annotate src/menubar-x.c @ 4928:ea701c23ed84

change text_width method to take a window, in preparation for unicode-internal changes -------------------- ChangeLog entries follow: -------------------- src/ChangeLog addition: 2010-01-19 Ben Wing <ben@xemacs.org> * console-impl.h (struct console_methods): * console-stream.c (stream_text_width): * redisplay-msw.c (mswindows_output_string): * redisplay-msw.c (mswindows_text_width): * redisplay-tty.c (tty_text_width): * redisplay-xlike-inc.c (XLIKE_text_width): * redisplay-xlike-inc.c (XLIKE_output_string): * redisplay.c: * redisplay.c (redisplay_window_text_width_ichar_string): * redisplay.c (redisplay_text_width_string): Change the text_width method to take a window instead of a frame. Needed for Unicode-internal.
author Ben Wing <ben@xemacs.org>
date Tue, 19 Jan 2010 11:21:34 -0600
parents 726060ee587c
children 19a72041c5ed
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 -- X interface.
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.
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1204
diff changeset
4 Copyright (C) 2000, 2001, 2002, 2003 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 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
10 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 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
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* Synched up with: Not in FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
25 /* This file Mule-ized by Ben Wing, 7-8-00. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
26
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
27 /* Authorship:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
28
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
29 Created 16-dec-91 by Jamie Zawinski.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
30 Menu filters and many other keywords added by Stig for 19.12.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
31 Original device-abstraction work and GC cleanup work by Ben Wing for 19.13.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
32 Menu accelerators c. 1997? by ??. Moved here from event-stream.c.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
33 Other work post-1996 by ??.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
34 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 #include "commands.h" /* zmacs_regions */
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
41 #include "device-impl.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 #include "events.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
43 #include "frame-impl.h"
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
44 #include "gui.h"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
45 #include "keymap.h"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
46 #include "menubar.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #include "opaque.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
48 #include "window-impl.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
50 #include "console-x-impl.h"
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
51
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
52 #include "EmacsFrame.h"
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
53 #include "../lwlib/lwlib.h"
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
54
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 static int set_frame_menubar (struct frame *f,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 int deep_p,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 int first_time_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 #define MENUBAR_TYPE 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 #define SUBMENU_TYPE 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 #define POPUP_TYPE 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 /* Converting Lisp menu tree descriptions to lwlib's `widget_value' form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 menu_item_descriptor_to_widget_value() converts a lisp description of a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 menubar into a tree of widget_value structures. It allocates widget_values
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 with malloc_widget_value() and allocates other storage only for the `key'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 slot. All other slots are filled with pointers to Lisp_String data. We
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 allocate a widget_value description of the menu or menubar, and hand it to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 lwlib, which then makes a copy of it, which it manages internally. We then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 immediately free our widget_value tree; it will not be referenced again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 Incremental menu construction callbacks operate just a bit differently.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 They allocate widget_values and call replace_widget_value_tree() to tell
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 lwlib to destructively modify the incremental stub (subtree) of its
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 separate widget_value tree.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 This function is highly recursive (it follows the menu trees) and may call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 eval. The reason we keep pointers to lisp string data instead of copying
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 it and freeing it later is to avoid the speed penalty that would entail
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 (since this needs to be fast, in the simple cases at least). (The reason
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 we malloc/free the keys slot is because there's not a lisp string around
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 for us to use in that case.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 Since we keep pointers to lisp strings, and we call eval, we could lose if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 GC relocates (or frees) those strings. It's not easy to gc protect the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 strings because of the recursive nature of this function, and the fact that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 it returns a data structure that gets freed later. So... we do the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 sleaziest thing possible and inhibit GC for the duration. This is probably
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 not a big deal...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 We do not have to worry about the pointers to Lisp_String data after
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 this function successfully finishes. lwlib copies all such data with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 strdup(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 static widget_value *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 menu_item_descriptor_to_widget_value_1 (Lisp_Object desc,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 int menu_type, int deep_p,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 int filter_p,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 /* This function cannot GC.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 It is only called from menu_item_descriptor_to_widget_value, which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 prohibits GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 int menubar_root_p = (menu_type == MENUBAR_TYPE && depth == 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 int count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 int partition_seen = 0;
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
109 widget_value *wv = xmalloc_widget_value ();
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
110 Lisp_Object wv_closure = make_opaque_ptr (wv);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 record_unwind_protect (widget_value_unwind, wv_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 if (STRINGP (desc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
116 Ibyte *string_chars = XSTRING_DATA (desc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 wv->type = (separator_string_p (string_chars) ? SEPARATOR_TYPE :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 TEXT_TYPE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 if (wv->type == SEPARATOR_TYPE)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
121 wv->value = menu_separator_style_and_to_external (string_chars);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
125 LISP_STRING_TO_EXTERNAL_MALLOC (desc, wv->name, Qlwlib_encoding);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 wv->enabled = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 /* dverna Dec. 98: command_builder_operate_menu_accelerator will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 manipulate the accel as a Lisp_Object if the widget has a name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 Since simple labels have a name, but no accel, we *must* set it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 to nil */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 wv->accel = LISP_TO_VOID (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 else if (VECTORP (desc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 Lisp_Object gui_item = gui_parse_item_keywords (desc);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
137 if (!button_item_to_widget_value (Qmenubar,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
138 gui_item, wv, 1,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 (menu_type == MENUBAR_TYPE
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
140 && depth <= 1), 1, 1))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 /* :included form was nil */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 wv = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 goto menu_item_done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 else if (CONSP (desc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 Lisp_Object incremental_data = desc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 widget_value *prev = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 if (STRINGP (XCAR (desc)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 Lisp_Object key, val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 Lisp_Object include_p = Qnil, hook_fn = Qnil, config_tag = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 Lisp_Object active_p = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 Lisp_Object accel;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 int included_spec = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 int active_spec = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 wv->type = CASCADE_TYPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 wv->enabled = 1;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
162 wv->name = add_accel_and_to_external (XCAR (desc));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
164 accel = gui_name_accelerator (XCAR (desc));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 wv->accel = LISP_TO_VOID (accel);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 desc = Fcdr (desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 while (key = Fcar (desc), KEYWORDP (key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 Lisp_Object cascade = desc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 desc = Fcdr (desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 if (NILP (desc))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
174 sferror ("Keyword in menu lacks a value", cascade);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 val = Fcar (desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 desc = Fcdr (desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 if (EQ (key, Q_included))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 include_p = val, included_spec = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 else if (EQ (key, Q_config))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 config_tag = val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 else if (EQ (key, Q_filter))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 hook_fn = val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 else if (EQ (key, Q_active))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 active_p = val, active_spec = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 else if (EQ (key, Q_accelerator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 if ( SYMBOLP (val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 || CHARP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 wv->accel = LISP_TO_VOID (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
191 invalid_argument ("bad keyboard accelerator", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 else if (EQ (key, Q_label))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 /* implement in 21.2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
198 invalid_argument ("Unknown menu cascade keyword", cascade);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 if ((!NILP (config_tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 && NILP (Fmemq (config_tag, Vmenubar_configuration)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 || (included_spec && NILP (Feval (include_p))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 wv = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 goto menu_item_done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 if (active_spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 active_p = Feval (active_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 if (!NILP (hook_fn) && !NILP (active_p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 if (filter_p || depth == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 #endif
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
218 desc = call1 (hook_fn, desc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 if (UNBOUNDP (desc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 desc = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 else
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 widget_value *incr_wv = xmalloc_widget_value ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 wv->contents = incr_wv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 incr_wv->type = INCREMENTAL_TYPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 incr_wv->enabled = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 incr_wv->name = wv->name;
436
080151679be2 Import from CVS: tag r21-2-26
cvs
parents: 428
diff changeset
230 incr_wv->name = xstrdup (wv->name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 /* This is automatically GC protected through
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 the call to lw_map_widget_values(); no need
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 to worry. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 incr_wv->call_data = LISP_TO_VOID (incremental_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 goto menu_item_done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 if (menu_type == POPUP_TYPE && popup_menu_titles && depth == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 /* Simply prepend three more widget values to the contents of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 the menu: a label, and two separators (to get a double
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 line). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 widget_value *title_wv = xmalloc_widget_value ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 widget_value *sep_wv = xmalloc_widget_value ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 title_wv->type = TEXT_TYPE;
436
080151679be2 Import from CVS: tag r21-2-26
cvs
parents: 428
diff changeset
247 title_wv->name = xstrdup (wv->name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 title_wv->enabled = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 title_wv->next = sep_wv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 sep_wv->type = SEPARATOR_TYPE;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
251 sep_wv->value = menu_separator_style_and_to_external ((Ibyte *) "==");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 sep_wv->next = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 wv->contents = title_wv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 prev = sep_wv;
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 wv->enabled = ! NILP (active_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 if (deep_p && !wv->enabled && !NILP (desc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 widget_value *dummy;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 /* Add a fake entry so the menus show up */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 wv->contents = dummy = xmalloc_widget_value ();
436
080151679be2 Import from CVS: tag r21-2-26
cvs
parents: 428
diff changeset
263 dummy->name = xstrdup ("(inactive)");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 dummy->accel = LISP_TO_VOID (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 dummy->enabled = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 dummy->selected = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 dummy->value = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 dummy->type = BUTTON_TYPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 dummy->call_data = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 dummy->next = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 goto menu_item_done;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
273 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274
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 else if (menubar_root_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 {
436
080151679be2 Import from CVS: tag r21-2-26
cvs
parents: 428
diff changeset
278 wv->name = xstrdup ("menubar");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 wv->type = CASCADE_TYPE; /* Well, nothing else seems to fit and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 this is ignored anyway... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
284 sferror ("Menu name (first element) must be a string", desc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 }
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 if (deep_p || menubar_root_p)
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 widget_value *next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 for (; !NILP (desc); desc = Fcdr (desc))
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 Lisp_Object child = Fcar (desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 if (menubar_root_p && NILP (child)) /* the partition */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 if (partition_seen)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
296 sferror
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
297 ("More than one partition (nil) in menubar description",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
298 desc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 partition_seen = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 next = xmalloc_widget_value ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 next->type = PUSHRIGHT_TYPE;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 next = menu_item_descriptor_to_widget_value_1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 (child, menu_type, deep_p, filter_p, depth + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 if (! next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 else if (prev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 prev->next = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 wv->contents = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 prev = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 }
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 (deep_p && !wv->contents)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 wv = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 else if (NILP (desc))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
321 sferror ("nil may not appear in menu descriptions", desc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
323 sferror ("Unrecognized menu descriptor", desc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
325 menu_item_done:
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 if (wv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 /* Completed normally. Clear out the object that widget_value_unwind()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 will be called with to tell it not to free the wv (as we are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 returning it.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 set_opaque_ptr (wv_closure, 0);
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
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
335 unbind_to (count);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 return wv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
339 struct menu_item_descriptor_to_widget_value
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
340 {
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
341 Lisp_Object desc;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
342 int menu_type, deep_p, filter_p;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
343 widget_value *wv;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
344 };
428
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 static Lisp_Object
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
347 protected_menu_item_descriptor_to_widget_value_1 (void *gack)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 {
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
349 struct menu_item_descriptor_to_widget_value *midtwv =
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
350 (struct menu_item_descriptor_to_widget_value *) gack;
1918
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
351 int count = begin_gc_forbidden ();
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
352 /* Can't GC! */
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
353 midtwv->wv = menu_item_descriptor_to_widget_value_1 (midtwv->desc,
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
354 midtwv->menu_type,
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
355 midtwv->deep_p,
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
356 midtwv->filter_p,
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
357 0);
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
358 unbind_to (count);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
359 return Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 }
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
361
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
362 /* Inside of the pre_activate_callback, we absolutely need to protect
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
363 against errors, esp. but not exclusively in the filter code. (We do
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
364 other evalling, too.) We also need to reenable quit checking, which
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
365 was disabled by next_event_internal() so as to read C-g as an
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
366 event. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
368 static widget_value *
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
369 protected_menu_item_descriptor_to_widget_value (Lisp_Object desc,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
370 int menu_type, int deep_p,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
371 int filter_p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 {
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
373 struct menu_item_descriptor_to_widget_value midtwv;
1279
cd0abfdb9e9d [xemacs-hg @ 2003-02-09 09:33:42 by ben]
ben
parents: 1268
diff changeset
374 int depth = internal_bind_int (&in_menu_callback, 1);
cd0abfdb9e9d [xemacs-hg @ 2003-02-09 09:33:42 by ben]
ben
parents: 1268
diff changeset
375 Lisp_Object retval;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
377 midtwv.desc = desc;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
378 midtwv.menu_type = menu_type;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
379 midtwv.deep_p = deep_p;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
380 midtwv.filter_p = filter_p;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381
1279
cd0abfdb9e9d [xemacs-hg @ 2003-02-09 09:33:42 by ben]
ben
parents: 1268
diff changeset
382 retval = event_stream_protect_modal_loop
cd0abfdb9e9d [xemacs-hg @ 2003-02-09 09:33:42 by ben]
ben
parents: 1268
diff changeset
383 ("Error during menu callback",
cd0abfdb9e9d [xemacs-hg @ 2003-02-09 09:33:42 by ben]
ben
parents: 1268
diff changeset
384 protected_menu_item_descriptor_to_widget_value_1, &midtwv,
cd0abfdb9e9d [xemacs-hg @ 2003-02-09 09:33:42 by ben]
ben
parents: 1268
diff changeset
385 UNINHIBIT_QUIT);
cd0abfdb9e9d [xemacs-hg @ 2003-02-09 09:33:42 by ben]
ben
parents: 1268
diff changeset
386 unbind_to (depth);
cd0abfdb9e9d [xemacs-hg @ 2003-02-09 09:33:42 by ben]
ben
parents: 1268
diff changeset
387
cd0abfdb9e9d [xemacs-hg @ 2003-02-09 09:33:42 by ben]
ben
parents: 1268
diff changeset
388 if (UNBOUNDP (retval))
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
389 return 0;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
390
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
391 return midtwv.wv;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 }
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
393
1918
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
394 /* The two callers of menu_item_descriptor_to_widget_value may both run while
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
395 in redisplay. Some descriptor to widget value conversions call Feval, and
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
396 at least one calls QUIT. Hence, we have to establish protection here.. */
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
397
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
398 static widget_value *
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
399 menu_item_descriptor_to_widget_value (Lisp_Object desc,
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
400 int menu_type, /* if this is a menubar,
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
401 popup or sub menu */
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
402 int deep_p, /* */
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
403 int filter_p) /* if :filter forms
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
404 should run now */
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
405 {
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
406 struct menu_item_descriptor_to_widget_value midtwv;
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
407 Lisp_Object retval;
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
408
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
409 midtwv.desc = desc;
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
410 midtwv.menu_type = menu_type;
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
411 midtwv.deep_p = deep_p;
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
412 midtwv.filter_p = filter_p;
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
413
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
414 retval = call_trapping_problems
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
415 (Qevent, "Error during menu construction", 0, NULL,
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
416 protected_menu_item_descriptor_to_widget_value_1, &midtwv);
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
417
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
418 if (UNBOUNDP (retval))
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
419 return NULL;
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
420
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
421 return midtwv.wv;
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
422 }
59bf16be00bf [xemacs-hg @ 2004-02-19 02:49:18 by james]
james
parents: 1346
diff changeset
423
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 /* The order in which callbacks are run is funny to say the least.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 It's sometimes tricky to avoid running a callback twice, and to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 avoid returning prematurely. So, this function returns true
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 if the menu's callbacks are no longer gc protected. So long
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 as we unprotect them before allowing other callbacks to run,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 everything should be ok.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 The pre_activate_callback() *IS* intentionally called multiple times.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 If client_data == NULL, then it's being called before the menu is posted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 If client_data != NULL, then client_data is a (widget_value *) and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 client_data->data is a Lisp_Object pointing to a lisp submenu description
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 that must be converted into widget_values. *client_data is destructively
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 modified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 #### Stig thinks that there may be a GC problem here due to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 fact that pre_activate_callback() is called multiple times, but I
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 think he's wrong.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 static void
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1918
diff changeset
445 pre_activate_callback (Widget widget, LWLIB_ID UNUSED (id),
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1918
diff changeset
446 XtPointer client_data)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 struct device *d = get_device_from_display (XtDisplay (widget));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 struct frame *f = x_any_window_to_frame (d, XtWindow (widget));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 Lisp_Object frame;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 /* set in lwlib to the time stamp associated with the most recent menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 operation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 extern Time x_focus_timestamp_really_sucks_fix_me_better;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 if (!f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 f = x_any_window_to_frame (d, XtWindow (XtParent (widget)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 if (!f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 return;
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 /* make sure f is the selected frame */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
463 frame = wrap_frame (f);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 Fselect_frame (frame);
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 if (client_data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 /* this is an incremental menu construction callback */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 widget_value *hack_wv = (widget_value *) client_data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 Lisp_Object submenu_desc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 widget_value *wv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 assert (hack_wv->type == INCREMENTAL_TYPE);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
474 submenu_desc = VOID_TO_LISP (hack_wv->call_data);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
476 wv = (protected_menu_item_descriptor_to_widget_value
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
477 (submenu_desc, SUBMENU_TYPE, 1, 0));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 if (!wv)
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 wv = xmalloc_widget_value ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 wv->type = CASCADE_TYPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 wv->next = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 wv->accel = LISP_TO_VOID (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 wv->contents = xmalloc_widget_value ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 wv->contents->type = TEXT_TYPE;
436
080151679be2 Import from CVS: tag r21-2-26
cvs
parents: 428
diff changeset
487 wv->contents->name = xstrdup ("No menu");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 wv->contents->next = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 wv->contents->accel = LISP_TO_VOID (Qnil);
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 assert (wv && wv->type == CASCADE_TYPE && wv->contents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 replace_widget_value_tree (hack_wv, wv->contents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 free_popup_widget_value_tree (wv);
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1204
diff changeset
494 /* Now that we've destructively modified part of the widget value
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1204
diff changeset
495 hierarchy, our list of protected callbacks will no longer be
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1204
diff changeset
496 valid, so we need to recompute it. */
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
497 gcpro_popup_callbacks (FRAME_X_MENUBAR_ID (f));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 }
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
499 else if (!FRAME_X_MENUBAR_ID (f))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 else
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 /* #### - It is necessary to *ALWAYS* call set_frame_menubar() now that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 incremental menus are implemented. If a subtree of a menu has been
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 updated incrementally (a destructive operation), then that subtree
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 must somehow be wiped.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 It is difficult to undo the destructive operation in lwlib because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 a pointer back to lisp data needs to be hidden away somewhere. So
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 that an INCREMENTAL_TYPE widget_value can be recreated... Hmmmmm. */
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
511 run_hook_trapping_problems
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1279
diff changeset
512 (Qmenubar, Qactivate_menubar_hook,
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
513 INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 set_frame_menubar (f, 1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 DEVICE_X_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 x_focus_timestamp_really_sucks_fix_me_better;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 static widget_value *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 compute_menubar_data (struct frame *f, Lisp_Object menubar, int deep_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 if (NILP (menubar))
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
525 return 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 {
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
528 widget_value *data;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 int count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
531 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
532 Fset_buffer (XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 data = menu_item_descriptor_to_widget_value (menubar, MENUBAR_TYPE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 deep_p, 0);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
535 unbind_to (count);
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
536
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
537 return data;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 set_frame_menubar (struct frame *f, int deep_p, int first_time_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 widget_value *data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 Lisp_Object menubar;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 int menubar_visible;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 long id;
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
548 /* As with the toolbar, the minibuffer does not have its own menubar. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 if (! FRAME_X_P (f))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 /***** first compute the contents of the menubar *****/
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 if (! first_time_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 /* evaluate `current-menubar' in the buffer of the selected window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 of the frame in question. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 menubar = symbol_value_in_buffer (Qcurrent_menubar, w->buffer);
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 /* That's a little tricky the first time since the frame isn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 fully initialized yet. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 menubar = Fsymbol_value (Qcurrent_menubar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 if (NILP (menubar))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 menubar = Vblank_menubar;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 menubar_visible = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 menubar_visible = !NILP (w->menubar_visible_p);
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 data = compute_menubar_data (f, menubar, deep_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 if (!data || (!data->next && !data->contents))
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2367
diff changeset
579 ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
581 if (!FRAME_X_MENUBAR_ID (f))
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
582 FRAME_X_MENUBAR_ID (f) = new_lwlib_id ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 /***** now store into the menubar widget, creating it if necessary *****/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
586 id = FRAME_X_MENUBAR_ID (f);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 if (!FRAME_X_MENUBAR_WIDGET (f))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 Widget parent = FRAME_X_CONTAINER_WIDGET (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 assert (first_time_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 /* It's the first time we've mapped the menubar so compute its
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 contents completely once. This makes sure that the menubar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 components are created with the right type. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 if (!deep_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 free_popup_widget_value_tree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 data = compute_menubar_data (f, menubar, 1);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 FRAME_X_MENUBAR_WIDGET (f) =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 lw_create_widget ("menubar", "menubar", id, data, parent,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 0, pre_activate_callback,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 popup_selection_callback, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 lw_modify_all_widgets (id, data, deep_p ? True : False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 free_popup_widget_value_tree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1204
diff changeset
615 /* Buried inside of the lwlib data are pointers to Lisp objects that may
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1204
diff changeset
616 have been freshly created. They need to be GC-protected, so snarf them
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1204
diff changeset
617 now and record them into the popup-data object associated with the
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1204
diff changeset
618 frame. */
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
619 gcpro_popup_callbacks (id);
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1204
diff changeset
620
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
621 FRAME_X_MENUBAR_CONTENTS_UP_TO_DATE (f) = deep_p;
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
622 FRAME_X_LAST_MENUBAR_BUFFER (f) =
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 return menubar_visible;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626
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 /* Called from x_create_widgets() to create the initial menubar of a frame
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 before it is mapped, so that the window is mapped with the menubar already
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 there instead of us tacking it on later and thrashing the window after it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 is visible. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 x_initialize_frame_menubar (struct frame *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 return set_frame_menubar (f, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637
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 static LWLIB_ID last_popup_menu_selection_callback_id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 popup_menu_selection_callback (Widget widget, LWLIB_ID id,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 XtPointer client_data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 last_popup_menu_selection_callback_id = id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 popup_selection_callback (widget, id, client_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 /* lw_destroy_all_widgets() will be called from popup_down_callback() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 static void
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1918
diff changeset
651 popup_menu_down_callback (Widget widget, LWLIB_ID id,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1918
diff changeset
652 XtPointer UNUSED (client_data))
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 if (popup_handled_p (id))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 assert (popup_up_p != 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 ungcpro_popup_callbacks (id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 popup_up_p--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 /* if this isn't called immediately after the selection callback, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 there wasn't a menu selection. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 if (id != last_popup_menu_selection_callback_id)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 popup_selection_callback (widget, id, (XtPointer) -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 lw_destroy_all_widgets (id);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 static void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
668 make_dummy_xbutton_event (XEvent *dummy, Widget daddy, Lisp_Event *eev)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 /* NULL for eev means query pointer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 XButtonPressedEvent *btn = (XButtonPressedEvent *) dummy;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 btn->type = ButtonPress;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 btn->serial = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 btn->send_event = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 btn->display = XtDisplay (daddy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 btn->window = XtWindow (daddy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 if (eev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 Position shellx, shelly, framex, framey;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 Arg al [2];
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
682 btn->time = EVENT_TIMESTAMP (eev);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
683 btn->button = EVENT_BUTTON_BUTTON (eev);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
684 btn->root = RootWindowOfScreen (XtScreen (daddy));
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
685 btn->subwindow = (Window) NULL;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
686 btn->x = EVENT_BUTTON_X (eev);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
687 btn->y = EVENT_BUTTON_Y (eev);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 shellx = shelly = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 #ifndef HAVE_WMCOMMAND
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 Widget shell = XtParent (daddy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692
4528
726060ee587c First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents: 4522
diff changeset
693 Xt_SET_ARG (al [0], XtNx, &shellx);
726060ee587c First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents: 4522
diff changeset
694 Xt_SET_ARG (al [1], XtNy, &shelly);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 XtGetValues (shell, al, 2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 }
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
697 #endif
4528
726060ee587c First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents: 4522
diff changeset
698 Xt_SET_ARG (al [0], XtNx, &framex);
726060ee587c First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents: 4522
diff changeset
699 Xt_SET_ARG (al [1], XtNy, &framey);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 XtGetValues (daddy, al, 2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 btn->x_root = shellx + framex + btn->x;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 btn->y_root = shelly + framey + btn->y;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 btn->state = ButtonPressMask; /* all buttons pressed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 /* CurrentTime is just ZERO, so it's worthless for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 determining relative click times. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 struct device *d = get_device_from_display (XtDisplay (daddy));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 btn->time = DEVICE_X_MOUSE_TIMESTAMP (d); /* event-Xt maintains this */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 btn->button = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 XQueryPointer (btn->display, btn->window, &btn->root,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 &btn->subwindow, &btn->x_root, &btn->y_root,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 &btn->x, &btn->y, &btn->state);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 x_update_frame_menubar_internal (struct frame *f)
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 /* We assume the menubar contents has changed if the global flag is set,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 or if the current buffer has changed, or if the menubar has never
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 been updated before.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 int menubar_contents_changed =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 (f->menubar_changed
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
729 || !FRAME_X_MENUBAR_ID (f)
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
730 || (!EQ (FRAME_X_LAST_MENUBAR_BUFFER (f),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 Boolean menubar_was_visible = XtIsManaged (FRAME_X_MENUBAR_WIDGET (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 Boolean menubar_will_be_visible = menubar_was_visible;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 Boolean menubar_visibility_changed;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 if (menubar_contents_changed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 menubar_will_be_visible = set_frame_menubar (f, 0, 0);
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 menubar_visibility_changed = menubar_was_visible != menubar_will_be_visible;
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 if (!menubar_visibility_changed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 /* Set menubar visibility */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 (menubar_will_be_visible ? XtManageChild : XtUnmanageChild)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 (FRAME_X_MENUBAR_WIDGET (f));
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 MARK_FRAME_SIZE_SLIPPED (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 x_update_frame_menubars (struct frame *f)
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 assert (FRAME_X_P (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 x_update_frame_menubar_internal (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 /* #### This isn't going to work right now that this function works on
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 a per-frame, not per-device basis. Guess what? I don't care. */
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 x_free_frame_menubars (struct frame *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 Widget menubar_widget;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 assert (FRAME_X_P (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 if (menubar_widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 {
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
773 LWLIB_ID id = FRAME_X_MENUBAR_ID (f);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 lw_destroy_all_widgets (id);
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
775 ungcpro_popup_callbacks (id);
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
776 FRAME_X_MENUBAR_ID (f) = 0;
428
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 x_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 int menu_id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 struct frame *f = selected_frame ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 widget_value *data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 Widget parent;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 Widget menu;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
788 Lisp_Event *eev = NULL;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 XEvent xev;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
790 Lisp_Object frame = wrap_frame (f);
428
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 CHECK_X_FRAME (frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 parent = FRAME_X_SHELL_WIDGET (f);
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 if (!NILP (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 CHECK_LIVE_EVENT (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 eev= XEVENT (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 if (eev->event_type != button_press_event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 && eev->event_type != button_release_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 wrong_type_argument (Qmouse_event_p, event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 else if (!NILP (Vthis_command_keys))
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 /* 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
806 currently being executed, if that event is a mouse event */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 eev = XEVENT (Vthis_command_keys); /* last event first */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 if (eev->event_type != button_press_event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 && eev->event_type != button_release_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 eev = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 make_dummy_xbutton_event (&xev, parent, eev);
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 if (SYMBOLP (menu_desc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 menu_desc = Fsymbol_value (menu_desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 CHECK_CONS (menu_desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 CHECK_STRING (XCAR (menu_desc));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 data = menu_item_descriptor_to_widget_value (menu_desc, POPUP_TYPE, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
820 if (! data) signal_error (Qgui_error, "no menu", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 menu_id = new_lwlib_id ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 menu = lw_create_widget ("popup", "popup" /* data->name */, menu_id, data,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 parent, 1, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 popup_menu_selection_callback,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 popup_menu_down_callback);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 free_popup_widget_value_tree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 gcpro_popup_callbacks (menu_id);
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 /* Setting zmacs-region-stays is necessary here because executing a command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 from a menu is really a two-command process: the first command (bound to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 the button-click) simply pops up the menu, and returns. This causes a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 sequence of magic-events (destined for the popup-menu widget) to begin.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 Eventually, a menu item is selected, and a menu-event blip is pushed onto
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 the end of the input stream, which is then executed by the event loop.
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 So there are two command-events, with a bunch of magic-events between
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 them. We don't want the *first* command event to alter the state of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 region, so that the region can be available as an argument for the second
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 command.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
842 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 if (zmacs_regions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 zmacs_region_stays = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 popup_up_p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 lw_popup_menu (menu, &xev);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 /* this speeds up display of pop-up menus */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 XFlush (XtDisplay (parent));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851
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
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
854 #if defined(LWLIB_MENUBARS_LUCID)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
855 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
856 menu_move_up (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
857 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
858 widget_value *current = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
859 widget_value *entries = lw_get_entries (True);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
860 widget_value *prev = NULL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
861
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
862 while (entries != current)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
863 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
864 if (entries->name /*&& entries->enabled*/) prev = entries;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
865 entries = entries->next;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
866 assert (entries);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
867 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
868
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
869 if (!prev)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
870 /* move to last item */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
871 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
872 while (entries->next)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
873 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
874 if (entries->name /*&& entries->enabled*/) prev = entries;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
875 entries = entries->next;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
876 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
877 if (prev)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
878 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
879 if (entries->name /*&& entries->enabled*/)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
880 prev = entries;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
881 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
882 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
883 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
884 /* no selectable items in this menu, pop up to previous level */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
885 lw_pop_menu ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
886 return;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
887 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
888 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
889 lw_set_item (prev);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
890 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
891
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
892 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
893 menu_move_down (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
894 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
895 widget_value *current = lw_get_entries (False);
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
896 widget_value *new_ = current;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
897
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
898 while (new_->next)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
899 {
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
900 new_ = new_->next;
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
901 if (new_->name /*&& new_->enabled*/) break;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
902 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
903
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
904 if (new_==current||!(new_->name/*||new_->enabled*/))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
905 {
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
906 new_ = lw_get_entries (True);
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
907 while (new_!=current)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
908 {
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
909 if (new_->name /*&& new_->enabled*/) break;
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
910 new_ = new_->next;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
911 }
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
912 if (new_==current&&!(new_->name /*|| new_->enabled*/))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
913 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
914 lw_pop_menu ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
915 return;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
916 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
917 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
918
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
919 lw_set_item (new_);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
920 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
921
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
922 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
923 menu_move_left (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
924 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
925 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
926 int l = level;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
927 widget_value *current;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
928
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
929 while (level-- >= 3)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
930 lw_pop_menu ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
931
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
932 menu_move_up ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
933 current = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
934 if (l > 2 && current->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
935 lw_push_menu (current->contents);
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
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
938 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
939 menu_move_right (void)
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 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
942 int l = level;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
943 widget_value *current;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
944
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
945 while (level-- >= 3)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
946 lw_pop_menu ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
947
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
948 menu_move_down ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
949 current = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
950 if (l > 2 && current->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
951 lw_push_menu (current->contents);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
952 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
953
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
954 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
955 menu_select_item (widget_value *val)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
956 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
957 if (val == NULL)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
958 val = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
959
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
960 /* is match a submenu? */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
961
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
962 if (val->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
963 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
964 /* enter the submenu */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
965
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
966 lw_set_item (val);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
967 lw_push_menu (val->contents);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
968 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
969 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
970 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
971 /* Execute the menu entry by calling the menu's `select'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
972 callback function
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
973 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
974 lw_kill_menus (val);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
975 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
976 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
977
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
978 Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
979 command_builder_operate_menu_accelerator (struct command_builder *builder)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
980 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
981 /* this function can GC */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
982
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
983 struct console *con = XCONSOLE (Vselected_console);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
984 Lisp_Object evee = builder->most_current_event;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
985 Lisp_Object binding;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
986 widget_value *entries;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
987
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
988 extern int lw_menu_accelerate; /* lwlib.c */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
989
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
990 #if 0
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
991 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
992 int i;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
993 Lisp_Object t;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
994
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
995 t = builder->current_events;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
996 i = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
997 while (!NILP (t))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
998 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
999 i++;
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
1000 write_fmt_string (Qexternal_debugging_output, "OPERATE (%d): ",i);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1001 print_internal (t, Qexternal_debugging_output, 1);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
1002 write_c_string (Qexternal_debugging_output, "\n");
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1003 t = XEVENT_NEXT (t);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1004 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1005 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1006 #endif /* 0 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1007
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1008 /* menu accelerator keys don't go into keyboard macros */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1009 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1010 con->kbd_macro_ptr = con->kbd_macro_end;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1011
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1012 /* don't echo menu accelerator keys */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1013 /*reset_key_echo (builder, 1);*/
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1014
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1015 if (!lw_menu_accelerate)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1016 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1017 /* `convert' mouse display to keyboard display
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1018 by entering the open submenu
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1019 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1020 entries = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1021 if (entries->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1022 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1023 lw_push_menu (entries->contents);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1024 lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1025 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1026 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1027
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1028 /* compare event to the current menu accelerators */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1029
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1030 entries=lw_get_entries (True);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1031
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1032 while (entries)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1033 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1034 Lisp_Object accel;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
1035 accel = VOID_TO_LISP (entries->accel);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1036 if (entries->name && !NILP (accel))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1037 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
1038 if (event_matches_key_specifier_p (evee, accel))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1039 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1040 /* a match! */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1041
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1042 menu_select_item (entries);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1043
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1044 if (lw_menu_active) lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1045
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1046 reset_this_command_keys (Vselected_console, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1047 /*reset_command_builder_event_chain (builder);*/
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1048 return Vmenu_accelerator_map;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1049 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1050 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1051 entries = entries->next;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1052 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1053
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1054 /* try to look up event in menu-accelerator-map */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1055
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1056 binding = event_binding_in (evee, Vmenu_accelerator_map, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1057
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1058 if (NILP (binding))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1059 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1060 /* beep at user for undefined key */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1061 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1062 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1063 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1064 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1065 if (EQ (binding, Qmenu_quit))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1066 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1067 /* turn off menus and set quit flag */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1068 lw_kill_menus (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1069 Vquit_flag = Qt;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1070 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1071 else if (EQ (binding, Qmenu_up))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1072 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1073 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1074 if (level > 2)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1075 menu_move_up ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1076 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1077 else if (EQ (binding, Qmenu_down))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1078 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1079 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1080 if (level > 2)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1081 menu_move_down ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1082 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1083 menu_select_item (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1084 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1085 else if (EQ (binding, Qmenu_left))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1086 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1087 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1088 if (level > 3)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1089 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1090 lw_pop_menu ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1091 lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1092 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1093 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1094 menu_move_left ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1095 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1096 else if (EQ (binding, Qmenu_right))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1097 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1098 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1099 if (level > 2 &&
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1100 lw_get_entries (False)->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1101 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1102 widget_value *current = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1103 if (current->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1104 menu_select_item (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1105 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1106 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1107 menu_move_right ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1108 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1109 else if (EQ (binding, Qmenu_select))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1110 menu_select_item (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1111 else if (EQ (binding, Qmenu_escape))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1112 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1113 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1114
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1115 if (level > 2)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1116 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1117 lw_pop_menu ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1118 lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1119 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1120 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1121 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1122 /* turn off menus quietly */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1123 lw_kill_menus (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1124 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1125 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1126 else if (KEYMAPP (binding))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1127 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1128 /* prefix key */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1129 reset_this_command_keys (Vselected_console, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1130 /*reset_command_builder_event_chain (builder);*/
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1131 return binding;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1132 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1133 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1134 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1135 /* turn off menus and execute binding */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1136 lw_kill_menus (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1137 reset_this_command_keys (Vselected_console, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1138 /*reset_command_builder_event_chain (builder);*/
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1139 return binding;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1140 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1141 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1142
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1143 if (lw_menu_active) lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1144
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1145 reset_this_command_keys (Vselected_console, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1146 /*reset_command_builder_event_chain (builder);*/
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1147
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1148 return Vmenu_accelerator_map;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1149 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1150
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1151 static Lisp_Object
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1918
diff changeset
1152 menu_accelerator_junk_on_error (Lisp_Object errordata,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1918
diff changeset
1153 Lisp_Object UNUSED (ignored))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1154 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1155 Vmenu_accelerator_prefix = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1156 Vmenu_accelerator_modifiers = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1157 Vmenu_accelerator_enabled = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1158 if (!NILP (errordata))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1159 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1160 /* #### This should call
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1161 (with-output-to-string (display-error errordata))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1162 but that stuff is all in Lisp currently. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1163 warn_when_safe_lispobj
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1164 (Qerror, Qwarning,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1165 emacs_sprintf_string_lisp
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1166 ("%s: %s", Qnil, 2,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1167 build_msg_string ("Error in menu accelerators (setting to nil)"),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1168 errordata));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1169 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1170
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1171 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1172 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1173
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1174 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1175 menu_accelerator_safe_compare (Lisp_Object event0)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1176 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1177 if (CONSP (Vmenu_accelerator_prefix))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1178 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1179 Lisp_Object t;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1180 t=Vmenu_accelerator_prefix;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1181 while (!NILP (t)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1182 && !NILP (event0)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
1183 && event_matches_key_specifier_p (event0, Fcar (t)))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1184 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1185 t = Fcdr (t);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1186 event0 = XEVENT_NEXT (event0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1187 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1188 if (!NILP (t))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1189 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1190 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1191 else if (NILP (event0))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1192 return Qnil;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
1193 else if (event_matches_key_specifier_p (event0, Vmenu_accelerator_prefix))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1194 event0 = XEVENT_NEXT (event0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1195 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1196 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1197 return event0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1198 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1199
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1200 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1201 menu_accelerator_safe_mod_compare (Lisp_Object cons)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1202 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
1203 return (event_matches_key_specifier_p (XCAR (cons), XCDR (cons)) ? Qt
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1204 : Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1205 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1206
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1207 Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1208 command_builder_find_menu_accelerator (struct command_builder *builder)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1209 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1210 /* this function can GC */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1211 Lisp_Object event0 = builder->current_events;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1212 struct console *con = XCONSOLE (Vselected_console);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1213 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1214 Widget menubar_widget;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1215
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1216 /* compare entries in event0 against the menu prefix */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1217
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1218 if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) ||
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1219 XEVENT (event0)->event_type != key_press_event)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1220 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1221
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1222 if (!NILP (Vmenu_accelerator_prefix))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1223 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1224 event0 = condition_case_1 (Qerror,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1225 menu_accelerator_safe_compare,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1226 event0,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1227 menu_accelerator_junk_on_error,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1228 Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1229 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1230
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1231 if (NILP (event0))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1232 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1233
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1234 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1235 if (menubar_widget
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1236 && CONSP (Vmenu_accelerator_modifiers))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1237 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1238 Lisp_Object fake = Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1239 Lisp_Object last = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1240 struct gcpro gcpro1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1241 Lisp_Object matchp;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1242
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1243 widget_value *val;
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
1244 LWLIB_ID id = FRAME_X_MENUBAR_ID (f);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1245
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1246 val = lw_get_all_values (id);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1247 if (val)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1248 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1249 val = val->contents;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1250
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1251 fake = Fcopy_sequence (Vmenu_accelerator_modifiers);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1252 last = fake;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1253
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1254 while (!NILP (Fcdr (last)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1255 last = Fcdr (last);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1256
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1257 Fsetcdr (last, Fcons (Qnil, Qnil));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1258 last = Fcdr (last);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1259 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1260
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1261 fake = Fcons (Qnil, fake);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1262
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1263 GCPRO1 (fake);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1264
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1265 while (val)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1266 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1267 Lisp_Object accel;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
1268 accel = VOID_TO_LISP (val->accel);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1269 if (val->name && !NILP (accel))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1270 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1271 Fsetcar (last, accel);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1272 Fsetcar (fake, event0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1273 matchp = condition_case_1 (Qerror,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1274 menu_accelerator_safe_mod_compare,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1275 fake,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1276 menu_accelerator_junk_on_error,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1277 Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1278 if (!NILP (matchp))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1279 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1280 /* we found one! */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1281
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1282 lw_set_menu (menubar_widget, val);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1283 /* yah - yet another hack.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1284 pretend emacs timestamp is the same as an X timestamp,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1285 which for the moment it is. (read events.h)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1286 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1287 lw_map_menu (XEVENT (event0)->timestamp);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1288
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1289 if (val->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1290 lw_push_menu (val->contents);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1291
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1292 lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1293
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1294 /* menu accelerator keys don't go into keyboard macros */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1295 if (!NILP (con->defining_kbd_macro)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1296 && NILP (Vexecuting_macro))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1297 con->kbd_macro_ptr = con->kbd_macro_end;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1298
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1299 /* don't echo menu accelerator keys */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1300 /*reset_key_echo (builder, 1);*/
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1301 reset_this_command_keys (Vselected_console, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1302 UNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1303
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1304 return Vmenu_accelerator_map;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1305 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1306 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1307
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1308 val = val->next;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1309 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1310
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1311 UNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1312 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1313 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1314 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1315
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1316 int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1317 x_kludge_lw_menu_active (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1318 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1319 return lw_menu_active;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1320 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1321
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1322 DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1323 Make the menubar active. Menu items can be selected using menu accelerators
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1324 or by actions defined in menu-accelerator-map.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1325 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1326 ())
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1327 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1328 struct console *con = XCONSOLE (Vselected_console);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1329 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1330 LWLIB_ID id;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1331 widget_value *val;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1332
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
1333 if (!FRAME_X_MENUBAR_ID (f))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1334 invalid_argument ("Frame has no menubar", Qunbound);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1335
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
1336 id = FRAME_X_MENUBAR_ID (f);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1337 val = lw_get_all_values (id);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1338 val = val->contents;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1339 lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1340 lw_map_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1341
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1342 lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1343
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1344 /* menu accelerator keys don't go into keyboard macros */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1345 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1346 con->kbd_macro_ptr = con->kbd_macro_end;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1347
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1348 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1349 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1350 #endif /* LWLIB_MENUBARS_LUCID */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1351
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1352
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 syms_of_menubar_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1356 #if defined(LWLIB_MENUBARS_LUCID)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1357 DEFSUBR (Faccelerate_menu);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1358 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 console_type_create_menubar_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 CONSOLE_HAS_METHOD (x, update_frame_menubars);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 CONSOLE_HAS_METHOD (x, free_frame_menubars);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 CONSOLE_HAS_METHOD (x, popup_menu);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 reinit_vars_of_menubar_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 last_popup_menu_selection_callback_id = (LWLIB_ID) -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 vars_of_menubar_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 #if defined (LWLIB_MENUBARS_LUCID)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 Fprovide (intern ("lucid-menubars"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 #elif defined (LWLIB_MENUBARS_MOTIF)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 Fprovide (intern ("motif-menubars"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 #elif defined (LWLIB_MENUBARS_ATHENA)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 Fprovide (intern ("athena-menubars"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 }