root/src/menu.c

DEFINITIONS

1. have_boxes
2. init_menu_items
3. finish_menu_items
4. unuse_menu_items
5. discard_menu_items
6. restore_menu_items
7. save_menu_items
8. ensure_menu_items
9. push_submenu_start
10. push_submenu_end
11. push_left_right_boundary
12. push_menu_pane
13. push_menu_item
14. single_keymap_panes
15. single_menu_item
16. keymap_panes
17. encode_menu_string
18. list_of_items
19. list_of_panes
20. parse_single_submenu
21. make_widget_value
22. free_menubar_widget_value_tree
23. digest_single_submenu
24. update_submenu_strings
25. find_and_call_menu_selection
26. find_and_return_menu_selection
27. menu_item_width
28. x_popup_menu_1
29. emulate_dialog_with_menu
30. syms_of_menu

     1 /* Platform-independent code for terminal communications.
     2 
     3 Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2023 Free Software
     4 Foundation, Inc.
     5 
     6 This file is part of GNU Emacs.
     7 
     8 GNU Emacs is free software: you can redistribute it and/or modify
     9 it under the terms of the GNU General Public License as published by
    10 the Free Software Foundation, either version 3 of the License, or (at
    11 your option) any later version.
    12 
    13 GNU Emacs is distributed in the hope that it will be useful,
    14 but WITHOUT ANY WARRANTY; without even the implied warranty of
    15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    16 GNU General Public License for more details.
    17 
    18 You should have received a copy of the GNU General Public License
    19 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
    20 
    21 #include <config.h>
    22 #include <limits.h> /* for INT_MAX */
    23 
    24 #include "lisp.h"
    25 #include "character.h"
    26 #include "coding.h"
    27 #include "dispextern.h"
    28 #include "keyboard.h"
    29 #include "keymap.h"
    30 #include "frame.h"
    31 #include "window.h"
    32 #include "termhooks.h"
    33 #include "blockinput.h"
    34 #include "buffer.h"
    35 
    36 #ifdef HAVE_WINDOW_SYSTEM
    37 #include TERM_HEADER
    38 #endif /* HAVE_WINDOW_SYSTEM */
    39 
    40 #ifdef HAVE_NTGUI
    41 extern AppendMenuW_Proc unicode_append_menu;
    42 #endif /* HAVE_NTGUI  */
    43 
    44 #include "menu.h"
    45 
    46 /* Return non-zero if menus can handle radio and toggle buttons.  */
    47 static bool
    48 have_boxes (void)
    49 {
    50 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI) || defined (HAVE_NS) \
    51   || defined (HAVE_HAIKU)
    52   if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame)))
    53     return 1;
    54 #endif
    55   return 0;
    56 }
    57 
    58 Lisp_Object menu_items;
    59 
    60 /* Whether the global vars defined here are already in use.
    61    Used to detect cases where we try to re-enter this non-reentrant code.  */
    62 bool menu_items_inuse;
    63 
    64 /* Number of slots currently allocated in menu_items.  */
    65 int menu_items_allocated;
    66 
    67 /* This is the index in menu_items of the first empty slot.  */
    68 int menu_items_used;
    69 
    70 /* The number of panes currently recorded in menu_items,
    71    excluding those within submenus.  */
    72 int menu_items_n_panes;
    73 
    74 /* Current depth within submenus.  */
    75 static int menu_items_submenu_depth;
    76 
    77 void
    78 init_menu_items (void)
    79 {
    80   if (menu_items_inuse)
    81     error ("Trying to use a menu from within a menu-entry");
    82 
    83   if (NILP (menu_items))
    84     {
    85       menu_items_allocated = 60;
    86       menu_items = make_nil_vector (menu_items_allocated);
    87     }
    88 
    89   menu_items_inuse = true;
    90   menu_items_used = 0;
    91   menu_items_n_panes = 0;
    92   menu_items_submenu_depth = 0;
    93 }
    94 
    95 /* Call at the end of generating the data in menu_items.  */
    96 
    97 void
    98 finish_menu_items (void)
    99 {
   100 }
   101 
   102 void
   103 unuse_menu_items (void)
   104 {
   105   menu_items_inuse = false;
   106 }
   107 
   108 /* Call when finished using the data for the current menu
   109    in menu_items.  */
   110 
   111 void
   112 discard_menu_items (void)
   113 {
   114   /* Free the structure if it is especially large.
   115      Otherwise, hold on to it, to save time.  */
   116   if (menu_items_allocated > 200)
   117     {
   118       menu_items = Qnil;
   119       menu_items_allocated = 0;
   120     }
   121   eassert (!menu_items_inuse);
   122 }
   123 
   124 /* This undoes save_menu_items, and it is called by the specpdl unwind
   125    mechanism.  */
   126 
   127 static void
   128 restore_menu_items (Lisp_Object saved)
   129 {
   130   menu_items = XCAR (saved);
   131   menu_items_inuse = ! NILP (menu_items);
   132   menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
   133   saved = XCDR (saved);
   134   menu_items_used = XFIXNUM (XCAR (saved));
   135   saved = XCDR (saved);
   136   menu_items_n_panes = XFIXNUM (XCAR (saved));
   137   saved = XCDR (saved);
   138   menu_items_submenu_depth = XFIXNUM (XCAR (saved));
   139 }
   140 
   141 /* Push the whole state of menu_items processing onto the specpdl.
   142    It will be restored when the specpdl is unwound.  */
   143 
   144 void
   145 save_menu_items (void)
   146 {
   147   Lisp_Object saved = list4 (menu_items_inuse ? menu_items : Qnil,
   148                              make_fixnum (menu_items_used),
   149                              make_fixnum (menu_items_n_panes),
   150                              make_fixnum (menu_items_submenu_depth));
   151   record_unwind_protect (restore_menu_items, saved);
   152   menu_items_inuse = false;
   153   menu_items = Qnil;
   154 }
   155 
   156 
   157 /* Ensure that there is room for ITEMS items in the menu_items vector.  */
   158 
   159 static void
   160 ensure_menu_items (int items)
   161 {
   162   int incr = items - (menu_items_allocated - menu_items_used);
   163   if (incr > 0)
   164     {
   165       menu_items = larger_vector (menu_items, incr, INT_MAX);
   166       menu_items_allocated = ASIZE (menu_items);
   167     }
   168 }
   169 
   170 #ifdef HAVE_EXT_MENU_BAR
   171 
   172 /* Begin a submenu.  */
   173 
   174 static void
   175 push_submenu_start (void)
   176 {
   177   ensure_menu_items (1);
   178   ASET (menu_items, menu_items_used, Qnil);
   179   menu_items_used++;
   180   menu_items_submenu_depth++;
   181 }
   182 
   183 /* End a submenu.  */
   184 
   185 static void
   186 push_submenu_end (void)
   187 {
   188   ensure_menu_items (1);
   189   ASET (menu_items, menu_items_used, Qlambda);
   190   menu_items_used++;
   191   menu_items_submenu_depth--;
   192 }
   193 
   194 #endif /* HAVE_EXT_MENU_BAR */
   195 
   196 /* Indicate boundary between left and right.  */
   197 
   198 static void
   199 push_left_right_boundary (void)
   200 {
   201   ensure_menu_items (1);
   202   ASET (menu_items, menu_items_used, Qquote);
   203   menu_items_used++;
   204 }
   205 
   206 /* Start a new menu pane in menu_items.
   207    NAME is the pane name.  PREFIX_VEC is a prefix key for this pane.  */
   208 
   209 static void
   210 push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec)
   211 {
   212   ensure_menu_items (MENU_ITEMS_PANE_LENGTH);
   213   if (menu_items_submenu_depth == 0)
   214     menu_items_n_panes++;
   215   ASET (menu_items, menu_items_used, Qt);
   216   menu_items_used++;
   217   ASET (menu_items, menu_items_used, name);
   218   menu_items_used++;
   219   ASET (menu_items, menu_items_used, prefix_vec);
   220   menu_items_used++;
   221 }
   222 
   223 /* Push one menu item into the current pane.  NAME is the string to
   224    display.  ENABLE if non-nil means this item can be selected.  KEY
   225    is the key generated by choosing this item, or nil if this item
   226    doesn't really have a definition.  DEF is the definition of this
   227    item.  EQUIV is the textual description of the keyboard equivalent
   228    for this item (or nil if none).  TYPE is the type of this menu
   229    item, one of nil, `toggle' or `radio'. */
   230 
   231 static void
   232 push_menu_item (Lisp_Object name, Lisp_Object enable, Lisp_Object key, Lisp_Object def, Lisp_Object equiv, Lisp_Object type, Lisp_Object selected, Lisp_Object help)
   233 {
   234   ensure_menu_items (MENU_ITEMS_ITEM_LENGTH);
   235 
   236   ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_NAME,     name);
   237   ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_ENABLE,   enable);
   238   ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_VALUE,    key);
   239   ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_EQUIV_KEY, equiv);
   240   ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_DEFINITION, def);
   241   ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_TYPE,     type);
   242   ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_SELECTED, selected);
   243   ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_HELP,     help);
   244 
   245   menu_items_used += MENU_ITEMS_ITEM_LENGTH;
   246 }
   247 
   248 /* Args passed between single_keymap_panes and single_menu_item.  */
   249 struct skp
   250   {
   251      Lisp_Object pending_maps;
   252      int maxdepth;
   253      int notbuttons;
   254   };
   255 
   256 static void single_menu_item (Lisp_Object, Lisp_Object, Lisp_Object,
   257                               void *);
   258 
   259 /* This is a recursive subroutine of keymap_panes.
   260    It handles one keymap, KEYMAP.
   261    The other arguments are passed along
   262    or point to local variables of the previous function.
   263 
   264    If we encounter submenus deeper than MAXDEPTH levels, ignore them.  */
   265 
   266 static void
   267 single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
   268                      Lisp_Object prefix, int maxdepth)
   269 {
   270   struct skp skp;
   271 
   272   skp.pending_maps = Qnil;
   273   skp.maxdepth = maxdepth;
   274   skp.notbuttons = 0;
   275 
   276   if (maxdepth <= 0)
   277     return;
   278 
   279   push_menu_pane (pane_name, prefix);
   280 
   281   if (!have_boxes ())
   282     {
   283       /* Remember index for first item in this pane so we can go back
   284          and add a prefix when (if) we see the first button.  After
   285          that, notbuttons is set to 0, to mark that we have seen a
   286          button and all non button items need a prefix.  */
   287       skp.notbuttons = menu_items_used;
   288     }
   289 
   290   map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
   291 
   292   /* Process now any submenus which want to be panes at this level.  */
   293   while (CONSP (skp.pending_maps))
   294     {
   295       Lisp_Object elt, eltcdr, string;
   296       elt = XCAR (skp.pending_maps);
   297       eltcdr = XCDR (elt);
   298       string = XCAR (eltcdr);
   299       /* We no longer discard the @ from the beginning of the string here.
   300          Instead, we do this in *menu_show.  */
   301       single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
   302       skp.pending_maps = XCDR (skp.pending_maps);
   303     }
   304 }
   305 
   306 /* This is a subroutine of single_keymap_panes that handles one
   307    keymap entry.
   308    KEY is a key in a keymap and ITEM is its binding.
   309    SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
   310    separate panes.
   311    If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them.  */
   312 
   313 static void
   314 single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v)
   315 {
   316   Lisp_Object map, item_string, enabled;
   317   bool res;
   318   struct skp *skp = skp_v;
   319 
   320   /* Parse the menu item and leave the result in item_properties.  */
   321   res = parse_menu_item (item, 0);
   322   if (!res)
   323     return;                     /* Not a menu item.  */
   324 
   325   map = AREF (item_properties, ITEM_PROPERTY_MAP);
   326 
   327   enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
   328   item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
   329 
   330   if (!NILP (map) && SREF (item_string, 0) == '@')
   331     {
   332       if (!NILP (enabled))
   333         /* An enabled separate pane. Remember this to handle it later.  */
   334         skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
   335                                    skp->pending_maps);
   336       return;
   337     }
   338 
   339   /* Simulate radio buttons and toggle boxes by putting a prefix in
   340      front of them.  */
   341   if (!have_boxes ())
   342     {
   343       char const *prefix = 0;
   344       Lisp_Object type = AREF (item_properties, ITEM_PROPERTY_TYPE);
   345       if (!NILP (type))
   346         {
   347           Lisp_Object selected
   348             = AREF (item_properties, ITEM_PROPERTY_SELECTED);
   349 
   350           if (skp->notbuttons)
   351             /* The first button. Line up previous items in this menu.  */
   352             {
   353               int idx = skp->notbuttons; /* Index for first item this menu.  */
   354               int submenu = 0;
   355               Lisp_Object tem;
   356               while (idx < menu_items_used)
   357                 {
   358                   tem
   359                     = AREF (menu_items, idx + MENU_ITEMS_ITEM_NAME);
   360                   if (NILP (tem))
   361                     {
   362                       idx++;
   363                       submenu++;                /* Skip sub menu.  */
   364                     }
   365                   else if (EQ (tem, Qlambda))
   366                     {
   367                       idx++;
   368                       submenu--;                /* End sub menu.  */
   369                     }
   370                   else if (EQ (tem, Qt))
   371                     idx += 3;           /* Skip new pane marker. */
   372                   else if (EQ (tem, Qquote))
   373                     idx++;              /* Skip a left, right divider. */
   374                   else
   375                     {
   376                       if (!submenu && SREF (tem, 0) != '\0'
   377                           && SREF (tem, 0) != '-')
   378                         {
   379                           AUTO_STRING (spaces, "    ");
   380                           ASET (menu_items, idx + MENU_ITEMS_ITEM_NAME,
   381                                 concat2 (spaces, tem));
   382                         }
   383                       idx += MENU_ITEMS_ITEM_LENGTH;
   384                     }
   385                 }
   386               skp->notbuttons = 0;
   387             }
   388 
   389           /* Calculate prefix, if any, for this item.  */
   390           if (EQ (type, QCtoggle))
   391             prefix = NILP (selected) ? "[ ] " : "[X] ";
   392           else if (EQ (type, QCradio))
   393             prefix = NILP (selected) ? "( ) " : "(*) ";
   394         }
   395       /* Not a button. If we have earlier buttons, then we need a prefix.  */
   396       else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
   397                && SREF (item_string, 0) != '-')
   398         prefix = "    ";
   399 
   400       if (prefix)
   401         {
   402           AUTO_STRING_WITH_LEN (prefix_obj, prefix, 4);
   403           item_string = concat2 (prefix_obj, item_string);
   404         }
   405   }
   406 
   407   if ((FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame))
   408        || FRAME_MSDOS_P (XFRAME (Vmenu_updating_frame)))
   409       && !NILP (map))
   410     /* Indicate visually that this is a submenu.  */
   411     {
   412       AUTO_STRING (space_gt, " >");
   413       item_string = concat2 (item_string, space_gt);
   414     }
   415 
   416   push_menu_item (item_string, enabled, key,
   417                   AREF (item_properties, ITEM_PROPERTY_DEF),
   418                   AREF (item_properties, ITEM_PROPERTY_KEYEQ),
   419                   AREF (item_properties, ITEM_PROPERTY_TYPE),
   420                   AREF (item_properties, ITEM_PROPERTY_SELECTED),
   421                   AREF (item_properties, ITEM_PROPERTY_HELP));
   422 
   423 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) \
   424   || defined (HAVE_NTGUI) || defined (HAVE_HAIKU) || defined (HAVE_PGTK)
   425   /* Display a submenu using the toolkit.  */
   426   if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame))
   427       && ! (NILP (map) || NILP (enabled)))
   428     {
   429       push_submenu_start ();
   430       single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
   431       push_submenu_end ();
   432     }
   433 #endif
   434 }
   435 
   436 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
   437    and generate menu panes for them in menu_items.  */
   438 
   439 static void
   440 keymap_panes (Lisp_Object *keymaps, ptrdiff_t nmaps)
   441 {
   442   ptrdiff_t mapno;
   443 
   444   init_menu_items ();
   445 
   446   /* Loop over the given keymaps, making a pane for each map.
   447      But don't make a pane that is empty--ignore that map instead.
   448      P is the number of panes we have made so far.  */
   449   for (mapno = 0; mapno < nmaps; mapno++)
   450     single_keymap_panes (keymaps[mapno],
   451                          Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
   452 
   453   finish_menu_items ();
   454 }
   455 
   456 /* Encode a menu string as appropriate for menu-updating-frame's type.  */
   457 static Lisp_Object
   458 encode_menu_string (Lisp_Object str)
   459 {
   460   /* TTY menu strings are encoded by write_glyphs, when they are
   461      delivered to the glass, so no need to encode them here.  */
   462   if (FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame)))
   463     return str;
   464   return ENCODE_MENU_STRING (str);
   465 }
   466 
   467 /* Push the items in a single pane defined by the alist PANE.  */
   468 static void
   469 list_of_items (Lisp_Object pane)
   470 {
   471   Lisp_Object tail, item, item1;
   472 
   473   for (tail = pane; CONSP (tail); tail = XCDR (tail))
   474     {
   475       item = XCAR (tail);
   476       if (STRINGP (item))
   477         push_menu_item (encode_menu_string (item), Qnil, Qnil, Qt,
   478                         Qnil, Qnil, Qnil, Qnil);
   479       else if (CONSP (item))
   480         {
   481           item1 = XCAR (item);
   482           CHECK_STRING (item1);
   483           push_menu_item (encode_menu_string (item1), Qt, XCDR (item),
   484                           Qt, Qnil, Qnil, Qnil, Qnil);
   485         }
   486       else
   487         push_left_right_boundary ();
   488 
   489     }
   490 }
   491 
   492 /* Push all the panes and items of a menu described by the
   493    alist-of-alists MENU.
   494    This handles old-fashioned calls to x-popup-menu.  */
   495 void
   496 list_of_panes (Lisp_Object menu)
   497 {
   498   Lisp_Object tail;
   499 
   500   init_menu_items ();
   501 
   502   for (tail = menu; CONSP (tail); tail = XCDR (tail))
   503     {
   504       Lisp_Object elt, pane_name, pane_data;
   505       elt = XCAR (tail);
   506       pane_name = Fcar (elt);
   507       CHECK_STRING (pane_name);
   508       push_menu_pane (encode_menu_string (pane_name), Qnil);
   509       pane_data = Fcdr (elt);
   510       CHECK_CONS (pane_data);
   511       list_of_items (pane_data);
   512     }
   513 
   514   finish_menu_items ();
   515 }
   516 
   517 /* Set up data in menu_items for a menu bar item
   518    whose event type is ITEM_KEY (with string ITEM_NAME)
   519    and whose contents come from the list of keymaps MAPS.  */
   520 bool
   521 parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name,
   522                       Lisp_Object maps)
   523 {
   524   Lisp_Object *mapvec;
   525   bool top_level_items = 0;
   526   USE_SAFE_ALLOCA;
   527 
   528   ptrdiff_t len = list_length (maps);
   529 
   530   /* Convert the list MAPS into a vector MAPVEC.  */
   531   SAFE_ALLOCA_LISP (mapvec, len);
   532   for (ptrdiff_t i = 0; i < len; i++)
   533     {
   534       mapvec[i] = Fcar (maps);
   535       maps = Fcdr (maps);
   536     }
   537 
   538   /* Loop over the given keymaps, making a pane for each map.
   539      But don't make a pane that is empty--ignore that map instead.  */
   540   for (ptrdiff_t i = 0; i < len; i++)
   541     {
   542       if (!KEYMAPP (mapvec[i]))
   543         {
   544           /* Here we have a command at top level in the menu bar
   545              as opposed to a submenu.  */
   546           top_level_items = 1;
   547           push_menu_pane (Qnil, Qnil);
   548           push_menu_item (item_name, Qt, item_key, mapvec[i],
   549                           Qnil, Qnil, Qnil, Qnil);
   550         }
   551       else
   552         {
   553           Lisp_Object prompt;
   554           prompt = Fkeymap_prompt (mapvec[i]);
   555           single_keymap_panes (mapvec[i],
   556                                !NILP (prompt) ? prompt : item_name,
   557                                item_key, 10);
   558         }
   559     }
   560 
   561   SAFE_FREE ();
   562   return top_level_items;
   563 }
   564 
   565 
   566 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
   567 
   568 /* Allocate and basically initialize widget_value, blocking input.  */
   569 
   570 widget_value *
   571 make_widget_value (const char *name, char *value,
   572                    bool enabled, Lisp_Object help)
   573 {
   574   widget_value *wv;
   575 
   576   block_input ();
   577   wv = xzalloc (sizeof (widget_value));
   578   unblock_input ();
   579 
   580   wv->name = (char *) name;
   581   wv->value = value;
   582   wv->enabled = enabled;
   583   wv->help = help;
   584   return wv;
   585 }
   586 
   587 /* This recursively calls xfree on the tree of widgets.
   588    It must free all data that was malloc'ed for these widget_values.
   589    In Emacs, many slots are pointers into the data of Lisp_Strings, and
   590    must be left alone.  */
   591 
   592 void
   593 free_menubar_widget_value_tree (widget_value *wv)
   594 {
   595   if (! wv) return;
   596 
   597   wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
   598 
   599   if (wv->contents && (wv->contents != (widget_value *) 1))
   600     {
   601       free_menubar_widget_value_tree (wv->contents);
   602       wv->contents = (widget_value *) 0xDEADBEEF;
   603     }
   604   if (wv->next)
   605     {
   606       free_menubar_widget_value_tree (wv->next);
   607       wv->next = (widget_value *) 0xDEADBEEF;
   608     }
   609   block_input ();
   610   xfree (wv);
   611   unblock_input ();
   612 }
   613 
   614 /* Create a tree of widget_value objects
   615    representing the panes and items
   616    in menu_items starting at index START, up to index END.  */
   617 
   618 widget_value *
   619 digest_single_submenu (int start, int end, bool top_level_items)
   620 {
   621   widget_value *wv, *prev_wv, *save_wv, *first_wv;
   622   int i;
   623   int submenu_depth = 0;
   624   widget_value **submenu_stack;
   625   bool panes_seen = 0;
   626   struct frame *f = XFRAME (Vmenu_updating_frame);
   627   USE_SAFE_ALLOCA;
   628 
   629   SAFE_NALLOCA (submenu_stack, 1, menu_items_used);
   630   wv = make_widget_value ("menu", NULL, true, Qnil);
   631   wv->button_type = BUTTON_TYPE_NONE;
   632   first_wv = wv;
   633   save_wv = 0;
   634   prev_wv = 0;
   635 
   636   /* Loop over all panes and items made by the preceding call
   637      to parse_single_submenu and construct a tree of widget_value objects.
   638      Ignore the panes and items used by previous calls to
   639      digest_single_submenu, even though those are also in menu_items.  */
   640   i = start;
   641   while (i < end)
   642     {
   643       if (NILP (AREF (menu_items, i)))
   644         {
   645           submenu_stack[submenu_depth++] = save_wv;
   646           save_wv = prev_wv;
   647           prev_wv = 0;
   648           i++;
   649         }
   650       else if (EQ (AREF (menu_items, i), Qlambda))
   651         {
   652           prev_wv = save_wv;
   653           save_wv = submenu_stack[--submenu_depth];
   654           i++;
   655         }
   656       else if (EQ (AREF (menu_items, i), Qt)
   657                && submenu_depth != 0)
   658         i += MENU_ITEMS_PANE_LENGTH;
   659       /* Ignore a nil in the item list.
   660          It's meaningful only for dialog boxes.  */
   661       else if (EQ (AREF (menu_items, i), Qquote))
   662         i += 1;
   663       else if (EQ (AREF (menu_items, i), Qt))
   664         {
   665           /* Create a new pane.  */
   666           Lisp_Object pane_name;
   667           const char *pane_string;
   668 
   669           panes_seen = 1;
   670 
   671           pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
   672 
   673           /* TTY menus display menu items via tty_write_glyphs, which
   674              will encode the strings as appropriate.  */
   675           if (!FRAME_TERMCAP_P (f))
   676             {
   677 #ifdef HAVE_NTGUI
   678               if (STRINGP (pane_name))
   679                 {
   680                   if (unicode_append_menu)
   681                     /* Encode as UTF-8 for now.  */
   682                     pane_name = ENCODE_UTF_8 (pane_name);
   683                   else if (STRING_MULTIBYTE (pane_name))
   684                     pane_name = ENCODE_SYSTEM (pane_name);
   685 
   686                   ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
   687                 }
   688 #elif defined (USE_LUCID) && (defined USE_CAIRO || defined HAVE_XFT)
   689               if (STRINGP (pane_name))
   690                 {
   691                   pane_name = ENCODE_UTF_8 (pane_name);
   692                   ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
   693                 }
   694 #elif !defined (HAVE_MULTILINGUAL_MENU)
   695               if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
   696                 {
   697                   pane_name = ENCODE_MENU_STRING (pane_name);
   698                   ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
   699                 }
   700 #endif
   701             }
   702 
   703           pane_string = (NILP (pane_name)
   704                          ? "" : SSDATA (pane_name));
   705           /* If there is just one top-level pane, put all its items directly
   706              under the top-level menu.  */
   707           if (menu_items_n_panes == 1)
   708             pane_string = "";
   709 
   710           /* If the pane has a meaningful name,
   711              make the pane a top-level menu item
   712              with its items as a submenu beneath it.  */
   713           if (strcmp (pane_string, ""))
   714             {
   715               /* Set value to 1 so update_submenu_strings can handle '@'.  */
   716               wv = make_widget_value (NULL, (char *) 1, true, Qnil);
   717               if (save_wv)
   718                 save_wv->next = wv;
   719               else
   720                 first_wv->contents = wv;
   721               wv->lname = pane_name;
   722               wv->button_type = BUTTON_TYPE_NONE;
   723               save_wv = wv;
   724             }
   725           else
   726             save_wv = first_wv;
   727 
   728           prev_wv = 0;
   729           i += MENU_ITEMS_PANE_LENGTH;
   730         }
   731       else
   732         {
   733           /* Create a new item within current pane.  */
   734           Lisp_Object item_name, enable, descrip, def, type, selected;
   735           Lisp_Object help;
   736 
   737           /* All items should be contained in panes.  */
   738           if (! panes_seen)
   739             emacs_abort ();
   740 
   741           item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
   742           enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
   743           descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
   744           def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
   745           type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
   746           selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
   747           help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
   748 
   749           /* TTY menu items and their descriptions will be encoded by
   750              tty_write_glyphs.  */
   751           if (!FRAME_TERMCAP_P (f))
   752             {
   753 #ifdef HAVE_NTGUI
   754               if (STRINGP (item_name))
   755                 {
   756                   if (unicode_append_menu)
   757                     item_name = ENCODE_UTF_8 (item_name);
   758                   else if (STRING_MULTIBYTE (item_name))
   759                     item_name = ENCODE_SYSTEM (item_name);
   760 
   761                   ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
   762                 }
   763 
   764               if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
   765                 {
   766                   descrip = ENCODE_SYSTEM (descrip);
   767                   ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
   768                 }
   769 #elif USE_LUCID
   770               if (STRINGP (item_name))
   771                 {
   772                   item_name = ENCODE_UTF_8 (item_name);
   773                   ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
   774                 }
   775 
   776               if (STRINGP (descrip))
   777                 {
   778                   descrip = ENCODE_UTF_8 (descrip);
   779                   ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
   780                 }
   781 #elif !defined (HAVE_MULTILINGUAL_MENU)
   782               if (STRING_MULTIBYTE (item_name))
   783                 {
   784                   item_name = ENCODE_MENU_STRING (item_name);
   785                   ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
   786                 }
   787 
   788               if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
   789                 {
   790                   descrip = ENCODE_MENU_STRING (descrip);
   791                   ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
   792                 }
   793 #endif
   794             }
   795 
   796           wv = make_widget_value (NULL, NULL, !NILP (enable),
   797                                   STRINGP (help) ? help : Qnil);
   798           if (prev_wv)
   799             prev_wv->next = wv;
   800           else
   801             save_wv->contents = wv;
   802 
   803           wv->lname = item_name;
   804           if (!NILP (descrip))
   805             wv->lkey = descrip;
   806           /* The intptr_t cast avoids a warning.  There's no problem
   807              as long as pointers have enough bits to hold small integers.  */
   808           wv->call_data = (!NILP (def) ? (void *) (intptr_t) i : 0);
   809 
   810           if (NILP (type))
   811             wv->button_type = BUTTON_TYPE_NONE;
   812           else if (EQ (type, QCradio))
   813             wv->button_type = BUTTON_TYPE_RADIO;
   814           else if (EQ (type, QCtoggle))
   815             wv->button_type = BUTTON_TYPE_TOGGLE;
   816           else
   817             emacs_abort ();
   818 
   819           wv->selected = !NILP (selected);
   820 
   821           prev_wv = wv;
   822 
   823           i += MENU_ITEMS_ITEM_LENGTH;
   824         }
   825     }
   826 
   827   /* If we have just one "menu item"
   828      that was originally a button, return it by itself.  */
   829   if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
   830     {
   831       wv = first_wv;
   832       first_wv = first_wv->contents;
   833       xfree (wv);
   834     }
   835 
   836   SAFE_FREE ();
   837   return first_wv;
   838 }
   839 
   840 /* Walk through the widget_value tree starting at FIRST_WV and update
   841    the char * pointers from the corresponding lisp values.
   842    We do this after building the whole tree, since GC may happen while the
   843    tree is constructed, and small strings are relocated.  So we must wait
   844    until no GC can happen before storing pointers into lisp values.  */
   845 void
   846 update_submenu_strings (widget_value *first_wv)
   847 {
   848   widget_value *wv;
   849 
   850   for (wv = first_wv; wv; wv = wv->next)
   851     {
   852       if (STRINGP (wv->lname))
   853         {
   854           wv->name = SSDATA (wv->lname);
   855 
   856           /* Ignore the @ that means "separate pane".
   857              This is a kludge, but this isn't worth more time.  */
   858           if (wv->value == (char *)1)
   859             {
   860               if (wv->name[0] == '@')
   861                 wv->name++;
   862               wv->value = 0;
   863             }
   864         }
   865 
   866       if (STRINGP (wv->lkey))
   867         wv->key = SSDATA (wv->lkey);
   868 
   869       if (wv->contents)
   870         update_submenu_strings (wv->contents);
   871     }
   872 }
   873 
   874 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
   875 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) \
   876   || defined (HAVE_NTGUI) || defined (HAVE_HAIKU)
   877 
   878 /* Find the menu selection and store it in the keyboard buffer.
   879    F is the frame the menu is on.
   880    MENU_BAR_ITEMS_USED is the length of VECTOR.
   881    VECTOR is an array of menu events for the whole menu.  */
   882 
   883 void
   884 find_and_call_menu_selection (struct frame *f, int menu_bar_items_used,
   885                               Lisp_Object vector, void *client_data)
   886 {
   887   Lisp_Object prefix, entry;
   888   Lisp_Object *subprefix_stack;
   889   int submenu_depth = 0;
   890   int i;
   891   USE_SAFE_ALLOCA;
   892 
   893   entry = Qnil;
   894   SAFE_NALLOCA (subprefix_stack, 1, menu_bar_items_used);
   895   prefix = Qnil;
   896   i = 0;
   897 
   898   while (i < menu_bar_items_used)
   899     {
   900       if (NILP (AREF (vector, i)))
   901         {
   902           subprefix_stack[submenu_depth++] = prefix;
   903           prefix = entry;
   904           i++;
   905         }
   906       else if (EQ (AREF (vector, i), Qlambda))
   907         {
   908           prefix = subprefix_stack[--submenu_depth];
   909           i++;
   910         }
   911       else if (EQ (AREF (vector, i), Qt))
   912         {
   913           prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
   914           i += MENU_ITEMS_PANE_LENGTH;
   915         }
   916       else
   917         {
   918           entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
   919           /* Treat the pointer as an integer.  There's no problem
   920              as long as pointers have enough bits to hold small integers.  */
   921           if ((intptr_t) client_data == i)
   922             {
   923               int j;
   924               struct input_event buf;
   925               Lisp_Object frame;
   926               EVENT_INIT (buf);
   927 
   928               XSETFRAME (frame, f);
   929               buf.kind = MENU_BAR_EVENT;
   930               buf.frame_or_window = frame;
   931               buf.arg = frame;
   932               kbd_buffer_store_event (&buf);
   933 
   934               for (j = 0; j < submenu_depth; j++)
   935                 if (!NILP (subprefix_stack[j]))
   936                   {
   937                     buf.kind = MENU_BAR_EVENT;
   938                     buf.frame_or_window = frame;
   939                     buf.arg = subprefix_stack[j];
   940                     kbd_buffer_store_event (&buf);
   941                   }
   942 
   943               if (!NILP (prefix))
   944                 {
   945                   buf.kind = MENU_BAR_EVENT;
   946                   buf.frame_or_window = frame;
   947                   buf.arg = prefix;
   948                   kbd_buffer_store_event (&buf);
   949                 }
   950 
   951               buf.kind = MENU_BAR_EVENT;
   952               buf.frame_or_window = frame;
   953               buf.arg = entry;
   954               kbd_buffer_store_event (&buf);
   955 
   956               break;
   957             }
   958           i += MENU_ITEMS_ITEM_LENGTH;
   959         }
   960     }
   961 
   962   SAFE_FREE ();
   963 }
   964 
   965 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI || HAVE_HAIKU */
   966 
   967 #ifdef HAVE_NS
   968 /* As above, but return the menu selection instead of storing in kb buffer.
   969    If KEYMAPS, return full prefixes to selection. */
   970 Lisp_Object
   971 find_and_return_menu_selection (struct frame *f, bool keymaps, void *client_data)
   972 {
   973   Lisp_Object prefix, entry;
   974   int i;
   975   Lisp_Object *subprefix_stack;
   976   int submenu_depth = 0;
   977   USE_SAFE_ALLOCA;
   978 
   979   prefix = entry = Qnil;
   980   i = 0;
   981   SAFE_ALLOCA_LISP (subprefix_stack, menu_items_used);
   982 
   983   while (i < menu_items_used)
   984     {
   985       if (NILP (AREF (menu_items, i)))
   986         {
   987           subprefix_stack[submenu_depth++] = prefix;
   988           prefix = entry;
   989           i++;
   990         }
   991       else if (EQ (AREF (menu_items, i), Qlambda))
   992         {
   993           prefix = subprefix_stack[--submenu_depth];
   994           i++;
   995         }
   996       else if (EQ (AREF (menu_items, i), Qt))
   997         {
   998           prefix
   999             = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
  1000           i += MENU_ITEMS_PANE_LENGTH;
  1001         }
  1002       /* Ignore a nil in the item list.
  1003          It's meaningful only for dialog boxes.  */
  1004       else if (EQ (AREF (menu_items, i), Qquote))
  1005         i += 1;
  1006       else
  1007         {
  1008           entry
  1009             = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
  1010           if (aref_addr (menu_items, i) == client_data)
  1011             {
  1012               if (keymaps)
  1013                 {
  1014                   int j;
  1015 
  1016                   entry = list1 (entry);
  1017                   if (!NILP (prefix))
  1018                     entry = Fcons (prefix, entry);
  1019                   for (j = submenu_depth - 1; j >= 0; j--)
  1020                     if (!NILP (subprefix_stack[j]))
  1021                       entry = Fcons (subprefix_stack[j], entry);
  1022                 }
  1023               SAFE_FREE ();
  1024               return entry;
  1025             }
  1026           i += MENU_ITEMS_ITEM_LENGTH;
  1027         }
  1028     }
  1029   SAFE_FREE ();
  1030   return Qnil;
  1031 }
  1032 #endif  /* HAVE_NS */
  1033 
  1034 ptrdiff_t
  1035 menu_item_width (const unsigned char *str)
  1036 {
  1037   ptrdiff_t len;
  1038   const unsigned char *p;
  1039 
  1040   for (len = 0, p = str; *p; )
  1041     {
  1042       int ch_len, ch = string_char_and_length (p, &ch_len);
  1043       len += CHARACTER_WIDTH (ch);
  1044       p += ch_len;
  1045     }
  1046   return len;
  1047 }
  1048 
  1049 DEFUN ("menu-bar-menu-at-x-y", Fmenu_bar_menu_at_x_y, Smenu_bar_menu_at_x_y,
  1050        2, 3, 0,
  1051        doc: /* Return the menu-bar menu on FRAME at pixel coordinates X, Y.
  1052 X and Y are frame-relative pixel coordinates, assumed to define
  1053 a location within the menu bar.
  1054 If FRAME is nil or omitted, it defaults to the selected frame.
  1055 
  1056 Value is the symbol of the menu at X/Y, or nil if the specified
  1057 coordinates are not within the FRAME's menu bar.  The symbol can
  1058 be used to look up the menu like this:
  1059 
  1060      (lookup-key MAP [menu-bar SYMBOL])
  1061 
  1062 where MAP is either the current global map or the current local map,
  1063 since menu-bar items come from both.
  1064 
  1065 This function can return non-nil only on a text-terminal frame
  1066 or on an X frame that doesn't use any GUI toolkit.  Otherwise,
  1067 Emacs does not manage the menu bar and cannot convert coordinates
  1068 into menu items.  */)
  1069   (Lisp_Object x, Lisp_Object y, Lisp_Object frame)
  1070 {
  1071   int row, col;
  1072   struct frame *f = decode_any_frame (frame);
  1073 
  1074   if (!FRAME_LIVE_P (f))
  1075     return Qnil;
  1076 
  1077   pixel_to_glyph_coords (f, XFIXNUM (x), XFIXNUM (y), &col, &row, NULL, 1);
  1078   if (0 <= row && row < FRAME_MENU_BAR_LINES (f))
  1079     {
  1080       Lisp_Object items, item;
  1081       int i;
  1082 
  1083       /* Find the menu bar item under `col'.  */
  1084       item = Qnil;
  1085       items = FRAME_MENU_BAR_ITEMS (f);
  1086       /* This loop assumes a single menu-bar line, and will fail to
  1087          find an item if it is not in the first line.  Note that
  1088          make_lispy_event in keyboard.c makes the same assumption.  */
  1089       for (i = 0; i < ASIZE (items); i += 4)
  1090         {
  1091           Lisp_Object pos, str;
  1092 
  1093           str = AREF (items, i + 1);
  1094           pos = AREF (items, i + 3);
  1095           if (NILP (str))
  1096             return item;
  1097           if (XFIXNUM (pos) <= col
  1098               /* We use <= so the blank between 2 items on a TTY is
  1099                  considered part of the previous item.  */
  1100               && col <= XFIXNUM (pos) + menu_item_width (SDATA (str)))
  1101             {
  1102               item = AREF (items, i);
  1103               return item;
  1104             }
  1105         }
  1106     }
  1107   return Qnil;
  1108 }
  1109 
  1110 Lisp_Object
  1111 x_popup_menu_1 (Lisp_Object position, Lisp_Object menu)
  1112 {
  1113   Lisp_Object keymap, tem, tem2 = Qnil;
  1114   int xpos = 0, ypos = 0;
  1115   Lisp_Object title;
  1116   const char *error_name = NULL;
  1117   Lisp_Object selection = Qnil;
  1118   struct frame *f;
  1119   Lisp_Object x, y, window;
  1120   int menuflags = 0;
  1121   specpdl_ref specpdl_count = SPECPDL_INDEX ();
  1122 
  1123   if (NILP (position))
  1124     /* This is an obsolete call, which wants us to precompute the
  1125        keybinding equivalents, but we don't do that any more anyway.  */
  1126     return Qnil;
  1127 
  1128   {
  1129     bool get_current_pos_p = 0;
  1130 
  1131     /* Decode the first argument: find the window and the coordinates.  */
  1132     if (EQ (position, Qt)
  1133         || (CONSP (position)
  1134             && (EQ (XCAR (position), Qmenu_bar)
  1135                 || EQ (XCAR (position), Qtab_bar)
  1136                 || (CONSP (XCDR (position))
  1137                     && EQ (XCAR (XCDR (position)), Qtab_bar))
  1138                 || EQ (XCAR (position), Qtool_bar))))
  1139       {
  1140         get_current_pos_p = 1;
  1141       }
  1142     else
  1143       {
  1144         tem = Fcar (position);
  1145         if (CONSP (tem))
  1146           {
  1147             window = Fcar (Fcdr (position));
  1148             x = XCAR (tem);
  1149             y = Fcar (XCDR (tem));
  1150           }
  1151         else
  1152           {
  1153             menuflags |= MENU_FOR_CLICK;
  1154             tem = Fcar (XCDR (position));    /* EVENT_START (position) */
  1155             window = Fcar (tem);             /* POSN_WINDOW (tem) */
  1156             tem2 = Fcar (Fcdr (tem));        /* POSN_POSN (tem) */
  1157             /* The MENU_KBD_NAVIGATION field is set when the menu
  1158                was invoked by F10, which probably means they have no
  1159                mouse.  In that case, we let them switch between
  1160                top-level menu-bar menus by using C-f/C-b and
  1161                horizontal arrow keys, since they cannot click the
  1162                mouse to open a different submenu.  This flag is only
  1163                supported by tty_menu_show.  We set it when POSITION
  1164                and last_nonmenu_event are different, which means we
  1165                constructed POSITION by hand (in popup-menu, see
  1166                menu-bar.el) to look like a mouse click on the menu bar
  1167                event.  */
  1168             if (!EQ (POSN_POSN (last_nonmenu_event),
  1169                      POSN_POSN (position))
  1170                 && CONSP (tem2) && EQ (XCAR (tem2), Qmenu_bar))
  1171               menuflags |= MENU_KBD_NAVIGATION;
  1172             tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
  1173             x = Fcar (tem);
  1174             y = Fcdr (tem);
  1175           }
  1176 
  1177         /* If a click happens in an external tool bar or a detached
  1178            tool bar, x and y is NIL.  In that case, use the current
  1179            mouse position.  This happens for the help button in the
  1180            tool bar.  Ideally popup-menu should pass NIL to
  1181            this function, but it doesn't.  */
  1182         if (NILP (x) && NILP (y))
  1183           get_current_pos_p = 1;
  1184       }
  1185 
  1186     if (get_current_pos_p)
  1187       {
  1188         /* Use the mouse's current position.  */
  1189         struct frame *new_f = SELECTED_FRAME ();
  1190 
  1191         XSETFASTINT (x, 0);
  1192         XSETFASTINT (y, 0);
  1193 #ifdef HAVE_X_WINDOWS
  1194         if (FRAME_X_P (new_f))
  1195           {
  1196             /* Can't use mouse_position_hook for X since it returns
  1197                coordinates relative to the window the mouse is in,
  1198                we need coordinates relative to the edit widget always.  */
  1199             if (new_f != 0)
  1200               {
  1201                 int cur_x, cur_y;
  1202 
  1203                 x_relative_mouse_position (new_f, &cur_x, &cur_y);
  1204                 /* cur_x/y may be negative, so use make_fixnum.  */
  1205                 x = make_fixnum (cur_x);
  1206                 y = make_fixnum (cur_y);
  1207               }
  1208           }
  1209         else
  1210 #endif /* HAVE_X_WINDOWS */
  1211           {
  1212             Lisp_Object bar_window;
  1213             enum scroll_bar_part part;
  1214             Time time;
  1215             void (*mouse_position_hook) (struct frame **, int,
  1216                                          Lisp_Object *,
  1217                                          enum scroll_bar_part *,
  1218                                          Lisp_Object *,
  1219                                          Lisp_Object *,
  1220                                          Time *) =
  1221               FRAME_TERMINAL (new_f)->mouse_position_hook;
  1222 
  1223             if (mouse_position_hook)
  1224               (*mouse_position_hook) (&new_f, 1, &bar_window,
  1225                                       &part, &x, &y, &time);
  1226           }
  1227 
  1228         if (new_f != 0)
  1229           XSETFRAME (window, new_f);
  1230         else
  1231           {
  1232             window = selected_window;
  1233             XSETFASTINT (x, 0);
  1234             XSETFASTINT (y, 0);
  1235           }
  1236       }
  1237 
  1238     /* Decode where to put the menu.  */
  1239 
  1240     if (FRAMEP (window))
  1241       {
  1242         f = XFRAME (window);
  1243         xpos = 0;
  1244         ypos = 0;
  1245       }
  1246     else if (WINDOWP (window))
  1247       {
  1248         struct window *win = XWINDOW (window);
  1249         CHECK_LIVE_WINDOW (window);
  1250         f = XFRAME (WINDOW_FRAME (win));
  1251 
  1252         if (FIXNUMP (tem2))
  1253           {
  1254             /* Clicks in the text area, where TEM2 is a buffer
  1255                position, are relative to the top-left edge of the text
  1256                area, see keyboard.c:make_lispy_position.  */
  1257             xpos = window_box_left (win, TEXT_AREA);
  1258             ypos = (WINDOW_TOP_EDGE_Y (win)
  1259                     + WINDOW_TAB_LINE_HEIGHT (win)
  1260                     + WINDOW_HEADER_LINE_HEIGHT (win));
  1261           }
  1262         else
  1263           {
  1264             xpos = WINDOW_LEFT_EDGE_X (win);
  1265             ypos = WINDOW_TOP_EDGE_Y (win);
  1266           }
  1267       }
  1268     else
  1269       /* ??? Not really clean; should be Qwindow_or_framep
  1270          but I don't want to make one now.  */
  1271       wrong_type_argument (Qwindowp, window);
  1272 
  1273     xpos += check_integer_range (x,
  1274                                  (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
  1275                                   ? (EMACS_INT) INT_MIN - xpos
  1276                                   : MOST_NEGATIVE_FIXNUM),
  1277                                  INT_MAX - xpos);
  1278     ypos += check_integer_range (y,
  1279                                  (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
  1280                                   ? (EMACS_INT) INT_MIN - ypos
  1281                                   : MOST_NEGATIVE_FIXNUM),
  1282                                  INT_MAX - ypos);
  1283 
  1284     XSETFRAME (Vmenu_updating_frame, f);
  1285   }
  1286 
  1287   /* Now parse the lisp menus.  */
  1288   record_unwind_protect_void (unuse_menu_items);
  1289 
  1290   title = Qnil;
  1291 
  1292   /* Decode the menu items from what was specified.  */
  1293 
  1294   keymap = get_keymap (menu, 0, 0);
  1295   if (CONSP (keymap))
  1296     {
  1297       /* We were given a keymap.  Extract menu info from the keymap.  */
  1298       Lisp_Object prompt;
  1299 
  1300       /* Extract the detailed info to make one pane.  */
  1301       keymap_panes (&menu, 1);
  1302 
  1303       /* Search for a string appearing directly as an element of the keymap.
  1304          That string is the title of the menu.  */
  1305       prompt = Fkeymap_prompt (keymap);
  1306 
  1307 #if defined (USE_GTK) || defined (HAVE_NS)
  1308       if (STRINGP (prompt)
  1309           && SCHARS (prompt) > 0
  1310           && !NILP (Fget_text_property (make_fixnum (0), Qhide, prompt)))
  1311         title = Qnil;
  1312       else
  1313 #endif
  1314       if (!NILP (prompt))
  1315         title = prompt;
  1316 
  1317       /* Make that be the pane title of the first pane.  */
  1318       if (!NILP (prompt) && menu_items_n_panes >= 0)
  1319         ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
  1320 
  1321       menuflags |= MENU_KEYMAPS;
  1322     }
  1323   else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
  1324     {
  1325       /* We were given a list of keymaps.  */
  1326       ptrdiff_t nmaps = list_length (menu);
  1327       Lisp_Object *maps;
  1328       ptrdiff_t i;
  1329       USE_SAFE_ALLOCA;
  1330 
  1331       SAFE_ALLOCA_LISP (maps, nmaps);
  1332       title = Qnil;
  1333 
  1334       /* The first keymap that has a prompt string
  1335          supplies the menu title.  */
  1336       for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
  1337         {
  1338           Lisp_Object prompt;
  1339 
  1340           maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
  1341 
  1342           prompt = Fkeymap_prompt (keymap);
  1343           if (NILP (title) && !NILP (prompt))
  1344             title = prompt;
  1345         }
  1346 
  1347       /* Extract the detailed info to make one pane.  */
  1348       keymap_panes (maps, nmaps);
  1349 
  1350       /* Make the title be the pane title of the first pane.  */
  1351       if (!NILP (title) && menu_items_n_panes >= 0)
  1352         ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
  1353 
  1354       menuflags |= MENU_KEYMAPS;
  1355 
  1356       SAFE_FREE ();
  1357     }
  1358   else
  1359     {
  1360       /* We were given an old-fashioned menu.  */
  1361       title = Fcar (menu);
  1362       CHECK_STRING (title);
  1363 
  1364       list_of_panes (Fcdr (menu));
  1365 
  1366       menuflags &= ~MENU_KEYMAPS;
  1367     }
  1368 
  1369   unbind_to (specpdl_count, Qnil);
  1370 
  1371 #ifdef HAVE_WINDOW_SYSTEM
  1372   /* Hide a previous tip, if any.  */
  1373   if (!FRAME_TERMCAP_P (f))
  1374     Fx_hide_tip ();
  1375 #endif
  1376 
  1377 #ifdef HAVE_NTGUI     /* FIXME: Is it really w32-specific?  --Stef  */
  1378   /* If resources from a previous popup menu still exist, does nothing
  1379      until the `menu_free_timer' has freed them (see w32fns.c). This
  1380      can occur if you press ESC or click outside a menu without selecting
  1381      a menu item.
  1382   */
  1383   if (current_popup_menu && FRAME_W32_P (f))
  1384     {
  1385       discard_menu_items ();
  1386       FRAME_DISPLAY_INFO (f)->grabbed = 0;
  1387       return Qnil;
  1388     }
  1389 #endif
  1390 
  1391   record_unwind_protect_void (discard_menu_items);
  1392 
  1393   run_hook (Qx_pre_popup_menu_hook);
  1394 
  1395 #ifdef HAVE_WINDOW_SYSTEM
  1396   /* Cancel the hourglass timer.  Depending on how the show_menu_hook
  1397      is implemented, the hourglass window can either be mapped (or on
  1398      non-X systems, the hourglass cursor can be defined) either while
  1399      the menu is active, or while it is deactivated.  Both situations
  1400      lead to annoying cursor and/or screen flicker and a failure to
  1401      detect input immediately after a popup menu generated by Custom
  1402      is unmapped.  */
  1403   cancel_hourglass ();
  1404 #endif
  1405 
  1406   /* Display them in a menu, but not if F is the initial frame that
  1407      doesn't have its hooks set (e.g., in a batch session), because
  1408      such a frame cannot display menus.  */
  1409   if (!FRAME_INITIAL_P (f))
  1410     selection = FRAME_TERMINAL (f)->menu_show_hook (f, xpos, ypos, menuflags,
  1411                                                     title, &error_name);
  1412 
  1413   unbind_to (specpdl_count, Qnil);
  1414 
  1415 #ifdef HAVE_NTGUI     /* W32 specific because other terminals clear
  1416                          the grab inside their `menu_show_hook's if
  1417                          it's actually required (i.e. there isn't a
  1418                          way to query the buttons currently held down
  1419                          after XMenuActivate). */
  1420   if (FRAME_W32_P (f))
  1421     FRAME_DISPLAY_INFO (f)->grabbed = 0;
  1422 #endif
  1423 
  1424   if (error_name) error ("%s", error_name);
  1425   return selection;
  1426 }
  1427 
  1428 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
  1429        doc: /* Pop up a deck-of-cards menu and return user's selection.
  1430 POSITION is a position specification.  This is either a mouse button event
  1431 or a list ((XOFFSET YOFFSET) WINDOW)
  1432 where XOFFSET and YOFFSET are positions in pixels from the top left
  1433 corner of WINDOW.  (WINDOW may be a window or a frame object.)
  1434 This controls the position of the top left of the menu as a whole.
  1435 If POSITION is t, it means to use the current mouse position.
  1436 
  1437 MENU is a specifier for a menu.  For the simplest case, MENU is a keymap.
  1438 The menu items come from key bindings that have a menu string as well as
  1439 a definition; actually, the "definition" in such a key binding looks like
  1440 \(STRING . REAL-DEFINITION).  To give the menu a title, put a string into
  1441 the keymap as a top-level element.
  1442 
  1443 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
  1444 Otherwise, REAL-DEFINITION should be a valid key binding definition.
  1445 
  1446 You can also use a list of keymaps as MENU.
  1447   Then each keymap makes a separate pane.
  1448 
  1449 When MENU is a keymap or a list of keymaps, the return value is the
  1450 list of events corresponding to the user's choice. Note that
  1451 `x-popup-menu' does not actually execute the command bound to that
  1452 sequence of events.
  1453 
  1454 Alternatively, you can specify a menu of multiple panes
  1455   with a list of the form (TITLE PANE1 PANE2...),
  1456 where each pane is a list of form (TITLE ITEM1 ITEM2...).
  1457 Each ITEM is normally a cons cell (STRING . VALUE);
  1458 but a string can appear as an item--that makes a nonselectable line
  1459 in the menu.
  1460 With this form of menu, the return value is VALUE from the chosen item.
  1461 
  1462 If POSITION is nil, don't display the menu at all, just precalculate the
  1463 cached information about equivalent key sequences.
  1464 
  1465 If the user gets rid of the menu without making a valid choice, for
  1466 instance by clicking the mouse away from a valid choice or by typing
  1467 keyboard input, then this normally results in a quit and
  1468 `x-popup-menu' does not return.  But if POSITION is a mouse button
  1469 event (indicating that the user invoked the menu with the mouse) then
  1470 no quit occurs and `x-popup-menu' returns nil.  */)
  1471   (Lisp_Object position, Lisp_Object menu)
  1472 {
  1473   init_raw_keybuf_count ();
  1474   return x_popup_menu_1 (position, menu);
  1475 }
  1476 
  1477 /* If F's terminal is not capable of displaying a popup dialog,
  1478    emulate it with a menu.  */
  1479 
  1480 static Lisp_Object
  1481 emulate_dialog_with_menu (struct frame *f, Lisp_Object contents)
  1482 {
  1483   Lisp_Object x, y, frame, newpos, prompt = Fcar (contents);
  1484   int x_coord, y_coord;
  1485 
  1486   if (FRAME_WINDOW_P (f))
  1487     {
  1488       x_coord = FRAME_PIXEL_WIDTH (f);
  1489       y_coord = FRAME_PIXEL_HEIGHT (f);
  1490     }
  1491   else
  1492     {
  1493       x_coord = FRAME_COLS (f);
  1494       /* Center the title at frame middle.  (TTY menus have
  1495          their upper-left corner at the given position.)  */
  1496       if (STRINGP (prompt))
  1497         x_coord -= SCHARS (prompt);
  1498       y_coord = FRAME_TOTAL_LINES (f);
  1499     }
  1500 
  1501   XSETFRAME (frame, f);
  1502   XSETINT (x, x_coord / 2);
  1503   XSETINT (y, y_coord / 2);
  1504   newpos = list2 (list2 (x, y), frame);
  1505 
  1506   return Fx_popup_menu (newpos, list2 (prompt, contents));
  1507 }
  1508 
  1509 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
  1510        doc: /* Pop up a dialog box and return user's selection.
  1511 POSITION specifies which frame to use.
  1512 This is normally a mouse button event or a window or frame.
  1513 If POSITION is t, it means to use the frame the mouse is on.
  1514 The dialog box appears in the middle of the specified frame.
  1515 
  1516 CONTENTS specifies the alternatives to display in the dialog box.
  1517 It is a list of the form (DIALOG ITEM1 ITEM2...).
  1518 Each ITEM is a cons cell (STRING . VALUE).
  1519 The return value is VALUE from the chosen item.
  1520 
  1521 An ITEM may also be just a string--that makes a nonselectable item.
  1522 An ITEM may also be nil--that means to put all preceding items
  1523 on the left of the dialog box and all following items on the right.
  1524 \(By default, approximately half appear on each side.)
  1525 
  1526 If HEADER is non-nil, the frame title for the box is "Information",
  1527 otherwise it is "Question".
  1528 
  1529 If the user gets rid of the dialog box without making a valid choice,
  1530 for instance using the window manager, then this produces a quit and
  1531 `x-popup-dialog' does not return.  */)
  1532   (Lisp_Object position, Lisp_Object contents, Lisp_Object header)
  1533 {
  1534   struct frame *f = NULL;
  1535   Lisp_Object window;
  1536 
  1537   /* Decode the first argument: find the window or frame to use.  */
  1538   if (EQ (position, Qt)
  1539       || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
  1540                                || EQ (XCAR (position), Qtab_bar)
  1541                                || EQ (XCAR (position), Qtool_bar))))
  1542     window = selected_window;
  1543   else if (CONSP (position))
  1544     {
  1545       Lisp_Object tem = XCAR (position);
  1546       if (CONSP (tem))
  1547         window = Fcar (XCDR (position));
  1548       else
  1549         {
  1550           tem = Fcar (XCDR (position));  /* EVENT_START (position) */
  1551           window = Fcar (tem);       /* POSN_WINDOW (tem) */
  1552         }
  1553     }
  1554   else if (WINDOWP (position) || FRAMEP (position))
  1555     window = position;
  1556   else
  1557     window = Qnil;
  1558 
  1559   /* Decode where to put the menu.  */
  1560 
  1561   if (FRAMEP (window))
  1562     f = XFRAME (window);
  1563   else if (WINDOWP (window))
  1564     {
  1565       CHECK_LIVE_WINDOW (window);
  1566       f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
  1567     }
  1568   else
  1569     /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
  1570        but I don't want to make one now.  */
  1571     CHECK_WINDOW (window);
  1572 
  1573   /* Note that xw_popup_dialog can call menu code, so
  1574      Vmenu_updating_frame should be set (Bug#17891).  */
  1575   eassume (f && FRAME_LIVE_P (f));
  1576   XSETFRAME (Vmenu_updating_frame, f);
  1577 
  1578   /* Force a redisplay before showing the dialog.  If a frame is created
  1579      just before showing the dialog, its contents may not have been fully
  1580      drawn, as this depends on timing of events from the X server.  Redisplay
  1581      is not done when a dialog is shown.  If redisplay could be done in the
  1582      X event loop (i.e. the X event loop does not run in a signal handler)
  1583      this would not be needed.
  1584 
  1585      Do this before creating the widget value that points to Lisp
  1586      string contents, because Fredisplay may GC and relocate them.  */
  1587   Fredisplay (Qt);
  1588 
  1589   /* Display the popup dialog by a terminal-specific hook ... */
  1590   if (FRAME_TERMINAL (f)->popup_dialog_hook)
  1591     {
  1592       Lisp_Object selection
  1593         = FRAME_TERMINAL (f)->popup_dialog_hook (f, header, contents);
  1594 #ifdef HAVE_NTGUI
  1595       /* NTGUI supports only simple dialogs with Yes/No choices.  For
  1596          other dialogs, it returns the symbol 'unsupported--w32-dialog',
  1597          as a signal for the caller to fall back to the emulation code.  */
  1598       if (!EQ (selection, Qunsupported__w32_dialog))
  1599 #endif
  1600         return selection;
  1601     }
  1602   /* ... or emulate it with a menu.  */
  1603   return emulate_dialog_with_menu (f, contents);
  1604 }
  1605 
  1606 void
  1607 syms_of_menu (void)
  1608 {
  1609   menu_items = Qnil;
  1610   staticpro (&menu_items);
  1611 
  1612   DEFSYM (Qhide, "hide");
  1613   DEFSYM (Qx_pre_popup_menu_hook, "x-pre-popup-menu-hook");
  1614 
  1615   DEFVAR_LISP ("x-pre-popup-menu-hook", Vx_pre_popup_menu_hook,
  1616                doc: /* Hook run before `x-popup-menu' displays a popup menu.
  1617 It is only run before the menu is really going to be displayed.  It
  1618 won't be run if `x-popup-menu' fails or returns for some other reason
  1619 (such as the keymap is invalid).  */);
  1620   Vx_pre_popup_menu_hook = Qnil;
  1621 
  1622   defsubr (&Sx_popup_menu);
  1623   defsubr (&Sx_popup_dialog);
  1624   defsubr (&Smenu_bar_menu_at_x_y);
  1625 }