428
+ − 1 /* Implements an elisp-programmable menubar -- Win32
+ − 2 Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+ − 3 Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
442
+ − 4 Copyright (C) 1997 Kirill M. Katsnelson <kkm@kis.ru>.
826
+ − 5 Copyright (C) 2000, 2001, 2002 Ben Wing.
428
+ − 6
+ − 7 This file is part of XEmacs.
+ − 8
+ − 9 XEmacs is free software; you can redistribute it and/or modify it
+ − 10 under the terms of the GNU General Public License as published by the
+ − 11 Free Software Foundation; either version 2, or (at your option) any
+ − 12 later version.
+ − 13
+ − 14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ − 15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ − 16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ − 17 for more details.
+ − 18
+ − 19 You should have received a copy of the GNU General Public License
+ − 20 along with XEmacs; see the file COPYING. If not, write to
+ − 21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ − 22 Boston, MA 02111-1307, USA. */
+ − 23
+ − 24 /* Synched up with: Not in FSF. */
+ − 25
771
+ − 26 /* This function mostly Mule-ized (except perhaps some Unicode splitting).
+ − 27 5-2000. */
+ − 28
428
+ − 29 /* Author:
+ − 30 Initially written by kkm 12/24/97,
+ − 31 peeking into and copying stuff from menubar-x.c
+ − 32 */
+ − 33
+ − 34 /* Algorithm for handling menus is as follows. When window's menubar
+ − 35 * is created, current-menubar is not traversed in depth. Rather, only
+ − 36 * top level items, both items and pulldowns, are added to the
+ − 37 * menubar. Each pulldown is initially empty. When a pulldown is
+ − 38 * selected and about to open, corresponding element of
+ − 39 * current-menubar is found, and the newly open pulldown is
+ − 40 * populated. This is made again in the same non-recursive manner.
+ − 41 *
+ − 42 * This algorithm uses hash tables to find out element of the menu
+ − 43 * descriptor list given menu handle. The key is an opaque ptr data
+ − 44 * type, keeping menu handle, and the value is a list of strings
+ − 45 * representing the path from the root of the menu to the item
+ − 46 * descriptor. Each frame has an associated hash table.
+ − 47 *
+ − 48 * Leaf items are assigned a unique id based on item's hash. When an
+ − 49 * item is selected, Windows sends back the id. Unfortunately, only
+ − 50 * low 16 bit of the ID are sent, and there's no way to get the 32-bit
+ − 51 * value. Yes, Win32 is just a different set of bugs than X! Aside
+ − 52 * from this blame, another hashing mechanism is required to map menu
+ − 53 * ids to commands (which are actually Lisp_Object's). This mapping is
+ − 54 * performed in the same hash table, as the lifetime of both maps is
+ − 55 * exactly the same. This is unambigous, as menu handles are
+ − 56 * represented by lisp opaques, while command ids are by lisp
+ − 57 * integers. The additional advantage for this is that command forms
+ − 58 * are automatically GC-protected, which is important because these
+ − 59 * may be transient forms generated by :filter functions.
+ − 60 *
+ − 61 * The hash table is not allowed to grow too much; it is pruned
+ − 62 * whenever this is safe to do. This is done by re-creating the menu
+ − 63 * bar, and clearing and refilling the hash table from scratch.
+ − 64 *
+ − 65 * Popup menus are handled identically to pulldowns. A static hash
+ − 66 * table is used for popup menus, and lookup is made not in
+ − 67 * current-menubar but in a lisp form supplied to the `popup'
+ − 68 * function.
+ − 69 *
+ − 70 * Another Windows weirdness is that there's no way to tell that a
+ − 71 * popup has been dismissed without making selection. We need to know
+ − 72 * that to cleanup the popup menu hash table, but this is not honestly
+ − 73 * doable using *documented* sequence of messages. Sticking to
+ − 74 * particular knowledge is bad because this may break in Windows NT
+ − 75 * 5.0, or Windows 98, or other future version. Instead, I allow the
+ − 76 * hash tables to hang around, and not clear them, unless WM_COMMAND is
442
+ − 77 * received. This is worth some memory but more safe. Hacks welcome,
428
+ − 78 * anyways!
+ − 79 *
+ − 80 */
+ − 81
+ − 82 #include <config.h>
+ − 83 #include "lisp.h"
+ − 84
+ − 85 #include "buffer.h"
+ − 86 #include "commands.h"
872
+ − 87 #include "console-msw-impl.h"
428
+ − 88 #include "elhash.h"
+ − 89 #include "events.h"
872
+ − 90 #include "frame-impl.h"
428
+ − 91 #include "gui.h"
+ − 92 #include "lisp.h"
+ − 93 #include "menubar.h"
+ − 94 #include "menubar-msw.h"
+ − 95 #include "opaque.h"
872
+ − 96 #include "window-impl.h"
428
+ − 97
+ − 98 /* #### */
442
+ − 99 #define REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH 0
428
+ − 100
+ − 101 #define EMPTY_ITEM_ID ((UINT)LISP_TO_VOID (Qunbound))
771
+ − 102 #define EMPTY_ITEM_NAME "(empty)" /* WARNING: uses of this need XETEXT */
428
+ − 103
+ − 104 /* Current menu (bar or popup) descriptor. gcpro'ed */
+ − 105 static Lisp_Object current_menudesc;
+ − 106
+ − 107 /* Current menubar or popup hash table. gcpro'ed */
+ − 108 static Lisp_Object current_hash_table;
+ − 109
+ − 110 /* This is used to allocate unique ids to menu items.
+ − 111 Items ids are in MENU_ITEM_ID_MIN to MENU_ITEM_ID_MAX.
+ − 112 Allocation checks that the item is not already in
+ − 113 the TOP_LEVEL_MENU */
+ − 114
+ − 115 /* #### defines go to gui-msw.h, as the range is shared with toolbars
+ − 116 (If only toolbars will be implemented as common controls) */
+ − 117 #define MENU_ITEM_ID_MIN 0x8000
+ − 118 #define MENU_ITEM_ID_MAX 0xFFFF
+ − 119 #define MENU_ITEM_ID_BITS(x) (((x) & 0x7FFF) | 0x8000)
+ − 120 static HMENU top_level_menu;
+ − 121
+ − 122 /*
771
+ − 123 * Translate X accelerator syntax to win32 accelerator syntax.
867
+ − 124 * accel = (Ichar*) to receive the accelerator character
442
+ − 125 * or NULL to suppress accelerators in the menu or dialog item.
+ − 126 *
+ − 127 * %% is replaced with %
+ − 128 * if accel is NULL:
+ − 129 * %_ is removed.
+ − 130 * if accel is non-NULL:
+ − 131 * %_ is replaced with &.
+ − 132 * The accelerator character is passed back in *accel.
+ − 133 * (If there is no accelerator, it will be added on the first character.)
+ − 134 *
+ − 135 */
771
+ − 136
+ − 137 Lisp_Object
867
+ − 138 mswindows_translate_menu_or_dialog_item (Lisp_Object item, Ichar *accel)
442
+ − 139 {
771
+ − 140 Bytecount len = XSTRING_LENGTH (item);
867
+ − 141 Ibyte *it = (Ibyte *) ALLOCA (2 * len + 42), *ptr = it;
442
+ − 142
771
+ − 143 memcpy (ptr, XSTRING_DATA (item), len + 1);
442
+ − 144 if (accel)
+ − 145 *accel = '\0';
+ − 146
+ − 147 /* Escape '&' as '&&' */
771
+ − 148
867
+ − 149 while ((ptr = (Ibyte *) memchr (ptr, '&', len - (ptr - it))) != NULL)
442
+ − 150 {
771
+ − 151 memmove (ptr + 1, ptr, (len - (ptr - it)) + 1);
442
+ − 152 len++;
+ − 153 ptr += 2;
+ − 154 }
+ − 155
+ − 156 /* Replace XEmacs accelerator '%_' with Windows accelerator '&'
+ − 157 and `%%' with `%'. */
771
+ − 158 ptr = it;
867
+ − 159 while ((ptr = (Ibyte *) memchr (ptr, '%', len - (ptr - it))) != NULL)
442
+ − 160 {
+ − 161 if (*(ptr + 1) == '_')
+ − 162 {
+ − 163 if (accel)
+ − 164 {
+ − 165 *ptr = '&';
+ − 166 if (!*accel)
867
+ − 167 *accel = DOWNCASE (0, itext_ichar (ptr + 2));
771
+ − 168 memmove (ptr + 1, ptr + 2, len - (ptr - it + 2) + 1);
442
+ − 169 len--;
+ − 170 }
+ − 171 else /* Skip accelerator */
+ − 172 {
771
+ − 173 memmove (ptr, ptr + 2, len - (ptr - it + 2) + 1);
+ − 174 len -= 2;
442
+ − 175 }
+ − 176 }
+ − 177 else if (*(ptr + 1) == '%')
+ − 178 {
771
+ − 179 memmove (ptr + 1, ptr + 2, len - (ptr - it + 2) + 1);
442
+ − 180 len--;
+ − 181 ptr++;
+ − 182 }
+ − 183 else /* % on its own - shouldn't happen */
+ − 184 ptr++;
+ − 185 }
+ − 186
+ − 187 if (accel && !*accel)
+ − 188 {
+ − 189 /* Force a default accelerator */
771
+ − 190 ptr = it;
442
+ − 191 memmove (ptr + 1, ptr, len + 1);
867
+ − 192 *accel = DOWNCASE (0, itext_ichar (ptr + 1));
442
+ − 193 *ptr = '&';
+ − 194
+ − 195 len++;
+ − 196 }
+ − 197
771
+ − 198 return make_string (it, len);
442
+ − 199 }
+ − 200
+ − 201 /*
428
+ − 202 * This returns Windows-style menu item string:
+ − 203 * "Left Flush\tRight Flush"
+ − 204 */
442
+ − 205
771
+ − 206 static Lisp_Object
867
+ − 207 displayable_menu_item (Lisp_Object gui_item, int bar_p, Ichar *accel)
428
+ − 208 {
771
+ − 209 Lisp_Object left, right = Qnil;
428
+ − 210
+ − 211 /* Left flush part of the string */
771
+ − 212 left = gui_item_display_flush_left (gui_item);
428
+ − 213
771
+ − 214 left = mswindows_translate_menu_or_dialog_item (left, accel);
428
+ − 215
+ − 216 /* Right flush part, unless we're at the top-level where it's not allowed */
+ − 217 if (!bar_p)
771
+ − 218 right = gui_item_display_flush_right (gui_item);
442
+ − 219
771
+ − 220 if (!NILP (right))
+ − 221 return concat3 (left, build_string ("\t"), right);
+ − 222 else
+ − 223 return left;
428
+ − 224 }
+ − 225
+ − 226 /*
+ − 227 * hmenu_to_lisp_object() returns an opaque ptr given menu handle.
+ − 228 */
+ − 229 static Lisp_Object
+ − 230 hmenu_to_lisp_object (HMENU hmenu)
+ − 231 {
+ − 232 return make_opaque_ptr (hmenu);
+ − 233 }
+ − 234
+ − 235 /*
+ − 236 * Allocation tries a hash based on item's path and name first. This
+ − 237 * almost guarantees that the same item will override its old value in
+ − 238 * the hash table rather than abandon it.
+ − 239 */
+ − 240 static Lisp_Object
+ − 241 allocate_menu_item_id (Lisp_Object path, Lisp_Object name, Lisp_Object suffix)
+ − 242 {
+ − 243 UINT id = MENU_ITEM_ID_BITS (HASH3 (internal_hash (path, 0),
+ − 244 internal_hash (name, 0),
+ − 245 internal_hash (suffix, 0)));
+ − 246 do {
+ − 247 id = MENU_ITEM_ID_BITS (id + 1);
+ − 248 } while (GetMenuState (top_level_menu, id, MF_BYCOMMAND) != 0xFFFFFFFF);
+ − 249 return make_int (id);
+ − 250 }
+ − 251
+ − 252 static HMENU
+ − 253 create_empty_popup_menu (void)
+ − 254 {
+ − 255 return CreatePopupMenu ();
+ − 256 }
+ − 257
+ − 258 static void
+ − 259 empty_menu (HMENU menu, int add_empty_p)
+ − 260 {
+ − 261 while (DeleteMenu (menu, 0, MF_BYPOSITION));
+ − 262 if (add_empty_p)
771
+ − 263 qxeAppendMenu (menu, MF_STRING | MF_GRAYED, EMPTY_ITEM_ID,
+ − 264 XETEXT (EMPTY_ITEM_NAME));
428
+ − 265 }
+ − 266
+ − 267 /*
+ − 268 * The idea of checksumming is that we must hash minimal object
+ − 269 * which is necessarily changes when the item changes. For separator
+ − 270 * this is a constant, for grey strings and submenus these are hashes
+ − 271 * of names, since submenus are unpopulated until opened so always
+ − 272 * equal otherwise. For items, this is a full hash value of a callback,
+ − 273 * because a callback may me a form which can be changed only somewhere
+ − 274 * in depth.
+ − 275 */
+ − 276 static unsigned long
+ − 277 checksum_menu_item (Lisp_Object item)
+ − 278 {
+ − 279 if (STRINGP (item))
+ − 280 {
+ − 281 /* Separator or unselectable text - hash as a string + 13 */
+ − 282 if (separator_string_p (XSTRING_DATA (item)))
+ − 283 return 13;
+ − 284 else
+ − 285 return internal_hash (item, 0) + 13;
+ − 286 }
+ − 287 else if (CONSP (item))
+ − 288 {
+ − 289 /* Submenu - hash by its string name + 0 */
771
+ − 290 return internal_hash (XCAR (item), 0);
428
+ − 291 }
+ − 292 else if (VECTORP (item))
+ − 293 {
+ − 294 /* An ordinary item - hash its name and callback form. */
+ − 295 return HASH2 (internal_hash (XVECTOR_DATA(item)[0], 0),
+ − 296 internal_hash (XVECTOR_DATA(item)[1], 0));
+ − 297 }
442
+ − 298
428
+ − 299 /* An error - will be caught later */
+ − 300 return 0;
+ − 301 }
+ − 302
+ − 303 static void
+ − 304 populate_menu_add_item (HMENU menu, Lisp_Object path,
+ − 305 Lisp_Object hash_tab, Lisp_Object item,
442
+ − 306 Lisp_Object *accel_list,
428
+ − 307 int flush_right, int bar_p)
+ − 308 {
771
+ − 309 MENUITEMINFOW item_info;
428
+ − 310
+ − 311 item_info.cbSize = sizeof (item_info);
+ − 312 item_info.fMask = MIIM_TYPE | MIIM_STATE | MIIM_ID;
+ − 313 item_info.fState = 0;
+ − 314 item_info.wID = 0;
+ − 315 item_info.fType = 0;
+ − 316
+ − 317 if (STRINGP (item))
+ − 318 {
+ − 319 /* Separator or unselectable text */
+ − 320 if (separator_string_p (XSTRING_DATA (item)))
771
+ − 321 item_info.fType = MFT_SEPARATOR;
428
+ − 322 else
+ − 323 {
771
+ − 324 Extbyte *itemext;
+ − 325
428
+ − 326 item_info.fType = MFT_STRING;
+ − 327 item_info.fState = MFS_DISABLED;
771
+ − 328 LISP_STRING_TO_TSTR (item, itemext);
+ − 329 item_info.dwTypeData = (XELPTSTR) itemext;
428
+ − 330 }
+ − 331 }
+ − 332 else if (CONSP (item))
+ − 333 {
+ − 334 /* Submenu */
+ − 335 HMENU submenu;
+ − 336 Lisp_Object gui_item = allocate_gui_item ();
442
+ − 337 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
+ − 338 struct gcpro gcpro1, gcpro2, gcpro3;
867
+ − 339 Ichar accel;
771
+ − 340 Extbyte *itemext;
428
+ − 341
442
+ − 342 GCPRO3 (gui_item, path, *accel_list);
428
+ − 343
+ − 344 menu_parse_submenu_keywords (item, gui_item);
+ − 345
+ − 346 if (!STRINGP (pgui_item->name))
563
+ − 347 invalid_argument ("Menu name (first element) must be a string",
442
+ − 348 item);
428
+ − 349
+ − 350 if (!gui_item_included_p (gui_item, Vmenubar_configuration))
442
+ − 351 {
+ − 352 UNGCPRO;
+ − 353 goto done;
+ − 354 }
428
+ − 355
+ − 356 if (!gui_item_active_p (gui_item))
771
+ − 357 item_info.fState = MFS_GRAYED;
428
+ − 358 /* Temptation is to put 'else' right here. Although, the
+ − 359 displayed item won't have an arrow indicating that it is a
+ − 360 popup. So we go ahead a little bit more and create a popup */
442
+ − 361 submenu = create_empty_popup_menu ();
428
+ − 362
+ − 363 item_info.fMask |= MIIM_SUBMENU;
771
+ − 364 LISP_STRING_TO_TSTR (displayable_menu_item (gui_item, bar_p, &accel),
+ − 365 itemext);
+ − 366 item_info.dwTypeData = (XELPTSTR) itemext;
428
+ − 367 item_info.hSubMenu = submenu;
442
+ − 368
+ − 369 if (accel && bar_p)
+ − 370 *accel_list = Fcons (make_char (accel), *accel_list);
428
+ − 371
+ − 372 if (!(item_info.fState & MFS_GRAYED))
+ − 373 {
+ − 374 /* Now add the full submenu path as a value to the hash table,
+ − 375 keyed by menu handle */
+ − 376 if (NILP(path))
+ − 377 path = list1 (pgui_item->name);
+ − 378 else
+ − 379 {
+ − 380 Lisp_Object arg[2];
+ − 381 arg[0] = path;
+ − 382 arg[1] = list1 (pgui_item->name);
+ − 383 path = Fappend (2, arg);
+ − 384 }
+ − 385
+ − 386 Fputhash (hmenu_to_lisp_object (submenu), path, hash_tab);
+ − 387 }
442
+ − 388 UNGCPRO;
+ − 389 }
428
+ − 390 else if (VECTORP (item))
+ − 391 {
+ − 392 /* An ordinary item */
+ − 393 Lisp_Object style, id;
+ − 394 Lisp_Object gui_item = gui_parse_item_keywords (item);
442
+ − 395 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
+ − 396 struct gcpro gcpro1, gcpro2;
867
+ − 397 Ichar accel;
771
+ − 398 Extbyte *itemext;
428
+ − 399
442
+ − 400 GCPRO2 (gui_item, *accel_list);
428
+ − 401
+ − 402 if (!gui_item_included_p (gui_item, Vmenubar_configuration))
442
+ − 403 {
+ − 404 UNGCPRO;
+ − 405 goto done;
+ − 406 }
+ − 407
+ − 408 if (!STRINGP (pgui_item->name))
+ − 409 pgui_item->name = Feval (pgui_item->name);
428
+ − 410
+ − 411 if (!gui_item_active_p (gui_item))
771
+ − 412 item_info.fState = MFS_GRAYED;
428
+ − 413
+ − 414 style = (NILP (pgui_item->selected) || NILP (Feval (pgui_item->selected))
+ − 415 ? Qnil : pgui_item->style);
+ − 416
+ − 417 if (EQ (style, Qradio))
+ − 418 {
+ − 419 item_info.fType |= MFT_RADIOCHECK;
+ − 420 item_info.fState |= MFS_CHECKED;
+ − 421 }
+ − 422 else if (EQ (style, Qtoggle))
771
+ − 423 item_info.fState |= MFS_CHECKED;
428
+ − 424
+ − 425 id = allocate_menu_item_id (path, pgui_item->name,
+ − 426 pgui_item->suffix);
+ − 427 Fputhash (id, pgui_item->callback, hash_tab);
+ − 428
442
+ − 429 item_info.wID = (UINT) XINT (id);
428
+ − 430 item_info.fType |= MFT_STRING;
771
+ − 431 LISP_STRING_TO_TSTR (displayable_menu_item (gui_item, bar_p, &accel),
+ − 432 itemext);
+ − 433 item_info.dwTypeData = (XELPTSTR) itemext;
428
+ − 434
442
+ − 435 if (accel && bar_p)
+ − 436 *accel_list = Fcons (make_char (accel), *accel_list);
+ − 437
+ − 438 UNGCPRO;
428
+ − 439 }
+ − 440 else
563
+ − 441 sferror ("Malformed menu item descriptor", item);
428
+ − 442
+ − 443 if (flush_right)
771
+ − 444 item_info.fType |= MFT_RIGHTJUSTIFY;
428
+ − 445
771
+ − 446 qxeInsertMenuItem (menu, UINT_MAX, TRUE, &item_info);
442
+ − 447
+ − 448 done:;
+ − 449 }
428
+ − 450
+ − 451 /*
+ − 452 * This function is called from populate_menu and checksum_menu.
+ − 453 * When called to populate, MENU is a menu handle, PATH is a
+ − 454 * list of strings representing menu path from root to this submenu,
+ − 455 * DESCRIPTOR is a menu descriptor, HASH_TAB is a hash table associated
+ − 456 * with root menu, BAR_P indicates whether this called for a menubar or
+ − 457 * a popup, and POPULATE_P is non-zero. Return value must be ignored.
+ − 458 * When called to checksum, DESCRIPTOR has the same meaning, POPULATE_P
+ − 459 * is zero, PATH must be Qnil, and the rest of parameters is ignored.
+ − 460 * Return value is the menu checksum.
+ − 461 */
+ − 462 static unsigned long
+ − 463 populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc,
+ − 464 Lisp_Object hash_tab, int bar_p, int populate_p)
+ − 465 {
+ − 466 Lisp_Object item_desc;
+ − 467 int deep_p, flush_right;
442
+ − 468 struct gcpro gcpro1, gcpro2, gcpro3;
428
+ − 469 unsigned long checksum;
+ − 470 Lisp_Object gui_item = allocate_gui_item ();
442
+ − 471 Lisp_Object accel_list = Qnil;
+ − 472 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
+ − 473
+ − 474 GCPRO3 (gui_item, accel_list, desc);
428
+ − 475
+ − 476 /* We are sometimes called with the menubar unchanged, and with changed
+ − 477 right flush. We have to update the menubar in this case,
+ − 478 so account for the compliance setting in the hash value */
442
+ − 479 checksum = REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH;
428
+ − 480
+ − 481 /* Will initially contain only "(empty)" */
+ − 482 if (populate_p)
+ − 483 empty_menu (menu, 1);
+ − 484
+ − 485 /* PATH set to nil indicates top-level popup or menubar */
+ − 486 deep_p = !NILP (path);
+ − 487
+ − 488 /* Fetch keywords prepending the item list */
+ − 489 desc = menu_parse_submenu_keywords (desc, gui_item);
+ − 490
+ − 491 /* Check that menu name is specified when expected */
+ − 492 if (NILP (pgui_item->name) && deep_p)
563
+ − 493 sferror ("Menu must have a name", desc);
428
+ − 494
+ − 495 /* Apply filter if specified */
+ − 496 if (!NILP (pgui_item->filter))
+ − 497 desc = call1 (pgui_item->filter, desc);
+ − 498
+ − 499 /* Loop thru the desc's CDR and add items for each entry */
+ − 500 flush_right = 0;
+ − 501 EXTERNAL_LIST_LOOP (item_desc, desc)
+ − 502 {
+ − 503 if (NILP (XCAR (item_desc)))
+ − 504 {
+ − 505 /* Do not flush right menubar items when MS style compliant */
442
+ − 506 if (bar_p && !REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH)
428
+ − 507 flush_right = 1;
+ − 508 if (!populate_p)
+ − 509 checksum = HASH2 (checksum, LISP_HASH (Qnil));
+ − 510 }
+ − 511 else if (populate_p)
+ − 512 populate_menu_add_item (menu, path, hash_tab,
442
+ − 513 XCAR (item_desc), &accel_list,
+ − 514 flush_right, bar_p);
428
+ − 515 else
+ − 516 checksum = HASH2 (checksum,
+ − 517 checksum_menu_item (XCAR (item_desc)));
+ − 518 }
442
+ − 519
428
+ − 520 if (populate_p)
+ − 521 {
+ − 522 /* Remove the "(empty)" item, if there are other ones */
+ − 523 if (GetMenuItemCount (menu) > 1)
+ − 524 RemoveMenu (menu, EMPTY_ITEM_ID, MF_BYCOMMAND);
+ − 525
+ − 526 /* Add the header to the popup, if told so. The same as in X - an
+ − 527 insensitive item, and a separator (Seems to me, there were
442
+ − 528 two separators in X... In Windows this looks ugly, anyways.) */
+ − 529 if (!bar_p && !deep_p && popup_menu_titles && !NILP (pgui_item->name))
428
+ − 530 {
771
+ − 531 Extbyte *nameext;
+ − 532
+ − 533 LISP_STRING_TO_TSTR (displayable_menu_item (gui_item, bar_p, NULL),
+ − 534 nameext);
+ − 535 qxeInsertMenu (menu, 0, MF_BYPOSITION | MF_STRING | MF_DISABLED,
+ − 536 0, nameext);
+ − 537 qxeInsertMenu (menu, 1, MF_BYPOSITION | MF_SEPARATOR, 0, NULL);
+ − 538 SetMenuDefaultItem (menu, 0, MF_BYPOSITION);
428
+ − 539 }
+ − 540 }
442
+ − 541
+ − 542 if (bar_p)
+ − 543 Fputhash (Qt, accel_list, hash_tab);
+ − 544
+ − 545 UNGCPRO;
428
+ − 546 return checksum;
+ − 547 }
+ − 548
+ − 549 static void
+ − 550 populate_menu (HMENU menu, Lisp_Object path, Lisp_Object desc,
442
+ − 551 Lisp_Object hash_tab, int bar_p)
428
+ − 552 {
+ − 553 populate_or_checksum_helper (menu, path, desc, hash_tab, bar_p, 1);
+ − 554 }
+ − 555
+ − 556 static unsigned long
+ − 557 checksum_menu (Lisp_Object desc)
+ − 558 {
+ − 559 return populate_or_checksum_helper (NULL, Qnil, desc, Qunbound, 0, 0);
+ − 560 }
+ − 561
+ − 562 static void
442
+ − 563 update_frame_menubar_maybe (struct frame *f)
428
+ − 564 {
+ − 565 HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f));
+ − 566 struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
+ − 567 Lisp_Object desc = (!NILP (w->menubar_visible_p)
+ − 568 ? symbol_value_in_buffer (Qcurrent_menubar, w->buffer)
+ − 569 : Qnil);
442
+ − 570 struct gcpro gcpro1;
+ − 571
+ − 572 GCPRO1 (desc); /* it's safest to do this, just in case some filter
+ − 573 or something changes the value of current-menubar */
428
+ − 574
+ − 575 top_level_menu = menubar;
+ − 576
+ − 577 if (NILP (desc) && menubar != NULL)
+ − 578 {
+ − 579 /* Menubar has gone */
442
+ − 580 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = Qnil;
428
+ − 581 SetMenu (FRAME_MSWINDOWS_HANDLE (f), NULL);
+ − 582 DestroyMenu (menubar);
+ − 583 DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f));
442
+ − 584 UNGCPRO;
428
+ − 585 return;
+ − 586 }
+ − 587
+ − 588 if (!NILP (desc) && menubar == NULL)
+ − 589 {
+ − 590 /* Menubar has appeared */
+ − 591 menubar = CreateMenu ();
+ − 592 goto populate;
+ − 593 }
+ − 594
+ − 595 if (NILP (desc))
+ − 596 {
+ − 597 /* We did not have the bar and are not going to */
442
+ − 598 UNGCPRO;
428
+ − 599 return;
+ − 600 }
+ − 601
+ − 602 /* Now we bail out if the menubar has not changed */
442
+ − 603 if (FRAME_MSWINDOWS_MENU_CHECKSUM (f) == checksum_menu (desc))
+ − 604 {
+ − 605 UNGCPRO;
+ − 606 return;
+ − 607 }
428
+ − 608
+ − 609 populate:
+ − 610 /* Come with empty hash table */
442
+ − 611 if (NILP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)))
+ − 612 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) =
428
+ − 613 make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
+ − 614 else
442
+ − 615 Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f));
428
+ − 616
+ − 617 Fputhash (hmenu_to_lisp_object (menubar), Qnil,
442
+ − 618 FRAME_MSWINDOWS_MENU_HASH_TABLE (f));
428
+ − 619 populate_menu (menubar, Qnil, desc,
442
+ − 620 FRAME_MSWINDOWS_MENU_HASH_TABLE (f), 1);
428
+ − 621 SetMenu (FRAME_MSWINDOWS_HANDLE (f), menubar);
+ − 622 DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f));
+ − 623
442
+ − 624 FRAME_MSWINDOWS_MENU_CHECKSUM (f) = checksum_menu (desc);
+ − 625
+ − 626 UNGCPRO;
428
+ − 627 }
+ − 628
+ − 629 static void
+ − 630 prune_menubar (struct frame *f)
+ − 631 {
+ − 632 HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f));
+ − 633 Lisp_Object desc = current_frame_menubar (f);
442
+ − 634 struct gcpro gcpro1;
+ − 635
428
+ − 636 if (menubar == NULL)
+ − 637 return;
+ − 638
+ − 639 /* #### If a filter function has set desc to Qnil, this abort()
+ − 640 triggers. To resolve, we must prevent filters explicitly from
+ − 641 mangling with the active menu. In apply_filter probably?
+ − 642 Is copy-tree on the whole menu too expensive? */
442
+ − 643 if (NILP (desc))
428
+ − 644 /* abort(); */
+ − 645 return;
+ − 646
442
+ − 647 GCPRO1 (desc); /* just to be safe -- see above */
428
+ − 648 /* We do the trick by removing all items and re-populating top level */
+ − 649 empty_menu (menubar, 0);
+ − 650
442
+ − 651 assert (HASH_TABLEP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)));
+ − 652 Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f));
428
+ − 653
+ − 654 Fputhash (hmenu_to_lisp_object (menubar), Qnil,
442
+ − 655 FRAME_MSWINDOWS_MENU_HASH_TABLE (f));
+ − 656 populate_menu (menubar, Qnil, desc,
+ − 657 FRAME_MSWINDOWS_MENU_HASH_TABLE (f), 1);
+ − 658 UNGCPRO;
428
+ − 659 }
+ − 660
+ − 661 /*
+ − 662 * This is called when cleanup is possible. It is better not to
+ − 663 * clean things up at all than do it too early!
+ − 664 */
+ − 665 static void
+ − 666 menu_cleanup (struct frame *f)
+ − 667 {
+ − 668 /* This function can GC */
+ − 669 current_menudesc = Qnil;
+ − 670 current_hash_table = Qnil;
+ − 671 prune_menubar (f);
+ − 672 }
442
+ − 673
+ − 674 int
867
+ − 675 mswindows_char_is_accelerator (struct frame *f, Ichar ch)
442
+ − 676 {
+ − 677 Lisp_Object hash = FRAME_MSWINDOWS_MENU_HASH_TABLE (f);
+ − 678
+ − 679 if (NILP (hash))
+ − 680 return 0;
771
+ − 681 return !NILP (memq_no_quit
+ − 682 (make_char
+ − 683 (DOWNCASE (WINDOW_XBUFFER (FRAME_SELECTED_XWINDOW (f)), ch)),
+ − 684 Fgethash (Qt, hash, Qnil)));
442
+ − 685 }
+ − 686
428
+ − 687
+ − 688 /*------------------------------------------------------------------------*/
+ − 689 /* Message handlers */
+ − 690 /*------------------------------------------------------------------------*/
+ − 691 static Lisp_Object
442
+ − 692 unsafe_handle_wm_initmenupopup_1 (HMENU menu, struct frame *f)
428
+ − 693 {
+ − 694 /* This function can call lisp, beat dogs and stick chewing gum to
+ − 695 everything! */
+ − 696
+ − 697 Lisp_Object path, desc;
+ − 698 struct gcpro gcpro1;
707
+ − 699
428
+ − 700 /* Find which guy is going to explode */
+ − 701 path = Fgethash (hmenu_to_lisp_object (menu), current_hash_table, Qunbound);
+ − 702 assert (!UNBOUNDP (path));
+ − 703 #ifdef DEBUG_XEMACS
+ − 704 /* Allow to continue in a debugger after assert - not so fatal */
+ − 705 if (UNBOUNDP (path))
563
+ − 706 signal_error (Qinternal_error, "internal menu error", Qunbound);
428
+ − 707 #endif
+ − 708
+ − 709 /* Now find a desc chunk for it. If none, then probably menu open
+ − 710 hook has played too much games around stuff */
+ − 711 desc = Fmenu_find_real_submenu (current_menudesc, path);
+ − 712 if (NILP (desc))
563
+ − 713 invalid_state ("This menu does not exist any more", path);
428
+ − 714
+ − 715 /* Now, stuff it */
+ − 716 /* DESC may be generated by filter, so we have to gcpro it */
+ − 717 GCPRO1 (desc);
+ − 718 populate_menu (menu, path, desc, current_hash_table, 0);
+ − 719 UNGCPRO;
+ − 720 return Qt;
+ − 721 }
+ − 722
+ − 723 static Lisp_Object
442
+ − 724 unsafe_handle_wm_initmenu_1 (struct frame *f)
428
+ − 725 {
+ − 726 /* This function can call lisp */
+ − 727
+ − 728 /* NOTE: This is called for the bar only, WM_INITMENU
+ − 729 for popups is filtered out */
+ − 730
+ − 731 /* #### - this menubar update mechanism is expensively anti-social and
+ − 732 the activate-menubar-hook is now mostly obsolete. */
+ − 733
+ − 734 /* We simply ignore return value. In any case, we construct the bar
+ − 735 on the fly */
853
+ − 736 run_hook_trapping_problems
+ − 737 ("Error in activate-menubar-hook", Qactivate_menubar_hook,
+ − 738 INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION);
428
+ − 739
+ − 740 update_frame_menubar_maybe (f);
+ − 741
+ − 742 current_menudesc = current_frame_menubar (f);
442
+ − 743 current_hash_table = FRAME_MSWINDOWS_MENU_HASH_TABLE (f);
428
+ − 744 assert (HASH_TABLEP (current_hash_table));
+ − 745
+ − 746 return Qt;
+ − 747 }
+ − 748
+ − 749 /*
+ − 750 * Return value is Qt if we have dispatched the command,
+ − 751 * or Qnil if id has not been mapped to a callback.
+ − 752 * Window procedure may try other targets to route the
+ − 753 * command if we return nil
+ − 754 */
+ − 755 Lisp_Object
442
+ − 756 mswindows_handle_wm_command (struct frame *f, WORD id)
428
+ − 757 {
+ − 758 /* Try to map the command id through the proper hash table */
+ − 759 Lisp_Object data, fn, arg, frame;
+ − 760 struct gcpro gcpro1;
+ − 761
+ − 762 if (NILP (current_hash_table))
+ − 763 return Qnil;
+ − 764
+ − 765 data = Fgethash (make_int (id), current_hash_table, Qunbound);
+ − 766
+ − 767 if (UNBOUNDP (data))
+ − 768 {
+ − 769 menu_cleanup (f);
+ − 770 return Qnil;
+ − 771 }
+ − 772
+ − 773 /* Need to gcpro because the hash table may get destroyed by
+ − 774 menu_cleanup(), and will not gcpro the data any more */
+ − 775 GCPRO1 (data);
+ − 776 menu_cleanup (f);
+ − 777
+ − 778 /* Ok, this is our one. Enqueue it. */
+ − 779 get_gui_callback (data, &fn, &arg);
793
+ − 780 frame = wrap_frame (f);
428
+ − 781 /* this used to call mswindows_enqueue_misc_user_event but that
+ − 782 breaks customize because the misc_event gets eval'ed in some
442
+ − 783 circumstances. Don't change it back unless you can fix the
771
+ − 784 customize problem also. */
707
+ − 785 mswindows_enqueue_misc_user_event (frame, fn, arg);
428
+ − 786
+ − 787 UNGCPRO; /* data */
+ − 788 return Qt;
+ − 789 }
+ − 790
+ − 791
+ − 792 /*------------------------------------------------------------------------*/
+ − 793 /* Message handling proxies */
+ − 794 /*------------------------------------------------------------------------*/
+ − 795
+ − 796 static HMENU wm_initmenu_menu;
442
+ − 797 static struct frame *wm_initmenu_frame;
428
+ − 798
+ − 799 static Lisp_Object
+ − 800 unsafe_handle_wm_initmenupopup (Lisp_Object u_n_u_s_e_d)
+ − 801 {
+ − 802 return unsafe_handle_wm_initmenupopup_1 (wm_initmenu_menu, wm_initmenu_frame);
+ − 803 }
+ − 804
+ − 805 static Lisp_Object
+ − 806 unsafe_handle_wm_initmenu (Lisp_Object u_n_u_s_e_d)
+ − 807 {
+ − 808 return unsafe_handle_wm_initmenu_1 (wm_initmenu_frame);
+ − 809 }
+ − 810
+ − 811 Lisp_Object
442
+ − 812 mswindows_handle_wm_initmenupopup (HMENU hmenu, struct frame *frm)
428
+ − 813 {
+ − 814 /* We cannot pass hmenu as a lisp object. Use static var */
+ − 815 wm_initmenu_menu = hmenu;
+ − 816 wm_initmenu_frame = frm;
853
+ − 817 /* Allow runaway filter code, e.g. custom, to be aborted. We are
+ − 818 usually called from next_event_internal(), which has turned off
+ − 819 quit checking to read the C-g as an event. */
+ − 820 return mswindows_protect_modal_loop ("Error during menu handling",
+ − 821 unsafe_handle_wm_initmenupopup, Qnil,
+ − 822 UNINHIBIT_QUIT);
428
+ − 823 }
+ − 824
+ − 825 Lisp_Object
442
+ − 826 mswindows_handle_wm_initmenu (HMENU hmenu, struct frame *f)
428
+ − 827 {
+ − 828 /* Handle only frame menubar, ignore if from popup or system menu */
442
+ − 829 if (GetMenu (FRAME_MSWINDOWS_HANDLE (f)) == hmenu)
428
+ − 830 {
+ − 831 wm_initmenu_frame = f;
853
+ − 832 return mswindows_protect_modal_loop ("Error during menu handling",
+ − 833 unsafe_handle_wm_initmenu, Qnil,
+ − 834 UNINHIBIT_QUIT);
428
+ − 835 }
+ − 836 return Qt;
+ − 837 }
+ − 838
+ − 839
+ − 840 /*------------------------------------------------------------------------*/
+ − 841 /* Methods */
+ − 842 /*------------------------------------------------------------------------*/
+ − 843
+ − 844 static void
442
+ − 845 mswindows_update_frame_menubars (struct frame *f)
428
+ − 846 {
+ − 847 update_frame_menubar_maybe (f);
+ − 848 }
+ − 849
+ − 850 static void
442
+ − 851 mswindows_free_frame_menubars (struct frame *f)
428
+ − 852 {
442
+ − 853 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = Qnil;
428
+ − 854 }
+ − 855
+ − 856 static void
+ − 857 mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
+ − 858 {
+ − 859 struct frame *f = selected_frame ();
440
+ − 860 Lisp_Event *eev = NULL;
428
+ − 861 HMENU menu;
+ − 862 POINT pt;
+ − 863 int ok;
442
+ − 864 struct gcpro gcpro1;
+ − 865
+ − 866 GCPRO1 (menu_desc); /* to be safe -- see above */
428
+ − 867
+ − 868 if (!NILP (event))
+ − 869 {
+ − 870 CHECK_LIVE_EVENT (event);
+ − 871 eev = XEVENT (event);
+ − 872 if (eev->event_type != button_press_event
+ − 873 && eev->event_type != button_release_event)
+ − 874 wrong_type_argument (Qmouse_event_p, event);
+ − 875 }
+ − 876 else if (!NILP (Vthis_command_keys))
+ − 877 {
+ − 878 /* if an event wasn't passed, use the last event of the event sequence
+ − 879 currently being executed, if that event is a mouse event */
+ − 880 eev = XEVENT (Vthis_command_keys); /* last event first */
+ − 881 if (eev->event_type != button_press_event
+ − 882 && eev->event_type != button_release_event)
+ − 883 eev = NULL;
+ − 884 }
+ − 885
707
+ − 886 popup_up_p++;
+ − 887
428
+ − 888 /* Default is to put the menu at the point (10, 10) in frame */
+ − 889 if (eev)
+ − 890 {
964
+ − 891 #ifdef USE_KKCC
+ − 892 pt.x = XBUTTON_DATA_X (EVENT_DATA (eev));
+ − 893 pt.y = XBUTTON_DATA_Y (EVENT_DATA (eev));
+ − 894 #else /* not USE_KKCC */
428
+ − 895 pt.x = eev->event.button.x;
+ − 896 pt.y = eev->event.button.y;
964
+ − 897 #endif /* not USE_KKCC */
428
+ − 898 ClientToScreen (FRAME_MSWINDOWS_HANDLE (f), &pt);
+ − 899 }
+ − 900 else
+ − 901 pt.x = pt.y = 10;
+ − 902
+ − 903 if (SYMBOLP (menu_desc))
+ − 904 menu_desc = Fsymbol_value (menu_desc);
+ − 905 CHECK_CONS (menu_desc);
+ − 906 CHECK_STRING (XCAR (menu_desc));
+ − 907
707
+ − 908 menu_cleanup (f);
+ − 909
428
+ − 910 current_menudesc = menu_desc;
+ − 911 current_hash_table =
+ − 912 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
442
+ − 913 menu = create_empty_popup_menu ();
428
+ − 914 Fputhash (hmenu_to_lisp_object (menu), Qnil, current_hash_table);
+ − 915 top_level_menu = menu;
442
+ − 916
428
+ − 917 /* see comments in menubar-x.c */
+ − 918 if (zmacs_regions)
+ − 919 zmacs_region_stays = 1;
442
+ − 920
428
+ − 921 ok = TrackPopupMenu (menu,
+ − 922 TPM_LEFTALIGN | TPM_LEFTBUTTON | TPM_RIGHTBUTTON,
+ − 923 pt.x, pt.y, 0,
+ − 924 FRAME_MSWINDOWS_HANDLE (f), NULL);
+ − 925
+ − 926 DestroyMenu (menu);
+ − 927
707
+ − 928 /* A WM_COMMAND is not issued until TrackPopupMenu returns. This
+ − 929 makes setting popup_up_p fairly pointless since we cannot keep
+ − 930 the menu up and dispatch events. Furthermore, we seem to have
+ − 931 little control over what happens to the menu when we click. */
+ − 932 popup_up_p--;
+ − 933
+ − 934 /* Signal a signal if caught by Track...() modal loop. */
+ − 935 /* I think this is pointless, the code hasn't actually put us in a
+ − 936 modal loop at this time -- andyp. */
428
+ − 937 mswindows_unmodalize_signal_maybe ();
+ − 938
+ − 939 /* This is probably the only real reason for failure */
442
+ − 940 if (!ok)
+ − 941 {
+ − 942 menu_cleanup (f);
563
+ − 943 invalid_operation ("Cannot track popup menu while in menu",
+ − 944 menu_desc);
442
+ − 945 }
+ − 946 UNGCPRO;
428
+ − 947 }
+ − 948
+ − 949
+ − 950 /*------------------------------------------------------------------------*/
+ − 951 /* Initialization */
+ − 952 /*------------------------------------------------------------------------*/
+ − 953 void
+ − 954 syms_of_menubar_mswindows (void)
+ − 955 {
+ − 956 }
+ − 957
+ − 958 void
+ − 959 console_type_create_menubar_mswindows (void)
+ − 960 {
+ − 961 CONSOLE_HAS_METHOD (mswindows, update_frame_menubars);
+ − 962 CONSOLE_HAS_METHOD (mswindows, free_frame_menubars);
+ − 963 CONSOLE_HAS_METHOD (mswindows, popup_menu);
+ − 964 }
+ − 965
+ − 966 void
+ − 967 vars_of_menubar_mswindows (void)
+ − 968 {
+ − 969 current_menudesc = Qnil;
+ − 970 current_hash_table = Qnil;
+ − 971
+ − 972 staticpro (¤t_menudesc);
+ − 973 staticpro (¤t_hash_table);
+ − 974 }