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