Mercurial > hg > xemacs-beta
comparison src/menubar-msw.c @ 442:abe6d1db359e r21-2-36
Import from CVS: tag r21-2-36
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:35:02 +0200 |
parents | 8de8e3f6228a |
children | 183866b06e0b |
comparison
equal
deleted
inserted
replaced
441:72a7cfa4a488 | 442:abe6d1db359e |
---|---|
1 /* Implements an elisp-programmable menubar -- Win32 | 1 /* Implements an elisp-programmable menubar -- Win32 |
2 Copyright (C) 1993, 1994 Free Software Foundation, Inc. | 2 Copyright (C) 1993, 1994 Free Software Foundation, Inc. |
3 Copyright (C) 1995 Tinker Systems and INS Engineering Corp. | 3 Copyright (C) 1995 Tinker Systems and INS Engineering Corp. |
4 Copyright (C) 1997 Kirill M. Katsnelson <kkm@kis.ru> | 4 Copyright (C) 1997 Kirill M. Katsnelson <kkm@kis.ru>. |
5 Copyright (C) 2000 Ben Wing. | |
5 | 6 |
6 This file is part of XEmacs. | 7 This file is part of XEmacs. |
7 | 8 |
8 XEmacs is free software; you can redistribute it and/or modify it | 9 XEmacs is free software; you can redistribute it and/or modify it |
9 under the terms of the GNU General Public License as published by the | 10 under the terms of the GNU General Public License as published by the |
68 * that to cleanup the popup menu hash table, but this is not honestly | 69 * that to cleanup the popup menu hash table, but this is not honestly |
69 * doable using *documented* sequence of messages. Sticking to | 70 * doable using *documented* sequence of messages. Sticking to |
70 * particular knowledge is bad because this may break in Windows NT | 71 * particular knowledge is bad because this may break in Windows NT |
71 * 5.0, or Windows 98, or other future version. Instead, I allow the | 72 * 5.0, or Windows 98, or other future version. Instead, I allow the |
72 * hash tables to hang around, and not clear them, unless WM_COMMAND is | 73 * hash tables to hang around, and not clear them, unless WM_COMMAND is |
73 * received. This is worthy some memory but more safe. Hacks welcome, | 74 * received. This is worth some memory but more safe. Hacks welcome, |
74 * anyways! | 75 * anyways! |
75 * | 76 * |
76 */ | 77 */ |
77 | 78 |
78 #include <config.h> | 79 #include <config.h> |
79 #include "lisp.h" | 80 #include "lisp.h" |
80 #include <limits.h> | |
81 | 81 |
82 #include "buffer.h" | 82 #include "buffer.h" |
83 #include "commands.h" | 83 #include "commands.h" |
84 #include "console-msw.h" | 84 #include "console-msw.h" |
85 #include "elhash.h" | 85 #include "elhash.h" |
91 #include "menubar-msw.h" | 91 #include "menubar-msw.h" |
92 #include "opaque.h" | 92 #include "opaque.h" |
93 #include "window.h" | 93 #include "window.h" |
94 | 94 |
95 /* #### */ | 95 /* #### */ |
96 #define REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIHGT_FLUSH 0 | 96 #define REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH 0 |
97 | 97 |
98 #define EMPTY_ITEM_ID ((UINT)LISP_TO_VOID (Qunbound)) | 98 #define EMPTY_ITEM_ID ((UINT)LISP_TO_VOID (Qunbound)) |
99 #define EMPTY_ITEM_NAME "(empty)" | 99 #define EMPTY_ITEM_NAME "(empty)" |
100 | 100 |
101 /* Current menu (bar or popup) descriptor. gcpro'ed */ | 101 /* Current menu (bar or popup) descriptor. gcpro'ed */ |
115 #define MENU_ITEM_ID_MAX 0xFFFF | 115 #define MENU_ITEM_ID_MAX 0xFFFF |
116 #define MENU_ITEM_ID_BITS(x) (((x) & 0x7FFF) | 0x8000) | 116 #define MENU_ITEM_ID_BITS(x) (((x) & 0x7FFF) | 0x8000) |
117 static HMENU top_level_menu; | 117 static HMENU top_level_menu; |
118 | 118 |
119 /* | 119 /* |
120 * Translate (in place) X accelerator syntax to win32 accelerator syntax. | |
121 * Return new length. | |
122 * len = number of bytes (not including zero terminator). | |
123 * maxlen = size of buffer. | |
124 * accel = (Emchar*) to receive the accelerator character | |
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 * We assume and maintain zero-termination. To be absolutely sure | |
136 * of not hitting an error, maxlen should be >= 2*len + 3. | |
137 */ | |
138 Bytecount | |
139 mswindows_translate_menu_or_dialog_item (Bufbyte *item, Bytecount len, | |
140 Bytecount maxlen, Emchar *accel, | |
141 Lisp_Object error_name) | |
142 { | |
143 Bufbyte *ptr; | |
144 | |
145 if (accel) | |
146 *accel = '\0'; | |
147 | |
148 /* Escape '&' as '&&' */ | |
149 ptr = item; | |
150 while ((ptr = (Bufbyte *) memchr (ptr, '&', len - (ptr - item))) != NULL) | |
151 { | |
152 if (len + 2 > maxlen) | |
153 syntax_error ("Menu item produces too long displayable string", | |
154 error_name); | |
155 memmove (ptr + 1, ptr, (len - (ptr - item)) + 1); | |
156 len++; | |
157 ptr += 2; | |
158 } | |
159 | |
160 /* Replace XEmacs accelerator '%_' with Windows accelerator '&' | |
161 and `%%' with `%'. */ | |
162 ptr = item; | |
163 while ((ptr = memchr (ptr, '%', len - (ptr - item))) != NULL) | |
164 { | |
165 if (*(ptr + 1) == '_') | |
166 { | |
167 if (accel) | |
168 { | |
169 *ptr = '&'; | |
170 if (!*accel) | |
171 /* #### urk ! We need a reference translation table for | |
172 case changes that aren't buffer-specific. */ | |
173 *accel = DOWNCASE (current_buffer, charptr_emchar (ptr + 2)); | |
174 memmove (ptr + 1, ptr + 2, len - (ptr - item + 2) + 1); | |
175 len--; | |
176 } | |
177 else /* Skip accelerator */ | |
178 { | |
179 memmove (ptr, ptr + 2, len - (ptr - item + 2) + 1); | |
180 len-=2; | |
181 } | |
182 } | |
183 else if (*(ptr + 1) == '%') | |
184 { | |
185 memmove (ptr + 1, ptr + 2, len - (ptr - item + 2) + 1); | |
186 len--; | |
187 ptr++; | |
188 } | |
189 else /* % on its own - shouldn't happen */ | |
190 ptr++; | |
191 } | |
192 | |
193 if (accel && !*accel) | |
194 { | |
195 /* Force a default accelerator */ | |
196 if (len + 2 > maxlen) | |
197 syntax_error ("Menu item produces too long displayable string", | |
198 error_name); | |
199 ptr = item; | |
200 memmove (ptr + 1, ptr, len + 1); | |
201 /* #### urk ! We need a reference translation table for | |
202 case changes that aren't buffer-specific. */ | |
203 *accel = DOWNCASE (current_buffer, charptr_emchar (ptr + 1)); | |
204 *ptr = '&'; | |
205 | |
206 len++; | |
207 } | |
208 | |
209 return len; | |
210 } | |
211 | |
212 /* | |
120 * This returns Windows-style menu item string: | 213 * This returns Windows-style menu item string: |
121 * "Left Flush\tRight Flush" | 214 * "Left Flush\tRight Flush" |
122 */ | 215 */ |
216 | |
217 /* #### This is junk. Need correct handling of sizes. Use a Bufbyte_dynarr, | |
218 not a static buffer. */ | |
123 static char* | 219 static char* |
124 displayable_menu_item (Lisp_Object gui_item, int bar_p) | 220 displayable_menu_item (Lisp_Object gui_item, int bar_p, Emchar *accel) |
125 { | 221 { |
222 unsigned int ll; | |
223 | |
126 /* We construct the name in a static buffer. That's fine, because | 224 /* We construct the name in a static buffer. That's fine, because |
127 menu items longer than 128 chars are probably programming errors, | 225 menu items longer than 128 chars are probably programming errors, |
128 and better be caught than displayed! */ | 226 and better be caught than displayed! */ |
129 | 227 |
130 static char buf[MAX_MENUITEM_LENGTH+2]; | 228 static char buf[MAX_MENUITEM_LENGTH+2]; |
131 char *ptr; | |
132 unsigned int ll, lr; | |
133 | 229 |
134 /* Left flush part of the string */ | 230 /* Left flush part of the string */ |
135 ll = gui_item_display_flush_left (gui_item, buf, MAX_MENUITEM_LENGTH); | 231 ll = gui_item_display_flush_left (gui_item, buf, MAX_MENUITEM_LENGTH); |
136 | 232 |
137 /* Escape '&' as '&&' */ | 233 ll = mswindows_translate_menu_or_dialog_item ((Bufbyte *) buf, ll, |
138 ptr = buf; | 234 MAX_MENUITEM_LENGTH, accel, |
139 while ((ptr=memchr (ptr, '&', ll-(ptr-buf))) != NULL) | 235 XGUI_ITEM (gui_item)->name); |
140 { | |
141 if (ll+2 >= MAX_MENUITEM_LENGTH) | |
142 signal_simple_error ("Menu item produces too long displayable string", | |
143 XGUI_ITEM (gui_item)->name); | |
144 memmove (ptr+1, ptr, (ll-(ptr-buf))+1); | |
145 ll++; | |
146 ptr+=2; | |
147 } | |
148 | |
149 /* Replace XEmacs accelerator '%_' with Windows accelerator '&' */ | |
150 ptr = buf; | |
151 while ((ptr=memchr (ptr, '%', ll-(ptr-buf))) != NULL) | |
152 { | |
153 if (*(ptr+1) == '_') | |
154 { | |
155 *ptr = '&'; | |
156 memmove (ptr+1, ptr+2, ll-(ptr-buf+2)); | |
157 ll--; | |
158 } | |
159 ptr++; | |
160 } | |
161 | 236 |
162 /* Right flush part, unless we're at the top-level where it's not allowed */ | 237 /* Right flush part, unless we're at the top-level where it's not allowed */ |
163 if (!bar_p) | 238 if (!bar_p) |
164 { | 239 { |
240 unsigned int lr; | |
241 | |
165 assert (MAX_MENUITEM_LENGTH > ll + 1); | 242 assert (MAX_MENUITEM_LENGTH > ll + 1); |
166 lr = gui_item_display_flush_right (gui_item, buf + ll + 1, | 243 lr = gui_item_display_flush_right (gui_item, buf + ll + 1, |
167 MAX_MENUITEM_LENGTH - ll - 1); | 244 MAX_MENUITEM_LENGTH - ll - 1); |
168 if (lr) | 245 if (lr) |
169 buf [ll] = '\t'; | 246 buf [ll] = '\t'; |
241 { | 318 { |
242 /* An ordinary item - hash its name and callback form. */ | 319 /* An ordinary item - hash its name and callback form. */ |
243 return HASH2 (internal_hash (XVECTOR_DATA(item)[0], 0), | 320 return HASH2 (internal_hash (XVECTOR_DATA(item)[0], 0), |
244 internal_hash (XVECTOR_DATA(item)[1], 0)); | 321 internal_hash (XVECTOR_DATA(item)[1], 0)); |
245 } | 322 } |
246 | 323 |
247 /* An error - will be caught later */ | 324 /* An error - will be caught later */ |
248 return 0; | 325 return 0; |
249 } | 326 } |
250 | 327 |
251 static void | 328 static void |
252 populate_menu_add_item (HMENU menu, Lisp_Object path, | 329 populate_menu_add_item (HMENU menu, Lisp_Object path, |
253 Lisp_Object hash_tab, Lisp_Object item, | 330 Lisp_Object hash_tab, Lisp_Object item, |
331 Lisp_Object *accel_list, | |
254 int flush_right, int bar_p) | 332 int flush_right, int bar_p) |
255 { | 333 { |
256 MENUITEMINFO item_info; | 334 MENUITEMINFO item_info; |
335 UINT oldflags = MF_BYPOSITION; | |
336 UINT olduidnewitem = 0; | |
337 LPCTSTR oldlpnewitem = 0; | |
257 | 338 |
258 item_info.cbSize = sizeof (item_info); | 339 item_info.cbSize = sizeof (item_info); |
259 item_info.fMask = MIIM_TYPE | MIIM_STATE | MIIM_ID; | 340 item_info.fMask = MIIM_TYPE | MIIM_STATE | MIIM_ID; |
260 item_info.fState = 0; | 341 item_info.fState = 0; |
261 item_info.wID = 0; | 342 item_info.wID = 0; |
263 | 344 |
264 if (STRINGP (item)) | 345 if (STRINGP (item)) |
265 { | 346 { |
266 /* Separator or unselectable text */ | 347 /* Separator or unselectable text */ |
267 if (separator_string_p (XSTRING_DATA (item))) | 348 if (separator_string_p (XSTRING_DATA (item))) |
268 item_info.fType = MFT_SEPARATOR; | 349 { |
350 item_info.fType = MFT_SEPARATOR; | |
351 oldflags |= MF_SEPARATOR; | |
352 } | |
269 else | 353 else |
270 { | 354 { |
271 item_info.fType = MFT_STRING; | 355 item_info.fType = MFT_STRING; |
272 item_info.fState = MFS_DISABLED; | 356 item_info.fState = MFS_DISABLED; |
273 item_info.dwTypeData = XSTRING_DATA (item); | 357 item_info.dwTypeData = XSTRING_DATA (item); |
358 oldflags |= MF_STRING | MF_DISABLED; | |
359 oldlpnewitem = item_info.dwTypeData; | |
274 } | 360 } |
275 } | 361 } |
276 else if (CONSP (item)) | 362 else if (CONSP (item)) |
277 { | 363 { |
278 /* Submenu */ | 364 /* Submenu */ |
279 HMENU submenu; | 365 HMENU submenu; |
280 Lisp_Object gui_item = allocate_gui_item (); | 366 Lisp_Object gui_item = allocate_gui_item (); |
281 Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); | 367 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); |
282 struct gcpro gcpro1; | 368 struct gcpro gcpro1, gcpro2, gcpro3; |
283 | 369 Emchar accel; |
284 GCPRO1 (gui_item); | 370 |
371 GCPRO3 (gui_item, path, *accel_list); | |
285 | 372 |
286 menu_parse_submenu_keywords (item, gui_item); | 373 menu_parse_submenu_keywords (item, gui_item); |
287 | 374 |
288 if (!STRINGP (pgui_item->name)) | 375 if (!STRINGP (pgui_item->name)) |
289 signal_simple_error ("Menu name (first element) must be a string", item); | 376 syntax_error ("Menu name (first element) must be a string", |
377 item); | |
290 | 378 |
291 if (!gui_item_included_p (gui_item, Vmenubar_configuration)) | 379 if (!gui_item_included_p (gui_item, Vmenubar_configuration)) |
292 return; | 380 { |
381 UNGCPRO; | |
382 goto done; | |
383 } | |
293 | 384 |
294 if (!gui_item_active_p (gui_item)) | 385 if (!gui_item_active_p (gui_item)) |
295 item_info.fState = MFS_GRAYED; | 386 { |
387 item_info.fState = MFS_GRAYED; | |
388 oldflags |= MF_GRAYED; | |
389 } | |
296 /* Temptation is to put 'else' right here. Although, the | 390 /* Temptation is to put 'else' right here. Although, the |
297 displayed item won't have an arrow indicating that it is a | 391 displayed item won't have an arrow indicating that it is a |
298 popup. So we go ahead a little bit more and create a popup */ | 392 popup. So we go ahead a little bit more and create a popup */ |
299 submenu = create_empty_popup_menu(); | 393 submenu = create_empty_popup_menu (); |
300 | 394 |
301 item_info.fMask |= MIIM_SUBMENU; | 395 item_info.fMask |= MIIM_SUBMENU; |
302 item_info.dwTypeData = displayable_menu_item (gui_item, bar_p); | 396 item_info.dwTypeData = displayable_menu_item (gui_item, bar_p, &accel); |
303 item_info.hSubMenu = submenu; | 397 item_info.hSubMenu = submenu; |
398 olduidnewitem = (UINT) submenu; | |
399 oldlpnewitem = item_info.dwTypeData; | |
400 oldflags |= MF_POPUP; | |
401 | |
402 if (accel && bar_p) | |
403 *accel_list = Fcons (make_char (accel), *accel_list); | |
304 | 404 |
305 if (!(item_info.fState & MFS_GRAYED)) | 405 if (!(item_info.fState & MFS_GRAYED)) |
306 { | 406 { |
307 /* Now add the full submenu path as a value to the hash table, | 407 /* Now add the full submenu path as a value to the hash table, |
308 keyed by menu handle */ | 408 keyed by menu handle */ |
309 if (NILP(path)) | 409 if (NILP(path)) |
310 /* list1 cannot GC */ | |
311 path = list1 (pgui_item->name); | 410 path = list1 (pgui_item->name); |
312 else | 411 else |
313 { | 412 { |
314 Lisp_Object arg[2]; | 413 Lisp_Object arg[2]; |
315 arg[0] = path; | 414 arg[0] = path; |
316 arg[1] = list1 (pgui_item->name); | 415 arg[1] = list1 (pgui_item->name); |
317 /* Fappend gcpro'es its arg */ | |
318 path = Fappend (2, arg); | 416 path = Fappend (2, arg); |
319 } | 417 } |
320 | 418 |
321 /* Fputhash GCPRO'es PATH */ | |
322 Fputhash (hmenu_to_lisp_object (submenu), path, hash_tab); | 419 Fputhash (hmenu_to_lisp_object (submenu), path, hash_tab); |
323 } | 420 } |
324 UNGCPRO; /* gui_item */ | 421 UNGCPRO; |
325 } | 422 } |
326 else if (VECTORP (item)) | 423 else if (VECTORP (item)) |
327 { | 424 { |
328 /* An ordinary item */ | 425 /* An ordinary item */ |
329 Lisp_Object style, id; | 426 Lisp_Object style, id; |
330 Lisp_Object gui_item = gui_parse_item_keywords (item); | 427 Lisp_Object gui_item = gui_parse_item_keywords (item); |
331 Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); | 428 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); |
332 struct gcpro gcpro1; | 429 struct gcpro gcpro1, gcpro2; |
333 | 430 Emchar accel; |
334 GCPRO1 (gui_item); | 431 |
432 GCPRO2 (gui_item, *accel_list); | |
335 | 433 |
336 if (!gui_item_included_p (gui_item, Vmenubar_configuration)) | 434 if (!gui_item_included_p (gui_item, Vmenubar_configuration)) |
337 return; | 435 { |
436 UNGCPRO; | |
437 goto done; | |
438 } | |
439 | |
440 if (!STRINGP (pgui_item->name)) | |
441 pgui_item->name = Feval (pgui_item->name); | |
338 | 442 |
339 if (!gui_item_active_p (gui_item)) | 443 if (!gui_item_active_p (gui_item)) |
340 item_info.fState = MFS_GRAYED; | 444 { |
445 item_info.fState = MFS_GRAYED; | |
446 oldflags = MF_GRAYED; | |
447 } | |
341 | 448 |
342 style = (NILP (pgui_item->selected) || NILP (Feval (pgui_item->selected)) | 449 style = (NILP (pgui_item->selected) || NILP (Feval (pgui_item->selected)) |
343 ? Qnil : pgui_item->style); | 450 ? Qnil : pgui_item->style); |
344 | 451 |
345 if (EQ (style, Qradio)) | 452 if (EQ (style, Qradio)) |
346 { | 453 { |
347 item_info.fType |= MFT_RADIOCHECK; | 454 item_info.fType |= MFT_RADIOCHECK; |
348 item_info.fState |= MFS_CHECKED; | 455 item_info.fState |= MFS_CHECKED; |
456 oldflags |= MF_CHECKED; /* Can't support radio-button checkmarks | |
457 under 3.51 */ | |
349 } | 458 } |
350 else if (EQ (style, Qtoggle)) | 459 else if (EQ (style, Qtoggle)) |
351 { | 460 { |
352 item_info.fState |= MFS_CHECKED; | 461 item_info.fState |= MFS_CHECKED; |
462 oldflags |= MF_CHECKED; | |
353 } | 463 } |
354 | 464 |
355 id = allocate_menu_item_id (path, pgui_item->name, | 465 id = allocate_menu_item_id (path, pgui_item->name, |
356 pgui_item->suffix); | 466 pgui_item->suffix); |
357 Fputhash (id, pgui_item->callback, hash_tab); | 467 Fputhash (id, pgui_item->callback, hash_tab); |
358 | 468 |
359 item_info.wID = (UINT) XINT(id); | 469 item_info.wID = (UINT) XINT (id); |
360 item_info.fType |= MFT_STRING; | 470 item_info.fType |= MFT_STRING; |
361 item_info.dwTypeData = displayable_menu_item (gui_item, bar_p); | 471 item_info.dwTypeData = displayable_menu_item (gui_item, bar_p, &accel); |
362 | 472 olduidnewitem = item_info.wID; |
363 UNGCPRO; /* gui_item */ | 473 oldflags |= MF_STRING; |
474 oldlpnewitem = item_info.dwTypeData; | |
475 | |
476 if (accel && bar_p) | |
477 *accel_list = Fcons (make_char (accel), *accel_list); | |
478 | |
479 UNGCPRO; | |
364 } | 480 } |
365 else | 481 else |
366 { | 482 syntax_error ("Malformed menu item descriptor", item); |
367 signal_simple_error ("Malformed menu item descriptor", item); | |
368 } | |
369 | 483 |
370 if (flush_right) | 484 if (flush_right) |
371 item_info.fType |= MFT_RIGHTJUSTIFY; | 485 item_info.fType |= MFT_RIGHTJUSTIFY; /* can't support in 3.51 */ |
372 | 486 |
373 InsertMenuItem (menu, UINT_MAX, TRUE, &item_info); | 487 if (xInsertMenuItemA) |
374 } | 488 xInsertMenuItemA (menu, UINT_MAX, TRUE, &item_info); |
489 else | |
490 InsertMenu (menu, UINT_MAX, oldflags, olduidnewitem, oldlpnewitem); | |
491 | |
492 done:; | |
493 } | |
375 | 494 |
376 /* | 495 /* |
377 * This function is called from populate_menu and checksum_menu. | 496 * This function is called from populate_menu and checksum_menu. |
378 * When called to populate, MENU is a menu handle, PATH is a | 497 * When called to populate, MENU is a menu handle, PATH is a |
379 * list of strings representing menu path from root to this submenu, | 498 * list of strings representing menu path from root to this submenu, |
388 populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc, | 507 populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc, |
389 Lisp_Object hash_tab, int bar_p, int populate_p) | 508 Lisp_Object hash_tab, int bar_p, int populate_p) |
390 { | 509 { |
391 Lisp_Object item_desc; | 510 Lisp_Object item_desc; |
392 int deep_p, flush_right; | 511 int deep_p, flush_right; |
393 struct gcpro gcpro1; | 512 struct gcpro gcpro1, gcpro2, gcpro3; |
394 unsigned long checksum; | 513 unsigned long checksum; |
395 Lisp_Object gui_item = allocate_gui_item (); | 514 Lisp_Object gui_item = allocate_gui_item (); |
396 Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); | 515 Lisp_Object accel_list = Qnil; |
397 GCPRO1 (gui_item); | 516 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); |
517 | |
518 GCPRO3 (gui_item, accel_list, desc); | |
398 | 519 |
399 /* We are sometimes called with the menubar unchanged, and with changed | 520 /* We are sometimes called with the menubar unchanged, and with changed |
400 right flush. We have to update the menubar in this case, | 521 right flush. We have to update the menubar in this case, |
401 so account for the compliance setting in the hash value */ | 522 so account for the compliance setting in the hash value */ |
402 checksum = REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIHGT_FLUSH; | 523 checksum = REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH; |
403 | 524 |
404 /* Will initially contain only "(empty)" */ | 525 /* Will initially contain only "(empty)" */ |
405 if (populate_p) | 526 if (populate_p) |
406 empty_menu (menu, 1); | 527 empty_menu (menu, 1); |
407 | 528 |
411 /* Fetch keywords prepending the item list */ | 532 /* Fetch keywords prepending the item list */ |
412 desc = menu_parse_submenu_keywords (desc, gui_item); | 533 desc = menu_parse_submenu_keywords (desc, gui_item); |
413 | 534 |
414 /* Check that menu name is specified when expected */ | 535 /* Check that menu name is specified when expected */ |
415 if (NILP (pgui_item->name) && deep_p) | 536 if (NILP (pgui_item->name) && deep_p) |
416 signal_simple_error ("Menu must have a name", desc); | 537 syntax_error ("Menu must have a name", desc); |
417 | 538 |
418 /* Apply filter if specified */ | 539 /* Apply filter if specified */ |
419 if (!NILP (pgui_item->filter)) | 540 if (!NILP (pgui_item->filter)) |
420 desc = call1 (pgui_item->filter, desc); | 541 desc = call1 (pgui_item->filter, desc); |
421 | 542 |
424 EXTERNAL_LIST_LOOP (item_desc, desc) | 545 EXTERNAL_LIST_LOOP (item_desc, desc) |
425 { | 546 { |
426 if (NILP (XCAR (item_desc))) | 547 if (NILP (XCAR (item_desc))) |
427 { | 548 { |
428 /* Do not flush right menubar items when MS style compliant */ | 549 /* Do not flush right menubar items when MS style compliant */ |
429 if (bar_p && !REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIHGT_FLUSH) | 550 if (bar_p && !REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH) |
430 flush_right = 1; | 551 flush_right = 1; |
431 if (!populate_p) | 552 if (!populate_p) |
432 checksum = HASH2 (checksum, LISP_HASH (Qnil)); | 553 checksum = HASH2 (checksum, LISP_HASH (Qnil)); |
433 } | 554 } |
434 else if (populate_p) | 555 else if (populate_p) |
435 populate_menu_add_item (menu, path, hash_tab, | 556 populate_menu_add_item (menu, path, hash_tab, |
436 XCAR (item_desc), flush_right, bar_p); | 557 XCAR (item_desc), &accel_list, |
558 flush_right, bar_p); | |
437 else | 559 else |
438 checksum = HASH2 (checksum, | 560 checksum = HASH2 (checksum, |
439 checksum_menu_item (XCAR (item_desc))); | 561 checksum_menu_item (XCAR (item_desc))); |
440 } | 562 } |
441 | 563 |
442 if (populate_p) | 564 if (populate_p) |
443 { | 565 { |
444 /* Remove the "(empty)" item, if there are other ones */ | 566 /* Remove the "(empty)" item, if there are other ones */ |
445 if (GetMenuItemCount (menu) > 1) | 567 if (GetMenuItemCount (menu) > 1) |
446 RemoveMenu (menu, EMPTY_ITEM_ID, MF_BYCOMMAND); | 568 RemoveMenu (menu, EMPTY_ITEM_ID, MF_BYCOMMAND); |
447 | 569 |
448 /* Add the header to the popup, if told so. The same as in X - an | 570 /* Add the header to the popup, if told so. The same as in X - an |
449 insensitive item, and a separator (Seems to me, there were | 571 insensitive item, and a separator (Seems to me, there were |
450 two separators in X... In Windows this looks ugly, anyways. */ | 572 two separators in X... In Windows this looks ugly, anyways.) */ |
451 if (!bar_p && !deep_p && popup_menu_titles && !NILP(pgui_item->name)) | 573 if (!bar_p && !deep_p && popup_menu_titles && !NILP (pgui_item->name)) |
452 { | 574 { |
453 CHECK_STRING (pgui_item->name); | 575 CHECK_STRING (pgui_item->name); |
454 InsertMenu (menu, 0, MF_BYPOSITION | MF_STRING | MF_DISABLED, | 576 InsertMenu (menu, 0, MF_BYPOSITION | MF_STRING | MF_DISABLED, |
455 0, XSTRING_DATA(pgui_item->name)); | 577 0, displayable_menu_item (gui_item, bar_p, NULL)); |
456 InsertMenu (menu, 1, MF_BYPOSITION | MF_SEPARATOR, 0, NULL); | 578 InsertMenu (menu, 1, MF_BYPOSITION | MF_SEPARATOR, 0, NULL); |
457 SetMenuDefaultItem (menu, 0, MF_BYPOSITION); | 579 if (xSetMenuDefaultItem) /* not in NT 3.5x */ |
458 } | 580 xSetMenuDefaultItem (menu, 0, MF_BYPOSITION); |
459 } | 581 } |
460 UNGCPRO; /* gui_item */ | 582 } |
583 | |
584 if (bar_p) | |
585 Fputhash (Qt, accel_list, hash_tab); | |
586 | |
587 UNGCPRO; | |
461 return checksum; | 588 return checksum; |
462 } | 589 } |
463 | 590 |
464 static void | 591 static void |
465 populate_menu (HMENU menu, Lisp_Object path, Lisp_Object desc, | 592 populate_menu (HMENU menu, Lisp_Object path, Lisp_Object desc, |
466 Lisp_Object hash_tab, int bar_p) | 593 Lisp_Object hash_tab, int bar_p) |
467 { | 594 { |
468 populate_or_checksum_helper (menu, path, desc, hash_tab, bar_p, 1); | 595 populate_or_checksum_helper (menu, path, desc, hash_tab, bar_p, 1); |
469 } | 596 } |
470 | 597 |
471 static unsigned long | 598 static unsigned long |
473 { | 600 { |
474 return populate_or_checksum_helper (NULL, Qnil, desc, Qunbound, 0, 0); | 601 return populate_or_checksum_helper (NULL, Qnil, desc, Qunbound, 0, 0); |
475 } | 602 } |
476 | 603 |
477 static void | 604 static void |
478 update_frame_menubar_maybe (struct frame* f) | 605 update_frame_menubar_maybe (struct frame *f) |
479 { | 606 { |
480 HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f)); | 607 HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f)); |
481 struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); | 608 struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); |
482 Lisp_Object desc = (!NILP (w->menubar_visible_p) | 609 Lisp_Object desc = (!NILP (w->menubar_visible_p) |
483 ? symbol_value_in_buffer (Qcurrent_menubar, w->buffer) | 610 ? symbol_value_in_buffer (Qcurrent_menubar, w->buffer) |
484 : Qnil); | 611 : Qnil); |
612 struct gcpro gcpro1; | |
613 | |
614 GCPRO1 (desc); /* it's safest to do this, just in case some filter | |
615 or something changes the value of current-menubar */ | |
485 | 616 |
486 top_level_menu = menubar; | 617 top_level_menu = menubar; |
487 | 618 |
488 if (NILP (desc) && menubar != NULL) | 619 if (NILP (desc) && menubar != NULL) |
489 { | 620 { |
490 /* Menubar has gone */ | 621 /* Menubar has gone */ |
491 FRAME_MSWINDOWS_MENU_HASH_TABLE(f) = Qnil; | 622 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = Qnil; |
492 SetMenu (FRAME_MSWINDOWS_HANDLE (f), NULL); | 623 SetMenu (FRAME_MSWINDOWS_HANDLE (f), NULL); |
493 DestroyMenu (menubar); | 624 DestroyMenu (menubar); |
494 DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f)); | 625 DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f)); |
626 UNGCPRO; | |
495 return; | 627 return; |
496 } | 628 } |
497 | 629 |
498 if (!NILP (desc) && menubar == NULL) | 630 if (!NILP (desc) && menubar == NULL) |
499 { | 631 { |
503 } | 635 } |
504 | 636 |
505 if (NILP (desc)) | 637 if (NILP (desc)) |
506 { | 638 { |
507 /* We did not have the bar and are not going to */ | 639 /* We did not have the bar and are not going to */ |
640 UNGCPRO; | |
508 return; | 641 return; |
509 } | 642 } |
510 | 643 |
511 /* Now we bail out if the menubar has not changed */ | 644 /* Now we bail out if the menubar has not changed */ |
512 if (FRAME_MSWINDOWS_MENU_CHECKSUM(f) == checksum_menu (desc)) | 645 if (FRAME_MSWINDOWS_MENU_CHECKSUM (f) == checksum_menu (desc)) |
513 return; | 646 { |
647 UNGCPRO; | |
648 return; | |
649 } | |
514 | 650 |
515 populate: | 651 populate: |
516 /* Come with empty hash table */ | 652 /* Come with empty hash table */ |
517 if (NILP (FRAME_MSWINDOWS_MENU_HASH_TABLE(f))) | 653 if (NILP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f))) |
518 FRAME_MSWINDOWS_MENU_HASH_TABLE(f) = | 654 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = |
519 make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); | 655 make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); |
520 else | 656 else |
521 Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE(f)); | 657 Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); |
522 | 658 |
523 Fputhash (hmenu_to_lisp_object (menubar), Qnil, | 659 Fputhash (hmenu_to_lisp_object (menubar), Qnil, |
524 FRAME_MSWINDOWS_MENU_HASH_TABLE(f)); | 660 FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); |
525 populate_menu (menubar, Qnil, desc, | 661 populate_menu (menubar, Qnil, desc, |
526 FRAME_MSWINDOWS_MENU_HASH_TABLE(f), 1); | 662 FRAME_MSWINDOWS_MENU_HASH_TABLE (f), 1); |
527 SetMenu (FRAME_MSWINDOWS_HANDLE (f), menubar); | 663 SetMenu (FRAME_MSWINDOWS_HANDLE (f), menubar); |
528 DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f)); | 664 DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f)); |
529 | 665 |
530 FRAME_MSWINDOWS_MENU_CHECKSUM(f) = checksum_menu (desc); | 666 FRAME_MSWINDOWS_MENU_CHECKSUM (f) = checksum_menu (desc); |
667 | |
668 UNGCPRO; | |
531 } | 669 } |
532 | 670 |
533 static void | 671 static void |
534 prune_menubar (struct frame *f) | 672 prune_menubar (struct frame *f) |
535 { | 673 { |
536 HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f)); | 674 HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f)); |
537 Lisp_Object desc = current_frame_menubar (f); | 675 Lisp_Object desc = current_frame_menubar (f); |
676 struct gcpro gcpro1; | |
677 | |
538 if (menubar == NULL) | 678 if (menubar == NULL) |
539 return; | 679 return; |
540 | 680 |
541 /* #### If a filter function has set desc to Qnil, this abort() | 681 /* #### If a filter function has set desc to Qnil, this abort() |
542 triggers. To resolve, we must prevent filters explicitly from | 682 triggers. To resolve, we must prevent filters explicitly from |
543 mangling with the active menu. In apply_filter probably? | 683 mangling with the active menu. In apply_filter probably? |
544 Is copy-tree on the whole menu too expensive? */ | 684 Is copy-tree on the whole menu too expensive? */ |
545 if (NILP(desc)) | 685 if (NILP (desc)) |
546 /* abort(); */ | 686 /* abort(); */ |
547 return; | 687 return; |
548 | 688 |
689 GCPRO1 (desc); /* just to be safe -- see above */ | |
549 /* We do the trick by removing all items and re-populating top level */ | 690 /* We do the trick by removing all items and re-populating top level */ |
550 empty_menu (menubar, 0); | 691 empty_menu (menubar, 0); |
551 | 692 |
552 assert (HASH_TABLEP (FRAME_MSWINDOWS_MENU_HASH_TABLE(f))); | 693 assert (HASH_TABLEP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f))); |
553 Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE(f)); | 694 Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); |
554 | 695 |
555 Fputhash (hmenu_to_lisp_object (menubar), Qnil, | 696 Fputhash (hmenu_to_lisp_object (menubar), Qnil, |
556 FRAME_MSWINDOWS_MENU_HASH_TABLE(f)); | 697 FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); |
557 populate_menu (menubar, Qnil, desc, | 698 populate_menu (menubar, Qnil, desc, |
558 FRAME_MSWINDOWS_MENU_HASH_TABLE(f), 1); | 699 FRAME_MSWINDOWS_MENU_HASH_TABLE (f), 1); |
700 UNGCPRO; | |
559 } | 701 } |
560 | 702 |
561 /* | 703 /* |
562 * This is called when cleanup is possible. It is better not to | 704 * This is called when cleanup is possible. It is better not to |
563 * clean things up at all than do it too early! | 705 * clean things up at all than do it too early! |
568 /* This function can GC */ | 710 /* This function can GC */ |
569 current_menudesc = Qnil; | 711 current_menudesc = Qnil; |
570 current_hash_table = Qnil; | 712 current_hash_table = Qnil; |
571 prune_menubar (f); | 713 prune_menubar (f); |
572 } | 714 } |
573 | 715 |
716 int | |
717 mswindows_char_is_accelerator (struct frame *f, Emchar ch) | |
718 { | |
719 Lisp_Object hash = FRAME_MSWINDOWS_MENU_HASH_TABLE (f); | |
720 | |
721 if (NILP (hash)) | |
722 return 0; | |
723 /* !!#### not Mule-ized */ | |
724 return !NILP (memq_no_quit (make_char (tolower (ch)), | |
725 Fgethash (Qt, hash, Qnil))); | |
726 } | |
727 | |
574 | 728 |
575 /*------------------------------------------------------------------------*/ | 729 /*------------------------------------------------------------------------*/ |
576 /* Message handlers */ | 730 /* Message handlers */ |
577 /*------------------------------------------------------------------------*/ | 731 /*------------------------------------------------------------------------*/ |
578 static Lisp_Object | 732 static Lisp_Object |
579 unsafe_handle_wm_initmenupopup_1 (HMENU menu, struct frame* f) | 733 unsafe_handle_wm_initmenupopup_1 (HMENU menu, struct frame *f) |
580 { | 734 { |
581 /* This function can call lisp, beat dogs and stick chewing gum to | 735 /* This function can call lisp, beat dogs and stick chewing gum to |
582 everything! */ | 736 everything! */ |
583 | 737 |
584 Lisp_Object path, desc; | 738 Lisp_Object path, desc; |
606 UNGCPRO; | 760 UNGCPRO; |
607 return Qt; | 761 return Qt; |
608 } | 762 } |
609 | 763 |
610 static Lisp_Object | 764 static Lisp_Object |
611 unsafe_handle_wm_initmenu_1 (struct frame* f) | 765 unsafe_handle_wm_initmenu_1 (struct frame *f) |
612 { | 766 { |
613 /* This function can call lisp */ | 767 /* This function can call lisp */ |
614 | 768 |
615 /* NOTE: This is called for the bar only, WM_INITMENU | 769 /* NOTE: This is called for the bar only, WM_INITMENU |
616 for popups is filtered out */ | 770 for popups is filtered out */ |
623 run_hook (Qactivate_menubar_hook); | 777 run_hook (Qactivate_menubar_hook); |
624 | 778 |
625 update_frame_menubar_maybe (f); | 779 update_frame_menubar_maybe (f); |
626 | 780 |
627 current_menudesc = current_frame_menubar (f); | 781 current_menudesc = current_frame_menubar (f); |
628 current_hash_table = FRAME_MSWINDOWS_MENU_HASH_TABLE(f); | 782 current_hash_table = FRAME_MSWINDOWS_MENU_HASH_TABLE (f); |
629 assert (HASH_TABLEP (current_hash_table)); | 783 assert (HASH_TABLEP (current_hash_table)); |
630 | 784 |
631 return Qt; | 785 return Qt; |
632 } | 786 } |
633 | 787 |
636 * or Qnil if id has not been mapped to a callback. | 790 * or Qnil if id has not been mapped to a callback. |
637 * Window procedure may try other targets to route the | 791 * Window procedure may try other targets to route the |
638 * command if we return nil | 792 * command if we return nil |
639 */ | 793 */ |
640 Lisp_Object | 794 Lisp_Object |
641 mswindows_handle_wm_command (struct frame* f, WORD id) | 795 mswindows_handle_wm_command (struct frame *f, WORD id) |
642 { | 796 { |
643 /* Try to map the command id through the proper hash table */ | 797 /* Try to map the command id through the proper hash table */ |
644 Lisp_Object data, fn, arg, frame; | 798 Lisp_Object data, fn, arg, frame; |
645 struct gcpro gcpro1; | 799 struct gcpro gcpro1; |
646 | 800 |
663 /* Ok, this is our one. Enqueue it. */ | 817 /* Ok, this is our one. Enqueue it. */ |
664 get_gui_callback (data, &fn, &arg); | 818 get_gui_callback (data, &fn, &arg); |
665 XSETFRAME (frame, f); | 819 XSETFRAME (frame, f); |
666 /* this used to call mswindows_enqueue_misc_user_event but that | 820 /* this used to call mswindows_enqueue_misc_user_event but that |
667 breaks customize because the misc_event gets eval'ed in some | 821 breaks customize because the misc_event gets eval'ed in some |
668 cicumstances. Don't change it back unless you can fix the | 822 circumstances. Don't change it back unless you can fix the |
669 customize problem also.*/ | 823 customize problem also.*/ |
670 enqueue_misc_user_event (frame, fn, arg); | 824 enqueue_misc_user_event (frame, fn, arg); |
671 mswindows_enqueue_magic_event (NULL, XM_BUMPQUEUE); | 825 mswindows_enqueue_magic_event (NULL, XM_BUMPQUEUE); |
672 | 826 |
673 UNGCPRO; /* data */ | 827 UNGCPRO; /* data */ |
678 /*------------------------------------------------------------------------*/ | 832 /*------------------------------------------------------------------------*/ |
679 /* Message handling proxies */ | 833 /* Message handling proxies */ |
680 /*------------------------------------------------------------------------*/ | 834 /*------------------------------------------------------------------------*/ |
681 | 835 |
682 static HMENU wm_initmenu_menu; | 836 static HMENU wm_initmenu_menu; |
683 static struct frame* wm_initmenu_frame; | 837 static struct frame *wm_initmenu_frame; |
684 | 838 |
685 static Lisp_Object | 839 static Lisp_Object |
686 unsafe_handle_wm_initmenupopup (Lisp_Object u_n_u_s_e_d) | 840 unsafe_handle_wm_initmenupopup (Lisp_Object u_n_u_s_e_d) |
687 { | 841 { |
688 return unsafe_handle_wm_initmenupopup_1 (wm_initmenu_menu, wm_initmenu_frame); | 842 return unsafe_handle_wm_initmenupopup_1 (wm_initmenu_menu, wm_initmenu_frame); |
693 { | 847 { |
694 return unsafe_handle_wm_initmenu_1 (wm_initmenu_frame); | 848 return unsafe_handle_wm_initmenu_1 (wm_initmenu_frame); |
695 } | 849 } |
696 | 850 |
697 Lisp_Object | 851 Lisp_Object |
698 mswindows_handle_wm_initmenupopup (HMENU hmenu, struct frame* frm) | 852 mswindows_handle_wm_initmenupopup (HMENU hmenu, struct frame *frm) |
699 { | 853 { |
700 /* We cannot pass hmenu as a lisp object. Use static var */ | 854 /* We cannot pass hmenu as a lisp object. Use static var */ |
701 wm_initmenu_menu = hmenu; | 855 wm_initmenu_menu = hmenu; |
702 wm_initmenu_frame = frm; | 856 wm_initmenu_frame = frm; |
703 return mswindows_protect_modal_loop (unsafe_handle_wm_initmenupopup, Qnil); | 857 return mswindows_protect_modal_loop (unsafe_handle_wm_initmenupopup, Qnil); |
704 } | 858 } |
705 | 859 |
706 Lisp_Object | 860 Lisp_Object |
707 mswindows_handle_wm_initmenu (HMENU hmenu, struct frame* f) | 861 mswindows_handle_wm_initmenu (HMENU hmenu, struct frame *f) |
708 { | 862 { |
709 /* Handle only frame menubar, ignore if from popup or system menu */ | 863 /* Handle only frame menubar, ignore if from popup or system menu */ |
710 if (GetMenu (FRAME_MSWINDOWS_HANDLE(f)) == hmenu) | 864 if (GetMenu (FRAME_MSWINDOWS_HANDLE (f)) == hmenu) |
711 { | 865 { |
712 wm_initmenu_frame = f; | 866 wm_initmenu_frame = f; |
713 return mswindows_protect_modal_loop (unsafe_handle_wm_initmenu, Qnil); | 867 return mswindows_protect_modal_loop (unsafe_handle_wm_initmenu, Qnil); |
714 } | 868 } |
715 return Qt; | 869 return Qt; |
719 /*------------------------------------------------------------------------*/ | 873 /*------------------------------------------------------------------------*/ |
720 /* Methods */ | 874 /* Methods */ |
721 /*------------------------------------------------------------------------*/ | 875 /*------------------------------------------------------------------------*/ |
722 | 876 |
723 static void | 877 static void |
724 mswindows_update_frame_menubars (struct frame* f) | 878 mswindows_update_frame_menubars (struct frame *f) |
725 { | 879 { |
726 update_frame_menubar_maybe (f); | 880 update_frame_menubar_maybe (f); |
727 } | 881 } |
728 | 882 |
729 static void | 883 static void |
730 mswindows_free_frame_menubars (struct frame* f) | 884 mswindows_free_frame_menubars (struct frame *f) |
731 { | 885 { |
732 FRAME_MSWINDOWS_MENU_HASH_TABLE(f) = Qnil; | 886 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = Qnil; |
733 } | 887 } |
734 | 888 |
735 static void | 889 static void |
736 mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event) | 890 mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event) |
737 { | 891 { |
738 struct frame *f = selected_frame (); | 892 struct frame *f = selected_frame (); |
739 Lisp_Event *eev = NULL; | 893 Lisp_Event *eev = NULL; |
740 HMENU menu; | 894 HMENU menu; |
741 POINT pt; | 895 POINT pt; |
742 int ok; | 896 int ok; |
897 struct gcpro gcpro1; | |
898 | |
899 GCPRO1 (menu_desc); /* to be safe -- see above */ | |
743 | 900 |
744 if (!NILP (event)) | 901 if (!NILP (event)) |
745 { | 902 { |
746 CHECK_LIVE_EVENT (event); | 903 CHECK_LIVE_EVENT (event); |
747 eev = XEVENT (event); | 904 eev = XEVENT (event); |
775 CHECK_STRING (XCAR (menu_desc)); | 932 CHECK_STRING (XCAR (menu_desc)); |
776 | 933 |
777 current_menudesc = menu_desc; | 934 current_menudesc = menu_desc; |
778 current_hash_table = | 935 current_hash_table = |
779 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); | 936 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); |
780 menu = create_empty_popup_menu(); | 937 menu = create_empty_popup_menu (); |
781 Fputhash (hmenu_to_lisp_object (menu), Qnil, current_hash_table); | 938 Fputhash (hmenu_to_lisp_object (menu), Qnil, current_hash_table); |
782 top_level_menu = menu; | 939 top_level_menu = menu; |
783 | 940 |
784 /* see comments in menubar-x.c */ | 941 /* see comments in menubar-x.c */ |
785 if (zmacs_regions) | 942 if (zmacs_regions) |
786 zmacs_region_stays = 1; | 943 zmacs_region_stays = 1; |
787 | 944 |
788 ok = TrackPopupMenu (menu, | 945 ok = TrackPopupMenu (menu, |
789 TPM_LEFTALIGN | TPM_LEFTBUTTON | TPM_RIGHTBUTTON, | 946 TPM_LEFTALIGN | TPM_LEFTBUTTON | TPM_RIGHTBUTTON, |
790 pt.x, pt.y, 0, | 947 pt.x, pt.y, 0, |
791 FRAME_MSWINDOWS_HANDLE (f), NULL); | 948 FRAME_MSWINDOWS_HANDLE (f), NULL); |
792 | 949 |
794 | 951 |
795 /* Signal a signal if caught by Track...() modal loop */ | 952 /* Signal a signal if caught by Track...() modal loop */ |
796 mswindows_unmodalize_signal_maybe (); | 953 mswindows_unmodalize_signal_maybe (); |
797 | 954 |
798 /* This is probably the only real reason for failure */ | 955 /* This is probably the only real reason for failure */ |
799 if (!ok) { | 956 if (!ok) |
800 menu_cleanup (f); | 957 { |
801 signal_simple_error ("Cannot track popup menu while in menu", | 958 menu_cleanup (f); |
802 menu_desc); | 959 signal_simple_error ("Cannot track popup menu while in menu", |
803 } | 960 menu_desc); |
961 } | |
962 UNGCPRO; | |
804 } | 963 } |
805 | 964 |
806 | 965 |
807 /*------------------------------------------------------------------------*/ | 966 /*------------------------------------------------------------------------*/ |
808 /* Initialization */ | 967 /* Initialization */ |