]> code.delx.au - gnu-emacs/blobdiff - src/keyboard.c
(Fnext_property_change): Properly offset interval
[gnu-emacs] / src / keyboard.c
index c756ae7cb92796a8177c82e68ca4b9a9e731e228..a3dd95e0f7d72e22122478933aa053b35226339e 100644 (file)
@@ -451,6 +451,7 @@ Lisp_Object Qmouse_click;
 #ifdef WINDOWSNT
 Lisp_Object Qmouse_wheel;
 #endif
+Lisp_Object Qdrag_n_drop;
 /* Lisp_Object Qmouse_movement; - also an event header */
 
 /* Properties of event headers.  */
@@ -460,7 +461,8 @@ Lisp_Object Qevent_symbol_elements;
 /* menu item parts */
 Lisp_Object Qmenu_alias;
 Lisp_Object Qmenu_enable;
-Lisp_Object QCenable, QCvisible, QChelp, QCfilter, QCbutton, QCtoggle, QCradio;
+Lisp_Object QCenable, QCvisible, QChelp, QCfilter, QCkeys, QCkey_sequence;
+Lisp_Object QCbutton, QCtoggle, QCradio;
 extern Lisp_Object Vdefine_key_rebound_commands;
 extern Lisp_Object Qmenu_item;
 
@@ -1304,7 +1306,7 @@ command_loop_1 ()
                {
                   struct Lisp_Char_Table *dp
                    = window_display_table (XWINDOW (selected_window));
-                 lose = FETCH_BYTE (PT_BYTE);
+                 lose = FETCH_CHAR (PT_BYTE);
                  SET_PT (PT + 1);
                  if ((dp
                       ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
@@ -1334,7 +1336,7 @@ command_loop_1 ()
                   struct Lisp_Char_Table *dp
                    = window_display_table (XWINDOW (selected_window));
                  SET_PT (PT - 1);
-                 lose = FETCH_BYTE (PT_BYTE);
+                 lose = FETCH_CHAR (PT_BYTE);
                  if ((dp
                       ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
                          ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
@@ -1834,14 +1836,29 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
       goto reread_first;
     }
 
+  /* if redisplay was requested */
   if (commandflag >= 0)
     {
+       /* If there is pending input, process any events which are not
+          user-visible, such as X selection_request events.  */
       if (input_pending
          || detect_input_pending_run_timers (0))
-       swallow_events (0);
+       swallow_events (0);             /* may clear input_pending */
 
-      if (!input_pending)
-       redisplay ();
+      /* Redisplay if no pending input.  */
+      while (!input_pending)
+       {
+         redisplay ();
+
+         if (!input_pending)
+           /* Normal case: no input arrived during redisplay.  */
+           break;
+
+         /* Input arrived and pre-empted redisplay.
+            Process any events which are not user-visible.  */
+         swallow_events (0);
+         /* If that cleared input_pending, try again to redisplay.  */
+       }
     }
 
   /* Message turns off echoing unless more keystrokes turn it on again. */
@@ -3290,6 +3307,7 @@ static Lisp_Object mouse_syms;
 #ifdef WINDOWSNT
 static Lisp_Object mouse_wheel_syms;
 #endif
+static Lisp_Object drag_n_drop_syms;
 
 /* This is a list of keysym codes for special "accent" characters.
    It parallels lispy_accent_keys.  */
@@ -3721,8 +3739,16 @@ static char *lispy_mouse_wheel_names[] =
 {
   "mouse-wheel"
 };
+
 #endif /* WINDOWSNT */
 
+/* drag-n-drop events are generated when a set of selected files are
+   dragged from another application and dropped onto an Emacs window.  */
+static char *lispy_drag_n_drop_names[] =
+{
+  "drag-n-drop"
+};
+
 /* Scroll bar parts.  */
 Lisp_Object Qabove_handle, Qhandle, Qbelow_handle;
 Lisp_Object Qup, Qdown;
@@ -4215,6 +4241,78 @@ make_lispy_event (event)
        }
       }
 #endif /* WINDOWSNT */
+
+    case drag_n_drop:
+      {
+       int part;
+       FRAME_PTR f;
+       Lisp_Object window;
+       Lisp_Object posn;
+       Lisp_Object head, position;
+       Lisp_Object files;
+       int row, column;
+
+       /* The frame_or_window field should be a cons of the frame in
+          which the event occurred and a list of the filenames
+          dropped.  */
+       if (! CONSP (event->frame_or_window))
+         abort ();
+
+       f = XFRAME (XCONS (event->frame_or_window)->car);
+       files = XCONS (event->frame_or_window)->cdr;
+
+       /* Ignore mouse events that were made on frames that
+          have been deleted.  */
+       if (! FRAME_LIVE_P (f))
+         return Qnil;
+       pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
+                              &column, &row, NULL, 1);
+       window = window_from_coordinates (f, column, row, &part);
+
+       if (!WINDOWP (window))
+         {
+           window = XCONS (event->frame_or_window)->car;
+           posn = Qnil;
+         }
+       else
+         {
+           int pixcolumn, pixrow;
+           column -= XINT (XWINDOW (window)->left);
+           row -= XINT (XWINDOW (window)->top);
+           glyph_to_pixel_coords (f, column, row, &pixcolumn, &pixrow);
+           XSETINT (event->x, pixcolumn);
+           XSETINT (event->y, pixrow);
+
+           if (part == 1)
+             posn = Qmode_line;
+           else if (part == 2)
+             posn = Qvertical_line;
+           else
+             XSETINT (posn,
+                      buffer_posn_from_coords (XWINDOW (window),
+                                               column, row));
+         }
+
+       {
+         Lisp_Object head, position;
+
+         position
+           = Fcons (window,
+                    Fcons (posn,
+                           Fcons (Fcons (event->x, event->y),
+                                  Fcons (make_number (event->timestamp),
+                                         Qnil))));
+
+         head = modify_event_symbol (0, event->modifiers,
+                                     Qdrag_n_drop, Qnil,
+                                     lispy_drag_n_drop_names,
+                                     &drag_n_drop_syms, 1);
+         return Fcons (head,
+                       Fcons (position,
+                              Fcons (files,
+                                     Qnil)));
+       }
+      }
 #endif /* HAVE_MOUSE */
 
 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI)
@@ -5542,8 +5640,9 @@ menu_item_eval_property (sexpr)
    ITEM is a key binding, a possible menu item.
    If NOTREAL is nonzero, only check for equivalent key bindings, don't
    evaluate dynamic expressions in the menu item.
-   INMENUBAR is true when this is considered for an entry in a menu bar
+   INMENUBAR is > 0 when this is considered for an entry in a menu bar
    top level.
+   INMENUBAR is < 0 when this is considered for an entry in a keyboard menu.
    parse_menu_item returns true if the item is a menu item and false
    otherwise.  */
 
@@ -5552,28 +5651,16 @@ parse_menu_item (item, notreal, inmenubar)
      Lisp_Object item;
      int notreal, inmenubar;
 {
-  Lisp_Object def, tem;
-
-  Lisp_Object type = Qnil;
+  Lisp_Object def, tem, item_string, start;
   Lisp_Object cachelist = Qnil;
   Lisp_Object filter = Qnil;
-  Lisp_Object item_string, start;
+  Lisp_Object keyhint = Qnil;
   int i;
-  struct gcpro gcpro1, gcpro2, gcpro3;
-
-#define RET0                                   \
-  if (1)                                       \
-    {                                          \
-      UNGCPRO;                                 \
-      return 0;                                        \
-    }                                          \
-  else
+  int newcache = 0;
 
   if (!CONSP (item))
     return 0;
 
-  GCPRO1 (item);
-
   /* Create item_properties vector if necessary.  */
   if (NILP (item_properties))
     item_properties
@@ -5660,15 +5747,31 @@ parse_menu_item (item, notreal, inmenubar)
                     then ignore this item.  */
                  tem = menu_item_eval_property (XCONS (item)->car);
                  if (NILP (tem))
-                   RET0;
+                   return 0;
                }
              else if (EQ (tem, QChelp))
                XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]
                  = XCONS (item)->car;
              else if (EQ (tem, QCfilter))
-               filter = XCONS (item)->car;
+               filter = item;
+             else if (EQ (tem, QCkey_sequence))
+               {
+                 tem = XCONS (item)->car;
+                 if (NILP (cachelist)
+                     && (SYMBOLP (tem) || STRINGP (tem) || VECTORP (tem)))
+                   /* Be GC protected. Set keyhint to item instead of tem. */
+                   keyhint = item;
+               }
+             else if (EQ (tem, QCkeys))
+               {
+                 tem = XCONS (item)->car;
+                 if (CONSP (tem) || STRINGP (tem) && NILP (cachelist))
+                   XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]
+                     = tem;
+               }
              else if (EQ (tem, QCbutton) && CONSP (XCONS (item)->car))
                {
+                 Lisp_Object type;
                  tem = XCONS (item)->car;
                  type = XCONS (tem)->car;
                  if (EQ (type, QCtoggle) || EQ (type, QCradio))
@@ -5683,10 +5786,10 @@ parse_menu_item (item, notreal, inmenubar)
            }
        }
       else if (inmenubar || !NILP (start))
-       RET0;
+       return 0;
     }
   else
-    RET0;
+    return 0;                  /* not a menu item */
 
   /* If item string is not a string, evaluate it to get string.
      If we don't get a string, skip this item.  */
@@ -5695,7 +5798,7 @@ parse_menu_item (item, notreal, inmenubar)
     {
       item_string = menu_item_eval_property (item_string);
       if (!STRINGP (item_string))
-       RET0;
+       return 0;
       XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME] = item_string;
     }
      
@@ -5703,18 +5806,15 @@ parse_menu_item (item, notreal, inmenubar)
   def = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
   if (!NILP (filter))
     {
-      def = menu_item_eval_property (Fcons (filter, Fcons (def, Qnil)));
+      def = menu_item_eval_property (Fcons (XCONS (filter)->car,
+                                           Fcons (def, Qnil)));
       XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF] = def;
     }
 
   /* If we got no definition, this item is just unselectable text which
-     is ok when in a submenu and if there is an item string.  */
-  item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
+     is OK in a submenu but not in the menubar.  */
   if (NILP (def))
-    {
-      UNGCPRO;
-      return (!inmenubar && STRINGP (item_string) ? 1 : 0);
-    }
+    return (inmenubar ? 0 : 1);
  
   /* Enable or disable selection of item.  */
   tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
@@ -5725,99 +5825,145 @@ parse_menu_item (item, notreal, inmenubar)
       else
        tem = menu_item_eval_property (tem);
       if (inmenubar && NILP (tem))
-       RET0;           /* Ignore disabled items in menu bar.  */
+       return 0;               /* Ignore disabled items in menu bar.  */
       XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE] = tem;
     }
 
   /* See if this is a separate pane or a submenu.  */
+  def = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
   tem = get_keymap_1 (def, 0, 1);
   if (!NILP (tem))
     {
       XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP] = tem;
       XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF] = tem;
-      UNGCPRO;
       return 1;
     }
-  else if (inmenubar)
-    RET0;              /* Entries in menu bar must be submenus.  */
+  else if (inmenubar > 0)
+    return 0;                  /* Entries in menu bar must be submenus.  */
 
   /* This is a command.  See if there is an equivalent key binding. */
   if (NILP (cachelist))
     {
-      /* We have to create a cachelist. */
+      /* We have to create a cachelist.  */
       CHECK_IMPURE (start);
       XCONS (start)->cdr = Fcons (Fcons (Qnil, Qnil), XCONS (start)->cdr);
       cachelist = XCONS (XCONS (start)->cdr)->car;
-      /* We have not checked this before so check it now.  */
-      tem = def;
-    }
-  else if (VECTORP (XCONS (cachelist)->car)) /* Saved key */
-    {
-      tem = Fkey_binding (XCONS (cachelist)->car, Qnil);
-      if (EQ (tem, def) 
-         /* If the command is an alias for another
-            (such as easymenu.el and lmenu.el set it up),
-            check if the original command matches the cached command.  */
-         || (SYMBOLP (def) && EQ (tem, XSYMBOL (def)->function)))
-       tem = Qnil;             /* Don't need to recompute key binding.  */
+      newcache = 1;
+      tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];
+      if (!NILP (keyhint))
+       {
+         XCONS (cachelist)->car = XCONS (keyhint)->car;
+         newcache = 0;
+       }
+      else if (STRINGP (tem))
+       {
+         XCONS (cachelist)->cdr = Fsubstitute_command_keys (tem);
+         XCONS (cachelist)->car = Qt;
+       }
+    }
+  tem = XCONS (cachelist)->car;
+  if (!EQ (tem, Qt))
+    {
+      int chkcache = 0;
+      Lisp_Object prefix;
+
+      if (!NILP (tem))
+       tem = Fkey_binding (tem, Qnil);
+
+      prefix = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];
+      if (CONSP (prefix))
+       {
+         def = XCONS (prefix)->car;
+         prefix = XCONS (prefix)->cdr;
+       }
       else
-       tem = def;
-    }
-  /* If something had no key binding before, don't recheck it
-     because that is too slow--except if we have a list of rebound
-     commands in Vdefine_key_rebound_commands, do recheck any command
-     that appears in that list. */
-  else if (!NILP (XCONS (cachelist)->car))
-    tem = def;                 /* Should signal an error here.  */
-  else if (
-          /* Should we check everything when precomputing key bindings?  */
-          /* notreal || */
-          CONSP (Vdefine_key_rebound_commands)
-          && !NILP (Fmemq (def, Vdefine_key_rebound_commands)))
-    tem = def;
-  else
-    tem = Qnil;
-  
-  if (!NILP (tem))
+       def = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
+
+      if (NILP (XCONS (cachelist)->car)) /* Have no saved key.  */
+       {
+         if (newcache          /* Always check first time.  */
+             /* Should we check everything when precomputing key
+                bindings?  */
+             /* || notreal */
+             /* If something had no key binding before, don't recheck it
+                because that is too slow--except if we have a list of
+                rebound commands in Vdefine_key_rebound_commands, do
+                recheck any command that appears in that list. */
+             || (CONSP (Vdefine_key_rebound_commands)
+                 && !NILP (Fmemq (def, Vdefine_key_rebound_commands))))
+           chkcache = 1;
+       }
+      /* We had a saved key. Is it still bound to the command?  */
+      else if (NILP (tem)
+              || !EQ (tem, def)
+              /* If the command is an alias for another
+                 (such as lmenu.el set it up), check if the
+                 original command matches the cached command.  */
+              && !(SYMBOLP (def) && EQ (tem, XSYMBOL (def)->function)))
+       chkcache = 1;           /* Need to recompute key binding.  */
+
+      if (chkcache)
+       {
+         /* Recompute equivalent key binding.  If the command is an alias
+            for another (such as lmenu.el set it up), see if the original
+            command name has equivalent keys.  Otherwise look up the
+            specified command itself.  We don't try both, because that
+            makes lmenu menus slow. */
+         if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)
+             && ! NILP (Fget (def, Qmenu_alias)))
+           def = XSYMBOL (def)->function;
+         tem = Fwhere_is_internal (def, Qnil, Qt, Qnil);
+         XCONS (cachelist)->car = tem;
+         if (NILP (tem))
+           {
+             XCONS (cachelist)->cdr = Qnil;
+             chkcache = 0;
+           }
+       }
+      else if (!NILP (keyhint) && !NILP (XCONS (cachelist)->car))
+       {
+         tem = XCONS (cachelist)->car;
+         chkcache = 1;
+       }
+
+      newcache = chkcache;
+      if (chkcache)
+       {
+         tem = Fkey_description (tem);
+         if (CONSP (prefix))
+           {
+             if (STRINGP (XCONS (prefix)->car))
+               tem = concat2 (XCONS (prefix)->car, tem);
+             if (STRINGP (XCONS (prefix)->cdr))
+               tem = concat2 (tem, XCONS (prefix)->cdr);
+           }
+         XCONS (cachelist)->cdr = tem;
+       }
+    }
+
+  tem = XCONS (cachelist)->cdr;
+  if (newcache && !NILP (tem))
     {
-      /* Recompute equivalent key binding.
-         If the command is an alias for another
-        (such as easymenu.el and lmenu.el set it up),
-        see if the original command name has equivalent keys.
-        Otherwise look up the specified command itself.
-        We don't try both, because that makes easymenu menus slow.  */
-      if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)
-         && ! NILP (Fget (def, Qmenu_alias)))
-       tem = XSYMBOL (def)->function;
-      tem = Fwhere_is_internal (tem, Qnil, Qt, Qnil);
-      XCONS (cachelist)->car = tem;
-      XCONS (cachelist)->cdr
-       = (NILP (tem) ? Qnil
-          :
-          concat2 (build_string ("  ("),
-                   concat2 (Fkey_description (tem), build_string (")"))));
+      tem = concat3 (build_string ("  ("), tem, build_string (")"));
+      XCONS (cachelist)->cdr = tem;
     }
 
   /* If we only want to precompute equivalent key bindings, stop here. */
   if (notreal)
-    {
-      UNGCPRO;
-      return 1;
-    }
+    return 1;
 
   /* If we have an equivalent key binding, use that.  */
-  XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]
-    = XCONS (cachelist)->cdr;
-
-  /* Include this when menu help is implemented. 
-     tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP];
-     if (!(NILP (tem) || STRINGP (tem)))
-     {
-     tem = menu_item_eval_property (tem);
-     if (!STRINGP (tem))
-     tem = Qnil;
-     XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem;
-     }
+  XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ] = tem;
+
+  /* Include this when menu help is implemented.
+  tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP];
+  if (!(NILP (tem) || STRINGP (tem)))
+    {
+      tem = menu_item_eval_property (tem);
+      if (!STRINGP (tem))
+       tem = Qnil;
+      XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem;
+    }
   */
 
   /* Handle radio buttons or toggle boxes.  */ 
@@ -5826,7 +5972,6 @@ parse_menu_item (item, notreal, inmenubar)
     XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED]
       = menu_item_eval_property (tem);
 
-  UNGCPRO;
   return 1;
 }
 \f
@@ -6020,7 +6165,7 @@ read_char_minibuf_menu_prompt (commandflag, nmaps, maps)
       /* Loop over elements of map.  */
       while (i < width)
        {
-         Lisp_Object s, elt;
+         Lisp_Object elt;
 
          /* If reached end of map, start at beginning of next map.  */
          if (NILP (rest))
@@ -6053,26 +6198,27 @@ read_char_minibuf_menu_prompt (commandflag, nmaps, maps)
          else
            {
              /* An ordinary element.  */
-             Lisp_Object event;
+             Lisp_Object event, tem;
 
              if (idx < 0)
                {
-                 s = Fcar_safe (Fcdr_safe (elt));      /* alist */
-                 event = Fcar_safe (elt);
+                 event = Fcar_safe (elt); /* alist */
+                 elt = Fcdr_safe (elt);
                }
              else
                {
-                 s = Fcar_safe (elt);                  /* vector */
-                 XSETINT (event, idx);
+                 XSETINT (event, idx); /* vector */
                }
 
              /* Ignore the element if it has no prompt string.  */
-             if (STRINGP (s) && INTEGERP (event))
+             if (INTEGERP (event) && parse_menu_item (elt, 0, -1))
                {
                  /* 1 if the char to type matches the string.  */
                  int char_matches;
                  Lisp_Object upcased_event, downcased_event;
                  Lisp_Object desc;
+                 Lisp_Object s
+                   = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
 
                  upcased_event = Fupcase (event);
                  downcased_event = Fdowncase (event);
@@ -6081,6 +6227,27 @@ read_char_minibuf_menu_prompt (commandflag, nmaps, maps)
                  if (! char_matches)
                    desc = Fsingle_key_description (event);
 
+                 tem
+                   = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];
+                 if (!NILP (tem))
+                   /* Insert equivalent keybinding. */
+                   s = concat2 (s, tem);
+
+                 tem
+                   = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
+                 if (EQ (tem, QCradio) || EQ (tem, QCtoggle))
+                   {
+                     /* Insert button prefix. */
+                     Lisp_Object selected
+                       = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
+                     if (EQ (tem, QCradio))
+                       tem = build_string (NILP (selected) ? "(*) " : "( ) ");
+                     else
+                       tem = build_string (NILP (selected) ? "[X] " : "[ ] ");
+                     s = concat2 (tem, s);
+                   }
+                 
+
                  /* If we have room for the prompt string, add it to this line.
                     If this is the first on the line, always add it.  */
                  if ((XSTRING (s)->size + i + 2
@@ -8480,6 +8647,8 @@ syms_of_keyboard ()
   Qmouse_wheel = intern ("mouse-wheel");
   staticpro (&Qmouse_wheel);
 #endif
+  Qdrag_n_drop = intern ("drag-n-drop");
+  staticpro (&Qdrag_n_drop);
 
   Qmenu_enable = intern ("menu-enable");
   staticpro (&Qmenu_enable);
@@ -8493,6 +8662,10 @@ syms_of_keyboard ()
   staticpro (&QCfilter);
   QCbutton = intern (":button");
   staticpro (&QCbutton);
+  QCkeys = intern (":keys");
+  staticpro (&QCkeys);
+  QCkey_sequence = intern (":key-sequence");
+  staticpro (&QCkey_sequence);
   QCtoggle = intern (":toggle");
   staticpro (&QCtoggle);
   QCradio = intern (":radio");
@@ -8589,6 +8762,9 @@ syms_of_keyboard ()
 #ifdef WINDOWSNT
   mouse_wheel_syms = Qnil;
   staticpro (&mouse_wheel_syms);
+  
+  drag_n_drop_syms = Qnil;
+  staticpro (&drag_n_drop_syms);
 #endif
 
   unread_switch_frame = Qnil;