home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / emacs-19.16 / src / xmenu.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-06-15  |  23.2 KB  |  780 lines
  1. /* X Communication module for terminals which understand the X protocol.
  2.    Copyright (C) 1986, 1988, 1993 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. /* X pop-up deck-of-cards menu facility for gnuemacs.
  21.  *
  22.  * Written by Jon Arnold and Roman Budzianowski
  23.  * Mods and rewrite by Robert Krawitz
  24.  *
  25.  */
  26.  
  27. #ifdef XDEBUG
  28. #include <stdio.h>
  29. #endif
  30.  
  31. /* On 4.3 this loses if it comes after xterm.h.  */
  32. #include <signal.h>
  33. #include "config.h"
  34. #include "lisp.h"
  35. #include "frame.h"
  36. #include "window.h"
  37. #include "keyboard.h"
  38. #include "blockinput.h"
  39.  
  40. /* This may include sys/types.h, and that somehow loses
  41.    if this is not done before the other system files.  */
  42. #include "xterm.h"
  43.  
  44. /* Load sys/types.h if not already loaded.
  45.    In some systems loading it twice is suicidal.  */
  46. #ifndef makedev
  47. #include <sys/types.h>
  48. #endif
  49.  
  50. #include "dispextern.h"
  51.  
  52. #ifdef HAVE_X11
  53. #include "../oldXMenu/XMenu.h"
  54. #else
  55. #include <X/XMenu.h>
  56. #endif
  57.  
  58. #define min(x,y) (((x) < (y)) ? (x) : (y))
  59. #define max(x,y) (((x) > (y)) ? (x) : (y))
  60.  
  61. #define NUL 0
  62.  
  63. #ifndef TRUE
  64. #define TRUE 1
  65. #define FALSE 0
  66. #endif /* TRUE */
  67.  
  68. #ifdef HAVE_X11
  69. extern Display *x_current_display;
  70. #else
  71. #define    ButtonReleaseMask ButtonReleased
  72. #endif /* not HAVE_X11 */
  73.  
  74. extern Lisp_Object Qmenu_enable;
  75. Lisp_Object xmenu_show ();
  76. extern int x_error_handler ();
  77.  
  78. /*************************************************************/
  79.  
  80. #if 0
  81. /* Ignoring the args is easiest.  */
  82. xmenu_quit ()
  83. {
  84.   error ("Unknown XMenu error");
  85. }
  86. #endif
  87.  
  88. DEFUN ("x-popup-menu",Fx_popup_menu, Sx_popup_menu, 1, 2, 0,
  89.   "Pop up a deck-of-cards menu and return user's selection.\n\
  90. POSITION is a position specification.  This is either a mouse button event\n\
  91. or a list ((XOFFSET YOFFSET) WINDOW)\n\
  92. where XOFFSET and YOFFSET are positions in characters from the top left\n\
  93. corner of WINDOW's frame.  (WINDOW may be a frame object instead of a window.)\n\
  94. This controls the position of the center of the first line\n\
  95. in the first pane of the menu, not the top left of the menu as a whole.\n\
  96. \n\
  97. MENU is a specifier for a menu.  For the simplest case, MENU is a keymap.\n\
  98. The menu items come from key bindings that have a menu string as well as\n\
  99. a definition; actually, the \"definition\" in such a key binding looks like\n\
  100. \(STRING . REAL-DEFINITION).  To give the menu a title, put a string into\n\
  101. the keymap as a top-level element.\n\n\
  102. You can also use a list of keymaps as MENU.\n\
  103.   Then each keymap makes a separate pane.\n\
  104. When MENU is a keymap or a list of keymaps, the return value\n\
  105. is a list of events.\n\n\
  106. Alternatively, you can specify a menu of multiple panes\n\
  107.   with a list of the form (TITLE PANE1 PANE2...),\n\
  108. where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
  109. Each ITEM is normally a cons cell (STRING . VALUE);\n\
  110. but a string can appear as an item--that makes a nonselectable line\n\
  111. in the menu.\n\
  112. With this form of menu, the return value is VALUE from the chosen item.")
  113.   (position, menu)
  114.      Lisp_Object position, menu;
  115. {
  116.   int number_of_panes;
  117.   Lisp_Object XMenu_return, keymap, tem;
  118.   int XMenu_xpos, XMenu_ypos;
  119.   char **menus;
  120.   char ***names;
  121.   int **enables;
  122.   Lisp_Object **obj_list;
  123.   Lisp_Object *prefixes;
  124.   int *items;
  125.   char *title;
  126.   char *error_name;
  127.   Lisp_Object ltitle, selection;
  128.   int i, j;
  129.   FRAME_PTR f;
  130.   Lisp_Object x, y, window;
  131.  
  132.   /* Decode the first argument: find the window and the coordinates.  */
  133.   tem = Fcar (position);
  134.   if (XTYPE (tem) == Lisp_Cons)
  135.     {
  136.       window = Fcar (Fcdr (position));
  137.       x = Fcar (tem);
  138.       y = Fcar (Fcdr (tem));
  139.     }
  140.   else
  141.     {
  142.       tem = Fcar (Fcdr (position));  /* EVENT_START (position) */
  143.       window = Fcar (tem);         /* POSN_WINDOW (tem) */
  144.       tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
  145.       x = Fcar (tem);
  146.       y = Fcdr (tem);
  147.     }
  148.   CHECK_NUMBER (x, 0);
  149.   CHECK_NUMBER (y, 0);
  150.  
  151.   if (XTYPE (window) == Lisp_Frame)
  152.     {
  153.       f = XFRAME (window);
  154.  
  155.       XMenu_xpos = 0;
  156.       XMenu_ypos = 0;
  157.     }
  158.   else if (XTYPE (window) == Lisp_Window)
  159.     {
  160.       CHECK_LIVE_WINDOW (window, 0);
  161.       f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
  162.  
  163.       XMenu_xpos = FONT_WIDTH (f->display.x->font) * XWINDOW (window)->left;
  164.       XMenu_ypos = FONT_HEIGHT (f->display.x->font) * XWINDOW (window)->top;
  165.     }
  166.   else
  167.     /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
  168.        but I don't want to make one now.  */
  169.     CHECK_WINDOW (window, 0);
  170.  
  171.   XMenu_xpos += FONT_WIDTH (f->display.x->font) * XINT (x);
  172.   XMenu_ypos += FONT_HEIGHT (f->display.x->font) * XINT (y);
  173.  
  174.   XMenu_xpos += f->display.x->left_pos;
  175.   XMenu_ypos += f->display.x->top_pos;
  176.  
  177.   keymap = Fkeymapp (menu);
  178.   tem = Qnil;
  179.   if (XTYPE (menu) == Lisp_Cons)
  180.     tem = Fkeymapp (Fcar (menu));
  181.   if (!NILP (keymap))
  182.     {
  183.       /* We were given a keymap.  Extract menu info from the keymap.  */
  184.       Lisp_Object prompt;
  185.       keymap = get_keymap (menu);
  186.  
  187.       /* Search for a string appearing directly as an element of the keymap.
  188.      That string is the title of the menu.  */
  189.       prompt = map_prompt (keymap);
  190.       if (!NILP (prompt))
  191.     title = (char *) XSTRING (prompt)->data;
  192.  
  193.       /* Extract the detailed info to make one pane.  */
  194.       number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables,
  195.                       &items, &prefixes, &menu, 1);
  196.       /* The menu title seems to be ignored,
  197.      so put it in the pane title.  */
  198.       if (menus[0] == 0)
  199.     menus[0] = title;
  200.     }
  201.   else if (!NILP (tem))
  202.     {
  203.       /* We were given a list of keymaps.  */
  204.       Lisp_Object prompt;
  205.       int nmaps = XFASTINT (Flength (menu));
  206.       Lisp_Object *maps
  207.     = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
  208.       int i;
  209.       title = 0;
  210.  
  211.       /* The first keymap that has a prompt string
  212.      supplies the menu title.  */
  213.       for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
  214.     {
  215.       maps[i++] = keymap = get_keymap (Fcar (tem));
  216.  
  217.       prompt = map_prompt (keymap);
  218.       if (title == 0 && !NILP (prompt))
  219.         title = (char *) XSTRING (prompt)->data;
  220.     }
  221.  
  222.       /* Extract the detailed info to make one pane.  */
  223.       number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables,
  224.                       &items, &prefixes, maps, nmaps);
  225.       /* The menu title seems to be ignored,
  226.      so put it in the pane title.  */
  227.       if (menus[0] == 0)
  228.     menus[0] = title;
  229.     }
  230.   else
  231.     {
  232.       /* We were given an old-fashioned menu.  */
  233.       ltitle = Fcar (menu);
  234.       CHECK_STRING (ltitle, 1);
  235.       title = (char *) XSTRING (ltitle)->data;
  236.       prefixes = 0;
  237.       number_of_panes = list_of_panes (&obj_list, &menus, &names, &enables,
  238.                        &items, Fcdr (menu));
  239.     }
  240. #ifdef XDEBUG
  241.   fprintf (stderr, "Panes = %d\n", number_of_panes);
  242.   for (i = 0; i < number_of_panes; i++)
  243.     {
  244.       fprintf (stderr, "Pane %d has lines %d title %s\n",
  245.            i, items[i], menus[i]);
  246.       for (j = 0; j < items[i]; j++)
  247.     fprintf (stderr, "    Item %d %s\n", j, names[i][j]);
  248.     }
  249. #endif
  250.   BLOCK_INPUT;
  251.   {
  252.     Window root;
  253.     int root_x, root_y;
  254.     int dummy_int;
  255.     unsigned int dummy_uint;
  256.     Window dummy_window;
  257.  
  258.     /* Figure out which root window F is on.  */
  259.     XGetGeometry (x_current_display, FRAME_X_WINDOW (f), &root,
  260.           &dummy_int, &dummy_int, &dummy_uint, &dummy_uint,
  261.           &dummy_uint, &dummy_uint);
  262.  
  263.     /* Translate the menu co-ordinates within f to menu co-ordinates
  264.        on that root window.  */
  265.     if (! XTranslateCoordinates (x_current_display,
  266.                  FRAME_X_WINDOW (f), root,
  267.                  XMenu_xpos, XMenu_ypos, &root_x, &root_y,
  268.                  &dummy_window))
  269.       /* But XGetGeometry said root was the root window of f's screen!  */ 
  270.       abort ();
  271.  
  272.     selection = xmenu_show (root, XMenu_xpos, XMenu_ypos, names, enables,
  273.                 menus, prefixes, items, number_of_panes, obj_list,
  274.                 title, &error_name);
  275.   }
  276.   UNBLOCK_INPUT;
  277.   /* fprintf (stderr, "selection = %x\n", selection);  */
  278.   if (selection != NUL)
  279.     {                /* selected something */
  280.       XMenu_return = selection;
  281.     }
  282.   else
  283.     {                /* nothing selected */
  284.       XMenu_return = Qnil;
  285.     }
  286.   /* now free up the strings */
  287.   for (i = 0; i < number_of_panes; i++)
  288.     {
  289.       xfree (names[i]);
  290.       xfree (enables[i]);
  291.       xfree (obj_list[i]);
  292.     }
  293.   xfree (menus);
  294.   xfree (obj_list);
  295.   xfree (names);
  296.   xfree (enables);
  297.   xfree (items);
  298.   /* free (title); */
  299.   if (error_name) error (error_name);
  300.   return XMenu_return;
  301. }
  302.  
  303. struct indices {
  304.   int pane;
  305.   int line;
  306. };
  307.  
  308. Lisp_Object
  309. xmenu_show (parent, startx, starty, line_list, enable_list, pane_list,
  310.         prefixes, line_cnt, pane_cnt, item_list, title, error)
  311.      Window parent;        
  312.      int startx, starty;    /* upper left corner position BROKEN */
  313.      char **line_list[];       /* list of strings for items */
  314.      int *enable_list[];       /* list of strings for items */
  315.      char *pane_list[];        /* list of pane titles */
  316.      Lisp_Object *prefixes;    /* Prefix key for each pane */
  317.      char *title;
  318.      int pane_cnt;        /* total number of panes */
  319.      Lisp_Object *item_list[];    /* All items */
  320.      int line_cnt[];        /* Lines in each pane */
  321.      char **error;        /* Error returned */
  322. {
  323.   XMenu *GXMenu;
  324.   int last, panes, selidx, lpane, status;
  325.   int lines, sofar;
  326.   Lisp_Object entry;
  327.   /* struct indices *datap, *datap_save; */
  328.   char *datap;
  329.   int ulx, uly, width, height;
  330.   int dispwidth, dispheight;
  331.  
  332.   *error = 0;
  333.   if (pane_cnt == 0)
  334.     return 0;
  335.  
  336.   BLOCK_INPUT;
  337.   *error = (char *) 0;        /* Initialize error pointer to null */
  338.   GXMenu = XMenuCreate (XDISPLAY parent, "emacs");
  339.   if (GXMenu == NUL)
  340.     {
  341.       *error = "Can't create menu";
  342.       UNBLOCK_INPUT;
  343.       return (0);
  344.     }
  345.   
  346.   for (panes = 0, lines = 0; panes < pane_cnt;
  347.        lines += line_cnt[panes], panes++)
  348.     ;
  349.   /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */
  350.   /* datap = (char *) xmalloc (lines * sizeof (char));
  351.     datap_save = datap;*/
  352.   
  353.   for (panes = 0, sofar = 0; panes < pane_cnt;
  354.        sofar += line_cnt[panes], panes++)
  355.     {
  356.       /* create all the necessary panes */
  357.       lpane = XMenuAddPane (XDISPLAY GXMenu, pane_list[panes], TRUE);
  358.       if (lpane == XM_FAILURE)
  359.     {
  360.       XMenuDestroy (XDISPLAY GXMenu);
  361.       *error = "Can't create pane";
  362.       UNBLOCK_INPUT;
  363.       return (0);
  364.     }
  365.       for (selidx = 0; selidx < line_cnt[panes]; selidx++)
  366.     {
  367.       /* add the selection stuff to the menus */
  368.       /* datap[selidx+sofar].pane = panes;
  369.          datap[selidx+sofar].line = selidx; */
  370.       if (XMenuAddSelection (XDISPLAY GXMenu, lpane, 0,
  371.                  line_list[panes][selidx],
  372.                  enable_list[panes][selidx])
  373.           == XM_FAILURE)
  374.         {
  375.           XMenuDestroy (XDISPLAY GXMenu);
  376.           /* free (datap); */
  377.           *error = "Can't add selection to menu";
  378.           /* error ("Can't add selection to menu"); */
  379.           UNBLOCK_INPUT;
  380.           return (0);
  381.         }
  382.     }
  383.     }
  384.   /* all set and ready to fly */
  385.   XMenuRecompute (XDISPLAY GXMenu);
  386.   dispwidth = DisplayWidth (x_current_display, XDefaultScreen (x_current_display));
  387.   dispheight = DisplayHeight (x_current_display, XDefaultScreen (x_current_display));
  388.   startx = min (startx, dispwidth);
  389.   starty = min (starty, dispheight);
  390.   startx = max (startx, 1);
  391.   starty = max (starty, 1);
  392.   XMenuLocate (XDISPLAY GXMenu, 0, 0, startx, starty,
  393.            &ulx, &uly, &width, &height);
  394.   if (ulx+width > dispwidth)
  395.     {
  396.       startx -= (ulx + width) - dispwidth;
  397.       ulx = dispwidth - width;
  398.     }
  399.   if (uly+height > dispheight)
  400.     {
  401.       starty -= (uly + height) - dispheight;
  402.       uly = dispheight - height;
  403.     }
  404.   if (ulx < 0) startx -= ulx;
  405.   if (uly < 0) starty -= uly;
  406.     
  407.   XMenuSetFreeze (GXMenu, TRUE);
  408.   panes = selidx = 0;
  409.   
  410.   status = XMenuActivate (XDISPLAY GXMenu, &panes, &selidx,
  411.               startx, starty, ButtonReleaseMask, &datap);
  412.   switch (status)
  413.     {
  414.     case XM_SUCCESS:
  415. #ifdef XDEBUG
  416.       fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
  417. #endif
  418.       entry = item_list[panes][selidx];
  419.       if (prefixes != 0)
  420.     {
  421.       entry = Fcons (entry, Qnil);
  422.       if (!NILP (prefixes[panes]))
  423.         entry = Fcons (prefixes[panes], entry);
  424.     }
  425.       break;
  426.     case XM_FAILURE:
  427.       /* free (datap_save); */
  428.       XMenuDestroy (XDISPLAY GXMenu);
  429.       *error = "Can't activate menu";
  430.       /* error ("Can't activate menu"); */
  431.     case XM_IA_SELECT:
  432.     case XM_NO_SELECT:
  433.       entry = Qnil;
  434.       break;
  435.     }
  436.   XMenuDestroy (XDISPLAY GXMenu);
  437.   UNBLOCK_INPUT;
  438.   /* free (datap_save);*/
  439.   return (entry);
  440. }
  441.  
  442. syms_of_xmenu ()
  443. {
  444.   defsubr (&Sx_popup_menu);
  445. }
  446.  
  447. /* Construct the vectors that describe a menu
  448.    and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS.
  449.    Each of those four values is a vector indexed by pane number.
  450.    Return the number of panes.
  451.  
  452.    KEYMAPS is a vector of keymaps.  NMAPS gives the length of KEYMAPS.  */
  453.  
  454. int
  455. keymap_panes (vector, panes, names, enables, items, prefixes, keymaps, nmaps)
  456.      Lisp_Object ***vector;    /* RETURN all menu objects */
  457.      char ***panes;        /* RETURN pane names */
  458.      char ****names;        /* RETURN all line names */
  459.      int ***enables;        /* RETURN enable-flags of lines */
  460.      int **items;        /* RETURN number of items per pane */
  461.      Lisp_Object **prefixes;    /* RETURN vector of prefix keys, per pane */
  462.      Lisp_Object *keymaps;
  463.      int nmaps;
  464. {
  465.   /* Number of panes we have made.  */
  466.   int p = 0;
  467.   /* Number of panes we have space for.  */
  468.   int npanes_allocated = nmaps;
  469.   int mapno;
  470.  
  471.   if (npanes_allocated < 4)
  472.     npanes_allocated = 4;
  473.  
  474.   /* Make space for an estimated number of panes.  */
  475.   *vector = (Lisp_Object **) xmalloc (npanes_allocated * sizeof (Lisp_Object *));
  476.   *panes = (char **) xmalloc (npanes_allocated * sizeof (char *));
  477.   *items = (int *) xmalloc (npanes_allocated * sizeof (int));
  478.   *names = (char ***) xmalloc (npanes_allocated * sizeof (char **));
  479.   *enables = (int **) xmalloc (npanes_allocated * sizeof (int *));
  480.   *prefixes = (Lisp_Object *) xmalloc (npanes_allocated * sizeof (Lisp_Object));
  481.  
  482.   /* Loop over the given keymaps, making a pane for each map.
  483.      But don't make a pane that is empty--ignore that map instead.
  484.      P is the number of panes we have made so far.  */
  485.   for (mapno = 0; mapno < nmaps; mapno++)
  486.     single_keymap_panes (keymaps[mapno], panes, vector, names, enables, items,
  487.              prefixes, &p, &npanes_allocated, "");
  488.  
  489.   /* Return the number of panes.  */
  490.   return p;
  491. }
  492.  
  493. /* This is a recursive subroutine of the previous function.
  494.    It handles one keymap, KEYMAP.
  495.    The other arguments are passed along
  496.    or point to local variables of the previous function.  */
  497.  
  498. single_keymap_panes (keymap, panes, vector, names, enables, items, prefixes,
  499.              p_ptr, npanes_allocated_ptr, pane_name)
  500.      Lisp_Object keymap;
  501.      Lisp_Object ***vector;    /* RETURN all menu objects */
  502.      char ***panes;        /* RETURN pane names */
  503.      char ****names;        /* RETURN all line names */
  504.      int ***enables;        /* RETURN enable flags of lines */
  505.      int **items;        /* RETURN number of items per pane */
  506.      Lisp_Object **prefixes;    /* RETURN vector of prefix keys, per pane */
  507.      int *p_ptr;
  508.      int *npanes_allocated_ptr;
  509.      char *pane_name;
  510. {
  511.   int i;
  512.   Lisp_Object pending_maps;
  513.   Lisp_Object tail, item, item1, item2, table;
  514.  
  515.   pending_maps = Qnil;
  516.  
  517.   /* Make sure we have room for another pane.  */
  518.   if (*p_ptr == *npanes_allocated_ptr)
  519.     {
  520.       *npanes_allocated_ptr *= 2;
  521.  
  522.       *vector
  523.     = (Lisp_Object **) xrealloc (*vector,
  524.                      *npanes_allocated_ptr * sizeof (Lisp_Object *));
  525.       *panes
  526.     = (char **) xrealloc (*panes,
  527.                   *npanes_allocated_ptr * sizeof (char *));
  528.       *items
  529.     = (int *) xrealloc (*items,
  530.                 *npanes_allocated_ptr * sizeof (int));
  531.       *prefixes
  532.     = (Lisp_Object *) xrealloc (*prefixes,
  533.                     (*npanes_allocated_ptr
  534.                      * sizeof (Lisp_Object)));
  535.       *names
  536.     = (char ***) xrealloc (*names,
  537.                    *npanes_allocated_ptr * sizeof (char **));
  538.       *enables
  539.     = (int **) xrealloc (*enables,
  540.                  *npanes_allocated_ptr * sizeof (int *));
  541.     }
  542.  
  543.   /* When a menu comes from keymaps, don't give names to the panes.  */
  544.   (*panes)[*p_ptr] = pane_name;
  545.  
  546.   /* Normally put nil as pane's prefix key.
  547.      Caller will override this if appropriate.  */
  548.   (*prefixes)[*p_ptr] = Qnil;
  549.  
  550.   /* Get the length of the list level of the keymap.  */
  551.   i = XFASTINT (Flength (keymap));
  552.  
  553.   /* Add in lengths of any arrays.  */
  554.   for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
  555.     if (XTYPE (XCONS (tail)->car) == Lisp_Vector)
  556.       i += XVECTOR (XCONS (tail)->car)->size;
  557.  
  558.   /* Create vectors for the names and values of the items in the pane.
  559.      I is an upper bound for the number of items.  */
  560.   (*vector)[*p_ptr] = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object));
  561.   (*names)[*p_ptr] = (char **) xmalloc (i * sizeof (char *));
  562.   (*enables)[*p_ptr] = (int *) xmalloc (i * sizeof (int));
  563.  
  564.   /* I is now the index of the next unused slots.  */
  565.   i = 0;
  566.   for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
  567.     {
  568.       /* Look at each key binding, and if it has a menu string,
  569.      make a menu item from it.  */
  570.       item = XCONS (tail)->car;
  571.       if (XTYPE (item) == Lisp_Cons)
  572.     {
  573.       item1 = XCONS (item)->cdr;
  574.       if (XTYPE (item1) == Lisp_Cons)
  575.         {
  576.           item2 = XCONS (item1)->car;
  577.           if (XTYPE (item2) == Lisp_String)
  578.         {
  579.           Lisp_Object def, tem;
  580.           Lisp_Object enabled;
  581.  
  582.           def = Fcdr (item1);
  583.           enabled = Qt;
  584.           if (XTYPE (def) == Lisp_Symbol)
  585.             {
  586.               /* No property, or nil, means enable.
  587.              Otherwise, enable if value is not nil.  */
  588.               tem = Fget (def, Qmenu_enable);
  589.               if (!NILP (tem))
  590.             enabled = Feval (tem);
  591.             }
  592.           tem = Fkeymapp (def);
  593.           if (XSTRING (item2)->data[0] == '@' && !NILP (tem))
  594.             pending_maps = Fcons (Fcons (def, Fcons (item2, XCONS (item)->car)),
  595.                       pending_maps);
  596.           else
  597.             {
  598.               (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data;
  599.               /* The menu item "value" is the key bound here.  */
  600.               (*vector)[*p_ptr][i] = XCONS (item)->car;
  601.               (*enables)[*p_ptr][i]
  602.             = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0);
  603.               i++;
  604.             }
  605.         }
  606.         }
  607.     }
  608.       else if (XTYPE (item) == Lisp_Vector)
  609.     {
  610.       /* Loop over the char values represented in the vector.  */
  611.       int len = XVECTOR (item)->size;
  612.       int c;
  613.       for (c = 0; c < len; c++)
  614.         {
  615.           Lisp_Object character;
  616.           XFASTINT (character) = c;
  617.           item1 = XVECTOR (item)->contents[c];
  618.           if (XTYPE (item1) == Lisp_Cons)
  619.         {
  620.           item2 = XCONS (item1)->car;
  621.           if (XTYPE (item2) == Lisp_String)
  622.             {
  623.               Lisp_Object tem;
  624.               Lisp_Object def;
  625.               Lisp_Object enabled;
  626.  
  627.               def = Fcdr (item1);
  628.               enabled = Qt;
  629.               if (XTYPE (def) == Lisp_Symbol)
  630.             {
  631.               tem = Fget (def, Qmenu_enable);
  632.               /* No property, or nil, means enable.
  633.                  Otherwise, enable if value is not nil.  */
  634.               if (!NILP (tem))
  635.                 enabled = Feval (tem);
  636.             }
  637.  
  638.               tem = Fkeymapp (def);
  639.               if (XSTRING (item2)->data[0] == '@' && !NILP (tem))
  640.             pending_maps = Fcons (Fcons (def, Fcons (item2, character)),
  641.                           pending_maps);
  642.               else
  643.             {
  644.               (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data;
  645.               /* The menu item "value" is the key bound here.  */
  646.               (*vector)[*p_ptr][i] = character;
  647.               (*enables)[*p_ptr][i]
  648.                 = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0);
  649.               i++;
  650.             }
  651.             }
  652.         }
  653.         }
  654.     }
  655.     }
  656.   /* Record the number of items in the pane.  */
  657.   (*items)[*p_ptr] = i;
  658.  
  659.   /* If we just made an empty pane, get rid of it.  */
  660.   if (i == 0)
  661.     {
  662.       xfree ((*vector)[*p_ptr]);
  663.       xfree ((*names)[*p_ptr]);
  664.       xfree ((*enables)[*p_ptr]);
  665.     }
  666.   /* Otherwise, advance past it.  */
  667.   else
  668.     (*p_ptr)++;
  669.  
  670.   /* Process now any submenus which want to be panes at this level.  */
  671.   while (!NILP (pending_maps))
  672.     {
  673.       Lisp_Object elt, eltcdr;
  674.       int panenum = *p_ptr;
  675.       elt = Fcar (pending_maps);
  676.       eltcdr = XCONS (elt)->cdr;
  677.       single_keymap_panes (Fcar (elt), panes, vector, names, enables, items,
  678.                prefixes, p_ptr, npanes_allocated_ptr,
  679.                /* Add 1 to discard the @.  */
  680.                (char *) XSTRING (XCONS (eltcdr)->car)->data + 1);
  681.       (*prefixes)[panenum] = XCONS (eltcdr)->cdr;
  682.       pending_maps = Fcdr (pending_maps);
  683.     }
  684. }
  685.  
  686. /* Construct the vectors that describe a menu
  687.    and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS.
  688.    Each of those four values is a vector indexed by pane number.
  689.    Return the number of panes.
  690.  
  691.    MENU is the argument that was given to Fx_popup_menu.  */
  692.  
  693. int
  694. list_of_panes (vector, panes, names, enables, items, menu)
  695.      Lisp_Object ***vector;    /* RETURN all menu objects */
  696.      char ***panes;        /* RETURN pane names */
  697.      char ****names;        /* RETURN all line names */
  698.      int ***enables;        /* RETURN enable flags of lines */
  699.      int **items;        /* RETURN number of items per pane */
  700.      Lisp_Object menu;
  701. {
  702.   Lisp_Object tail, item, item1;
  703.   int i;
  704.   
  705.   if (XTYPE (menu) != Lisp_Cons) menu = wrong_type_argument (Qlistp, menu);
  706.  
  707.   i = XFASTINT (Flength (menu));
  708.  
  709.   *vector = (Lisp_Object **) xmalloc (i * sizeof (Lisp_Object *));
  710.   *panes = (char **) xmalloc (i * sizeof (char *));
  711.   *items = (int *) xmalloc (i * sizeof (int));
  712.   *names = (char ***) xmalloc (i * sizeof (char **));
  713.   *enables = (int **) xmalloc (i * sizeof (int *));
  714.  
  715.   for (i = 0, tail = menu; !NILP (tail); tail = Fcdr (tail), i++)
  716.     {
  717.       item = Fcdr (Fcar (tail));
  718.       if (XTYPE (item) != Lisp_Cons) (void) wrong_type_argument (Qlistp, item);
  719. #ifdef XDEBUG
  720.       fprintf (stderr, "list_of_panes check tail, i=%d\n", i);
  721. #endif
  722.       item1 = Fcar (Fcar (tail));
  723.       CHECK_STRING (item1, 1);
  724. #ifdef XDEBUG
  725.       fprintf (stderr, "list_of_panes check pane, i=%d%s\n", i,
  726.            XSTRING (item1)->data);
  727. #endif
  728.       (*panes)[i] = (char *) XSTRING (item1)->data;
  729.       (*items)[i] = list_of_items ((*vector)+i, (*names)+i, (*enables)+i, item);
  730.       /* (*panes)[i] = (char *) xmalloc ((XSTRING (item1)->size)+1);
  731.      bcopy (XSTRING (item1)->data, (*panes)[i], XSTRING (item1)->size + 1)
  732.      ; */
  733.     }
  734.   return i;
  735. }
  736.  
  737. /* Construct the lists of values and names for a single pane, from the
  738.    alist PANE.  Put them in *VECTOR and *NAMES.  Put the enable flags
  739.    int *ENABLES.   Return the number of items.  */
  740.  
  741. int
  742. list_of_items (vector, names, enables, pane)
  743.      Lisp_Object **vector;    /* RETURN menu "objects" */
  744.      char ***names;        /* RETURN line names */
  745.      int **enables;        /* RETURN enable flags of lines */
  746.      Lisp_Object pane;
  747. {
  748.   Lisp_Object tail, item, item1;
  749.   int i;
  750.  
  751.   if (XTYPE (pane) != Lisp_Cons) pane = wrong_type_argument (Qlistp, pane);
  752.  
  753.   i = XFASTINT (Flength (pane));
  754.  
  755.   *vector = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object));
  756.   *names = (char **) xmalloc (i * sizeof (char *));
  757.   *enables = (int *) xmalloc (i * sizeof (int));
  758.  
  759.   for (i = 0, tail = pane; !NILP (tail); tail = Fcdr (tail), i++)
  760.     {
  761.       item = Fcar (tail);
  762.       if (STRINGP (item))
  763.     {
  764.       (*vector)[i] = Qnil;
  765.       (*names)[i] = (char *) XSTRING (item)->data;
  766.       (*enables)[i] = -1;
  767.     }
  768.       else
  769.     {
  770.       CHECK_CONS (item, 0);
  771.       (*vector)[i] = Fcdr (item);
  772.       item1 = Fcar (item);
  773.       CHECK_STRING (item1, 1);
  774.       (*names)[i] = (char *) XSTRING (item1)->data;
  775.       (*enables)[i] = 1;
  776.     }
  777.     }
  778.   return i;
  779. }
  780.