src/w32menu.c

   1 /* Menu support for GNU Emacs on the Microsoft W32 API.
   2    Copyright (C) 1986, 1988, 1993, 1994 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, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21 /* Written by Kevin Gallo.  */
  22
  23 #include <signal.h>
  24 #include <config.h>
  25
  26 #include <stdio.h>
  27 #include "lisp.h"
  28 #include "termhooks.h"
  29 #include "frame.h"
  30 #include "window.h"
  31 #include "keyboard.h"
  32 #include "blockinput.h"
  33 #include "buffer.h"
  34
  35 /* This may include sys/types.h, and that somehow loses
  36    if this is not done before the other system files.  */
  37 #include "w32term.h"
  38
  39 /* Load sys/types.h if not already loaded.
  40    In some systems loading it twice is suicidal.  */
  41 #ifndef makedev
  42 #include <sys/types.h>
  43 #endif
  44
  45 #include "dispextern.h"
  46
  47 #define min(x, y) (((x) < (y)) ? (x) : (y))
  48 #define max(x, y) (((x) > (y)) ? (x) : (y))
  49
  50 typedef struct menu_map
  51 {
  52   Lisp_Object menu_items;
  53   int menu_items_allocated;
  54   int menu_items_used;
  55 } menu_map;
  56
  57 Lisp_Object Qdebug_on_next_call;
  58
  59 extern Lisp_Object Qmenu_enable;
  60 extern Lisp_Object Qmenu_bar;
  61
  62 extern Lisp_Object Voverriding_local_map;
  63 extern Lisp_Object Voverriding_local_map_menu_flag;
  64
  65 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
  66
  67 extern Lisp_Object Qmenu_bar_update_hook;
  68
  69 static Lisp_Object w32_dialog_show ();
  70 static Lisp_Object w32menu_show ();
  71
  72 static HMENU keymap_panes ();
  73 static HMENU single_keymap_panes ();
  74 static HMENU list_of_panes ();
  75 static HMENU list_of_items ();
  76
  77 static HMENU create_menu_items ();
  78
  79 /* Initialize the menu_items structure if we haven't already done so.
  80    Also mark it as currently empty.  */
  81
  82 static void
  83 init_menu_items (lpmm)
  84      menu_map * lpmm;
  85 {
  86   if (NILP (lpmm->menu_items))
  87     {
  88       lpmm->menu_items_allocated = 60;
  89       lpmm->menu_items = Fmake_vector (make_number (lpmm->menu_items_allocated),
  90                                        Qnil);
  91     }
  92
  93   lpmm->menu_items_used = 0;
  94 }
  95
  96 /* Call when finished using the data for the current menu
  97    in menu_items.  */
  98
  99 static void
 100 discard_menu_items (lpmm)
 101      menu_map * lpmm;
 102 {
 103   lpmm->menu_items = Qnil;
 104   lpmm->menu_items_allocated = lpmm->menu_items_used = 0;
 105 }
 106
 107 /* Make the menu_items vector twice as large.  */
 108
 109 static void
 110 grow_menu_items (lpmm)
 111      menu_map * lpmm;
 112 {
 113   Lisp_Object new;
 114   int old_size = lpmm->menu_items_allocated;
 115
 116   lpmm->menu_items_allocated *= 2;
 117   new = Fmake_vector (make_number (lpmm->menu_items_allocated), Qnil);
 118   bcopy (XVECTOR (lpmm->menu_items)->contents, XVECTOR (new)->contents,
 119          old_size * sizeof (Lisp_Object));
 120
 121   lpmm->menu_items = new;
 122 }
 123
 124 /* Indicate boundary between left and right.  */
 125
 126 static void
 127 add_left_right_boundary (hmenu)
 128      HMENU hmenu;
 129 {
 130   AppendMenu (hmenu, MF_MENUBARBREAK, 0, NULL);
 131 }
 132
 133 /* Push one menu item into the current pane.
 134    NAME is the string to display.  ENABLE if non-nil means
 135    this item can be selected.  KEY is the key generated by
 136    choosing this item.  EQUIV is the textual description
 137    of the keyboard equivalent for this item (or nil if none).  */
 138
 139 static void
 140 add_menu_item (lpmm, hmenu, name, enable, key)
 141      menu_map * lpmm;
 142      HMENU hmenu;
 143      Lisp_Object name;
 144      UINT enable;
 145      Lisp_Object key;
 146 {
 147   UINT fuFlags;
 148
 149   if (NILP (name)
 150       || ((char *) XSTRING (name)->data)[0] == 0
 151       || strcmp ((char *) XSTRING (name)->data, "--") == 0)
 152     fuFlags = MF_SEPARATOR;
 153   else if (enable)
 154     fuFlags = MF_STRING;
 155   else
 156     fuFlags = MF_STRING | MF_GRAYED;
 157
 158   AppendMenu (hmenu,
 159               fuFlags,
 160               lpmm->menu_items_used + 1,
 161               (fuFlags == MF_SEPARATOR)?NULL: (char *) XSTRING (name)->data);
 162
 163   lpmm->menu_items_used++;
 164 #if 0
 165   if (lpmm->menu_items_used >= lpmm->menu_items_allocated)
 166     grow_menu_items (lpmm);
 167
 168   XSET (XVECTOR (lpmm->menu_items)->contents[lpmm->menu_items_used++],
 169         Lisp_Cons,
 170         key);
 171 #endif
 172 }
 173 \f
 174 /* Figure out the current keyboard equivalent of a menu item ITEM1.
 175    The item string for menu display should be ITEM_STRING.
 176    Store the equivalent keyboard key sequence's
 177    textual description into *DESCRIP_PTR.
 178    Also cache them in the item itself.
 179    Return the real definition to execute.  */
 180
 181 static Lisp_Object
 182 menu_item_equiv_key (item_string, item1, descrip_ptr)
 183      Lisp_Object item_string;
 184      Lisp_Object item1;
 185      Lisp_Object *descrip_ptr;
 186 {
 187   /* This is the real definition--the function to run.  */
 188   Lisp_Object def;
 189   /* This is the sublist that records cached equiv key data
 190      so we can save time.  */
 191   Lisp_Object cachelist;
 192   /* These are the saved equivalent keyboard key sequence
 193      and its key-description.  */
 194   Lisp_Object savedkey, descrip;
 195   Lisp_Object def1;
 196   int changed = 0;
 197   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 198
 199   /* If a help string follows the item string, skip it.  */
 200   if (CONSP (XCONS (item1)->cdr)
 201       && STRINGP (XCONS (XCONS (item1)->cdr)->car))
 202     item1 = XCONS (item1)->cdr;
 203
 204   def = Fcdr (item1);
 205
 206   /* Get out the saved equivalent-keyboard-key info.  */
 207   cachelist = savedkey = descrip = Qnil;
 208   if (CONSP (def) && CONSP (XCONS (def)->car)
 209       && (NILP (XCONS (XCONS (def)->car)->car)
 210           || VECTORP (XCONS (XCONS (def)->car)->car)))
 211     {
 212       cachelist = XCONS (def)->car;
 213       def = XCONS (def)->cdr;
 214       savedkey = XCONS (cachelist)->car;
 215       descrip = XCONS (cachelist)->cdr;
 216     }
 217
 218   GCPRO4 (def, def1, savedkey, descrip);
 219
 220   /* Is it still valid?  */
 221   def1 = Qnil;
 222   if (!NILP (savedkey))
 223     def1 = Fkey_binding (savedkey, Qnil);
 224   /* If not, update it.  */
 225   if (! EQ (def1, def)
 226       /* If the command is an alias for another
 227          (such as easymenu.el and lmenu.el set it up),
 228          check if the original command matches the cached command. */
 229       && !(SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)
 230            && EQ (def1, XSYMBOL (def)->function))
 231       /* If something had no key binding before, don't recheck it--
 232          doing that takes too much time and makes menus too slow.  */
 233       && !(!NILP (cachelist) && NILP (savedkey)))
 234     {
 235       changed = 1;
 236       descrip = Qnil;
 237       savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil);
 238       /* If the command is an alias for another
 239          (such as easymenu.el and lmenu.el set it up),
 240          see if the original command name has equivalent keys.  */
 241       if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function))
 242         savedkey = Fwhere_is_internal (XSYMBOL (def)->function,
 243                                        Qnil, Qt, Qnil);
 244
 245       if (VECTORP (savedkey)
 246           && EQ (XVECTOR (savedkey)->contents[0], Qmenu_bar))
 247         savedkey = Qnil;
 248       if (!NILP (savedkey))
 249         {
 250           descrip = Fkey_description (savedkey);
 251           descrip = concat2 (make_string ("  (", 3), descrip);
 252           descrip = concat2 (descrip, make_string (")", 1));
 253         }
 254     }
 255
 256   /* Cache the data we just got in a sublist of the menu binding.  */
 257   if (NILP (cachelist))
 258     XCONS (item1)->cdr = Fcons (Fcons (savedkey, descrip), def);
 259   else if (changed)
 260     {
 261       XCONS (cachelist)->car = savedkey;
 262       XCONS (cachelist)->cdr = descrip;
 263     }
 264
 265   UNGCPRO;
 266   *descrip_ptr = descrip;
 267   return def;
 268 }
 269
 270 /* This is used as the handler when calling internal_condition_case_1.  */
 271
 272 static Lisp_Object
 273 menu_item_enabled_p_1 (arg)
 274      Lisp_Object arg;
 275 {
 276   return Qnil;
 277 }
 278
 279 /* Return non-nil if the command DEF is enabled when used as a menu item.
 280    This is based on looking for a menu-enable property.
 281    If NOTREAL is set, don't bother really computing this.  */
 282
 283 static Lisp_Object
 284 menu_item_enabled_p (def, notreal)
 285      Lisp_Object def;
 286 {
 287   Lisp_Object enabled, tem;
 288
 289   enabled = Qt;
 290   if (notreal)
 291     return enabled;
 292   if (XTYPE (def) == Lisp_Symbol)
 293     {
 294       /* No property, or nil, means enable.
 295          Otherwise, enable if value is not nil.  */
 296       tem = Fget (def, Qmenu_enable);
 297       if (!NILP (tem))
 298         /* (condition-case nil (eval tem)
 299            (error nil))  */
 300         enabled = internal_condition_case_1 (Feval, tem, Qerror,
 301                                              menu_item_enabled_p_1);
 302     }
 303   return enabled;
 304 }
 305 \f
 306 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
 307    and generate menu panes for them in menu_items.
 308    If NOTREAL is nonzero,
 309    don't bother really computing whether an item is enabled.  */
 310
 311 static HMENU
 312 keymap_panes (lpmm, keymaps, nmaps, notreal)
 313      menu_map * lpmm;
 314      Lisp_Object *keymaps;
 315      int nmaps;
 316      int notreal;
 317 {
 318   int mapno;
 319
 320   //    init_menu_items (lpmm);
 321
 322   if (nmaps > 1)
 323     {
 324       HMENU hmenu;
 325
 326       if (!notreal)
 327         {
 328           hmenu = CreateMenu ();
 329
 330           if (!hmenu) return (NULL);
 331         }
 332       else
 333         {
 334           hmenu = NULL;
 335         }
 336
 337       /* Loop over the given keymaps, making a pane for each map.
 338          But don't make a pane that is empty--ignore that map instead.
 339          P is the number of panes we have made so far.  */
 340       for (mapno = 0; mapno < nmaps; mapno++)
 341         {
 342           HMENU new_hmenu;
 343
 344           new_hmenu = single_keymap_panes (lpmm, keymaps[mapno],
 345                                            Qnil, Qnil, notreal);
 346
 347           if (!notreal && new_hmenu)
 348             {
 349               AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, "");
 350             }
 351         }
 352
 353         return (hmenu);
 354     }
 355   else
 356     {
 357       return (single_keymap_panes (lpmm, keymaps[0], Qnil, Qnil, notreal));
 358     }
 359 }
 360
 361 /* This is a recursive subroutine of keymap_panes.
 362    It handles one keymap, KEYMAP.
 363    The other arguments are passed along
 364    or point to local variables of the previous function.
 365    If NOTREAL is nonzero,
 366    don't bother really computing whether an item is enabled.  */
 367
 368 HMENU
 369 single_keymap_panes (lpmm, keymap, pane_name, prefix, notreal)
 370      menu_map * lpmm;
 371      Lisp_Object keymap;
 372      Lisp_Object pane_name;
 373      Lisp_Object prefix;
 374      int notreal;
 375 {
 376   Lisp_Object pending_maps;
 377   Lisp_Object tail, item, item1, item_string, table;
 378   HMENU hmenu;
 379   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 380
 381   if (!notreal)
 382     {
 383       hmenu = CreateMenu ();
 384       if (hmenu == NULL) return NULL;
 385     }
 386   else
 387     {
 388       hmenu = NULL;
 389     }
 390
 391   pending_maps = Qnil;
 392
 393   for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
 394     {
 395       /* Look at each key binding, and if it has a menu string,
 396          make a menu item from it.  */
 397
 398       item = XCONS (tail)->car;
 399
 400       if (CONSP (item))
 401         {
 402           item1 = XCONS (item)->cdr;
 403
 404           if (XTYPE (item1) == Lisp_Cons)
 405             {
 406               item_string = XCONS (item1)->car;
 407               if (XTYPE (item_string) == Lisp_String)
 408                 {
 409                   /* This is the real definition--the function to run.  */
 410
 411                   Lisp_Object def;
 412
 413                   /* These are the saved equivalent keyboard key sequence
 414                      and its key-description.  */
 415
 416                   Lisp_Object descrip;
 417                   Lisp_Object tem, enabled;
 418
 419                   /* GCPRO because ...enabled_p will call eval
 420                      and ..._equiv_key may autoload something.
 421                      Protecting KEYMAP preserves everything we use;
 422                      aside from that, must protect whatever might be
 423                      a string.  Since there's no GCPRO5, we refetch
 424                      item_string instead of protecting it.  */
 425
 426                   descrip = def = Qnil;
 427                   GCPRO4 (keymap, pending_maps, def, prefix);
 428
 429                   def = menu_item_equiv_key (item_string, item1, &descrip);
 430                   enabled = menu_item_enabled_p (def, notreal);
 431
 432                   UNGCPRO;
 433
 434                   item_string = XCONS (item1)->car;
 435
 436                   tem = Fkeymapp (def);
 437                   if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
 438                     {
 439                       pending_maps = Fcons (Fcons (def,
 440                                                    Fcons (item_string,
 441                                                           XCONS (item)->car)),
 442                                             pending_maps);
 443                     }
 444                   else
 445                     {
 446                       Lisp_Object submap;
 447
 448                       GCPRO4 (keymap, pending_maps, item, item_string);
 449
 450                       submap = get_keymap_1 (def, 0, 1);
 451
 452                       UNGCPRO;
 453
 454                       if (NILP (submap))
 455                         {
 456                           if (!notreal)
 457                             {
 458                               add_menu_item (lpmm,
 459                                              hmenu,
 460                                              item_string,
 461                                              !NILP (enabled),
 462                                              Fcons (XCONS (item)->car, prefix));
 463                             }
 464                         }
 465                       else
 466                         /* Display a submenu.  */
 467                         {
 468                           HMENU new_hmenu = single_keymap_panes (lpmm,
 469                                                                  submap,
 470                                                                  item_string,
 471                                                                  XCONS (item)->car,
 472                                                                  notreal);
 473
 474                           if (!notreal)
 475                             {
 476                               AppendMenu (hmenu, MF_POPUP,
 477                                           (UINT)new_hmenu,
 478                                           (char *) XSTRING (item_string)->data);
 479                             }
 480                         }
 481                     }
 482                 }
 483             }
 484         }
 485       else if (VECTORP (item))
 486         {
 487           /* Loop over the char values represented in the vector.  */
 488           int len = XVECTOR (item)->size;
 489           int c;
 490           for (c = 0; c < len; c++)
 491             {
 492               Lisp_Object character;
 493               XSETFASTINT (character, c);
 494               item1 = XVECTOR (item)->contents[c];
 495               if (CONSP (item1))
 496                 {
 497                   item_string = XCONS (item1)->car;
 498                   if (STRINGP (item_string))
 499                     {
 500                       Lisp_Object def;
 501
 502                       /* These are the saved equivalent keyboard key sequence
 503                          and its key-description.  */
 504                       Lisp_Object descrip;
 505                       Lisp_Object tem, enabled;
 506
 507                       /* GCPRO because ...enabled_p will call eval
 508                          and ..._equiv_key may autoload something.
 509                          Protecting KEYMAP preserves everything we use;
 510                          aside from that, must protect whatever might be
 511                          a string.  Since there's no GCPRO5, we refetch
 512                          item_string instead of protecting it.  */
 513                       GCPRO4 (keymap, pending_maps, def, descrip);
 514                       descrip = def = Qnil;
 515
 516                       def = menu_item_equiv_key (item_string, item1, &descrip);
 517                       enabled = menu_item_enabled_p (def, notreal);
 518
 519                       UNGCPRO;
 520
 521                       item_string = XCONS (item1)->car;
 522
 523                       tem = Fkeymapp (def);
 524                       if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
 525                         pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
 526                                               pending_maps);
 527                       else
 528                         {
 529                           Lisp_Object submap;
 530
 531                           GCPRO4 (keymap, pending_maps, descrip, item_string);
 532
 533                           submap = get_keymap_1 (def, 0, 1);
 534
 535                           UNGCPRO;
 536
 537                           if (NILP (submap))
 538                             {
 539                               if (!notreal)
 540                                 {
 541                                   add_menu_item (lpmm,
 542                                                  hmenu,
 543                                                  item_string,
 544                                                  !NILP (enabled),
 545                                                  character);
 546                                 }
 547                             }
 548                           else
 549                             /* Display a submenu.  */
 550                             {
 551                               HMENU new_hmenu = single_keymap_panes (lpmm,
 552                                                                      submap,
 553                                                                      Qnil,
 554                                                                      character,
 555                                                                      notreal);
 556
 557                               if (!notreal)
 558                                 {
 559                                   AppendMenu (hmenu,MF_POPUP,
 560                                               (UINT)new_hmenu,
 561                                               (char *)XSTRING (item_string)->data);
 562                                 }
 563                             }
 564                         }
 565                     }
 566                 }
 567             }
 568         }
 569     }
 570
 571   /* Process now any submenus which want to be panes at this level.  */
 572   while (!NILP (pending_maps))
 573     {
 574       Lisp_Object elt, eltcdr, string;
 575       elt = Fcar (pending_maps);
 576       eltcdr = XCONS (elt)->cdr;
 577       string = XCONS (eltcdr)->car;
 578       /* We no longer discard the @ from the beginning of the string here.
 579          Instead, we do this in w32menu_show.  */
 580       {
 581         HMENU new_hmenu = single_keymap_panes (lpmm,
 582                                                Fcar (elt),
 583                                                string,
 584                                                XCONS (eltcdr)->cdr, notreal);
 585
 586         if (!notreal)
 587           {
 588             AppendMenu (hmenu, MF_POPUP,
 589                         (UINT)new_hmenu,
 590                         (char *) XSTRING (string)->data);
 591           }
 592       }
 593
 594       pending_maps = Fcdr (pending_maps);
 595     }
 596
 597     return (hmenu);
 598 }
 599 \f
 600 /* Push all the panes and items of a menu described by the
 601    alist-of-alists MENU.
 602    This handles old-fashioned calls to x-popup-menu.  */
 603
 604 static HMENU
 605 list_of_panes (lpmm, menu)
 606      menu_map * lpmm;
 607      Lisp_Object menu;
 608 {
 609   Lisp_Object tail;
 610   HMENU hmenu;
 611
 612   hmenu = CreateMenu ();
 613   if (hmenu == NULL) return NULL;
 614
 615   //    init_menu_items (lpmm);
 616
 617   for (tail = menu; !NILP (tail); tail = Fcdr (tail))
 618     {
 619       Lisp_Object elt, pane_name, pane_data;
 620       HMENU new_hmenu;
 621
 622       elt = Fcar (tail);
 623       pane_name = Fcar (elt);
 624       CHECK_STRING (pane_name, 0);
 625       pane_data = Fcdr (elt);
 626       CHECK_CONS (pane_data, 0);
 627
 628       new_hmenu = list_of_items (lpmm, pane_data);
 629       if (new_hmenu == NULL) goto error;
 630
 631       AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu,
 632                   (char *) XSTRING (pane_name)->data);
 633     }
 634
 635   return (hmenu);
 636
 637  error:
 638   DestroyMenu (hmenu);
 639
 640   return (NULL);
 641 }
 642
 643 /* Push the items in a single pane defined by the alist PANE.  */
 644
 645 static HMENU
 646 list_of_items (lpmm, pane)
 647      menu_map * lpmm;
 648      Lisp_Object pane;
 649 {
 650   Lisp_Object tail, item, item1;
 651   HMENU hmenu;
 652
 653   hmenu = CreateMenu ();
 654   if (hmenu == NULL) return NULL;
 655
 656   for (tail = pane; !NILP (tail); tail = Fcdr (tail))
 657     {
 658       item = Fcar (tail);
 659       if (STRINGP (item))
 660         add_menu_item (lpmm, hmenu, item, Qnil, Qnil);
 661       else if (NILP (item))
 662         add_left_right_boundary ();
 663       else
 664         {
 665           CHECK_CONS (item, 0);
 666           item1 = Fcar (item);
 667           CHECK_STRING (item1, 1);
 668           add_menu_item (lpmm, hmenu, item1, Qt, Fcdr (item));
 669         }
 670     }
 671
 672   return (hmenu);
 673 }
 674 \f
 675
 676 HMENU
 677 create_menu_items (lpmm, menu, notreal)
 678      menu_map * lpmm;
 679      Lisp_Object menu;
 680      int notreal;
 681 {
 682   Lisp_Object title;
 683   Lisp_Object keymap, tem;
 684   HMENU hmenu;
 685
 686   title = Qnil;
 687
 688   /* Decode the menu items from what was specified.  */
 689
 690   keymap = Fkeymapp (menu);
 691   tem = Qnil;
 692   if (XTYPE (menu) == Lisp_Cons)
 693     tem = Fkeymapp (Fcar (menu));
 694
 695   if (!NILP (keymap))
 696     {
 697       /* We were given a keymap.  Extract menu info from the keymap.  */
 698       Lisp_Object prompt;
 699       keymap = get_keymap (menu);
 700
 701       /* Extract the detailed info to make one pane.  */
 702       hmenu = keymap_panes (lpmm, &keymap, 1, notreal);
 703
 704 #if 0
 705       /* Search for a string appearing directly as an element of the keymap.
 706          That string is the title of the menu.  */
 707       prompt = map_prompt (keymap);
 708
 709       /* Make that be the pane title of the first pane.  */
 710       if (!NILP (prompt) && menu_items_n_panes >= 0)
 711         XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
 712 #endif
 713     }
 714   else if (!NILP (tem))
 715     {
 716       /* We were given a list of keymaps.  */
 717       int nmaps = XFASTINT (Flength (menu));
 718       Lisp_Object *maps
 719         = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
 720       int i;
 721
 722       title = Qnil;
 723
 724       /* The first keymap that has a prompt string
 725          supplies the menu title.  */
 726       for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
 727         {
 728           Lisp_Object prompt;
 729
 730           maps[i++] = keymap = get_keymap (Fcar (tem));
 731 #if 0
 732           prompt = map_prompt (keymap);
 733           if (NILP (title) && !NILP (prompt))
 734             title = prompt;
 735 #endif
 736         }
 737
 738       /* Extract the detailed info to make one pane.  */
 739       hmenu = keymap_panes (lpmm, maps, nmaps, notreal);
 740
 741 #if 0
 742       /* Make the title be the pane title of the first pane.  */
 743       if (!NILP (title) && menu_items_n_panes >= 0)
 744         XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
 745 #endif
 746     }
 747   else
 748     {
 749       /* We were given an old-fashioned menu.  */
 750       title = Fcar (menu);
 751       CHECK_STRING (title, 1);
 752
 753       hmenu = list_of_panes (lpmm, Fcdr (menu));
 754     }
 755
 756   return (hmenu);
 757 }
 758
 759 /* This is a recursive subroutine of keymap_panes.
 760    It handles one keymap, KEYMAP.
 761    The other arguments are passed along
 762    or point to local variables of the previous function.
 763    If NOTREAL is nonzero,
 764    don't bother really computing whether an item is enabled.  */
 765
 766 Lisp_Object
 767 get_single_keymap_event (keymap, lpnum)
 768      Lisp_Object keymap;
 769      int * lpnum;
 770 {
 771   Lisp_Object pending_maps;
 772   Lisp_Object tail, item, item1, item_string, table;
 773   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 774
 775   pending_maps = Qnil;
 776
 777   for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
 778     {
 779       /* Look at each key binding, and if it has a menu string,
 780          make a menu item from it.  */
 781
 782       item = XCONS (tail)->car;
 783
 784       if (XTYPE (item) == Lisp_Cons)
 785         {
 786           item1 = XCONS (item)->cdr;
 787
 788           if (CONSP (item1))
 789             {
 790               item_string = XCONS (item1)->car;
 791               if (XTYPE (item_string) == Lisp_String)
 792                 {
 793                   /* This is the real definition--the function to run.  */
 794
 795                   Lisp_Object def;
 796
 797                   /* These are the saved equivalent keyboard key sequence
 798                      and its key-description.  */
 799
 800                   Lisp_Object descrip;
 801                   Lisp_Object tem, enabled;
 802
 803                   /* GCPRO because ...enabled_p will call eval
 804                      and ..._equiv_key may autoload something.
 805                      Protecting KEYMAP preserves everything we use;
 806                      aside from that, must protect whatever might be
 807                      a string.  Since there's no GCPRO5, we refetch
 808                      item_string instead of protecting it.  */
 809
 810                   descrip = def = Qnil;
 811                   GCPRO3 (keymap, pending_maps, def);
 812
 813                   def = menu_item_equiv_key (item_string, item1, &descrip);
 814
 815                   UNGCPRO;
 816
 817                   item_string = XCONS (item1)->car;
 818
 819                   tem = Fkeymapp (def);
 820                   if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
 821                     {
 822                       pending_maps = Fcons (Fcons (def,
 823                                                    Fcons (item_string,
 824                                                           XCONS (item)->car)),
 825                                             pending_maps);
 826                     }
 827                   else
 828                     {
 829                       Lisp_Object submap;
 830
 831                       GCPRO4 (keymap, pending_maps, item, item_string);
 832
 833                       submap = get_keymap_1 (def, 0, 1);
 834
 835                       UNGCPRO;
 836
 837                       if (NILP (submap))
 838                         {
 839                           if (--(*lpnum) == 0)
 840                             {
 841                               return (Fcons (XCONS (item)->car, Qnil));
 842                             }
 843                         }
 844                       else
 845                         /* Display a submenu.  */
 846                         {
 847                           Lisp_Object event = get_single_keymap_event (submap,
 848                                                                        lpnum);
 849
 850                           if (*lpnum <= 0)
 851                             {
 852                               if (!NILP (XCONS (item)->car))
 853                                 event = Fcons (XCONS (item)->car, event);
 854
 855                               return (event);
 856                             }
 857                         }
 858                     }
 859                 }
 860             }
 861         }
 862       else if (VECTORP (item))
 863         {
 864           /* Loop over the char values represented in the vector.  */
 865           int len = XVECTOR (item)->size;
 866           int c;
 867           for (c = 0; c < len; c++)
 868             {
 869               Lisp_Object character;
 870               XSETFASTINT (character, c);
 871               item1 = XVECTOR (item)->contents[c];
 872               if (XTYPE (item1) == Lisp_Cons)
 873                 {
 874                   item_string = XCONS (item1)->car;
 875                   if (XTYPE (item_string) == Lisp_String)
 876                     {
 877                       Lisp_Object def;
 878
 879                       /* These are the saved equivalent keyboard key sequence
 880                          and its key-description.  */
 881                       Lisp_Object descrip;
 882                       Lisp_Object tem, enabled;
 883
 884                       /* GCPRO because ...enabled_p will call eval
 885                          and ..._equiv_key may autoload something.
 886                          Protecting KEYMAP preserves everything we use;
 887                          aside from that, must protect whatever might be
 888                          a string.  Since there's no GCPRO5, we refetch
 889                          item_string instead of protecting it.  */
 890                       GCPRO4 (keymap, pending_maps, def, descrip);
 891                       descrip = def = Qnil;
 892
 893                       def = menu_item_equiv_key (item_string, item1, &descrip);
 894
 895                       UNGCPRO;
 896
 897                       item_string = XCONS (item1)->car;
 898
 899                       tem = Fkeymapp (def);
 900                       if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
 901                         pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
 902                                               pending_maps);
 903                       else
 904                         {
 905                           Lisp_Object submap;
 906
 907                           GCPRO4 (keymap, pending_maps, descrip, item_string);
 908
 909                           submap = get_keymap_1 (def, 0, 1);
 910
 911                           UNGCPRO;
 912
 913                           if (NILP (submap))
 914                             {
 915                               if (--(*lpnum) == 0)
 916                                 {
 917                                   return (Fcons (character, Qnil));
 918                                 }
 919                             }
 920                           else
 921                             /* Display a submenu.  */
 922                             {
 923                               Lisp_Object event = get_single_keymap_event (submap,
 924                                                                            lpnum);
 925
 926                               if (*lpnum <= 0)
 927                                 {
 928                                   if (!NILP (character))
 929                                     event = Fcons (character, event);
 930
 931                                   return (event);
 932                                 }
 933                             }
 934                         }
 935                     }
 936                 }
 937             }
 938         }
 939     }
 940
 941   /* Process now any submenus which want to be panes at this level.  */
 942   while (!NILP (pending_maps))
 943     {
 944       Lisp_Object elt, eltcdr, string;
 945       elt = Fcar (pending_maps);
 946       eltcdr = XCONS (elt)->cdr;
 947       string = XCONS (eltcdr)->car;
 948       /* We no longer discard the @ from the beginning of the string here.
 949          Instead, we do this in w32menu_show.  */
 950       {
 951         Lisp_Object event = get_single_keymap_event (Fcar (elt), lpnum);
 952
 953         if (*lpnum <= 0)
 954           {
 955             if (!NILP (XCONS (eltcdr)->cdr))
 956               event = Fcons (XCONS (eltcdr)->cdr, event);
 957
 958             return (event);
 959           }
 960       }
 961
 962       pending_maps = Fcdr (pending_maps);
 963     }
 964
 965   return (Qnil);
 966 }
 967
 968 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
 969    and generate menu panes for them in menu_items.
 970    If NOTREAL is nonzero,
 971    don't bother really computing whether an item is enabled.  */
 972
 973 static Lisp_Object
 974 get_keymap_event (keymaps, nmaps, lpnum)
 975      Lisp_Object *keymaps;
 976      int nmaps;
 977      int * lpnum;
 978 {
 979   int mapno;
 980   Lisp_Object event = Qnil;
 981
 982   /* Loop over the given keymaps, making a pane for each map.
 983      But don't make a pane that is empty--ignore that map instead.
 984      P is the number of panes we have made so far.  */
 985   for (mapno = 0; mapno < nmaps; mapno++)
 986     {
 987       event = get_single_keymap_event (keymaps[mapno], lpnum);
 988
 989       if (*lpnum <= 0) break;
 990     }
 991
 992   return (event);
 993 }
 994
 995 static Lisp_Object
 996 get_list_of_items_event (pane, lpnum)
 997      Lisp_Object pane;
 998      int * lpnum;
 999 {
1000   Lisp_Object tail, item, item1;
1001
1002   for (tail = pane; !NILP (tail); tail = Fcdr (tail))
1003     {
1004       item = Fcar (tail);
1005       if (STRINGP (item))
1006         {
1007           if (-- (*lpnum) == 0)
1008             {
1009               return (Qnil);
1010             }
1011         }
1012       else if (!NILP (item))
1013         {
1014           if (--(*lpnum) == 0)
1015             {
1016               CHECK_CONS (item, 0);
1017               return (Fcdr (item));
1018             }
1019         }
1020     }
1021
1022   return (Qnil);
1023 }
1024
1025 /* Push all the panes and items of a menu described by the
1026    alist-of-alists MENU.
1027    This handles old-fashioned calls to x-popup-menu.  */
1028
1029 static Lisp_Object
1030 get_list_of_panes_event (menu, lpnum)
1031      Lisp_Object menu;
1032      int * lpnum;
1033 {
1034   Lisp_Object tail;
1035
1036   for (tail = menu; !NILP (tail); tail = Fcdr (tail))
1037     {
1038       Lisp_Object elt, pane_name, pane_data;
1039       Lisp_Object event;
1040
1041       elt = Fcar (tail);
1042       pane_data = Fcdr (elt);
1043       CHECK_CONS (pane_data, 0);
1044
1045       event = get_list_of_items_event (pane_data, lpnum);
1046
1047       if (*lpnum <= 0)
1048         {
1049           return (event);
1050         }
1051     }
1052
1053   return (Qnil);
1054 }
1055
1056 Lisp_Object
1057 get_menu_event (menu, lpnum)
1058      Lisp_Object menu;
1059      int * lpnum;
1060 {
1061   Lisp_Object keymap, tem;
1062   Lisp_Object event;
1063
1064   /* Decode the menu items from what was specified.  */
1065
1066   keymap = Fkeymapp (menu);
1067   tem = Qnil;
1068   if (XTYPE (menu) == Lisp_Cons)
1069     tem = Fkeymapp (Fcar (menu));
1070
1071   if (!NILP (keymap))
1072     {
1073       keymap = get_keymap (menu);
1074
1075       event = get_keymap_event (menu, 1, lpnum);
1076     }
1077   else if (!NILP (tem))
1078     {
1079       /* We were given a list of keymaps.  */
1080       int nmaps = XFASTINT (Flength (menu));
1081       Lisp_Object *maps
1082         = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
1083       int i;
1084
1085       /* The first keymap that has a prompt string
1086          supplies the menu title.  */
1087       for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
1088         {
1089           Lisp_Object prompt;
1090
1091           maps[i++] = keymap = get_keymap (Fcar (tem));
1092         }
1093
1094       event = get_keymap_event (maps, nmaps, lpnum);
1095     }
1096   else
1097     {
1098       /* We were given an old-fashioned menu.  */
1099       event = get_list_of_panes_event (Fcdr (menu), lpnum);
1100     }
1101
1102   return (event);
1103 }
1104
1105 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1106        "Pop up a deck-of-cards menu and return user's selection.\n\
1107 POSITION is a position specification.  This is either a mouse button event\n\
1108 or a list ((XOFFSET YOFFSET) WINDOW)\n\
1109 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
1110 corner of WINDOW's frame.  (WINDOW may be a frame object instead of a window.)\n\
1111 This controls the position of the center of the first line\n\
1112 in the first pane of the menu, not the top left of the menu as a whole.\n\
1113 If POSITION is t, it means to use the current mouse position.\n\
1114 \n\
1115 MENU is a specifier for a menu.  For the simplest case, MENU is a keymap.\n\
1116 The menu items come from key bindings that have a menu string as well as\n\
1117 a definition; actually, the \"definition\" in such a key binding looks like\n\
1118 \(STRING . REAL-DEFINITION).  To give the menu a title, put a string into\n\
1119 the keymap as a top-level element.\n\n\
1120 You can also use a list of keymaps as MENU.\n\
1121   Then each keymap makes a separate pane.\n\
1122 When MENU is a keymap or a list of keymaps, the return value\n\
1123 is a list of events.\n\n\
1124 Alternatively, you can specify a menu of multiple panes\n\
1125   with a list of the form (TITLE PANE1 PANE2...),\n\
1126 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
1127 Each ITEM is normally a cons cell (STRING . VALUE);\n\
1128 but a string can appear as an item--that makes a nonselectable line\n\
1129 in the menu.\n\
1130 With this form of menu, the return value is VALUE from the chosen item.\n\
1131 \n\
1132 If POSITION is nil, don't display the menu at all, just precalculate the\n\
1133 cached information about equivalent key sequences.")
1134     (position, menu)
1135     Lisp_Object position, menu;
1136 {
1137   int number_of_panes, panes;
1138   Lisp_Object keymap, tem;
1139   int xpos, ypos;
1140   Lisp_Object title;
1141   char *error_name;
1142   Lisp_Object selection;
1143   int i, j;
1144   FRAME_PTR f;
1145   Lisp_Object x, y, window;
1146   int keymaps = 0;
1147   int menubarp = 0;
1148   struct gcpro gcpro1;
1149   HMENU hmenu;
1150   menu_map mm;
1151
1152   if (! NILP (position))
1153     {
1154       /* Decode the first argument: find the window and the coordinates.  */
1155       if (EQ (position, Qt)
1156           || (CONSP (position) && EQ (XCONS (position)->car, Qmenu_bar)))
1157         {
1158           /* Use the mouse's current position.  */
1159           FRAME_PTR new_f = selected_frame;
1160           Lisp_Object bar_window;
1161           int part;
1162           unsigned long time;
1163
1164           if (mouse_position_hook)
1165             (*mouse_position_hook) (&new_f, 1, &bar_window,
1166                                     &part, &x, &y, &time);
1167           if (new_f != 0)
1168             XSETFRAME (window, new_f);
1169           else
1170             {
1171               window = selected_window;
1172               XSETFASTINT (x, 0);
1173               XSETFASTINT (y, 0);
1174             }
1175         }
1176       else
1177         {
1178           tem = Fcar (position);
1179           if (CONSP (tem))
1180             {
1181               window = Fcar (Fcdr (position));
1182               x = Fcar (tem);
1183               y = Fcar (Fcdr (tem));
1184             }
1185           else
1186             {
1187               tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1188               window = Fcar (tem); /* POSN_WINDOW (tem) */
1189               tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1190               x = Fcar (tem);
1191               y = Fcdr (tem);
1192
1193               /* Determine whether this menu is handling a menu bar click.  */
1194               tem = Fcar (Fcdr (Fcar (Fcdr (position))));
1195               if (CONSP (tem) && EQ (Fcar (tem), Qmenu_bar))
1196                 menubarp = 1;
1197             }
1198         }
1199
1200       CHECK_NUMBER (x, 0);
1201       CHECK_NUMBER (y, 0);
1202
1203       /* Decode where to put the menu.  */
1204
1205       if (FRAMEP (window))
1206         {
1207           f = XFRAME (window);
1208
1209           xpos = 0;
1210           ypos = 0;
1211         }
1212       else if (WINDOWP (window))
1213         {
1214           CHECK_LIVE_WINDOW (window, 0);
1215           f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1216
1217           xpos = (FONT_WIDTH (f->output_data.w32->font) * XWINDOW (window)->left);
1218           ypos = (f->output_data.w32->line_height * XWINDOW (window)->top);
1219         }
1220       else
1221         /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1222            but I don't want to make one now.  */
1223         CHECK_WINDOW (window, 0);
1224
1225       xpos += XINT (x);
1226       ypos += XINT (y);
1227     }
1228
1229   title = Qnil;
1230   GCPRO1 (title);
1231
1232   discard_menu_items (&mm);
1233   hmenu = create_menu_items (&mm, menu, NILP (position));
1234
1235   if (NILP (position))
1236     {
1237       discard_menu_items (&mm);
1238       UNGCPRO;
1239       return Qnil;
1240     }
1241
1242   /* Display them in a menu.  */
1243   BLOCK_INPUT;
1244
1245   selection = w32menu_show (f, xpos, ypos, menu, &hmenu, &error_name);
1246
1247   UNBLOCK_INPUT;
1248
1249   discard_menu_items (&mm);
1250   DestroyMenu (hmenu);
1251
1252   UNGCPRO;
1253
1254   if (error_name) error (error_name);
1255   return selection;
1256 }
1257
1258 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
1259        "Pop up a dialog box and return user's selection.\n\
1260 POSITION specifies which frame to use.\n\
1261 This is normally a mouse button event or a window or frame.\n\
1262 If POSITION is t, it means to use the frame the mouse is on.\n\
1263 The dialog box appears in the middle of the specified frame.\n\
1264 \n\
1265 CONTENTS specifies the alternatives to display in the dialog box.\n\
1266 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
1267 Each ITEM is a cons cell (STRING . VALUE).\n\
1268 The return value is VALUE from the chosen item.\n\n\
1269 An ITEM may also be just a string--that makes a nonselectable item.\n\
1270 An ITEM may also be nil--that means to put all preceding items\n\
1271 on the left of the dialog box and all following items on the right.\n\
1272 \(By default, approximately half appear on each side.)")
1273     (position, contents)
1274     Lisp_Object position, contents;
1275 {
1276   FRAME_PTR f;
1277   Lisp_Object window;
1278
1279   /* Decode the first argument: find the window or frame to use.  */
1280   if (EQ (position, Qt))
1281     {
1282       /* Decode the first argument: find the window and the coordinates.  */
1283       if (EQ (position, Qt))
1284         window = selected_window;
1285     }
1286   else if (CONSP (position))
1287     {
1288       Lisp_Object tem;
1289       tem = Fcar (position);
1290       if (XTYPE (tem) == Lisp_Cons)
1291         window = Fcar (Fcdr (position));
1292       else
1293         {
1294           tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1295           window = Fcar (tem);  /* POSN_WINDOW (tem) */
1296         }
1297     }
1298   else if (WINDOWP (position) || FRAMEP (position))
1299     window = position;
1300
1301   /* Decode where to put the menu.  */
1302
1303   if (FRAMEP (window))
1304     f = XFRAME (window);
1305   else if (WINDOWP (window))
1306     {
1307       CHECK_LIVE_WINDOW (window, 0);
1308       f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1309     }
1310   else
1311     /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1312        but I don't want to make one now.  */
1313     CHECK_WINDOW (window, 0);
1314
1315 #if 1
1316   /* Display a menu with these alternatives
1317      in the middle of frame F.  */
1318   {
1319     Lisp_Object x, y, frame, newpos;
1320     XSETFRAME (frame, f);
1321     XSETINT (x, x_pixel_width (f) / 2);
1322     XSETINT (y, x_pixel_height (f) / 2);
1323     newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
1324
1325     return Fx_popup_menu (newpos,
1326                           Fcons (Fcar (contents), Fcons (contents, Qnil)));
1327   }
1328 #else
1329   {
1330     Lisp_Object title;
1331     char *error_name;
1332     Lisp_Object selection;
1333
1334     /* Decode the dialog items from what was specified.  */
1335     title = Fcar (contents);
1336     CHECK_STRING (title, 1);
1337
1338     list_of_panes (Fcons (contents, Qnil));
1339
1340     /* Display them in a dialog box.  */
1341     BLOCK_INPUT;
1342     selection = w32_dialog_show (f, 0, 0, title, &error_name);
1343     UNBLOCK_INPUT;
1344
1345     discard_menu_items ();
1346
1347     if (error_name) error (error_name);
1348     return selection;
1349   }
1350 #endif
1351 }
1352
1353 Lisp_Object
1354 get_frame_menubar_event (f, num)
1355      FRAME_PTR f;
1356      int num;
1357 {
1358   Lisp_Object tail, items;
1359   int i;
1360   struct gcpro gcpro1;
1361
1362   BLOCK_INPUT;
1363
1364   GCPRO1 (items);
1365
1366   if (NILP (items = FRAME_MENU_BAR_ITEMS (f)))
1367     items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1368
1369   for (i = 0; i < XVECTOR (items)->size; i += 4)
1370     {
1371       Lisp_Object event;
1372
1373       event = get_menu_event (XVECTOR (items)->contents[i + 2], &num);
1374
1375       if (num <= 0)
1376         {
1377           UNGCPRO;
1378           UNBLOCK_INPUT;
1379           return (Fcons (XVECTOR (items)->contents[i], event));
1380         }
1381     }
1382
1383   UNGCPRO;
1384   UNBLOCK_INPUT;
1385
1386   return (Qnil);
1387 }
1388
1389 void
1390 set_frame_menubar (f, first_time)
1391      FRAME_PTR f;
1392      int first_time;
1393 {
1394   Lisp_Object tail, items;
1395   HMENU hmenu;
1396   int i;
1397   struct gcpro gcpro1;
1398   menu_map mm;
1399   int count = specpdl_ptr - specpdl;
1400
1401   struct buffer *prev = current_buffer;
1402   Lisp_Object buffer;
1403
1404   buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1405   specbind (Qinhibit_quit, Qt);
1406   /* Don't let the debugger step into this code
1407      because it is not reentrant.  */
1408   specbind (Qdebug_on_next_call, Qnil);
1409
1410   record_unwind_protect (Fstore_match_data, Fmatch_data (Qnil, Qnil));
1411   if (NILP (Voverriding_local_map_menu_flag))
1412     {
1413       specbind (Qoverriding_terminal_local_map, Qnil);
1414       specbind (Qoverriding_local_map, Qnil);
1415     }
1416
1417   set_buffer_internal_1 (XBUFFER (buffer));
1418
1419   /* Run the Lucid hook.  */
1420   call1 (Vrun_hooks, Qactivate_menubar_hook);
1421   /* If it has changed current-menubar from previous value,
1422      really recompute the menubar from the value.  */
1423   if (! NILP (Vlucid_menu_bar_dirty_flag))
1424     call0 (Qrecompute_lucid_menubar);
1425   safe_run_hooks (Qmenu_bar_update_hook);
1426
1427   BLOCK_INPUT;
1428
1429   GCPRO1 (items);
1430
1431   items = FRAME_MENU_BAR_ITEMS (f);
1432   if (NILP (items))
1433     items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1434
1435   hmenu = CreateMenu ();
1436
1437   if (!hmenu) goto error;
1438
1439   discard_menu_items (&mm);
1440   UNBLOCK_INPUT;
1441
1442   for (i = 0; i < XVECTOR (items)->size; i += 4)
1443     {
1444       Lisp_Object string;
1445       int keymaps;
1446       CHAR *error;
1447       HMENU new_hmenu;
1448
1449       string = XVECTOR (items)->contents[i + 1];
1450       if (NILP (string))
1451         break;
1452
1453       /* Input must not be blocked here
1454          because we call general Lisp code and internal_condition_case_1.  */
1455       new_hmenu = create_menu_items (&mm,
1456                                      XVECTOR (items)->contents[i + 2],
1457                                      0);
1458
1459       if (!new_hmenu)
1460         continue;
1461
1462       BLOCK_INPUT;
1463       AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu,
1464                   (char *) XSTRING (string)->data);
1465       UNBLOCK_INPUT;
1466     }
1467
1468   BLOCK_INPUT;
1469   {
1470     HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1471     SetMenu (FRAME_W32_WINDOW (f), hmenu);
1472     DestroyMenu (old);
1473   }
1474
1475  error:
1476   set_buffer_internal_1 (prev);
1477   UNGCPRO;
1478   UNBLOCK_INPUT;
1479   unbind_to (count, Qnil);
1480 }
1481
1482 void
1483 free_frame_menubar (f)
1484      FRAME_PTR f;
1485 {
1486   BLOCK_INPUT;
1487
1488   {
1489     HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1490     SetMenu (FRAME_W32_WINDOW (f), NULL);
1491     DestroyMenu (old);
1492   }
1493
1494   UNBLOCK_INPUT;
1495 }
1496 /* Called from Fw32_create_frame to create the initial menubar of a frame
1497    before it is mapped, so that the window is mapped with the menubar already
1498    there instead of us tacking it on later and thrashing the window after it
1499    is visible.  */
1500 void
1501 initialize_frame_menubar (f)
1502      FRAME_PTR f;
1503 {
1504   set_frame_menubar (f, 1);
1505 }
1506 \f
1507 #if 0
1508 /* If the mouse has moved to another menu bar item,
1509    return 1 and unread a button press event for that item.
1510    Otherwise return 0.  */
1511
1512 static int
1513 check_mouse_other_menu_bar (f)
1514      FRAME_PTR f;
1515 {
1516   FRAME_PTR new_f;
1517   Lisp_Object bar_window;
1518   int part;
1519   Lisp_Object x, y;
1520   unsigned long time;
1521
1522   (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
1523
1524   if (f == new_f && other_menu_bar_item_p (f, x, y))
1525     {
1526       unread_menu_bar_button (f, x);
1527       return 1;
1528     }
1529
1530   return 0;
1531 }
1532 #endif
1533 \f
1534
1535 #if 0
1536 static HMENU
1537 create_menu (keymaps, error)
1538      int keymaps;
1539      char **error;
1540 {
1541   HMENU hmenu = NULL;   /* the menu we are currently working on */
1542   HMENU first_hmenu = NULL;
1543
1544   HMENU *submenu_stack = (HMENU *) alloca (menu_items_used * sizeof (HMENU));
1545   Lisp_Object *subprefix_stack = (Lisp_Object *) alloca (menu_items_used *
1546                                                          sizeof (Lisp_Object));
1547   int submenu_depth = 0;
1548   int i;
1549
1550   if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1551     {
1552       *error = "Empty menu";
1553       return NULL;
1554     }
1555
1556   i = 0;
1557
1558   /* Loop over all panes and items, filling in the tree.  */
1559
1560   while (i < menu_items_used)
1561     {
1562       if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1563         {
1564           submenu_stack[submenu_depth++] = hmenu;
1565           i++;
1566         }
1567       else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1568         {
1569           hmenu = submenu_stack[--submenu_depth];
1570           i++;
1571         }
1572 #if 0
1573 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1574          && submenu_depth != 0)
1575   i += MENU_ITEMS_PANE_LENGTH;
1576 #endif
1577       /* Ignore a nil in the item list.
1578          It's meaningful only for dialog boxes.  */
1579 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1580   i += 1;
1581 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1582   {
1583     /* Create a new pane.  */
1584
1585     Lisp_Object pane_name;
1586     char *pane_string;
1587
1588     pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1589     pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data);
1590
1591     if (!hmenu || strcmp (pane_string, ""))
1592       {
1593         HMENU new_hmenu = CreateMenu ();
1594
1595         if (!new_hmenu)
1596           {
1597             *error = "Could not create menu pane";
1598             goto error;
1599           }
1600
1601         if (hmenu)
1602           {
1603             AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, pane_string);
1604           }
1605
1606         hmenu = new_hmenu;
1607
1608         if (!first_hmenu) first_hmenu = hmenu;
1609       }
1610     i += MENU_ITEMS_PANE_LENGTH;
1611   }
1612 else
1613   {
1614     /* Create a new item within current pane.  */
1615
1616     Lisp_Object item_name, enable, descrip;
1617     UINT fuFlags;
1618
1619     item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1620     enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1621     //    descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1622
1623     if (((char *) XSTRING (item_name)->data)[0] == 0
1624         || strcmp ((char *) XSTRING (item_name)->data, "--") == 0)
1625       fuFlags = MF_SEPARATOR;
1626     else if (NILP (enable) || !XUINT(enable))
1627       fuFlags = MF_STRING | MF_GRAYED;
1628     else
1629       fuFlags = MF_STRING;
1630
1631     AppendMenu (hmenu,
1632                 fuFlags,
1633                 i,
1634                 (char *) XSTRING (item_name)->data);
1635
1636     //    if (!NILP (descrip))
1637       //            hmenu->key = (char *) XSTRING (descrip)->data;
1638
1639     i += MENU_ITEMS_ITEM_LENGTH;
1640   }
1641 }
1642
1643   return (first_hmenu);
1644
1645  error:
1646   if (first_hmenu) DestroyMenu (first_hmenu);
1647   return (NULL);
1648 }
1649
1650 #endif
1651
1652 /* w32menu_show actually displays a menu using the panes and items in
1653    menu_items and returns the value selected from it.
1654    There are two versions of w32menu_show, one for Xt and one for Xlib.
1655    Both assume input is blocked by the caller.  */
1656
1657 /* F is the frame the menu is for.
1658    X and Y are the frame-relative specified position,
1659    relative to the inside upper left corner of the frame F.
1660    MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1661    KEYMAPS is 1 if this menu was specified with keymaps;
1662    in that case, we return a list containing the chosen item's value
1663    and perhaps also the pane's prefix.
1664    TITLE is the specified menu title.
1665    ERROR is a place to store an error message string in case of failure.
1666    (We return nil on failure, but the value doesn't actually matter.)  */
1667
1668
1669 static Lisp_Object
1670 w32menu_show (f, x, y, menu, hmenu, error)
1671      FRAME_PTR f;
1672      int x;
1673      int y;
1674      Lisp_Object menu;
1675      HMENU hmenu;
1676      char **error;
1677 {
1678   int i , menu_selection;
1679   POINT pos;
1680
1681   *error = NULL;
1682
1683   if (!hmenu)
1684     {
1685       *error = "Empty menu";
1686       return Qnil;
1687     }
1688
1689   pos.x = x;
1690   pos.y = y;
1691
1692   /* Offset the coordinates to root-relative.  */
1693   ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1694
1695 #if 0
1696   /* If the mouse moves out of the menu before we show the menu,
1697      don't show it at all.  */
1698   if (check_mouse_other_menu_bar (f))
1699     {
1700       DestroyMenu (hmenu);
1701       return Qnil;
1702     }
1703 #endif
1704
1705   /* Display the menu.  */
1706   menu_selection = TrackPopupMenu (hmenu,
1707                                    0x10,
1708                                    pos.x, pos.y,
1709                                    0,
1710                                    FRAME_W32_WINDOW (f),
1711                                    NULL);
1712   if (menu_selection == -1)
1713     {
1714       *error = "Invalid menu specification";
1715       return Qnil;
1716     }
1717
1718   /* Find the selected item, and its pane, to return
1719      the proper value.  */
1720
1721 #if 1
1722   if (menu_selection > 0)
1723     {
1724       return get_menu_event (menu, menu_selection);
1725     }
1726 #else
1727   if (menu_selection > 0 && menu_selection <= lpmm->menu_items_used)
1728     {
1729       return (XVECTOR (lpmm->menu_items)->contents[menu_selection - 1]);
1730     }
1731 #endif
1732
1733   return Qnil;
1734 }
1735
1736 #if 0
1737 static char * button_names [] =
1738 {
1739   "button1", "button2", "button3", "button4", "button5",
1740   "button6", "button7", "button8", "button9", "button10"
1741 };
1742
1743 static Lisp_Object
1744 w32_dialog_show (f, menubarp, keymaps, title, error)
1745      FRAME_PTR f;
1746      int menubarp;
1747      int keymaps;
1748      Lisp_Object title;
1749      char **error;
1750 {
1751   int i, nb_buttons=0;
1752   HMENU hmenu;
1753   char dialog_name[6];
1754
1755   /* Number of elements seen so far, before boundary.  */
1756   int left_count = 0;
1757   /* 1 means we've seen the boundary between left-hand elts and right-hand.  */
1758   int boundary_seen = 0;
1759
1760   *error = NULL;
1761
1762   if (menu_items_n_panes > 1)
1763     {
1764       *error = "Multiple panes in dialog box";
1765       return Qnil;
1766     }
1767
1768   /* Create a tree of widget_value objects
1769      representing the text label and buttons.  */
1770   {
1771     Lisp_Object pane_name, prefix;
1772     char *pane_string;
1773     pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
1774     prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
1775     pane_string = (NILP (pane_name)
1776                    ? "" : (char *) XSTRING (pane_name)->data);
1777     prev_wv = malloc_widget_value ();
1778     prev_wv->value = pane_string;
1779     if (keymaps && !NILP (prefix))
1780       prev_wv->name++;
1781     prev_wv->enabled = 1;
1782     prev_wv->name = "message";
1783     first_wv = prev_wv;
1784
1785     /* Loop over all panes and items, filling in the tree.  */
1786     i = MENU_ITEMS_PANE_LENGTH;
1787     while (i < menu_items_used)
1788       {
1789
1790         /* Create a new item within current pane.  */
1791         Lisp_Object item_name, enable, descrip;
1792         item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1793         enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1794         descrip
1795           = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1796
1797         if (NILP (item_name))
1798           {
1799             free_menubar_widget_value_tree (first_wv);
1800             *error = "Submenu in dialog items";
1801             return Qnil;
1802           }
1803         if (EQ (item_name, Qquote))
1804           {
1805             /* This is the boundary between left-side elts
1806                and right-side elts.  Stop incrementing right_count.  */
1807             boundary_seen = 1;
1808             i++;
1809             continue;
1810           }
1811         if (nb_buttons >= 10)
1812           {
1813             free_menubar_widget_value_tree (first_wv);
1814             *error = "Too many dialog items";
1815             return Qnil;
1816           }
1817
1818         wv = malloc_widget_value ();
1819         prev_wv->next = wv;
1820         wv->name = (char *) button_names[nb_buttons];
1821         if (!NILP (descrip))
1822           wv->key = (char *) XSTRING (descrip)->data;
1823         wv->value = (char *) XSTRING (item_name)->data;
1824         wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
1825         wv->enabled = !NILP (enable);
1826         prev_wv = wv;
1827
1828         if (! boundary_seen)
1829           left_count++;
1830
1831         nb_buttons++;
1832         i += MENU_ITEMS_ITEM_LENGTH;
1833       }
1834
1835     /* If the boundary was not specified,
1836        by default put half on the left and half on the right.  */
1837     if (! boundary_seen)
1838       left_count = nb_buttons - nb_buttons / 2;
1839
1840     wv = malloc_widget_value ();
1841     wv->name = dialog_name;
1842
1843     /* Dialog boxes use a really stupid name encoding
1844        which specifies how many buttons to use
1845        and how many buttons are on the right.
1846        The Q means something also.  */
1847     dialog_name[0] = 'Q';
1848     dialog_name[1] = '0' + nb_buttons;
1849     dialog_name[2] = 'B';
1850     dialog_name[3] = 'R';
1851     /* Number of buttons to put on the right.  */
1852     dialog_name[4] = '0' + nb_buttons - left_count;
1853     dialog_name[5] = 0;
1854     wv->contents = first_wv;
1855     first_wv = wv;
1856   }
1857
1858   /* Actually create the dialog.  */
1859   dialog_id = ++popup_id_tick;
1860   menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
1861                            f->output_data.w32->widget, 1, 0,
1862                            dialog_selection_callback, 0);
1863 #if 0 /* This causes crashes, and seems to be redundant -- rms.  */
1864   lw_modify_all_widgets (dialog_id, first_wv, True);
1865 #endif
1866   lw_modify_all_widgets (dialog_id, first_wv->contents, True);
1867   /* Free the widget_value objects we used to specify the contents.  */
1868   free_menubar_widget_value_tree (first_wv);
1869
1870   /* No selection has been chosen yet.  */
1871   menu_item_selection = 0;
1872
1873   /* Display the menu.  */
1874   lw_pop_up_all_widgets (dialog_id);
1875
1876   /* Process events that apply to the menu.  */
1877   while (1)
1878     {
1879       XEvent event;
1880
1881       XtAppNextEvent (Xt_app_con, &event);
1882       if (event.type == ButtonRelease)
1883         {
1884           XtDispatchEvent (&event);
1885           break;
1886         }
1887       else if (event.type == Expose)
1888             process_expose_from_menu (event);
1889         XtDispatchEvent (&event);
1890       if (XtWindowToWidget(XDISPLAY event.xany.window) != menu)
1891         {
1892           queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue));
1893
1894           if (queue_tmp != NULL)
1895             {
1896               queue_tmp->event = event;
1897               queue_tmp->next = queue;
1898               queue = queue_tmp;
1899             }
1900         }
1901     }
1902  pop_down:
1903
1904   /* State that no mouse buttons are now held.
1905      That is not necessarily true, but the fiction leads to reasonable
1906      results, and it is a pain to ask which are actually held now
1907      or track this in the loop above.  */
1908   w32_mouse_grabbed = 0;
1909
1910   /* Unread any events that we got but did not handle.  */
1911   while (queue != NULL)
1912     {
1913       queue_tmp = queue;
1914       XPutBackEvent (XDISPLAY &queue_tmp->event);
1915       queue = queue_tmp->next;
1916       free ((char *)queue_tmp);
1917       /* Cause these events to get read as soon as we UNBLOCK_INPUT.  */
1918       interrupt_input_pending = 1;
1919     }
1920
1921   /* Find the selected item, and its pane, to return
1922      the proper value.  */
1923   if (menu_item_selection != 0)
1924     {
1925       Lisp_Object prefix;
1926
1927       prefix = Qnil;
1928       i = 0;
1929       while (i < menu_items_used)
1930         {
1931           Lisp_Object entry;
1932
1933           if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1934             {
1935               prefix
1936                 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1937               i += MENU_ITEMS_PANE_LENGTH;
1938             }
1939           else
1940             {
1941               entry
1942                 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1943               if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
1944                 {
1945                   if (keymaps != 0)
1946                     {
1947                       entry = Fcons (entry, Qnil);
1948                       if (!NILP (prefix))
1949                         entry = Fcons (prefix, entry);
1950                     }
1951                   return entry;
1952                 }
1953               i += MENU_ITEMS_ITEM_LENGTH;
1954             }
1955         }
1956     }
1957
1958   return Qnil;
1959 }
1960 #endif
1961
1962 syms_of_w32menu ()
1963 {
1964   Qdebug_on_next_call = intern ("debug-on-next-call");
1965   staticpro (&Qdebug_on_next_call);
1966
1967   defsubr (&Sx_popup_menu);
1968   defsubr (&Sx_popup_dialog);
1969 }