1/* Menu support for GNU Emacs on the Microsoft W32 API. 2 Copyright (C) 1986, 1988, 1993, 1994, 1996, 1998, 1999, 2001, 2002, 3 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 4 5This file is part of GNU Emacs. 6 7GNU Emacs is free software; you can redistribute it and/or modify 8it under the terms of the GNU General Public License as published by 9the Free Software Foundation; either version 2, or (at your option) 10any later version. 11 12GNU Emacs is distributed in the hope that it will be useful, 13but WITHOUT ANY WARRANTY; without even the implied warranty of 14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15GNU General Public License for more details. 16 17You should have received a copy of the GNU General Public License 18along with GNU Emacs; see the file COPYING. If not, write to 19the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 20Boston, MA 02110-1301, USA. */ 21 22#include <config.h> 23#include <signal.h> 24 25#include <stdio.h> 26#include "lisp.h" 27#include "termhooks.h" 28#include "keyboard.h" 29#include "keymap.h" 30#include "frame.h" 31#include "window.h" 32#include "blockinput.h" 33#include "buffer.h" 34#include "charset.h" 35#include "coding.h" 36 37/* This may include sys/types.h, and that somehow loses 38 if this is not done before the other system files. */ 39#include "w32term.h" 40 41/* Load sys/types.h if not already loaded. 42 In some systems loading it twice is suicidal. */ 43#ifndef makedev 44#include <sys/types.h> 45#endif 46 47#include "dispextern.h" 48 49#undef HAVE_DIALOGS /* TODO: Implement native dialogs. */ 50 51/******************************************************************/ 52/* Definitions copied from lwlib.h */ 53 54typedef void * XtPointer; 55typedef char Boolean; 56 57enum button_type 58{ 59 BUTTON_TYPE_NONE, 60 BUTTON_TYPE_TOGGLE, 61 BUTTON_TYPE_RADIO 62}; 63 64/* This structure is based on the one in ../lwlib/lwlib.h, modified 65 for Windows. */ 66typedef struct _widget_value 67{ 68 /* name of widget */ 69 Lisp_Object lname; 70 char* name; 71 /* value (meaning depend on widget type) */ 72 char* value; 73 /* keyboard equivalent. no implications for XtTranslations */ 74 Lisp_Object lkey; 75 char* key; 76 /* Help string or nil if none. 77 GC finds this string through the frame's menu_bar_vector 78 or through menu_items. */ 79 Lisp_Object help; 80 /* true if enabled */ 81 Boolean enabled; 82 /* true if selected */ 83 Boolean selected; 84 /* The type of a button. */ 85 enum button_type button_type; 86 /* true if menu title */ 87 Boolean title; 88#if 0 89 /* true if was edited (maintained by get_value) */ 90 Boolean edited; 91 /* true if has changed (maintained by lw library) */ 92 change_type change; 93 /* true if this widget itself has changed, 94 but not counting the other widgets found in the `next' field. */ 95 change_type this_one_change; 96#endif 97 /* Contents of the sub-widgets, also selected slot for checkbox */ 98 struct _widget_value* contents; 99 /* data passed to callback */ 100 XtPointer call_data; 101 /* next one in the list */ 102 struct _widget_value* next; 103#if 0 104 /* slot for the toolkit dependent part. Always initialize to NULL. */ 105 void* toolkit_data; 106 /* tell us if we should free the toolkit data slot when freeing the 107 widget_value itself. */ 108 Boolean free_toolkit_data; 109 110 /* we resource the widget_value structures; this points to the next 111 one on the free list if this one has been deallocated. 112 */ 113 struct _widget_value *free_list; 114#endif 115} widget_value; 116 117/* Local memory management */ 118#define local_heap (GetProcessHeap ()) 119#define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n))) 120#define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p)))) 121 122#define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value))) 123#define free_widget_value(wv) (local_free ((wv))) 124 125/******************************************************************/ 126 127#ifndef TRUE 128#define TRUE 1 129#define FALSE 0 130#endif /* no TRUE */ 131 132HMENU current_popup_menu; 133 134void syms_of_w32menu (); 135void globals_of_w32menu (); 136 137typedef BOOL (WINAPI * GetMenuItemInfoA_Proc) ( 138 IN HMENU, 139 IN UINT, 140 IN BOOL, 141 IN OUT LPMENUITEMINFOA); 142typedef BOOL (WINAPI * SetMenuItemInfoA_Proc) ( 143 IN HMENU, 144 IN UINT, 145 IN BOOL, 146 IN LPCMENUITEMINFOA); 147 148GetMenuItemInfoA_Proc get_menu_item_info = NULL; 149SetMenuItemInfoA_Proc set_menu_item_info = NULL; 150AppendMenuW_Proc unicode_append_menu = NULL; 151 152Lisp_Object Qdebug_on_next_call; 153 154extern Lisp_Object Vmenu_updating_frame; 155 156extern Lisp_Object Qmenu_bar; 157 158extern Lisp_Object QCtoggle, QCradio; 159 160extern Lisp_Object Voverriding_local_map; 161extern Lisp_Object Voverriding_local_map_menu_flag; 162 163extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map; 164 165extern Lisp_Object Qmenu_bar_update_hook; 166 167void set_frame_menubar (); 168 169static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object, 170 Lisp_Object, Lisp_Object, Lisp_Object, 171 Lisp_Object, Lisp_Object)); 172#ifdef HAVE_DIALOGS 173static Lisp_Object w32_dialog_show (); 174#endif 175static Lisp_Object w32_menu_show (); 176 177static void keymap_panes (); 178static void single_keymap_panes (); 179static void single_menu_item (); 180static void list_of_panes (); 181static void list_of_items (); 182void w32_free_menu_strings (HWND); 183 184/* This holds a Lisp vector that holds the results of decoding 185 the keymaps or alist-of-alists that specify a menu. 186 187 It describes the panes and items within the panes. 188 189 Each pane is described by 3 elements in the vector: 190 t, the pane name, the pane's prefix key. 191 Then follow the pane's items, with 5 elements per item: 192 the item string, the enable flag, the item's value, 193 the definition, and the equivalent keyboard key's description string. 194 195 In some cases, multiple levels of menus may be described. 196 A single vector slot containing nil indicates the start of a submenu. 197 A single vector slot containing lambda indicates the end of a submenu. 198 The submenu follows a menu item which is the way to reach the submenu. 199 200 A single vector slot containing quote indicates that the 201 following items should appear on the right of a dialog box. 202 203 Using a Lisp vector to hold this information while we decode it 204 takes care of protecting all the data from GC. */ 205 206#define MENU_ITEMS_PANE_NAME 1 207#define MENU_ITEMS_PANE_PREFIX 2 208#define MENU_ITEMS_PANE_LENGTH 3 209 210enum menu_item_idx 211{ 212 MENU_ITEMS_ITEM_NAME = 0, 213 MENU_ITEMS_ITEM_ENABLE, 214 MENU_ITEMS_ITEM_VALUE, 215 MENU_ITEMS_ITEM_EQUIV_KEY, 216 MENU_ITEMS_ITEM_DEFINITION, 217 MENU_ITEMS_ITEM_TYPE, 218 MENU_ITEMS_ITEM_SELECTED, 219 MENU_ITEMS_ITEM_HELP, 220 MENU_ITEMS_ITEM_LENGTH 221}; 222 223static Lisp_Object menu_items; 224 225/* Number of slots currently allocated in menu_items. */ 226static int menu_items_allocated; 227 228/* This is the index in menu_items of the first empty slot. */ 229static int menu_items_used; 230 231/* The number of panes currently recorded in menu_items, 232 excluding those within submenus. */ 233static int menu_items_n_panes; 234 235/* Current depth within submenus. */ 236static int menu_items_submenu_depth; 237 238static int next_menubar_widget_id; 239 240/* This is set nonzero after the user activates the menu bar, and set 241 to zero again after the menu bars are redisplayed by prepare_menu_bar. 242 While it is nonzero, all calls to set_frame_menubar go deep. 243 244 I don't understand why this is needed, but it does seem to be 245 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */ 246 247int pending_menu_activation; 248 249 250/* Return the frame whose ->output_data.w32->menubar_widget equals 251 ID, or 0 if none. */ 252 253static struct frame * 254menubar_id_to_frame (id) 255 HMENU id; 256{ 257 Lisp_Object tail, frame; 258 FRAME_PTR f; 259 260 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail)) 261 { 262 frame = XCAR (tail); 263 if (!GC_FRAMEP (frame)) 264 continue; 265 f = XFRAME (frame); 266 if (!FRAME_WINDOW_P (f)) 267 continue; 268 if (f->output_data.w32->menubar_widget == id) 269 return f; 270 } 271 return 0; 272} 273 274/* Initialize the menu_items structure if we haven't already done so. 275 Also mark it as currently empty. */ 276 277static void 278init_menu_items () 279{ 280 if (NILP (menu_items)) 281 { 282 menu_items_allocated = 60; 283 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil); 284 } 285 286 menu_items_used = 0; 287 menu_items_n_panes = 0; 288 menu_items_submenu_depth = 0; 289} 290 291/* Call at the end of generating the data in menu_items. 292 This fills in the number of items in the last pane. */ 293 294static void 295finish_menu_items () 296{ 297} 298 299/* Call when finished using the data for the current menu 300 in menu_items. */ 301 302static void 303discard_menu_items () 304{ 305 /* Free the structure if it is especially large. 306 Otherwise, hold on to it, to save time. */ 307 if (menu_items_allocated > 200) 308 { 309 menu_items = Qnil; 310 menu_items_allocated = 0; 311 } 312} 313 314/* Make the menu_items vector twice as large. */ 315 316static void 317grow_menu_items () 318{ 319 Lisp_Object old; 320 int old_size = menu_items_allocated; 321 old = menu_items; 322 323 menu_items_allocated *= 2; 324 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil); 325 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents, 326 old_size * sizeof (Lisp_Object)); 327} 328 329/* Begin a submenu. */ 330 331static void 332push_submenu_start () 333{ 334 if (menu_items_used + 1 > menu_items_allocated) 335 grow_menu_items (); 336 337 ASET (menu_items, menu_items_used++, Qnil); 338 menu_items_submenu_depth++; 339} 340 341/* End a submenu. */ 342 343static void 344push_submenu_end () 345{ 346 if (menu_items_used + 1 > menu_items_allocated) 347 grow_menu_items (); 348 349 ASET (menu_items, menu_items_used++, Qlambda); 350 menu_items_submenu_depth--; 351} 352 353/* Indicate boundary between left and right. */ 354 355static void 356push_left_right_boundary () 357{ 358 if (menu_items_used + 1 > menu_items_allocated) 359 grow_menu_items (); 360 361 ASET (menu_items, menu_items_used++, Qquote); 362} 363 364/* Start a new menu pane in menu_items. 365 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */ 366 367static void 368push_menu_pane (name, prefix_vec) 369 Lisp_Object name, prefix_vec; 370{ 371 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated) 372 grow_menu_items (); 373 374 if (menu_items_submenu_depth == 0) 375 menu_items_n_panes++; 376 ASET (menu_items, menu_items_used++, Qt); 377 ASET (menu_items, menu_items_used++, name); 378 ASET (menu_items, menu_items_used++, prefix_vec); 379} 380 381/* Push one menu item into the current pane. NAME is the string to 382 display. ENABLE if non-nil means this item can be selected. KEY 383 is the key generated by choosing this item, or nil if this item 384 doesn't really have a definition. DEF is the definition of this 385 item. EQUIV is the textual description of the keyboard equivalent 386 for this item (or nil if none). TYPE is the type of this menu 387 item, one of nil, `toggle' or `radio'. */ 388 389static void 390push_menu_item (name, enable, key, def, equiv, type, selected, help) 391 Lisp_Object name, enable, key, def, equiv, type, selected, help; 392{ 393 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated) 394 grow_menu_items (); 395 396 ASET (menu_items, menu_items_used++, name); 397 ASET (menu_items, menu_items_used++, enable); 398 ASET (menu_items, menu_items_used++, key); 399 ASET (menu_items, menu_items_used++, equiv); 400 ASET (menu_items, menu_items_used++, def); 401 ASET (menu_items, menu_items_used++, type); 402 ASET (menu_items, menu_items_used++, selected); 403 ASET (menu_items, menu_items_used++, help); 404} 405 406/* Look through KEYMAPS, a vector of keymaps that is NMAPS long, 407 and generate menu panes for them in menu_items. 408 If NOTREAL is nonzero, 409 don't bother really computing whether an item is enabled. */ 410 411static void 412keymap_panes (keymaps, nmaps, notreal) 413 Lisp_Object *keymaps; 414 int nmaps; 415 int notreal; 416{ 417 int mapno; 418 419 init_menu_items (); 420 421 /* Loop over the given keymaps, making a pane for each map. 422 But don't make a pane that is empty--ignore that map instead. 423 P is the number of panes we have made so far. */ 424 for (mapno = 0; mapno < nmaps; mapno++) 425 single_keymap_panes (keymaps[mapno], 426 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10); 427 428 finish_menu_items (); 429} 430 431/* This is a recursive subroutine of keymap_panes. 432 It handles one keymap, KEYMAP. 433 The other arguments are passed along 434 or point to local variables of the previous function. 435 If NOTREAL is nonzero, only check for equivalent key bindings, don't 436 evaluate expressions in menu items and don't make any menu. 437 438 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */ 439 440static void 441single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth) 442 Lisp_Object keymap; 443 Lisp_Object pane_name; 444 Lisp_Object prefix; 445 int notreal; 446 int maxdepth; 447{ 448 Lisp_Object pending_maps = Qnil; 449 Lisp_Object tail, item; 450 struct gcpro gcpro1, gcpro2; 451 452 if (maxdepth <= 0) 453 return; 454 455 push_menu_pane (pane_name, prefix); 456 457 for (tail = keymap; CONSP (tail); tail = XCDR (tail)) 458 { 459 GCPRO2 (keymap, pending_maps); 460 /* Look at each key binding, and if it is a menu item add it 461 to this menu. */ 462 item = XCAR (tail); 463 if (CONSP (item)) 464 single_menu_item (XCAR (item), XCDR (item), 465 &pending_maps, notreal, maxdepth); 466 else if (VECTORP (item)) 467 { 468 /* Loop over the char values represented in the vector. */ 469 int len = ASIZE (item); 470 int c; 471 for (c = 0; c < len; c++) 472 { 473 Lisp_Object character; 474 XSETFASTINT (character, c); 475 single_menu_item (character, AREF (item, c), 476 &pending_maps, notreal, maxdepth); 477 } 478 } 479 UNGCPRO; 480 } 481 482 /* Process now any submenus which want to be panes at this level. */ 483 while (!NILP (pending_maps)) 484 { 485 Lisp_Object elt, eltcdr, string; 486 elt = Fcar (pending_maps); 487 eltcdr = XCDR (elt); 488 string = XCAR (eltcdr); 489 /* We no longer discard the @ from the beginning of the string here. 490 Instead, we do this in w32_menu_show. */ 491 single_keymap_panes (Fcar (elt), string, 492 XCDR (eltcdr), notreal, maxdepth - 1); 493 pending_maps = Fcdr (pending_maps); 494 } 495} 496 497/* This is a subroutine of single_keymap_panes that handles one 498 keymap entry. 499 KEY is a key in a keymap and ITEM is its binding. 500 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into 501 separate panes. 502 If NOTREAL is nonzero, only check for equivalent key bindings, don't 503 evaluate expressions in menu items and don't make any menu. 504 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */ 505 506static void 507single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth) 508 Lisp_Object key, item; 509 Lisp_Object *pending_maps_ptr; 510 int maxdepth, notreal; 511{ 512 Lisp_Object map, item_string, enabled; 513 struct gcpro gcpro1, gcpro2; 514 int res; 515 516 /* Parse the menu item and leave the result in item_properties. */ 517 GCPRO2 (key, item); 518 res = parse_menu_item (item, notreal, 0); 519 UNGCPRO; 520 if (!res) 521 return; /* Not a menu item. */ 522 523 map = AREF (item_properties, ITEM_PROPERTY_MAP); 524 525 if (notreal) 526 { 527 /* We don't want to make a menu, just traverse the keymaps to 528 precompute equivalent key bindings. */ 529 if (!NILP (map)) 530 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1); 531 return; 532 } 533 534 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE); 535 item_string = AREF (item_properties, ITEM_PROPERTY_NAME); 536 537 if (!NILP (map) && SREF (item_string, 0) == '@') 538 { 539 if (!NILP (enabled)) 540 /* An enabled separate pane. Remember this to handle it later. */ 541 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)), 542 *pending_maps_ptr); 543 return; 544 } 545 546 push_menu_item (item_string, enabled, key, 547 AREF (item_properties, ITEM_PROPERTY_DEF), 548 AREF (item_properties, ITEM_PROPERTY_KEYEQ), 549 AREF (item_properties, ITEM_PROPERTY_TYPE), 550 AREF (item_properties, ITEM_PROPERTY_SELECTED), 551 AREF (item_properties, ITEM_PROPERTY_HELP)); 552 553 /* Display a submenu using the toolkit. */ 554 if (! (NILP (map) || NILP (enabled))) 555 { 556 push_submenu_start (); 557 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1); 558 push_submenu_end (); 559 } 560} 561 562/* Push all the panes and items of a menu described by the 563 alist-of-alists MENU. 564 This handles old-fashioned calls to x-popup-menu. */ 565 566static void 567list_of_panes (menu) 568 Lisp_Object menu; 569{ 570 Lisp_Object tail; 571 572 init_menu_items (); 573 574 for (tail = menu; !NILP (tail); tail = Fcdr (tail)) 575 { 576 Lisp_Object elt, pane_name, pane_data; 577 elt = Fcar (tail); 578 pane_name = Fcar (elt); 579 CHECK_STRING (pane_name); 580 push_menu_pane (pane_name, Qnil); 581 pane_data = Fcdr (elt); 582 CHECK_CONS (pane_data); 583 list_of_items (pane_data); 584 } 585 586 finish_menu_items (); 587} 588 589/* Push the items in a single pane defined by the alist PANE. */ 590 591static void 592list_of_items (pane) 593 Lisp_Object pane; 594{ 595 Lisp_Object tail, item, item1; 596 597 for (tail = pane; !NILP (tail); tail = Fcdr (tail)) 598 { 599 item = Fcar (tail); 600 if (STRINGP (item)) 601 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil); 602 else if (NILP (item)) 603 push_left_right_boundary (); 604 else 605 { 606 CHECK_CONS (item); 607 item1 = Fcar (item); 608 CHECK_STRING (item1); 609 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil); 610 } 611 } 612} 613 614DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0, 615 doc: /* Pop up a deck-of-cards menu and return user's selection. 616POSITION is a position specification. This is either a mouse button 617event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET 618are positions in pixels from the top left corner of WINDOW's frame 619\(WINDOW may be a frame object instead of a window). This controls the 620position of the center of the first line in the first pane of the 621menu, not the top left of the menu as a whole. If POSITION is t, it 622means to use the current mouse position. 623 624MENU is a specifier for a menu. For the simplest case, MENU is a keymap. 625The menu items come from key bindings that have a menu string as well as 626a definition; actually, the \"definition\" in such a key binding looks like 627\(STRING . REAL-DEFINITION). To give the menu a title, put a string into 628the keymap as a top-level element. 629 630If REAL-DEFINITION is nil, that puts a nonselectable string in the menu. 631Otherwise, REAL-DEFINITION should be a valid key binding definition. 632 633You can also use a list of keymaps as MENU. Then each keymap makes a 634separate pane. When MENU is a keymap or a list of keymaps, the return 635value is a list of events. 636 637Alternatively, you can specify a menu of multiple panes with a list of 638the form (TITLE PANE1 PANE2...), where each pane is a list of 639form (TITLE ITEM1 ITEM2...). 640Each ITEM is normally a cons cell (STRING . VALUE); but a string can 641appear as an item--that makes a nonselectable line in the menu. 642With this form of menu, the return value is VALUE from the chosen item. 643 644If POSITION is nil, don't display the menu at all, just precalculate the 645cached information about equivalent key sequences. */) 646 (position, menu) 647 Lisp_Object position, menu; 648{ 649 Lisp_Object keymap, tem; 650 int xpos = 0, ypos = 0; 651 Lisp_Object title; 652 char *error_name; 653 Lisp_Object selection; 654 FRAME_PTR f = NULL; 655 Lisp_Object x, y, window; 656 int keymaps = 0; 657 int for_click = 0; 658 struct gcpro gcpro1; 659 660#ifdef HAVE_MENUS 661 if (! NILP (position)) 662 { 663 check_w32 (); 664 665 /* Decode the first argument: find the window and the coordinates. */ 666 if (EQ (position, Qt) 667 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar) 668 || EQ (XCAR (position), Qtool_bar)))) 669 { 670 /* Use the mouse's current position. */ 671 FRAME_PTR new_f = SELECTED_FRAME (); 672 Lisp_Object bar_window; 673 enum scroll_bar_part part; 674 unsigned long time; 675 676 if (mouse_position_hook) 677 (*mouse_position_hook) (&new_f, 1, &bar_window, 678 &part, &x, &y, &time); 679 if (new_f != 0) 680 XSETFRAME (window, new_f); 681 else 682 { 683 window = selected_window; 684 XSETFASTINT (x, 0); 685 XSETFASTINT (y, 0); 686 } 687 } 688 else 689 { 690 tem = Fcar (position); 691 if (CONSP (tem)) 692 { 693 window = Fcar (Fcdr (position)); 694 x = Fcar (tem); 695 y = Fcar (Fcdr (tem)); 696 } 697 else 698 { 699 for_click = 1; 700 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ 701 window = Fcar (tem); /* POSN_WINDOW (tem) */ 702 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */ 703 x = Fcar (tem); 704 y = Fcdr (tem); 705 } 706 } 707 708 CHECK_NUMBER (x); 709 CHECK_NUMBER (y); 710 711 /* Decode where to put the menu. */ 712 713 if (FRAMEP (window)) 714 { 715 f = XFRAME (window); 716 xpos = 0; 717 ypos = 0; 718 } 719 else if (WINDOWP (window)) 720 { 721 CHECK_LIVE_WINDOW (window); 722 f = XFRAME (WINDOW_FRAME (XWINDOW (window))); 723 724 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window)); 725 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window)); 726 } 727 else 728 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, 729 but I don't want to make one now. */ 730 CHECK_WINDOW (window); 731 732 xpos += XINT (x); 733 ypos += XINT (y); 734 735 XSETFRAME (Vmenu_updating_frame, f); 736 } 737 else 738 Vmenu_updating_frame = Qnil; 739#endif /* HAVE_MENUS */ 740 741 title = Qnil; 742 GCPRO1 (title); 743 744 /* Decode the menu items from what was specified. */ 745 746 keymap = get_keymap (menu, 0, 0); 747 if (CONSP (keymap)) 748 { 749 /* We were given a keymap. Extract menu info from the keymap. */ 750 Lisp_Object prompt; 751 752 /* Extract the detailed info to make one pane. */ 753 keymap_panes (&menu, 1, NILP (position)); 754 755 /* Search for a string appearing directly as an element of the keymap. 756 That string is the title of the menu. */ 757 prompt = Fkeymap_prompt (keymap); 758 if (NILP (title) && !NILP (prompt)) 759 title = prompt; 760 761 /* Make that be the pane title of the first pane. */ 762 if (!NILP (prompt) && menu_items_n_panes >= 0) 763 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt); 764 765 keymaps = 1; 766 } 767 else if (CONSP (menu) && KEYMAPP (XCAR (menu))) 768 { 769 /* We were given a list of keymaps. */ 770 int nmaps = XFASTINT (Flength (menu)); 771 Lisp_Object *maps 772 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); 773 int i; 774 775 title = Qnil; 776 777 /* The first keymap that has a prompt string 778 supplies the menu title. */ 779 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem)) 780 { 781 Lisp_Object prompt; 782 783 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0); 784 785 prompt = Fkeymap_prompt (keymap); 786 if (NILP (title) && !NILP (prompt)) 787 title = prompt; 788 } 789 790 /* Extract the detailed info to make one pane. */ 791 keymap_panes (maps, nmaps, NILP (position)); 792 793 /* Make the title be the pane title of the first pane. */ 794 if (!NILP (title) && menu_items_n_panes >= 0) 795 ASET (menu_items, MENU_ITEMS_PANE_NAME, title); 796 797 keymaps = 1; 798 } 799 else 800 { 801 /* We were given an old-fashioned menu. */ 802 title = Fcar (menu); 803 CHECK_STRING (title); 804 805 list_of_panes (Fcdr (menu)); 806 807 keymaps = 0; 808 } 809 810 if (NILP (position)) 811 { 812 discard_menu_items (); 813 UNGCPRO; 814 return Qnil; 815 } 816 817#ifdef HAVE_MENUS 818 /* If resources from a previous popup menu still exist, does nothing 819 until the `menu_free_timer' has freed them (see w32fns.c). This 820 can occur if you press ESC or click outside a menu without selecting 821 a menu item. 822 */ 823 if (current_popup_menu) 824 { 825 discard_menu_items (); 826 UNGCPRO; 827 return Qnil; 828 } 829 830 /* Display them in a menu. */ 831 BLOCK_INPUT; 832 833 selection = w32_menu_show (f, xpos, ypos, for_click, 834 keymaps, title, &error_name); 835 UNBLOCK_INPUT; 836 837 discard_menu_items (); 838 839#endif /* HAVE_MENUS */ 840 841 UNGCPRO; 842 843 if (error_name) error (error_name); 844 return selection; 845} 846 847#ifdef HAVE_MENUS 848 849DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0, 850 doc: /* Pop up a dialog box and return user's selection. 851POSITION specifies which frame to use. 852This is normally a mouse button event or a window or frame. 853If POSITION is t, it means to use the frame the mouse is on. 854The dialog box appears in the middle of the specified frame. 855 856CONTENTS specifies the alternatives to display in the dialog box. 857It is a list of the form (TITLE ITEM1 ITEM2...). 858Each ITEM is a cons cell (STRING . VALUE). 859The return value is VALUE from the chosen item. 860 861An ITEM may also be just a string--that makes a nonselectable item. 862An ITEM may also be nil--that means to put all preceding items 863on the left of the dialog box and all following items on the right. 864\(By default, approximately half appear on each side.) 865 866If HEADER is non-nil, the frame title for the box is "Information", 867otherwise it is "Question". */) 868 (position, contents, header) 869 Lisp_Object position, contents, header; 870{ 871 FRAME_PTR f = NULL; 872 Lisp_Object window; 873 874 check_w32 (); 875 876 /* Decode the first argument: find the window or frame to use. */ 877 if (EQ (position, Qt) 878 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar) 879 || EQ (XCAR (position), Qtool_bar)))) 880 { 881#if 0 /* Using the frame the mouse is on may not be right. */ 882 /* Use the mouse's current position. */ 883 FRAME_PTR new_f = SELECTED_FRAME (); 884 Lisp_Object bar_window; 885 enum scroll_bar_part part; 886 unsigned long time; 887 Lisp_Object x, y; 888 889 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time); 890 891 if (new_f != 0) 892 XSETFRAME (window, new_f); 893 else 894 window = selected_window; 895#endif 896 window = selected_window; 897 } 898 else if (CONSP (position)) 899 { 900 Lisp_Object tem; 901 tem = Fcar (position); 902 if (CONSP (tem)) 903 window = Fcar (Fcdr (position)); 904 else 905 { 906 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ 907 window = Fcar (tem); /* POSN_WINDOW (tem) */ 908 } 909 } 910 else if (WINDOWP (position) || FRAMEP (position)) 911 window = position; 912 else 913 window = Qnil; 914 915 /* Decode where to put the menu. */ 916 917 if (FRAMEP (window)) 918 f = XFRAME (window); 919 else if (WINDOWP (window)) 920 { 921 CHECK_LIVE_WINDOW (window); 922 f = XFRAME (WINDOW_FRAME (XWINDOW (window))); 923 } 924 else 925 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, 926 but I don't want to make one now. */ 927 CHECK_WINDOW (window); 928 929#ifndef HAVE_DIALOGS 930 /* Display a menu with these alternatives 931 in the middle of frame F. */ 932 { 933 Lisp_Object x, y, frame, newpos; 934 XSETFRAME (frame, f); 935 XSETINT (x, x_pixel_width (f) / 2); 936 XSETINT (y, x_pixel_height (f) / 2); 937 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil)); 938 939 return Fx_popup_menu (newpos, 940 Fcons (Fcar (contents), Fcons (contents, Qnil))); 941 } 942#else /* HAVE_DIALOGS */ 943 { 944 Lisp_Object title; 945 char *error_name; 946 Lisp_Object selection; 947 948 /* Decode the dialog items from what was specified. */ 949 title = Fcar (contents); 950 CHECK_STRING (title); 951 952 list_of_panes (Fcons (contents, Qnil)); 953 954 /* Display them in a dialog box. */ 955 BLOCK_INPUT; 956 selection = w32_dialog_show (f, 0, title, header, &error_name); 957 UNBLOCK_INPUT; 958 959 discard_menu_items (); 960 961 if (error_name) error (error_name); 962 return selection; 963 } 964#endif /* HAVE_DIALOGS */ 965} 966 967/* Activate the menu bar of frame F. 968 This is called from keyboard.c when it gets the 969 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue. 970 971 To activate the menu bar, we signal to the input thread that it can 972 return from the WM_INITMENU message, allowing the normal Windows 973 processing of the menus. 974 975 But first we recompute the menu bar contents (the whole tree). 976 977 This way we can safely execute Lisp code. */ 978 979void 980x_activate_menubar (f) 981 FRAME_PTR f; 982{ 983 set_frame_menubar (f, 0, 1); 984 985 /* Lock out further menubar changes while active. */ 986 f->output_data.w32->menubar_active = 1; 987 988 /* Signal input thread to return from WM_INITMENU. */ 989 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0); 990} 991 992/* This callback is called from the menu bar pulldown menu 993 when the user makes a selection. 994 Figure out what the user chose 995 and put the appropriate events into the keyboard buffer. */ 996 997void 998menubar_selection_callback (FRAME_PTR f, void * client_data) 999{ 1000 Lisp_Object prefix, entry; 1001 Lisp_Object vector; 1002 Lisp_Object *subprefix_stack; 1003 int submenu_depth = 0; 1004 int i; 1005 1006 if (!f) 1007 return; 1008 entry = Qnil; 1009 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object)); 1010 vector = f->menu_bar_vector; 1011 prefix = Qnil; 1012 i = 0; 1013 while (i < f->menu_bar_items_used) 1014 { 1015 if (EQ (AREF (vector, i), Qnil)) 1016 { 1017 subprefix_stack[submenu_depth++] = prefix; 1018 prefix = entry; 1019 i++; 1020 } 1021 else if (EQ (AREF (vector, i), Qlambda)) 1022 { 1023 prefix = subprefix_stack[--submenu_depth]; 1024 i++; 1025 } 1026 else if (EQ (AREF (vector, i), Qt)) 1027 { 1028 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX); 1029 i += MENU_ITEMS_PANE_LENGTH; 1030 } 1031 else 1032 { 1033 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE); 1034 /* The EMACS_INT cast avoids a warning. There's no problem 1035 as long as pointers have enough bits to hold small integers. */ 1036 if ((int) (EMACS_INT) client_data == i) 1037 { 1038 int j; 1039 struct input_event buf; 1040 Lisp_Object frame; 1041 EVENT_INIT (buf); 1042 1043 XSETFRAME (frame, f); 1044 buf.kind = MENU_BAR_EVENT; 1045 buf.frame_or_window = frame; 1046 buf.arg = frame; 1047 kbd_buffer_store_event (&buf); 1048 1049 for (j = 0; j < submenu_depth; j++) 1050 if (!NILP (subprefix_stack[j])) 1051 { 1052 buf.kind = MENU_BAR_EVENT; 1053 buf.frame_or_window = frame; 1054 buf.arg = subprefix_stack[j]; 1055 kbd_buffer_store_event (&buf); 1056 } 1057 1058 if (!NILP (prefix)) 1059 { 1060 buf.kind = MENU_BAR_EVENT; 1061 buf.frame_or_window = frame; 1062 buf.arg = prefix; 1063 kbd_buffer_store_event (&buf); 1064 } 1065 1066 buf.kind = MENU_BAR_EVENT; 1067 buf.frame_or_window = frame; 1068 buf.arg = entry; 1069 /* Free memory used by owner-drawn and help-echo strings. */ 1070 w32_free_menu_strings (FRAME_W32_WINDOW (f)); 1071 kbd_buffer_store_event (&buf); 1072 1073 f->output_data.w32->menubar_active = 0; 1074 return; 1075 } 1076 i += MENU_ITEMS_ITEM_LENGTH; 1077 } 1078 } 1079 /* Free memory used by owner-drawn and help-echo strings. */ 1080 w32_free_menu_strings (FRAME_W32_WINDOW (f)); 1081 f->output_data.w32->menubar_active = 0; 1082} 1083 1084/* Allocate a widget_value, blocking input. */ 1085 1086widget_value * 1087xmalloc_widget_value () 1088{ 1089 widget_value *value; 1090 1091 BLOCK_INPUT; 1092 value = malloc_widget_value (); 1093 UNBLOCK_INPUT; 1094 1095 return value; 1096} 1097 1098/* This recursively calls free_widget_value on the tree of widgets. 1099 It must free all data that was malloc'ed for these widget_values. 1100 In Emacs, many slots are pointers into the data of Lisp_Strings, and 1101 must be left alone. */ 1102 1103void 1104free_menubar_widget_value_tree (wv) 1105 widget_value *wv; 1106{ 1107 if (! wv) return; 1108 1109 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF; 1110 1111 if (wv->contents && (wv->contents != (widget_value*)1)) 1112 { 1113 free_menubar_widget_value_tree (wv->contents); 1114 wv->contents = (widget_value *) 0xDEADBEEF; 1115 } 1116 if (wv->next) 1117 { 1118 free_menubar_widget_value_tree (wv->next); 1119 wv->next = (widget_value *) 0xDEADBEEF; 1120 } 1121 BLOCK_INPUT; 1122 free_widget_value (wv); 1123 UNBLOCK_INPUT; 1124} 1125 1126/* Set up data i menu_items for a menu bar item 1127 whose event type is ITEM_KEY (with string ITEM_NAME) 1128 and whose contents come from the list of keymaps MAPS. */ 1129 1130static int 1131parse_single_submenu (item_key, item_name, maps) 1132 Lisp_Object item_key, item_name, maps; 1133{ 1134 Lisp_Object length; 1135 int len; 1136 Lisp_Object *mapvec; 1137 int i; 1138 int top_level_items = 0; 1139 1140 length = Flength (maps); 1141 len = XINT (length); 1142 1143 /* Convert the list MAPS into a vector MAPVEC. */ 1144 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); 1145 for (i = 0; i < len; i++) 1146 { 1147 mapvec[i] = Fcar (maps); 1148 maps = Fcdr (maps); 1149 } 1150 1151 /* Loop over the given keymaps, making a pane for each map. 1152 But don't make a pane that is empty--ignore that map instead. */ 1153 for (i = 0; i < len; i++) 1154 { 1155 if (SYMBOLP (mapvec[i]) 1156 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i]))) 1157 { 1158 /* Here we have a command at top level in the menu bar 1159 as opposed to a submenu. */ 1160 top_level_items = 1; 1161 push_menu_pane (Qnil, Qnil); 1162 push_menu_item (item_name, Qt, item_key, mapvec[i], 1163 Qnil, Qnil, Qnil, Qnil); 1164 } 1165 else 1166 { 1167 Lisp_Object prompt; 1168 prompt = Fkeymap_prompt (mapvec[i]); 1169 single_keymap_panes (mapvec[i], 1170 !NILP (prompt) ? prompt : item_name, 1171 item_key, 0, 10); 1172 } 1173 } 1174 1175 return top_level_items; 1176} 1177 1178 1179/* Create a tree of widget_value objects 1180 representing the panes and items 1181 in menu_items starting at index START, up to index END. */ 1182 1183static widget_value * 1184digest_single_submenu (start, end, top_level_items) 1185 int start, end, top_level_items; 1186{ 1187 widget_value *wv, *prev_wv, *save_wv, *first_wv; 1188 int i; 1189 int submenu_depth = 0; 1190 widget_value **submenu_stack; 1191 1192 submenu_stack 1193 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *)); 1194 wv = xmalloc_widget_value (); 1195 wv->name = "menu"; 1196 wv->value = 0; 1197 wv->enabled = 1; 1198 wv->button_type = BUTTON_TYPE_NONE; 1199 wv->help = Qnil; 1200 first_wv = wv; 1201 save_wv = 0; 1202 prev_wv = 0; 1203 1204 /* Loop over all panes and items made by the preceding call 1205 to parse_single_submenu and construct a tree of widget_value objects. 1206 Ignore the panes and items used by previous calls to 1207 digest_single_submenu, even though those are also in menu_items. */ 1208 i = start; 1209 while (i < end) 1210 { 1211 if (EQ (AREF (menu_items, i), Qnil)) 1212 { 1213 submenu_stack[submenu_depth++] = save_wv; 1214 save_wv = prev_wv; 1215 prev_wv = 0; 1216 i++; 1217 } 1218 else if (EQ (AREF (menu_items, i), Qlambda)) 1219 { 1220 prev_wv = save_wv; 1221 save_wv = submenu_stack[--submenu_depth]; 1222 i++; 1223 } 1224 else if (EQ (AREF (menu_items, i), Qt) 1225 && submenu_depth != 0) 1226 i += MENU_ITEMS_PANE_LENGTH; 1227 /* Ignore a nil in the item list. 1228 It's meaningful only for dialog boxes. */ 1229 else if (EQ (AREF (menu_items, i), Qquote)) 1230 i += 1; 1231 else if (EQ (AREF (menu_items, i), Qt)) 1232 { 1233 /* Create a new pane. */ 1234 Lisp_Object pane_name, prefix; 1235 char *pane_string; 1236 1237 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME); 1238 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX); 1239 1240 if (STRINGP (pane_name)) 1241 { 1242 if (unicode_append_menu) 1243 /* Encode as UTF-8 for now. */ 1244 pane_name = ENCODE_UTF_8 (pane_name); 1245 else if (STRING_MULTIBYTE (pane_name)) 1246 pane_name = ENCODE_SYSTEM (pane_name); 1247 1248 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); 1249 } 1250 1251 pane_string = (NILP (pane_name) 1252 ? "" : (char *) SDATA (pane_name)); 1253 /* If there is just one top-level pane, put all its items directly 1254 under the top-level menu. */ 1255 if (menu_items_n_panes == 1) 1256 pane_string = ""; 1257 1258 /* If the pane has a meaningful name, 1259 make the pane a top-level menu item 1260 with its items as a submenu beneath it. */ 1261 if (strcmp (pane_string, "")) 1262 { 1263 wv = xmalloc_widget_value (); 1264 if (save_wv) 1265 save_wv->next = wv; 1266 else 1267 first_wv->contents = wv; 1268 wv->lname = pane_name; 1269 /* Set value to 1 so update_submenu_strings can handle '@' */ 1270 wv->value = (char *) 1; 1271 wv->enabled = 1; 1272 wv->button_type = BUTTON_TYPE_NONE; 1273 wv->help = Qnil; 1274 } 1275 save_wv = wv; 1276 prev_wv = 0; 1277 i += MENU_ITEMS_PANE_LENGTH; 1278 } 1279 else 1280 { 1281 /* Create a new item within current pane. */ 1282 Lisp_Object item_name, enable, descrip, def, type, selected; 1283 Lisp_Object help; 1284 1285 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME); 1286 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE); 1287 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY); 1288 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION); 1289 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE); 1290 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED); 1291 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP); 1292 1293 if (STRINGP (item_name)) 1294 { 1295 if (unicode_append_menu) 1296 item_name = ENCODE_UTF_8 (item_name); 1297 else if (STRING_MULTIBYTE (item_name)) 1298 item_name = ENCODE_SYSTEM (item_name); 1299 1300 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name); 1301 } 1302 1303 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip)) 1304 { 1305 descrip = ENCODE_SYSTEM (descrip); 1306 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip); 1307 } 1308 1309 wv = xmalloc_widget_value (); 1310 if (prev_wv) 1311 prev_wv->next = wv; 1312 else 1313 save_wv->contents = wv; 1314 1315 wv->lname = item_name; 1316 if (!NILP (descrip)) 1317 wv->lkey = descrip; 1318 wv->value = 0; 1319 /* The EMACS_INT cast avoids a warning. There's no problem 1320 as long as pointers have enough bits to hold small integers. */ 1321 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0); 1322 wv->enabled = !NILP (enable); 1323 1324 if (NILP (type)) 1325 wv->button_type = BUTTON_TYPE_NONE; 1326 else if (EQ (type, QCradio)) 1327 wv->button_type = BUTTON_TYPE_RADIO; 1328 else if (EQ (type, QCtoggle)) 1329 wv->button_type = BUTTON_TYPE_TOGGLE; 1330 else 1331 abort (); 1332 1333 wv->selected = !NILP (selected); 1334 if (!STRINGP (help)) 1335 help = Qnil; 1336 1337 wv->help = help; 1338 1339 prev_wv = wv; 1340 1341 i += MENU_ITEMS_ITEM_LENGTH; 1342 } 1343 } 1344 1345 /* If we have just one "menu item" 1346 that was originally a button, return it by itself. */ 1347 if (top_level_items && first_wv->contents && first_wv->contents->next == 0) 1348 { 1349 wv = first_wv->contents; 1350 free_widget_value (first_wv); 1351 return wv; 1352 } 1353 1354 return first_wv; 1355} 1356 1357 1358/* Walk through the widget_value tree starting at FIRST_WV and update 1359 the char * pointers from the corresponding lisp values. 1360 We do this after building the whole tree, since GC may happen while the 1361 tree is constructed, and small strings are relocated. So we must wait 1362 until no GC can happen before storing pointers into lisp values. */ 1363static void 1364update_submenu_strings (first_wv) 1365 widget_value *first_wv; 1366{ 1367 widget_value *wv; 1368 1369 for (wv = first_wv; wv; wv = wv->next) 1370 { 1371 if (wv->lname && ! NILP (wv->lname)) 1372 { 1373 wv->name = SDATA (wv->lname); 1374 1375 /* Ignore the @ that means "separate pane". 1376 This is a kludge, but this isn't worth more time. */ 1377 if (wv->value == (char *)1) 1378 { 1379 if (wv->name[0] == '@') 1380 wv->name++; 1381 wv->value = 0; 1382 } 1383 } 1384 1385 if (wv->lkey && ! NILP (wv->lkey)) 1386 wv->key = SDATA (wv->lkey); 1387 1388 if (wv->contents) 1389 update_submenu_strings (wv->contents); 1390 } 1391} 1392 1393 1394/* Set the contents of the menubar widgets of frame F. 1395 The argument FIRST_TIME is currently ignored; 1396 it is set the first time this is called, from initialize_frame_menubar. */ 1397 1398void 1399set_frame_menubar (f, first_time, deep_p) 1400 FRAME_PTR f; 1401 int first_time; 1402 int deep_p; 1403{ 1404 HMENU menubar_widget = f->output_data.w32->menubar_widget; 1405 Lisp_Object items; 1406 widget_value *wv, *first_wv, *prev_wv = 0; 1407 int i, last_i; 1408 int *submenu_start, *submenu_end; 1409 int *submenu_top_level_items, *submenu_n_panes; 1410 1411 /* We must not change the menubar when actually in use. */ 1412 if (f->output_data.w32->menubar_active) 1413 return; 1414 1415 XSETFRAME (Vmenu_updating_frame, f); 1416 1417 if (! menubar_widget) 1418 deep_p = 1; 1419 else if (pending_menu_activation && !deep_p) 1420 deep_p = 1; 1421 1422 if (deep_p) 1423 { 1424 /* Make a widget-value tree representing the entire menu trees. */ 1425 1426 struct buffer *prev = current_buffer; 1427 Lisp_Object buffer; 1428 int specpdl_count = SPECPDL_INDEX (); 1429 int previous_menu_items_used = f->menu_bar_items_used; 1430 Lisp_Object *previous_items 1431 = (Lisp_Object *) alloca (previous_menu_items_used 1432 * sizeof (Lisp_Object)); 1433 1434 /* If we are making a new widget, its contents are empty, 1435 do always reinitialize them. */ 1436 if (! menubar_widget) 1437 previous_menu_items_used = 0; 1438 1439 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer; 1440 specbind (Qinhibit_quit, Qt); 1441 /* Don't let the debugger step into this code 1442 because it is not reentrant. */ 1443 specbind (Qdebug_on_next_call, Qnil); 1444 1445 record_unwind_save_match_data (); 1446 1447 if (NILP (Voverriding_local_map_menu_flag)) 1448 { 1449 specbind (Qoverriding_terminal_local_map, Qnil); 1450 specbind (Qoverriding_local_map, Qnil); 1451 } 1452 1453 set_buffer_internal_1 (XBUFFER (buffer)); 1454 1455 /* Run the Lucid hook. */ 1456 safe_run_hooks (Qactivate_menubar_hook); 1457 /* If it has changed current-menubar from previous value, 1458 really recompute the menubar from the value. */ 1459 if (! NILP (Vlucid_menu_bar_dirty_flag)) 1460 call0 (Qrecompute_lucid_menubar); 1461 safe_run_hooks (Qmenu_bar_update_hook); 1462 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); 1463 1464 items = FRAME_MENU_BAR_ITEMS (f); 1465 1466 /* Save the frame's previous menu bar contents data. */ 1467 if (previous_menu_items_used) 1468 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items, 1469 previous_menu_items_used * sizeof (Lisp_Object)); 1470 1471 /* Fill in menu_items with the current menu bar contents. 1472 This can evaluate Lisp code. */ 1473 menu_items = f->menu_bar_vector; 1474 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0; 1475 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *)); 1476 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *)); 1477 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int)); 1478 submenu_top_level_items 1479 = (int *) alloca (XVECTOR (items)->size * sizeof (int *)); 1480 init_menu_items (); 1481 for (i = 0; i < ASIZE (items); i += 4) 1482 { 1483 Lisp_Object key, string, maps; 1484 1485 last_i = i; 1486 1487 key = AREF (items, i); 1488 string = AREF (items, i + 1); 1489 maps = AREF (items, i + 2); 1490 if (NILP (string)) 1491 break; 1492 1493 submenu_start[i] = menu_items_used; 1494 1495 menu_items_n_panes = 0; 1496 submenu_top_level_items[i] 1497 = parse_single_submenu (key, string, maps); 1498 submenu_n_panes[i] = menu_items_n_panes; 1499 1500 submenu_end[i] = menu_items_used; 1501 } 1502 1503 finish_menu_items (); 1504 1505 /* Convert menu_items into widget_value trees 1506 to display the menu. This cannot evaluate Lisp code. */ 1507 1508 wv = xmalloc_widget_value (); 1509 wv->name = "menubar"; 1510 wv->value = 0; 1511 wv->enabled = 1; 1512 wv->button_type = BUTTON_TYPE_NONE; 1513 wv->help = Qnil; 1514 first_wv = wv; 1515 1516 for (i = 0; i < last_i; i += 4) 1517 { 1518 menu_items_n_panes = submenu_n_panes[i]; 1519 wv = digest_single_submenu (submenu_start[i], submenu_end[i], 1520 submenu_top_level_items[i]); 1521 if (prev_wv) 1522 prev_wv->next = wv; 1523 else 1524 first_wv->contents = wv; 1525 /* Don't set wv->name here; GC during the loop might relocate it. */ 1526 wv->enabled = 1; 1527 wv->button_type = BUTTON_TYPE_NONE; 1528 prev_wv = wv; 1529 } 1530 1531 set_buffer_internal_1 (prev); 1532 unbind_to (specpdl_count, Qnil); 1533 1534 /* If there has been no change in the Lisp-level contents 1535 of the menu bar, skip redisplaying it. Just exit. */ 1536 1537 for (i = 0; i < previous_menu_items_used; i++) 1538 if (menu_items_used == i 1539 || (!EQ (previous_items[i], AREF (menu_items, i)))) 1540 break; 1541 if (i == menu_items_used && i == previous_menu_items_used && i != 0) 1542 { 1543 free_menubar_widget_value_tree (first_wv); 1544 menu_items = Qnil; 1545 1546 return; 1547 } 1548 1549 /* Now GC cannot happen during the lifetime of the widget_value, 1550 so it's safe to store data from a Lisp_String, as long as 1551 local copies are made when the actual menu is created. 1552 Windows takes care of this for normal string items, but 1553 not for owner-drawn items or additional item-info. */ 1554 wv = first_wv->contents; 1555 for (i = 0; i < ASIZE (items); i += 4) 1556 { 1557 Lisp_Object string; 1558 string = AREF (items, i + 1); 1559 if (NILP (string)) 1560 break; 1561 wv->name = (char *) SDATA (string); 1562 update_submenu_strings (wv->contents); 1563 wv = wv->next; 1564 } 1565 1566 f->menu_bar_vector = menu_items; 1567 f->menu_bar_items_used = menu_items_used; 1568 menu_items = Qnil; 1569 } 1570 else 1571 { 1572 /* Make a widget-value tree containing 1573 just the top level menu bar strings. */ 1574 1575 wv = xmalloc_widget_value (); 1576 wv->name = "menubar"; 1577 wv->value = 0; 1578 wv->enabled = 1; 1579 wv->button_type = BUTTON_TYPE_NONE; 1580 wv->help = Qnil; 1581 first_wv = wv; 1582 1583 items = FRAME_MENU_BAR_ITEMS (f); 1584 for (i = 0; i < ASIZE (items); i += 4) 1585 { 1586 Lisp_Object string; 1587 1588 string = AREF (items, i + 1); 1589 if (NILP (string)) 1590 break; 1591 1592 wv = xmalloc_widget_value (); 1593 wv->name = (char *) SDATA (string); 1594 wv->value = 0; 1595 wv->enabled = 1; 1596 wv->button_type = BUTTON_TYPE_NONE; 1597 wv->help = Qnil; 1598 /* This prevents lwlib from assuming this 1599 menu item is really supposed to be empty. */ 1600 /* The EMACS_INT cast avoids a warning. 1601 This value just has to be different from small integers. */ 1602 wv->call_data = (void *) (EMACS_INT) (-1); 1603 1604 if (prev_wv) 1605 prev_wv->next = wv; 1606 else 1607 first_wv->contents = wv; 1608 prev_wv = wv; 1609 } 1610 1611 /* Forget what we thought we knew about what is in the 1612 detailed contents of the menu bar menus. 1613 Changing the top level always destroys the contents. */ 1614 f->menu_bar_items_used = 0; 1615 } 1616 1617 /* Create or update the menu bar widget. */ 1618 1619 BLOCK_INPUT; 1620 1621 if (menubar_widget) 1622 { 1623 /* Empty current menubar, rather than creating a fresh one. */ 1624 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION)) 1625 ; 1626 } 1627 else 1628 { 1629 menubar_widget = CreateMenu (); 1630 } 1631 fill_in_menu (menubar_widget, first_wv->contents); 1632 1633 free_menubar_widget_value_tree (first_wv); 1634 1635 { 1636 HMENU old_widget = f->output_data.w32->menubar_widget; 1637 1638 f->output_data.w32->menubar_widget = menubar_widget; 1639 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget); 1640 /* Causes flicker when menu bar is updated 1641 DrawMenuBar (FRAME_W32_WINDOW (f)); */ 1642 1643 /* Force the window size to be recomputed so that the frame's text 1644 area remains the same, if menubar has just been created. */ 1645 if (old_widget == NULL) 1646 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f)); 1647 } 1648 1649 UNBLOCK_INPUT; 1650} 1651 1652/* Called from Fx_create_frame to create the initial menubar of a frame 1653 before it is mapped, so that the window is mapped with the menubar already 1654 there instead of us tacking it on later and thrashing the window after it 1655 is visible. */ 1656 1657void 1658initialize_frame_menubar (f) 1659 FRAME_PTR f; 1660{ 1661 /* This function is called before the first chance to redisplay 1662 the frame. It has to be, so the frame will have the right size. */ 1663 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); 1664 set_frame_menubar (f, 1, 1); 1665} 1666 1667/* Get rid of the menu bar of frame F, and free its storage. 1668 This is used when deleting a frame, and when turning off the menu bar. */ 1669 1670void 1671free_frame_menubar (f) 1672 FRAME_PTR f; 1673{ 1674 BLOCK_INPUT; 1675 1676 { 1677 HMENU old = GetMenu (FRAME_W32_WINDOW (f)); 1678 SetMenu (FRAME_W32_WINDOW (f), NULL); 1679 f->output_data.w32->menubar_widget = NULL; 1680 DestroyMenu (old); 1681 } 1682 1683 UNBLOCK_INPUT; 1684} 1685 1686 1687/* w32_menu_show actually displays a menu using the panes and items in 1688 menu_items and returns the value selected from it; we assume input 1689 is blocked by the caller. */ 1690 1691/* F is the frame the menu is for. 1692 X and Y are the frame-relative specified position, 1693 relative to the inside upper left corner of the frame F. 1694 FOR_CLICK is nonzero if this menu was invoked for a mouse click. 1695 KEYMAPS is 1 if this menu was specified with keymaps; 1696 in that case, we return a list containing the chosen item's value 1697 and perhaps also the pane's prefix. 1698 TITLE is the specified menu title. 1699 ERROR is a place to store an error message string in case of failure. 1700 (We return nil on failure, but the value doesn't actually matter.) */ 1701 1702static Lisp_Object 1703w32_menu_show (f, x, y, for_click, keymaps, title, error) 1704 FRAME_PTR f; 1705 int x; 1706 int y; 1707 int for_click; 1708 int keymaps; 1709 Lisp_Object title; 1710 char **error; 1711{ 1712 int i; 1713 int menu_item_selection; 1714 HMENU menu; 1715 POINT pos; 1716 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0; 1717 widget_value **submenu_stack 1718 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *)); 1719 Lisp_Object *subprefix_stack 1720 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object)); 1721 int submenu_depth = 0; 1722 int first_pane; 1723 1724 *error = NULL; 1725 1726 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH) 1727 { 1728 *error = "Empty menu"; 1729 return Qnil; 1730 } 1731 1732 /* Create a tree of widget_value objects 1733 representing the panes and their items. */ 1734 wv = xmalloc_widget_value (); 1735 wv->name = "menu"; 1736 wv->value = 0; 1737 wv->enabled = 1; 1738 wv->button_type = BUTTON_TYPE_NONE; 1739 wv->help = Qnil; 1740 first_wv = wv; 1741 first_pane = 1; 1742 1743 /* Loop over all panes and items, filling in the tree. */ 1744 i = 0; 1745 while (i < menu_items_used) 1746 { 1747 if (EQ (AREF (menu_items, i), Qnil)) 1748 { 1749 submenu_stack[submenu_depth++] = save_wv; 1750 save_wv = prev_wv; 1751 prev_wv = 0; 1752 first_pane = 1; 1753 i++; 1754 } 1755 else if (EQ (AREF (menu_items, i), Qlambda)) 1756 { 1757 prev_wv = save_wv; 1758 save_wv = submenu_stack[--submenu_depth]; 1759 first_pane = 0; 1760 i++; 1761 } 1762 else if (EQ (AREF (menu_items, i), Qt) 1763 && submenu_depth != 0) 1764 i += MENU_ITEMS_PANE_LENGTH; 1765 /* Ignore a nil in the item list. 1766 It's meaningful only for dialog boxes. */ 1767 else if (EQ (AREF (menu_items, i), Qquote)) 1768 i += 1; 1769 else if (EQ (AREF (menu_items, i), Qt)) 1770 { 1771 /* Create a new pane. */ 1772 Lisp_Object pane_name, prefix; 1773 char *pane_string; 1774 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME); 1775 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX); 1776 1777 if (STRINGP (pane_name)) 1778 { 1779 if (unicode_append_menu) 1780 pane_name = ENCODE_UTF_8 (pane_name); 1781 else if (STRING_MULTIBYTE (pane_name)) 1782 pane_name = ENCODE_SYSTEM (pane_name); 1783 1784 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); 1785 } 1786 1787 pane_string = (NILP (pane_name) 1788 ? "" : (char *) SDATA (pane_name)); 1789 /* If there is just one top-level pane, put all its items directly 1790 under the top-level menu. */ 1791 if (menu_items_n_panes == 1) 1792 pane_string = ""; 1793 1794 /* If the pane has a meaningful name, 1795 make the pane a top-level menu item 1796 with its items as a submenu beneath it. */ 1797 if (!keymaps && strcmp (pane_string, "")) 1798 { 1799 wv = xmalloc_widget_value (); 1800 if (save_wv) 1801 save_wv->next = wv; 1802 else 1803 first_wv->contents = wv; 1804 wv->name = pane_string; 1805 if (keymaps && !NILP (prefix)) 1806 wv->name++; 1807 wv->value = 0; 1808 wv->enabled = 1; 1809 wv->button_type = BUTTON_TYPE_NONE; 1810 wv->help = Qnil; 1811 save_wv = wv; 1812 prev_wv = 0; 1813 } 1814 else if (first_pane) 1815 { 1816 save_wv = wv; 1817 prev_wv = 0; 1818 } 1819 first_pane = 0; 1820 i += MENU_ITEMS_PANE_LENGTH; 1821 } 1822 else 1823 { 1824 /* Create a new item within current pane. */ 1825 Lisp_Object item_name, enable, descrip, def, type, selected, help; 1826 1827 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME); 1828 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE); 1829 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY); 1830 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION); 1831 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE); 1832 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED); 1833 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP); 1834 1835 if (STRINGP (item_name)) 1836 { 1837 if (unicode_append_menu) 1838 item_name = ENCODE_UTF_8 (item_name); 1839 else if (STRING_MULTIBYTE (item_name)) 1840 item_name = ENCODE_SYSTEM (item_name); 1841 1842 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name); 1843 } 1844 1845 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip)) 1846 { 1847 descrip = ENCODE_SYSTEM (descrip); 1848 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip); 1849 } 1850 1851 wv = xmalloc_widget_value (); 1852 if (prev_wv) 1853 prev_wv->next = wv; 1854 else 1855 save_wv->contents = wv; 1856 wv->name = (char *) SDATA (item_name); 1857 if (!NILP (descrip)) 1858 wv->key = (char *) SDATA (descrip); 1859 wv->value = 0; 1860 /* Use the contents index as call_data, since we are 1861 restricted to 16-bits. */ 1862 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0; 1863 wv->enabled = !NILP (enable); 1864 1865 if (NILP (type)) 1866 wv->button_type = BUTTON_TYPE_NONE; 1867 else if (EQ (type, QCtoggle)) 1868 wv->button_type = BUTTON_TYPE_TOGGLE; 1869 else if (EQ (type, QCradio)) 1870 wv->button_type = BUTTON_TYPE_RADIO; 1871 else 1872 abort (); 1873 1874 wv->selected = !NILP (selected); 1875 if (!STRINGP (help)) 1876 help = Qnil; 1877 1878 wv->help = help; 1879 1880 prev_wv = wv; 1881 1882 i += MENU_ITEMS_ITEM_LENGTH; 1883 } 1884 } 1885 1886 /* Deal with the title, if it is non-nil. */ 1887 if (!NILP (title)) 1888 { 1889 widget_value *wv_title = xmalloc_widget_value (); 1890 widget_value *wv_sep = xmalloc_widget_value (); 1891 1892 /* Maybe replace this separator with a bitmap or owner-draw item 1893 so that it looks better. Having two separators looks odd. */ 1894 wv_sep->name = "--"; 1895 wv_sep->next = first_wv->contents; 1896 wv_sep->help = Qnil; 1897 1898 if (unicode_append_menu) 1899 title = ENCODE_UTF_8 (title); 1900 else if (STRING_MULTIBYTE (title)) 1901 title = ENCODE_SYSTEM (title); 1902 1903 wv_title->name = (char *) SDATA (title); 1904 wv_title->enabled = TRUE; 1905 wv_title->title = TRUE; 1906 wv_title->button_type = BUTTON_TYPE_NONE; 1907 wv_title->help = Qnil; 1908 wv_title->next = wv_sep; 1909 first_wv->contents = wv_title; 1910 } 1911 1912 /* Actually create the menu. */ 1913 current_popup_menu = menu = CreatePopupMenu (); 1914 fill_in_menu (menu, first_wv->contents); 1915 1916 /* Adjust coordinates to be root-window-relative. */ 1917 pos.x = x; 1918 pos.y = y; 1919 ClientToScreen (FRAME_W32_WINDOW (f), &pos); 1920 1921 /* No selection has been chosen yet. */ 1922 menu_item_selection = 0; 1923 1924 /* Display the menu. */ 1925 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f), 1926 WM_EMACS_TRACKPOPUPMENU, 1927 (WPARAM)menu, (LPARAM)&pos); 1928 1929 /* Clean up extraneous mouse events which might have been generated 1930 during the call. */ 1931 discard_mouse_events (); 1932 1933 /* Free the widget_value objects we used to specify the contents. */ 1934 free_menubar_widget_value_tree (first_wv); 1935 1936 DestroyMenu (menu); 1937 1938 /* Free the owner-drawn and help-echo menu strings. */ 1939 w32_free_menu_strings (FRAME_W32_WINDOW (f)); 1940 f->output_data.w32->menubar_active = 0; 1941 1942 /* Find the selected item, and its pane, to return 1943 the proper value. */ 1944 if (menu_item_selection != 0) 1945 { 1946 Lisp_Object prefix, entry; 1947 1948 prefix = entry = Qnil; 1949 i = 0; 1950 while (i < menu_items_used) 1951 { 1952 if (EQ (AREF (menu_items, i), Qnil)) 1953 { 1954 subprefix_stack[submenu_depth++] = prefix; 1955 prefix = entry; 1956 i++; 1957 } 1958 else if (EQ (AREF (menu_items, i), Qlambda)) 1959 { 1960 prefix = subprefix_stack[--submenu_depth]; 1961 i++; 1962 } 1963 else if (EQ (AREF (menu_items, i), Qt)) 1964 { 1965 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX); 1966 i += MENU_ITEMS_PANE_LENGTH; 1967 } 1968 /* Ignore a nil in the item list. 1969 It's meaningful only for dialog boxes. */ 1970 else if (EQ (AREF (menu_items, i), Qquote)) 1971 i += 1; 1972 else 1973 { 1974 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE); 1975 if (menu_item_selection == i) 1976 { 1977 if (keymaps != 0) 1978 { 1979 int j; 1980 1981 entry = Fcons (entry, Qnil); 1982 if (!NILP (prefix)) 1983 entry = Fcons (prefix, entry); 1984 for (j = submenu_depth - 1; j >= 0; j--) 1985 if (!NILP (subprefix_stack[j])) 1986 entry = Fcons (subprefix_stack[j], entry); 1987 } 1988 return entry; 1989 } 1990 i += MENU_ITEMS_ITEM_LENGTH; 1991 } 1992 } 1993 } 1994 else if (!for_click) 1995 /* Make "Cancel" equivalent to C-g. */ 1996 Fsignal (Qquit, Qnil); 1997 1998 return Qnil; 1999} 2000 2001 2002#ifdef HAVE_DIALOGS 2003static char * button_names [] = { 2004 "button1", "button2", "button3", "button4", "button5", 2005 "button6", "button7", "button8", "button9", "button10" }; 2006 2007static Lisp_Object 2008w32_dialog_show (f, keymaps, title, header, error) 2009 FRAME_PTR f; 2010 int keymaps; 2011 Lisp_Object title, header; 2012 char **error; 2013{ 2014 int i, nb_buttons=0; 2015 char dialog_name[6]; 2016 int menu_item_selection; 2017 2018 widget_value *wv, *first_wv = 0, *prev_wv = 0; 2019 2020 /* Number of elements seen so far, before boundary. */ 2021 int left_count = 0; 2022 /* 1 means we've seen the boundary between left-hand elts and right-hand. */ 2023 int boundary_seen = 0; 2024 2025 *error = NULL; 2026 2027 if (menu_items_n_panes > 1) 2028 { 2029 *error = "Multiple panes in dialog box"; 2030 return Qnil; 2031 } 2032 2033 /* Create a tree of widget_value objects 2034 representing the text label and buttons. */ 2035 { 2036 Lisp_Object pane_name, prefix; 2037 char *pane_string; 2038 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME); 2039 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX); 2040 pane_string = (NILP (pane_name) 2041 ? "" : (char *) SDATA (pane_name)); 2042 prev_wv = xmalloc_widget_value (); 2043 prev_wv->value = pane_string; 2044 if (keymaps && !NILP (prefix)) 2045 prev_wv->name++; 2046 prev_wv->enabled = 1; 2047 prev_wv->name = "message"; 2048 prev_wv->help = Qnil; 2049 first_wv = prev_wv; 2050 2051 /* Loop over all panes and items, filling in the tree. */ 2052 i = MENU_ITEMS_PANE_LENGTH; 2053 while (i < menu_items_used) 2054 { 2055 2056 /* Create a new item within current pane. */ 2057 Lisp_Object item_name, enable, descrip, help; 2058 2059 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME); 2060 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE); 2061 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY); 2062 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP); 2063 2064 if (NILP (item_name)) 2065 { 2066 free_menubar_widget_value_tree (first_wv); 2067 *error = "Submenu in dialog items"; 2068 return Qnil; 2069 } 2070 if (EQ (item_name, Qquote)) 2071 { 2072 /* This is the boundary between left-side elts 2073 and right-side elts. Stop incrementing right_count. */ 2074 boundary_seen = 1; 2075 i++; 2076 continue; 2077 } 2078 if (nb_buttons >= 9) 2079 { 2080 free_menubar_widget_value_tree (first_wv); 2081 *error = "Too many dialog items"; 2082 return Qnil; 2083 } 2084 2085 wv = xmalloc_widget_value (); 2086 prev_wv->next = wv; 2087 wv->name = (char *) button_names[nb_buttons]; 2088 if (!NILP (descrip)) 2089 wv->key = (char *) SDATA (descrip); 2090 wv->value = (char *) SDATA (item_name); 2091 wv->call_data = (void *) &AREF (menu_items, i); 2092 wv->enabled = !NILP (enable); 2093 wv->help = Qnil; 2094 prev_wv = wv; 2095 2096 if (! boundary_seen) 2097 left_count++; 2098 2099 nb_buttons++; 2100 i += MENU_ITEMS_ITEM_LENGTH; 2101 } 2102 2103 /* If the boundary was not specified, 2104 by default put half on the left and half on the right. */ 2105 if (! boundary_seen) 2106 left_count = nb_buttons - nb_buttons / 2; 2107 2108 wv = xmalloc_widget_value (); 2109 wv->name = dialog_name; 2110 wv->help = Qnil; 2111 2112 /* Frame title: 'Q' = Question, 'I' = Information. 2113 Can also have 'E' = Error if, one day, we want 2114 a popup for errors. */ 2115 if (NILP(header)) 2116 dialog_name[0] = 'Q'; 2117 else 2118 dialog_name[0] = 'I'; 2119 2120 /* Dialog boxes use a really stupid name encoding 2121 which specifies how many buttons to use 2122 and how many buttons are on the right. */ 2123 dialog_name[1] = '0' + nb_buttons; 2124 dialog_name[2] = 'B'; 2125 dialog_name[3] = 'R'; 2126 /* Number of buttons to put on the right. */ 2127 dialog_name[4] = '0' + nb_buttons - left_count; 2128 dialog_name[5] = 0; 2129 wv->contents = first_wv; 2130 first_wv = wv; 2131 } 2132 2133 /* Actually create the dialog. */ 2134 dialog_id = widget_id_tick++; 2135 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv, 2136 f->output_data.w32->widget, 1, 0, 2137 dialog_selection_callback, 0); 2138 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE); 2139 2140 /* Free the widget_value objects we used to specify the contents. */ 2141 free_menubar_widget_value_tree (first_wv); 2142 2143 /* No selection has been chosen yet. */ 2144 menu_item_selection = 0; 2145 2146 /* Display the menu. */ 2147 lw_pop_up_all_widgets (dialog_id); 2148 2149 /* Process events that apply to the menu. */ 2150 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id); 2151 2152 lw_destroy_all_widgets (dialog_id); 2153 2154 /* Find the selected item, and its pane, to return 2155 the proper value. */ 2156 if (menu_item_selection != 0) 2157 { 2158 Lisp_Object prefix; 2159 2160 prefix = Qnil; 2161 i = 0; 2162 while (i < menu_items_used) 2163 { 2164 Lisp_Object entry; 2165 2166 if (EQ (AREF (menu_items, i), Qt)) 2167 { 2168 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX); 2169 i += MENU_ITEMS_PANE_LENGTH; 2170 } 2171 else 2172 { 2173 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE); 2174 if (menu_item_selection == i) 2175 { 2176 if (keymaps != 0) 2177 { 2178 entry = Fcons (entry, Qnil); 2179 if (!NILP (prefix)) 2180 entry = Fcons (prefix, entry); 2181 } 2182 return entry; 2183 } 2184 i += MENU_ITEMS_ITEM_LENGTH; 2185 } 2186 } 2187 } 2188 else 2189 /* Make "Cancel" equivalent to C-g. */ 2190 Fsignal (Qquit, Qnil); 2191 2192 return Qnil; 2193} 2194#endif /* HAVE_DIALOGS */ 2195 2196 2197/* Is this item a separator? */ 2198static int 2199name_is_separator (name) 2200 char *name; 2201{ 2202 char *start = name; 2203 2204 /* Check if name string consists of only dashes ('-'). */ 2205 while (*name == '-') name++; 2206 /* Separators can also be of the form "--:TripleSuperMegaEtched" 2207 or "--deep-shadow". We don't implement them yet, se we just treat 2208 them like normal separators. */ 2209 return (*name == '\0' || start + 2 == name); 2210} 2211 2212 2213/* Indicate boundary between left and right. */ 2214static int 2215add_left_right_boundary (HMENU menu) 2216{ 2217 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL); 2218} 2219 2220/* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */ 2221static void 2222utf8to16 (unsigned char * src, int len, WCHAR * dest) 2223{ 2224 while (len > 0) 2225 { 2226 int utf16; 2227 if (*src < 0x80) 2228 { 2229 *dest = (WCHAR) *src; 2230 dest++; src++; len--; 2231 } 2232 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */ 2233 else if (*src < 0xC0) 2234 { 2235 src++; len--; 2236 } 2237 /* 2 char UTF-8 sequence. */ 2238 else if (*src < 0xE0) 2239 { 2240 *dest = (WCHAR) (((*src & 0x1f) << 6) 2241 | (*(src + 1) & 0x3f)); 2242 src += 2; len -= 2; dest++; 2243 } 2244 else if (*src < 0xF0) 2245 { 2246 *dest = (WCHAR) (((*src & 0x0f) << 12) 2247 | ((*(src + 1) & 0x3f) << 6) 2248 | (*(src + 2) & 0x3f)); 2249 src += 3; len -= 3; dest++; 2250 } 2251 else /* Not encodable. Insert Unicode Substitution char. */ 2252 { 2253 *dest = (WCHAR) 0xfffd; 2254 src++; len--; dest++; 2255 } 2256 } 2257 *dest = 0; 2258} 2259 2260static int 2261add_menu_item (HMENU menu, widget_value *wv, HMENU item) 2262{ 2263 UINT fuFlags; 2264 char *out_string; 2265 int return_value; 2266 2267 if (name_is_separator (wv->name)) 2268 { 2269 fuFlags = MF_SEPARATOR; 2270 out_string = NULL; 2271 } 2272 else 2273 { 2274 if (wv->enabled) 2275 fuFlags = MF_STRING; 2276 else 2277 fuFlags = MF_STRING | MF_GRAYED; 2278 2279 if (wv->key != NULL) 2280 { 2281 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2); 2282 strcpy (out_string, wv->name); 2283 strcat (out_string, "\t"); 2284 strcat (out_string, wv->key); 2285 } 2286 else 2287 out_string = wv->name; 2288 2289 if (item != NULL) 2290 fuFlags = MF_POPUP; 2291 else if (wv->title || wv->call_data == 0) 2292 { 2293 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since 2294 we can't deallocate the memory otherwise. */ 2295 if (get_menu_item_info) 2296 { 2297 out_string = (char *) local_alloc (strlen (wv->name) + 1); 2298 strcpy (out_string, wv->name); 2299#ifdef MENU_DEBUG 2300 DebPrint ("Menu: allocing %ld for owner-draw", out_string); 2301#endif 2302 fuFlags = MF_OWNERDRAW | MF_DISABLED; 2303 } 2304 else 2305 fuFlags = MF_DISABLED; 2306 } 2307 2308 /* Draw radio buttons and tickboxes. */ 2309 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE || 2310 wv->button_type == BUTTON_TYPE_RADIO)) 2311 fuFlags |= MF_CHECKED; 2312 else 2313 fuFlags |= MF_UNCHECKED; 2314 } 2315 2316 if (unicode_append_menu && out_string) 2317 { 2318 /* Convert out_string from UTF-8 to UTF-16-LE. */ 2319 int utf8_len = strlen (out_string); 2320 WCHAR * utf16_string; 2321 if (fuFlags & MF_OWNERDRAW) 2322 utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR)); 2323 else 2324 utf16_string = alloca ((utf8_len + 1) * sizeof (WCHAR)); 2325 2326 utf8to16 (out_string, utf8_len, utf16_string); 2327 return_value = unicode_append_menu (menu, fuFlags, 2328 item != NULL ? (UINT) item 2329 : (UINT) wv->call_data, 2330 utf16_string); 2331 if (!return_value) 2332 { 2333 /* On W9x/ME, unicode menus are not supported, though AppendMenuW 2334 apparently does exist at least in some cases and appears to be 2335 stubbed out to do nothing. out_string is UTF-8, but since 2336 our standard menus are in English and this is only going to 2337 happen the first time a menu is used, the encoding is 2338 of minor importance compared with menus not working at all. */ 2339 return_value = 2340 AppendMenu (menu, fuFlags, 2341 item != NULL ? (UINT) item: (UINT) wv->call_data, 2342 out_string); 2343 /* Don't use unicode menus in future. */ 2344 unicode_append_menu = NULL; 2345 } 2346 2347 if (unicode_append_menu && (fuFlags & MF_OWNERDRAW)) 2348 local_free (out_string); 2349 } 2350 else 2351 { 2352 return_value = 2353 AppendMenu (menu, 2354 fuFlags, 2355 item != NULL ? (UINT) item : (UINT) wv->call_data, 2356 out_string ); 2357 } 2358 2359 /* This must be done after the menu item is created. */ 2360 if (!wv->title && wv->call_data != 0) 2361 { 2362 if (set_menu_item_info) 2363 { 2364 MENUITEMINFO info; 2365 bzero (&info, sizeof (info)); 2366 info.cbSize = sizeof (info); 2367 info.fMask = MIIM_DATA; 2368 2369 /* Set help string for menu item. Leave it as a Lisp_Object 2370 until it is ready to be displayed, since GC can happen while 2371 menus are active. */ 2372 if (!NILP (wv->help)) 2373#ifdef USE_LISP_UNION_TYPE 2374 info.dwItemData = (DWORD) (wv->help).i; 2375#else 2376 info.dwItemData = (DWORD) (wv->help); 2377#endif 2378 if (wv->button_type == BUTTON_TYPE_RADIO) 2379 { 2380 /* CheckMenuRadioItem allows us to differentiate TOGGLE and 2381 RADIO items, but is not available on NT 3.51 and earlier. */ 2382 info.fMask |= MIIM_TYPE | MIIM_STATE; 2383 info.fType = MFT_RADIOCHECK | MFT_STRING; 2384 info.dwTypeData = out_string; 2385 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED; 2386 } 2387 2388 set_menu_item_info (menu, 2389 item != NULL ? (UINT) item : (UINT) wv->call_data, 2390 FALSE, &info); 2391 } 2392 } 2393 return return_value; 2394} 2395 2396/* Construct native Windows menu(bar) based on widget_value tree. */ 2397int 2398fill_in_menu (HMENU menu, widget_value *wv) 2399{ 2400 int items_added = 0; 2401 2402 for ( ; wv != NULL; wv = wv->next) 2403 { 2404 if (wv->contents) 2405 { 2406 HMENU sub_menu = CreatePopupMenu (); 2407 2408 if (sub_menu == NULL) 2409 return 0; 2410 2411 if (!fill_in_menu (sub_menu, wv->contents) || 2412 !add_menu_item (menu, wv, sub_menu)) 2413 { 2414 DestroyMenu (sub_menu); 2415 return 0; 2416 } 2417 } 2418 else 2419 { 2420 if (!add_menu_item (menu, wv, NULL)) 2421 return 0; 2422 } 2423 } 2424 return 1; 2425} 2426 2427/* Display help string for currently pointed to menu item. Not 2428 supported on NT 3.51 and earlier, as GetMenuItemInfo is not 2429 available. */ 2430void 2431w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags) 2432{ 2433 if (get_menu_item_info) 2434 { 2435 struct frame *f = x_window_to_frame (&one_w32_display_info, owner); 2436 Lisp_Object frame, help; 2437 2438 /* No help echo on owner-draw menu items, or when the keyboard is used 2439 to navigate the menus, since tooltips are distracting if they pop 2440 up elsewhere. */ 2441 if (flags & MF_OWNERDRAW || flags & MF_POPUP 2442 || !(flags & MF_MOUSESELECT)) 2443 help = Qnil; 2444 else 2445 { 2446 MENUITEMINFO info; 2447 2448 bzero (&info, sizeof (info)); 2449 info.cbSize = sizeof (info); 2450 info.fMask = MIIM_DATA; 2451 get_menu_item_info (menu, item, FALSE, &info); 2452 2453#ifdef USE_LISP_UNION_TYPE 2454 help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData) 2455 : Qnil; 2456#else 2457 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil; 2458#endif 2459 } 2460 2461 /* Store the help echo in the keyboard buffer as the X toolkit 2462 version does, rather than directly showing it. This seems to 2463 solve the GC problems that were present when we based the 2464 Windows code on the non-toolkit version. */ 2465 if (f) 2466 { 2467 XSETFRAME (frame, f); 2468 kbd_buffer_store_help_event (frame, help); 2469 } 2470 else 2471 /* X version has a loop through frames here, which doesn't 2472 appear to do anything, unless it has some side effect. */ 2473 show_help_echo (help, Qnil, Qnil, Qnil, 1); 2474 } 2475} 2476 2477/* Free memory used by owner-drawn strings. */ 2478static void 2479w32_free_submenu_strings (menu) 2480 HMENU menu; 2481{ 2482 int i, num = GetMenuItemCount (menu); 2483 for (i = 0; i < num; i++) 2484 { 2485 MENUITEMINFO info; 2486 bzero (&info, sizeof (info)); 2487 info.cbSize = sizeof (info); 2488 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU; 2489 2490 get_menu_item_info (menu, i, TRUE, &info); 2491 2492 /* Owner-drawn names are held in dwItemData. */ 2493 if ((info.fType & MF_OWNERDRAW) && info.dwItemData) 2494 { 2495#ifdef MENU_DEBUG 2496 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData); 2497#endif 2498 local_free (info.dwItemData); 2499 } 2500 2501 /* Recurse down submenus. */ 2502 if (info.hSubMenu) 2503 w32_free_submenu_strings (info.hSubMenu); 2504 } 2505} 2506 2507void 2508w32_free_menu_strings (hwnd) 2509 HWND hwnd; 2510{ 2511 HMENU menu = current_popup_menu; 2512 2513 if (get_menu_item_info) 2514 { 2515 /* If there is no popup menu active, free the strings from the frame's 2516 menubar. */ 2517 if (!menu) 2518 menu = GetMenu (hwnd); 2519 2520 if (menu) 2521 w32_free_submenu_strings (menu); 2522 } 2523 2524 current_popup_menu = NULL; 2525} 2526 2527#endif /* HAVE_MENUS */ 2528 2529/* The following is used by delayed window autoselection. */ 2530 2531DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0, 2532 doc: /* Return t if a menu or popup dialog is active on selected frame. */) 2533 () 2534{ 2535#ifdef HAVE_MENUS 2536 FRAME_PTR f; 2537 f = SELECTED_FRAME (); 2538 return (f->output_data.w32->menubar_active > 0) ? Qt : Qnil; 2539#else 2540 return Qnil; 2541#endif /* HAVE_MENUS */ 2542} 2543 2544void syms_of_w32menu () 2545{ 2546 globals_of_w32menu (); 2547 staticpro (&menu_items); 2548 menu_items = Qnil; 2549 2550 current_popup_menu = NULL; 2551 2552 Qdebug_on_next_call = intern ("debug-on-next-call"); 2553 staticpro (&Qdebug_on_next_call); 2554 2555 defsubr (&Sx_popup_menu); 2556 defsubr (&Smenu_or_popup_active_p); 2557#ifdef HAVE_MENUS 2558 defsubr (&Sx_popup_dialog); 2559#endif 2560} 2561 2562/* 2563 globals_of_w32menu is used to initialize those global variables that 2564 must always be initialized on startup even when the global variable 2565 initialized is non zero (see the function main in emacs.c). 2566 globals_of_w32menu is called from syms_of_w32menu when the global 2567 variable initialized is 0 and directly from main when initialized 2568 is non zero. 2569 */ 2570void globals_of_w32menu () 2571{ 2572 /* See if Get/SetMenuItemInfo functions are available. */ 2573 HMODULE user32 = GetModuleHandle ("user32.dll"); 2574 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA"); 2575 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA"); 2576 unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW"); 2577} 2578 2579/* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0 2580 (do not change this comment) */ 2581