(vendor-key-syms): Set this variable.
[bpt/emacs.git] / src / xmenu.c
index 4d86a62..9fcd49f 100644 (file)
@@ -1,5 +1,5 @@
 /* X Communication module for terminals which understand the X protocol.
-   Copyright (C) 1986, 1988, 1992 Free Software Foundation, Inc.
+   Copyright (C) 1986, 1988, 1993 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -30,11 +30,12 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
 
 /* On 4.3 this loses if it comes after xterm.h.  */
 #include <signal.h>
-#include "config.h"
+#include <config.h>
 #include "lisp.h"
 #include "frame.h"
 #include "window.h"
 #include "keyboard.h"
+#include "blockinput.h"
 
 /* This may include sys/types.h, and that somehow loses
    if this is not done before the other system files.  */
@@ -62,7 +63,7 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
 #ifndef TRUE
 #define TRUE 1
 #define FALSE 0
-#endif TRUE
+#endif /* TRUE */
 
 #ifdef HAVE_X11
 extern Display *x_current_display;
@@ -70,7 +71,7 @@ extern Display *x_current_display;
 #define        ButtonReleaseMask ButtonReleased
 #endif /* not HAVE_X11 */
 
-Lisp_Object Qmenu_enable;
+extern Lisp_Object Qmenu_enable;
 Lisp_Object xmenu_show ();
 extern int x_error_handler ();
 
@@ -99,12 +100,16 @@ a definition; actually, the \"definition\" in such a key binding looks like\n\
 \(STRING . REAL-DEFINITION).  To give the menu a title, put a string into\n\
 the keymap as a top-level element.\n\n\
 You can also use a list of keymaps as MENU.\n\
-  Then each keymap makes a separate pane.\n\n\
+  Then each keymap makes a separate pane.\n\
+When MENU is a keymap or a list of keymaps, the return value\n\
+is a list of events.\n\n\
 Alternatively, you can specify a menu of multiple panes\n\
-  with a list of the form\n\
-\(TITLE PANE1 PANE2...), where each pane is a list of form\n\
-\(TITLE (LINE ITEM)...).  Each line should be a string, and item should\n\
-be the return value for that line (i.e. if it is selected).")
+  with a list of the form (TITLE PANE1 PANE2...),\n\
+where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
+Each ITEM is normally a cons cell (STRING . VALUE);\n\
+but a string can appear as an item--that makes a nonselectable line\n\
+in the menu.\n\
+With this form of menu, the return value is VALUE from the chosen item.")
   (position, menu)
      Lisp_Object position, menu;
 {
@@ -113,7 +118,9 @@ be the return value for that line (i.e. if it is selected).")
   int XMenu_xpos, XMenu_ypos;
   char **menus;
   char ***names;
+  int **enables;
   Lisp_Object **obj_list;
+  Lisp_Object *prefixes;
   int *items;
   char *title;
   char *error_name;
@@ -156,6 +163,38 @@ be the return value for that line (i.e. if it is selected).")
       XMenu_xpos = FONT_WIDTH (f->display.x->font) * XWINDOW (window)->left;
       XMenu_ypos = FONT_HEIGHT (f->display.x->font) * XWINDOW (window)->top;
     }
+  else
+    /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
+       but I don't want to make one now.  */
+    CHECK_WINDOW (window, 0);
+
+#ifdef HAVE_X11
+  {
+    Window child;
+    int win_x = 0, win_y = 0;
+
+    /* Find the position of the outside upper-left corner of
+       the inner window, with respect to the outer window.  */
+    if (f->display.x->parent_desc != ROOT_WINDOW)
+      {
+       BLOCK_INPUT;
+       XTranslateCoordinates (x_current_display,
+
+                              /* From-window, to-window.  */
+                              f->display.x->window_desc,
+                              f->display.x->parent_desc,
+
+                              /* From-position, to-position.  */
+                              0, 0, &win_x, &win_y,
+
+                              /* Child of window.  */
+                              &child);
+       UNBLOCK_INPUT;
+       XMenu_xpos += win_x;
+       XMenu_ypos += win_y;
+      }
+  }
+#endif
 
   XMenu_xpos += FONT_WIDTH (f->display.x->font) * XINT (x);
   XMenu_ypos += FONT_HEIGHT (f->display.x->font) * XINT (y);
@@ -180,8 +219,8 @@ be the return value for that line (i.e. if it is selected).")
        title = (char *) XSTRING (prompt)->data;
 
       /* Extract the detailed info to make one pane.  */
-      number_of_panes = keymap_panes (&obj_list, &menus, &names, &items,
-                                     &menu, 1);
+      number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables,
+                                     &items, &prefixes, &menu, 1);
       /* The menu title seems to be ignored,
         so put it in the pane title.  */
       if (menus[0] == 0)
@@ -209,8 +248,8 @@ be the return value for that line (i.e. if it is selected).")
        }
 
       /* Extract the detailed info to make one pane.  */
-      number_of_panes = keymap_panes (&obj_list, &menus, &names, &items,
-                                     maps, nmaps);
+      number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables,
+                                     &items, &prefixes, maps, nmaps);
       /* The menu title seems to be ignored,
         so put it in the pane title.  */
       if (menus[0] == 0)
@@ -222,8 +261,9 @@ be the return value for that line (i.e. if it is selected).")
       ltitle = Fcar (menu);
       CHECK_STRING (ltitle, 1);
       title = (char *) XSTRING (ltitle)->data;
-      number_of_panes = list_of_panes (&obj_list, &menus, &names, &items,
-                                      Fcdr (menu));
+      prefixes = 0;
+      number_of_panes = list_of_panes (&obj_list, &menus, &names, &enables,
+                                      &items, Fcdr (menu));
     }
 #ifdef XDEBUG
   fprintf (stderr, "Panes = %d\n", number_of_panes);
@@ -257,9 +297,9 @@ be the return value for that line (i.e. if it is selected).")
       /* But XGetGeometry said root was the root window of f's screen!  */ 
       abort ();
 
-    selection = xmenu_show (root, XMenu_xpos, XMenu_ypos, names, menus,
-                           items, number_of_panes, obj_list, title,
-                           &error_name);
+    selection = xmenu_show (root, XMenu_xpos, XMenu_ypos, names, enables,
+                           menus, prefixes, items, number_of_panes, obj_list,
+                           title, &error_name);
   }
   UNBLOCK_INPUT;
   /* fprintf (stderr, "selection = %x\n", selection);  */
@@ -274,13 +314,15 @@ be the return value for that line (i.e. if it is selected).")
   /* now free up the strings */
   for (i = 0; i < number_of_panes; i++)
     {
-      free (names[i]);
-      free (obj_list[i]);
+      xfree (names[i]);
+      xfree (enables[i]);
+      xfree (obj_list[i]);
     }
-  free (menus);
-  free (obj_list);
-  free (names);
-  free (items);
+  xfree (menus);
+  xfree (obj_list);
+  xfree (names);
+  xfree (enables);
+  xfree (items);
   /* free (title); */
   if (error_name) error (error_name);
   return XMenu_return;
@@ -292,12 +334,14 @@ struct indices {
 };
 
 Lisp_Object
-xmenu_show (parent, startx, starty, line_list, pane_list, line_cnt,
-                     pane_cnt, item_list, title, error)
+xmenu_show (parent, startx, starty, line_list, enable_list, pane_list,
+           prefixes, line_cnt, pane_cnt, item_list, title, error)
      Window parent;            
      int startx, starty;       /* upper left corner position BROKEN */
      char **line_list[];       /* list of strings for items */
+     int *enable_list[];       /* list of strings for items */
      char *pane_list[];                /* list of pane titles */
+     Lisp_Object *prefixes;    /* Prefix key for each pane */
      char *title;
      int pane_cnt;             /* total number of panes */
      Lisp_Object *item_list[]; /* All items */
@@ -313,14 +357,17 @@ xmenu_show (parent, startx, starty, line_list, pane_list, line_cnt,
   int ulx, uly, width, height;
   int dispwidth, dispheight;
 
+  *error = 0;
   if (pane_cnt == 0)
     return 0;
 
+  BLOCK_INPUT;
   *error = (char *) 0;         /* Initialize error pointer to null */
   GXMenu = XMenuCreate (XDISPLAY parent, "emacs");
   if (GXMenu == NUL)
     {
       *error = "Can't create menu";
+      UNBLOCK_INPUT;
       return (0);
     }
   
@@ -340,6 +387,7 @@ xmenu_show (parent, startx, starty, line_list, pane_list, line_cnt,
        {
          XMenuDestroy (XDISPLAY GXMenu);
          *error = "Can't create pane";
+         UNBLOCK_INPUT;
          return (0);
        }
       for (selidx = 0; selidx < line_cnt[panes]; selidx++)
@@ -348,13 +396,15 @@ xmenu_show (parent, startx, starty, line_list, pane_list, line_cnt,
          /* datap[selidx+sofar].pane = panes;
             datap[selidx+sofar].line = selidx; */
          if (XMenuAddSelection (XDISPLAY GXMenu, lpane, 0,
-                                line_list[panes][selidx], TRUE)
+                                line_list[panes][selidx],
+                                enable_list[panes][selidx])
              == XM_FAILURE)
            {
              XMenuDestroy (XDISPLAY GXMenu);
              /* free (datap); */
              *error = "Can't add selection to menu";
              /* error ("Can't add selection to menu"); */
+             UNBLOCK_INPUT;
              return (0);
            }
        }
@@ -394,6 +444,12 @@ xmenu_show (parent, startx, starty, line_list, pane_list, line_cnt,
       fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
 #endif
       entry = item_list[panes][selidx];
+      if (prefixes != 0)
+       {
+         entry = Fcons (entry, Qnil);
+         if (!NILP (prefixes[panes]))
+           entry = Fcons (prefixes[panes], entry);
+       }
       break;
     case XM_FAILURE:
       /* free (datap_save); */
@@ -406,31 +462,31 @@ xmenu_show (parent, startx, starty, line_list, pane_list, line_cnt,
       break;
     }
   XMenuDestroy (XDISPLAY GXMenu);
+  UNBLOCK_INPUT;
   /* free (datap_save);*/
   return (entry);
 }
 
 syms_of_xmenu ()
 {
-  Qmenu_enable = intern ("menu-enable");
-
-  staticpro (&Qmenu_enable);
   defsubr (&Sx_popup_menu);
 }
 \f
 /* Construct the vectors that describe a menu
-   and store them in *VECTOR, *PANES, *NAMES and *ITEMS.
+   and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS.
    Each of those four values is a vector indexed by pane number.
    Return the number of panes.
 
    KEYMAPS is a vector of keymaps.  NMAPS gives the length of KEYMAPS.  */
 
 int
-keymap_panes (vector, panes, names, items, keymaps, nmaps)
+keymap_panes (vector, panes, names, enables, items, prefixes, keymaps, nmaps)
      Lisp_Object ***vector;    /* RETURN all menu objects */
      char ***panes;            /* RETURN pane names */
      char ****names;           /* RETURN all line names */
+     int ***enables;           /* RETURN enable-flags of lines */
      int **items;              /* RETURN number of items per pane */
+     Lisp_Object **prefixes;   /* RETURN vector of prefix keys, per pane */
      Lisp_Object *keymaps;
      int nmaps;
 {
@@ -448,13 +504,15 @@ keymap_panes (vector, panes, names, items, keymaps, nmaps)
   *panes = (char **) xmalloc (npanes_allocated * sizeof (char *));
   *items = (int *) xmalloc (npanes_allocated * sizeof (int));
   *names = (char ***) xmalloc (npanes_allocated * sizeof (char **));
+  *enables = (int **) xmalloc (npanes_allocated * sizeof (int *));
+  *prefixes = (Lisp_Object *) xmalloc (npanes_allocated * sizeof (Lisp_Object));
 
   /* Loop over the given keymaps, making a pane for each map.
      But don't make a pane that is empty--ignore that map instead.
      P is the number of panes we have made so far.  */
   for (mapno = 0; mapno < nmaps; mapno++)
-    single_keymap_panes (keymaps[mapno], panes, vector, names, items,
-                        &p, &npanes_allocated, "");
+    single_keymap_panes (keymaps[mapno], panes, vector, names, enables, items,
+                        prefixes, &p, &npanes_allocated, "");
 
   /* Return the number of panes.  */
   return p;
@@ -465,13 +523,15 @@ keymap_panes (vector, panes, names, items, keymaps, nmaps)
    The other arguments are passed along
    or point to local variables of the previous function.  */
 
-single_keymap_panes (keymap, panes, vector, names, items,
+single_keymap_panes (keymap, panes, vector, names, enables, items, prefixes,
                     p_ptr, npanes_allocated_ptr, pane_name)
      Lisp_Object keymap;
      Lisp_Object ***vector;    /* RETURN all menu objects */
      char ***panes;            /* RETURN pane names */
      char ****names;           /* RETURN all line names */
+     int ***enables;           /* RETURN enable flags of lines */
      int **items;              /* RETURN number of items per pane */
+     Lisp_Object **prefixes;   /* RETURN vector of prefix keys, per pane */
      int *p_ptr;
      int *npanes_allocated_ptr;
      char *pane_name;
@@ -496,14 +556,25 @@ single_keymap_panes (keymap, panes, vector, names, items,
       *items
        = (int *) xrealloc (*items,
                            *npanes_allocated_ptr * sizeof (int));
+      *prefixes
+       = (Lisp_Object *) xrealloc (*prefixes,
+                                   (*npanes_allocated_ptr
+                                    * sizeof (Lisp_Object)));
       *names
        = (char ***) xrealloc (*names,
                               *npanes_allocated_ptr * sizeof (char **));
+      *enables
+       = (int **) xrealloc (*enables,
+                            *npanes_allocated_ptr * sizeof (int *));
     }
 
   /* When a menu comes from keymaps, don't give names to the panes.  */
   (*panes)[*p_ptr] = pane_name;
 
+  /* Normally put nil as pane's prefix key.
+     Caller will override this if appropriate.  */
+  (*prefixes)[*p_ptr] = Qnil;
+
   /* Get the length of the list level of the keymap.  */
   i = XFASTINT (Flength (keymap));
 
@@ -516,6 +587,7 @@ single_keymap_panes (keymap, panes, vector, names, items,
      I is an upper bound for the number of items.  */
   (*vector)[*p_ptr] = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object));
   (*names)[*p_ptr] = (char **) xmalloc (i * sizeof (char *));
+  (*enables)[*p_ptr] = (int *) xmalloc (i * sizeof (int));
 
   /* I is now the index of the next unused slots.  */
   i = 0;
@@ -547,13 +619,15 @@ single_keymap_panes (keymap, panes, vector, names, items,
                    }
                  tem = Fkeymapp (def);
                  if (XSTRING (item2)->data[0] == '@' && !NILP (tem))
-                   pending_maps = Fcons (Fcons (def, item2),
+                   pending_maps = Fcons (Fcons (def, Fcons (item2, XCONS (item)->car)),
                                          pending_maps);
-                 else if (!NILP (enabled))
+                 else
                    {
                      (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data;
                      /* The menu item "value" is the key bound here.  */
                      (*vector)[*p_ptr][i] = XCONS (item)->car;
+                     (*enables)[*p_ptr][i]
+                       = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0);
                      i++;
                    }
                }
@@ -591,13 +665,15 @@ single_keymap_panes (keymap, panes, vector, names, items,
 
                      tem = Fkeymapp (def);
                      if (XSTRING (item2)->data[0] == '@' && !NILP (tem))
-                       pending_maps = Fcons (Fcons (def, item2),
+                       pending_maps = Fcons (Fcons (def, Fcons (item2, character)),
                                              pending_maps);
-                     else if (!NILP (enabled))
+                     else
                        {
                          (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data;
                          /* The menu item "value" is the key bound here.  */
                          (*vector)[*p_ptr][i] = character;
+                         (*enables)[*p_ptr][i]
+                           = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0);
                          i++;
                        }
                    }
@@ -611,8 +687,9 @@ single_keymap_panes (keymap, panes, vector, names, items,
   /* If we just made an empty pane, get rid of it.  */
   if (i == 0)
     {
-      free ((*vector)[*p_ptr]);
-      free ((*names)[*p_ptr]);
+      xfree ((*vector)[*p_ptr]);
+      xfree ((*names)[*p_ptr]);
+      xfree ((*enables)[*p_ptr]);
     }
   /* Otherwise, advance past it.  */
   else
@@ -621,28 +698,32 @@ single_keymap_panes (keymap, panes, vector, names, items,
   /* Process now any submenus which want to be panes at this level.  */
   while (!NILP (pending_maps))
     {
-      Lisp_Object elt;
+      Lisp_Object elt, eltcdr;
+      int panenum = *p_ptr;
       elt = Fcar (pending_maps);
-      single_keymap_panes (Fcar (elt), panes, vector, names, items,
-                          p_ptr, npanes_allocated_ptr,
+      eltcdr = XCONS (elt)->cdr;
+      single_keymap_panes (Fcar (elt), panes, vector, names, enables, items,
+                          prefixes, p_ptr, npanes_allocated_ptr,
                           /* Add 1 to discard the @.  */
-                          (char *) XSTRING (XCONS (elt)->cdr)->data + 1);
+                          (char *) XSTRING (XCONS (eltcdr)->car)->data + 1);
+      (*prefixes)[panenum] = XCONS (eltcdr)->cdr;
       pending_maps = Fcdr (pending_maps);
     }
 }
 \f
 /* Construct the vectors that describe a menu
-   and store them in *VECTOR, *PANES, *NAMES and *ITEMS.
+   and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS.
    Each of those four values is a vector indexed by pane number.
    Return the number of panes.
 
    MENU is the argument that was given to Fx_popup_menu.  */
 
 int
-list_of_panes (vector, panes, names, items, menu)
+list_of_panes (vector, panes, names, enables, items, menu)
      Lisp_Object ***vector;    /* RETURN all menu objects */
      char ***panes;            /* RETURN pane names */
      char ****names;           /* RETURN all line names */
+     int ***enables;           /* RETURN enable flags of lines */
      int **items;              /* RETURN number of items per pane */
      Lisp_Object menu;
 {
@@ -657,6 +738,7 @@ list_of_panes (vector, panes, names, items, menu)
   *panes = (char **) xmalloc (i * sizeof (char *));
   *items = (int *) xmalloc (i * sizeof (int));
   *names = (char ***) xmalloc (i * sizeof (char **));
+  *enables = (int **) xmalloc (i * sizeof (int *));
 
   for (i = 0, tail = menu; !NILP (tail); tail = Fcdr (tail), i++)
     {
@@ -672,7 +754,7 @@ list_of_panes (vector, panes, names, items, menu)
               XSTRING (item1)->data);
 #endif
       (*panes)[i] = (char *) XSTRING (item1)->data;
-      (*items)[i] = list_of_items ((*vector)+i, (*names)+i, item);
+      (*items)[i] = list_of_items ((*vector)+i, (*names)+i, (*enables)+i, item);
       /* (*panes)[i] = (char *) xmalloc ((XSTRING (item1)->size)+1);
         bcopy (XSTRING (item1)->data, (*panes)[i], XSTRING (item1)->size + 1)
         ; */
@@ -681,13 +763,14 @@ list_of_panes (vector, panes, names, items, menu)
 }
 \f
 /* Construct the lists of values and names for a single pane, from the
-   alist PANE.  Put them in *VECTOR and *NAMES.
-   Return the number of items.  */
+   alist PANE.  Put them in *VECTOR and *NAMES.  Put the enable flags
+   int *ENABLES.   Return the number of items.  */
 
 int
-list_of_items (vector, names, pane)  /* get list from emacs and put to vector */
+list_of_items (vector, names, enables, pane)
      Lisp_Object **vector;     /* RETURN menu "objects" */
      char ***names;            /* RETURN line names */
+     int **enables;            /* RETURN enable flags of lines */
      Lisp_Object pane;
 {
   Lisp_Object tail, item, item1;
@@ -699,22 +782,26 @@ list_of_items (vector, names, pane)  /* get list from emacs and put to vector */
 
   *vector = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object));
   *names = (char **) xmalloc (i * sizeof (char *));
+  *enables = (int *) xmalloc (i * sizeof (int));
 
   for (i = 0, tail = pane; !NILP (tail); tail = Fcdr (tail), i++)
     {
       item = Fcar (tail);
-      if (XTYPE (item) != Lisp_Cons) (void) wrong_type_argument (Qlistp, item);
-#ifdef XDEBUG
-      fprintf (stderr, "list_of_items check tail, i=%d\n", i);
-#endif
-      (*vector)[i] =  Fcdr (item);
-      item1 = Fcar (item);
-      CHECK_STRING (item1, 1);
-#ifdef XDEBUG
-      fprintf (stderr, "list_of_items check item, i=%d%s\n", i,
-              XSTRING (item1)->data);
-#endif
-      (*names)[i] = (char *) XSTRING (item1)->data;
+      if (STRINGP (item))
+       {
+         (*vector)[i] = Qnil;
+         (*names)[i] = (char *) XSTRING (item)->data;
+         (*enables)[i] = -1;
+       }
+      else
+       {
+         CHECK_CONS (item, 0);
+         (*vector)[i] = Fcdr (item);
+         item1 = Fcar (item);
+         CHECK_STRING (item1, 1);
+         (*names)[i] = (char *) XSTRING (item1)->data;
+         (*enables)[i] = 1;
+       }
     }
   return i;
 }