annotate src/menubar-msw.c @ 872:79c6ff3eef26

[xemacs-hg @ 2002-06-20 21:18:01 by ben] font changes etc.; some 21.4 changes mule/mule-msw-init-late.el: Specify charset->windows-registry conversion. mule/mule-x-init.el: Delete extra mule font additions here. Put them in faces.c. cl-macs.el: Document better. font-lock.el: Move Lisp function regexp to lisp-mode.el. lisp-mode.el: Various indentation fixes: Handle flet functions better. Handle argument lists in defuns and flets. Handle quoted lists, e.g. property lists -- don't indent like function calls. Distinguish between lambdas and other lists. lisp-mode.el: Handle this form. faces.el, font-menu.el, font.el, gtk-faces.el, msw-faces.el, msw-font-menu.el, x-faces.el, x-init.el: Major overhaul of face-handling code: -- Fix lots of bogus code in msw-faces.el, msw-font-menu.el, font-menu.el that was "truenaming" font specs -- i.e. in the process of frobbing a particular field in a general user-specified font spec with wildcarded fields, sticking in particular values for all the remaining wildcarded fields. This bug was rampant everywhere except in x-faces.el (the oldest and only correctly written code). This also means that we need to work with font names at all times and not font instances, because a font instance is essentially a truenamed font. -- Total rewrite of extremely junky code in msw-faces.el. Work with names as well as font instances, and return names; stop truenaming when canonicalizing and frobbing; fix handling of the combined style field, i.e. weight/slant (also fixed in font.el). -- Totally rewrite the frobbing functions in faces.el. This time, we frob all the instantiators rather than just computing a single instance value and working backwards. That way, e.g., `bold' will work for all charsets that have bold available, rather than only for whatever charset was part of the computed font instance (another example of the truename virus). Also fix up code to look at the fallbacks (all of them) when no global value present, so we don't need to put something in the global value. Intelligently handle a request to frob a buffer locale, rather than signalling an error. When frobbing instantiators, try hard to figure out what device type is associated with them, and frob each according to its own proper device type. Correctly handle inheritance vectors given as instantiators. Preserve existing tags when putting back frobbed instantiators. Extract out general specifier-frobbing code into specifier.el. Document everything cleanly. Do lots of other things better, etc. -- Don't duplicatively set a global specification for the default font -- it's already in the fallback and we no longer need a default global specification present. Delete various code in x-faces.el and msw-faces.el that duplicated the lists of fonts in faces.c. -- init-global-faces was not being called at all under MS Windows! Major bogosity. That caused device-specific values to get stuck into all the fonts, making it very hard to change them -- setting global specs caused nothing to happen. -- Correct weight names in font.el. -- Lots more font fixups in objects*.c. Printer.el: Warning fix. specifier.el: Add more args to map-specifier. Add various "heuristic" specifier functions to aid in creation of specifier-munging code such as in faces.el. subr.el: New functions. lwlib.c: Fix warning. config.inc.samp: Clean up, add args to control fastcall (not yet supported! the changes needed are in another ws of mine), profile support, vc6 support, union-type. xemacs.dsp, xemacs.mak: Semi-major overhaul. Fix bug where dump-id was always getting recomputed, forcing a redump even when nothing changed. Add support for fastcall. Support edit-and-continue (on by default) with vc6. Use incremental linking when doing a debug compilation. Add support for profiling. Consolidate the various debug flags. Partial support for "batch-compiling" -- compiling many files on a single invocation of the compiler. Doesn't seem to help that much for me, so it's not finished or enabled by default. Remove HAVE_MSW_C_DIRED, we always do. Correct some sloppy use of directories. s/cygwin32.h: Allow pdump to work under Cygwin (mmap is broken, so need to undefine HAVE_MMAP). s/win32-common.h, s/windowsnt.h: Support for fastcall. Add WIN32_ANY for identifying all Win32 variants (Cygwin, native, MinGW). Both of these are properly used in another ws. alloc.c, balloon-x.c, buffer.c, bytecode.c, callint.c, cm.c, cmdloop.c, cmds.c, console-gtk.c, console-gtk.h, console-msw.c, console-msw.h, console-stream.c, console-stream.h, console-tty.c, console-tty.h, console-x.c, console-x.h, console.c, console.h, device-gtk.c, device-msw.c, device-tty.c, device-x.c, device.c, device.h, devslots.h, dialog-gtk.c, dialog-msw.c, dialog-x.c, dialog.c, dired-msw.c, editfns.c, emacs.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.c, extents.c, extents.h, faces.c, fileio.c, fns.c, frame-gtk.c, frame-msw.c, frame-tty.c, frame-x.c, frame.c, frame.h, glyphs-eimage.c, glyphs-gtk.c, glyphs-msw.c, glyphs-widget.c, glyphs-x.c, glyphs.c, glyphs.h, gui-gtk.c, gui-msw.c, gui-x.c, gui.c, gutter.c, input-method-xlib.c, intl-encap-win32.c, intl-win32.c, keymap.c, lisp.h, macros.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, menubar.h, minibuf.c, mule-charset.c, nt.c, objects-gtk.c, objects-gtk.h, objects-msw.c, objects-msw.h, objects-tty.c, objects-tty.h, objects-x.c, objects-x.h, objects.c, objects.h, postgresql.c, print.c, process.h, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-tty.c, redisplay-x.c, redisplay.c, redisplay.h, scrollbar-gtk.c, scrollbar-msw.c, scrollbar-x.c, scrollbar.c, select-gtk.c, select-msw.c, select-x.c, select.c, signal.c, sound.c, specifier.c, symbols.c, syntax.c, sysdep.c, syssignal.h, syswindows.h, toolbar-common.c, toolbar-gtk.c, toolbar-msw.c, toolbar-x.c, toolbar.c, unicode.c, window.c, window.h: The following are the major changes made: (1) Separation of various header files into an external and an internal version, similar to the existing separation of process.h and procimpl.h. Eventually this should be done for all Lisp objects. The external version has the same name as currently; the internal adds -impl. The external file has XFOO() macros for objects, but the structure is opaque and defined only in the internal file. It's now reasonable to move all prototypes in lisp.h into the appropriate external file, and this should be done. Currently, separation has been done on extents.h, objects*.h, console.h, device.h, frame.h, and window.h. For c/d/f/w, the most basic properties are available in the external header file, with the macros resolving to functions. In the internal header file, the macros are redefined to directly access the structure. Also, the global MARK_FOO_CHANGED macros have been made into functions so that they can be accessed without needing to include lots of -impl headers -- they are used in almost exclusively in non-time-critical functions, and take up enough time that the function overhead will be negligible. Similarly, the function overhead from making the basic properties mentioned above into functions is negligible, and code that does heavy accessing of c/d/f/w structures inevitably ends up needing the internal header files, anyway. (2) More face changes. -- Major rewrite of objects-msw.c. Now handles wildcard specs properly, rather than "truenaming" (or even worse, signalling an error, which previously happened with some of the fallbacks if you tried to use them in make-font-instance!). -- Split charset matching of fonts into two stages -- one to find a font specifically designed for a particular charset (by examining its registry), the second to find a Unicode font that can support the charset. This needs to proceed as two complete, separate instantiations in order to work properly (otherwise many of the fonts in the HELLO page look wrong). This should also make it easy to support iso10646 (Unicode) fonts under X. -- All default values for fonts are now completely specified in the fallbacks. Stuff from mule-x-init.el has all been moved here, merged with the existing specs, and totally rethought so you get sensible results. (HELLO now looks much better!). -- Generalize the "default X/GTK device" stuff into a per-device-type "default device". -- Add mswindows-{set-}charset-registry. In time, charset<->code-page conversion functions will be removed. -- Wrap protective code around calls to compute device specifier tags, and do this computation before calling the face initialization code because the latter may need these tags to be correctly updated. (3) Other changes. EmacsFrame.c, glyphs-msw.c, eval.c, gui-x.c, intl-encap-win32.c, search.c, signal.c, toolbar-msw.c, unicode.c: Warning fixes. config.h.in: #undefs meant to be frobbed by configure *MUST* go inside of #ifndef WIN32_NO_CONFIGURE, and everything else *MUST* go outside! eval.c: Let detailed backtraces be detailed. specifier.c: Don't override user's print-string-length/print-length settings. glyphs.c: New function image-instance-instantiator. config.h.in, sysdep.c: Changes for fastcall. sysdep.c, nt.c: Fix up a previous botched patch that tried to add support for both EEXIST and EACCES. IF THE BOTCHED PATCH WENT INTO 21.4, THIS FIXUP NEEDS TO GO IN, TOO. search.c: Fix *evil* crash due to incorrect synching of syntax-cache code with 21.1. THIS SHOULD GO INTO 21.4.
author ben
date Thu, 20 Jun 2002 21:19:10 +0000
parents 804517e16990
children 8d610ea37af8
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Implements an elisp-programmable menubar -- Win32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1993, 1994 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4 Copyright (C) 1997 Kirill M. Katsnelson <kkm@kis.ru>.
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 793
diff changeset
5 Copyright (C) 2000, 2001, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 /* Synched up with: Not in FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
26 /* This function mostly Mule-ized (except perhaps some Unicode splitting).
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
27 5-2000. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
28
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 /* Author:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 Initially written by kkm 12/24/97,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 peeking into and copying stuff from menubar-x.c
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 /* Algorithm for handling menus is as follows. When window's menubar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 * is created, current-menubar is not traversed in depth. Rather, only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 * top level items, both items and pulldowns, are added to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 * menubar. Each pulldown is initially empty. When a pulldown is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 * selected and about to open, corresponding element of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 * current-menubar is found, and the newly open pulldown is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 * populated. This is made again in the same non-recursive manner.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 * This algorithm uses hash tables to find out element of the menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 * descriptor list given menu handle. The key is an opaque ptr data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 * type, keeping menu handle, and the value is a list of strings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 * representing the path from the root of the menu to the item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 * descriptor. Each frame has an associated hash table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 * Leaf items are assigned a unique id based on item's hash. When an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 * item is selected, Windows sends back the id. Unfortunately, only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 * low 16 bit of the ID are sent, and there's no way to get the 32-bit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 * value. Yes, Win32 is just a different set of bugs than X! Aside
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 * from this blame, another hashing mechanism is required to map menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 * ids to commands (which are actually Lisp_Object's). This mapping is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 * performed in the same hash table, as the lifetime of both maps is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 * exactly the same. This is unambigous, as menu handles are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 * represented by lisp opaques, while command ids are by lisp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 * integers. The additional advantage for this is that command forms
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 * are automatically GC-protected, which is important because these
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 * may be transient forms generated by :filter functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 * The hash table is not allowed to grow too much; it is pruned
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 * whenever this is safe to do. This is done by re-creating the menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 * bar, and clearing and refilling the hash table from scratch.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 * Popup menus are handled identically to pulldowns. A static hash
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 * table is used for popup menus, and lookup is made not in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 * current-menubar but in a lisp form supplied to the `popup'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 * function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 * Another Windows weirdness is that there's no way to tell that a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 * popup has been dismissed without making selection. We need to know
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 * that to cleanup the popup menu hash table, but this is not honestly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 * doable using *documented* sequence of messages. Sticking to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 * particular knowledge is bad because this may break in Windows NT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 * 5.0, or Windows 98, or other future version. Instead, I allow the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 * hash tables to hang around, and not clear them, unless WM_COMMAND is
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
77 * received. This is worth some memory but more safe. Hacks welcome,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 * anyways!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 #include "commands.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
87 #include "console-msw-impl.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 #include "elhash.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 #include "events.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
90 #include "frame-impl.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 #include "gui.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 #include "menubar.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 #include "menubar-msw.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 #include "opaque.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
96 #include "window-impl.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 /* #### */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
99 #define REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH 0
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 #define EMPTY_ITEM_ID ((UINT)LISP_TO_VOID (Qunbound))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
102 #define EMPTY_ITEM_NAME "(empty)" /* WARNING: uses of this need XETEXT */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 /* Current menu (bar or popup) descriptor. gcpro'ed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 static Lisp_Object current_menudesc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 /* Current menubar or popup hash table. gcpro'ed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 static Lisp_Object current_hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 /* This is used to allocate unique ids to menu items.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 Items ids are in MENU_ITEM_ID_MIN to MENU_ITEM_ID_MAX.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 Allocation checks that the item is not already in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 the TOP_LEVEL_MENU */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 /* #### defines go to gui-msw.h, as the range is shared with toolbars
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 (If only toolbars will be implemented as common controls) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 #define MENU_ITEM_ID_MIN 0x8000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 #define MENU_ITEM_ID_MAX 0xFFFF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 #define MENU_ITEM_ID_BITS(x) (((x) & 0x7FFF) | 0x8000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 static HMENU top_level_menu;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 /*
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
123 * Translate X accelerator syntax to win32 accelerator syntax.
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
124 * accel = (Ichar*) to receive the accelerator character
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
125 * or NULL to suppress accelerators in the menu or dialog item.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
126 *
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
127 * %% is replaced with %
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
128 * if accel is NULL:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
129 * %_ is removed.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
130 * if accel is non-NULL:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
131 * %_ is replaced with &.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
132 * The accelerator character is passed back in *accel.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
133 * (If there is no accelerator, it will be added on the first character.)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
134 *
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
135 */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
136
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
137 Lisp_Object
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
138 mswindows_translate_menu_or_dialog_item (Lisp_Object item, Ichar *accel)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
139 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
140 Bytecount len = XSTRING_LENGTH (item);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
141 Ibyte *it = (Ibyte *) ALLOCA (2 * len + 42), *ptr = it;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
142
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
143 memcpy (ptr, XSTRING_DATA (item), len + 1);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
144 if (accel)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
145 *accel = '\0';
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
146
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
147 /* Escape '&' as '&&' */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
148
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
149 while ((ptr = (Ibyte *) memchr (ptr, '&', len - (ptr - it))) != NULL)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
150 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
151 memmove (ptr + 1, ptr, (len - (ptr - it)) + 1);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
152 len++;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
153 ptr += 2;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
154 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
155
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
156 /* Replace XEmacs accelerator '%_' with Windows accelerator '&'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
157 and `%%' with `%'. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
158 ptr = it;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
159 while ((ptr = (Ibyte *) memchr (ptr, '%', len - (ptr - it))) != NULL)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
160 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
161 if (*(ptr + 1) == '_')
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
162 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
163 if (accel)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
164 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
165 *ptr = '&';
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
166 if (!*accel)
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
167 *accel = DOWNCASE (0, itext_ichar (ptr + 2));
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
168 memmove (ptr + 1, ptr + 2, len - (ptr - it + 2) + 1);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
169 len--;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
170 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
171 else /* Skip accelerator */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
172 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
173 memmove (ptr, ptr + 2, len - (ptr - it + 2) + 1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
174 len -= 2;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
175 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
176 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
177 else if (*(ptr + 1) == '%')
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
178 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
179 memmove (ptr + 1, ptr + 2, len - (ptr - it + 2) + 1);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
180 len--;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
181 ptr++;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
182 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
183 else /* % on its own - shouldn't happen */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
184 ptr++;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
185 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
186
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
187 if (accel && !*accel)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
188 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
189 /* Force a default accelerator */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
190 ptr = it;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
191 memmove (ptr + 1, ptr, len + 1);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
192 *accel = DOWNCASE (0, itext_ichar (ptr + 1));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
193 *ptr = '&';
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
194
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
195 len++;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
196 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
197
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
198 return make_string (it, len);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
199 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
200
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
201 /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 * This returns Windows-style menu item string:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 * "Left Flush\tRight Flush"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
205
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
206 static Lisp_Object
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
207 displayable_menu_item (Lisp_Object gui_item, int bar_p, Ichar *accel)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
209 Lisp_Object left, right = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 /* Left flush part of the string */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
212 left = gui_item_display_flush_left (gui_item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
214 left = mswindows_translate_menu_or_dialog_item (left, accel);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 /* Right flush part, unless we're at the top-level where it's not allowed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 if (!bar_p)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
218 right = gui_item_display_flush_right (gui_item);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
219
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
220 if (!NILP (right))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
221 return concat3 (left, build_string ("\t"), right);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
222 else
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
223 return left;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 * hmenu_to_lisp_object() returns an opaque ptr given menu handle.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 hmenu_to_lisp_object (HMENU hmenu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 return make_opaque_ptr (hmenu);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 * Allocation tries a hash based on item's path and name first. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 * almost guarantees that the same item will override its old value in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 * the hash table rather than abandon it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 allocate_menu_item_id (Lisp_Object path, Lisp_Object name, Lisp_Object suffix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 UINT id = MENU_ITEM_ID_BITS (HASH3 (internal_hash (path, 0),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 internal_hash (name, 0),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 internal_hash (suffix, 0)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 do {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 id = MENU_ITEM_ID_BITS (id + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 } while (GetMenuState (top_level_menu, id, MF_BYCOMMAND) != 0xFFFFFFFF);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 return make_int (id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 static HMENU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 create_empty_popup_menu (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 return CreatePopupMenu ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 empty_menu (HMENU menu, int add_empty_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 while (DeleteMenu (menu, 0, MF_BYPOSITION));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 if (add_empty_p)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
263 qxeAppendMenu (menu, MF_STRING | MF_GRAYED, EMPTY_ITEM_ID,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
264 XETEXT (EMPTY_ITEM_NAME));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 * The idea of checksumming is that we must hash minimal object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 * which is necessarily changes when the item changes. For separator
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 * this is a constant, for grey strings and submenus these are hashes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 * of names, since submenus are unpopulated until opened so always
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 * equal otherwise. For items, this is a full hash value of a callback,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 * because a callback may me a form which can be changed only somewhere
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 * in depth.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 static unsigned long
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 checksum_menu_item (Lisp_Object item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 if (STRINGP (item))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 /* Separator or unselectable text - hash as a string + 13 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 if (separator_string_p (XSTRING_DATA (item)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 return 13;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 return internal_hash (item, 0) + 13;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 else if (CONSP (item))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 /* Submenu - hash by its string name + 0 */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
290 return internal_hash (XCAR (item), 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 else if (VECTORP (item))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 /* An ordinary item - hash its name and callback form. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 return HASH2 (internal_hash (XVECTOR_DATA(item)[0], 0),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 internal_hash (XVECTOR_DATA(item)[1], 0));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
298
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 /* An error - will be caught later */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 populate_menu_add_item (HMENU menu, Lisp_Object path,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 Lisp_Object hash_tab, Lisp_Object item,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
306 Lisp_Object *accel_list,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 int flush_right, int bar_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
309 MENUITEMINFOW item_info;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 item_info.cbSize = sizeof (item_info);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 item_info.fMask = MIIM_TYPE | MIIM_STATE | MIIM_ID;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 item_info.fState = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 item_info.wID = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 item_info.fType = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 if (STRINGP (item))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 /* Separator or unselectable text */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 if (separator_string_p (XSTRING_DATA (item)))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
321 item_info.fType = MFT_SEPARATOR;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
324 Extbyte *itemext;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
325
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 item_info.fType = MFT_STRING;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 item_info.fState = MFS_DISABLED;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
328 LISP_STRING_TO_TSTR (item, itemext);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
329 item_info.dwTypeData = (XELPTSTR) itemext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 else if (CONSP (item))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 /* Submenu */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 HMENU submenu;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 Lisp_Object gui_item = allocate_gui_item ();
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
337 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
338 struct gcpro gcpro1, gcpro2, gcpro3;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
339 Ichar accel;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
340 Extbyte *itemext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
342 GCPRO3 (gui_item, path, *accel_list);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 menu_parse_submenu_keywords (item, gui_item);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 if (!STRINGP (pgui_item->name))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 442
diff changeset
347 invalid_argument ("Menu name (first element) must be a string",
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
348 item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 if (!gui_item_included_p (gui_item, Vmenubar_configuration))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
351 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
352 UNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
353 goto done;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
354 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 if (!gui_item_active_p (gui_item))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
357 item_info.fState = MFS_GRAYED;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 /* Temptation is to put 'else' right here. Although, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 displayed item won't have an arrow indicating that it is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 popup. So we go ahead a little bit more and create a popup */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
361 submenu = create_empty_popup_menu ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 item_info.fMask |= MIIM_SUBMENU;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
364 LISP_STRING_TO_TSTR (displayable_menu_item (gui_item, bar_p, &accel),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
365 itemext);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
366 item_info.dwTypeData = (XELPTSTR) itemext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 item_info.hSubMenu = submenu;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
368
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
369 if (accel && bar_p)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
370 *accel_list = Fcons (make_char (accel), *accel_list);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 if (!(item_info.fState & MFS_GRAYED))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 /* Now add the full submenu path as a value to the hash table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 keyed by menu handle */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 if (NILP(path))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 path = list1 (pgui_item->name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 Lisp_Object arg[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 arg[0] = path;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 arg[1] = list1 (pgui_item->name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 path = Fappend (2, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 Fputhash (hmenu_to_lisp_object (submenu), path, hash_tab);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
388 UNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
389 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 else if (VECTORP (item))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 /* An ordinary item */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 Lisp_Object style, id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 Lisp_Object gui_item = gui_parse_item_keywords (item);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
395 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
396 struct gcpro gcpro1, gcpro2;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
397 Ichar accel;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
398 Extbyte *itemext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
400 GCPRO2 (gui_item, *accel_list);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 if (!gui_item_included_p (gui_item, Vmenubar_configuration))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
403 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
404 UNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
405 goto done;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
406 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
407
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
408 if (!STRINGP (pgui_item->name))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
409 pgui_item->name = Feval (pgui_item->name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 if (!gui_item_active_p (gui_item))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
412 item_info.fState = MFS_GRAYED;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 style = (NILP (pgui_item->selected) || NILP (Feval (pgui_item->selected))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 ? Qnil : pgui_item->style);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 if (EQ (style, Qradio))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 item_info.fType |= MFT_RADIOCHECK;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 item_info.fState |= MFS_CHECKED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 else if (EQ (style, Qtoggle))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
423 item_info.fState |= MFS_CHECKED;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 id = allocate_menu_item_id (path, pgui_item->name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 pgui_item->suffix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 Fputhash (id, pgui_item->callback, hash_tab);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
429 item_info.wID = (UINT) XINT (id);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 item_info.fType |= MFT_STRING;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
431 LISP_STRING_TO_TSTR (displayable_menu_item (gui_item, bar_p, &accel),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
432 itemext);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
433 item_info.dwTypeData = (XELPTSTR) itemext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
435 if (accel && bar_p)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
436 *accel_list = Fcons (make_char (accel), *accel_list);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
437
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
438 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 442
diff changeset
441 sferror ("Malformed menu item descriptor", item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 if (flush_right)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
444 item_info.fType |= MFT_RIGHTJUSTIFY;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
446 qxeInsertMenuItem (menu, UINT_MAX, TRUE, &item_info);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
447
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
448 done:;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
449 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 * This function is called from populate_menu and checksum_menu.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 * When called to populate, MENU is a menu handle, PATH is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 * list of strings representing menu path from root to this submenu,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 * DESCRIPTOR is a menu descriptor, HASH_TAB is a hash table associated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 * with root menu, BAR_P indicates whether this called for a menubar or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 * a popup, and POPULATE_P is non-zero. Return value must be ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 * When called to checksum, DESCRIPTOR has the same meaning, POPULATE_P
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 * is zero, PATH must be Qnil, and the rest of parameters is ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 * Return value is the menu checksum.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 static unsigned long
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 Lisp_Object hash_tab, int bar_p, int populate_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 Lisp_Object item_desc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 int deep_p, flush_right;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
468 struct gcpro gcpro1, gcpro2, gcpro3;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 unsigned long checksum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 Lisp_Object gui_item = allocate_gui_item ();
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
471 Lisp_Object accel_list = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
472 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
473
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
474 GCPRO3 (gui_item, accel_list, desc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 /* We are sometimes called with the menubar unchanged, and with changed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 right flush. We have to update the menubar in this case,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 so account for the compliance setting in the hash value */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
479 checksum = REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 /* Will initially contain only "(empty)" */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 if (populate_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 empty_menu (menu, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 /* PATH set to nil indicates top-level popup or menubar */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 deep_p = !NILP (path);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 /* Fetch keywords prepending the item list */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 desc = menu_parse_submenu_keywords (desc, gui_item);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 /* Check that menu name is specified when expected */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 if (NILP (pgui_item->name) && deep_p)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 442
diff changeset
493 sferror ("Menu must have a name", desc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 /* Apply filter if specified */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 if (!NILP (pgui_item->filter))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 desc = call1 (pgui_item->filter, desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 /* Loop thru the desc's CDR and add items for each entry */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 flush_right = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 EXTERNAL_LIST_LOOP (item_desc, desc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 if (NILP (XCAR (item_desc)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 /* Do not flush right menubar items when MS style compliant */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
506 if (bar_p && !REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 flush_right = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 if (!populate_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 checksum = HASH2 (checksum, LISP_HASH (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 else if (populate_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 populate_menu_add_item (menu, path, hash_tab,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
513 XCAR (item_desc), &accel_list,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
514 flush_right, bar_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 checksum = HASH2 (checksum,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 checksum_menu_item (XCAR (item_desc)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
519
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 if (populate_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 /* Remove the "(empty)" item, if there are other ones */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 if (GetMenuItemCount (menu) > 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 RemoveMenu (menu, EMPTY_ITEM_ID, MF_BYCOMMAND);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 /* Add the header to the popup, if told so. The same as in X - an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 insensitive item, and a separator (Seems to me, there were
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
528 two separators in X... In Windows this looks ugly, anyways.) */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
529 if (!bar_p && !deep_p && popup_menu_titles && !NILP (pgui_item->name))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
531 Extbyte *nameext;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
532
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
533 LISP_STRING_TO_TSTR (displayable_menu_item (gui_item, bar_p, NULL),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
534 nameext);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
535 qxeInsertMenu (menu, 0, MF_BYPOSITION | MF_STRING | MF_DISABLED,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
536 0, nameext);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
537 qxeInsertMenu (menu, 1, MF_BYPOSITION | MF_SEPARATOR, 0, NULL);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
538 SetMenuDefaultItem (menu, 0, MF_BYPOSITION);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
541
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
542 if (bar_p)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
543 Fputhash (Qt, accel_list, hash_tab);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
544
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
545 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 return checksum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 populate_menu (HMENU menu, Lisp_Object path, Lisp_Object desc,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
551 Lisp_Object hash_tab, int bar_p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 populate_or_checksum_helper (menu, path, desc, hash_tab, bar_p, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 static unsigned long
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 checksum_menu (Lisp_Object desc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 return populate_or_checksum_helper (NULL, Qnil, desc, Qunbound, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 static void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
563 update_frame_menubar_maybe (struct frame *f)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 Lisp_Object desc = (!NILP (w->menubar_visible_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 ? symbol_value_in_buffer (Qcurrent_menubar, w->buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 : Qnil);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
570 struct gcpro gcpro1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
571
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
572 GCPRO1 (desc); /* it's safest to do this, just in case some filter
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
573 or something changes the value of current-menubar */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 top_level_menu = menubar;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 if (NILP (desc) && menubar != NULL)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 /* Menubar has gone */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
580 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 SetMenu (FRAME_MSWINDOWS_HANDLE (f), NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 DestroyMenu (menubar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
584 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 if (!NILP (desc) && menubar == NULL)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 /* Menubar has appeared */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 menubar = CreateMenu ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 goto populate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 if (NILP (desc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 /* We did not have the bar and are not going to */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
598 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 /* Now we bail out if the menubar has not changed */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
603 if (FRAME_MSWINDOWS_MENU_CHECKSUM (f) == checksum_menu (desc))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
604 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
605 UNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
606 return;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
607 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 populate:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 /* Come with empty hash table */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
611 if (NILP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
612 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) =
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 else
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
615 Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 Fputhash (hmenu_to_lisp_object (menubar), Qnil,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
618 FRAME_MSWINDOWS_MENU_HASH_TABLE (f));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 populate_menu (menubar, Qnil, desc,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
620 FRAME_MSWINDOWS_MENU_HASH_TABLE (f), 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 SetMenu (FRAME_MSWINDOWS_HANDLE (f), menubar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
624 FRAME_MSWINDOWS_MENU_CHECKSUM (f) = checksum_menu (desc);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
625
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
626 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 prune_menubar (struct frame *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 Lisp_Object desc = current_frame_menubar (f);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
634 struct gcpro gcpro1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
635
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 if (menubar == NULL)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 /* #### If a filter function has set desc to Qnil, this abort()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 triggers. To resolve, we must prevent filters explicitly from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 mangling with the active menu. In apply_filter probably?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 Is copy-tree on the whole menu too expensive? */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
643 if (NILP (desc))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 /* abort(); */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
647 GCPRO1 (desc); /* just to be safe -- see above */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 /* We do the trick by removing all items and re-populating top level */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 empty_menu (menubar, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
651 assert (HASH_TABLEP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
652 Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 Fputhash (hmenu_to_lisp_object (menubar), Qnil,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
655 FRAME_MSWINDOWS_MENU_HASH_TABLE (f));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
656 populate_menu (menubar, Qnil, desc,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
657 FRAME_MSWINDOWS_MENU_HASH_TABLE (f), 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
658 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 * This is called when cleanup is possible. It is better not to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 * clean things up at all than do it too early!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 menu_cleanup (struct frame *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 current_menudesc = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 current_hash_table = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 prune_menubar (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
673
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
674 int
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
675 mswindows_char_is_accelerator (struct frame *f, Ichar ch)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
676 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
677 Lisp_Object hash = FRAME_MSWINDOWS_MENU_HASH_TABLE (f);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
678
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
679 if (NILP (hash))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
680 return 0;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
681 return !NILP (memq_no_quit
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
682 (make_char
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
683 (DOWNCASE (WINDOW_XBUFFER (FRAME_SELECTED_XWINDOW (f)), ch)),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
684 Fgethash (Qt, hash, Qnil)));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
685 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
686
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 /*------------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 /* Message handlers */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 /*------------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
692 unsafe_handle_wm_initmenupopup_1 (HMENU menu, struct frame *f)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 /* This function can call lisp, beat dogs and stick chewing gum to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 everything! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 Lisp_Object path, desc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 struct gcpro gcpro1;
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
699
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 /* Find which guy is going to explode */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 path = Fgethash (hmenu_to_lisp_object (menu), current_hash_table, Qunbound);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 assert (!UNBOUNDP (path));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 #ifdef DEBUG_XEMACS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 /* Allow to continue in a debugger after assert - not so fatal */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 if (UNBOUNDP (path))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 442
diff changeset
706 signal_error (Qinternal_error, "internal menu error", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 /* Now find a desc chunk for it. If none, then probably menu open
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 hook has played too much games around stuff */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 desc = Fmenu_find_real_submenu (current_menudesc, path);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 if (NILP (desc))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 442
diff changeset
713 invalid_state ("This menu does not exist any more", path);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 /* Now, stuff it */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 /* DESC may be generated by filter, so we have to gcpro it */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 GCPRO1 (desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 populate_menu (menu, path, desc, current_hash_table, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
724 unsafe_handle_wm_initmenu_1 (struct frame *f)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 /* NOTE: This is called for the bar only, WM_INITMENU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 for popups is filtered out */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 /* #### - this menubar update mechanism is expensively anti-social and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 the activate-menubar-hook is now mostly obsolete. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 /* We simply ignore return value. In any case, we construct the bar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 on the fly */
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
736 run_hook_trapping_problems
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
737 ("Error in activate-menubar-hook", Qactivate_menubar_hook,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
738 INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 update_frame_menubar_maybe (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 current_menudesc = current_frame_menubar (f);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
743 current_hash_table = FRAME_MSWINDOWS_MENU_HASH_TABLE (f);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 assert (HASH_TABLEP (current_hash_table));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 * Return value is Qt if we have dispatched the command,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 * or Qnil if id has not been mapped to a callback.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 * Window procedure may try other targets to route the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 * command if we return nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
756 mswindows_handle_wm_command (struct frame *f, WORD id)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 /* Try to map the command id through the proper hash table */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 Lisp_Object data, fn, arg, frame;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 if (NILP (current_hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 data = Fgethash (make_int (id), current_hash_table, Qunbound);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 if (UNBOUNDP (data))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 menu_cleanup (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 /* Need to gcpro because the hash table may get destroyed by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 menu_cleanup(), and will not gcpro the data any more */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 GCPRO1 (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 menu_cleanup (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 /* Ok, this is our one. Enqueue it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 get_gui_callback (data, &fn, &arg);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
780 frame = wrap_frame (f);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 /* this used to call mswindows_enqueue_misc_user_event but that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 breaks customize because the misc_event gets eval'ed in some
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
783 circumstances. Don't change it back unless you can fix the
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
784 customize problem also. */
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
785 mswindows_enqueue_misc_user_event (frame, fn, arg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 UNGCPRO; /* data */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 /*------------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 /* Message handling proxies */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 /*------------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 static HMENU wm_initmenu_menu;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
797 static struct frame *wm_initmenu_frame;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 unsafe_handle_wm_initmenupopup (Lisp_Object u_n_u_s_e_d)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 return unsafe_handle_wm_initmenupopup_1 (wm_initmenu_menu, wm_initmenu_frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 unsafe_handle_wm_initmenu (Lisp_Object u_n_u_s_e_d)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 return unsafe_handle_wm_initmenu_1 (wm_initmenu_frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
812 mswindows_handle_wm_initmenupopup (HMENU hmenu, struct frame *frm)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 /* We cannot pass hmenu as a lisp object. Use static var */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 wm_initmenu_menu = hmenu;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 wm_initmenu_frame = frm;
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
817 /* Allow runaway filter code, e.g. custom, to be aborted. We are
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
818 usually called from next_event_internal(), which has turned off
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
819 quit checking to read the C-g as an event. */
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
820 return mswindows_protect_modal_loop ("Error during menu handling",
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
821 unsafe_handle_wm_initmenupopup, Qnil,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
822 UNINHIBIT_QUIT);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
826 mswindows_handle_wm_initmenu (HMENU hmenu, struct frame *f)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 /* Handle only frame menubar, ignore if from popup or system menu */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
829 if (GetMenu (FRAME_MSWINDOWS_HANDLE (f)) == hmenu)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 wm_initmenu_frame = f;
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
832 return mswindows_protect_modal_loop ("Error during menu handling",
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
833 unsafe_handle_wm_initmenu, Qnil,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
834 UNINHIBIT_QUIT);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 /*------------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 /* Methods */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 /*------------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 static void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
845 mswindows_update_frame_menubars (struct frame *f)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 update_frame_menubar_maybe (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 static void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
851 mswindows_free_frame_menubars (struct frame *f)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
853 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 struct frame *f = selected_frame ();
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
860 Lisp_Event *eev = NULL;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 HMENU menu;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 POINT pt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 int ok;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
864 struct gcpro gcpro1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
865
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
866 GCPRO1 (menu_desc); /* to be safe -- see above */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 if (!NILP (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 CHECK_LIVE_EVENT (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 eev = XEVENT (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 if (eev->event_type != button_press_event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 && eev->event_type != button_release_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 wrong_type_argument (Qmouse_event_p, event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 else if (!NILP (Vthis_command_keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 /* if an event wasn't passed, use the last event of the event sequence
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 currently being executed, if that event is a mouse event */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 eev = XEVENT (Vthis_command_keys); /* last event first */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 if (eev->event_type != button_press_event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 && eev->event_type != button_release_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 eev = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
886 popup_up_p++;
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
887
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 /* Default is to put the menu at the point (10, 10) in frame */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 if (eev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 pt.x = eev->event.button.x;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 pt.y = eev->event.button.y;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 ClientToScreen (FRAME_MSWINDOWS_HANDLE (f), &pt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 pt.x = pt.y = 10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 if (SYMBOLP (menu_desc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 menu_desc = Fsymbol_value (menu_desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 CHECK_CONS (menu_desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 CHECK_STRING (XCAR (menu_desc));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
903 menu_cleanup (f);
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
904
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 current_menudesc = menu_desc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 current_hash_table =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
908 menu = create_empty_popup_menu ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 Fputhash (hmenu_to_lisp_object (menu), Qnil, current_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 top_level_menu = menu;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
911
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 /* see comments in menubar-x.c */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 if (zmacs_regions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 zmacs_region_stays = 1;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
915
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 ok = TrackPopupMenu (menu,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 TPM_LEFTALIGN | TPM_LEFTBUTTON | TPM_RIGHTBUTTON,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 pt.x, pt.y, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 FRAME_MSWINDOWS_HANDLE (f), NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 DestroyMenu (menu);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
923 /* A WM_COMMAND is not issued until TrackPopupMenu returns. This
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
924 makes setting popup_up_p fairly pointless since we cannot keep
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
925 the menu up and dispatch events. Furthermore, we seem to have
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
926 little control over what happens to the menu when we click. */
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
927 popup_up_p--;
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
928
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
929 /* Signal a signal if caught by Track...() modal loop. */
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
930 /* I think this is pointless, the code hasn't actually put us in a
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
931 modal loop at this time -- andyp. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 mswindows_unmodalize_signal_maybe ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 /* This is probably the only real reason for failure */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
935 if (!ok)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
936 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
937 menu_cleanup (f);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 442
diff changeset
938 invalid_operation ("Cannot track popup menu while in menu",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 442
diff changeset
939 menu_desc);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
940 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
941 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 /*------------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 /* Initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 /*------------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 syms_of_menubar_mswindows (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 console_type_create_menubar_mswindows (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 CONSOLE_HAS_METHOD (mswindows, update_frame_menubars);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 CONSOLE_HAS_METHOD (mswindows, free_frame_menubars);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 CONSOLE_HAS_METHOD (mswindows, popup_menu);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 vars_of_menubar_mswindows (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 current_menudesc = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 current_hash_table = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 staticpro (&current_menudesc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 staticpro (&current_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 }