Mercurial > hg > xemacs-beta
annotate src/menubar-gtk.c @ 4677:8f1ee2d15784
Support full Common Lisp multiple values in C.
lisp/ChangeLog
2009-08-11 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el :
Update this file to support full C-level multiple values. This
involves:
-- Four new bytecodes, and special compiler functions to compile
multiple-value-call, multiple-value-list-internal, values,
values-list, and, since it now needs to pass back multiple values
and is a special form, throw.
-- There's a new compiler variable, byte-compile-checks-on-load,
which is a list of forms that are evaluated at the very start of a
file, with an error thrown if any of them give nil.
-- The header is now inserted *after* compilation, giving a chance
for the compilation process to influence what those checks
are. There is still a check done before compilation for non-ASCII
characters, to try to turn off dynamic docstrings if appopriate,
in `byte-compile-maybe-reset-coding'.
Space is reserved for checks; comments describing the version of
the byte compiler generating the file are inserted if space
remains for them.
* bytecomp.el (byte-compile-version):
Update this, we're a newer version of the byte compiler.
* byte-optimize.el (byte-optimize-funcall):
Correct a comment.
* bytecomp.el (byte-compile-lapcode):
Discard the arg with byte-multiple-value-call.
* bytecomp.el (byte-compile-checks-and-comments-space):
New variable, describe how many octets to reserve for checks at
the start of byte-compiled files.
* cl-compat.el:
Remove the fake multiple-value implementation. Have the functions
that use it use the real multiple-value implementation instead.
* cl-macs.el (cl-block-wrapper, cl-block-throw):
Revise the byte-compile properties of these symbols to work now
we've made throw into a special form; keep the byte-compile
properties as anonymous lambdas, since we don't have docstrings
for them.
* cl-macs.el (multiple-value-bind, multiple-value-setq)
(multiple-value-list, nth-value):
Update these functions to work with the C support for multiple
values.
* cl-macs.el (values):
Modify the setf handler for this to call
#'multiple-value-list-internal appropriately.
* cl-macs.el (cl-setf-do-store):
If the store form is a cons, treat it specially as wrapping the
store value.
* cl.el (cl-block-wrapper):
Make this an alias of #'and, not #'identity, since it needs to
pass back multiple values.
* cl.el (multiple-value-apply):
We no longer support this, mark it obsolete.
* lisp-mode.el (eval-interactive-verbose):
Remove a useless space in the docstring.
* lisp-mode.el (eval-interactive):
Update this function and its docstring. It now passes back a list,
basically wrapping any eval calls with multiple-value-list. This
allows multiple values to be printed by default in *scratch*.
* lisp-mode.el (prin1-list-as-multiple-values):
New function, printing a list as multiple values in the manner of
Bruno Haible's clisp, separating each entry with " ;\n".
* lisp-mode.el (eval-last-sexp):
Call #'prin1-list-as-multiple-values on the return value of
#'eval-interactive.
* lisp-mode.el (eval-defun):
Call #'prin1-list-as-multiple-values on the return value of
#'eval-interactive.
* mouse.el (mouse-eval-sexp):
Deal with lists corresponding to multiple values from
#'eval-interactive. Call #'cl-prettyprint, which is always
available, instead of sometimes calling #'pprint and sometimes
falling back to prin1.
* obsolete.el (obsolete-throw):
New function, called from eval.c when #'funcall encounters an
attempt to call #'throw (now a special form) as a function. Only
needed for compatibility with 21.4 byte-code.
man/ChangeLog addition:
2009-08-11 Aidan Kehoe <kehoea@parhasard.net>
* cl.texi (Organization):
Remove references to the obsolete multiple-value emulating code.
src/ChangeLog addition:
2009-08-11 Aidan Kehoe <kehoea@parhasard.net>
* bytecode.c (enum Opcode /* Byte codes */):
Add four new bytecodes, to deal with multiple values.
(POP_WITH_MULTIPLE_VALUES): New macro.
(POP): Modify this macro to ignore multiple values.
(DISCARD_PRESERVING_MULTIPLE_VALUES): New macro.
(DISCARD): Modify this macro to ignore multiple values.
(TOP_WITH_MULTIPLE_VALUES): New macro.
(TOP_ADDRESS): New macro.
(TOP): Modify this macro to ignore multiple values.
(TOP_LVALUE): New macro.
(Bcall): Ignore multiple values where appropriate.
(Breturn): Pass back multiple values.
(Bdup): Preserve multiple values.
Use TOP_LVALUE with most bytecodes that assign anything to
anything.
(Bbind_multiple_value_limits, Bmultiple_value_call,
Bmultiple_value_list_internal, Bthrow): Implement the new
bytecodes.
(Bgotoifnilelsepop, Bgotoifnonnilelsepop, BRgotoifnilelsepop,
BRgotoifnonnilelsepop):
Discard any multiple values.
* callint.c (Fcall_interactively):
Ignore multiple values when calling #'eval, in two places.
* device-x.c (x_IO_error_handler):
* macros.c (pop_kbd_macro_event):
* eval.c (Fsignal):
* eval.c (flagged_a_squirmer):
Call throw_or_bomb_out, not Fthrow, now that the latter is a
special form.
* eval.c:
Make Qthrow, Qobsolete_throw available as symbols.
Provide multiple_value_current_limit, multiple-values-limit (the
latter as specified by Common Lisp.
* eval.c (For):
Ignore multiple values when comparing with Qnil, but pass any
multiple values back for the last arg.
* eval.c (Fand):
Ditto.
* eval.c (Fif):
Ignore multiple values when examining the result of the
condition.
* eval.c (Fcond):
Ignore multiple values when comparing what the clauses give, but
pass them back if a clause gave non-nil.
* eval.c (Fprog2):
Never pass back multiple values.
* eval.c (FletX, Flet):
Ignore multiple when evaluating what exactly symbols should be
bound to.
* eval.c (Fwhile):
Ignore multiple values when evaluating the test.
* eval.c (Fsetq, Fdefvar, Fdefconst):
Ignore multiple values.
* eval.c (Fthrow):
Declare this as a special form; ignore multiple values for TAG,
preserve them for VALUE.
* eval.c (throw_or_bomb_out):
Make this available to other files, now Fthrow is a special form.
* eval.c (Feval):
Ignore multiple values when calling a compiled function, a
non-special-form subr, or a lambda expression.
* eval.c (Ffuncall):
If we attempt to call #'throw (now a special form) as a function,
don't error, call #'obsolete-throw instead.
* eval.c (make_multiple_value, multiple_value_aset)
(multiple_value_aref, print_multiple_value, mark_multiple_value)
(size_multiple_value):
Implement the multiple_value type. Add a long comment describing
our implementation.
* eval.c (bind_multiple_value_limits):
New function, used by the bytecode and by #'multiple-value-call,
#'multiple-value-list-internal.
* eval.c (multiple_value_call):
New function, used by the bytecode and #'multiple-value-call.
* eval.c (Fmultiple_value_call):
New special form.
* eval.c (multiple_value_list_internal):
New function, used by the byte code and
#'multiple-value-list-internal.
* eval.c (Fmultiple_value_list_internal, Fmultiple_value_prog1):
New special forms.
* eval.c (Fvalues, Fvalues_list):
New Lisp functions.
* eval.c (values2):
New function, for C code returning multiple values.
* eval.c (syms_of_eval):
Make our new Lisp functions and symbols available.
* eval.c (multiple-values-limit):
Make this available to Lisp.
* event-msw.c (dde_eval_string):
* event-stream.c (execute_help_form):
* glade.c (connector):
* glyphs-widget.c (glyph_instantiator_to_glyph):
* glyphs.c (evaluate_xpm_color_symbols):
* gui-x.c (wv_set_evalable_slot, button_item_to_widget_value):
* gui.c (gui_item_value, gui_item_display_flush_left):
* lread.c (check_if_suppressed):
* menubar-gtk.c (menu_convert, menu_descriptor_to_widget_1):
* menubar-msw.c (populate_menu_add_item):
* print.c (Fwith_output_to_temp_buffer):
* symbols.c (Fsetq_default):
Ignore multiple values when calling Feval.
* symeval.h:
Add the header declarations necessary for the multiple-values
implementation.
* inline.c:
#include symeval.h, now that it has some inline functions.
* lisp.h:
Update Fthrow's declaration. Make throw_or_bomb_out available to
all files.
* lrecord.h (enum lrecord_type):
Add the multiple_value type here.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 16 Aug 2009 20:55:49 +0100 |
| parents | 3d8143fc88e1 |
| children | 4aebb0131297 |
| rev | line source |
|---|---|
| 2081 | 1 /* Implements an elisp-programmable menubar -- Gtk interface. |
| 462 | 2 Copyright (C) 1993, 1994 Free Software Foundation, Inc. |
| 3 Copyright (C) 1995 Tinker Systems and INS Engineering Corp. | |
| 1346 | 4 Copyright (C) 2002, 2003 Ben Wing. |
| 462 | 5 |
| 6 This file is part of XEmacs. | |
| 7 | |
| 8 XEmacs is free software; you can redistribute it and/or modify it | |
| 9 under the terms of the GNU General Public License as published by the | |
| 10 Free Software Foundation; either version 2, or (at your option) any | |
| 11 later version. | |
| 12 | |
| 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 19 along with XEmacs; see the file COPYING. If not, write to | |
| 20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 21 Boston, MA 02111-1307, USA. */ | |
| 22 | |
| 23 /* Synched up with: Not in FSF. */ | |
| 24 | |
| 25 /* created 16-dec-91 by jwz */ | |
| 26 | |
| 27 #include <config.h> | |
| 28 #include "lisp.h" | |
| 29 | |
| 30 #include "buffer.h" | |
| 31 #include "commands.h" /* zmacs_regions */ | |
| 1346 | 32 #include "device-impl.h" |
| 462 | 33 #include "events.h" |
| 872 | 34 #include "frame-impl.h" |
| 35 #include "gui.h" | |
| 462 | 36 #include "opaque.h" |
| 37 #include "window.h" | |
| 876 | 38 #include "window-impl.h" |
| 462 | 39 |
| 872 | 40 #include "console-gtk-impl.h" |
| 41 #include "ui-gtk.h" | |
| 876 | 42 #include "menubar.h" |
| 872 | 43 |
| 462 | 44 #ifdef HAVE_GNOME |
| 45 #include <libgnomeui/libgnomeui.h> | |
| 46 #endif | |
| 47 | |
| 48 #define MENUBAR_TYPE 0 | |
| 49 #define SUBMENU_TYPE 1 | |
| 50 #define POPUP_TYPE 2 | |
| 51 | |
| 2081 | 52 static GtkWidget *menu_descriptor_to_widget_1 (Lisp_Object descr, GtkAccelGroup* accel_group); |
| 462 | 53 |
| 1346 | 54 #define FRAME_GTK_MENUBAR_DATA(f) (FRAME_GTK_DATA (f)->menubar_data) |
| 55 #define XFRAME_GTK_MENUBAR_DATA_LASTBUFF(f) XCAR (FRAME_GTK_MENUBAR_DATA (f)) | |
| 56 #define XFRAME_GTK_MENUBAR_DATA_UPTODATE(f) XCDR (FRAME_GTK_MENUBAR_DATA (f)) | |
| 462 | 57 |
| 58 | |
| 59 /* This is a bogus subclass of GtkMenuBar so that the menu never tries | |
| 60 ** to be bigger than the text widget. This prevents weird resizing | |
| 61 ** when jumping around between buffers with radically different menu | |
| 62 ** sizes. | |
| 63 */ | |
| 64 | |
| 65 #define GTK_XEMACS_MENUBAR(obj) GTK_CHECK_CAST (obj, gtk_xemacs_menubar_get_type (), GtkXEmacsMenubar) | |
| 66 #define GTK_XEMACS_MENUBAR_CLASS(klass) GTK_CHECK_CLASS_CAST (klass, gtk_xemacs_menubar_get_type (), GtkXEmacsMenubarClass) | |
| 67 #define GTK_IS_XEMACS_MENUBAR(obj) GTK_CHECK_TYPE (obj, gtk_xemacs_menubar_get_type ()) | |
| 68 #define GTK_XEMACS_MENUBAR_FRAME(obj) GTK_XEMACS_MENUBAR (obj)->f | |
| 69 | |
| 70 typedef struct _GtkXEmacsMenubar GtkXEmacsMenubar; | |
| 71 typedef struct _GtkXEmacsMenubarClass GtkXEmacsMenubarClass; | |
| 72 | |
| 73 struct _GtkXEmacsMenubar | |
| 74 { | |
| 75 GtkMenuBar menu; | |
| 76 struct frame *frame; | |
| 77 }; | |
| 78 | |
| 79 struct _GtkXEmacsMenubarClass | |
| 80 { | |
| 81 GtkMenuBarClass parent_class; | |
| 82 }; | |
| 83 | |
| 84 guint gtk_xemacs_menubar_get_type (void); | |
| 85 GtkWidget *gtk_xemacs_menubar_new (struct frame *f); | |
| 86 | |
| 87 static void gtk_xemacs_menubar_class_init (GtkXEmacsMenubarClass *klass); | |
| 88 static void gtk_xemacs_menubar_init (GtkXEmacsMenubar *xemacs); | |
| 89 static void gtk_xemacs_menubar_size_request (GtkWidget *widget, GtkRequisition *requisition); | |
| 90 | |
| 91 guint | |
| 92 gtk_xemacs_menubar_get_type (void) | |
| 93 { | |
| 94 static guint xemacs_menubar_type; | |
| 95 | |
| 96 if (!xemacs_menubar_type) | |
| 97 { | |
| 98 static const GtkTypeInfo xemacs_menubar_info = | |
| 99 { | |
| 100 "GtkXEmacsMenubar", | |
| 101 sizeof (GtkXEmacsMenubar), | |
| 102 sizeof (GtkXEmacsMenubarClass), | |
| 103 (GtkClassInitFunc) gtk_xemacs_menubar_class_init, | |
| 104 (GtkObjectInitFunc) gtk_xemacs_menubar_init, | |
| 105 /* reserved_1 */ NULL, | |
| 106 /* reserved_2 */ NULL, | |
| 107 (GtkClassInitFunc) NULL, | |
| 108 }; | |
| 109 | |
| 110 xemacs_menubar_type = gtk_type_unique (gtk_menu_bar_get_type (), &xemacs_menubar_info); | |
| 111 } | |
| 112 | |
| 113 return xemacs_menubar_type; | |
| 114 } | |
| 115 | |
| 2081 | 116 static GtkWidgetClass *menubar_parent_class; |
| 462 | 117 |
| 1416 | 118 static void |
| 119 gtk_xemacs_menubar_class_init (GtkXEmacsMenubarClass *klass) | |
| 462 | 120 { |
| 121 GtkWidgetClass *widget_class; | |
| 122 | |
| 123 widget_class = (GtkWidgetClass*) klass; | |
| 2081 | 124 menubar_parent_class = (GtkWidgetClass *) gtk_type_class (gtk_menu_bar_get_type ()); |
| 462 | 125 |
| 126 widget_class->size_request = gtk_xemacs_menubar_size_request; | |
| 127 } | |
| 128 | |
| 1416 | 129 static void |
| 2286 | 130 gtk_xemacs_menubar_init (GtkXEmacsMenubar *UNUSED (xemacs)) |
| 462 | 131 { |
| 132 } | |
| 133 | |
| 1416 | 134 static void |
| 135 gtk_xemacs_menubar_size_request (GtkWidget *widget, GtkRequisition *requisition) | |
| 462 | 136 { |
| 137 GtkXEmacsMenubar *x = GTK_XEMACS_MENUBAR (widget); | |
| 138 GtkRequisition frame_size; | |
| 139 | |
| 2081 | 140 menubar_parent_class->size_request (widget, requisition); |
| 462 | 141 |
| 142 /* #### BILL! | |
| 143 ** We should really only do this if the menu has not been detached! | |
| 144 ** | |
| 145 ** WMP 9/9/2000 | |
| 146 */ | |
| 147 | |
| 148 gtk_widget_size_request (FRAME_GTK_TEXT_WIDGET (x->frame), &frame_size); | |
| 149 | |
| 150 requisition->width = frame_size.width; | |
| 151 } | |
| 152 | |
| 153 GtkWidget * | |
| 154 gtk_xemacs_menubar_new (struct frame *f) | |
| 155 { | |
| 2054 | 156 GtkXEmacsMenubar *menubar = (GtkXEmacsMenubar*) gtk_type_new (gtk_xemacs_menubar_get_type ()); |
| 462 | 157 |
| 158 menubar->frame = f; | |
| 159 | |
| 160 return (GTK_WIDGET (menubar)); | |
| 161 } | |
| 162 | |
| 2081 | 163 /* |
| 164 * Label with XEmacs accelerator character support. | |
| 165 * | |
| 166 * The default interfaces to GtkAccelLabel does not understand XEmacs | |
| 167 * keystroke printing conventions, nor is it convenient in the places where is | |
| 168 * it needed. This subclass provides an alternative interface more suited to | |
| 169 * XEmacs needs but does not add new functionality. | |
| 170 */ | |
| 171 #define GTK_TYPE_XEMACS_ACCEL_LABEL (gtk_xemacs_accel_label_get_type ()) | |
| 172 #define GTK_XEMACS_ACCEL_LABEL(obj) (GTK_CHECK_CAST ((obj), GTK_TYPE_ACCEL_LABEL, GtkXEmacsAccelLabel)) | |
| 173 #define GTK_XEMACS_ACCEL_LABEL_CLASS(klass) (GTK_CHECK_CLASS_CAST ((klass), GTK_TYPE_ACCEL_LABEL, GtkXEmacsAccelLabelClass)) | |
| 174 #define GTK_IS_XEMACS_ACCEL_LABEL(obj) (GTK_CHECK_TYPE ((obj), GTK_TYPE_XEMACS_ACCEL_LABEL)) | |
| 175 #define GTK_IS_XEMACS_ACCEL_LABEL_CLASS(klass) (GTK_CHECK_CLASS_TYPE ((klass), GTK_TYPE_XEMACS_ACCEL_LABEL)) | |
| 176 | |
| 177 typedef struct _GtkXEmacsAccelLabel GtkXEmacsAccelLabel; | |
| 178 typedef struct _GtkXEmacsAccelLabelClass GtkXEmacsAccelLabelClass; | |
| 179 | |
| 180 /* Instance structure. No additional fields required. */ | |
| 181 struct _GtkXEmacsAccelLabel | |
| 182 { | |
| 183 GtkAccelLabel label; | |
| 184 }; | |
| 185 | |
| 186 /* Class structure. No additional fields required. */ | |
| 187 struct _GtkXEmacsAccelLabelClass | |
| 188 { | |
| 189 GtkAccelLabelClass parent_class; | |
| 190 }; | |
| 191 | |
| 192 static GtkType gtk_xemacs_accel_label_get_type(void); | |
| 193 static GtkWidget* gtk_xemacs_accel_label_new(const gchar *string); | |
| 194 static void gtk_xemacs_set_accel_keys(GtkXEmacsAccelLabel* l, | |
| 195 Lisp_Object keys); | |
| 196 static void gtk_xemacs_accel_label_class_init(GtkXEmacsAccelLabelClass *klass); | |
| 197 static void gtk_xemacs_accel_label_init(GtkXEmacsAccelLabel *xemacs); | |
| 198 | |
| 199 static GtkType | |
| 200 gtk_xemacs_accel_label_get_type(void) | |
| 201 { | |
| 202 static GtkType xemacs_accel_label_type = 0; | |
| 203 | |
| 204 if (!xemacs_accel_label_type) | |
| 205 { | |
| 206 static const GtkTypeInfo xemacs_accel_label_info = | |
| 207 { | |
| 208 "GtkXEmacsAccelLabel", | |
| 209 sizeof (GtkXEmacsAccelLabel), | |
| 210 sizeof (GtkXEmacsAccelLabelClass), | |
| 211 (GtkClassInitFunc) gtk_xemacs_accel_label_class_init, | |
| 212 (GtkObjectInitFunc) gtk_xemacs_accel_label_init, | |
| 213 /* reserved_1 */ NULL, | |
| 214 /* reserved_2 */ NULL, | |
| 215 (GtkClassInitFunc) NULL, | |
| 216 }; | |
| 217 | |
| 218 xemacs_accel_label_type = gtk_type_unique (gtk_accel_label_get_type(), &xemacs_accel_label_info); | |
| 219 } | |
| 220 | |
| 221 return xemacs_accel_label_type; | |
| 222 } | |
| 223 | |
| 224 static void | |
| 2286 | 225 gtk_xemacs_accel_label_class_init(GtkXEmacsAccelLabelClass *UNUSED (klass)) |
| 2081 | 226 { |
| 227 /* Nothing to do. */ | |
| 228 } | |
| 229 | |
| 230 static void | |
| 2286 | 231 gtk_xemacs_accel_label_init(GtkXEmacsAccelLabel *UNUSED (xemacs)) |
| 2081 | 232 { |
| 233 /* Nothing to do. */ | |
| 234 } | |
| 235 | |
| 236 static GtkWidget* | |
| 237 gtk_xemacs_accel_label_new (const gchar *string) | |
| 238 { | |
| 239 GtkXEmacsAccelLabel *xemacs_accel_label; | |
| 240 | |
| 241 xemacs_accel_label = (GtkXEmacsAccelLabel*) gtk_type_new (GTK_TYPE_XEMACS_ACCEL_LABEL); | |
| 242 | |
| 243 if (string && *string) | |
| 244 gtk_label_set_text (GTK_LABEL (xemacs_accel_label), string); | |
| 245 | |
| 246 return GTK_WIDGET (xemacs_accel_label); | |
| 247 } | |
| 248 | |
| 249 /* Make the string <keys> the accelerator string for the label. */ | |
| 250 static void | |
| 251 gtk_xemacs_set_accel_keys(GtkXEmacsAccelLabel* l, Lisp_Object keys) | |
| 252 { | |
| 253 g_return_if_fail (l != NULL); | |
| 254 g_return_if_fail (GTK_IS_XEMACS_ACCEL_LABEL (l)); | |
| 255 | |
| 256 /* Disable the standard way of finding the accelerator string for the | |
| 257 label. */ | |
| 258 gtk_accel_label_set_accel_widget (GTK_ACCEL_LABEL(l), NULL); | |
| 259 | |
| 260 /* Set the string straight from the object. */ | |
| 261 if (STRINGP (keys) && XSTRING_LENGTH (keys)) | |
| 262 { | |
| 263 C_STRING_TO_EXTERNAL_MALLOC(XSTRING_DATA (keys), | |
| 264 l->label.accel_string, | |
| 265 Qctext); | |
| 266 } | |
| 267 else | |
| 268 { | |
| 269 /* l->label.accel_string = NULL;*/ | |
| 270 } | |
| 271 } | |
| 272 | |
| 273 | |
| 462 | 274 /* We now return you to your regularly scheduled menus... */ |
| 275 | |
| 276 int dockable_menubar; | |
| 277 | |
| 278 /* #define TEAR_OFF_MENUS */ | |
| 279 | |
| 280 #ifdef TEAR_OFF_MENUS | |
| 281 int tear_off_menus; | |
| 282 #endif | |
| 283 | |
| 284 | |
| 285 /* Converting from XEmacs to GTK representation */ | |
| 286 static Lisp_Object | |
| 2054 | 287 menu_name_to_accelerator (Ibyte *name) |
| 462 | 288 { |
| 289 while (*name) { | |
| 290 if (*name=='%') { | |
| 291 ++name; | |
| 292 if (!(*name)) | |
| 293 return Qnil; | |
| 294 if (*name=='_' && *(name+1)) | |
| 295 { | |
| 2054 | 296 int accelerator = (int) (*(name+1)); |
| 462 | 297 return make_char (tolower (accelerator)); |
| 298 } | |
| 299 } | |
| 300 ++name; | |
| 301 } | |
| 302 return Qnil; | |
| 303 } | |
| 304 | |
| 305 #define XEMACS_MENU_DESCR_TAG "xemacs::menu::description" | |
| 306 #define XEMACS_MENU_FILTER_TAG "xemacs::menu::filter" | |
| 307 #define XEMACS_MENU_GUIID_TAG "xemacs::menu::gui_id" | |
| 308 #define XEMACS_MENU_FIRSTTIME_TAG "xemacs::menu::first_time" | |
| 309 | |
| 310 static void __activate_menu(GtkMenuItem *, gpointer); | |
| 311 | |
| 312 #ifdef TEAR_OFF_MENUS | |
| 313 static void | |
| 2286 | 314 __torn_off_sir(GtkMenuItem *UNUSED (item), gpointer user_data) |
| 462 | 315 { |
| 316 GtkWidget *menu_item = GTK_WIDGET (user_data); | |
| 317 | |
| 318 if (GTK_TEAROFF_MENU_ITEM (item)->torn_off) | |
| 319 { | |
| 320 /* Menu was just torn off */ | |
| 321 GUI_ID id = new_gui_id (); | |
| 322 Lisp_Object menu_desc = Qnil; | |
| 323 GtkWidget *old_submenu = GTK_MENU_ITEM (menu_item)->submenu; | |
| 324 | |
| 826 | 325 menu_desc = VOID_TO_LISP (gtk_object_get_data (GTK_OBJECT (menu_item), XEMACS_MENU_DESCR_TAG)); |
| 462 | 326 |
| 327 /* GCPRO all of our very own */ | |
| 328 gcpro_popup_callbacks (id, menu_desc); | |
| 329 | |
| 330 /* Hide the now detached menu from the attentions of | |
| 331 __activate_menu destroying the old submenu */ | |
| 332 #if 0 | |
| 333 gtk_widget_ref (old_submenu); | |
| 334 gtk_menu_item_set_submenu (GTK_MENU_ITEM (menu_item), gtk_menu_new ()); | |
| 335 gtk_widget_show_all (old_submenu); | |
| 336 #endif | |
| 337 } | |
| 338 } | |
| 339 #endif | |
| 340 | |
| 341 /* This is called when a menu is about to be shown... this is what | |
| 342 does the delayed creation of the menu items. We populate the | |
| 343 submenu and away we go. */ | |
| 344 static void | |
| 2286 | 345 __maybe_destroy (GtkWidget *child, GtkWidget *UNUSED (precious)) |
| 462 | 346 { |
| 347 if (GTK_IS_MENU_ITEM (child) && !GTK_IS_TEAROFF_MENU_ITEM (child)) | |
| 348 { | |
| 349 if (GTK_WIDGET_VISIBLE (child)) | |
| 350 { | |
| 351 /* If we delete the menu item that was 'active' when the | |
| 352 menu was cancelled, GTK gets upset because it tries to | |
| 353 remove the focus rectangle from a (now) dead widget. | |
| 354 | |
| 355 This widget will eventually get killed because it will | |
| 356 not be visible the next time the window is shown. | |
| 357 */ | |
| 358 gtk_widget_set_sensitive (child, FALSE); | |
| 359 gtk_widget_hide_all (child); | |
| 360 } | |
| 361 else | |
| 362 { | |
| 363 gtk_widget_destroy (child); | |
| 364 } | |
| 365 } | |
| 366 } | |
| 367 | |
| 368 /* If user_data != 0x00 then we are using a hook to build the menu. */ | |
| 369 static void | |
| 370 __activate_menu(GtkMenuItem *item, gpointer user_data) | |
| 371 { | |
| 372 Lisp_Object desc; | |
| 373 gpointer force_clear = gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_FIRSTTIME_TAG); | |
| 374 | |
| 375 gtk_object_set_data (GTK_OBJECT (item), XEMACS_MENU_FIRSTTIME_TAG, 0x00); | |
| 376 | |
| 377 /* Delete the old contents of the menu if we are the top level menubar */ | |
| 378 if (GTK_IS_MENU_BAR (GTK_WIDGET (item)->parent) || force_clear) | |
| 379 { | |
| 380 GtkWidget *selected = gtk_menu_get_active (GTK_MENU (item->submenu)); | |
| 381 | |
| 382 gtk_container_foreach (GTK_CONTAINER (item->submenu),(GtkCallback) __maybe_destroy, | |
| 383 selected); | |
| 384 } | |
| 385 else if (gtk_container_children (GTK_CONTAINER (item->submenu))) | |
| 386 { | |
| 387 return; | |
| 388 } | |
| 389 | |
| 826 | 390 desc = VOID_TO_LISP (gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_DESCR_TAG)); |
| 462 | 391 |
| 392 #ifdef TEAR_OFF_MENUS | |
| 393 /* Lets stick in a detacher just for giggles */ | |
| 394 if (tear_off_menus && !gtk_container_children (GTK_CONTAINER (item->submenu))) | |
| 395 { | |
| 396 GtkWidget *w = gtk_tearoff_menu_item_new (); | |
| 397 gtk_widget_show (w); | |
| 398 gtk_menu_append (GTK_MENU (item->submenu), w); | |
| 399 gtk_signal_connect (GTK_OBJECT (w), "activate", GTK_SIGNAL_FUNC (__torn_off_sir), item); | |
| 400 } | |
| 401 #endif | |
| 402 | |
| 403 if (user_data) | |
| 404 { | |
| 405 GUI_ID id = (GUI_ID) gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_GUIID_TAG); | |
| 406 Lisp_Object hook_fn; | |
| 407 struct gcpro gcpro1, gcpro2; | |
| 408 | |
| 826 | 409 hook_fn = VOID_TO_LISP (gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_FILTER_TAG)); |
| 462 | 410 |
| 411 GCPRO2 (desc, hook_fn); | |
| 412 | |
| 413 desc = call1 (hook_fn, desc); | |
| 414 | |
| 415 UNGCPRO; | |
| 416 | |
| 417 ungcpro_popup_callbacks (id); | |
| 418 gcpro_popup_callbacks (id, desc); | |
| 419 } | |
| 420 | |
| 421 /* Build the child widgets */ | |
| 422 for (; !NILP (desc); desc = Fcdr (desc)) | |
| 423 { | |
| 424 GtkWidget *next = NULL; | |
| 425 Lisp_Object child = Fcar (desc); | |
| 426 | |
| 427 if (NILP (child)) /* the partition */ | |
| 428 { | |
| 429 /* Signal an error here? The NILP handling is handled a | |
| 430 layer higher where appropriate */ | |
| 431 } | |
| 432 else | |
| 433 { | |
| 2081 | 434 next = menu_descriptor_to_widget_1 (child, |
| 435 gtk_menu_ensure_uline_accel_group (GTK_MENU (item->submenu))); | |
| 462 | 436 } |
| 437 | |
| 438 if (!next) | |
| 439 { | |
| 440 continue; | |
| 441 } | |
| 442 | |
| 443 gtk_widget_show_all (next); | |
| 444 gtk_menu_append (GTK_MENU (item->submenu), next); | |
| 445 } | |
| 446 } | |
| 447 | |
| 448 /* This is called whenever an item with a GUI_ID associated with it is | |
| 449 destroyed. This allows us to remove the references in gui-gtk.c | |
| 450 that made sure callbacks and such were GCPRO-ed | |
| 451 */ | |
| 452 static void | |
| 453 __remove_gcpro_by_id (gpointer user_data) | |
| 454 { | |
| 455 ungcpro_popup_callbacks ((GUI_ID) user_data); | |
| 456 } | |
| 457 | |
| 458 static void | |
| 2286 | 459 __kill_stupid_gtk_timer (GtkObject *obj, gpointer UNUSED (user_data)) |
| 462 | 460 { |
| 461 GtkMenuItem *mi = GTK_MENU_ITEM (obj); | |
| 462 | |
| 463 if (mi->timer) | |
| 464 { | |
| 465 gtk_timeout_remove (mi->timer); | |
| 466 mi->timer = 0; | |
| 467 } | |
| 468 } | |
| 469 | |
| 2081 | 470 /* Convert the XEmacs menu accelerator representation to Gtk mnemonic form. If |
| 471 no accelerator has been provided, put one at the start of the string (this | |
| 472 mirrors the behaviour under X). This algorithm is also found in | |
| 473 dialog-gtk.el:gtk-popup-convert-underscores. | |
| 474 */ | |
| 462 | 475 static char * |
| 2081 | 476 convert_underscores(const Ibyte *name) |
| 462 | 477 { |
| 2081 | 478 char *rval; |
| 479 int i,j; | |
| 480 int found_accel = FALSE; | |
| 481 int underscores = 0; | |
| 482 | |
| 483 for (i = 0; name[i]; ++i) | |
| 484 if (name[i] == '%' && name[i+1] == '_') | |
| 485 { | |
| 486 found_accel = TRUE; | |
| 487 } | |
| 488 else if (name[i] == '_') | |
| 489 { | |
| 490 underscores++; | |
| 491 } | |
| 492 | |
| 493 /* Allocate space for the original string, plus zero byte plus extra space | |
| 494 for all quoted underscores plus possible additional leading accelerator. */ | |
| 495 rval = (char*) xmalloc_and_zero (qxestrlen(name) + 1 + underscores | |
| 496 + (found_accel ? 0 : 1)); | |
| 497 | |
| 498 if (!found_accel) | |
| 499 rval[0] = '_'; | |
| 500 | |
| 501 for (i = 0, j = (found_accel ? 0 : 1); name[i]; i++) | |
| 502 { | |
| 503 if (name[i]=='%') | |
| 504 { | |
| 505 i++; | |
| 506 if (!(name[i])) | |
| 507 continue; | |
| 508 | |
| 509 if ((name[i] != '_') && (name[i] != '%')) | |
| 510 i--; | |
| 511 | |
| 512 found_accel = TRUE; | |
| 513 } | |
| 514 else if (name[i] == '_') | |
| 515 { | |
| 516 rval[j++] = '_'; | |
| 517 } | |
| 518 | |
| 519 rval[j++] = name[i]; | |
| 520 } | |
| 521 | |
| 522 return rval; | |
| 523 } | |
| 524 | |
| 525 /* Remove the XEmacs menu accellerator representation from a string. */ | |
| 526 static char * | |
| 527 remove_underscores(const Ibyte *name) | |
| 528 { | |
| 529 char *rval = (char*) xmalloc_and_zero (qxestrlen(name) + 1); | |
| 462 | 530 int i,j; |
| 531 | |
| 532 for (i = 0, j = 0; name[i]; i++) | |
| 533 { | |
| 534 if (name[i]=='%') { | |
| 535 i++; | |
| 536 if (!(name[i])) | |
| 537 continue; | |
| 538 | |
| 2081 | 539 if ((name[i] != '_') && (name[i] != '%')) |
| 540 i--; | |
| 541 else | |
| 462 | 542 continue; |
| 543 } | |
| 544 rval[j++] = name[i]; | |
| 545 } | |
| 546 return rval; | |
| 547 } | |
| 548 | |
| 549 /* This converts an entire menu into a GtkMenuItem (with an attached | |
| 550 submenu). A menu is a list of (STRING [:keyword value]+ [DESCR]+) | |
| 551 DESCR is either a list (meaning a submenu), a vector, or nil (if | |
| 552 you include a :filter keyword) */ | |
| 553 static GtkWidget * | |
| 2081 | 554 menu_convert (Lisp_Object desc, GtkWidget *reuse, |
| 555 GtkAccelGroup* menubar_accel_group) | |
| 462 | 556 { |
| 557 GtkWidget *menu_item = NULL; | |
| 558 GtkWidget *submenu = NULL; | |
| 559 Lisp_Object key, val; | |
| 560 Lisp_Object include_p = Qnil, hook_fn = Qnil, config_tag = Qnil; | |
| 561 Lisp_Object active_p = Qt; | |
| 562 Lisp_Object accel; | |
| 563 int included_spec = 0; | |
| 564 int active_spec = 0; | |
| 565 | |
| 566 if (STRINGP (XCAR (desc))) | |
| 567 { | |
| 568 accel = menu_name_to_accelerator (XSTRING_DATA (XCAR (desc))); | |
| 569 | |
| 570 if (!reuse) | |
| 571 { | |
| 2081 | 572 char *temp_menu_name = convert_underscores (XSTRING_DATA (XCAR (desc))); |
| 573 GtkWidget* accel_label = gtk_xemacs_accel_label_new(NULL); | |
| 574 guint accel_key; | |
| 575 | |
| 576 gtk_misc_set_alignment (GTK_MISC (accel_label), 0.0, 0.5); | |
| 577 accel_key = gtk_label_parse_uline (GTK_LABEL (accel_label), temp_menu_name); | |
| 578 | |
| 579 menu_item = gtk_menu_item_new (); | |
| 580 gtk_container_add (GTK_CONTAINER (menu_item), accel_label); | |
| 581 gtk_widget_show (accel_label); | |
| 582 | |
| 583 if (menubar_accel_group) | |
| 584 gtk_widget_add_accelerator (menu_item, | |
| 585 "activate_item", | |
| 586 menubar_accel_group, | |
| 587 accel_key, GDK_MOD1_MASK, | |
| 588 GTK_ACCEL_LOCKED); | |
| 462 | 589 free (temp_menu_name); |
| 590 } | |
| 591 else | |
| 592 { | |
| 593 menu_item = reuse; | |
| 594 } | |
| 595 | |
| 596 submenu = gtk_menu_new (); | |
| 597 gtk_widget_show (menu_item); | |
| 598 gtk_widget_show (submenu); | |
| 599 | |
| 600 if (!reuse) | |
| 601 gtk_signal_connect (GTK_OBJECT (menu_item), "destroy", | |
| 602 GTK_SIGNAL_FUNC (__kill_stupid_gtk_timer), NULL); | |
| 603 | |
| 604 /* Without this sometimes a submenu gets left on the screen - | |
| 605 ** urk | |
| 606 */ | |
| 607 if (GTK_MENU_ITEM (menu_item)->submenu) | |
| 608 { | |
| 609 gtk_widget_destroy (GTK_MENU_ITEM (menu_item)->submenu); | |
| 610 } | |
| 611 | |
| 612 gtk_menu_item_set_submenu (GTK_MENU_ITEM (menu_item), submenu); | |
| 613 | |
| 614 /* We put this bogus menu item in so that GTK does the right | |
| 615 ** thing when the menu is near the screen border. | |
| 616 ** | |
| 617 ** Aug 29, 2000 | |
| 618 */ | |
| 619 { | |
| 620 GtkWidget *bogus_item = gtk_menu_item_new_with_label ("A suitably long label here..."); | |
| 621 | |
| 622 gtk_object_set_data (GTK_OBJECT (menu_item), XEMACS_MENU_FIRSTTIME_TAG, (gpointer)0x01); | |
| 623 gtk_widget_show_all (bogus_item); | |
| 624 gtk_menu_append (GTK_MENU (submenu), bogus_item); | |
| 625 } | |
| 626 | |
| 627 desc = Fcdr (desc); | |
| 628 | |
| 629 while (key = Fcar (desc), KEYWORDP (key)) | |
| 630 { | |
| 631 Lisp_Object cascade = desc; | |
| 632 desc = Fcdr (desc); | |
| 633 if (NILP (desc)) | |
| 563 | 634 sferror ("keyword in menu lacks a value", |
| 462 | 635 cascade); |
| 636 val = Fcar (desc); | |
| 637 desc = Fcdr (desc); | |
| 638 if (EQ (key, Q_included)) | |
| 639 include_p = val, included_spec = 1; | |
| 640 else if (EQ (key, Q_config)) | |
| 641 config_tag = val; | |
| 642 else if (EQ (key, Q_filter)) | |
| 643 hook_fn = val; | |
| 644 else if (EQ (key, Q_active)) | |
| 645 active_p = val, active_spec = 1; | |
| 646 else if (EQ (key, Q_accelerator)) | |
| 647 { | |
| 648 #if 0 | |
| 649 if ( SYMBOLP (val) | |
| 650 || CHARP (val)) | |
| 651 wv->accel = LISP_TO_VOID (val); | |
| 652 else | |
| 563 | 653 invalid_argument ("bad keyboard accelerator", val); |
| 462 | 654 #endif |
| 655 } | |
| 656 else if (EQ (key, Q_label)) | |
| 657 { | |
| 658 /* implement in 21.2 */ | |
| 659 } | |
| 660 else | |
| 563 | 661 invalid_argument ("unknown menu cascade keyword", cascade); |
| 462 | 662 } |
| 663 | |
| 664 gtk_object_set_data (GTK_OBJECT (menu_item), XEMACS_MENU_DESCR_TAG, LISP_TO_VOID (desc)); | |
| 665 gtk_object_set_data (GTK_OBJECT (menu_item), XEMACS_MENU_FILTER_TAG, LISP_TO_VOID (hook_fn)); | |
| 666 | |
| 667 if ((!NILP (config_tag) | |
| 668 && NILP (Fmemq (config_tag, Vmenubar_configuration))) | |
|
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2500
diff
changeset
|
669 || (included_spec && |
|
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2500
diff
changeset
|
670 NILP (IGNORE_MULTIPLE_VALUES (Feval (include_p))))) |
| 462 | 671 { |
| 672 return (NULL); | |
| 673 } | |
| 674 | |
| 675 if (active_spec) | |
|
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2500
diff
changeset
|
676 active_p = IGNORE_MULTIPLE_VALUES (Feval (active_p)); |
| 462 | 677 |
| 678 gtk_widget_set_sensitive (GTK_WIDGET (menu_item), ! NILP (active_p)); | |
| 679 } | |
| 680 else | |
| 681 { | |
| 563 | 682 invalid_argument ("menu name (first element) must be a string", |
| 462 | 683 desc); |
| 684 } | |
| 685 | |
| 686 /* If we are reusing a widget, we need to make sure we clean | |
| 687 ** everything up. | |
| 688 */ | |
| 689 if (reuse) | |
| 690 { | |
| 691 gpointer id = gtk_object_get_data (GTK_OBJECT (reuse), XEMACS_MENU_GUIID_TAG); | |
| 692 | |
| 693 if (id) | |
| 694 { | |
| 695 /* If the menu item had a GUI_ID that means it was a filter menu */ | |
| 696 __remove_gcpro_by_id (id); | |
| 697 gtk_signal_disconnect_by_func (GTK_OBJECT (reuse), | |
| 698 GTK_SIGNAL_FUNC (__activate_menu), | |
| 699 (gpointer) 0x01 ); | |
| 700 } | |
| 701 else | |
| 702 { | |
| 703 gtk_signal_disconnect_by_func (GTK_OBJECT (reuse), | |
| 704 GTK_SIGNAL_FUNC (__activate_menu), | |
| 705 NULL); | |
| 706 } | |
| 707 | |
| 708 GTK_MENU_ITEM (reuse)->right_justify = 0; | |
| 709 } | |
| 710 | |
| 711 if (NILP (hook_fn)) | |
| 712 { | |
| 713 /* Generic menu builder */ | |
| 714 gtk_signal_connect (GTK_OBJECT (menu_item), "activate", | |
| 715 GTK_SIGNAL_FUNC (__activate_menu), | |
| 716 NULL); | |
| 717 } | |
| 718 else | |
| 719 { | |
| 720 GUI_ID id = new_gui_id (); | |
| 721 | |
| 722 gtk_object_set_data (GTK_OBJECT (menu_item), XEMACS_MENU_GUIID_TAG, | |
| 723 (gpointer) id); | |
| 724 | |
| 725 /* Make sure we gcpro the menu descriptions */ | |
| 726 gcpro_popup_callbacks (id, desc); | |
| 727 gtk_object_weakref (GTK_OBJECT (menu_item), __remove_gcpro_by_id, | |
| 728 (gpointer) id); | |
| 729 | |
| 730 gtk_signal_connect (GTK_OBJECT (menu_item), "activate", | |
| 731 GTK_SIGNAL_FUNC (__activate_menu), | |
| 732 (gpointer) 0x01); | |
| 733 } | |
| 734 | |
| 735 return (menu_item); | |
| 736 } | |
| 737 | |
| 738 /* Called whenever a button, radio, or toggle is selected in the menu */ | |
| 739 static void | |
| 740 __generic_button_callback (GtkMenuItem *item, gpointer user_data) | |
| 741 { | |
| 742 Lisp_Object callback, function, data, channel; | |
| 743 | |
| 2168 | 744 channel = wrap_frame (gtk_widget_to_frame (GTK_WIDGET (item))); |
| 462 | 745 |
| 826 | 746 callback = VOID_TO_LISP (user_data); |
| 462 | 747 |
| 748 get_gui_callback (callback, &function, &data); | |
| 749 | |
| 750 signal_special_gtk_user_event (channel, function, data); | |
| 751 } | |
| 752 | |
| 753 /* Convert a single menu item descriptor to a suitable GtkMenuItem */ | |
| 754 /* This function cannot GC. | |
| 755 It is only called from menu_item_descriptor_to_widget_value, which | |
| 756 prohibits GC. */ | |
| 1416 | 757 static GtkWidget * |
| 2081 | 758 menu_descriptor_to_widget_1 (Lisp_Object descr, GtkAccelGroup* accel_group) |
| 462 | 759 { |
| 760 if (STRINGP (descr)) | |
| 761 { | |
| 762 /* It is a separator. Unfortunately GTK does not allow us to | |
| 763 specify what our separators look like, so we can't do all the | |
| 764 fancy stuff that the X code does. | |
| 765 */ | |
| 766 return (gtk_menu_item_new ()); | |
| 767 } | |
| 768 else if (LISTP (descr)) | |
| 769 { | |
| 770 /* It is a submenu */ | |
| 2081 | 771 return (menu_convert (descr, NULL, accel_group)); |
| 462 | 772 } |
| 773 else if (VECTORP (descr)) | |
| 774 { | |
| 775 /* An actual menu item description! This gets yucky. */ | |
| 776 Lisp_Object name = Qnil; | |
| 777 Lisp_Object callback = Qnil; | |
| 778 Lisp_Object suffix = Qnil; | |
| 779 Lisp_Object active_p = Qt; | |
| 780 Lisp_Object include_p = Qt; | |
| 781 Lisp_Object selected_p = Qnil; | |
| 782 Lisp_Object keys = Qnil; | |
| 783 Lisp_Object style = Qnil; | |
| 784 Lisp_Object config_tag = Qnil; | |
| 785 Lisp_Object accel = Qnil; | |
| 786 GtkWidget *main_label = NULL; | |
| 787 int length = XVECTOR_LENGTH (descr); | |
| 788 Lisp_Object *contents = XVECTOR_DATA (descr); | |
| 789 int plist_p; | |
| 790 int selected_spec = 0, included_spec = 0; | |
| 791 GtkWidget *widget = NULL; | |
| 2081 | 792 guint accel_key; |
| 462 | 793 |
| 794 if (length < 2) | |
| 563 | 795 sferror ("button descriptors must be at least 2 long", descr); |
| 462 | 796 |
| 797 /* length 2: [ "name" callback ] | |
| 798 length 3: [ "name" callback active-p ] | |
| 799 length 4: [ "name" callback active-p suffix ] | |
| 800 or [ "name" callback keyword value ] | |
| 801 length 5+: [ "name" callback [ keyword value ]+ ] | |
| 802 */ | |
| 803 plist_p = (length >= 5 || (length > 2 && KEYWORDP (contents [2]))); | |
| 804 | |
| 805 if (!plist_p && length > 2) | |
| 806 /* the old way */ | |
| 807 { | |
| 808 name = contents [0]; | |
| 809 callback = contents [1]; | |
| 810 active_p = contents [2]; | |
| 811 if (length == 4) | |
| 812 suffix = contents [3]; | |
| 813 } | |
| 814 else | |
| 815 { | |
| 816 /* the new way */ | |
| 817 int i; | |
| 818 if (length & 1) | |
| 563 | 819 sferror ( |
| 462 | 820 "button descriptor has an odd number of keywords and values", |
| 821 descr); | |
| 822 | |
| 823 name = contents [0]; | |
| 824 callback = contents [1]; | |
| 825 for (i = 2; i < length;) | |
| 826 { | |
| 827 Lisp_Object key = contents [i++]; | |
| 828 Lisp_Object val = contents [i++]; | |
| 829 if (!KEYWORDP (key)) | |
| 563 | 830 invalid_argument_2 ("not a keyword", key, descr); |
| 462 | 831 |
| 832 if (EQ (key, Q_active)) active_p = val; | |
| 833 else if (EQ (key, Q_suffix)) suffix = val; | |
| 834 else if (EQ (key, Q_keys)) keys = val; | |
| 835 else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compat */ | |
| 836 else if (EQ (key, Q_label)) ; /* implement for 21.0 */ | |
| 837 else if (EQ (key, Q_style)) style = val; | |
| 838 else if (EQ (key, Q_selected)) selected_p = val, selected_spec = 1; | |
| 839 else if (EQ (key, Q_included)) include_p = val, included_spec = 1; | |
| 840 else if (EQ (key, Q_config)) config_tag = val; | |
| 841 else if (EQ (key, Q_accelerator)) | |
| 842 { | |
| 843 if ( SYMBOLP (val) || CHARP (val)) | |
| 844 accel = val; | |
| 845 else | |
| 563 | 846 invalid_argument ("bad keyboard accelerator", val); |
| 462 | 847 } |
| 848 else if (EQ (key, Q_filter)) | |
| 563 | 849 sferror(":filter keyword not permitted on leaf nodes", descr); |
| 462 | 850 else |
| 563 | 851 invalid_argument_2 ("unknown menu item keyword", key, descr); |
| 462 | 852 } |
| 853 } | |
| 854 | |
| 855 #ifdef HAVE_MENUBARS | |
| 856 if ((!NILP (config_tag) && NILP (Fmemq (config_tag, Vmenubar_configuration))) | |
|
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2500
diff
changeset
|
857 || (included_spec && NILP (IGNORE_MULTIPLE_VALUES (Feval (include_p))))) |
|
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2500
diff
changeset
|
858 |
| 462 | 859 { |
| 860 /* the include specification says to ignore this item. */ | |
| 861 return 0; | |
| 862 } | |
| 863 #endif /* HAVE_MENUBARS */ | |
| 864 | |
| 865 CHECK_STRING (name); | |
| 866 | |
| 867 if (NILP (accel)) | |
| 868 accel = menu_name_to_accelerator (XSTRING_DATA (name)); | |
| 869 | |
| 870 if (!NILP (suffix)) | |
|
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2500
diff
changeset
|
871 suffix = IGNORE_MULTIPLE_VALUES (Feval (suffix)); |
|
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2500
diff
changeset
|
872 |
| 462 | 873 |
| 874 if (!separator_string_p (XSTRING_DATA (name))) | |
| 875 { | |
| 2054 | 876 Ibyte *label_buffer = NULL; |
| 462 | 877 char *temp_label = NULL; |
| 878 | |
| 879 if (STRINGP (suffix) && XSTRING_LENGTH (suffix)) | |
| 880 { | |
| 2367 | 881 /* !!#### */ |
| 882 label_buffer = alloca_ibytes (XSTRING_LENGTH (name) + 15 + XSTRING_LENGTH (suffix)); | |
| 883 qxesprintf (label_buffer, "%s %s ", XSTRING_DATA (name), | |
| 884 XSTRING_DATA (suffix)); | |
| 462 | 885 } |
| 886 else | |
| 887 { | |
| 2367 | 888 label_buffer = alloca_ibytes (XSTRING_LENGTH (name) + 15); |
| 889 qxesprintf (label_buffer, "%s ", XSTRING_DATA (name)); | |
| 462 | 890 } |
| 891 | |
| 2081 | 892 temp_label = convert_underscores (label_buffer); |
| 893 main_label = gtk_xemacs_accel_label_new (NULL); | |
| 894 accel_key = gtk_label_parse_uline (GTK_LABEL (main_label), temp_label); | |
| 462 | 895 free (temp_label); |
| 896 } | |
| 897 | |
| 898 /* Evaluate the selected and active items now */ | |
| 899 if (selected_spec) | |
| 900 { | |
| 901 if (NILP (selected_p) || EQ (selected_p, Qt)) | |
| 902 { | |
| 903 /* Do nothing */ | |
| 904 } | |
| 905 else | |
| 906 { | |
|
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2500
diff
changeset
|
907 selected_p = IGNORE_MULTIPLE_VALUES (Feval (selected_p)); |
| 462 | 908 } |
| 909 } | |
| 910 | |
| 911 if (NILP (active_p) || EQ (active_p, Qt)) | |
| 912 { | |
| 913 /* Do Nothing */ | |
| 914 } | |
| 915 else | |
| 916 { | |
|
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2500
diff
changeset
|
917 active_p = IGNORE_MULTIPLE_VALUES (Feval (active_p)); |
| 462 | 918 } |
| 919 | |
| 920 if (0 || | |
| 921 #ifdef HAVE_MENUBARS | |
| 922 menubar_show_keybindings | |
| 923 #endif | |
| 924 ) | |
| 925 { | |
| 926 /* Need to get keybindings */ | |
| 927 if (!NILP (keys)) | |
| 928 { | |
| 929 /* User-specified string to generate key bindings with */ | |
| 930 CHECK_STRING (keys); | |
| 931 | |
| 932 keys = Fsubstitute_command_keys (keys); | |
| 933 } | |
| 934 else if (SYMBOLP (callback)) | |
| 935 { | |
| 793 | 936 DECLARE_EISTRING_MALLOC (buf); |
| 462 | 937 |
| 938 /* #### Warning, dependency here on current_buffer and point */ | |
| 939 where_is_to_char (callback, buf); | |
| 940 | |
| 833 | 941 if (eilen (buf) > 0) |
| 942 keys = eimake_string (buf); | |
| 943 else | |
| 944 { | |
| 945 | |
| 946 keys = Qnil; | |
| 947 } | |
| 948 | |
| 793 | 949 eifree (buf); |
| 462 | 950 } |
| 951 } | |
| 952 | |
| 953 /* Now we get down to the dirty business of creating the widgets */ | |
| 954 if (NILP (style) || EQ (style, Qtext) || EQ (style, Qbutton)) | |
| 955 { | |
| 956 /* A normal menu item */ | |
| 957 widget = gtk_menu_item_new (); | |
| 958 } | |
| 959 else if (EQ (style, Qtoggle) || EQ (style, Qradio)) | |
| 960 { | |
| 961 /* They are radio or toggle buttons. | |
| 962 | |
| 963 XEmacs' menu descriptions are fairly lame in that they do | |
| 964 not have the idea of a 'group' of radio buttons. They | |
| 965 are exactly like toggle buttons except that they get | |
| 966 drawn differently. | |
| 967 | |
| 968 GTK rips us a new one again. If you have a radio button | |
| 969 in a group by itself, it always draws it as highlighted. | |
| 970 So we dummy up and create a second radio button that does | |
| 971 not get added to the menu, but gets invisibly set/unset | |
| 972 when the other gets unset/set. *sigh* | |
| 973 | |
| 974 */ | |
| 975 if (EQ (style, Qradio)) | |
| 976 { | |
| 977 GtkWidget *dummy_sibling = NULL; | |
| 978 GSList *group = NULL; | |
| 979 | |
| 980 dummy_sibling = gtk_radio_menu_item_new (group); | |
| 981 group = gtk_radio_menu_item_group (GTK_RADIO_MENU_ITEM (dummy_sibling)); | |
| 982 widget = gtk_radio_menu_item_new (group); | |
| 983 | |
| 984 /* We need to notice when the 'real' one gets destroyed | |
| 985 so we can clean up the dummy as well. */ | |
| 986 gtk_object_weakref (GTK_OBJECT (widget), | |
| 987 (GtkDestroyNotify) gtk_widget_destroy, | |
| 988 dummy_sibling); | |
| 989 } | |
| 990 else | |
| 991 { | |
| 992 widget = gtk_check_menu_item_new (); | |
| 993 } | |
| 994 | |
| 995 /* What horrible defaults you have GTK dear! The default | |
| 996 for a toggle menu item is to not show the toggle unless it | |
| 997 is turned on or actively highlighted. How absolutely | |
| 998 hideous. */ | |
| 999 gtk_check_menu_item_set_show_toggle (GTK_CHECK_MENU_ITEM (widget), TRUE); | |
| 1000 gtk_check_menu_item_set_active (GTK_CHECK_MENU_ITEM (widget), | |
| 1001 NILP (selected_p) ? FALSE : TRUE); | |
| 1002 } | |
| 1003 else | |
| 1004 { | |
| 563 | 1005 invalid_argument_2 ("unknown style", style, descr); |
| 462 | 1006 } |
| 1007 | |
| 1008 gtk_widget_set_sensitive (widget, ! NILP (active_p)); | |
| 1009 | |
| 1010 gtk_signal_connect (GTK_OBJECT (widget), "activate-item", | |
| 1011 GTK_SIGNAL_FUNC (__generic_button_callback), | |
| 1012 LISP_TO_VOID (callback)); | |
| 1013 | |
| 1014 gtk_signal_connect (GTK_OBJECT (widget), "activate", | |
| 1015 GTK_SIGNAL_FUNC (__generic_button_callback), | |
| 1016 LISP_TO_VOID (callback)); | |
| 1017 | |
| 2081 | 1018 /* Now that all the information about the menu item is know, set the |
| 1019 remaining properties. | |
| 462 | 1020 */ |
| 1021 | |
| 1022 if (main_label) | |
| 1023 { | |
| 1024 gtk_container_add (GTK_CONTAINER (widget), main_label); | |
| 1025 | |
| 2081 | 1026 gtk_misc_set_alignment (GTK_MISC (main_label), 0.0, 0.5); |
| 1027 gtk_xemacs_set_accel_keys(GTK_XEMACS_ACCEL_LABEL(main_label), keys); | |
| 462 | 1028 |
| 2081 | 1029 if (accel_group) |
| 1030 gtk_widget_add_accelerator (widget, | |
| 1031 "activate_item", | |
| 1032 accel_group, | |
| 1033 accel_key, 0, | |
| 1034 GTK_ACCEL_LOCKED); | |
| 462 | 1035 } |
| 1036 | |
| 1037 return (widget); | |
| 1038 } | |
| 1039 else | |
| 1040 { | |
| 1041 return (NULL); | |
| 2500 | 1042 /* ABORT (); ???? */ |
| 462 | 1043 } |
| 1044 } | |
| 1045 | |
| 1416 | 1046 static GtkWidget * |
| 2081 | 1047 menu_descriptor_to_widget (Lisp_Object descr, GtkAccelGroup* accel_group) |
| 462 | 1048 { |
| 1049 GtkWidget *rval = NULL; | |
| 771 | 1050 int count = begin_gc_forbidden (); |
| 462 | 1051 |
| 1052 /* Cannot GC from here on out... */ | |
| 2081 | 1053 rval = menu_descriptor_to_widget_1 (descr, accel_group); |
| 771 | 1054 unbind_to (count); |
| 462 | 1055 return (rval); |
| 1056 | |
| 1057 } | |
| 1058 | |
| 1059 static gboolean | |
| 2054 | 1060 menu_can_reuse_widget (GtkWidget *child, const Ibyte *label) |
| 462 | 1061 { |
| 1062 /* Everything up at the top level was done using | |
| 2081 | 1063 ** gtk_xemacs_accel_label_new(), but we still double check to make |
| 462 | 1064 ** sure we don't seriously foobar ourselves. |
| 1065 */ | |
| 2081 | 1066 gpointer possible_child = |
| 1067 g_list_nth_data (gtk_container_children (GTK_CONTAINER (child)), 0); | |
| 1068 gboolean ret_val = FALSE; | |
| 462 | 1069 |
| 1070 if (possible_child && GTK_IS_LABEL (possible_child)) | |
| 1071 { | |
| 2081 | 1072 char *temp_label = remove_underscores (label); |
| 1073 | |
| 462 | 1074 if (!strcmp (GTK_LABEL (possible_child)->label, temp_label)) |
| 2081 | 1075 ret_val = TRUE; |
| 1076 | |
| 1077 free (temp_label); | |
| 462 | 1078 } |
| 2081 | 1079 |
| 1080 return ret_val; | |
| 462 | 1081 } |
| 1082 | |
| 1083 /* Converts a menubar description into a GtkMenuBar... a menubar is a | |
| 1084 list of menus or buttons | |
| 1085 */ | |
| 1086 static void | |
| 1087 menu_create_menubar (struct frame *f, Lisp_Object descr) | |
| 1088 { | |
| 1089 gboolean right_justify = FALSE; | |
| 1090 Lisp_Object value = descr; | |
| 1091 GtkWidget *menubar = FRAME_GTK_MENUBAR_WIDGET (f); | |
| 1092 GUI_ID id = (GUI_ID) gtk_object_get_data (GTK_OBJECT (menubar), XEMACS_MENU_GUIID_TAG); | |
| 1093 guint menu_position = 0; | |
| 2081 | 1094 GtkAccelGroup *menubar_accel_group; |
| 462 | 1095 |
| 1096 /* Remove any existing protection for old menu items */ | |
| 1097 ungcpro_popup_callbacks (id); | |
| 1098 | |
| 1099 /* GCPRO the whole damn thing */ | |
| 1100 gcpro_popup_callbacks (id, descr); | |
| 1101 | |
| 2081 | 1102 menubar_accel_group = gtk_accel_group_new(); |
| 1103 | |
| 2367 | 1104 { |
| 1105 EXTERNAL_LIST_LOOP_2 (item_descr, value) | |
| 1106 { | |
| 1107 gpointer current_child = g_list_nth_data (GTK_MENU_SHELL (menubar)->children, menu_position); | |
| 462 | 1108 |
| 2367 | 1109 if (NILP (item_descr)) |
| 1110 { | |
| 1111 /* Need to start right-justifying menus */ | |
| 1112 right_justify = TRUE; | |
| 1113 menu_position--; | |
| 1114 } | |
| 1115 else if (VECTORP (item_descr)) | |
| 1116 { | |
| 1117 /* It is a button description */ | |
| 1118 GtkWidget *item; | |
| 462 | 1119 |
| 2367 | 1120 item = menu_descriptor_to_widget (item_descr, menubar_accel_group); |
| 1121 gtk_widget_set_name (item, "XEmacsMenuButton"); | |
| 1122 | |
| 1123 if (!item) | |
| 1124 { | |
| 1125 item = gtk_menu_item_new_with_label ("ITEM CREATION ERROR"); | |
| 1126 } | |
| 462 | 1127 |
| 2367 | 1128 gtk_widget_show_all (item); |
| 1129 if (current_child) gtk_widget_destroy (GTK_WIDGET (current_child)); | |
| 1130 gtk_menu_bar_insert (GTK_MENU_BAR (menubar), item, menu_position); | |
| 1131 } | |
| 1132 else if (LISTP (item_descr)) | |
| 1133 { | |
| 1134 /* Need to actually convert it into a menu and slap it in */ | |
| 1135 GtkWidget *widget; | |
| 1136 gboolean reused_p = FALSE; | |
| 462 | 1137 |
| 2367 | 1138 /* We may be able to reuse the widget, let's at least check. */ |
| 1139 if (current_child && menu_can_reuse_widget (GTK_WIDGET (current_child), | |
| 1140 XSTRING_DATA (XCAR (item_descr)))) | |
| 1141 { | |
| 1142 widget = menu_convert (item_descr, GTK_WIDGET (current_child), | |
| 1143 menubar_accel_group); | |
| 1144 reused_p = TRUE; | |
| 1145 } | |
| 1146 else | |
| 1147 { | |
| 1148 widget = menu_convert (item_descr, NULL, menubar_accel_group); | |
| 1149 if (current_child) gtk_widget_destroy (GTK_WIDGET (current_child)); | |
| 1150 gtk_menu_bar_insert (GTK_MENU_BAR (menubar), widget, menu_position); | |
| 1151 } | |
| 462 | 1152 |
| 2367 | 1153 if (widget) |
| 1154 { | |
| 1155 if (right_justify) gtk_menu_item_right_justify (GTK_MENU_ITEM (widget)); | |
| 1156 } | |
| 1157 else | |
| 1158 { | |
| 1159 widget = gtk_menu_item_new_with_label ("ERROR"); | |
| 2500 | 1160 /* ABORT() */ |
| 2367 | 1161 } |
| 1162 gtk_widget_show_all (widget); | |
| 1163 } | |
| 1164 else if (STRINGP (item_descr)) | |
| 1165 { | |
| 1166 /* Do I really want to be this careful? Anything else in a | |
| 1167 menubar description is illegal */ | |
| 1168 } | |
| 1169 menu_position++; | |
| 1170 } | |
| 1171 } | |
| 462 | 1172 |
| 1173 /* Need to delete any menu items that were past the bounds of the new one */ | |
| 1174 { | |
| 1175 GList *l = NULL; | |
| 1176 | |
| 1177 while ((l = g_list_nth (GTK_MENU_SHELL (menubar)->children, menu_position))) | |
| 1178 { | |
| 1179 gpointer data = l->data; | |
| 1180 g_list_remove_link (GTK_MENU_SHELL (menubar)->children, l); | |
| 1181 | |
| 1182 if (data) | |
| 1183 { | |
| 1184 gtk_widget_destroy (GTK_WIDGET (data)); | |
| 1185 } | |
| 1186 } | |
| 1187 } | |
| 2081 | 1188 |
| 1189 /* Attach the new accelerator group to the frame. */ | |
| 1190 gtk_window_add_accel_group (GTK_WINDOW (FRAME_GTK_SHELL_WIDGET(f)), | |
| 1191 menubar_accel_group); | |
| 462 | 1192 } |
| 1193 | |
| 1194 | |
| 1195 /* Deal with getting/setting the menubar */ | |
| 1196 #ifndef GNOME_IS_APP | |
| 1197 #define GNOME_IS_APP(x) 0 | |
| 1198 #define gnome_app_set_menus(x,y) | |
| 1199 #endif | |
| 1200 | |
| 1201 static gboolean | |
| 2286 | 1202 run_menubar_hook (GtkWidget *widget, GdkEventButton *UNUSED (event), |
| 1203 gpointer UNUSED (user_data)) | |
| 462 | 1204 { |
| 1205 if (!GTK_MENU_SHELL(widget)->active) | |
| 1206 { | |
| 1207 run_hook (Qactivate_menubar_hook); | |
| 1208 } | |
| 1209 return(FALSE); | |
| 1210 } | |
| 1211 | |
| 1212 static void | |
| 1213 create_menubar_widget (struct frame *f) | |
| 1214 { | |
| 1215 GUI_ID id = new_gui_id (); | |
| 1216 GtkWidget *handlebox = NULL; | |
| 1217 GtkWidget *menubar = gtk_xemacs_menubar_new (f); | |
| 1218 | |
| 1219 if (GNOME_IS_APP (FRAME_GTK_SHELL_WIDGET (f))) | |
| 1220 { | |
| 1221 gnome_app_set_menus (GNOME_APP (FRAME_GTK_SHELL_WIDGET (f)), GTK_MENU_BAR (menubar)); | |
| 1222 } | |
| 1223 else if (dockable_menubar) | |
| 1224 { | |
| 1225 handlebox = gtk_handle_box_new (); | |
| 1226 gtk_handle_box_set_handle_position (GTK_HANDLE_BOX (handlebox), GTK_POS_LEFT); | |
| 1227 gtk_container_add (GTK_CONTAINER (handlebox), menubar); | |
| 1228 gtk_box_pack_start (GTK_BOX (FRAME_GTK_CONTAINER_WIDGET (f)), handlebox, FALSE, FALSE, 0); | |
| 1229 } | |
| 1230 else | |
| 1231 { | |
| 1232 gtk_box_pack_start (GTK_BOX (FRAME_GTK_CONTAINER_WIDGET (f)), menubar, FALSE, FALSE, 0); | |
| 1233 } | |
| 1234 | |
| 1235 gtk_signal_connect (GTK_OBJECT (menubar), "button-press-event", | |
| 1236 GTK_SIGNAL_FUNC (run_menubar_hook), NULL); | |
| 1237 | |
| 1238 FRAME_GTK_MENUBAR_WIDGET (f) = menubar; | |
| 1239 gtk_object_set_data (GTK_OBJECT (menubar), XEMACS_MENU_GUIID_TAG, (gpointer) id); | |
| 1240 gtk_object_weakref (GTK_OBJECT (menubar), __remove_gcpro_by_id, (gpointer) id); | |
| 1241 } | |
| 1242 | |
| 1243 static int | |
| 1244 set_frame_menubar (struct frame *f, int first_time_p) | |
| 1245 { | |
| 1246 Lisp_Object menubar; | |
| 1247 int menubar_visible; | |
| 1248 /* As for the toolbar, the minibuffer does not have its own menubar. */ | |
| 1249 struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); | |
| 1250 | |
| 1251 if (! FRAME_GTK_P (f)) | |
| 1252 return 0; | |
| 1253 | |
| 1254 /***** first compute the contents of the menubar *****/ | |
| 1255 | |
| 1256 if (! first_time_p) | |
| 1257 { | |
| 1258 /* evaluate `current-menubar' in the buffer of the selected window | |
| 1259 of the frame in question. */ | |
| 1260 menubar = symbol_value_in_buffer (Qcurrent_menubar, w->buffer); | |
| 1261 } | |
| 1262 else | |
| 1263 { | |
| 1264 /* That's a little tricky the first time since the frame isn't | |
| 1265 fully initialized yet. */ | |
| 1266 menubar = Fsymbol_value (Qcurrent_menubar); | |
| 1267 } | |
| 1268 | |
| 1269 if (NILP (menubar)) | |
| 1270 { | |
| 1271 menubar = Vblank_menubar; | |
| 1272 menubar_visible = 0; | |
| 1273 } | |
| 1274 else | |
| 1275 { | |
| 1276 menubar_visible = !NILP (w->menubar_visible_p); | |
| 1277 } | |
| 1278 | |
| 1279 if (!FRAME_GTK_MENUBAR_WIDGET (f)) | |
| 1280 { | |
| 1281 create_menubar_widget (f); | |
| 1282 } | |
| 1283 | |
| 1284 /* Populate the menubar, but nothing is shown yet */ | |
| 1285 { | |
| 1286 Lisp_Object old_buffer; | |
| 1287 int count = specpdl_depth (); | |
| 1288 | |
| 1289 old_buffer = Fcurrent_buffer (); | |
| 1290 record_unwind_protect (Fset_buffer, old_buffer); | |
| 1291 Fset_buffer (XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer); | |
| 1292 | |
| 1293 menu_create_menubar (f, menubar); | |
| 1294 | |
| 1295 Fset_buffer (old_buffer); | |
| 771 | 1296 unbind_to (count); |
| 462 | 1297 } |
| 1298 | |
| 1346 | 1299 FRAME_GTK_MENUBAR_DATA (f) = Fcons (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer, Qt); |
| 462 | 1300 |
| 1301 return (menubar_visible); | |
| 1302 } | |
| 1303 | |
| 1304 /* Called from gtk_create_widgets() to create the inital menubar of a frame | |
| 1305 before it is mapped, so that the window is mapped with the menubar already | |
| 1306 there instead of us tacking it on later and thrashing the window after it | |
| 1307 is visible. */ | |
| 1308 int | |
| 1309 gtk_initialize_frame_menubar (struct frame *f) | |
| 1310 { | |
| 1311 create_menubar_widget (f); | |
| 1312 return set_frame_menubar (f, 1); | |
| 1313 } | |
| 1314 | |
| 1315 | |
| 1316 static void | |
| 1317 gtk_update_frame_menubar_internal (struct frame *f) | |
| 1318 { | |
| 1319 /* We assume the menubar contents has changed if the global flag is set, | |
| 1320 or if the current buffer has changed, or if the menubar has never | |
| 1321 been updated before. | |
| 1322 */ | |
| 1323 int menubar_contents_changed = | |
| 1324 (f->menubar_changed | |
| 1346 | 1325 || NILP (FRAME_GTK_MENUBAR_DATA (f)) |
| 1326 || (!EQ (XFRAME_GTK_MENUBAR_DATA_LASTBUFF (f), | |
| 462 | 1327 XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer))); |
| 1328 | |
| 1329 gboolean menubar_was_visible = GTK_WIDGET_VISIBLE (FRAME_GTK_MENUBAR_WIDGET (f)); | |
| 1330 gboolean menubar_will_be_visible = menubar_was_visible; | |
| 1331 gboolean menubar_visibility_changed; | |
| 1332 | |
| 1333 if (menubar_contents_changed) | |
| 1334 { | |
| 1335 menubar_will_be_visible = set_frame_menubar (f, 0); | |
| 1336 } | |
| 1337 | |
| 1338 menubar_visibility_changed = menubar_was_visible != menubar_will_be_visible; | |
| 1339 | |
| 1340 if (!menubar_visibility_changed) | |
| 1341 { | |
| 1342 return; | |
| 1343 } | |
| 1344 | |
| 1345 /* We hide and show the menubar's parent (which is actually the | |
| 1346 GtkHandleBox)... this is to simplify the code that destroys old | |
| 1347 menu items, etc. There is no easy way to get the child out of a | |
| 1348 handle box, and I didn't want to add yet another stupid widget | |
| 1349 slot to struct gtk_frame. */ | |
| 1350 if (menubar_will_be_visible) | |
| 1351 { | |
| 1352 gtk_widget_show_all (FRAME_GTK_MENUBAR_WIDGET (f)->parent); | |
| 1353 } | |
| 1354 else | |
| 1355 { | |
| 1356 gtk_widget_hide_all (FRAME_GTK_MENUBAR_WIDGET (f)->parent); | |
| 1357 } | |
| 1358 | |
| 1359 MARK_FRAME_SIZE_SLIPPED (f); | |
| 1360 } | |
| 1361 | |
| 1362 static void | |
| 1363 gtk_update_frame_menubars (struct frame *f) | |
| 1364 { | |
| 1365 GtkWidget *menubar = NULL; | |
| 1366 | |
| 1367 assert (FRAME_GTK_P (f)); | |
| 1368 | |
| 1369 menubar = FRAME_GTK_MENUBAR_WIDGET (f); | |
| 1370 | |
| 1371 if ((GTK_MENU_SHELL (menubar)->active) || | |
| 1372 (GTK_MENU_SHELL (menubar)->have_grab) || | |
| 1373 (GTK_MENU_SHELL (menubar)->have_xgrab)) | |
| 1374 { | |
| 1375 return; | |
| 1376 } | |
| 1377 | |
| 1378 gtk_update_frame_menubar_internal (f); | |
| 1379 } | |
| 1380 | |
| 1381 static void | |
| 1382 gtk_free_frame_menubars (struct frame *f) | |
| 1383 { | |
| 1384 GtkWidget *menubar_widget; | |
| 1385 | |
| 1386 assert (FRAME_GTK_P (f)); | |
| 1387 | |
| 1388 menubar_widget = FRAME_GTK_MENUBAR_WIDGET (f); | |
| 1389 if (menubar_widget) | |
| 1390 { | |
| 1391 gtk_widget_destroy (menubar_widget); | |
| 1392 } | |
| 1393 } | |
| 1394 | |
| 1416 | 1395 static void |
| 2286 | 1396 popdown_menu_cb (GtkMenuShell *UNUSED (menu), gpointer UNUSED (user_data)) |
| 462 | 1397 { |
| 1398 popup_up_p--; | |
| 1399 } | |
| 1400 | |
| 1401 static void | |
| 1402 gtk_popup_menu (Lisp_Object menu_desc, Lisp_Object event) | |
| 1403 { | |
| 1404 struct Lisp_Event *eev = NULL; | |
| 714 | 1405 GtkWidget *widget = NULL; |
| 1406 GtkWidget *menu = NULL; | |
| 1407 gpointer id = NULL; | |
| 462 | 1408 |
| 714 | 1409 /* Do basic error checking first... */ |
| 1410 if (SYMBOLP (menu_desc)) | |
| 1411 menu_desc = Fsymbol_value (menu_desc); | |
| 1412 CHECK_CONS (menu_desc); | |
| 1413 CHECK_STRING (XCAR (menu_desc)); | |
| 1414 | |
| 1415 /* Now lets get down to business... */ | |
| 2081 | 1416 widget = menu_descriptor_to_widget (menu_desc, NULL); |
| 714 | 1417 menu = GTK_MENU_ITEM (widget)->submenu; |
| 462 | 1418 gtk_widget_set_name (widget, "XEmacsPopupMenu"); |
| 714 | 1419 id = gtk_object_get_data (GTK_OBJECT (widget), XEMACS_MENU_GUIID_TAG); |
| 462 | 1420 |
| 1421 __activate_menu (GTK_MENU_ITEM (widget), id); | |
| 1422 | |
| 1423 if (!NILP (event)) | |
| 1424 { | |
| 1425 CHECK_LIVE_EVENT (event); | |
| 1426 eev = XEVENT (event); | |
| 1427 | |
| 1428 if ((eev->event_type != button_press_event) && | |
| 1429 (eev->event_type != button_release_event)) | |
| 1430 wrong_type_argument (Qmouse_event_p, event); | |
| 1431 } | |
| 1432 else if (!NILP (Vthis_command_keys)) | |
| 1433 { | |
| 1434 /* If an event wasn't passed, use the last event of the event | |
| 1435 sequence currently being executed, if that event is a mouse | |
| 1436 event. */ | |
| 1437 eev = XEVENT (Vthis_command_keys); | |
| 1438 if ((eev->event_type != button_press_event) && | |
| 1439 (eev->event_type != button_release_event)) | |
| 1440 eev = NULL; | |
| 1441 } | |
| 1442 | |
| 1443 gtk_widget_show (menu); | |
| 1444 | |
| 1445 popup_up_p++; | |
| 1446 gtk_signal_connect (GTK_OBJECT (menu), "deactivate", | |
| 1447 GTK_SIGNAL_FUNC (popdown_menu_cb), NULL); | |
| 1448 | |
| 1449 gtk_menu_popup (GTK_MENU (menu), NULL, NULL, NULL, NULL, | |
| 1204 | 1450 eev ? EVENT_BUTTON_BUTTON (eev) : 0, |
| 462 | 1451 eev ? eev->timestamp : GDK_CURRENT_TIME); |
| 1452 } | |
| 1453 | |
| 1454 DEFUN ("gtk-build-xemacs-menu", Fgtk_build_xemacs_menu, 1, 1, 0, /* | |
| 1455 Returns a GTK menu item from MENU, a standard XEmacs menu description. | |
| 1456 See the definition of `popup-menu' for more information on the format of MENU. | |
| 1457 */ | |
| 1458 (menu)) | |
| 1459 { | |
| 2081 | 1460 GtkWidget *w = menu_descriptor_to_widget (menu, NULL); |
| 462 | 1461 |
| 1462 return (w ? build_gtk_object (GTK_OBJECT (w)) : Qnil); | |
| 1463 } | |
| 1464 | |
| 1465 | |
| 1466 void | |
| 1467 syms_of_menubar_gtk (void) | |
| 1468 { | |
| 1469 DEFSUBR (Fgtk_build_xemacs_menu); | |
| 1470 } | |
| 1471 | |
| 1472 void | |
| 1473 console_type_create_menubar_gtk (void) | |
| 1474 { | |
| 1475 CONSOLE_HAS_METHOD (gtk, update_frame_menubars); | |
| 1476 CONSOLE_HAS_METHOD (gtk, free_frame_menubars); | |
| 1477 CONSOLE_HAS_METHOD (gtk, popup_menu); | |
| 1478 } | |
| 1479 | |
| 1416 | 1480 void |
| 1481 reinit_vars_of_menubar_gtk (void) | |
| 462 | 1482 { |
| 1483 dockable_menubar = 1; | |
| 1484 #ifdef TEAR_OFF_MENUS | |
| 1485 tear_off_menus = 1; | |
| 1486 #endif | |
| 1487 } | |
| 1488 | |
| 1489 void | |
| 1490 vars_of_menubar_gtk (void) | |
| 1491 { | |
| 1492 Fprovide (intern ("gtk-menubars")); | |
| 1493 DEFVAR_BOOL ("menubar-dockable-p", &dockable_menubar /* | |
| 1494 If non-nil, the frame menubar can be detached into its own top-level window. | |
| 1495 */ ); | |
| 1496 #ifdef TEAR_OFF_MENUS | |
| 1497 DEFVAR_BOOL ("menubar-tearable-p", &tear_off_menus /* | |
| 1498 If non-nil, menus can be torn off into their own top-level windows. | |
| 1499 */ ); | |
| 1500 #endif | |
| 1501 } | |
| 2081 | 1502 |
| 1503 /*---------------------------------------------------------------------------*/ | |
| 1504 |