annotate src/menubar-x.c @ 5315:2a7b6ddb8063

#'float: if handed a bigfloat, give the same bigfloat back. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * floatfns.c (Ffloat): If we've been handed a bigfloat here, it's appropriate to give the same bigfloat back.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 29 Dec 2010 23:51:08 +0000
parents 6f2158fa75ed
children 308d34e9f07d
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.
5050
6f2158fa75ed Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents: 5013
diff changeset
4 Copyright (C) 2000, 2001, 2002, 2003, 2010 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 {
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
125 wv->name = LISP_STRING_TO_EXTERNAL_MALLOC (desc, 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 */
5013
ae48681c47fa changes to VOID_TO_LISP et al.
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
131 wv->accel = STORE_LISP_IN_VOID (Qnil);
428
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));
5013
ae48681c47fa changes to VOID_TO_LISP et al.
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
165 wv->accel = STORE_LISP_IN_VOID (accel);
428
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))
5013
ae48681c47fa changes to VOID_TO_LISP et al.
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
189 wv->accel = STORE_LISP_IN_VOID (val);
428
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. */
5013
ae48681c47fa changes to VOID_TO_LISP et al.
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
234 incr_wv->call_data = STORE_LISP_IN_VOID (incremental_data);
428
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)");
5013
ae48681c47fa changes to VOID_TO_LISP et al.
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
264 dummy->accel = STORE_LISP_IN_VOID (Qnil);
428
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);
5013
ae48681c47fa changes to VOID_TO_LISP et al.
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
474 submenu_desc = GET_LISP_FROM_VOID (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;
5013
ae48681c47fa changes to VOID_TO_LISP et al.
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
484 wv->accel = STORE_LISP_IN_VOID (Qnil);
428
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;
5013
ae48681c47fa changes to VOID_TO_LISP et al.
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
489 wv->contents->accel = STORE_LISP_IN_VOID (Qnil);
428
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);
5050
6f2158fa75ed Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents: 5013
diff changeset
578 assert (data && (data->next || data->contents));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
580 if (!FRAME_X_MENUBAR_ID (f))
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
581 FRAME_X_MENUBAR_ID (f) = new_lwlib_id ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 /***** now store into the menubar widget, creating it if necessary *****/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
585 id = FRAME_X_MENUBAR_ID (f);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 if (!FRAME_X_MENUBAR_WIDGET (f))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 Widget parent = FRAME_X_CONTAINER_WIDGET (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 assert (first_time_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 /* 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
593 contents completely once. This makes sure that the menubar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 components are created with the right type. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 if (!deep_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 free_popup_widget_value_tree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 data = compute_menubar_data (f, menubar, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 }
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 FRAME_X_MENUBAR_WIDGET (f) =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 lw_create_widget ("menubar", "menubar", id, data, parent,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 0, pre_activate_callback,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 popup_selection_callback, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 lw_modify_all_widgets (id, data, deep_p ? True : False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 free_popup_widget_value_tree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1204
diff changeset
614 /* 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
615 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
616 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
617 frame. */
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
618 gcpro_popup_callbacks (id);
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1204
diff changeset
619
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
620 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
621 FRAME_X_LAST_MENUBAR_BUFFER (f) =
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 return menubar_visible;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 }
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 /* 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
628 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
629 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
630 is visible. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 x_initialize_frame_menubar (struct frame *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 return set_frame_menubar (f, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 }
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 static LWLIB_ID last_popup_menu_selection_callback_id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 popup_menu_selection_callback (Widget widget, LWLIB_ID id,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 XtPointer client_data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 last_popup_menu_selection_callback_id = id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 popup_selection_callback (widget, id, client_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 /* lw_destroy_all_widgets() will be called from popup_down_callback() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 }
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 static void
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1918
diff changeset
650 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
651 XtPointer UNUSED (client_data))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 if (popup_handled_p (id))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 assert (popup_up_p != 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 ungcpro_popup_callbacks (id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 popup_up_p--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 /* if this isn't called immediately after the selection callback, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 there wasn't a menu selection. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 if (id != last_popup_menu_selection_callback_id)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 popup_selection_callback (widget, id, (XtPointer) -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 lw_destroy_all_widgets (id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 }
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 static void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
667 make_dummy_xbutton_event (XEvent *dummy, Widget daddy, Lisp_Event *eev)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 /* NULL for eev means query pointer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 XButtonPressedEvent *btn = (XButtonPressedEvent *) dummy;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 btn->type = ButtonPress;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 btn->serial = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 btn->send_event = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 btn->display = XtDisplay (daddy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 btn->window = XtWindow (daddy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 if (eev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 Position shellx, shelly, framex, framey;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 Arg al [2];
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
681 btn->time = EVENT_TIMESTAMP (eev);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
682 btn->button = EVENT_BUTTON_BUTTON (eev);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
683 btn->root = RootWindowOfScreen (XtScreen (daddy));
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
684 btn->subwindow = (Window) NULL;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
685 btn->x = EVENT_BUTTON_X (eev);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
686 btn->y = EVENT_BUTTON_Y (eev);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 shellx = shelly = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 #ifndef HAVE_WMCOMMAND
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 Widget shell = XtParent (daddy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691
4528
726060ee587c First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents: 4522
diff changeset
692 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
693 Xt_SET_ARG (al [1], XtNy, &shelly);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 XtGetValues (shell, al, 2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 }
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
696 #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
697 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
698 Xt_SET_ARG (al [1], XtNy, &framey);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 XtGetValues (daddy, al, 2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 btn->x_root = shellx + framex + btn->x;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 btn->y_root = shelly + framey + btn->y;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 btn->state = ButtonPressMask; /* all buttons pressed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 /* CurrentTime is just ZERO, so it's worthless for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 determining relative click times. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 struct device *d = get_device_from_display (XtDisplay (daddy));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 btn->time = DEVICE_X_MOUSE_TIMESTAMP (d); /* event-Xt maintains this */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 btn->button = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 XQueryPointer (btn->display, btn->window, &btn->root,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 &btn->subwindow, &btn->x_root, &btn->y_root,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 &btn->x, &btn->y, &btn->state);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 }
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 x_update_frame_menubar_internal (struct frame *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 /* 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
723 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
724 been updated before.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 int menubar_contents_changed =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 (f->menubar_changed
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
728 || !FRAME_X_MENUBAR_ID (f)
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
729 || (!EQ (FRAME_X_LAST_MENUBAR_BUFFER (f),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 Boolean menubar_was_visible = XtIsManaged (FRAME_X_MENUBAR_WIDGET (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 Boolean menubar_will_be_visible = menubar_was_visible;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 Boolean menubar_visibility_changed;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 if (menubar_contents_changed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 menubar_will_be_visible = set_frame_menubar (f, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 menubar_visibility_changed = menubar_was_visible != menubar_will_be_visible;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 if (!menubar_visibility_changed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 /* Set menubar visibility */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 (menubar_will_be_visible ? XtManageChild : XtUnmanageChild)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 (FRAME_X_MENUBAR_WIDGET (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 MARK_FRAME_SIZE_SLIPPED (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 x_update_frame_menubars (struct frame *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 assert (FRAME_X_P (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 x_update_frame_menubar_internal (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 /* #### 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
759 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
760 }
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 x_free_frame_menubars (struct frame *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 Widget menubar_widget;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 assert (FRAME_X_P (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 if (menubar_widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 {
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
772 LWLIB_ID id = FRAME_X_MENUBAR_ID (f);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 lw_destroy_all_widgets (id);
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
774 ungcpro_popup_callbacks (id);
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
775 FRAME_X_MENUBAR_ID (f) = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 }
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 x_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 int menu_id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 struct frame *f = selected_frame ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 widget_value *data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 Widget parent;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 Widget menu;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
787 Lisp_Event *eev = NULL;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 XEvent xev;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
789 Lisp_Object frame = wrap_frame (f);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 CHECK_X_FRAME (frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 parent = FRAME_X_SHELL_WIDGET (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 if (!NILP (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 CHECK_LIVE_EVENT (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 eev= XEVENT (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 if (eev->event_type != button_press_event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 && eev->event_type != button_release_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 wrong_type_argument (Qmouse_event_p, event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 else if (!NILP (Vthis_command_keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 /* 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
805 currently being executed, if that event is a mouse event */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 eev = XEVENT (Vthis_command_keys); /* last event first */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 if (eev->event_type != button_press_event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 && eev->event_type != button_release_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 eev = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 make_dummy_xbutton_event (&xev, parent, eev);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 if (SYMBOLP (menu_desc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 menu_desc = Fsymbol_value (menu_desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 CHECK_CONS (menu_desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 CHECK_STRING (XCAR (menu_desc));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 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
818
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
819 if (! data) signal_error (Qgui_error, "no menu", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 menu_id = new_lwlib_id ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 menu = lw_create_widget ("popup", "popup" /* data->name */, menu_id, data,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 parent, 1, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 popup_menu_selection_callback,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 popup_menu_down_callback);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 free_popup_widget_value_tree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 gcpro_popup_callbacks (menu_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 /* Setting zmacs-region-stays is necessary here because executing a command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 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
832 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
833 sequence of magic-events (destined for the popup-menu widget) to begin.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 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
835 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
836
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 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
838 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
839 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
840 command.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
841 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 if (zmacs_regions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 zmacs_region_stays = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 popup_up_p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 lw_popup_menu (menu, &xev);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 /* this speeds up display of pop-up menus */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 XFlush (XtDisplay (parent));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
852
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
853 #if defined(LWLIB_MENUBARS_LUCID)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
854 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
855 menu_move_up (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
856 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
857 widget_value *current = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
858 widget_value *entries = lw_get_entries (True);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
859 widget_value *prev = NULL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
860
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
861 while (entries != current)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
862 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
863 if (entries->name /*&& entries->enabled*/) prev = entries;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
864 entries = entries->next;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
865 assert (entries);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
866 }
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 if (!prev)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
869 /* move to last item */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
870 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
871 while (entries->next)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
872 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
873 if (entries->name /*&& entries->enabled*/) prev = entries;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
874 entries = entries->next;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
875 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
876 if (prev)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
877 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
878 if (entries->name /*&& entries->enabled*/)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
879 prev = entries;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
880 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
881 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
882 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
883 /* no selectable items in this menu, pop up to previous level */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
884 lw_pop_menu ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
885 return;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
886 }
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 lw_set_item (prev);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
889 }
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 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
892 menu_move_down (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
893 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
894 widget_value *current = lw_get_entries (False);
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
895 widget_value *new_ = current;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
896
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
897 while (new_->next)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
898 {
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
899 new_ = new_->next;
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
900 if (new_->name /*&& new_->enabled*/) break;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
901 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
902
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
903 if (new_==current||!(new_->name/*||new_->enabled*/))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
904 {
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
905 new_ = lw_get_entries (True);
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
906 while (new_!=current)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
907 {
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
908 if (new_->name /*&& new_->enabled*/) break;
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
909 new_ = new_->next;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
910 }
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
911 if (new_==current&&!(new_->name /*|| new_->enabled*/))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
912 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
913 lw_pop_menu ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
914 return;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
915 }
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
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2500
diff changeset
918 lw_set_item (new_);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
919 }
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 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
922 menu_move_left (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
923 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
924 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
925 int l = level;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
926 widget_value *current;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
927
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
928 while (level-- >= 3)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
929 lw_pop_menu ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
930
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
931 menu_move_up ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
932 current = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
933 if (l > 2 && current->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
934 lw_push_menu (current->contents);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
935 }
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 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
938 menu_move_right (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
939 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
940 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
941 int l = level;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
942 widget_value *current;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
943
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
944 while (level-- >= 3)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
945 lw_pop_menu ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
946
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
947 menu_move_down ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
948 current = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
949 if (l > 2 && current->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
950 lw_push_menu (current->contents);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
951 }
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 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
954 menu_select_item (widget_value *val)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
955 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
956 if (val == NULL)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
957 val = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
958
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
959 /* is match a submenu? */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
960
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
961 if (val->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
962 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
963 /* enter the submenu */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
964
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
965 lw_set_item (val);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
966 lw_push_menu (val->contents);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
967 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
968 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
969 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
970 /* Execute the menu entry by calling the menu's `select'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
971 callback function
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
972 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
973 lw_kill_menus (val);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
974 }
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 Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
978 command_builder_operate_menu_accelerator (struct command_builder *builder)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
979 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
980 /* this function can GC */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
981
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
982 struct console *con = XCONSOLE (Vselected_console);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
983 Lisp_Object evee = builder->most_current_event;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
984 Lisp_Object binding;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
985 widget_value *entries;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
986
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
987 extern int lw_menu_accelerate; /* lwlib.c */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
988
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
989 #if 0
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
990 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
991 int i;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
992 Lisp_Object t;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
993
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
994 t = builder->current_events;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
995 i = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
996 while (!NILP (t))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
997 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
998 i++;
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
999 write_fmt_string (Qexternal_debugging_output, "OPERATE (%d): ",i);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1000 print_internal (t, Qexternal_debugging_output, 1);
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4528
diff changeset
1001 write_ascstring (Qexternal_debugging_output, "\n");
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1002 t = XEVENT_NEXT (t);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1003 }
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 #endif /* 0 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1006
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1007 /* menu accelerator keys don't go into keyboard macros */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1008 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1009 con->kbd_macro_ptr = con->kbd_macro_end;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1010
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1011 /* don't echo menu accelerator keys */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1012 /*reset_key_echo (builder, 1);*/
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1013
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1014 if (!lw_menu_accelerate)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1015 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1016 /* `convert' mouse display to keyboard display
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1017 by entering the open submenu
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1018 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1019 entries = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1020 if (entries->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1021 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1022 lw_push_menu (entries->contents);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1023 lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1024 }
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 /* compare event to the current menu accelerators */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1028
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1029 entries=lw_get_entries (True);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1030
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1031 while (entries)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1032 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1033 Lisp_Object accel;
5013
ae48681c47fa changes to VOID_TO_LISP et al.
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
1034 accel = GET_LISP_FROM_VOID (entries->accel);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1035 if (entries->name && !NILP (accel))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1036 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
1037 if (event_matches_key_specifier_p (evee, accel))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1038 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1039 /* a match! */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1040
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1041 menu_select_item (entries);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1042
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1043 if (lw_menu_active) lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1044
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1045 reset_this_command_keys (Vselected_console, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1046 /*reset_command_builder_event_chain (builder);*/
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1047 return Vmenu_accelerator_map;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1048 }
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 entries = entries->next;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1051 }
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 /* try to look up event in menu-accelerator-map */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1054
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1055 binding = event_binding_in (evee, Vmenu_accelerator_map, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1056
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1057 if (NILP (binding))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1058 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1059 /* beep at user for undefined key */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1060 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1061 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1062 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1063 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1064 if (EQ (binding, Qmenu_quit))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1065 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1066 /* turn off menus and set quit flag */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1067 lw_kill_menus (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1068 Vquit_flag = Qt;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1069 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1070 else if (EQ (binding, Qmenu_up))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1071 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1072 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1073 if (level > 2)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1074 menu_move_up ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1075 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1076 else if (EQ (binding, Qmenu_down))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1077 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1078 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1079 if (level > 2)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1080 menu_move_down ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1081 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1082 menu_select_item (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1083 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1084 else if (EQ (binding, Qmenu_left))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1085 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1086 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1087 if (level > 3)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1088 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1089 lw_pop_menu ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1090 lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1091 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1092 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1093 menu_move_left ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1094 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1095 else if (EQ (binding, Qmenu_right))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1096 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1097 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1098 if (level > 2 &&
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1099 lw_get_entries (False)->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1100 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1101 widget_value *current = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1102 if (current->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1103 menu_select_item (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1104 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1105 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1106 menu_move_right ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1107 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1108 else if (EQ (binding, Qmenu_select))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1109 menu_select_item (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1110 else if (EQ (binding, Qmenu_escape))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1111 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1112 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1113
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1114 if (level > 2)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1115 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1116 lw_pop_menu ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1117 lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1118 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1119 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1120 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1121 /* turn off menus quietly */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1122 lw_kill_menus (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1123 }
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 else if (KEYMAPP (binding))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1126 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1127 /* prefix key */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1128 reset_this_command_keys (Vselected_console, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1129 /*reset_command_builder_event_chain (builder);*/
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1130 return binding;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1131 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1132 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1133 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1134 /* turn off menus and execute binding */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1135 lw_kill_menus (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1136 reset_this_command_keys (Vselected_console, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1137 /*reset_command_builder_event_chain (builder);*/
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1138 return binding;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1139 }
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 if (lw_menu_active) lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1143
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1144 reset_this_command_keys (Vselected_console, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1145 /*reset_command_builder_event_chain (builder);*/
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1146
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1147 return Vmenu_accelerator_map;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1148 }
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 static Lisp_Object
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1918
diff changeset
1151 menu_accelerator_junk_on_error (Lisp_Object errordata,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1918
diff changeset
1152 Lisp_Object UNUSED (ignored))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1153 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1154 Vmenu_accelerator_prefix = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1155 Vmenu_accelerator_modifiers = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1156 Vmenu_accelerator_enabled = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1157 if (!NILP (errordata))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1158 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1159 /* #### This should call
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1160 (with-output-to-string (display-error errordata))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1161 but that stuff is all in Lisp currently. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1162 warn_when_safe_lispobj
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1163 (Qerror, Qwarning,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1164 emacs_sprintf_string_lisp
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1165 ("%s: %s", Qnil, 2,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1166 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
1167 errordata));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1168 }
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 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1171 }
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 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1174 menu_accelerator_safe_compare (Lisp_Object event0)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1175 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1176 if (CONSP (Vmenu_accelerator_prefix))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1177 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1178 Lisp_Object t;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1179 t=Vmenu_accelerator_prefix;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1180 while (!NILP (t)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1181 && !NILP (event0)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
1182 && event_matches_key_specifier_p (event0, Fcar (t)))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1183 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1184 t = Fcdr (t);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1185 event0 = XEVENT_NEXT (event0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1186 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1187 if (!NILP (t))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1188 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1189 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1190 else if (NILP (event0))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1191 return Qnil;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
1192 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
1193 event0 = XEVENT_NEXT (event0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1194 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1195 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1196 return event0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1197 }
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 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1200 menu_accelerator_safe_mod_compare (Lisp_Object cons)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1201 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
1202 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
1203 : Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1204 }
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 Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1207 command_builder_find_menu_accelerator (struct command_builder *builder)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1208 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1209 /* this function can GC */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1210 Lisp_Object event0 = builder->current_events;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1211 struct console *con = XCONSOLE (Vselected_console);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1212 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1213 Widget menubar_widget;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1214
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1215 /* compare entries in event0 against the menu prefix */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1216
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1217 if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) ||
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1218 XEVENT (event0)->event_type != key_press_event)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1219 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1220
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1221 if (!NILP (Vmenu_accelerator_prefix))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1222 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1223 event0 = condition_case_1 (Qerror,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1224 menu_accelerator_safe_compare,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1225 event0,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1226 menu_accelerator_junk_on_error,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1227 Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1228 }
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 if (NILP (event0))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1231 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1232
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1233 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1234 if (menubar_widget
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1235 && CONSP (Vmenu_accelerator_modifiers))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1236 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1237 Lisp_Object fake = Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1238 Lisp_Object last = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1239 struct gcpro gcpro1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1240 Lisp_Object matchp;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1241
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1242 widget_value *val;
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
1243 LWLIB_ID id = FRAME_X_MENUBAR_ID (f);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1244
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1245 val = lw_get_all_values (id);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1246 if (val)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1247 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1248 val = val->contents;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1249
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1250 fake = Fcopy_sequence (Vmenu_accelerator_modifiers);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1251 last = fake;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1252
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1253 while (!NILP (Fcdr (last)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1254 last = Fcdr (last);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1255
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1256 Fsetcdr (last, Fcons (Qnil, Qnil));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1257 last = Fcdr (last);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1258 }
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 fake = Fcons (Qnil, fake);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1261
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1262 GCPRO1 (fake);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1263
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1264 while (val)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1265 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1266 Lisp_Object accel;
5013
ae48681c47fa changes to VOID_TO_LISP et al.
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
1267 accel = GET_LISP_FROM_VOID (val->accel);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1268 if (val->name && !NILP (accel))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1269 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1270 Fsetcar (last, accel);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1271 Fsetcar (fake, event0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1272 matchp = condition_case_1 (Qerror,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1273 menu_accelerator_safe_mod_compare,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1274 fake,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1275 menu_accelerator_junk_on_error,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1276 Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1277 if (!NILP (matchp))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1278 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1279 /* we found one! */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1280
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1281 lw_set_menu (menubar_widget, val);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1282 /* yah - yet another hack.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1283 pretend emacs timestamp is the same as an X timestamp,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1284 which for the moment it is. (read events.h)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1285 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1286 lw_map_menu (XEVENT (event0)->timestamp);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1287
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1288 if (val->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1289 lw_push_menu (val->contents);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1290
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1291 lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1292
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1293 /* menu accelerator keys don't go into keyboard macros */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1294 if (!NILP (con->defining_kbd_macro)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1295 && NILP (Vexecuting_macro))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1296 con->kbd_macro_ptr = con->kbd_macro_end;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1297
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1298 /* don't echo menu accelerator keys */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1299 /*reset_key_echo (builder, 1);*/
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1300 reset_this_command_keys (Vselected_console, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1301 UNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1302
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1303 return Vmenu_accelerator_map;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1304 }
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 val = val->next;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1308 }
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 UNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1311 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1312 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1313 }
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 int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1316 x_kludge_lw_menu_active (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1317 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1318 return lw_menu_active;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1319 }
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 DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1322 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
1323 or by actions defined in menu-accelerator-map.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1324 */
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 struct console *con = XCONSOLE (Vselected_console);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1328 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1329 LWLIB_ID id;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1330 widget_value *val;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1331
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
1332 if (!FRAME_X_MENUBAR_ID (f))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1333 invalid_argument ("Frame has no menubar", Qunbound);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1334
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1333
diff changeset
1335 id = FRAME_X_MENUBAR_ID (f);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1336 val = lw_get_all_values (id);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1337 val = val->contents;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1338 lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1339 lw_map_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1340
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1341 lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1342
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1343 /* menu accelerator keys don't go into keyboard macros */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1344 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1345 con->kbd_macro_ptr = con->kbd_macro_end;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1346
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1347 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1348 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1349 #endif /* LWLIB_MENUBARS_LUCID */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1350
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1351
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 syms_of_menubar_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1355 #if defined(LWLIB_MENUBARS_LUCID)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1356 DEFSUBR (Faccelerate_menu);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1357 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 }
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 console_type_create_menubar_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 CONSOLE_HAS_METHOD (x, update_frame_menubars);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 CONSOLE_HAS_METHOD (x, free_frame_menubars);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 CONSOLE_HAS_METHOD (x, popup_menu);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 }
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 reinit_vars_of_menubar_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 last_popup_menu_selection_callback_id = (LWLIB_ID) -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 }
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 vars_of_menubar_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 #if defined (LWLIB_MENUBARS_LUCID)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 Fprovide (intern ("lucid-menubars"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 #elif defined (LWLIB_MENUBARS_MOTIF)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 Fprovide (intern ("motif-menubars"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 #elif defined (LWLIB_MENUBARS_ATHENA)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 Fprovide (intern ("athena-menubars"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 }