home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / src / events.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-12-13  |  24.9 KB  |  797 lines
  1. /* Events: printing them, converting them to and from characters.
  2.    Copyright (C) 1991, 1992 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. #include "config.h"
  21. #include "lisp.h"
  22. #include "buffer.h"
  23. #include "window.h"
  24. #include "screen.h"
  25. #include "events.h"
  26. #include "indent.h"
  27.  
  28. extern Lisp_Object Qeventp;
  29. Lisp_Object QKbackspace, QKtab, QKlinefeed, QKreturn, QKescape,
  30.  QKspace, QKdelete, QKnosymbol;
  31.  
  32. void
  33. character_to_event (c, event)
  34.      unsigned int c;
  35.      struct Lisp_Event *event;
  36. {
  37.   unsigned int m = 0;
  38.   if (event->event_type == dead_event)
  39.     error ("character-to-event called with a deallocated event!");
  40.  
  41.   if (c > 127) c -= 128, m  = MOD_META;
  42.   if (c < ' ') c += '@', m |= MOD_CONTROL;
  43.   if (m & MOD_CONTROL) {
  44.     switch (c) {
  45.     case 'I': c = QKtab;    m &= ~MOD_CONTROL; break;
  46.     case 'J': c = QKlinefeed;    m &= ~MOD_CONTROL; break;
  47.     case 'M': c = QKreturn;    m &= ~MOD_CONTROL; break;
  48.     case '[': c = QKescape;    m &= ~MOD_CONTROL; break;
  49. # if 0
  50.     /* This is probably too controversial... */
  51.     case 'H': c = QKbackspace;    m &= ~MOD_CONTROL; break;
  52. # endif
  53.     }
  54.     if (c >= 'A' && c <= 'Z') c -= 'A'-'a';
  55.   }
  56.   else if (c == 127) c = QKdelete;
  57.   else if (c == ' ') c = QKspace;
  58.   
  59.   event->event_type        = key_press_event;
  60.   event->channel        = Qnil;
  61.   event->timestamp        = 0;
  62.   event->event.key.key        = c;
  63.   event->event.key.modifiers    = m;
  64. }
  65.  
  66.  
  67. /* This variable controls what character name -> character code mapping
  68.    we are using.  Window-system-specific code sets this to some symbol,
  69.    and we use that symbol as the plist key to convert keysyms into 8-bit
  70.    codes.  In this way one can have several character sets predefined and
  71.    switch them by changing this.
  72.  */
  73. Lisp_Object Vcharacter_set_property;
  74.  
  75. int
  76. event_to_character (event, lenient)    /* This is worthless and weak */
  77.      struct Lisp_Event *event;
  78.      int lenient;
  79. {
  80.   int c;
  81.   if (event->event_type != key_press_event) {
  82.     if (event->event_type == dead_event) abort ();
  83.     return -1;
  84.   }
  85.   if (!lenient &&
  86.       event->event.key.modifiers & (MOD_SUPER|MOD_HYPER|MOD_SYMBOL))
  87.     return -1;
  88.   if (FIXNUMP (event->event.key.key))        c = event->event.key.key;
  89.   else if (EQ (event->event.key.key, QKbackspace))    c = '\b';
  90.   else if (EQ (event->event.key.key, QKtab))        c = '\t';
  91.   else if (EQ (event->event.key.key, QKlinefeed))    c = '\n';
  92.   else if (EQ (event->event.key.key, QKreturn))        c = '\r';
  93.   else if (EQ (event->event.key.key, QKescape))        c = 27;
  94.   else if (EQ (event->event.key.key, QKspace))        c = ' ';
  95.   else if (EQ (event->event.key.key, QKdelete))        c = 127;
  96.  
  97.   else if (!SYMBOLP (event->event.key.key))
  98.     abort ();
  99.   else if (!NILP (Vcharacter_set_property))
  100.     {
  101.       /* Allow window-system-specific extensibility of the keysym->code mapping
  102.        */
  103.       Lisp_Object code = Fget (event->event.key.key, Vcharacter_set_property);
  104.       if (!FIXNUMP (code))
  105.     return -1;
  106.       c = XINT (code);
  107.     }
  108.   else return -1;
  109.  
  110.   if (event->event.key.modifiers & MOD_CONTROL) {
  111.     if (c >= 'a' && c <= 'z')
  112.       c -= ('a' - 'A');
  113.     else
  114.       if (c >= 'A' && c <= 'Z' && !lenient) /* reject Control-Shift- keys */
  115.     return -1;
  116.  
  117.     if (c >= '@' && c <= '_')
  118.       c -= '@';
  119.     else if (c == ' ')  /* C-space and C-@ are the same. */
  120.       c = 0;
  121.     else
  122.       if (! lenient) return -1;
  123.   }
  124.   /* I'm not sure this is right, given the keysym stuff above.
  125.      Once the tty interface is implemented, it might turn out to
  126.      be wrong to interpret the high bit as meta.  Possibly the
  127.      tty layer will do the meta hacking, and doing it here would
  128.      mean we were doing it twice.
  129.    */
  130.   if (event->event.key.modifiers & MOD_META)
  131.     c |= 0200;
  132.   return c;
  133. }
  134.  
  135. DEFUN ("event-to-character", Fevent_to_character, Sevent_to_character,
  136.        1, 2, 0,
  137.  "Returns the closest ASCII approximation to the given event object.\n\
  138. If the event isn't a keypress, this returns nil.\n\
  139. If the second argument is non-nil, then this is lenient in its \n\
  140. translation; it will ignore modifier keys other than control and meta,\n\
  141. and will ignore the shift modifier on those characters which have no \n\
  142. shifted ASCII equivalent (Control-Shift-A for example, will be mapped to \n\
  143. the same ASCII code as Control-A.)  If the second arg is nil, then nil \n\
  144. will be returned for events which have no direct ASCII equivalent.")
  145.      (event, lenient)
  146.      Lisp_Object event, lenient;
  147. {
  148.   int c;
  149.   CHECK_EVENT (event, 0);
  150.   if (XEVENT (event)->event_type == dead_event)
  151.     error ("event-to-character called with a deallocated event!");
  152.   c = event_to_character (XEVENT (event), !NILP (lenient));
  153.   return (c == -1 ? Qnil : make_number (c));
  154. }
  155.  
  156.  
  157. DEFUN ("character-to-event", Fcharacter_to_event, Scharacter_to_event, 1, 2, 0,
  158.   "Converts a numeric ASCII value to an event structure, replete with\n\
  159. bucky bits.  The character is the first argument, and the event to fill\n\
  160. in is the second.  This function contains knowledge about what the codes\n\
  161. ``mean'' -- for example, the number 9 is converted to the character ``Tab'',\n\
  162. not the distinct character ``Control-I''.\n\
  163. \n\
  164. If the optional second argument is an event, it is modified; otherwise, a\n\
  165. new event object is created.\n\
  166. \n\
  167. Beware that character-to-event and event-to-character are not strictly \n\
  168. inverse functions, since events contain much more information than the \n\
  169. ASCII character set can encode.")
  170.      (ch, event)
  171.      Lisp_Object ch, event;
  172. {
  173.   CHECK_FIXNUM (ch, 0);
  174.   if (NILP (event))
  175.     event = Fallocate_event ();
  176.   else
  177.     CHECK_EVENT (event, 0);
  178.   character_to_event (XINT (ch), XEVENT (event));
  179.   return event;
  180. }
  181.  
  182.  
  183. #ifdef HAVE_X_WINDOWS
  184. extern char* x_event_name ();
  185. #endif
  186.  
  187. void
  188. format_event_object (buf, event, brief)
  189.      char *buf;
  190.      struct Lisp_Event *event;
  191.      int brief;
  192. {
  193.   int mod, mouse_p = 0;
  194.   Lisp_Object key;
  195.   switch (event->event_type) {
  196.   case key_press_event:
  197.     mod = event->event.key.modifiers;
  198.     key = event->event.key.key;
  199.     /* Hack. */
  200.     if (! brief && FIXNUMP (key) &&
  201.     mod & (MOD_CONTROL|MOD_META|MOD_SUPER|MOD_HYPER)) {
  202.       if (XINT (key) >= 'a' && XINT (key) <= 'z')
  203.     XFASTINT (key) -= 'a'-'A';
  204.       else if (XINT (key) >= 'A' && XINT (key) <= 'Z')
  205.     mod |= MOD_SHIFT;
  206.     }
  207.     break;
  208.   case button_release_event:
  209.     mouse_p++;
  210.   case button_press_event:
  211.     mouse_p++;
  212.     mod = event->event.button.modifiers;
  213.     key = make_number (event->event.button.button + '0');
  214.     break;
  215.   case magic_event:
  216.     {
  217.       char *name =
  218. #ifdef HAVE_X_WINDOWS
  219.     x_event_name (((XEvent *) &event->event.magic.underlying_event)
  220.               ->xany.type);
  221. #else
  222.         0;
  223. #endif
  224.       if (name) strcpy (buf, name);
  225.       else strcpy (buf, "???");
  226.       return;
  227.     }
  228.   case pointer_motion_event:    strcpy (buf, "motion");    return;
  229.   case menu_event:        strcpy (buf, "menu");     return;
  230.   case eval_event:        strcpy (buf, "eval");     return;
  231.   case process_event:        strcpy (buf, "process");return;
  232.   case timeout_event:        strcpy (buf, "timeout");return;
  233.   case empty_event:        strcpy (buf, "EMPTY-EVENT"); return;
  234.   case dead_event:        strcpy (buf, "DEAD-EVENT");  return;
  235.   default:
  236.     abort ();
  237.   }
  238. #define modprint1(x)  { strcpy(buf,(x)); buf+=sizeof(x)-1; }
  239. #define modprint(x,y) { if (brief) modprint1(y) else modprint1(x) }
  240.   if (mod & MOD_CONTROL) modprint ("control-", "C-");
  241.   if (mod & MOD_META)    modprint ("meta-",    "M-");
  242.   if (mod & MOD_SUPER)   modprint ("super-",   "S-");
  243.   if (mod & MOD_HYPER)   modprint ("hyper-",   "H-");
  244.   if (mod & MOD_SYMBOL)  modprint ("symbol-",  "Sym-");
  245.   if (mod & MOD_SHIFT)   modprint ("shift-",   "Sh-");
  246.   if (mouse_p) {
  247.     modprint1 ("button");
  248.     --mouse_p;
  249.   }
  250. #undef modprint
  251. #undef modprint1
  252.  
  253.   switch (XTYPE (key)) {
  254.   case Lisp_Int:
  255.     buf[0] = XINT (key);
  256.     buf[1] = 0;
  257.     buf++;
  258.     break;
  259.   case Lisp_Symbol:
  260.     {
  261.       char *str = 0;
  262.       if (brief) {
  263.     if (EQ (key, QKlinefeed)) str = "LFD";
  264.     else if (EQ (key, QKtab)) str = "TAB";
  265.     else if (EQ (key, QKreturn)) str = "RET";
  266.     else if (EQ (key, QKescape)) str = "ESC";
  267.     else if (EQ (key, QKdelete)) str = "DEL";
  268.     else if (EQ (key, QKspace)) str = "SPC";
  269.     else if (EQ (key, QKbackspace)) str = "BS";
  270.       }
  271.       if (str) {
  272.     int i = strlen (str);
  273.     strncpy (buf, str, i+1);
  274.     str += i;
  275.       }
  276.       else {
  277.     strncpy (buf, (char *) XSYMBOL (key)->name->data,
  278.          XSYMBOL (key)->name->size+1);
  279.     str += XSYMBOL (key)->name->size;
  280.       }
  281.       break;
  282.     }
  283.   default:
  284.     abort ();
  285.   }
  286.   if (mouse_p) strncpy (buf, "up", 4);
  287. }
  288.  
  289.  
  290. /* 
  291.  * some predicates and accessors
  292.  */
  293.  
  294. Lisp_Object Qeventp, Qkey_press_event_p, Qbutton_event_p, Qmouse_event_p,
  295.  Qprocess_event_p;
  296.  
  297. DEFUN ("eventp", Feventp, Seventp, 1, 1, 0,
  298.        "True if the argument is an event object.")
  299.      (obj)
  300.      Lisp_Object obj;
  301. {
  302.   return ((EVENTP (obj)) ? Qt : Qnil);
  303. }
  304.  
  305. #define EVENT_PRED(type) \
  306.   return ((EVENTP (obj) && \
  307.        XEVENT (obj)->event_type == (type)) \
  308.       ? Qt : Qnil)
  309.  
  310. DEFUN ("key-press-event-p", Fkey_press_event_p, Skey_press_event_p, 1, 1, 0,
  311.        "True if the argument is a key-press event object.")
  312.      (obj)
  313.      Lisp_Object obj;
  314. { EVENT_PRED (key_press_event); }
  315.  
  316. DEFUN ("button-press-event-p", Fbutton_press_event_p, Sbutton_press_event_p,
  317.        1, 1, 0, "True if the argument is a mouse-button-press event object.")
  318.      (obj)
  319.      Lisp_Object obj;
  320. { EVENT_PRED (button_press_event); }
  321.  
  322. DEFUN ("button-release-event-p", Fbutton_release_event_p,
  323.        Sbutton_release_event_p, 1, 1, 0,
  324.        "True if the argument is a mouse-button-release event object.")
  325.      (obj)
  326.      Lisp_Object obj;
  327. { EVENT_PRED (button_release_event); }
  328.  
  329. DEFUN ("button-event-p", Fbutton_event_p,
  330.        Sbutton_event_p, 1, 1, 0,
  331.        "True if the argument is a button-press or button-release event object.")
  332.      (obj)
  333.      Lisp_Object obj;
  334. {
  335.   return ((EVENTP (obj) &&
  336.        (XEVENT (obj)->event_type == button_press_event ||
  337.         XEVENT (obj)->event_type == button_release_event))
  338.       ? Qt : Qnil);
  339. }
  340.  
  341. DEFUN ("motion-event-p", Fmotion_event_p, Smotion_event_p, 1, 1, 0,
  342.        "True if the argument is a mouse-motion event object.")
  343.      (obj)
  344.      Lisp_Object obj;
  345. { EVENT_PRED (pointer_motion_event); }
  346.  
  347. DEFUN ("process-event-p", Fprocess_event_p, Sprocess_event_p, 1, 1, 0,
  348.        "True if the argument is a process-output event object.")
  349.      (obj)
  350.      Lisp_Object obj;
  351. { EVENT_PRED (process_event); }
  352.  
  353. DEFUN ("timeout-event-p", Ftimeout_event_p, Stimeout_event_p, 1, 1, 0,
  354.        "True if the argument is a timeout event object.")
  355.      (obj)
  356.      Lisp_Object obj;
  357. { EVENT_PRED (timeout_event); }
  358.  
  359. DEFUN ("menu-event-p", Fmenu_event_p, Smenu_event_p, 1, 1, 0,
  360.        "True if the argument is a menu event object.")
  361.      (obj)
  362.      Lisp_Object obj;
  363. { EVENT_PRED (menu_event); }
  364.  
  365. DEFUN ("eval-event-p", Feval_event_p, Seval_event_p, 1, 1, 0,
  366.        "True if the argument is an `eval' or `menu' event object.")
  367.      (obj)
  368.      Lisp_Object obj;
  369. {
  370.   return ((EVENTP (obj) &&
  371.        (XEVENT (obj)->event_type == menu_event ||
  372.         XEVENT (obj)->event_type == eval_event))
  373.       ? Qt : Qnil);
  374. }
  375.  
  376. #define CHECK_EVENT_SAFE(e) \
  377. { CHECK_EVENT ((e),0); \
  378.   if ((XEVENT (e)->event_type < first_event_type) \
  379.       || (XEVENT (e)->event_type > last_event_type)) \
  380.      abort (); \
  381.   if (XEVENT (e)->event_type == dead_event) error ("deallocated event"); \
  382. }
  383.  
  384. DEFUN ("event-timestamp", Fevent_timestamp, Sevent_timestamp, 1, 1, 0,
  385.   "Returns the timestamp of the given event object.")
  386.      (event)
  387.      Lisp_Object event;
  388. {
  389.   CHECK_EVENT_SAFE (event);
  390.   /* This junk is so that timestamps don't get to be negative, but contain
  391.      as many bits as this particular emacs will allow.
  392.    */
  393.   return make_number (((1 << (VALBITS - 1)) - 1) &
  394.               XEVENT (event)->timestamp);
  395. }
  396.  
  397. #define CHECK_EVENT_TYPE(e,t1,sym) \
  398. { CHECK_EVENT_SAFE (e); \
  399.   if (XEVENT(e)->event_type != (t1)) \
  400.      e = wrong_type_argument ((sym),(e)); \
  401. }
  402.  
  403. #define CHECK_EVENT_TYPE2(e,t1,t2,sym) \
  404. { CHECK_EVENT_SAFE (e); \
  405.   if (XEVENT(e)->event_type != (t1) && XEVENT(e)->event_type != (t2)) \
  406.      e = wrong_type_argument ((sym),(e));\
  407. }
  408.  
  409. DEFUN ("event-key", Fevent_key, Sevent_key, 1, 1, 0,
  410.        "Returns the KeySym of the given key-press event.  This will be the\n\
  411. ASCII code of a printing character, or a symbol.")
  412.      (event)
  413.      Lisp_Object event;
  414. {
  415.   CHECK_EVENT_TYPE (event, key_press_event, Qkey_press_event_p);
  416.   return XEVENT (event)->event.key.key;
  417. }
  418.  
  419. DEFUN ("event-button", Fevent_button, Sevent_button, 1, 1, 0,
  420.        "Returns the button-number of the given mouse-button-press event.")
  421.      (event)
  422.      Lisp_Object event;
  423. {
  424.   CHECK_EVENT_TYPE2 (event, button_press_event, button_release_event,
  425.              Qbutton_event_p);
  426.   return make_number (XEVENT (event)->event.button.button);
  427. }
  428.  
  429. DEFUN ("event-modifier-bits", Fevent_modifier_bits, Sevent_modifier_bits,
  430.        1, 1, 0,
  431.        "Returns a number representing the modifier keys which were down \n\
  432. when the given mouse or keyboard event was produced.  See also the function\n\
  433. event-modifiers.")
  434.      (event)
  435.      Lisp_Object event;
  436. {
  437.   CHECK_EVENT_SAFE (event);
  438.   if (XEVENT (event)->event_type != key_press_event &&
  439.       XEVENT (event)->event_type != button_press_event &&
  440.       XEVENT (event)->event_type != button_release_event)
  441.     wrong_type_argument (intern ("key-or-mouse-event-p"), event);
  442.   return make_number((XEVENT (event)->event_type != key_press_event)
  443.              ? XEVENT (event)->event.key.modifiers
  444.              : XEVENT (event)->event.button.modifiers);
  445. }
  446.  
  447. DEFUN ("event-modifiers", Fevent_modifiers, Sevent_modifiers, 1, 1, 0,
  448.        "Returns a list of symbols, the names of the modifier keys which \n\
  449. were down when the given mouse or keyboard event was produced.\n\
  450. See also the function event-modifier-bits.")
  451.      (event)
  452.      Lisp_Object event;
  453. {
  454.   int mod = XINT (Fevent_modifier_bits (event));
  455.   Lisp_Object result = Qnil;
  456.   if (mod & MOD_SHIFT)   result = Fcons (intern ("shift"), result);
  457.   if (mod & MOD_SYMBOL)  result = Fcons (intern ("symbol"), result);
  458.   if (mod & MOD_HYPER)   result = Fcons (intern ("hyper"), result);
  459.   if (mod & MOD_SUPER)   result = Fcons (intern ("super"), result);
  460.   if (mod & MOD_META)    result = Fcons (intern ("meta"), result);
  461.   if (mod & MOD_CONTROL) result = Fcons (intern ("control"), result);
  462.   return result;
  463. }
  464.  
  465. DEFUN ("event-x-pixel", Fevent_x_pixel, Sevent_x_pixel, 1, 1, 0,
  466.  "Returns the X position of the given mouse-motion, button-press, or\n\
  467. button-release event in pixels.")
  468.      (event)
  469.      Lisp_Object event;
  470. {
  471.   CHECK_EVENT_SAFE (event);
  472.   if (XEVENT (event)->event_type == pointer_motion_event)
  473.     return make_number (XEVENT (event)->event.motion.x);
  474.   else if (XEVENT (event)->event_type == button_press_event ||
  475.        XEVENT (event)->event_type == button_release_event)
  476.     return make_number (XEVENT (event)->event.button.x);
  477.   else
  478.     return wrong_type_argument (Qmouse_event_p, event);
  479. }
  480.  
  481. DEFUN ("event-y-pixel", Fevent_y_pixel, Sevent_y_pixel, 1, 1, 0,
  482.  "Returns the Y position of the given mouse-motion, button-press, or\n\
  483. button-release event in pixels.")
  484.      (event)
  485.      Lisp_Object event;
  486. {
  487.   CHECK_EVENT_SAFE (event);
  488.   if (XEVENT (event)->event_type == pointer_motion_event)
  489.     return make_number (XEVENT (event)->event.motion.y);
  490.   else if (XEVENT (event)->event_type == button_press_event ||
  491.        XEVENT (event)->event_type == button_release_event)
  492.     return make_number (XEVENT (event)->event.button.y);
  493.   else
  494.     return wrong_type_argument (Qmouse_event_p, event);
  495. }
  496.  
  497.  
  498. static void
  499. event_pixel_translation (event, char_x, char_y, w, bufp, class, the_hard_way)
  500.      Lisp_Object event, *class;
  501.      int *char_x, *char_y, *bufp;
  502.      struct window **w;
  503.      int the_hard_way;
  504. {
  505.   int pix_x, pix_y, begin_p;
  506.   int glyph, res;
  507.   Lisp_Object screen;
  508.   
  509.   CHECK_EVENT_SAFE (event);
  510.   if (XEVENT (event)->event_type == pointer_motion_event) {
  511.     pix_x  = XEVENT (event)->event.motion.x;
  512.     pix_y  = XEVENT (event)->event.motion.y;
  513.     screen = XEVENT (event)->channel;
  514.   }
  515.   else if (XEVENT (event)->event_type == button_press_event ||
  516.        XEVENT (event)->event_type == button_release_event) {
  517.     pix_x  = XEVENT (event)->event.button.x;
  518.     pix_y  = XEVENT (event)->event.button.y;
  519.     screen = XEVENT (event)->channel;
  520.   }
  521.   else
  522.     wrong_type_argument (Qmouse_event_p, event);
  523.  
  524.   res = pixel_to_glyph_translation (XSCREEN (screen), pix_x, pix_y,
  525.                     char_x, char_y, w, bufp,
  526.                     &glyph, class, &begin_p);
  527.   /* It looks to me like the result value of pixel_to_glyph_translation() is
  528.      0:  modeline
  529.      1:  over text, or over a glyph in the lineinfo column;
  530.      2:  not over text, not in a window, or over an inactive minibuffer.
  531.    */
  532.   if (res == 2)
  533.     *bufp = 0;
  534.   else if (*w && NILP ((*w)->buffer))
  535.     *w = 0; /* Why does this happen? */
  536.  
  537. #if 0
  538.  
  539.   if (the_hard_way && *bufp)
  540.     /* pixel_to_glyph_translation() doesn't really work when what you're
  541.        interested in is the buffer position of a pixel position, though
  542.        it works for the other values.  So if we want the point, we use
  543.        compute_motion() to get the buffer position, because doing this is
  544.        loads easier than actually fixing the redisplay data structures to
  545.        be valid.  What a crock.
  546.      */
  547.     {
  548.       struct position *posval;
  549.       XSETWINDOW (window, *w);
  550.       posval = compute_motion (window, marker_position ((*w)->start), 0, 0,
  551.                    ZV, *char_y, *char_x,
  552.                    XFASTINT ((*w)->width), XINT ((*w)->hscroll),
  553.                    0, 0, 0);
  554.       *bufp = posval->bufpos;
  555.     }
  556. #endif
  557. }
  558.  
  559.  
  560. DEFUN ("event-window", Fevent_window, Sevent_window, 1, 1, 0,
  561.  "Given a mouse motion, button press, or button release event, compute\n\
  562. and return the window on which that event occurred.  This may be nil if\n\
  563. the event did not occur in an emacs window (in the border or modeline.)")
  564.      (event)
  565.      Lisp_Object event;
  566. {
  567.   int char_x, char_y, bufp;
  568.   struct window *w;
  569.   Lisp_Object window, class;
  570.   event_pixel_translation (event, &char_x, &char_y, &w, &bufp, &class, 0);
  571.   if (! w) return Qnil;
  572.   XSET (window, Lisp_Window, w);
  573.   return window;
  574. }
  575.  
  576.  
  577. DEFUN ("event-point", Fevent_point, Sevent_point, 1, 1, 0,
  578.  "Returns the character position of the given mouse-motion, button-press,\n\
  579. or button-release event.  If the event did not occur over a window, or did\n\
  580. not occur over text, then this returns nil.  Otherwise, it returns an index\n\
  581. into the buffer visible in the event's window.")
  582.      (event)
  583.      Lisp_Object event;
  584. {
  585.   int char_x, char_y, bufp, class;
  586.   struct window *w;
  587.   event_pixel_translation (event, &char_x, &char_y, &w, &bufp, &class, 1);
  588.   if (! w) return Qnil;
  589.   if (! bufp) return Qnil;
  590.   return make_number (bufp);
  591. }
  592.  
  593. DEFUN ("event-x", Fevent_x, Sevent_x, 1, 1, 0,
  594.  "Returns the X position of the given mouse-motion, button-press, or\n\
  595. button-release event in characters.")
  596.      (event)
  597.      Lisp_Object event;
  598. {
  599.   int char_x, char_y, bufp, class;
  600.   struct window *w;
  601.   event_pixel_translation (event, &char_x, &char_y, &w, &bufp, &class, 0);
  602.   if (! w) return Qnil;
  603.   return make_number (char_x);
  604. }
  605.  
  606. DEFUN ("event-y", Fevent_y, Sevent_y, 1, 1, 0,
  607.  "Returns the Y position of the given mouse-motion, button-press, or\n\
  608. button-release event in characters.")
  609.      (event)
  610.      Lisp_Object event;
  611. {
  612.   int char_x, char_y, bufp, class;
  613.   struct window *w;
  614.   event_pixel_translation (event, &char_x, &char_y, &w, &bufp, &class, 0);
  615.   if (! w) return Qnil;
  616.   return make_number (char_y);
  617. }
  618.  
  619.  
  620. DEFUN ("event-glyph", Fevent_glyph, Sevent_glyph, 1, 1, 0,
  621.  "If the given mouse-motion, button-press, or button-release event happened\n\
  622. on top of a glyph, this returns it; else nil.")
  623.      (event)
  624.      Lisp_Object event;
  625. {
  626.   int char_x, char_y, bufp;
  627.   Lisp_Object class;
  628.   struct window *w;
  629.  
  630.   event_pixel_translation (event, &char_x, &char_y, &w, &bufp, &class, 0);
  631.   if (! w) return Qnil;
  632.   return class;
  633. }
  634.  
  635.  
  636. DEFUN ("event-process", Fevent_process, Sevent_process, 1, 1, 0,
  637.  "Returns the process of the given proces-output event.")
  638.      (event)
  639.      Lisp_Object event;
  640. {
  641.   CHECK_EVENT_TYPE (event, process_event, Qprocess_event_p);
  642.   return (XEVENT (event)->event.process.process);
  643. }
  644.  
  645. DEFUN ("event-function", Fevent_function, Sevent_function, 1, 1, 0,
  646.  "Returns the callback function of the given timeout, menu, or eval event.")
  647.      (event)
  648.      Lisp_Object event;
  649. {
  650.   CHECK_EVENT_SAFE (event);
  651.   switch (XEVENT (event)->event_type) {
  652.   case timeout_event:
  653.     return (XEVENT (event)->event.timeout.function);
  654.   case menu_event:
  655.   case eval_event:
  656.     return (XEVENT (event)->event.eval.function);
  657.   default:
  658.     return wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
  659.   }
  660. }
  661.  
  662. DEFUN ("event-object", Fevent_object, Sevent_object, 1, 1, 0,
  663.  "Returns the callback function argument of the given timeout, menu, or\n\
  664. eval event.")
  665.      (event)
  666.      Lisp_Object event;
  667. {
  668.   CHECK_EVENT_SAFE (event);
  669.   switch (XEVENT (event)->event_type) {
  670.   case timeout_event:
  671.     return (XEVENT (event)->event.timeout.object);
  672.   case menu_event:
  673.   case eval_event:
  674.     return (XEVENT (event)->event.eval.object);
  675.   default:
  676.     return wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
  677.   }
  678. }
  679.  
  680. Lisp_Object
  681. event_equal (o1, o2)            /* only Fequal() uses this */
  682.      Lisp_Object o1, o2;
  683. {
  684.   if (XEVENT (o1)->event_type != XEVENT (o2)->event_type) return Qnil;
  685.   if (XEVENT (o1)->channel != XEVENT (o2)->channel) return Qnil;
  686. /*  if (XEVENT (o1)->timestamp != XEVENT (o2)->timestamp) return Qnil; */
  687.   switch (XEVENT (o1)->event_type) {
  688.     
  689.   case process_event:
  690.     return (EQ (XEVENT (o1)->event.process.process,
  691.         XEVENT (o2)->event.process.process)
  692.         ? Qt : Qnil);
  693.     
  694.   case timeout_event:
  695.     if (NILP (Fequal (XEVENT (o1)->event.timeout.function,
  696.               XEVENT (o2)->event.timeout.function)))
  697.       return Qnil;
  698.     if (NILP (Fequal (XEVENT (o1)->event.timeout.object,
  699.               XEVENT (o2)->event.timeout.object)))
  700.       return Qnil;
  701.     return Qt;
  702.     
  703.   case key_press_event:
  704.     return ((XEVENT (o1)->event.key.key == XEVENT (o2)->event.key.key &&
  705.          XEVENT (o1)->event.key.modifiers ==
  706.          XEVENT (o2)->event.key.modifiers)
  707.         ? Qt : Qnil);
  708.   case button_press_event:
  709.   case button_release_event:
  710.     return ((XEVENT (o1)->event.button.button ==
  711.          XEVENT (o2)->event.button.button &&
  712.          XEVENT (o1)->event.button.modifiers ==
  713.          XEVENT (o2)->event.button.modifiers)
  714.         ? Qt : Qnil);
  715.   case pointer_motion_event:
  716.     return ((XEVENT (o1)->event.motion.x == XEVENT (o2)->event.motion.x &&
  717.          XEVENT (o1)->event.motion.y == XEVENT (o2)->event.motion.y)
  718.         ? Qt : Qnil);
  719.   case menu_event:
  720.   case eval_event:
  721.     if (NILP (Fequal (XEVENT (o1)->event.eval.function,
  722.               XEVENT (o2)->event.eval.function)))
  723.       return Qnil;
  724.     if (NILP (Fequal (XEVENT (o1)->event.eval.object,
  725.               XEVENT (o2)->event.eval.object)))
  726.       return Qnil;
  727.     return Qt;
  728.   case magic_event:
  729.     return (memcmp ((char*) &(XEVENT (o1)->event.magic),
  730.             (char*) &(XEVENT (o2)->event.magic),
  731.             sizeof (struct magic_data))
  732.         ? Qnil : Qt);
  733.  
  734.   default:
  735.     error ("unknown event type");
  736.     return Qnil; /* not reached; warning suppression */
  737.   }
  738. }
  739.  
  740.  
  741. void
  742. syms_of_events ()
  743. {
  744.   DEFVAR_LISP ("character-set-property", &Vcharacter_set_property,
  745.    "A symbol used to look up the 8-bit character of a keysym.\n\
  746. To convert a keysym symbol to an 8-bit code, as when that key is\n\
  747. bound to self-insert-command, we will look up the property that this\n\
  748. variable names on the property list of the keysym-symbol.  The window-\n\
  749. system-specific code will set up appropriate properties and set this\n\
  750. variable.");
  751.   Vcharacter_set_property = Qnil;
  752.  
  753.   defsubr (&Scharacter_to_event);
  754.   defsubr (&Sevent_to_character);
  755.  
  756.   defsubr (&Seventp);
  757.   defsubr (&Skey_press_event_p);
  758.   defsubr (&Sbutton_press_event_p);
  759.   defsubr (&Sbutton_release_event_p);
  760.   defsubr (&Smotion_event_p);
  761.   defsubr (&Sprocess_event_p);
  762.   defsubr (&Stimeout_event_p);
  763.   defsubr (&Smenu_event_p);
  764.   defsubr (&Seval_event_p);
  765.  
  766.   defsubr (&Sevent_timestamp);
  767.   defsubr (&Sevent_key);
  768.   defsubr (&Sevent_button);
  769.   defsubr (&Sevent_modifier_bits);
  770.   defsubr (&Sevent_modifiers);
  771.   defsubr (&Sevent_x_pixel);
  772.   defsubr (&Sevent_y_pixel);
  773.   defsubr (&Sevent_window);
  774.   defsubr (&Sevent_x);
  775.   defsubr (&Sevent_y);
  776.   defsubr (&Sevent_point);
  777.   defsubr (&Sevent_glyph);
  778.   defsubr (&Sevent_process);
  779.   defsubr (&Sevent_function);
  780.   defsubr (&Sevent_object);
  781.  
  782.   Qeventp         = intern ("eventp");
  783.   Qkey_press_event_p = intern ("key-press-event-p");
  784.   Qbutton_event_p    = intern ("button-event-p");
  785.   Qmouse_event_p     = intern ("mouse-event-p");
  786.   Qprocess_event_p   = intern ("process-event-p");
  787.  
  788.   QKbackspace = KEYSYM ("backspace");
  789.   QKtab       = KEYSYM ("tab");
  790.   QKlinefeed  = KEYSYM ("linefeed");
  791.   QKreturn    = KEYSYM ("return");
  792.   QKescape    = KEYSYM ("escape");
  793.   QKspace     = KEYSYM ("space");
  794.   QKdelete    = KEYSYM ("delete");
  795.   QKnosymbol  = KEYSYM ("NoSymbol");
  796. }
  797.