Mercurial > hg > xemacs-beta
annotate src/menubar-msw.c @ 5159:cb303ff63e76
merge
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Fri, 19 Mar 2010 17:02:11 -0500 |
| parents | ae48681c47fa |
| children | 71ee43b8a74d |
| rev | line source |
|---|---|
| 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>. |
| 1333 | 5 Copyright (C) 2000, 2001, 2002, 2003 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 "opaque.h" | |
| 872 | 95 #include "window-impl.h" |
| 428 | 96 |
| 97 /* #### */ | |
| 442 | 98 #define REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH 0 |
| 428 | 99 |
| 5013 | 100 #define EMPTY_ITEM_ID ((UINT)STORE_LISP_IN_VOID (Qunbound)) |
| 771 | 101 #define EMPTY_ITEM_NAME "(empty)" /* WARNING: uses of this need XETEXT */ |
| 428 | 102 |
| 103 /* Current menu (bar or popup) descriptor. gcpro'ed */ | |
| 104 static Lisp_Object current_menudesc; | |
| 105 | |
| 106 /* Current menubar or popup hash table. gcpro'ed */ | |
| 107 static Lisp_Object current_hash_table; | |
| 108 | |
| 109 /* This is used to allocate unique ids to menu items. | |
| 110 Items ids are in MENU_ITEM_ID_MIN to MENU_ITEM_ID_MAX. | |
| 111 Allocation checks that the item is not already in | |
| 112 the TOP_LEVEL_MENU */ | |
| 113 | |
| 114 /* #### defines go to gui-msw.h, as the range is shared with toolbars | |
| 115 (If only toolbars will be implemented as common controls) */ | |
| 116 #define MENU_ITEM_ID_MIN 0x8000 | |
| 117 #define MENU_ITEM_ID_MAX 0xFFFF | |
| 118 #define MENU_ITEM_ID_BITS(x) (((x) & 0x7FFF) | 0x8000) | |
| 119 static HMENU top_level_menu; | |
| 120 | |
| 121 /* | |
| 122 * This returns Windows-style menu item string: | |
| 123 * "Left Flush\tRight Flush" | |
| 124 */ | |
| 442 | 125 |
| 771 | 126 static Lisp_Object |
| 867 | 127 displayable_menu_item (Lisp_Object gui_item, int bar_p, Ichar *accel) |
| 428 | 128 { |
| 771 | 129 Lisp_Object left, right = Qnil; |
| 428 | 130 |
| 131 /* Left flush part of the string */ | |
| 771 | 132 left = gui_item_display_flush_left (gui_item); |
| 428 | 133 |
| 771 | 134 left = mswindows_translate_menu_or_dialog_item (left, accel); |
| 428 | 135 |
| 136 /* Right flush part, unless we're at the top-level where it's not allowed */ | |
| 137 if (!bar_p) | |
| 771 | 138 right = gui_item_display_flush_right (gui_item); |
| 442 | 139 |
| 771 | 140 if (!NILP (right)) |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4677
diff
changeset
|
141 return concat3 (left, build_ascstring ("\t"), right); |
| 771 | 142 else |
| 143 return left; | |
| 428 | 144 } |
| 145 | |
| 146 /* | |
| 147 * hmenu_to_lisp_object() returns an opaque ptr given menu handle. | |
| 148 */ | |
| 149 static Lisp_Object | |
| 150 hmenu_to_lisp_object (HMENU hmenu) | |
| 151 { | |
| 152 return make_opaque_ptr (hmenu); | |
| 153 } | |
| 154 | |
| 155 /* | |
| 156 * Allocation tries a hash based on item's path and name first. This | |
| 157 * almost guarantees that the same item will override its old value in | |
| 158 * the hash table rather than abandon it. | |
| 159 */ | |
| 160 static Lisp_Object | |
| 161 allocate_menu_item_id (Lisp_Object path, Lisp_Object name, Lisp_Object suffix) | |
| 162 { | |
| 163 UINT id = MENU_ITEM_ID_BITS (HASH3 (internal_hash (path, 0), | |
| 164 internal_hash (name, 0), | |
| 165 internal_hash (suffix, 0))); | |
| 166 do { | |
| 167 id = MENU_ITEM_ID_BITS (id + 1); | |
| 168 } while (GetMenuState (top_level_menu, id, MF_BYCOMMAND) != 0xFFFFFFFF); | |
| 169 return make_int (id); | |
| 170 } | |
| 171 | |
| 172 static HMENU | |
| 173 create_empty_popup_menu (void) | |
| 174 { | |
| 175 return CreatePopupMenu (); | |
| 176 } | |
| 177 | |
| 178 static void | |
| 179 empty_menu (HMENU menu, int add_empty_p) | |
| 180 { | |
| 181 while (DeleteMenu (menu, 0, MF_BYPOSITION)); | |
| 182 if (add_empty_p) | |
| 771 | 183 qxeAppendMenu (menu, MF_STRING | MF_GRAYED, EMPTY_ITEM_ID, |
| 184 XETEXT (EMPTY_ITEM_NAME)); | |
| 428 | 185 } |
| 186 | |
| 187 /* | |
| 188 * The idea of checksumming is that we must hash minimal object | |
| 189 * which is necessarily changes when the item changes. For separator | |
| 190 * this is a constant, for grey strings and submenus these are hashes | |
| 191 * of names, since submenus are unpopulated until opened so always | |
| 192 * equal otherwise. For items, this is a full hash value of a callback, | |
| 193 * because a callback may me a form which can be changed only somewhere | |
| 194 * in depth. | |
| 195 */ | |
| 196 static unsigned long | |
| 197 checksum_menu_item (Lisp_Object item) | |
| 198 { | |
| 199 if (STRINGP (item)) | |
| 200 { | |
| 201 /* Separator or unselectable text - hash as a string + 13 */ | |
| 202 if (separator_string_p (XSTRING_DATA (item))) | |
| 203 return 13; | |
| 204 else | |
| 205 return internal_hash (item, 0) + 13; | |
| 206 } | |
| 207 else if (CONSP (item)) | |
| 208 { | |
| 209 /* Submenu - hash by its string name + 0 */ | |
| 771 | 210 return internal_hash (XCAR (item), 0); |
| 428 | 211 } |
| 212 else if (VECTORP (item)) | |
| 213 { | |
| 214 /* An ordinary item - hash its name and callback form. */ | |
| 215 return HASH2 (internal_hash (XVECTOR_DATA(item)[0], 0), | |
| 216 internal_hash (XVECTOR_DATA(item)[1], 0)); | |
| 217 } | |
| 442 | 218 |
| 428 | 219 /* An error - will be caught later */ |
| 220 return 0; | |
| 221 } | |
| 222 | |
| 223 static void | |
| 224 populate_menu_add_item (HMENU menu, Lisp_Object path, | |
| 225 Lisp_Object hash_tab, Lisp_Object item, | |
| 442 | 226 Lisp_Object *accel_list, |
| 428 | 227 int flush_right, int bar_p) |
| 228 { | |
| 771 | 229 MENUITEMINFOW item_info; |
| 428 | 230 |
| 231 item_info.cbSize = sizeof (item_info); | |
| 232 item_info.fMask = MIIM_TYPE | MIIM_STATE | MIIM_ID; | |
| 233 item_info.fState = 0; | |
| 234 item_info.wID = 0; | |
| 235 item_info.fType = 0; | |
| 236 | |
| 237 if (STRINGP (item)) | |
| 238 { | |
| 239 /* Separator or unselectable text */ | |
| 240 if (separator_string_p (XSTRING_DATA (item))) | |
| 771 | 241 item_info.fType = MFT_SEPARATOR; |
| 428 | 242 else |
| 243 { | |
| 244 item_info.fType = MFT_STRING; | |
| 245 item_info.fState = MFS_DISABLED; | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
246 item_info.dwTypeData = (XELPTSTR) LISP_STRING_TO_TSTR (item); |
| 428 | 247 } |
| 248 } | |
| 249 else if (CONSP (item)) | |
| 250 { | |
| 251 /* Submenu */ | |
| 252 HMENU submenu; | |
| 253 Lisp_Object gui_item = allocate_gui_item (); | |
| 442 | 254 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); |
| 255 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 867 | 256 Ichar accel; |
| 428 | 257 |
| 442 | 258 GCPRO3 (gui_item, path, *accel_list); |
| 428 | 259 |
| 260 menu_parse_submenu_keywords (item, gui_item); | |
| 261 | |
| 262 if (!STRINGP (pgui_item->name)) | |
| 563 | 263 invalid_argument ("Menu name (first element) must be a string", |
| 442 | 264 item); |
| 428 | 265 |
| 266 if (!gui_item_included_p (gui_item, Vmenubar_configuration)) | |
| 442 | 267 { |
| 268 UNGCPRO; | |
| 269 goto done; | |
| 270 } | |
| 428 | 271 |
| 1913 | 272 if (!gui_item_active_p (gui_item)) |
| 771 | 273 item_info.fState = MFS_GRAYED; |
| 428 | 274 /* Temptation is to put 'else' right here. Although, the |
| 275 displayed item won't have an arrow indicating that it is a | |
| 276 popup. So we go ahead a little bit more and create a popup */ | |
| 442 | 277 submenu = create_empty_popup_menu (); |
| 428 | 278 |
| 279 item_info.fMask |= MIIM_SUBMENU; | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
280 item_info.dwTypeData = (XELPTSTR) |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
281 LISP_STRING_TO_TSTR (displayable_menu_item (gui_item, bar_p, &accel)); |
| 428 | 282 item_info.hSubMenu = submenu; |
| 442 | 283 |
| 284 if (accel && bar_p) | |
| 285 *accel_list = Fcons (make_char (accel), *accel_list); | |
| 428 | 286 |
| 287 if (!(item_info.fState & MFS_GRAYED)) | |
| 288 { | |
| 289 /* Now add the full submenu path as a value to the hash table, | |
| 290 keyed by menu handle */ | |
| 291 if (NILP(path)) | |
| 292 path = list1 (pgui_item->name); | |
| 293 else | |
| 294 { | |
| 295 Lisp_Object arg[2]; | |
| 296 arg[0] = path; | |
| 297 arg[1] = list1 (pgui_item->name); | |
| 298 path = Fappend (2, arg); | |
| 299 } | |
| 300 | |
| 301 Fputhash (hmenu_to_lisp_object (submenu), path, hash_tab); | |
| 302 } | |
| 442 | 303 UNGCPRO; |
| 304 } | |
| 428 | 305 else if (VECTORP (item)) |
| 306 { | |
| 307 /* An ordinary item */ | |
| 308 Lisp_Object style, id; | |
| 309 Lisp_Object gui_item = gui_parse_item_keywords (item); | |
| 442 | 310 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); |
| 311 struct gcpro gcpro1, gcpro2; | |
| 867 | 312 Ichar accel; |
| 428 | 313 |
| 442 | 314 GCPRO2 (gui_item, *accel_list); |
| 428 | 315 |
| 316 if (!gui_item_included_p (gui_item, Vmenubar_configuration)) | |
| 442 | 317 { |
| 318 UNGCPRO; | |
| 319 goto done; | |
| 320 } | |
| 321 | |
| 322 if (!STRINGP (pgui_item->name)) | |
|
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2500
diff
changeset
|
323 pgui_item->name = IGNORE_MULTIPLE_VALUES (Feval (pgui_item->name)); |
| 428 | 324 |
| 1913 | 325 if (!gui_item_active_p (gui_item)) |
| 771 | 326 item_info.fState = MFS_GRAYED; |
| 428 | 327 |
| 328 style = (NILP (pgui_item->selected) || NILP (Feval (pgui_item->selected)) | |
| 329 ? Qnil : pgui_item->style); | |
| 330 | |
| 331 if (EQ (style, Qradio)) | |
| 332 { | |
| 333 item_info.fType |= MFT_RADIOCHECK; | |
| 334 item_info.fState |= MFS_CHECKED; | |
| 335 } | |
| 336 else if (EQ (style, Qtoggle)) | |
| 771 | 337 item_info.fState |= MFS_CHECKED; |
| 428 | 338 |
| 339 id = allocate_menu_item_id (path, pgui_item->name, | |
| 340 pgui_item->suffix); | |
| 341 Fputhash (id, pgui_item->callback, hash_tab); | |
| 342 | |
| 442 | 343 item_info.wID = (UINT) XINT (id); |
| 428 | 344 item_info.fType |= MFT_STRING; |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
345 item_info.dwTypeData = (XELPTSTR) |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
346 LISP_STRING_TO_TSTR (displayable_menu_item (gui_item, bar_p, &accel)); |
| 428 | 347 |
| 442 | 348 if (accel && bar_p) |
| 349 *accel_list = Fcons (make_char (accel), *accel_list); | |
| 350 | |
| 351 UNGCPRO; | |
| 428 | 352 } |
| 353 else | |
| 563 | 354 sferror ("Malformed menu item descriptor", item); |
| 428 | 355 |
| 356 if (flush_right) | |
| 771 | 357 item_info.fType |= MFT_RIGHTJUSTIFY; |
| 428 | 358 |
| 771 | 359 qxeInsertMenuItem (menu, UINT_MAX, TRUE, &item_info); |
| 442 | 360 |
| 361 done:; | |
| 362 } | |
| 428 | 363 |
| 364 /* | |
| 365 * This function is called from populate_menu and checksum_menu. | |
| 366 * When called to populate, MENU is a menu handle, PATH is a | |
| 367 * list of strings representing menu path from root to this submenu, | |
| 368 * DESCRIPTOR is a menu descriptor, HASH_TAB is a hash table associated | |
| 369 * with root menu, BAR_P indicates whether this called for a menubar or | |
| 370 * a popup, and POPULATE_P is non-zero. Return value must be ignored. | |
| 371 * When called to checksum, DESCRIPTOR has the same meaning, POPULATE_P | |
| 372 * is zero, PATH must be Qnil, and the rest of parameters is ignored. | |
| 373 * Return value is the menu checksum. | |
| 374 */ | |
| 375 static unsigned long | |
| 376 populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc, | |
| 377 Lisp_Object hash_tab, int bar_p, int populate_p) | |
| 378 { | |
| 379 int deep_p, flush_right; | |
| 442 | 380 struct gcpro gcpro1, gcpro2, gcpro3; |
| 428 | 381 unsigned long checksum; |
| 382 Lisp_Object gui_item = allocate_gui_item (); | |
| 442 | 383 Lisp_Object accel_list = Qnil; |
| 384 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); | |
| 385 | |
| 386 GCPRO3 (gui_item, accel_list, desc); | |
| 428 | 387 |
| 388 /* We are sometimes called with the menubar unchanged, and with changed | |
| 389 right flush. We have to update the menubar in this case, | |
| 390 so account for the compliance setting in the hash value */ | |
| 442 | 391 checksum = REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH; |
| 428 | 392 |
| 393 /* Will initially contain only "(empty)" */ | |
| 394 if (populate_p) | |
| 395 empty_menu (menu, 1); | |
| 396 | |
| 397 /* PATH set to nil indicates top-level popup or menubar */ | |
| 398 deep_p = !NILP (path); | |
| 399 | |
| 400 /* Fetch keywords prepending the item list */ | |
| 401 desc = menu_parse_submenu_keywords (desc, gui_item); | |
| 402 | |
| 403 /* Check that menu name is specified when expected */ | |
| 404 if (NILP (pgui_item->name) && deep_p) | |
| 563 | 405 sferror ("Menu must have a name", desc); |
| 428 | 406 |
| 407 /* Apply filter if specified */ | |
| 408 if (!NILP (pgui_item->filter)) | |
| 409 desc = call1 (pgui_item->filter, desc); | |
| 410 | |
| 411 /* Loop thru the desc's CDR and add items for each entry */ | |
| 412 flush_right = 0; | |
| 2367 | 413 { |
| 414 EXTERNAL_LIST_LOOP_2 (elt, desc) | |
| 415 { | |
| 416 if (NILP (elt)) | |
| 417 { | |
| 418 /* Do not flush right menubar items when MS style compliant */ | |
| 419 if (bar_p && !REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH) | |
| 420 flush_right = 1; | |
| 421 if (!populate_p) | |
| 422 checksum = HASH2 (checksum, LISP_HASH (Qnil)); | |
| 423 } | |
| 424 else if (populate_p) | |
| 425 populate_menu_add_item (menu, path, hash_tab, | |
| 426 elt, &accel_list, | |
| 427 flush_right, bar_p); | |
| 428 else | |
| 429 checksum = HASH2 (checksum, | |
| 430 checksum_menu_item (elt)); | |
| 431 } | |
| 432 } | |
| 442 | 433 |
| 428 | 434 if (populate_p) |
| 435 { | |
| 436 /* Remove the "(empty)" item, if there are other ones */ | |
| 437 if (GetMenuItemCount (menu) > 1) | |
| 438 RemoveMenu (menu, EMPTY_ITEM_ID, MF_BYCOMMAND); | |
| 439 | |
| 440 /* Add the header to the popup, if told so. The same as in X - an | |
| 441 insensitive item, and a separator (Seems to me, there were | |
| 442 | 442 two separators in X... In Windows this looks ugly, anyways.) */ |
| 443 if (!bar_p && !deep_p && popup_menu_titles && !NILP (pgui_item->name)) | |
| 428 | 444 { |
| 771 | 445 qxeInsertMenu (menu, 0, MF_BYPOSITION | MF_STRING | MF_DISABLED, |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
446 0, LISP_STRING_TO_TSTR (displayable_menu_item |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
447 (gui_item, bar_p, NULL))); |
| 771 | 448 qxeInsertMenu (menu, 1, MF_BYPOSITION | MF_SEPARATOR, 0, NULL); |
| 449 SetMenuDefaultItem (menu, 0, MF_BYPOSITION); | |
| 428 | 450 } |
| 451 } | |
| 442 | 452 |
| 453 if (bar_p) | |
| 454 Fputhash (Qt, accel_list, hash_tab); | |
| 455 | |
| 456 UNGCPRO; | |
| 428 | 457 return checksum; |
| 458 } | |
| 459 | |
| 460 static void | |
| 461 populate_menu (HMENU menu, Lisp_Object path, Lisp_Object desc, | |
| 442 | 462 Lisp_Object hash_tab, int bar_p) |
| 428 | 463 { |
| 464 populate_or_checksum_helper (menu, path, desc, hash_tab, bar_p, 1); | |
| 465 } | |
| 466 | |
| 467 static unsigned long | |
| 468 checksum_menu (Lisp_Object desc) | |
| 469 { | |
| 470 return populate_or_checksum_helper (NULL, Qnil, desc, Qunbound, 0, 0); | |
| 471 } | |
| 472 | |
| 473 static void | |
| 442 | 474 update_frame_menubar_maybe (struct frame *f) |
| 428 | 475 { |
| 476 HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f)); | |
| 477 struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); | |
| 478 Lisp_Object desc = (!NILP (w->menubar_visible_p) | |
| 479 ? symbol_value_in_buffer (Qcurrent_menubar, w->buffer) | |
| 480 : Qnil); | |
| 442 | 481 struct gcpro gcpro1; |
| 482 | |
| 483 GCPRO1 (desc); /* it's safest to do this, just in case some filter | |
| 484 or something changes the value of current-menubar */ | |
| 428 | 485 |
| 486 top_level_menu = menubar; | |
| 487 | |
| 488 if (NILP (desc) && menubar != NULL) | |
| 489 { | |
| 490 /* Menubar has gone */ | |
| 442 | 491 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = Qnil; |
| 428 | 492 SetMenu (FRAME_MSWINDOWS_HANDLE (f), NULL); |
| 493 DestroyMenu (menubar); | |
| 494 DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f)); | |
| 442 | 495 UNGCPRO; |
| 428 | 496 return; |
| 497 } | |
| 498 | |
| 499 if (!NILP (desc) && menubar == NULL) | |
| 500 { | |
| 501 /* Menubar has appeared */ | |
| 502 menubar = CreateMenu (); | |
| 503 goto populate; | |
| 504 } | |
| 505 | |
| 506 if (NILP (desc)) | |
| 507 { | |
| 508 /* We did not have the bar and are not going to */ | |
| 442 | 509 UNGCPRO; |
| 428 | 510 return; |
| 511 } | |
| 512 | |
| 513 /* Now we bail out if the menubar has not changed */ | |
| 442 | 514 if (FRAME_MSWINDOWS_MENU_CHECKSUM (f) == checksum_menu (desc)) |
| 515 { | |
| 516 UNGCPRO; | |
| 517 return; | |
| 518 } | |
| 428 | 519 |
| 520 populate: | |
| 521 /* Come with empty hash table */ | |
| 442 | 522 if (NILP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f))) |
| 523 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = | |
| 428 | 524 make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); |
| 525 else | |
| 442 | 526 Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); |
| 428 | 527 |
| 528 Fputhash (hmenu_to_lisp_object (menubar), Qnil, | |
| 442 | 529 FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); |
| 428 | 530 populate_menu (menubar, Qnil, desc, |
| 442 | 531 FRAME_MSWINDOWS_MENU_HASH_TABLE (f), 1); |
| 428 | 532 SetMenu (FRAME_MSWINDOWS_HANDLE (f), menubar); |
| 533 DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f)); | |
| 534 | |
| 442 | 535 FRAME_MSWINDOWS_MENU_CHECKSUM (f) = checksum_menu (desc); |
| 536 | |
| 537 UNGCPRO; | |
| 428 | 538 } |
| 539 | |
| 540 static void | |
| 541 prune_menubar (struct frame *f) | |
| 542 { | |
| 543 HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f)); | |
| 544 Lisp_Object desc = current_frame_menubar (f); | |
| 442 | 545 struct gcpro gcpro1; |
| 546 | |
| 428 | 547 if (menubar == NULL) |
| 548 return; | |
| 549 | |
| 2500 | 550 /* #### If a filter function has set desc to Qnil, this ABORT() |
| 428 | 551 triggers. To resolve, we must prevent filters explicitly from |
| 552 mangling with the active menu. In apply_filter probably? | |
| 553 Is copy-tree on the whole menu too expensive? */ | |
| 442 | 554 if (NILP (desc)) |
| 2500 | 555 /* ABORT(); */ |
| 428 | 556 return; |
| 557 | |
| 442 | 558 GCPRO1 (desc); /* just to be safe -- see above */ |
| 428 | 559 /* We do the trick by removing all items and re-populating top level */ |
| 560 empty_menu (menubar, 0); | |
| 561 | |
| 442 | 562 assert (HASH_TABLEP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f))); |
| 563 Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); | |
| 428 | 564 |
| 565 Fputhash (hmenu_to_lisp_object (menubar), Qnil, | |
| 442 | 566 FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); |
| 567 populate_menu (menubar, Qnil, desc, | |
| 568 FRAME_MSWINDOWS_MENU_HASH_TABLE (f), 1); | |
| 569 UNGCPRO; | |
| 428 | 570 } |
| 571 | |
| 572 /* | |
| 573 * This is called when cleanup is possible. It is better not to | |
| 574 * clean things up at all than do it too early! | |
| 575 */ | |
| 576 static void | |
| 577 menu_cleanup (struct frame *f) | |
| 578 { | |
| 579 /* This function can GC */ | |
| 580 current_menudesc = Qnil; | |
| 581 current_hash_table = Qnil; | |
| 582 prune_menubar (f); | |
| 583 } | |
| 442 | 584 |
| 585 int | |
| 867 | 586 mswindows_char_is_accelerator (struct frame *f, Ichar ch) |
| 442 | 587 { |
| 588 Lisp_Object hash = FRAME_MSWINDOWS_MENU_HASH_TABLE (f); | |
| 589 | |
| 590 if (NILP (hash)) | |
| 591 return 0; | |
| 771 | 592 return !NILP (memq_no_quit |
| 593 (make_char | |
| 594 (DOWNCASE (WINDOW_XBUFFER (FRAME_SELECTED_XWINDOW (f)), ch)), | |
| 595 Fgethash (Qt, hash, Qnil))); | |
| 442 | 596 } |
| 597 | |
| 428 | 598 |
| 599 /*------------------------------------------------------------------------*/ | |
| 600 /* Message handlers */ | |
| 601 /*------------------------------------------------------------------------*/ | |
| 602 static Lisp_Object | |
| 2286 | 603 unsafe_handle_wm_initmenupopup_1 (HMENU menu, struct frame *UNUSED (f)) |
| 428 | 604 { |
| 605 /* This function can call lisp, beat dogs and stick chewing gum to | |
| 606 everything! */ | |
| 607 | |
| 608 Lisp_Object path, desc; | |
| 609 struct gcpro gcpro1; | |
| 707 | 610 |
| 428 | 611 /* Find which guy is going to explode */ |
| 612 path = Fgethash (hmenu_to_lisp_object (menu), current_hash_table, Qunbound); | |
| 613 assert (!UNBOUNDP (path)); | |
| 614 #ifdef DEBUG_XEMACS | |
| 615 /* Allow to continue in a debugger after assert - not so fatal */ | |
| 616 if (UNBOUNDP (path)) | |
| 563 | 617 signal_error (Qinternal_error, "internal menu error", Qunbound); |
| 428 | 618 #endif |
| 619 | |
| 620 /* Now find a desc chunk for it. If none, then probably menu open | |
| 621 hook has played too much games around stuff */ | |
| 622 desc = Fmenu_find_real_submenu (current_menudesc, path); | |
| 623 if (NILP (desc)) | |
| 563 | 624 invalid_state ("This menu does not exist any more", path); |
| 428 | 625 |
| 626 /* Now, stuff it */ | |
| 627 /* DESC may be generated by filter, so we have to gcpro it */ | |
| 628 GCPRO1 (desc); | |
| 629 populate_menu (menu, path, desc, current_hash_table, 0); | |
| 630 UNGCPRO; | |
| 631 return Qt; | |
| 632 } | |
| 633 | |
| 634 static Lisp_Object | |
| 442 | 635 unsafe_handle_wm_initmenu_1 (struct frame *f) |
| 428 | 636 { |
| 637 /* This function can call lisp */ | |
| 638 | |
| 639 /* NOTE: This is called for the bar only, WM_INITMENU | |
| 640 for popups is filtered out */ | |
| 641 | |
| 642 /* #### - this menubar update mechanism is expensively anti-social and | |
| 643 the activate-menubar-hook is now mostly obsolete. */ | |
| 644 | |
| 645 /* We simply ignore return value. In any case, we construct the bar | |
| 646 on the fly */ | |
| 853 | 647 run_hook_trapping_problems |
| 1333 | 648 (Qmenubar, Qactivate_menubar_hook, |
| 853 | 649 INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION); |
| 428 | 650 |
| 651 update_frame_menubar_maybe (f); | |
| 652 | |
| 653 current_menudesc = current_frame_menubar (f); | |
| 442 | 654 current_hash_table = FRAME_MSWINDOWS_MENU_HASH_TABLE (f); |
| 428 | 655 assert (HASH_TABLEP (current_hash_table)); |
| 656 | |
| 657 return Qt; | |
| 658 } | |
| 659 | |
| 660 /* | |
| 661 * Return value is Qt if we have dispatched the command, | |
| 662 * or Qnil if id has not been mapped to a callback. | |
| 663 * Window procedure may try other targets to route the | |
| 664 * command if we return nil | |
| 665 */ | |
| 666 Lisp_Object | |
| 442 | 667 mswindows_handle_wm_command (struct frame *f, WORD id) |
| 428 | 668 { |
| 669 /* Try to map the command id through the proper hash table */ | |
| 670 Lisp_Object data, fn, arg, frame; | |
| 671 struct gcpro gcpro1; | |
| 672 | |
| 673 if (NILP (current_hash_table)) | |
| 674 return Qnil; | |
| 675 | |
| 676 data = Fgethash (make_int (id), current_hash_table, Qunbound); | |
| 677 | |
| 678 if (UNBOUNDP (data)) | |
| 679 { | |
| 680 menu_cleanup (f); | |
| 681 return Qnil; | |
| 682 } | |
| 683 | |
| 684 /* Need to gcpro because the hash table may get destroyed by | |
| 685 menu_cleanup(), and will not gcpro the data any more */ | |
| 686 GCPRO1 (data); | |
| 687 menu_cleanup (f); | |
| 688 | |
| 689 /* Ok, this is our one. Enqueue it. */ | |
| 690 get_gui_callback (data, &fn, &arg); | |
| 793 | 691 frame = wrap_frame (f); |
| 428 | 692 /* this used to call mswindows_enqueue_misc_user_event but that |
| 693 breaks customize because the misc_event gets eval'ed in some | |
| 442 | 694 circumstances. Don't change it back unless you can fix the |
| 771 | 695 customize problem also. */ |
| 707 | 696 mswindows_enqueue_misc_user_event (frame, fn, arg); |
| 428 | 697 |
| 698 UNGCPRO; /* data */ | |
| 699 return Qt; | |
| 700 } | |
| 701 | |
| 702 | |
| 703 /*------------------------------------------------------------------------*/ | |
| 704 /* Message handling proxies */ | |
| 705 /*------------------------------------------------------------------------*/ | |
| 706 | |
| 1268 | 707 struct handle_wm_initmenu |
| 708 { | |
| 709 HMENU menu; | |
| 710 struct frame *frame; | |
| 711 }; | |
| 428 | 712 |
| 713 static Lisp_Object | |
| 1268 | 714 unsafe_handle_wm_initmenupopup (void *arg) |
| 428 | 715 { |
| 1268 | 716 struct handle_wm_initmenu *z = (struct handle_wm_initmenu *) arg; |
| 717 return unsafe_handle_wm_initmenupopup_1 (z->menu, z->frame); | |
| 428 | 718 } |
| 719 | |
| 720 static Lisp_Object | |
| 1268 | 721 unsafe_handle_wm_initmenu (void *arg) |
| 428 | 722 { |
| 1268 | 723 struct handle_wm_initmenu *z = (struct handle_wm_initmenu *) arg; |
| 724 return unsafe_handle_wm_initmenu_1 (z->frame); | |
| 428 | 725 } |
| 726 | |
| 727 Lisp_Object | |
| 442 | 728 mswindows_handle_wm_initmenupopup (HMENU hmenu, struct frame *frm) |
| 428 | 729 { |
| 1268 | 730 struct handle_wm_initmenu z; |
| 1279 | 731 int depth = internal_bind_int (&in_menu_callback, 1); |
| 732 Lisp_Object retval; | |
| 1268 | 733 |
| 734 z.menu = hmenu; | |
| 735 z.frame = frm; | |
| 736 | |
| 737 /* [[ Allow runaway filter code, e.g. custom, to be aborted. We are | |
| 853 | 738 usually called from next_event_internal(), which has turned off |
| 1268 | 739 quit checking to read the C-g as an event.]] |
| 740 | |
| 741 #### This is bogus because by the very act of calling | |
| 742 event_stream_protect_modal_loop(), we disable event retrieval! */ | |
| 1279 | 743 retval = event_stream_protect_modal_loop ("Error during menu handling", |
| 744 unsafe_handle_wm_initmenupopup, &z, | |
| 745 UNINHIBIT_QUIT); | |
| 746 unbind_to (depth); | |
| 747 | |
| 748 return retval; | |
| 428 | 749 } |
| 750 | |
| 751 Lisp_Object | |
| 442 | 752 mswindows_handle_wm_initmenu (HMENU hmenu, struct frame *f) |
| 428 | 753 { |
| 754 /* Handle only frame menubar, ignore if from popup or system menu */ | |
| 442 | 755 if (GetMenu (FRAME_MSWINDOWS_HANDLE (f)) == hmenu) |
| 428 | 756 { |
| 1268 | 757 struct handle_wm_initmenu z; |
| 758 | |
| 759 z.frame = f; | |
| 760 return event_stream_protect_modal_loop ("Error during menu handling", | |
| 761 unsafe_handle_wm_initmenu, &z, | |
| 762 UNINHIBIT_QUIT); | |
| 428 | 763 } |
| 764 return Qt; | |
| 765 } | |
| 766 | |
| 767 | |
| 768 /*------------------------------------------------------------------------*/ | |
| 769 /* Methods */ | |
| 770 /*------------------------------------------------------------------------*/ | |
| 771 | |
| 772 static void | |
| 442 | 773 mswindows_update_frame_menubars (struct frame *f) |
| 428 | 774 { |
| 775 update_frame_menubar_maybe (f); | |
| 776 } | |
| 777 | |
| 778 static void | |
| 442 | 779 mswindows_free_frame_menubars (struct frame *f) |
| 428 | 780 { |
| 442 | 781 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = Qnil; |
| 428 | 782 } |
| 783 | |
| 784 static void | |
| 785 mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event) | |
| 786 { | |
| 787 struct frame *f = selected_frame (); | |
| 440 | 788 Lisp_Event *eev = NULL; |
| 428 | 789 HMENU menu; |
| 790 POINT pt; | |
| 791 int ok; | |
| 442 | 792 struct gcpro gcpro1; |
| 793 | |
| 794 GCPRO1 (menu_desc); /* to be safe -- see above */ | |
| 428 | 795 |
| 796 if (!NILP (event)) | |
| 797 { | |
| 798 CHECK_LIVE_EVENT (event); | |
| 799 eev = XEVENT (event); | |
| 800 if (eev->event_type != button_press_event | |
| 801 && eev->event_type != button_release_event) | |
| 802 wrong_type_argument (Qmouse_event_p, event); | |
| 803 } | |
| 804 else if (!NILP (Vthis_command_keys)) | |
| 805 { | |
| 806 /* if an event wasn't passed, use the last event of the event sequence | |
| 807 currently being executed, if that event is a mouse event */ | |
| 808 eev = XEVENT (Vthis_command_keys); /* last event first */ | |
| 809 if (eev->event_type != button_press_event | |
| 810 && eev->event_type != button_release_event) | |
| 811 eev = NULL; | |
| 812 } | |
| 813 | |
| 707 | 814 popup_up_p++; |
| 815 | |
| 428 | 816 /* Default is to put the menu at the point (10, 10) in frame */ |
| 817 if (eev) | |
| 818 { | |
| 1204 | 819 pt.x = EVENT_BUTTON_X (eev); |
| 820 pt.y = EVENT_BUTTON_Y (eev); | |
| 428 | 821 ClientToScreen (FRAME_MSWINDOWS_HANDLE (f), &pt); |
| 822 } | |
| 823 else | |
| 824 pt.x = pt.y = 10; | |
| 825 | |
| 826 if (SYMBOLP (menu_desc)) | |
| 827 menu_desc = Fsymbol_value (menu_desc); | |
| 828 CHECK_CONS (menu_desc); | |
| 829 CHECK_STRING (XCAR (menu_desc)); | |
| 830 | |
| 707 | 831 menu_cleanup (f); |
| 832 | |
| 428 | 833 current_menudesc = menu_desc; |
| 834 current_hash_table = | |
| 835 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); | |
| 442 | 836 menu = create_empty_popup_menu (); |
| 428 | 837 Fputhash (hmenu_to_lisp_object (menu), Qnil, current_hash_table); |
| 838 top_level_menu = menu; | |
| 442 | 839 |
| 428 | 840 /* see comments in menubar-x.c */ |
| 841 if (zmacs_regions) | |
| 842 zmacs_region_stays = 1; | |
| 442 | 843 |
| 428 | 844 ok = TrackPopupMenu (menu, |
| 845 TPM_LEFTALIGN | TPM_LEFTBUTTON | TPM_RIGHTBUTTON, | |
| 846 pt.x, pt.y, 0, | |
| 847 FRAME_MSWINDOWS_HANDLE (f), NULL); | |
| 848 | |
| 849 DestroyMenu (menu); | |
| 850 | |
| 707 | 851 /* A WM_COMMAND is not issued until TrackPopupMenu returns. This |
| 852 makes setting popup_up_p fairly pointless since we cannot keep | |
| 853 the menu up and dispatch events. Furthermore, we seem to have | |
| 854 little control over what happens to the menu when we click. */ | |
| 855 popup_up_p--; | |
| 856 | |
| 857 /* Signal a signal if caught by Track...() modal loop. */ | |
| 858 /* I think this is pointless, the code hasn't actually put us in a | |
| 859 modal loop at this time -- andyp. */ | |
| 428 | 860 mswindows_unmodalize_signal_maybe (); |
| 861 | |
| 862 /* This is probably the only real reason for failure */ | |
| 442 | 863 if (!ok) |
| 864 { | |
| 865 menu_cleanup (f); | |
| 563 | 866 invalid_operation ("Cannot track popup menu while in menu", |
| 867 menu_desc); | |
| 442 | 868 } |
| 869 UNGCPRO; | |
| 428 | 870 } |
| 871 | |
| 872 | |
| 873 /*------------------------------------------------------------------------*/ | |
| 874 /* Initialization */ | |
| 875 /*------------------------------------------------------------------------*/ | |
| 876 void | |
| 877 syms_of_menubar_mswindows (void) | |
| 878 { | |
| 879 } | |
| 880 | |
| 881 void | |
| 882 console_type_create_menubar_mswindows (void) | |
| 883 { | |
| 884 CONSOLE_HAS_METHOD (mswindows, update_frame_menubars); | |
| 885 CONSOLE_HAS_METHOD (mswindows, free_frame_menubars); | |
| 886 CONSOLE_HAS_METHOD (mswindows, popup_menu); | |
| 887 } | |
| 888 | |
| 889 void | |
| 890 vars_of_menubar_mswindows (void) | |
| 891 { | |
| 892 current_menudesc = Qnil; | |
| 893 current_hash_table = Qnil; | |
| 894 | |
| 895 staticpro (¤t_menudesc); | |
| 896 staticpro (¤t_hash_table); | |
| 897 } |