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