Mercurial > hg > xemacs-beta
annotate src/menubar-msw.c @ 5518:3cc7470ea71c
gnuclient: if TMPDIR was set and connect failed, try again with /tmp
2011-06-03 Aidan Kehoe <kehoea@parhasard.net>
* gnuslib.c (connect_to_unix_server):
Retry with /tmp as a directory in which to search for Unix sockets
if an attempt to connect with some other directory failed (which
may be because gnuclient and gnuserv don't share an environment
value for TMPDIR, or because gnuserv was compiled with USE_TMPDIR
turned off).
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Fri, 03 Jun 2011 18:40:57 +0100 |
| 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 } |