changeset 1082:d24afc1bef38

(xmenu_show): If no panes, just return. (Fx_popup_menu): Treat coords relative to spec'd window. (single_keymap_panes): New function; contains guts of keymap_panes. If a command binding for submenu has a prompt string starting with @, make a separate pane for it at this level. (keymap_panes): New function. (Fx_popup_menu): Accept keymap or list of keymaps as MENU argument. Accept mouse button event as POSITION argument.

--- a/src/xmenu.c	Fri Sep 04 23:38:45 1992 +0000
+++ b/src/xmenu.c	Sat Sep 05 00:08:07 1992 +0000
@@ -84,21 +84,30 @@
 
 DEFUN ("x-popup-menu",Fx_popup_menu, Sx_popup_menu, 1, 2, 0,
   "Pop up a deck-of-cards menu and return user's selection.\n\
-ARG is a position specification: a list ((XOFFSET YOFFSET) WINDOW)\n\
+POSITION is a position specification.  This is either a mouse button event\n\
+or a list ((XOFFSET YOFFSET) WINDOW)\n\
 where XOFFSET and YOFFSET are positions in characters from the top left\n\
 corner of WINDOW's frame.  A mouse-event list will serve for this.\n\
 This controls the position of the center of the first line\n\
 in the first pane of the menu, not the top left of the menu as a whole.\n\
 \n\
-MENU is a specifier for a menu.  It is a list of the form\n\
-\(TITLE PANE1 PANE2...), and each pane is a list of form\n\
+MENU is a specifier for a menu.  For the simplest case, MENU is a keymap.\n\
+The menu items come from key bindings that have a menu string as well as\n\
+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\
+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.")
-       (arg, menu)
-     Lisp_Object arg, menu;
+  (position, menu)
+     Lisp_Object position, menu;
 {
   int number_of_panes;
-  Lisp_Object XMenu_return;
+  Lisp_Object XMenu_return, keymap, tem;
   int XMenu_xpos, XMenu_ypos;
   char **menus;
   char ***names;
@@ -111,39 +120,113 @@
   FRAME_PTR f;
   Lisp_Object x, y, window;
 
-  window = Fcar (Fcdr (arg));
-  x = Fcar (Fcar (arg));
-  y = Fcar (Fcdr (Fcar (arg)));
+  /* Decode the first argument: find the window and the coordinates.  */
+  tem = Fcar (position);
+  if (XTYPE (tem) == Lisp_Cons)
+    {
+      window = Fcar (Fcdr (position));
+      x = Fcar (tem);
+      y = Fcar (Fcdr (tem));
+    }
+  else
+    {
+      tem = Fcdr (position);
+      window = Fcar (tem);
+      tem = Fcar (Fcdr (Fcdr (tem)));
+      x = Fcar (tem);
+      y = Fcdr (tem);
+    }
   CHECK_WINDOW (window, 0);
   CHECK_NUMBER (x, 0);
   CHECK_NUMBER (y, 0);
+
   f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
 
-  XMenu_xpos = FONT_WIDTH (f->display.x->font) * XINT (x);
-  XMenu_ypos = FONT_HEIGHT (f->display.x->font) * XINT (y);
+  XMenu_xpos
+    = FONT_WIDTH (f->display.x->font) * (XINT (x) + XWINDOW (window)->left);
+  XMenu_ypos
+    = FONT_HEIGHT (f->display.x->font) * (XINT (y) + XWINDOW (window)->top);
   XMenu_xpos += f->display.x->left_pos;
   XMenu_ypos += f->display.x->top_pos;
 
-  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));
+  keymap = Fkeymapp (menu);
+  tem = Qnil;
+  if (XTYPE (menu) == Lisp_Cons)
+    tem = Fkeymapp (Fcar (menu));
+  if (!NILP (keymap))
+    {
+      /* We were given a keymap.  Extract menu info from the keymap.  */
+      Lisp_Object prompt;
+      keymap = get_keymap (menu);
+
+      /* Search for a string appearing directly as an element of the keymap.
+	 That string is the title of the menu.  */
+      prompt = map_prompt (keymap);
+      if (!NILP (prompt))
+	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);
+      /* The menu title seems to be ignored,
+	 so put it in the pane title.  */
+      if (menus[0] == 0)
+	menus[0] = title;
+    }
+  else if (!NILP (tem))
+    {
+      /* We were given a list of keymaps.  */
+      Lisp_Object prompt;
+      int nmaps = XFASTINT (Flength (menu));
+      Lisp_Object *maps
+	= (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
+      int i;
+      title = 0;
+
+      /* The first keymap that has a prompt string
+	 supplies the menu title.  */
+      for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
+	{
+	  maps[i++] = keymap = get_keymap (Fcar (tem));
+
+	  prompt = map_prompt (keymap);
+	  if (title == 0 && !NILP (prompt))
+	    title = (char *) XSTRING (prompt)->data;
+	}
+
+      /* Extract the detailed info to make one pane.  */
+      number_of_panes = keymap_panes (&obj_list, &menus, &names, &items,
+				      maps, nmaps);
+      /* The menu title seems to be ignored,
+	 so put it in the pane title.  */
+      if (menus[0] == 0)
+	menus[0] = title;
+    }
+  else
+    {
+      /* We were given an old-fashioned menu.  */
+      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));
+    }
 #ifdef XDEBUG
-  fprintf (stderr, "Panes= %d\n", number_of_panes);
-  for (i=0; i < number_of_panes; i++)
+  fprintf (stderr, "Panes = %d\n", number_of_panes);
+  for (i = 0; i < number_of_panes; i++)
     {
-      fprintf (stderr, "Pane %d lines %d title %s\n", i, items[i], menus[i]);
-      for (j=0; j < items[i]; j++)
-	{
-	  fprintf (stderr, "    Item %d %s\n", j, names[i][j]);
-	}
+      fprintf (stderr, "Pane %d has lines %d title %s\n",
+	       i, items[i], menus[i]);
+      for (j = 0; j < items[i]; j++)
+	fprintf (stderr, "    Item %d %s\n", j, names[i][j]);
     }
 #endif
   BLOCK_INPUT;
   selection = xmenu_show (ROOT_WINDOW, XMenu_xpos, XMenu_ypos, names, menus,
-			  items, number_of_panes, obj_list, title, &error_name);
+			  items, number_of_panes, obj_list, title,
+			  &error_name);
   UNBLOCK_INPUT;
-  /** fprintf (stderr, "selection = %x\n", selection);  **/
+  /* fprintf (stderr, "selection = %x\n", selection);  */
   if (selection != NUL)
     {				/* selected something */
       XMenu_return = selection;
@@ -153,7 +236,7 @@
       XMenu_return = Qnil;
     }
   /* now free up the strings */
-  for (i=0; i < number_of_panes; i++)
+  for (i = 0; i < number_of_panes; i++)
     {
       free (names[i]);
       free (obj_list[i]);
@@ -162,7 +245,7 @@
   free (obj_list);
   free (names);
   free (items);
-  /*   free (title); */
+  /* free (title); */
   if (error_name) error (error_name);
   return XMenu_return;
 }
@@ -193,7 +276,10 @@
   char *datap;
   int ulx, uly, width, height;
   int dispwidth, dispheight;
-  
+
+  if (pane_cnt == 0)
+    return 0;
+
   *error = (char *) 0;		/* Initialize error pointer to null */
   GXMenu = XMenuCreate (XDISPLAY parent, "emacs");
   if (GXMenu == NUL)
@@ -202,13 +288,15 @@
       return (0);
     }
   
-  for (panes=0, lines=0; panes < pane_cnt; lines += line_cnt[panes], panes++)
+  for (panes = 0, lines = 0; panes < pane_cnt;
+       lines += line_cnt[panes], panes++)
     ;
   /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */
-  /*datap = (char *) xmalloc (lines * sizeof (char));
+  /* datap = (char *) xmalloc (lines * sizeof (char));
     datap_save = datap;*/
   
-  for (panes = 0, sofar=0;panes < pane_cnt;sofar +=line_cnt[panes], panes++)
+  for (panes = 0, sofar = 0; panes < pane_cnt;
+       sofar += line_cnt[panes], panes++)
     {
       /* create all the necessary panes */
       lpane = XMenuAddPane (XDISPLAY GXMenu, pane_list[panes], TRUE);
@@ -218,7 +306,7 @@
 	  *error = "Can't create pane";
 	  return (0);
 	}
-      for (selidx = 0; selidx < line_cnt[panes] ; selidx++)
+      for (selidx = 0; selidx < line_cnt[panes]; selidx++)
 	{
 	  /* add the selection stuff to the menus */
 	  /* datap[selidx+sofar].pane = panes;
@@ -272,7 +360,7 @@
       entry = item_list[panes][selidx];
       break;
     case XM_FAILURE:
-      /*free (datap_save); */
+      /* free (datap_save); */
       XMenuDestroy (XDISPLAY GXMenu);
       *error = "Can't activate menu";
       /* error ("Can't activate menu"); */
@@ -282,7 +370,7 @@
       break;
     }
   XMenuDestroy (XDISPLAY GXMenu);
-  /*free (datap_save);*/
+  /* free (datap_save);*/
   return (entry);
 }
 
@@ -290,7 +378,176 @@
 {
   defsubr (&Sx_popup_menu);
 }
+
+/* Construct the vectors that describe a menu
+   and store them in *VECTOR, *PANES, *NAMES 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)
+     Lisp_Object ***vector;	/* RETURN all menu objects */
+     char ***panes;		/* RETURN pane names */
+     char ****names;		/* RETURN all line names */
+     int **items;		/* RETURN number of items per pane */
+     Lisp_Object *keymaps;
+     int nmaps;
+{
+  /* Number of panes we have made.  */
+  int p = 0;
+  /* Number of panes we have space for.  */
+  int npanes_allocated = nmaps;
+  int mapno;
+
+  if (npanes_allocated < 4)
+    npanes_allocated = 4;
+
+  /* Make space for an estimated number of panes.  */
+  *vector = (Lisp_Object **) xmalloc (npanes_allocated * sizeof (Lisp_Object *));
+  *panes = (char **) xmalloc (npanes_allocated * sizeof (char *));
+  *items = (int *) xmalloc (npanes_allocated * sizeof (int));
+  *names = (char ***) xmalloc (npanes_allocated * sizeof (char **));
+
+  /* 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, "");
+
+  /* Return the number of panes.  */
+  return p;
+}
+
+/* This is a recursive subroutine of the previous function.
+   It handles one keymap, KEYMAP.
+   The other arguments are passed along
+   or point to local variables of the previous function.  */
+
+single_keymap_panes (keymap, panes, vector, names, items,
+		     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 **items;		/* RETURN number of items per pane */
+     int *p_ptr;
+     int *npanes_allocated_ptr;
+     char *pane_name;
+{
+  int i;
+  Lisp_Object pending_maps;
+  Lisp_Object tail, item, item1, item2, table;
+
+  pending_maps = Qnil;
+
+  /* Make sure we have room for another pane.  */
+  if (*p_ptr == *npanes_allocated_ptr)
+    {
+      *npanes_allocated_ptr *= 2;
+
+      *vector
+	= (Lisp_Object **) xrealloc (*vector,
+				     *npanes_allocated_ptr * sizeof (Lisp_Object *));
+      *panes
+	= (char **) xrealloc (*panes,
+			      *npanes_allocated_ptr * sizeof (char *));
+      *items
+	= (int *) xrealloc (*items,
+			    *npanes_allocated_ptr * sizeof (int));
+      *names
+	= (char ***) xrealloc (*names,
+			       *npanes_allocated_ptr * sizeof (char **));
+    }
+
+  /* When a menu comes from keymaps, don't give names to the panes.  */
+  (*panes)[*p_ptr] = pane_name;
+
+  /* Get the length of the list level of the keymap.  */
+  i = XFASTINT (Flength (keymap));
+
+  /* If the keymap has a dense table, put it in TABLE,
+     and leave only the list level in KEYMAP.
+     Include the length of the dense table in I.  */
+  table = keymap_table (keymap);
+  if (!NILP (table))
+    {
+      i += XFASTINT (Flength (table));
+      keymap = XCONS (XCONS (keymap)->cdr)->cdr;
+    }
+
+  /* Create vectors for the names and values of the items in the pane.
+     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 *));
+
+  /* I is now the index of the next unused slots.  */
+  i = 0;
+  for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
+    {
+      /* Look at each key binding, and if it has a menu string,
+	 make a menu item from it.  */
+      item = XCONS (tail)->car;
+      if (XTYPE (item) == Lisp_Cons)
+	{
+	  item1 = XCONS (item)->cdr;
+	  if (XTYPE (item1) == Lisp_Cons)
+	    {
+	      item2 = XCONS (item1)->car;
+	      if (XTYPE (item2) == Lisp_String)
+		{
+		  Lisp_Object tem;
+		  tem = Fkeymapp (Fcdr (item1));
+		  if (XSTRING (item2)->data[0] == '@' && !NILP (tem))
+		    pending_maps = Fcons (Fcons (Fcdr (item1), item2),
+					  pending_maps);
+		  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;
+		      i++;
+		    }
+		}
+	    }
+	}
+    }
+  /* Record the number of items in the pane.  */
+  (*items)[*p_ptr] = i;
+
+  /* If we just made an empty pane, get rid of it.  */
+  if (i == 0)
+    {
+      free ((*vector)[*p_ptr]);
+      free ((*names)[*p_ptr]);
+    }
+  /* Otherwise, advance past it.  */
+  else
+    (*p_ptr)++;
+
+  /* Process now any submenus which want to be panes at this level.  */
+  while (!NILP (pending_maps))
+    {
+      Lisp_Object elt;
+      elt = Fcar (pending_maps);
+      single_keymap_panes (Fcar (elt), panes, vector, names, items,
+			   p_ptr, npanes_allocated_ptr,
+			   /* Add 1 to discard the @.  */
+			   (char *) XSTRING (XCONS (elt)->cdr)->data + 1);
+      pending_maps = Fcdr (pending_maps);
+    }
+}
+
+/* Construct the vectors that describe a menu
+   and store them in *VECTOR, *PANES, *NAMES 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)
      Lisp_Object ***vector;	/* RETURN all menu objects */
      char ***panes;		/* RETURN pane names */
@@ -303,36 +560,40 @@
   
   if (XTYPE (menu) != Lisp_Cons) menu = wrong_type_argument (Qlistp, menu);
 
-  i= XFASTINT (Flength (menu, 1));
+  i = XFASTINT (Flength (menu));
 
   *vector = (Lisp_Object **) xmalloc (i * sizeof (Lisp_Object *));
   *panes = (char **) xmalloc (i * sizeof (char *));
   *items = (int *) xmalloc (i * sizeof (int));
   *names = (char ***) xmalloc (i * sizeof (char **));
 
-  for (i=0, tail = menu; !NILP (tail); tail = Fcdr (tail), i++)
+  for (i = 0, tail = menu; !NILP (tail); tail = Fcdr (tail), i++)
     {
-       item = Fcdr (Fcar (tail));
-       if (XTYPE (item) != Lisp_Cons) (void) wrong_type_argument (Qlistp, item);
+      item = Fcdr (Fcar (tail));
+      if (XTYPE (item) != Lisp_Cons) (void) wrong_type_argument (Qlistp, item);
 #ifdef XDEBUG
-       fprintf (stderr, "list_of_panes check tail, i=%d\n", i);
+      fprintf (stderr, "list_of_panes check tail, i=%d\n", i);
 #endif
-       item1 = Fcar (Fcar (tail));
-       CHECK_STRING (item1, 1);
+      item1 = Fcar (Fcar (tail));
+      CHECK_STRING (item1, 1);
 #ifdef XDEBUG
-       fprintf (stderr, "list_of_panes check pane, i=%d%s\n", i,
-		XSTRING (item1)->data);
+      fprintf (stderr, "list_of_panes check pane, i=%d%s\n", i,
+	       XSTRING (item1)->data);
 #endif
-       (*panes)[i] = (char *) XSTRING (item1)->data;
-       (*items)[i] = list_of_items ((*vector)+i, (*names)+i, item);
-       /* (*panes)[i] = (char *) xmalloc ((XSTRING (item1)->size)+1);
-	  bcopy (XSTRING (item1)->data, (*panes)[i], XSTRING (item1)->size + 1)
-	  ; */
+      (*panes)[i] = (char *) XSTRING (item1)->data;
+      (*items)[i] = list_of_items ((*vector)+i, (*names)+i, item);
+      /* (*panes)[i] = (char *) xmalloc ((XSTRING (item1)->size)+1);
+	 bcopy (XSTRING (item1)->data, (*panes)[i], XSTRING (item1)->size + 1)
+	 ; */
     }
   return i;
 }
-     
+
+/* 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.  */
 
+int
 list_of_items (vector, names, pane)  /* get list from emacs and put to vector */
      Lisp_Object **vector;	/* RETURN menu "objects" */
      char ***names;		/* RETURN line names */
@@ -343,26 +604,26 @@
 
   if (XTYPE (pane) != Lisp_Cons) pane = wrong_type_argument (Qlistp, pane);
 
-  i= XFASTINT (Flength (pane, 1));
+  i = XFASTINT (Flength (pane, 1));
 
   *vector = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object));
   *names = (char **) xmalloc (i * sizeof (char *));
 
-  for (i=0, tail = pane; !NILP (tail); tail = Fcdr (tail), i++)
+  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);
+      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);
+      fprintf (stderr, "list_of_items check tail, i=%d\n", i);
 #endif
-       (*vector)[i] =  Fcdr (item);
-       item1 = Fcar (item);
-       CHECK_STRING (item1, 1);
+      (*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);
+      fprintf (stderr, "list_of_items check item, i=%d%s\n", i,
+	       XSTRING (item1)->data);
 #endif
-       (*names)[i] = (char *) XSTRING (item1)->data;
+      (*names)[i] = (char *) XSTRING (item1)->data;
     }
   return i;
 }