Mercurial > hg > xemacs-beta
annotate src/menubar-msw.c @ 4952:19a72041c5ed
Mule-izing, various fixes related to char * arguments
-------------------- ChangeLog entries follow: --------------------
modules/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c:
* postgresql/postgresql.c (CHECK_LIVE_CONNECTION):
* postgresql/postgresql.c (print_pgresult):
* postgresql/postgresql.c (Fpq_conn_defaults):
* postgresql/postgresql.c (Fpq_connectdb):
* postgresql/postgresql.c (Fpq_connect_start):
* postgresql/postgresql.c (Fpq_result_status):
* postgresql/postgresql.c (Fpq_res_status):
Mule-ize large parts of it.
2010-01-26 Ben Wing <ben@xemacs.org>
* ldap/eldap.c (print_ldap):
* ldap/eldap.c (allocate_ldap):
Use write_ascstring().
src/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (build_ascstring):
* alloc.c (build_msg_cistring):
* alloc.c (staticpro_1):
* alloc.c (staticpro_name):
* alloc.c (staticpro_nodump_1):
* alloc.c (staticpro_nodump_name):
* alloc.c (unstaticpro_nodump_1):
* alloc.c (mcpro_1):
* alloc.c (mcpro_name):
* alloc.c (object_memory_usage_stats):
* alloc.c (common_init_alloc_early):
* alloc.c (init_alloc_once_early):
* buffer.c (print_buffer):
* buffer.c (vars_of_buffer):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.c (init_initial_directory):
* bytecode.c (invalid_byte_code):
* bytecode.c (print_compiled_function):
* bytecode.c (mark_compiled_function):
* chartab.c (print_table_entry):
* chartab.c (print_char_table):
* config.h.in:
* console-gtk.c:
* console-gtk.c (gtk_device_to_console_connection):
* console-gtk.c (gtk_semi_canonicalize_console_connection):
* console-gtk.c (gtk_canonicalize_console_connection):
* console-gtk.c (gtk_semi_canonicalize_device_connection):
* console-gtk.c (gtk_canonicalize_device_connection):
* console-stream.c (stream_init_frame_1):
* console-stream.c (vars_of_console_stream):
* console-stream.c (init_console_stream):
* console-x.c (x_semi_canonicalize_console_connection):
* console-x.c (x_semi_canonicalize_device_connection):
* console-x.c (x_canonicalize_device_connection):
* console-x.h:
* data.c (eq_with_ebola_notice):
* data.c (Fsubr_interactive):
* data.c (Fnumber_to_string):
* data.c (digit_to_number):
* device-gtk.c (gtk_init_device):
* device-msw.c (print_devmode):
* device-x.c (x_event_name):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-msw.c (handle_file_dialog_box):
* dialog-msw.c (vars_of_dialog_mswindows):
* doc.c (weird_doc):
* doc.c (Fsnarf_documentation):
* doc.c (vars_of_doc):
* dumper.c (pdump):
* dynarr.c:
* dynarr.c (Dynarr_realloc):
* editfns.c (Fuser_real_login_name):
* editfns.c (get_home_directory):
* elhash.c (print_hash_table_data):
* elhash.c (print_hash_table):
* emacs.c (main_1):
* emacs.c (vars_of_emacs):
* emodules.c:
* emodules.c (_emodules_list):
* emodules.c (Fload_module):
* emodules.c (Funload_module):
* emodules.c (Flist_modules):
* emodules.c (find_make_module):
* emodules.c (attempt_module_delete):
* emodules.c (emodules_load):
* emodules.c (emodules_doc_subr):
* emodules.c (emodules_doc_sym):
* emodules.c (syms_of_module):
* emodules.c (vars_of_module):
* emodules.h:
* eval.c (print_subr):
* eval.c (signal_call_debugger):
* eval.c (build_error_data):
* eval.c (signal_error):
* eval.c (maybe_signal_error):
* eval.c (signal_continuable_error):
* eval.c (maybe_signal_continuable_error):
* eval.c (signal_error_2):
* eval.c (maybe_signal_error_2):
* eval.c (signal_continuable_error_2):
* eval.c (maybe_signal_continuable_error_2):
* eval.c (signal_ferror):
* eval.c (maybe_signal_ferror):
* eval.c (signal_continuable_ferror):
* eval.c (maybe_signal_continuable_ferror):
* eval.c (signal_ferror_with_frob):
* eval.c (maybe_signal_ferror_with_frob):
* eval.c (signal_continuable_ferror_with_frob):
* eval.c (maybe_signal_continuable_ferror_with_frob):
* eval.c (syntax_error):
* eval.c (syntax_error_2):
* eval.c (maybe_syntax_error):
* eval.c (sferror):
* eval.c (sferror_2):
* eval.c (maybe_sferror):
* eval.c (invalid_argument):
* eval.c (invalid_argument_2):
* eval.c (maybe_invalid_argument):
* eval.c (invalid_constant):
* eval.c (invalid_constant_2):
* eval.c (maybe_invalid_constant):
* eval.c (invalid_operation):
* eval.c (invalid_operation_2):
* eval.c (maybe_invalid_operation):
* eval.c (invalid_change):
* eval.c (invalid_change_2):
* eval.c (maybe_invalid_change):
* eval.c (invalid_state):
* eval.c (invalid_state_2):
* eval.c (maybe_invalid_state):
* eval.c (wtaerror):
* eval.c (stack_overflow):
* eval.c (out_of_memory):
* eval.c (print_multiple_value):
* eval.c (issue_call_trapping_problems_warning):
* eval.c (backtrace_specials):
* eval.c (backtrace_unevalled_args):
* eval.c (Fbacktrace):
* eval.c (warn_when_safe):
* event-Xt.c (modwarn):
* event-Xt.c (modbarf):
* event-Xt.c (check_modifier):
* event-Xt.c (store_modifier):
* event-Xt.c (emacs_Xt_format_magic_event):
* event-Xt.c (describe_event):
* event-gtk.c (dragndrop_data_received):
* event-gtk.c (store_modifier):
* event-gtk.c (gtk_reset_modifier_mapping):
* event-msw.c (dde_eval_string):
* event-msw.c (Fdde_alloc_advise_item):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (FROB):
* event-msw.c (emacs_mswindows_format_magic_event):
* event-stream.c (external_debugging_print_event):
* event-stream.c (execute_help_form):
* event-stream.c (vars_of_event_stream):
* events.c (print_event_1):
* events.c (print_event):
* events.c (event_equal):
* extents.c (print_extent_1):
* extents.c (print_extent):
* extents.c (vars_of_extents):
* faces.c (print_face):
* faces.c (complex_vars_of_faces):
* file-coding.c:
* file-coding.c (print_coding_system):
* file-coding.c (print_coding_system_in_print_method):
* file-coding.c (default_query_method):
* file-coding.c (find_coding_system):
* file-coding.c (make_coding_system_1):
* file-coding.c (chain_print):
* file-coding.c (undecided_print):
* file-coding.c (gzip_print):
* file-coding.c (vars_of_file_coding):
* file-coding.c (complex_vars_of_file_coding):
* fileio.c:
* fileio.c (report_file_type_error):
* fileio.c (report_error_with_errno):
* fileio.c (report_file_error):
* fileio.c (barf_or_query_if_file_exists):
* fileio.c (vars_of_fileio):
* floatfns.c (matherr):
* fns.c (print_bit_vector):
* fns.c (Fmapconcat):
* fns.c (add_suffix_to_symbol):
* fns.c (add_prefix_to_symbol):
* frame-gtk.c:
* frame-gtk.c (Fgtk_window_id):
* frame-x.c (def):
* frame-x.c (x_cde_transfer_callback):
* frame.c:
* frame.c (Fmake_frame):
* gc.c (show_gc_cursor_and_message):
* gc.c (vars_of_gc):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate):
* glyphs-gtk.c (gtk_print_image_instance):
* glyphs-msw.c (mswindows_print_image_instance):
* glyphs-x.c (x_print_image_instance):
* glyphs-x.c (update_widget_face):
* glyphs.c (make_string_from_file):
* glyphs.c (print_image_instance):
* glyphs.c (signal_image_error):
* glyphs.c (signal_image_error_2):
* glyphs.c (signal_double_image_error):
* glyphs.c (signal_double_image_error_2):
* glyphs.c (xbm_mask_file_munging):
* glyphs.c (pixmap_to_lisp_data):
* glyphs.h:
* gui.c (gui_item_display_flush_left):
* hpplay.c (player_error_internal):
* hpplay.c (myHandler):
* intl-win32.c:
* intl-win32.c (langcode_to_lang):
* intl-win32.c (sublangcode_to_lang):
* intl-win32.c (Fmswindows_get_locale_info):
* intl-win32.c (lcid_to_locale_mule_or_no):
* intl-win32.c (mswindows_multibyte_to_unicode_print):
* intl-win32.c (complex_vars_of_intl_win32):
* keymap.c:
* keymap.c (print_keymap):
* keymap.c (ensure_meta_prefix_char_keymapp):
* keymap.c (Fkey_description):
* keymap.c (Ftext_char_description):
* lisp.h:
* lisp.h (struct):
* lisp.h (DECLARE_INLINE_HEADER):
* lread.c (Fload_internal):
* lread.c (locate_file):
* lread.c (read_escape):
* lread.c (read_raw_string):
* lread.c (read1):
* lread.c (read_list):
* lread.c (read_compiled_function):
* lread.c (init_lread):
* lrecord.h:
* marker.c (print_marker):
* marker.c (marker_equal):
* menubar-msw.c (displayable_menu_item):
* menubar-x.c (command_builder_operate_menu_accelerator):
* menubar.c (vars_of_menubar):
* minibuf.c (reinit_complex_vars_of_minibuf):
* minibuf.c (complex_vars_of_minibuf):
* mule-charset.c (Fmake_charset):
* mule-charset.c (complex_vars_of_mule_charset):
* mule-coding.c (iso2022_print):
* mule-coding.c (fixed_width_query):
* number.c (bignum_print):
* number.c (ratio_print):
* number.c (bigfloat_print):
* number.c (bigfloat_finalize):
* objects-msw.c:
* objects-msw.c (mswindows_color_to_string):
* objects-msw.c (mswindows_color_list):
* objects-tty.c:
* objects-tty.c (tty_font_list):
* objects-tty.c (tty_find_charset_font):
* objects-xlike-inc.c (xft_find_charset_font):
* objects-xlike-inc.c (endif):
* print.c:
* print.c (write_istring):
* print.c (write_ascstring):
* print.c (Fterpri):
* print.c (Fprint):
* print.c (print_error_message):
* print.c (print_vector_internal):
* print.c (print_cons):
* print.c (print_string):
* print.c (printing_unreadable_object):
* print.c (print_internal):
* print.c (print_float):
* print.c (print_symbol):
* process-nt.c (mswindows_report_winsock_error):
* process-nt.c (nt_canonicalize_host_name):
* process-unix.c (unix_canonicalize_host_name):
* process.c (print_process):
* process.c (report_process_error):
* process.c (report_network_error):
* process.c (make_process_internal):
* process.c (Fstart_process_internal):
* process.c (status_message):
* process.c (putenv_internal):
* process.c (vars_of_process):
* process.h:
* profile.c (vars_of_profile):
* rangetab.c (print_range_table):
* realpath.c (vars_of_realpath):
* redisplay.c (vars_of_redisplay):
* search.c (wordify):
* search.c (Freplace_match):
* sheap.c (sheap_adjust_h):
* sound.c (report_sound_error):
* sound.c (Fplay_sound_file):
* specifier.c (print_specifier):
* symbols.c (Fsubr_name):
* symbols.c (do_symval_forwarding):
* symbols.c (set_default_buffer_slot_variable):
* symbols.c (set_default_console_slot_variable):
* symbols.c (store_symval_forwarding):
* symbols.c (default_value):
* symbols.c (defsymbol_massage_name_1):
* symbols.c (defsymbol_massage_name_nodump):
* symbols.c (defsymbol_massage_name):
* symbols.c (defsymbol_massage_multiword_predicate_nodump):
* symbols.c (defsymbol_massage_multiword_predicate):
* symbols.c (defsymbol_nodump):
* symbols.c (defsymbol):
* symbols.c (defkeyword):
* symbols.c (defkeyword_massage_name):
* symbols.c (check_module_subr):
* symbols.c (deferror_1):
* symbols.c (deferror):
* symbols.c (deferror_massage_name):
* symbols.c (deferror_massage_name_and_message):
* symbols.c (defvar_magic):
* symeval.h:
* symeval.h (DEFVAR_SYMVAL_FWD):
* sysdep.c:
* sysdep.c (init_system_name):
* sysdll.c:
* sysdll.c (MAYBE_PREPEND_UNDERSCORE):
* sysdll.c (dll_function):
* sysdll.c (dll_variable):
* sysdll.c (dll_error):
* sysdll.c (dll_open):
* sysdll.c (dll_close):
* sysdll.c (image_for_address):
* sysdll.c (my_find_image):
* sysdll.c (search_linked_libs):
* sysdll.h:
* sysfile.h:
* sysfile.h (DEFAULT_DIRECTORY_FALLBACK):
* syswindows.h:
* tests.c (DFC_CHECK_LENGTH):
* tests.c (DFC_CHECK_CONTENT):
* tests.c (Ftest_hash_tables):
* text.c (vars_of_text):
* text.h:
* tooltalk.c (tt_opnum_string):
* tooltalk.c (tt_message_arg_ival_string):
* tooltalk.c (Ftooltalk_default_procid):
* tooltalk.c (Ftooltalk_default_session):
* tooltalk.c (init_tooltalk):
* tooltalk.c (vars_of_tooltalk):
* ui-gtk.c (Fdll_load):
* ui-gtk.c (type_to_marshaller_type):
* ui-gtk.c (Fgtk_import_function_internal):
* ui-gtk.c (emacs_gtk_object_printer):
* ui-gtk.c (emacs_gtk_boxed_printer):
* unicode.c (unicode_to_ichar):
* unicode.c (unicode_print):
* unicode.c (unicode_query):
* unicode.c (vars_of_unicode):
* unicode.c (complex_vars_of_unicode):
* win32.c:
* win32.c (mswindows_report_process_error):
* window.c (print_window):
* xemacs.def.in.in:
BASIC IDEA: Further fixing up uses of char * and CIbyte *
to reflect their actual semantics; Mule-izing some code;
redoing of the not-yet-working code to handle message translation.
Clean up code to handle message-translation (not yet working).
Create separate versions of build_msg_string() for working with
Ibyte *, CIbyte *, and Ascbyte * arguments. Assert that Ascbyte *
arguments are pure-ASCII. Make build_msg_string() be the same
as build_msg_ascstring(). Create same three versions of GETTEXT()
and DEFER_GETTEXT(). Also create build_defer_string() and
variants for the equivalent of DEFER_GETTEXT() when building a
string. Remove old CGETTEXT(). Clean up code where GETTEXT(),
DEFER_GETTEXT(), build_msg_string(), etc. was being called and
introduce some new calls to build_msg_string(), etc. Remove
GETTEXT() from calls to weird_doc() -- we assume that the
message snarfer knows about weird_doc(). Remove uses of
DEFER_GETTEXT() from error messages in sysdep.c and instead use
special comments /* @@@begin-snarf@@@ */ and /* @@@end-snarf@@@ */
that the message snarfer presumably knows about.
Create build_ascstring() and use it in many instances in place
of build_string(). The purpose of having Ascbyte * variants is
to make the code more self-documenting in terms of what sort of
semantics is expected for char * strings. In fact in the process
of looking for uses of build_string(), much improperly Mule-ized
was discovered.
Mule-ize a lot of code as described in previous paragraph,
e.g. in sysdep.c.
Make the error functions take Ascbyte * strings and fix up a
couple of places where non-pure-ASCII strings were being passed in
(file-coding.c, mule-coding.c, unicode.c). (It's debatable whether
we really need to make the error functions work this way. It
helps catch places where code is written in a way that message
translation won't work, but we may well never implement message
translation.)
Make staticpro() and friends take Ascbyte * strings instead of
raw char * strings. Create a const_Ascbyte_ptr dynarr type
to describe what's held by staticpro_names[] and friends,
create pdump descriptions for const_Ascbyte_ptr dynarrs, and
use them in place of specially-crafted staticpro descriptions.
Mule-ize certain other functions (e.g. x_event_name) by correcting
raw use of char * to Ascbyte *, Rawbyte * or another such type,
and raw use of char[] buffers to another type (usually Ascbyte[]).
Change many uses of write_c_string() to write_msg_string(),
write_ascstring(), etc.
Mule-ize emodules.c, emodules.h, sysdll.h.
Fix some un-Mule-ized code in intl-win32.c.
A comment in event-Xt.c and the limitations of the message
snarfer (make-msgfile or whatever) is presumably incorrect --
it should be smart enough to handle function calls spread over
more than one line. Clean up code in event-Xt.c that was
written awkwardly for this reason.
In config.h.in, instead of NEED_ERROR_CHECK_TYPES_INLINES,
create a more general XEMACS_DEFS_NEEDS_INLINE_DECLS to
indicate when inlined functions need to be declared in
xemacs.defs.in.in, and make use of it in xemacs.defs.in.in.
We need to do this because postgresql.c now calls qxestrdup(),
which is an inline function.
Make nconc2() and other such functions MODULE_API and put
them in xemacs.defs.in.in since postgresql.c now uses them.
Clean up indentation in lread.c and a few other places.
In text.h, document ASSERT_ASCTEXT_ASCII() and
ASSERT_ASCTEXT_ASCII_LEN(), group together the stand-in
encodings and add some more for DLL symbols, function and
variable names, etc.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Tue, 26 Jan 2010 23:22:30 -0600 |
parents | 8f1ee2d15784 |
children | 4aebb0131297 |
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 { | |
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 } |