Mercurial > hg > xemacs-beta
annotate src/menubar-msw.c @ 4981:4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
-------------------- ChangeLog entries follow: --------------------
modules/ChangeLog addition:
2010-02-05 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c:
* postgresql/postgresql.c (CHECK_LIVE_CONNECTION):
* postgresql/postgresql.c (Fpq_connectdb):
* postgresql/postgresql.c (Fpq_connect_start):
* postgresql/postgresql.c (Fpq_lo_import):
* postgresql/postgresql.c (Fpq_lo_export):
* ldap/eldap.c (Fldap_open):
* ldap/eldap.c (Fldap_search_basic):
* ldap/eldap.c (Fldap_add):
* ldap/eldap.c (Fldap_modify):
* ldap/eldap.c (Fldap_delete):
* canna/canna_api.c (Fcanna_initialize):
* canna/canna_api.c (Fcanna_store_yomi):
* canna/canna_api.c (Fcanna_parse):
* canna/canna_api.c (Fcanna_henkan_begin):
EXTERNAL_TO_C_STRING returns its argument instead of storing it
in a parameter, and is renamed to EXTERNAL_TO_ITEXT. Similar
things happen to related macros. See entry in src/ChangeLog.
More Mule-izing of postgresql.c. Extract out common code
between `pq-connectdb' and `pq-connect-start'. Fix places
that signal an error string using a formatted string to instead
follow the standard and have a fixed reason followed by the
particular error message stored as one of the frobs.
src/ChangeLog addition:
2010-02-05 Ben Wing <ben@xemacs.org>
* console-msw.c (write_string_to_mswindows_debugging_output):
* console-msw.c (Fmswindows_message_box):
* console-x.c (x_perhaps_init_unseen_key_defaults):
* console.c:
* database.c (dbm_get):
* database.c (dbm_put):
* database.c (dbm_remove):
* database.c (berkdb_get):
* database.c (berkdb_put):
* database.c (berkdb_remove):
* database.c (Fopen_database):
* device-gtk.c (gtk_init_device):
* device-msw.c (msprinter_init_device_internal):
* device-msw.c (msprinter_default_printer):
* device-msw.c (msprinter_init_device):
* device-msw.c (sync_printer_with_devmode):
* device-msw.c (Fmsprinter_select_settings):
* device-x.c (sanity_check_geometry_resource):
* device-x.c (Dynarr_add_validified_lisp_string):
* device-x.c (x_init_device):
* device-x.c (Fx_put_resource):
* device-x.c (Fx_valid_keysym_name_p):
* device-x.c (Fx_set_font_path):
* dialog-msw.c (push_lisp_string_as_unicode):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-msw.c (handle_file_dialog_box):
* dialog-x.c (dbox_descriptor_to_widget_value):
* editfns.c (Fformat_time_string):
* editfns.c (Fencode_time):
* editfns.c (Fset_time_zone_rule):
* emacs.c (make_argc_argv):
* emacs.c (Fdump_emacs):
* emodules.c (emodules_load):
* eval.c:
* eval.c (maybe_signal_error_1):
* event-msw.c (Fdde_alloc_advise_item):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (mswindows_wnd_proc):
* fileio.c (report_error_with_errno):
* fileio.c (Fsysnetunam):
* fileio.c (Fdo_auto_save):
* font-mgr.c (extract_fcapi_string):
* font-mgr.c (Ffc_config_app_font_add_file):
* font-mgr.c (Ffc_config_app_font_add_dir):
* font-mgr.c (Ffc_config_filename):
* frame-gtk.c (gtk_set_frame_text_value):
* frame-gtk.c (gtk_create_widgets):
* frame-msw.c (mswindows_init_frame_1):
* frame-msw.c (mswindows_set_title_from_ibyte):
* frame-msw.c (msprinter_init_frame_3):
* frame-x.c (x_set_frame_text_value):
* frame-x.c (x_set_frame_properties):
* frame-x.c (start_drag_internal_1):
* frame-x.c (x_cde_transfer_callback):
* frame-x.c (x_create_widgets):
* glyphs-eimage.c (my_jpeg_output_message):
* glyphs-eimage.c (jpeg_instantiate):
* glyphs-eimage.c (gif_instantiate):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate):
* glyphs-gtk.c (xbm_instantiate_1):
* glyphs-gtk.c (gtk_xbm_instantiate):
* glyphs-gtk.c (gtk_xpm_instantiate):
* glyphs-gtk.c (gtk_xface_instantiate):
* glyphs-gtk.c (cursor_font_instantiate):
* glyphs-gtk.c (gtk_redisplay_widget):
* glyphs-gtk.c (gtk_widget_instantiate_1):
* glyphs-gtk.c (gtk_add_tab_item):
* glyphs-msw.c (mswindows_xpm_instantiate):
* glyphs-msw.c (bmp_instantiate):
* glyphs-msw.c (mswindows_resource_instantiate):
* glyphs-msw.c (xbm_instantiate_1):
* glyphs-msw.c (mswindows_xbm_instantiate):
* glyphs-msw.c (mswindows_xface_instantiate):
* glyphs-msw.c (mswindows_redisplay_widget):
* glyphs-msw.c (mswindows_widget_instantiate):
* glyphs-msw.c (add_tree_item):
* glyphs-msw.c (add_tab_item):
* glyphs-msw.c (mswindows_combo_box_instantiate):
* glyphs-msw.c (mswindows_widget_query_string_geometry):
* glyphs-x.c (x_locate_pixmap_file):
* glyphs-x.c (xbm_instantiate_1):
* glyphs-x.c (x_xbm_instantiate):
* glyphs-x.c (extract_xpm_color_names):
* glyphs-x.c (x_xpm_instantiate):
* glyphs-x.c (x_xface_instantiate):
* glyphs-x.c (autodetect_instantiate):
* glyphs-x.c (safe_XLoadFont):
* glyphs-x.c (cursor_font_instantiate):
* glyphs-x.c (x_redisplay_widget):
* glyphs-x.c (Fchange_subwindow_property):
* glyphs-x.c (x_widget_instantiate):
* glyphs-x.c (x_tab_control_redisplay):
* glyphs.c (pixmap_to_lisp_data):
* gui-x.c (menu_separator_style_and_to_external):
* gui-x.c (add_accel_and_to_external):
* gui-x.c (button_item_to_widget_value):
* hpplay.c (player_error_internal):
* hpplay.c (play_sound_file):
* hpplay.c (play_sound_data):
* intl.c (Fset_current_locale):
* lisp.h:
* menubar-gtk.c (gtk_xemacs_set_accel_keys):
* menubar-msw.c (populate_menu_add_item):
* menubar-msw.c (populate_or_checksum_helper):
* menubar-x.c (menu_item_descriptor_to_widget_value_1):
* nt.c (init_user_info):
* nt.c (get_long_basename):
* nt.c (nt_get_resource):
* nt.c (init_mswindows_environment):
* nt.c (get_cached_volume_information):
* nt.c (mswindows_readdir):
* nt.c (read_unc_volume):
* nt.c (mswindows_stat):
* nt.c (mswindows_getdcwd):
* nt.c (mswindows_executable_type):
* nt.c (Fmswindows_short_file_name):
* ntplay.c (nt_play_sound_file):
* objects-gtk.c:
* objects-gtk.c (gtk_valid_color_name_p):
* objects-gtk.c (gtk_initialize_font_instance):
* objects-gtk.c (gtk_font_list):
* objects-msw.c (font_enum_callback_2):
* objects-msw.c (parse_font_spec):
* objects-x.c (x_parse_nearest_color):
* objects-x.c (x_valid_color_name_p):
* objects-x.c (x_initialize_font_instance):
* objects-x.c (x_font_instance_truename):
* objects-x.c (x_font_list):
* objects-xlike-inc.c (XFUN):
* objects-xlike-inc.c (xft_find_charset_font):
* process-nt.c (mswindows_report_winsock_error):
* process-nt.c (nt_create_process):
* process-nt.c (get_internet_address):
* process-nt.c (nt_open_network_stream):
* process-unix.c:
* process-unix.c (allocate_pty):
* process-unix.c (get_internet_address):
* process-unix.c (unix_canonicalize_host_name):
* process-unix.c (unix_open_network_stream):
* realpath.c:
* select-common.h (lisp_data_to_selection_data):
* select-gtk.c (symbol_to_gtk_atom):
* select-gtk.c (atom_to_symbol):
* select-msw.c (symbol_to_ms_cf):
* select-msw.c (mswindows_register_selection_data_type):
* select-x.c (symbol_to_x_atom):
* select-x.c (x_atom_to_symbol):
* select-x.c (hack_motif_clipboard_selection):
* select-x.c (Fx_store_cutbuffer_internal):
* sound.c (Fplay_sound_file):
* sound.c (Fplay_sound):
* sound.h (sound_perror):
* sysdep.c:
* sysdep.c (qxe_allocating_getcwd):
* sysdep.c (qxe_execve):
* sysdep.c (copy_in_passwd):
* sysdep.c (qxe_getpwnam):
* sysdep.c (qxe_ctime):
* sysdll.c (dll_open):
* sysdll.c (dll_function):
* sysdll.c (dll_variable):
* sysdll.c (search_linked_libs):
* sysdll.c (dll_error):
* sysfile.h:
* sysfile.h (PATHNAME_CONVERT_OUT_TSTR):
* sysfile.h (PATHNAME_CONVERT_OUT_UTF_8):
* sysfile.h (PATHNAME_CONVERT_OUT):
* sysfile.h (LISP_PATHNAME_CONVERT_OUT):
* syswindows.h (ITEXT_TO_TSTR):
* syswindows.h (LOCAL_FILE_FORMAT_TO_TSTR):
* syswindows.h (TSTR_TO_LOCAL_FILE_FORMAT):
* syswindows.h (LOCAL_FILE_FORMAT_TO_INTERNAL_MSWIN):
* syswindows.h (LISP_LOCAL_FILE_FORMAT_MAYBE_URL_TO_TSTR):
* text.h:
* text.h (eicpy_ext_len):
* text.h (enum new_dfc_src_type):
* text.h (EXTERNAL_TO_ITEXT):
* text.h (GET_STRERROR):
* tooltalk.c (check_status):
* tooltalk.c (Fadd_tooltalk_message_arg):
* tooltalk.c (Fadd_tooltalk_pattern_attribute):
* tooltalk.c (Fadd_tooltalk_pattern_arg):
* win32.c (tstr_to_local_file_format):
* win32.c (mswindows_lisp_error_1):
* win32.c (mswindows_report_process_error):
* win32.c (Fmswindows_shell_execute):
* win32.c (mswindows_read_link_1):
Changes involving external/internal format conversion,
mostly code cleanup and renaming.
1. Eliminate the previous macros like LISP_STRING_TO_EXTERNAL
that stored its result in a parameter. The new version of
LISP_STRING_TO_EXTERNAL returns its result through the
return value, same as the previous NEW_LISP_STRING_TO_EXTERNAL.
Use the new-style macros throughout the code.
2. Rename C_STRING_TO_EXTERNAL and friends to ITEXT_TO_EXTERNAL,
in keeping with overall naming rationalization involving
Itext and related types.
Macros involved in previous two:
EXTERNAL_TO_C_STRING -> EXTERNAL_TO_ITEXT
EXTERNAL_TO_C_STRING_MALLOC -> EXTERNAL_TO_ITEXT_MALLOC
SIZED_EXTERNAL_TO_C_STRING -> SIZED_EXTERNAL_TO_ITEXT
SIZED_EXTERNAL_TO_C_STRING_MALLOC -> SIZED_EXTERNAL_TO_ITEXT_MALLOC
C_STRING_TO_EXTERNAL -> ITEXT_TO_EXTERNAL
C_STRING_TO_EXTERNAL_MALLOC -> ITEXT_TO_EXTERNAL_MALLOC
LISP_STRING_TO_EXTERNAL
LISP_STRING_TO_EXTERNAL_MALLOC
LISP_STRING_TO_TSTR
C_STRING_TO_TSTR -> ITEXT_TO_TSTR
TSTR_TO_C_STRING -> TSTR_TO_ITEXT
The following four still return their values through parameters,
since they have more than one value to return:
C_STRING_TO_SIZED_EXTERNAL -> ITEXT_TO_SIZED_EXTERNAL
LISP_STRING_TO_SIZED_EXTERNAL
C_STRING_TO_SIZED_EXTERNAL_MALLOC -> ITEXT_TO_SIZED_EXTERNAL_MALLOC
LISP_STRING_TO_SIZED_EXTERNAL_MALLOC
Sometimes additional casts had to be inserted, since the old
macros played strange games and completely defeated the type system
of the store params.
3. Rewrite many places where direct calls to TO_EXTERNAL_FORMAT
occurred with calls to one of the convenience macros listed above,
or to make_extstring().
4. Eliminate SIZED_C_STRING macros (they were hardly used, anyway)
and use a direct call to TO_EXTERNAL_FORMAT or TO_INTERNAL_FORMAT.
4. Use LISP_PATHNAME_CONVERT_OUT in many places instead of something
like LISP_STRING_TO_EXTERNAL(..., Qfile_name).
5. Eliminate some temporary variables that are no longer necessary
now that we return a value rather than storing it into a variable.
6. Some Mule-izing in database.c.
7. Error functions:
-- A bit of code cleanup in maybe_signal_error_1.
-- Eliminate report_file_type_error; it's just an alias for
signal_error_2 with params in a different order.
-- Fix some places in the hostname-handling code that directly
inserted externally-retrieved error strings into the
supposed ASCII "reason" param instead of doing the right thing
and sticking text descriptive of what was going on in "reason"
and putting the external message in a frob.
8. Use Ascbyte instead of CIbyte in process-unix.c and maybe one
or two other places.
9. Some code cleanup in copy_in_passwd() in sysdep.c.
10. Fix a real bug due to accidental variable shadowing in
tstr_to_local_file_format() in win32.c.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Fri, 05 Feb 2010 11:02:24 -0600 |
| parents | 19a72041c5ed |
| children | ae48681c47fa |
| 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)) |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4677
diff
changeset
|
141 return concat3 (left, build_ascstring ("\t"), right); |
| 771 | 142 else |
| 143 return left; | |
| 428 | 144 } |
| 145 | |
| 146 /* | |
| 147 * hmenu_to_lisp_object() returns an opaque ptr given menu handle. | |
| 148 */ | |
| 149 static Lisp_Object | |
| 150 hmenu_to_lisp_object (HMENU hmenu) | |
| 151 { | |
| 152 return make_opaque_ptr (hmenu); | |
| 153 } | |
| 154 | |
| 155 /* | |
| 156 * Allocation tries a hash based on item's path and name first. This | |
| 157 * almost guarantees that the same item will override its old value in | |
| 158 * the hash table rather than abandon it. | |
| 159 */ | |
| 160 static Lisp_Object | |
| 161 allocate_menu_item_id (Lisp_Object path, Lisp_Object name, Lisp_Object suffix) | |
| 162 { | |
| 163 UINT id = MENU_ITEM_ID_BITS (HASH3 (internal_hash (path, 0), | |
| 164 internal_hash (name, 0), | |
| 165 internal_hash (suffix, 0))); | |
| 166 do { | |
| 167 id = MENU_ITEM_ID_BITS (id + 1); | |
| 168 } while (GetMenuState (top_level_menu, id, MF_BYCOMMAND) != 0xFFFFFFFF); | |
| 169 return make_int (id); | |
| 170 } | |
| 171 | |
| 172 static HMENU | |
| 173 create_empty_popup_menu (void) | |
| 174 { | |
| 175 return CreatePopupMenu (); | |
| 176 } | |
| 177 | |
| 178 static void | |
| 179 empty_menu (HMENU menu, int add_empty_p) | |
| 180 { | |
| 181 while (DeleteMenu (menu, 0, MF_BYPOSITION)); | |
| 182 if (add_empty_p) | |
| 771 | 183 qxeAppendMenu (menu, MF_STRING | MF_GRAYED, EMPTY_ITEM_ID, |
| 184 XETEXT (EMPTY_ITEM_NAME)); | |
| 428 | 185 } |
| 186 | |
| 187 /* | |
| 188 * The idea of checksumming is that we must hash minimal object | |
| 189 * which is necessarily changes when the item changes. For separator | |
| 190 * this is a constant, for grey strings and submenus these are hashes | |
| 191 * of names, since submenus are unpopulated until opened so always | |
| 192 * equal otherwise. For items, this is a full hash value of a callback, | |
| 193 * because a callback may me a form which can be changed only somewhere | |
| 194 * in depth. | |
| 195 */ | |
| 196 static unsigned long | |
| 197 checksum_menu_item (Lisp_Object item) | |
| 198 { | |
| 199 if (STRINGP (item)) | |
| 200 { | |
| 201 /* Separator or unselectable text - hash as a string + 13 */ | |
| 202 if (separator_string_p (XSTRING_DATA (item))) | |
| 203 return 13; | |
| 204 else | |
| 205 return internal_hash (item, 0) + 13; | |
| 206 } | |
| 207 else if (CONSP (item)) | |
| 208 { | |
| 209 /* Submenu - hash by its string name + 0 */ | |
| 771 | 210 return internal_hash (XCAR (item), 0); |
| 428 | 211 } |
| 212 else if (VECTORP (item)) | |
| 213 { | |
| 214 /* An ordinary item - hash its name and callback form. */ | |
| 215 return HASH2 (internal_hash (XVECTOR_DATA(item)[0], 0), | |
| 216 internal_hash (XVECTOR_DATA(item)[1], 0)); | |
| 217 } | |
| 442 | 218 |
| 428 | 219 /* An error - will be caught later */ |
| 220 return 0; | |
| 221 } | |
| 222 | |
| 223 static void | |
| 224 populate_menu_add_item (HMENU menu, Lisp_Object path, | |
| 225 Lisp_Object hash_tab, Lisp_Object item, | |
| 442 | 226 Lisp_Object *accel_list, |
| 428 | 227 int flush_right, int bar_p) |
| 228 { | |
| 771 | 229 MENUITEMINFOW item_info; |
| 428 | 230 |
| 231 item_info.cbSize = sizeof (item_info); | |
| 232 item_info.fMask = MIIM_TYPE | MIIM_STATE | MIIM_ID; | |
| 233 item_info.fState = 0; | |
| 234 item_info.wID = 0; | |
| 235 item_info.fType = 0; | |
| 236 | |
| 237 if (STRINGP (item)) | |
| 238 { | |
| 239 /* Separator or unselectable text */ | |
| 240 if (separator_string_p (XSTRING_DATA (item))) | |
| 771 | 241 item_info.fType = MFT_SEPARATOR; |
| 428 | 242 else |
| 243 { | |
| 244 item_info.fType = MFT_STRING; | |
| 245 item_info.fState = MFS_DISABLED; | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
246 item_info.dwTypeData = (XELPTSTR) LISP_STRING_TO_TSTR (item); |
| 428 | 247 } |
| 248 } | |
| 249 else if (CONSP (item)) | |
| 250 { | |
| 251 /* Submenu */ | |
| 252 HMENU submenu; | |
| 253 Lisp_Object gui_item = allocate_gui_item (); | |
| 442 | 254 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); |
| 255 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 867 | 256 Ichar accel; |
| 428 | 257 |
| 442 | 258 GCPRO3 (gui_item, path, *accel_list); |
| 428 | 259 |
| 260 menu_parse_submenu_keywords (item, gui_item); | |
| 261 | |
| 262 if (!STRINGP (pgui_item->name)) | |
| 563 | 263 invalid_argument ("Menu name (first element) must be a string", |
| 442 | 264 item); |
| 428 | 265 |
| 266 if (!gui_item_included_p (gui_item, Vmenubar_configuration)) | |
| 442 | 267 { |
| 268 UNGCPRO; | |
| 269 goto done; | |
| 270 } | |
| 428 | 271 |
| 1913 | 272 if (!gui_item_active_p (gui_item)) |
| 771 | 273 item_info.fState = MFS_GRAYED; |
| 428 | 274 /* Temptation is to put 'else' right here. Although, the |
| 275 displayed item won't have an arrow indicating that it is a | |
| 276 popup. So we go ahead a little bit more and create a popup */ | |
| 442 | 277 submenu = create_empty_popup_menu (); |
| 428 | 278 |
| 279 item_info.fMask |= MIIM_SUBMENU; | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
280 item_info.dwTypeData = (XELPTSTR) |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
281 LISP_STRING_TO_TSTR (displayable_menu_item (gui_item, bar_p, &accel)); |
| 428 | 282 item_info.hSubMenu = submenu; |
| 442 | 283 |
| 284 if (accel && bar_p) | |
| 285 *accel_list = Fcons (make_char (accel), *accel_list); | |
| 428 | 286 |
| 287 if (!(item_info.fState & MFS_GRAYED)) | |
| 288 { | |
| 289 /* Now add the full submenu path as a value to the hash table, | |
| 290 keyed by menu handle */ | |
| 291 if (NILP(path)) | |
| 292 path = list1 (pgui_item->name); | |
| 293 else | |
| 294 { | |
| 295 Lisp_Object arg[2]; | |
| 296 arg[0] = path; | |
| 297 arg[1] = list1 (pgui_item->name); | |
| 298 path = Fappend (2, arg); | |
| 299 } | |
| 300 | |
| 301 Fputhash (hmenu_to_lisp_object (submenu), path, hash_tab); | |
| 302 } | |
| 442 | 303 UNGCPRO; |
| 304 } | |
| 428 | 305 else if (VECTORP (item)) |
| 306 { | |
| 307 /* An ordinary item */ | |
| 308 Lisp_Object style, id; | |
| 309 Lisp_Object gui_item = gui_parse_item_keywords (item); | |
| 442 | 310 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); |
| 311 struct gcpro gcpro1, gcpro2; | |
| 867 | 312 Ichar accel; |
| 428 | 313 |
| 442 | 314 GCPRO2 (gui_item, *accel_list); |
| 428 | 315 |
| 316 if (!gui_item_included_p (gui_item, Vmenubar_configuration)) | |
| 442 | 317 { |
| 318 UNGCPRO; | |
| 319 goto done; | |
| 320 } | |
| 321 | |
| 322 if (!STRINGP (pgui_item->name)) | |
|
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2500
diff
changeset
|
323 pgui_item->name = IGNORE_MULTIPLE_VALUES (Feval (pgui_item->name)); |
| 428 | 324 |
| 1913 | 325 if (!gui_item_active_p (gui_item)) |
| 771 | 326 item_info.fState = MFS_GRAYED; |
| 428 | 327 |
| 328 style = (NILP (pgui_item->selected) || NILP (Feval (pgui_item->selected)) | |
| 329 ? Qnil : pgui_item->style); | |
| 330 | |
| 331 if (EQ (style, Qradio)) | |
| 332 { | |
| 333 item_info.fType |= MFT_RADIOCHECK; | |
| 334 item_info.fState |= MFS_CHECKED; | |
| 335 } | |
| 336 else if (EQ (style, Qtoggle)) | |
| 771 | 337 item_info.fState |= MFS_CHECKED; |
| 428 | 338 |
| 339 id = allocate_menu_item_id (path, pgui_item->name, | |
| 340 pgui_item->suffix); | |
| 341 Fputhash (id, pgui_item->callback, hash_tab); | |
| 342 | |
| 442 | 343 item_info.wID = (UINT) XINT (id); |
| 428 | 344 item_info.fType |= MFT_STRING; |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
345 item_info.dwTypeData = (XELPTSTR) |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
346 LISP_STRING_TO_TSTR (displayable_menu_item (gui_item, bar_p, &accel)); |
| 428 | 347 |
| 442 | 348 if (accel && bar_p) |
| 349 *accel_list = Fcons (make_char (accel), *accel_list); | |
| 350 | |
| 351 UNGCPRO; | |
| 428 | 352 } |
| 353 else | |
| 563 | 354 sferror ("Malformed menu item descriptor", item); |
| 428 | 355 |
| 356 if (flush_right) | |
| 771 | 357 item_info.fType |= MFT_RIGHTJUSTIFY; |
| 428 | 358 |
| 771 | 359 qxeInsertMenuItem (menu, UINT_MAX, TRUE, &item_info); |
| 442 | 360 |
| 361 done:; | |
| 362 } | |
| 428 | 363 |
| 364 /* | |
| 365 * This function is called from populate_menu and checksum_menu. | |
| 366 * When called to populate, MENU is a menu handle, PATH is a | |
| 367 * list of strings representing menu path from root to this submenu, | |
| 368 * DESCRIPTOR is a menu descriptor, HASH_TAB is a hash table associated | |
| 369 * with root menu, BAR_P indicates whether this called for a menubar or | |
| 370 * a popup, and POPULATE_P is non-zero. Return value must be ignored. | |
| 371 * When called to checksum, DESCRIPTOR has the same meaning, POPULATE_P | |
| 372 * is zero, PATH must be Qnil, and the rest of parameters is ignored. | |
| 373 * Return value is the menu checksum. | |
| 374 */ | |
| 375 static unsigned long | |
| 376 populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc, | |
| 377 Lisp_Object hash_tab, int bar_p, int populate_p) | |
| 378 { | |
| 379 int deep_p, flush_right; | |
| 442 | 380 struct gcpro gcpro1, gcpro2, gcpro3; |
| 428 | 381 unsigned long checksum; |
| 382 Lisp_Object gui_item = allocate_gui_item (); | |
| 442 | 383 Lisp_Object accel_list = Qnil; |
| 384 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); | |
| 385 | |
| 386 GCPRO3 (gui_item, accel_list, desc); | |
| 428 | 387 |
| 388 /* We are sometimes called with the menubar unchanged, and with changed | |
| 389 right flush. We have to update the menubar in this case, | |
| 390 so account for the compliance setting in the hash value */ | |
| 442 | 391 checksum = REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH; |
| 428 | 392 |
| 393 /* Will initially contain only "(empty)" */ | |
| 394 if (populate_p) | |
| 395 empty_menu (menu, 1); | |
| 396 | |
| 397 /* PATH set to nil indicates top-level popup or menubar */ | |
| 398 deep_p = !NILP (path); | |
| 399 | |
| 400 /* Fetch keywords prepending the item list */ | |
| 401 desc = menu_parse_submenu_keywords (desc, gui_item); | |
| 402 | |
| 403 /* Check that menu name is specified when expected */ | |
| 404 if (NILP (pgui_item->name) && deep_p) | |
| 563 | 405 sferror ("Menu must have a name", desc); |
| 428 | 406 |
| 407 /* Apply filter if specified */ | |
| 408 if (!NILP (pgui_item->filter)) | |
| 409 desc = call1 (pgui_item->filter, desc); | |
| 410 | |
| 411 /* Loop thru the desc's CDR and add items for each entry */ | |
| 412 flush_right = 0; | |
| 2367 | 413 { |
| 414 EXTERNAL_LIST_LOOP_2 (elt, desc) | |
| 415 { | |
| 416 if (NILP (elt)) | |
| 417 { | |
| 418 /* Do not flush right menubar items when MS style compliant */ | |
| 419 if (bar_p && !REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH) | |
| 420 flush_right = 1; | |
| 421 if (!populate_p) | |
| 422 checksum = HASH2 (checksum, LISP_HASH (Qnil)); | |
| 423 } | |
| 424 else if (populate_p) | |
| 425 populate_menu_add_item (menu, path, hash_tab, | |
| 426 elt, &accel_list, | |
| 427 flush_right, bar_p); | |
| 428 else | |
| 429 checksum = HASH2 (checksum, | |
| 430 checksum_menu_item (elt)); | |
| 431 } | |
| 432 } | |
| 442 | 433 |
| 428 | 434 if (populate_p) |
| 435 { | |
| 436 /* Remove the "(empty)" item, if there are other ones */ | |
| 437 if (GetMenuItemCount (menu) > 1) | |
| 438 RemoveMenu (menu, EMPTY_ITEM_ID, MF_BYCOMMAND); | |
| 439 | |
| 440 /* Add the header to the popup, if told so. The same as in X - an | |
| 441 insensitive item, and a separator (Seems to me, there were | |
| 442 | 442 two separators in X... In Windows this looks ugly, anyways.) */ |
| 443 if (!bar_p && !deep_p && popup_menu_titles && !NILP (pgui_item->name)) | |
| 428 | 444 { |
| 771 | 445 qxeInsertMenu (menu, 0, MF_BYPOSITION | MF_STRING | MF_DISABLED, |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
446 0, LISP_STRING_TO_TSTR (displayable_menu_item |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
447 (gui_item, bar_p, NULL))); |
| 771 | 448 qxeInsertMenu (menu, 1, MF_BYPOSITION | MF_SEPARATOR, 0, NULL); |
| 449 SetMenuDefaultItem (menu, 0, MF_BYPOSITION); | |
| 428 | 450 } |
| 451 } | |
| 442 | 452 |
| 453 if (bar_p) | |
| 454 Fputhash (Qt, accel_list, hash_tab); | |
| 455 | |
| 456 UNGCPRO; | |
| 428 | 457 return checksum; |
| 458 } | |
| 459 | |
| 460 static void | |
| 461 populate_menu (HMENU menu, Lisp_Object path, Lisp_Object desc, | |
| 442 | 462 Lisp_Object hash_tab, int bar_p) |
| 428 | 463 { |
| 464 populate_or_checksum_helper (menu, path, desc, hash_tab, bar_p, 1); | |
| 465 } | |
| 466 | |
| 467 static unsigned long | |
| 468 checksum_menu (Lisp_Object desc) | |
| 469 { | |
| 470 return populate_or_checksum_helper (NULL, Qnil, desc, Qunbound, 0, 0); | |
| 471 } | |
| 472 | |
| 473 static void | |
| 442 | 474 update_frame_menubar_maybe (struct frame *f) |
| 428 | 475 { |
| 476 HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f)); | |
| 477 struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); | |
| 478 Lisp_Object desc = (!NILP (w->menubar_visible_p) | |
| 479 ? symbol_value_in_buffer (Qcurrent_menubar, w->buffer) | |
| 480 : Qnil); | |
| 442 | 481 struct gcpro gcpro1; |
| 482 | |
| 483 GCPRO1 (desc); /* it's safest to do this, just in case some filter | |
| 484 or something changes the value of current-menubar */ | |
| 428 | 485 |
| 486 top_level_menu = menubar; | |
| 487 | |
| 488 if (NILP (desc) && menubar != NULL) | |
| 489 { | |
| 490 /* Menubar has gone */ | |
| 442 | 491 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = Qnil; |
| 428 | 492 SetMenu (FRAME_MSWINDOWS_HANDLE (f), NULL); |
| 493 DestroyMenu (menubar); | |
| 494 DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f)); | |
| 442 | 495 UNGCPRO; |
| 428 | 496 return; |
| 497 } | |
| 498 | |
| 499 if (!NILP (desc) && menubar == NULL) | |
| 500 { | |
| 501 /* Menubar has appeared */ | |
| 502 menubar = CreateMenu (); | |
| 503 goto populate; | |
| 504 } | |
| 505 | |
| 506 if (NILP (desc)) | |
| 507 { | |
| 508 /* We did not have the bar and are not going to */ | |
| 442 | 509 UNGCPRO; |
| 428 | 510 return; |
| 511 } | |
| 512 | |
| 513 /* Now we bail out if the menubar has not changed */ | |
| 442 | 514 if (FRAME_MSWINDOWS_MENU_CHECKSUM (f) == checksum_menu (desc)) |
| 515 { | |
| 516 UNGCPRO; | |
| 517 return; | |
| 518 } | |
| 428 | 519 |
| 520 populate: | |
| 521 /* Come with empty hash table */ | |
| 442 | 522 if (NILP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f))) |
| 523 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = | |
| 428 | 524 make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); |
| 525 else | |
| 442 | 526 Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); |
| 428 | 527 |
| 528 Fputhash (hmenu_to_lisp_object (menubar), Qnil, | |
| 442 | 529 FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); |
| 428 | 530 populate_menu (menubar, Qnil, desc, |
| 442 | 531 FRAME_MSWINDOWS_MENU_HASH_TABLE (f), 1); |
| 428 | 532 SetMenu (FRAME_MSWINDOWS_HANDLE (f), menubar); |
| 533 DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f)); | |
| 534 | |
| 442 | 535 FRAME_MSWINDOWS_MENU_CHECKSUM (f) = checksum_menu (desc); |
| 536 | |
| 537 UNGCPRO; | |
| 428 | 538 } |
| 539 | |
| 540 static void | |
| 541 prune_menubar (struct frame *f) | |
| 542 { | |
| 543 HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f)); | |
| 544 Lisp_Object desc = current_frame_menubar (f); | |
| 442 | 545 struct gcpro gcpro1; |
| 546 | |
| 428 | 547 if (menubar == NULL) |
| 548 return; | |
| 549 | |
| 2500 | 550 /* #### If a filter function has set desc to Qnil, this ABORT() |
| 428 | 551 triggers. To resolve, we must prevent filters explicitly from |
| 552 mangling with the active menu. In apply_filter probably? | |
| 553 Is copy-tree on the whole menu too expensive? */ | |
| 442 | 554 if (NILP (desc)) |
| 2500 | 555 /* ABORT(); */ |
| 428 | 556 return; |
| 557 | |
| 442 | 558 GCPRO1 (desc); /* just to be safe -- see above */ |
| 428 | 559 /* We do the trick by removing all items and re-populating top level */ |
| 560 empty_menu (menubar, 0); | |
| 561 | |
| 442 | 562 assert (HASH_TABLEP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f))); |
| 563 Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); | |
| 428 | 564 |
| 565 Fputhash (hmenu_to_lisp_object (menubar), Qnil, | |
| 442 | 566 FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); |
| 567 populate_menu (menubar, Qnil, desc, | |
| 568 FRAME_MSWINDOWS_MENU_HASH_TABLE (f), 1); | |
| 569 UNGCPRO; | |
| 428 | 570 } |
| 571 | |
| 572 /* | |
| 573 * This is called when cleanup is possible. It is better not to | |
| 574 * clean things up at all than do it too early! | |
| 575 */ | |
| 576 static void | |
| 577 menu_cleanup (struct frame *f) | |
| 578 { | |
| 579 /* This function can GC */ | |
| 580 current_menudesc = Qnil; | |
| 581 current_hash_table = Qnil; | |
| 582 prune_menubar (f); | |
| 583 } | |
| 442 | 584 |
| 585 int | |
| 867 | 586 mswindows_char_is_accelerator (struct frame *f, Ichar ch) |
| 442 | 587 { |
| 588 Lisp_Object hash = FRAME_MSWINDOWS_MENU_HASH_TABLE (f); | |
| 589 | |
| 590 if (NILP (hash)) | |
| 591 return 0; | |
| 771 | 592 return !NILP (memq_no_quit |
| 593 (make_char | |
| 594 (DOWNCASE (WINDOW_XBUFFER (FRAME_SELECTED_XWINDOW (f)), ch)), | |
| 595 Fgethash (Qt, hash, Qnil))); | |
| 442 | 596 } |
| 597 | |
| 428 | 598 |
| 599 /*------------------------------------------------------------------------*/ | |
| 600 /* Message handlers */ | |
| 601 /*------------------------------------------------------------------------*/ | |
| 602 static Lisp_Object | |
| 2286 | 603 unsafe_handle_wm_initmenupopup_1 (HMENU menu, struct frame *UNUSED (f)) |
| 428 | 604 { |
| 605 /* This function can call lisp, beat dogs and stick chewing gum to | |
| 606 everything! */ | |
| 607 | |
| 608 Lisp_Object path, desc; | |
| 609 struct gcpro gcpro1; | |
| 707 | 610 |
| 428 | 611 /* Find which guy is going to explode */ |
| 612 path = Fgethash (hmenu_to_lisp_object (menu), current_hash_table, Qunbound); | |
| 613 assert (!UNBOUNDP (path)); | |
| 614 #ifdef DEBUG_XEMACS | |
| 615 /* Allow to continue in a debugger after assert - not so fatal */ | |
| 616 if (UNBOUNDP (path)) | |
| 563 | 617 signal_error (Qinternal_error, "internal menu error", Qunbound); |
| 428 | 618 #endif |
| 619 | |
| 620 /* Now find a desc chunk for it. If none, then probably menu open | |
| 621 hook has played too much games around stuff */ | |
| 622 desc = Fmenu_find_real_submenu (current_menudesc, path); | |
| 623 if (NILP (desc)) | |
| 563 | 624 invalid_state ("This menu does not exist any more", path); |
| 428 | 625 |
| 626 /* Now, stuff it */ | |
| 627 /* DESC may be generated by filter, so we have to gcpro it */ | |
| 628 GCPRO1 (desc); | |
| 629 populate_menu (menu, path, desc, current_hash_table, 0); | |
| 630 UNGCPRO; | |
| 631 return Qt; | |
| 632 } | |
| 633 | |
| 634 static Lisp_Object | |
| 442 | 635 unsafe_handle_wm_initmenu_1 (struct frame *f) |
| 428 | 636 { |
| 637 /* This function can call lisp */ | |
| 638 | |
| 639 /* NOTE: This is called for the bar only, WM_INITMENU | |
| 640 for popups is filtered out */ | |
| 641 | |
| 642 /* #### - this menubar update mechanism is expensively anti-social and | |
| 643 the activate-menubar-hook is now mostly obsolete. */ | |
| 644 | |
| 645 /* We simply ignore return value. In any case, we construct the bar | |
| 646 on the fly */ | |
| 853 | 647 run_hook_trapping_problems |
| 1333 | 648 (Qmenubar, Qactivate_menubar_hook, |
| 853 | 649 INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION); |
| 428 | 650 |
| 651 update_frame_menubar_maybe (f); | |
| 652 | |
| 653 current_menudesc = current_frame_menubar (f); | |
| 442 | 654 current_hash_table = FRAME_MSWINDOWS_MENU_HASH_TABLE (f); |
| 428 | 655 assert (HASH_TABLEP (current_hash_table)); |
| 656 | |
| 657 return Qt; | |
| 658 } | |
| 659 | |
| 660 /* | |
| 661 * Return value is Qt if we have dispatched the command, | |
| 662 * or Qnil if id has not been mapped to a callback. | |
| 663 * Window procedure may try other targets to route the | |
| 664 * command if we return nil | |
| 665 */ | |
| 666 Lisp_Object | |
| 442 | 667 mswindows_handle_wm_command (struct frame *f, WORD id) |
| 428 | 668 { |
| 669 /* Try to map the command id through the proper hash table */ | |
| 670 Lisp_Object data, fn, arg, frame; | |
| 671 struct gcpro gcpro1; | |
| 672 | |
| 673 if (NILP (current_hash_table)) | |
| 674 return Qnil; | |
| 675 | |
| 676 data = Fgethash (make_int (id), current_hash_table, Qunbound); | |
| 677 | |
| 678 if (UNBOUNDP (data)) | |
| 679 { | |
| 680 menu_cleanup (f); | |
| 681 return Qnil; | |
| 682 } | |
| 683 | |
| 684 /* Need to gcpro because the hash table may get destroyed by | |
| 685 menu_cleanup(), and will not gcpro the data any more */ | |
| 686 GCPRO1 (data); | |
| 687 menu_cleanup (f); | |
| 688 | |
| 689 /* Ok, this is our one. Enqueue it. */ | |
| 690 get_gui_callback (data, &fn, &arg); | |
| 793 | 691 frame = wrap_frame (f); |
| 428 | 692 /* this used to call mswindows_enqueue_misc_user_event but that |
| 693 breaks customize because the misc_event gets eval'ed in some | |
| 442 | 694 circumstances. Don't change it back unless you can fix the |
| 771 | 695 customize problem also. */ |
| 707 | 696 mswindows_enqueue_misc_user_event (frame, fn, arg); |
| 428 | 697 |
| 698 UNGCPRO; /* data */ | |
| 699 return Qt; | |
| 700 } | |
| 701 | |
| 702 | |
| 703 /*------------------------------------------------------------------------*/ | |
| 704 /* Message handling proxies */ | |
| 705 /*------------------------------------------------------------------------*/ | |
| 706 | |
| 1268 | 707 struct handle_wm_initmenu |
| 708 { | |
| 709 HMENU menu; | |
| 710 struct frame *frame; | |
| 711 }; | |
| 428 | 712 |
| 713 static Lisp_Object | |
| 1268 | 714 unsafe_handle_wm_initmenupopup (void *arg) |
| 428 | 715 { |
| 1268 | 716 struct handle_wm_initmenu *z = (struct handle_wm_initmenu *) arg; |
| 717 return unsafe_handle_wm_initmenupopup_1 (z->menu, z->frame); | |
| 428 | 718 } |
| 719 | |
| 720 static Lisp_Object | |
| 1268 | 721 unsafe_handle_wm_initmenu (void *arg) |
| 428 | 722 { |
| 1268 | 723 struct handle_wm_initmenu *z = (struct handle_wm_initmenu *) arg; |
| 724 return unsafe_handle_wm_initmenu_1 (z->frame); | |
| 428 | 725 } |
| 726 | |
| 727 Lisp_Object | |
| 442 | 728 mswindows_handle_wm_initmenupopup (HMENU hmenu, struct frame *frm) |
| 428 | 729 { |
| 1268 | 730 struct handle_wm_initmenu z; |
| 1279 | 731 int depth = internal_bind_int (&in_menu_callback, 1); |
| 732 Lisp_Object retval; | |
| 1268 | 733 |
| 734 z.menu = hmenu; | |
| 735 z.frame = frm; | |
| 736 | |
| 737 /* [[ Allow runaway filter code, e.g. custom, to be aborted. We are | |
| 853 | 738 usually called from next_event_internal(), which has turned off |
| 1268 | 739 quit checking to read the C-g as an event.]] |
| 740 | |
| 741 #### This is bogus because by the very act of calling | |
| 742 event_stream_protect_modal_loop(), we disable event retrieval! */ | |
| 1279 | 743 retval = event_stream_protect_modal_loop ("Error during menu handling", |
| 744 unsafe_handle_wm_initmenupopup, &z, | |
| 745 UNINHIBIT_QUIT); | |
| 746 unbind_to (depth); | |
| 747 | |
| 748 return retval; | |
| 428 | 749 } |
| 750 | |
| 751 Lisp_Object | |
| 442 | 752 mswindows_handle_wm_initmenu (HMENU hmenu, struct frame *f) |
| 428 | 753 { |
| 754 /* Handle only frame menubar, ignore if from popup or system menu */ | |
| 442 | 755 if (GetMenu (FRAME_MSWINDOWS_HANDLE (f)) == hmenu) |
| 428 | 756 { |
| 1268 | 757 struct handle_wm_initmenu z; |
| 758 | |
| 759 z.frame = f; | |
| 760 return event_stream_protect_modal_loop ("Error during menu handling", | |
| 761 unsafe_handle_wm_initmenu, &z, | |
| 762 UNINHIBIT_QUIT); | |
| 428 | 763 } |
| 764 return Qt; | |
| 765 } | |
| 766 | |
| 767 | |
| 768 /*------------------------------------------------------------------------*/ | |
| 769 /* Methods */ | |
| 770 /*------------------------------------------------------------------------*/ | |
| 771 | |
| 772 static void | |
| 442 | 773 mswindows_update_frame_menubars (struct frame *f) |
| 428 | 774 { |
| 775 update_frame_menubar_maybe (f); | |
| 776 } | |
| 777 | |
| 778 static void | |
| 442 | 779 mswindows_free_frame_menubars (struct frame *f) |
| 428 | 780 { |
| 442 | 781 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = Qnil; |
| 428 | 782 } |
| 783 | |
| 784 static void | |
| 785 mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event) | |
| 786 { | |
| 787 struct frame *f = selected_frame (); | |
| 440 | 788 Lisp_Event *eev = NULL; |
| 428 | 789 HMENU menu; |
| 790 POINT pt; | |
| 791 int ok; | |
| 442 | 792 struct gcpro gcpro1; |
| 793 | |
| 794 GCPRO1 (menu_desc); /* to be safe -- see above */ | |
| 428 | 795 |
| 796 if (!NILP (event)) | |
| 797 { | |
| 798 CHECK_LIVE_EVENT (event); | |
| 799 eev = XEVENT (event); | |
| 800 if (eev->event_type != button_press_event | |
| 801 && eev->event_type != button_release_event) | |
| 802 wrong_type_argument (Qmouse_event_p, event); | |
| 803 } | |
| 804 else if (!NILP (Vthis_command_keys)) | |
| 805 { | |
| 806 /* if an event wasn't passed, use the last event of the event sequence | |
| 807 currently being executed, if that event is a mouse event */ | |
| 808 eev = XEVENT (Vthis_command_keys); /* last event first */ | |
| 809 if (eev->event_type != button_press_event | |
| 810 && eev->event_type != button_release_event) | |
| 811 eev = NULL; | |
| 812 } | |
| 813 | |
| 707 | 814 popup_up_p++; |
| 815 | |
| 428 | 816 /* Default is to put the menu at the point (10, 10) in frame */ |
| 817 if (eev) | |
| 818 { | |
| 1204 | 819 pt.x = EVENT_BUTTON_X (eev); |
| 820 pt.y = EVENT_BUTTON_Y (eev); | |
| 428 | 821 ClientToScreen (FRAME_MSWINDOWS_HANDLE (f), &pt); |
| 822 } | |
| 823 else | |
| 824 pt.x = pt.y = 10; | |
| 825 | |
| 826 if (SYMBOLP (menu_desc)) | |
| 827 menu_desc = Fsymbol_value (menu_desc); | |
| 828 CHECK_CONS (menu_desc); | |
| 829 CHECK_STRING (XCAR (menu_desc)); | |
| 830 | |
| 707 | 831 menu_cleanup (f); |
| 832 | |
| 428 | 833 current_menudesc = menu_desc; |
| 834 current_hash_table = | |
| 835 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); | |
| 442 | 836 menu = create_empty_popup_menu (); |
| 428 | 837 Fputhash (hmenu_to_lisp_object (menu), Qnil, current_hash_table); |
| 838 top_level_menu = menu; | |
| 442 | 839 |
| 428 | 840 /* see comments in menubar-x.c */ |
| 841 if (zmacs_regions) | |
| 842 zmacs_region_stays = 1; | |
| 442 | 843 |
| 428 | 844 ok = TrackPopupMenu (menu, |
| 845 TPM_LEFTALIGN | TPM_LEFTBUTTON | TPM_RIGHTBUTTON, | |
| 846 pt.x, pt.y, 0, | |
| 847 FRAME_MSWINDOWS_HANDLE (f), NULL); | |
| 848 | |
| 849 DestroyMenu (menu); | |
| 850 | |
| 707 | 851 /* A WM_COMMAND is not issued until TrackPopupMenu returns. This |
| 852 makes setting popup_up_p fairly pointless since we cannot keep | |
| 853 the menu up and dispatch events. Furthermore, we seem to have | |
| 854 little control over what happens to the menu when we click. */ | |
| 855 popup_up_p--; | |
| 856 | |
| 857 /* Signal a signal if caught by Track...() modal loop. */ | |
| 858 /* I think this is pointless, the code hasn't actually put us in a | |
| 859 modal loop at this time -- andyp. */ | |
| 428 | 860 mswindows_unmodalize_signal_maybe (); |
| 861 | |
| 862 /* This is probably the only real reason for failure */ | |
| 442 | 863 if (!ok) |
| 864 { | |
| 865 menu_cleanup (f); | |
| 563 | 866 invalid_operation ("Cannot track popup menu while in menu", |
| 867 menu_desc); | |
| 442 | 868 } |
| 869 UNGCPRO; | |
| 428 | 870 } |
| 871 | |
| 872 | |
| 873 /*------------------------------------------------------------------------*/ | |
| 874 /* Initialization */ | |
| 875 /*------------------------------------------------------------------------*/ | |
| 876 void | |
| 877 syms_of_menubar_mswindows (void) | |
| 878 { | |
| 879 } | |
| 880 | |
| 881 void | |
| 882 console_type_create_menubar_mswindows (void) | |
| 883 { | |
| 884 CONSOLE_HAS_METHOD (mswindows, update_frame_menubars); | |
| 885 CONSOLE_HAS_METHOD (mswindows, free_frame_menubars); | |
| 886 CONSOLE_HAS_METHOD (mswindows, popup_menu); | |
| 887 } | |
| 888 | |
| 889 void | |
| 890 vars_of_menubar_mswindows (void) | |
| 891 { | |
| 892 current_menudesc = Qnil; | |
| 893 current_hash_table = Qnil; | |
| 894 | |
| 895 staticpro (¤t_menudesc); | |
| 896 staticpro (¤t_hash_table); | |
| 897 } |