Mercurial > hg > xemacs-beta
view src/menubar-gtk.c @ 5353:38e24b8be4ea
Improve the lexical scoping in #'block, #'return-from.
lisp/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el:
* bytecomp.el (byte-compile-initial-macro-environment):
Shadow `block', `return-from' here, we implement them differently
when byte-compiling.
* bytecomp.el (byte-compile-active-blocks): New.
* bytecomp.el (byte-compile-block-1): New.
* bytecomp.el (byte-compile-return-from-1): New.
* bytecomp.el (return-from-1): New.
* bytecomp.el (block-1): New.
These are two aliases that exist to have their own associated
byte-compile functions, which functions implement `block' and
`return-from'.
* cl-extra.el (cl-macroexpand-all):
Fix a bug here when macros in the environment have been compiled.
* cl-macs.el (block):
* cl-macs.el (return):
* cl-macs.el (return-from):
Be more careful about lexical scope in these macros.
* cl.el:
* cl.el ('cl-block-wrapper): Removed.
* cl.el ('cl-block-throw): Removed.
These aren't needed in code generated by this XEmacs. They
shouldn't be needed in code generated by XEmacs 21.4, but if it
turns out the packages do need them, we can put them back.
2011-01-30 Mike Sperber <mike@xemacs.org>
* font-lock.el (font-lock-fontify-pending-extents): Don't fail if
`font-lock-mode' is unset, which can happen in the middle of
`revert-buffer'.
2011-01-23 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete):
* cl-macs.el (delq):
* cl-macs.el (remove):
* cl-macs.el (remq):
Don't use the compiler macro if these functions were given the
wrong number of arguments, as happens in lisp-tests.el.
* cl-seq.el (remove, remq): Removed.
I added these to subr.el, and forgot to remove them from here.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-setq, byte-compile-set):
Remove kludge allowing keywords' values to be set, all the code
that does that is gone.
* cl-compat.el (elt-satisfies-test-p):
* faces.el (set-face-parent):
* faces.el (face-doc-string):
* gtk-font-menu.el:
* gtk-font-menu.el (gtk-reset-device-font-menus):
* msw-font-menu.el:
* msw-font-menu.el (mswindows-reset-device-font-menus):
* package-get.el (package-get-installedp):
* select.el (select-convert-from-image-data):
* sound.el:
* sound.el (load-sound-file):
* x-font-menu.el (x-reset-device-font-menus-core):
Don't quote keywords, they're self-quoting, and the
win from backward-compatibility is sufficiently small now that the
style problem overrides it.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (block, return-from): Require that NAME be a symbol
in these macros, as always documented in the #'block docstring and
as required by Common Lisp.
* descr-text.el (unidata-initialize-unihan-database):
Correct the use of non-symbols in #'block and #'return-from in
this function.
2011-01-15 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (concatenate): Accept more complicated TYPEs in this
function, handing the sequences over to #'coerce if we don't
understand them here.
* cl-macs.el (inline): Don't proclaim #'concatenate as inline, its
compiler macro is more useful than doing that.
2011-01-11 Aidan Kehoe <kehoea@parhasard.net>
* subr.el (delete, delq, remove, remq): Move #'remove, #'remq
here, they don't belong in cl-seq.el; move #'delete, #'delq here
from fns.c, implement them in terms of #'delete*, allowing support
for sequences generally.
* update-elc.el (do-autoload-commands): Use #'delete*, not #'delq
here, now the latter's no longer dumped.
* cl-macs.el (delete, delq): Add compiler macros transforming
#'delete and #'delq to #'delete* calls.
2011-01-10 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box): Correct a misplaced parenthesis
here, thank you Mats Lidell in 87zkr9gqrh.fsf@mail.contactor.se !
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box):
* list-mode.el (display-completion-list):
These functions used to use cl-parsing-keywords; change them to
use defun* instead, fixing the build. (Not sure what led to me
not including this change in d1b17a33450b!)
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (define-star-compiler-macros):
Make sure the form has ITEM and LIST specified before attempting
to change to calls with explicit tests; necessary for some tests
in lisp-tests.el to compile correctly.
(stable-union, stable-intersection): Add compiler macros for these
functions, in the same way we do for most of the other functions
in cl-seq.el.
2011-01-01 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (dolist, dotimes, do-symbols, macrolet)
(symbol-macrolet):
Define these macros with defmacro* instead of parsing the argument
list by hand, for the sake of style and readability; use backquote
where appropriate, instead of calling #'list and and friends, for
the same reason.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* x-misc.el (device-x-display):
Provide this function, documented in the Lispref for years, but
not existing previously. Thank you Julian Bradfield, thank you
Jeff Mincy.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl-seq.el:
Move the heavy lifting from this file to C. Dump the
cl-parsing-keywords macro, but don't use defun* for the functions
we define that do take keywords, dynamic scope lossage makes that
not practical.
* subr.el (sort, fillarray): Move these aliases here.
(map-plist): #'nsublis is now built-in, but at this point #'eql
isn't necessarily available as a test; use #'eq.
* obsolete.el (cl-delete-duplicates): Make this available for old
compiler macros and old code.
(memql): Document that this is equivalent to #'member*, and worse.
* cl.el (adjoin, subst): Removed. These are in C.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (assoc-ignore-case): Remove a duplicate definition of
this function (it's already in subr.el).
* iso8859-1.el (char-width):
On non-Mule, make this function equivalent to that produced by
(constantly 1), but preserve its docstring.
* subr.el (subst-char-in-string): Define this in terms of
#'substitute, #'nsubstitute.
(string-width): Define this using #'reduce and #'char-width.
(char-width): Give this a simpler definition, it makes far more
sense to check for mule at load time and redefine, as we do in
iso8859-1.el.
(store-substring): Implement this in terms of #'replace, now
#'replace is cheap.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* update-elc.el (lisp-files-needed-for-byte-compilation)
(lisp-files-needing-early-byte-compilation):
cl-macs belongs in the former, not the latter, it is as
fundamental as bytecomp.el.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl.el:
Provde the Common Lisp program-error, type-error as error
symbols. This doesn't nearly go far enough for anyone using the
Common Lisp errors.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete-duplicates):
If the form has an incorrect number of arguments, don't attempt a
compiler macroexpansion.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (cl-safe-expr-p):
Forms that start with the symbol lambda are also safe.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
For these functions' compiler macros, the optimisation is safe
even if the first and the last arguments have side effects, since
they're only used the once.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (inline-side-effect-free-compiler-macros):
Unroll a loop here at macro-expansion time, so these compiler
macros are compiled. Use #'eql instead of #'eq in a couple of
places for better style.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (notany, notevery): Avoid some dynamic scope
stupidity with local variable names in these functions, when they
weren't prefixed with cl-; go into some more detail in the doc
strings.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns): #'remove, #'remq are
free of side-effects.
(side-effect-and-error-free-fns):
Drop dot, dot-marker from the list.
2010-11-17 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (coerce):
In the argument list, name the first argument OBJECT, not X; the
former name was always used in the doc string and is clearer.
Handle vector type specifications which include the length of the
target sequence, error if there's a mismatch.
* cl-macs.el (cl-make-type-test): Handle type specifications
starting with the symbol 'eql.
2010-11-14 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (eql): Don't remove the byte-compile property of this
symbol. That was necessary to override a bug in bytecomp.el where
#'eql was confused with #'eq, which bug we no longer have.
If neither expression is constant, don't attempt to handle the
expression in this compiler macro, leave it to byte-compile-eql,
which produces better code anyway.
* bytecomp.el (eq): #'eql is not the function associated with the
byte-eq byte code.
(byte-compile-eql): Add an explicit compile method for this
function, for cases where the cl-macs compiler macro hasn't
reduced it to #'eq or #'equal.
2010-10-25 Aidan Kehoe <kehoea@parhasard.net>
Add compiler macros and compilation sanity-checking for various
functions that take keywords.
* byte-optimize.el (side-effect-free-fns): #'symbol-value is
side-effect free and not error free.
* bytecomp.el (byte-compile-normal-call): Check keyword argument
lists for sanity; store information about the positions where
keyword arguments start using the new byte-compile-keyword-start
property.
* cl-macs.el (cl-const-expr-val): Take a new optional argument,
cl-not-constant, defaulting to nil, in this function; return it if
the expression is not constant.
(cl-non-fixnum-number-p): Make this into a separate function, we
want to pass it to #'every.
(eql): Use it.
(define-star-compiler-macros): Use the same code to generate the
member*, assoc* and rassoc* compiler macros; special-case some
code in #'add-to-list in subr.el.
(remove, remq): Add compiler macros for these two functions, in
preparation for #'remove being in C.
(define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to
(remove ... :if-not) at compile time, which will be a real win
once the latter is in C.
(define-substitute-if-compiler-macros)
(define-subst-if-compiler-macros): Similarly for these functions.
(delete-duplicates): Change this compiler macro to use
#'plists-equal; if we don't have information about the type of
SEQUENCE at compile time, don't bother attempting to inline the
call, the function will be in C soon enough.
(equalp): Remove an old commented-out compiler macro for this, if
we want to see it it's in version control.
(subst-char-in-string): Transform this to a call to nsubstitute or
nsubstitute, if that is appropriate.
* cl.el (ldiff): Don't call setf here, this makes for a load-time
dependency problem in cl-macs.el
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* term/vt100.el:
Refer to XEmacs, not GNU Emacs, in permissions.
* term/bg-mouse.el:
* term/sup-mouse.el:
Put copyright notice in canonical "Copyright DATE AUTHOR" form.
Refer to XEmacs, not GNU Emacs, in permissions.
* site-load.el:
Add permission boilerplate.
* mule/canna-leim.el:
* alist.el:
Refer to XEmacs, not APEL/this program, in permissions.
* mule/canna-leim.el:
Remove my copyright, I've assigned it to the FSF.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* gtk.el:
* gtk-widget-accessors.el:
* gtk-package.el:
* gtk-marshal.el:
* gtk-compose.el:
* gnome.el:
Add copyright notice based on internal evidence.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* easymenu.el: Add reference to COPYING to permission notice.
* gutter.el:
* gutter-items.el:
* menubar-items.el:
Fix typo "Xmacs" in permissions notice.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* auto-save.el:
* font.el:
* fontconfig.el:
* mule/kinsoku.el:
Add "part of XEmacs" text to permission notice.
2010-10-14 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns):
* cl-macs.el (remf, getf):
* cl-extra.el (tailp, cl-set-getf, cl-do-remf):
* cl.el (ldiff, endp):
Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp;
add circularity checking for the first two.
#'cl-set-getf and #'cl-do-remf were Lisp implementations of
#'plist-put and #'plist-remprop; change the names to aliases,
changes the macros that use them to using #'plist-put and
#'plist-remprop directly.
2010-10-12 Aidan Kehoe <kehoea@parhasard.net>
* abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table):
Create both these abbrev tables using the usual
#'define-abbrev-table calls, rather than attempting to
special-case them.
* cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is
being loaded interpreted. Previously other, later files would
redundantly call (load "cl-macs") when interpreted, it's more
reasonable to do it here, once.
* cmdloop.el (read-quoted-char-radix): Use defcustom here, we
don't have any dump-order dependencies that would prevent that.
* custom.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling, rely on cl-extra.el in the
former case and the appropriate entry in bytecomp-load-hook in the
latter. Get rid of custom-declare-variable-list, we have no
dump-time dependencies that would require it.
* faces.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling.
* packages.el: Remove some inaccurate comments.
* post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not
here, now the order of preloaded-file-list has been changed to
make it available.
* subr.el (custom-declare-variable-list): Remove. No need for it.
Also remove a stub define-abbrev-table from this file, given the
current order of preloaded-file-list there's no need for it.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are
also constant.
(byte-compile-initial-macro-environment): In #'the, if FORM is
constant and does not match TYPE, warn at byte-compile time.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* backquote.el (bq-vector-contents, bq-list*): Remove; the former
is equivalent to (append VECTOR nil), the latter to (list* ...).
(bq-process-2): Use (append VECTOR nil) instead of using
#'bq-vector-contents to convert to a list.
(bq-process-1): Now we use list* instead of bq-list
* subr.el (list*): Moved from cl.el, since it is now required to
be available the first time a backquoted form is encountered.
* cl.el (list*): Move to subr.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* test-harness.el (Check-Message):
Add an omitted comma here, thank you the buildbot.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* hash-table.el (hash-table-key-list, hash-table-value-list)
(hash-table-key-value-alist, hash-table-key-value-plist):
Remove some useless #'nreverse calls in these files; our hash
tables have no order, it's not helpful to pretend they do.
* behavior.el (read-behavior):
Do the same in this file, in some code evidently copied from
hash-table.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* info.el (Info-insert-dir):
* format.el (format-deannotate-region):
* files.el (cd, save-buffers-kill-emacs):
Use #'some, #'every and related functions for applying boolean
operations to lists, instead of rolling our own ones that cons and
don't short-circuit.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-initial-macro-environment):
* cl-macs.el (the):
Rephrase the docstring, make its implementation when compiling
files a little nicer.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* descr-text.el (unidata-initialize-unicodedata-database)
(unidata-initialize-unihan-database, describe-char-unicode-data)
(describe-char-unicode-data):
Wrap calls to the database functions with (with-fboundp ...),
avoiding byte compile warnings on builds without support for the
database functions.
(describe-char): (reduce #'max ...), not (apply #'max ...), no
need to cons needlessly.
(describe-char): Remove a redundant lambda wrapping
#'extent-properties.
(describe-char-unicode-data): Call #'nsubst when replacing "" with
nil in the result of #'split-string, instead of consing inside
mapcar.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* x-faces.el (x-available-font-sizes):
* specifier.el (let-specifier):
* package-ui.el (pui-add-required-packages):
* msw-faces.el (mswindows-available-font-sizes):
* modeline.el (modeline-minor-mode-menu):
* minibuf.el (minibuf-directory-files):
Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with
the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
When these functions are handed more than two arguments, and those
arguments have no side effects, transform to a series of two
argument calls, avoiding funcall in the byte-compiled code.
* mule/mule-cmds.el (finish-set-language-environment):
Take advantage of this change in a function called 256 times at
startup.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-function-form, byte-compile-quote)
(byte-compile-quote-form):
Warn at compile time, and error at runtime, if a (quote ...) or a
(function ...) form attempts to quote more than one object.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc
(mapcar ...)) to (mapcan ...); warn about use of the first idiom.
* update-elc.el (do-autoload-commands):
* packages.el (packages-find-package-library-path):
* frame.el (frame-list):
* extents.el (extent-descendants):
* etags.el (buffer-tag-table-files):
* dumped-lisp.el (preloaded-file-list):
* device.el (device-list):
* bytecomp-runtime.el (proclaim-inline, proclaim-notinline)
Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files.
* bytecomp-runtime.el (eval-when-compile, eval-and-compile):
In passing, mention that these macros also evaluate the body when
interpreted.
tests/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test lexical scope for `block', `return-from'; add a
Known-Bug-Expect-Failure for a contorted example that fails when
byte-compiled.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Mon, 07 Feb 2011 12:01:24 +0000 |
parents | ae48681c47fa |
children | 3889ef128488 308d34e9f07d |
line wrap: on
line source
/* Implements an elisp-programmable menubar -- Gtk interface. Copyright (C) 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Tinker Systems and INS Engineering Corp. Copyright (C) 2002, 2003 Ben Wing. This file is part of XEmacs. XEmacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. XEmacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with XEmacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ /* Synched up with: Not in FSF. */ /* created 16-dec-91 by jwz */ #include <config.h> #include "lisp.h" #include "buffer.h" #include "commands.h" /* zmacs_regions */ #include "device-impl.h" #include "events.h" #include "frame-impl.h" #include "gui.h" #include "opaque.h" #include "window.h" #include "window-impl.h" #include "console-gtk-impl.h" #include "ui-gtk.h" #include "menubar.h" #ifdef HAVE_GNOME #include <libgnomeui/libgnomeui.h> #endif #define MENUBAR_TYPE 0 #define SUBMENU_TYPE 1 #define POPUP_TYPE 2 static GtkWidget *menu_descriptor_to_widget_1 (Lisp_Object descr, GtkAccelGroup* accel_group); #define FRAME_GTK_MENUBAR_DATA(f) (FRAME_GTK_DATA (f)->menubar_data) #define XFRAME_GTK_MENUBAR_DATA_LASTBUFF(f) XCAR (FRAME_GTK_MENUBAR_DATA (f)) #define XFRAME_GTK_MENUBAR_DATA_UPTODATE(f) XCDR (FRAME_GTK_MENUBAR_DATA (f)) /* This is a bogus subclass of GtkMenuBar so that the menu never tries ** to be bigger than the text widget. This prevents weird resizing ** when jumping around between buffers with radically different menu ** sizes. */ #define GTK_XEMACS_MENUBAR(obj) GTK_CHECK_CAST (obj, gtk_xemacs_menubar_get_type (), GtkXEmacsMenubar) #define GTK_XEMACS_MENUBAR_CLASS(klass) GTK_CHECK_CLASS_CAST (klass, gtk_xemacs_menubar_get_type (), GtkXEmacsMenubarClass) #define GTK_IS_XEMACS_MENUBAR(obj) GTK_CHECK_TYPE (obj, gtk_xemacs_menubar_get_type ()) #define GTK_XEMACS_MENUBAR_FRAME(obj) GTK_XEMACS_MENUBAR (obj)->f typedef struct _GtkXEmacsMenubar GtkXEmacsMenubar; typedef struct _GtkXEmacsMenubarClass GtkXEmacsMenubarClass; struct _GtkXEmacsMenubar { GtkMenuBar menu; struct frame *frame; }; struct _GtkXEmacsMenubarClass { GtkMenuBarClass parent_class; }; guint gtk_xemacs_menubar_get_type (void); GtkWidget *gtk_xemacs_menubar_new (struct frame *f); static void gtk_xemacs_menubar_class_init (GtkXEmacsMenubarClass *klass); static void gtk_xemacs_menubar_init (GtkXEmacsMenubar *xemacs); static void gtk_xemacs_menubar_size_request (GtkWidget *widget, GtkRequisition *requisition); guint gtk_xemacs_menubar_get_type (void) { static guint xemacs_menubar_type; if (!xemacs_menubar_type) { static const GtkTypeInfo xemacs_menubar_info = { "GtkXEmacsMenubar", sizeof (GtkXEmacsMenubar), sizeof (GtkXEmacsMenubarClass), (GtkClassInitFunc) gtk_xemacs_menubar_class_init, (GtkObjectInitFunc) gtk_xemacs_menubar_init, /* reserved_1 */ NULL, /* reserved_2 */ NULL, (GtkClassInitFunc) NULL, }; xemacs_menubar_type = gtk_type_unique (gtk_menu_bar_get_type (), &xemacs_menubar_info); } return xemacs_menubar_type; } static GtkWidgetClass *menubar_parent_class; static void gtk_xemacs_menubar_class_init (GtkXEmacsMenubarClass *klass) { GtkWidgetClass *widget_class; widget_class = (GtkWidgetClass*) klass; menubar_parent_class = (GtkWidgetClass *) gtk_type_class (gtk_menu_bar_get_type ()); widget_class->size_request = gtk_xemacs_menubar_size_request; } static void gtk_xemacs_menubar_init (GtkXEmacsMenubar *UNUSED (xemacs)) { } static void gtk_xemacs_menubar_size_request (GtkWidget *widget, GtkRequisition *requisition) { GtkXEmacsMenubar *x = GTK_XEMACS_MENUBAR (widget); GtkRequisition frame_size; menubar_parent_class->size_request (widget, requisition); /* #### BILL! ** We should really only do this if the menu has not been detached! ** ** WMP 9/9/2000 */ gtk_widget_size_request (FRAME_GTK_TEXT_WIDGET (x->frame), &frame_size); requisition->width = frame_size.width; } GtkWidget * gtk_xemacs_menubar_new (struct frame *f) { GtkXEmacsMenubar *menubar = (GtkXEmacsMenubar*) gtk_type_new (gtk_xemacs_menubar_get_type ()); menubar->frame = f; return (GTK_WIDGET (menubar)); } /* * Label with XEmacs accelerator character support. * * The default interfaces to GtkAccelLabel does not understand XEmacs * keystroke printing conventions, nor is it convenient in the places where is * it needed. This subclass provides an alternative interface more suited to * XEmacs needs but does not add new functionality. */ #define GTK_TYPE_XEMACS_ACCEL_LABEL (gtk_xemacs_accel_label_get_type ()) #define GTK_XEMACS_ACCEL_LABEL(obj) (GTK_CHECK_CAST ((obj), GTK_TYPE_ACCEL_LABEL, GtkXEmacsAccelLabel)) #define GTK_XEMACS_ACCEL_LABEL_CLASS(klass) (GTK_CHECK_CLASS_CAST ((klass), GTK_TYPE_ACCEL_LABEL, GtkXEmacsAccelLabelClass)) #define GTK_IS_XEMACS_ACCEL_LABEL(obj) (GTK_CHECK_TYPE ((obj), GTK_TYPE_XEMACS_ACCEL_LABEL)) #define GTK_IS_XEMACS_ACCEL_LABEL_CLASS(klass) (GTK_CHECK_CLASS_TYPE ((klass), GTK_TYPE_XEMACS_ACCEL_LABEL)) typedef struct _GtkXEmacsAccelLabel GtkXEmacsAccelLabel; typedef struct _GtkXEmacsAccelLabelClass GtkXEmacsAccelLabelClass; /* Instance structure. No additional fields required. */ struct _GtkXEmacsAccelLabel { GtkAccelLabel label; }; /* Class structure. No additional fields required. */ struct _GtkXEmacsAccelLabelClass { GtkAccelLabelClass parent_class; }; static GtkType gtk_xemacs_accel_label_get_type(void); static GtkWidget* gtk_xemacs_accel_label_new(const gchar *string); static void gtk_xemacs_set_accel_keys(GtkXEmacsAccelLabel* l, Lisp_Object keys); static void gtk_xemacs_accel_label_class_init(GtkXEmacsAccelLabelClass *klass); static void gtk_xemacs_accel_label_init(GtkXEmacsAccelLabel *xemacs); static GtkType gtk_xemacs_accel_label_get_type(void) { static GtkType xemacs_accel_label_type = 0; if (!xemacs_accel_label_type) { static const GtkTypeInfo xemacs_accel_label_info = { "GtkXEmacsAccelLabel", sizeof (GtkXEmacsAccelLabel), sizeof (GtkXEmacsAccelLabelClass), (GtkClassInitFunc) gtk_xemacs_accel_label_class_init, (GtkObjectInitFunc) gtk_xemacs_accel_label_init, /* reserved_1 */ NULL, /* reserved_2 */ NULL, (GtkClassInitFunc) NULL, }; xemacs_accel_label_type = gtk_type_unique (gtk_accel_label_get_type(), &xemacs_accel_label_info); } return xemacs_accel_label_type; } static void gtk_xemacs_accel_label_class_init(GtkXEmacsAccelLabelClass *UNUSED (klass)) { /* Nothing to do. */ } static void gtk_xemacs_accel_label_init(GtkXEmacsAccelLabel *UNUSED (xemacs)) { /* Nothing to do. */ } static GtkWidget* gtk_xemacs_accel_label_new (const gchar *string) { GtkXEmacsAccelLabel *xemacs_accel_label; xemacs_accel_label = (GtkXEmacsAccelLabel*) gtk_type_new (GTK_TYPE_XEMACS_ACCEL_LABEL); if (string && *string) gtk_label_set_text (GTK_LABEL (xemacs_accel_label), string); return GTK_WIDGET (xemacs_accel_label); } /* Make the string <keys> the accelerator string for the label. */ static void gtk_xemacs_set_accel_keys(GtkXEmacsAccelLabel* l, Lisp_Object keys) { g_return_if_fail (l != NULL); g_return_if_fail (GTK_IS_XEMACS_ACCEL_LABEL (l)); /* Disable the standard way of finding the accelerator string for the label. */ gtk_accel_label_set_accel_widget (GTK_ACCEL_LABEL(l), NULL); /* Set the string straight from the object. */ if (STRINGP (keys) && XSTRING_LENGTH (keys)) { l->label.accel_string = ITEXT_TO_EXTERNAL_MALLOC (XSTRING_DATA (keys), Qctext); } else { /* l->label.accel_string = NULL;*/ } } /* We now return you to your regularly scheduled menus... */ int dockable_menubar; /* #define TEAR_OFF_MENUS */ #ifdef TEAR_OFF_MENUS int tear_off_menus; #endif /* Converting from XEmacs to GTK representation */ static Lisp_Object menu_name_to_accelerator (Ibyte *name) { while (*name) { if (*name=='%') { ++name; if (!(*name)) return Qnil; if (*name=='_' && *(name+1)) { int accelerator = (int) (*(name+1)); return make_char (tolower (accelerator)); } } ++name; } return Qnil; } #define XEMACS_MENU_DESCR_TAG "xemacs::menu::description" #define XEMACS_MENU_FILTER_TAG "xemacs::menu::filter" #define XEMACS_MENU_GUIID_TAG "xemacs::menu::gui_id" #define XEMACS_MENU_FIRSTTIME_TAG "xemacs::menu::first_time" static void __activate_menu(GtkMenuItem *, gpointer); #ifdef TEAR_OFF_MENUS static void __torn_off_sir(GtkMenuItem *UNUSED (item), gpointer user_data) { GtkWidget *menu_item = GTK_WIDGET (user_data); if (GTK_TEAROFF_MENU_ITEM (item)->torn_off) { /* Menu was just torn off */ GUI_ID id = new_gui_id (); Lisp_Object menu_desc = Qnil; GtkWidget *old_submenu = GTK_MENU_ITEM (menu_item)->submenu; menu_desc = GET_LISP_FROM_VOID (gtk_object_get_data (GTK_OBJECT (menu_item), XEMACS_MENU_DESCR_TAG)); /* GCPRO all of our very own */ gcpro_popup_callbacks (id, menu_desc); /* Hide the now detached menu from the attentions of __activate_menu destroying the old submenu */ #if 0 gtk_widget_ref (old_submenu); gtk_menu_item_set_submenu (GTK_MENU_ITEM (menu_item), gtk_menu_new ()); gtk_widget_show_all (old_submenu); #endif } } #endif /* This is called when a menu is about to be shown... this is what does the delayed creation of the menu items. We populate the submenu and away we go. */ static void __maybe_destroy (GtkWidget *child, GtkWidget *UNUSED (precious)) { if (GTK_IS_MENU_ITEM (child) && !GTK_IS_TEAROFF_MENU_ITEM (child)) { if (GTK_WIDGET_VISIBLE (child)) { /* If we delete the menu item that was 'active' when the menu was cancelled, GTK gets upset because it tries to remove the focus rectangle from a (now) dead widget. This widget will eventually get killed because it will not be visible the next time the window is shown. */ gtk_widget_set_sensitive (child, FALSE); gtk_widget_hide_all (child); } else { gtk_widget_destroy (child); } } } /* If user_data != 0x00 then we are using a hook to build the menu. */ static void __activate_menu(GtkMenuItem *item, gpointer user_data) { Lisp_Object desc; gpointer force_clear = gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_FIRSTTIME_TAG); gtk_object_set_data (GTK_OBJECT (item), XEMACS_MENU_FIRSTTIME_TAG, 0x00); /* Delete the old contents of the menu if we are the top level menubar */ if (GTK_IS_MENU_BAR (GTK_WIDGET (item)->parent) || force_clear) { GtkWidget *selected = gtk_menu_get_active (GTK_MENU (item->submenu)); gtk_container_foreach (GTK_CONTAINER (item->submenu),(GtkCallback) __maybe_destroy, selected); } else if (gtk_container_children (GTK_CONTAINER (item->submenu))) { return; } desc = GET_LISP_FROM_VOID (gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_DESCR_TAG)); #ifdef TEAR_OFF_MENUS /* Lets stick in a detacher just for giggles */ if (tear_off_menus && !gtk_container_children (GTK_CONTAINER (item->submenu))) { GtkWidget *w = gtk_tearoff_menu_item_new (); gtk_widget_show (w); gtk_menu_append (GTK_MENU (item->submenu), w); gtk_signal_connect (GTK_OBJECT (w), "activate", GTK_SIGNAL_FUNC (__torn_off_sir), item); } #endif if (user_data) { GUI_ID id = (GUI_ID) gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_GUIID_TAG); Lisp_Object hook_fn; struct gcpro gcpro1, gcpro2; hook_fn = GET_LISP_FROM_VOID (gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_FILTER_TAG)); GCPRO2 (desc, hook_fn); desc = call1 (hook_fn, desc); UNGCPRO; ungcpro_popup_callbacks (id); gcpro_popup_callbacks (id, desc); } /* Build the child widgets */ for (; !NILP (desc); desc = Fcdr (desc)) { GtkWidget *next = NULL; Lisp_Object child = Fcar (desc); if (NILP (child)) /* the partition */ { /* Signal an error here? The NILP handling is handled a layer higher where appropriate */ } else { next = menu_descriptor_to_widget_1 (child, gtk_menu_ensure_uline_accel_group (GTK_MENU (item->submenu))); } if (!next) { continue; } gtk_widget_show_all (next); gtk_menu_append (GTK_MENU (item->submenu), next); } } /* This is called whenever an item with a GUI_ID associated with it is destroyed. This allows us to remove the references in gui-gtk.c that made sure callbacks and such were GCPRO-ed */ static void __remove_gcpro_by_id (gpointer user_data) { ungcpro_popup_callbacks ((GUI_ID) user_data); } static void __kill_stupid_gtk_timer (GtkObject *obj, gpointer UNUSED (user_data)) { GtkMenuItem *mi = GTK_MENU_ITEM (obj); if (mi->timer) { gtk_timeout_remove (mi->timer); mi->timer = 0; } } /* Convert the XEmacs menu accelerator representation to Gtk mnemonic form. If no accelerator has been provided, put one at the start of the string (this mirrors the behaviour under X). This algorithm is also found in dialog-gtk.el:gtk-popup-convert-underscores. */ static char * convert_underscores(const Ibyte *name) { char *rval; int i,j; int found_accel = FALSE; int underscores = 0; for (i = 0; name[i]; ++i) if (name[i] == '%' && name[i+1] == '_') { found_accel = TRUE; } else if (name[i] == '_') { underscores++; } /* Allocate space for the original string, plus zero byte plus extra space for all quoted underscores plus possible additional leading accelerator. */ rval = (char*) xmalloc_and_zero (qxestrlen(name) + 1 + underscores + (found_accel ? 0 : 1)); if (!found_accel) rval[0] = '_'; for (i = 0, j = (found_accel ? 0 : 1); name[i]; i++) { if (name[i]=='%') { i++; if (!(name[i])) continue; if ((name[i] != '_') && (name[i] != '%')) i--; found_accel = TRUE; } else if (name[i] == '_') { rval[j++] = '_'; } rval[j++] = name[i]; } return rval; } /* Remove the XEmacs menu accellerator representation from a string. */ static char * remove_underscores(const Ibyte *name) { char *rval = (char*) xmalloc_and_zero (qxestrlen(name) + 1); int i,j; for (i = 0, j = 0; name[i]; i++) { if (name[i]=='%') { i++; if (!(name[i])) continue; if ((name[i] != '_') && (name[i] != '%')) i--; else continue; } rval[j++] = name[i]; } return rval; } /* This converts an entire menu into a GtkMenuItem (with an attached submenu). A menu is a list of (STRING [:keyword value]+ [DESCR]+) DESCR is either a list (meaning a submenu), a vector, or nil (if you include a :filter keyword) */ static GtkWidget * menu_convert (Lisp_Object desc, GtkWidget *reuse, GtkAccelGroup* menubar_accel_group) { GtkWidget *menu_item = NULL; GtkWidget *submenu = NULL; Lisp_Object key, val; Lisp_Object include_p = Qnil, hook_fn = Qnil, config_tag = Qnil; Lisp_Object active_p = Qt; Lisp_Object accel; int included_spec = 0; int active_spec = 0; if (STRINGP (XCAR (desc))) { accel = menu_name_to_accelerator (XSTRING_DATA (XCAR (desc))); if (!reuse) { char *temp_menu_name = convert_underscores (XSTRING_DATA (XCAR (desc))); GtkWidget* accel_label = gtk_xemacs_accel_label_new(NULL); guint accel_key; gtk_misc_set_alignment (GTK_MISC (accel_label), 0.0, 0.5); accel_key = gtk_label_parse_uline (GTK_LABEL (accel_label), temp_menu_name); menu_item = gtk_menu_item_new (); gtk_container_add (GTK_CONTAINER (menu_item), accel_label); gtk_widget_show (accel_label); if (menubar_accel_group) gtk_widget_add_accelerator (menu_item, "activate_item", menubar_accel_group, accel_key, GDK_MOD1_MASK, GTK_ACCEL_LOCKED); free (temp_menu_name); } else { menu_item = reuse; } submenu = gtk_menu_new (); gtk_widget_show (menu_item); gtk_widget_show (submenu); if (!reuse) gtk_signal_connect (GTK_OBJECT (menu_item), "destroy", GTK_SIGNAL_FUNC (__kill_stupid_gtk_timer), NULL); /* Without this sometimes a submenu gets left on the screen - ** urk */ if (GTK_MENU_ITEM (menu_item)->submenu) { gtk_widget_destroy (GTK_MENU_ITEM (menu_item)->submenu); } gtk_menu_item_set_submenu (GTK_MENU_ITEM (menu_item), submenu); /* We put this bogus menu item in so that GTK does the right ** thing when the menu is near the screen border. ** ** Aug 29, 2000 */ { GtkWidget *bogus_item = gtk_menu_item_new_with_label ("A suitably long label here..."); gtk_object_set_data (GTK_OBJECT (menu_item), XEMACS_MENU_FIRSTTIME_TAG, (gpointer)0x01); gtk_widget_show_all (bogus_item); gtk_menu_append (GTK_MENU (submenu), bogus_item); } desc = Fcdr (desc); while (key = Fcar (desc), KEYWORDP (key)) { Lisp_Object cascade = desc; desc = Fcdr (desc); if (NILP (desc)) sferror ("keyword in menu lacks a value", cascade); val = Fcar (desc); desc = Fcdr (desc); if (EQ (key, Q_included)) include_p = val, included_spec = 1; else if (EQ (key, Q_config)) config_tag = val; else if (EQ (key, Q_filter)) hook_fn = val; else if (EQ (key, Q_active)) active_p = val, active_spec = 1; else if (EQ (key, Q_accelerator)) { #if 0 if ( SYMBOLP (val) || CHARP (val)) wv->accel = STORE_LISP_IN_VOID (val); else invalid_argument ("bad keyboard accelerator", val); #endif } else if (EQ (key, Q_label)) { /* implement in 21.2 */ } else invalid_argument ("unknown menu cascade keyword", cascade); } gtk_object_set_data (GTK_OBJECT (menu_item), XEMACS_MENU_DESCR_TAG, STORE_LISP_IN_VOID (desc)); gtk_object_set_data (GTK_OBJECT (menu_item), XEMACS_MENU_FILTER_TAG, STORE_LISP_IN_VOID (hook_fn)); if ((!NILP (config_tag) && NILP (Fmemq (config_tag, Vmenubar_configuration))) || (included_spec && NILP (IGNORE_MULTIPLE_VALUES (Feval (include_p))))) { return (NULL); } if (active_spec) active_p = IGNORE_MULTIPLE_VALUES (Feval (active_p)); gtk_widget_set_sensitive (GTK_WIDGET (menu_item), ! NILP (active_p)); } else { invalid_argument ("menu name (first element) must be a string", desc); } /* If we are reusing a widget, we need to make sure we clean ** everything up. */ if (reuse) { gpointer id = gtk_object_get_data (GTK_OBJECT (reuse), XEMACS_MENU_GUIID_TAG); if (id) { /* If the menu item had a GUI_ID that means it was a filter menu */ __remove_gcpro_by_id (id); gtk_signal_disconnect_by_func (GTK_OBJECT (reuse), GTK_SIGNAL_FUNC (__activate_menu), (gpointer) 0x01 ); } else { gtk_signal_disconnect_by_func (GTK_OBJECT (reuse), GTK_SIGNAL_FUNC (__activate_menu), NULL); } GTK_MENU_ITEM (reuse)->right_justify = 0; } if (NILP (hook_fn)) { /* Generic menu builder */ gtk_signal_connect (GTK_OBJECT (menu_item), "activate", GTK_SIGNAL_FUNC (__activate_menu), NULL); } else { GUI_ID id = new_gui_id (); gtk_object_set_data (GTK_OBJECT (menu_item), XEMACS_MENU_GUIID_TAG, (gpointer) id); /* Make sure we gcpro the menu descriptions */ gcpro_popup_callbacks (id, desc); gtk_object_weakref (GTK_OBJECT (menu_item), __remove_gcpro_by_id, (gpointer) id); gtk_signal_connect (GTK_OBJECT (menu_item), "activate", GTK_SIGNAL_FUNC (__activate_menu), (gpointer) 0x01); } return (menu_item); } /* Called whenever a button, radio, or toggle is selected in the menu */ static void __generic_button_callback (GtkMenuItem *item, gpointer user_data) { Lisp_Object callback, function, data, channel; channel = wrap_frame (gtk_widget_to_frame (GTK_WIDGET (item))); callback = GET_LISP_FROM_VOID (user_data); get_gui_callback (callback, &function, &data); signal_special_gtk_user_event (channel, function, data); } /* Convert a single menu item descriptor to a suitable GtkMenuItem */ /* This function cannot GC. It is only called from menu_item_descriptor_to_widget_value, which prohibits GC. */ static GtkWidget * menu_descriptor_to_widget_1 (Lisp_Object descr, GtkAccelGroup* accel_group) { if (STRINGP (descr)) { /* It is a separator. Unfortunately GTK does not allow us to specify what our separators look like, so we can't do all the fancy stuff that the X code does. */ return (gtk_menu_item_new ()); } else if (LISTP (descr)) { /* It is a submenu */ return (menu_convert (descr, NULL, accel_group)); } else if (VECTORP (descr)) { /* An actual menu item description! This gets yucky. */ Lisp_Object name = Qnil; Lisp_Object callback = Qnil; Lisp_Object suffix = Qnil; Lisp_Object active_p = Qt; Lisp_Object include_p = Qt; Lisp_Object selected_p = Qnil; Lisp_Object keys = Qnil; Lisp_Object style = Qnil; Lisp_Object config_tag = Qnil; Lisp_Object accel = Qnil; GtkWidget *main_label = NULL; int length = XVECTOR_LENGTH (descr); Lisp_Object *contents = XVECTOR_DATA (descr); int plist_p; int selected_spec = 0, included_spec = 0; GtkWidget *widget = NULL; guint accel_key; if (length < 2) sferror ("button descriptors must be at least 2 long", descr); /* length 2: [ "name" callback ] length 3: [ "name" callback active-p ] length 4: [ "name" callback active-p suffix ] or [ "name" callback keyword value ] length 5+: [ "name" callback [ keyword value ]+ ] */ plist_p = (length >= 5 || (length > 2 && KEYWORDP (contents [2]))); if (!plist_p && length > 2) /* the old way */ { name = contents [0]; callback = contents [1]; active_p = contents [2]; if (length == 4) suffix = contents [3]; } else { /* the new way */ int i; if (length & 1) sferror ( "button descriptor has an odd number of keywords and values", descr); name = contents [0]; callback = contents [1]; for (i = 2; i < length;) { Lisp_Object key = contents [i++]; Lisp_Object val = contents [i++]; if (!KEYWORDP (key)) invalid_argument_2 ("not a keyword", key, descr); if (EQ (key, Q_active)) active_p = val; else if (EQ (key, Q_suffix)) suffix = val; else if (EQ (key, Q_keys)) keys = val; else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compat */ else if (EQ (key, Q_label)) ; /* implement for 21.0 */ else if (EQ (key, Q_style)) style = val; else if (EQ (key, Q_selected)) selected_p = val, selected_spec = 1; else if (EQ (key, Q_included)) include_p = val, included_spec = 1; else if (EQ (key, Q_config)) config_tag = val; else if (EQ (key, Q_accelerator)) { if ( SYMBOLP (val) || CHARP (val)) accel = val; else invalid_argument ("bad keyboard accelerator", val); } else if (EQ (key, Q_filter)) sferror(":filter keyword not permitted on leaf nodes", descr); else invalid_argument_2 ("unknown menu item keyword", key, descr); } } #ifdef HAVE_MENUBARS if ((!NILP (config_tag) && NILP (Fmemq (config_tag, Vmenubar_configuration))) || (included_spec && NILP (IGNORE_MULTIPLE_VALUES (Feval (include_p))))) { /* the include specification says to ignore this item. */ return 0; } #endif /* HAVE_MENUBARS */ CHECK_STRING (name); if (NILP (accel)) accel = menu_name_to_accelerator (XSTRING_DATA (name)); if (!NILP (suffix)) suffix = IGNORE_MULTIPLE_VALUES (Feval (suffix)); if (!separator_string_p (XSTRING_DATA (name))) { Ibyte *label_buffer = NULL; char *temp_label = NULL; if (STRINGP (suffix) && XSTRING_LENGTH (suffix)) { /* !!#### */ label_buffer = alloca_ibytes (XSTRING_LENGTH (name) + 15 + XSTRING_LENGTH (suffix)); qxesprintf (label_buffer, "%s %s ", XSTRING_DATA (name), XSTRING_DATA (suffix)); } else { label_buffer = alloca_ibytes (XSTRING_LENGTH (name) + 15); qxesprintf (label_buffer, "%s ", XSTRING_DATA (name)); } temp_label = convert_underscores (label_buffer); main_label = gtk_xemacs_accel_label_new (NULL); accel_key = gtk_label_parse_uline (GTK_LABEL (main_label), temp_label); free (temp_label); } /* Evaluate the selected and active items now */ if (selected_spec) { if (NILP (selected_p) || EQ (selected_p, Qt)) { /* Do nothing */ } else { selected_p = IGNORE_MULTIPLE_VALUES (Feval (selected_p)); } } if (NILP (active_p) || EQ (active_p, Qt)) { /* Do Nothing */ } else { active_p = IGNORE_MULTIPLE_VALUES (Feval (active_p)); } if (0 || #ifdef HAVE_MENUBARS menubar_show_keybindings #endif ) { /* Need to get keybindings */ if (!NILP (keys)) { /* User-specified string to generate key bindings with */ CHECK_STRING (keys); keys = Fsubstitute_command_keys (keys); } else if (SYMBOLP (callback)) { DECLARE_EISTRING_MALLOC (buf); /* #### Warning, dependency here on current_buffer and point */ where_is_to_char (callback, buf); if (eilen (buf) > 0) keys = eimake_string (buf); else { keys = Qnil; } eifree (buf); } } /* Now we get down to the dirty business of creating the widgets */ if (NILP (style) || EQ (style, Qtext) || EQ (style, Qbutton)) { /* A normal menu item */ widget = gtk_menu_item_new (); } else if (EQ (style, Qtoggle) || EQ (style, Qradio)) { /* They are radio or toggle buttons. XEmacs' menu descriptions are fairly lame in that they do not have the idea of a 'group' of radio buttons. They are exactly like toggle buttons except that they get drawn differently. GTK rips us a new one again. If you have a radio button in a group by itself, it always draws it as highlighted. So we dummy up and create a second radio button that does not get added to the menu, but gets invisibly set/unset when the other gets unset/set. *sigh* */ if (EQ (style, Qradio)) { GtkWidget *dummy_sibling = NULL; GSList *group = NULL; dummy_sibling = gtk_radio_menu_item_new (group); group = gtk_radio_menu_item_group (GTK_RADIO_MENU_ITEM (dummy_sibling)); widget = gtk_radio_menu_item_new (group); /* We need to notice when the 'real' one gets destroyed so we can clean up the dummy as well. */ gtk_object_weakref (GTK_OBJECT (widget), (GtkDestroyNotify) gtk_widget_destroy, dummy_sibling); } else { widget = gtk_check_menu_item_new (); } /* What horrible defaults you have GTK dear! The default for a toggle menu item is to not show the toggle unless it is turned on or actively highlighted. How absolutely hideous. */ gtk_check_menu_item_set_show_toggle (GTK_CHECK_MENU_ITEM (widget), TRUE); gtk_check_menu_item_set_active (GTK_CHECK_MENU_ITEM (widget), NILP (selected_p) ? FALSE : TRUE); } else { invalid_argument_2 ("unknown style", style, descr); } gtk_widget_set_sensitive (widget, ! NILP (active_p)); gtk_signal_connect (GTK_OBJECT (widget), "activate-item", GTK_SIGNAL_FUNC (__generic_button_callback), STORE_LISP_IN_VOID (callback)); gtk_signal_connect (GTK_OBJECT (widget), "activate", GTK_SIGNAL_FUNC (__generic_button_callback), STORE_LISP_IN_VOID (callback)); /* Now that all the information about the menu item is know, set the remaining properties. */ if (main_label) { gtk_container_add (GTK_CONTAINER (widget), main_label); gtk_misc_set_alignment (GTK_MISC (main_label), 0.0, 0.5); gtk_xemacs_set_accel_keys(GTK_XEMACS_ACCEL_LABEL(main_label), keys); if (accel_group) gtk_widget_add_accelerator (widget, "activate_item", accel_group, accel_key, 0, GTK_ACCEL_LOCKED); } return (widget); } else { return (NULL); /* ABORT (); ???? */ } } static GtkWidget * menu_descriptor_to_widget (Lisp_Object descr, GtkAccelGroup* accel_group) { GtkWidget *rval = NULL; int count = begin_gc_forbidden (); /* Cannot GC from here on out... */ rval = menu_descriptor_to_widget_1 (descr, accel_group); unbind_to (count); return (rval); } static gboolean menu_can_reuse_widget (GtkWidget *child, const Ibyte *label) { /* Everything up at the top level was done using ** gtk_xemacs_accel_label_new(), but we still double check to make ** sure we don't seriously foobar ourselves. */ gpointer possible_child = g_list_nth_data (gtk_container_children (GTK_CONTAINER (child)), 0); gboolean ret_val = FALSE; if (possible_child && GTK_IS_LABEL (possible_child)) { char *temp_label = remove_underscores (label); if (!strcmp (GTK_LABEL (possible_child)->label, temp_label)) ret_val = TRUE; free (temp_label); } return ret_val; } /* Converts a menubar description into a GtkMenuBar... a menubar is a list of menus or buttons */ static void menu_create_menubar (struct frame *f, Lisp_Object descr) { gboolean right_justify = FALSE; Lisp_Object value = descr; GtkWidget *menubar = FRAME_GTK_MENUBAR_WIDGET (f); GUI_ID id = (GUI_ID) gtk_object_get_data (GTK_OBJECT (menubar), XEMACS_MENU_GUIID_TAG); guint menu_position = 0; GtkAccelGroup *menubar_accel_group; /* Remove any existing protection for old menu items */ ungcpro_popup_callbacks (id); /* GCPRO the whole damn thing */ gcpro_popup_callbacks (id, descr); menubar_accel_group = gtk_accel_group_new(); { EXTERNAL_LIST_LOOP_2 (item_descr, value) { gpointer current_child = g_list_nth_data (GTK_MENU_SHELL (menubar)->children, menu_position); if (NILP (item_descr)) { /* Need to start right-justifying menus */ right_justify = TRUE; menu_position--; } else if (VECTORP (item_descr)) { /* It is a button description */ GtkWidget *item; item = menu_descriptor_to_widget (item_descr, menubar_accel_group); gtk_widget_set_name (item, "XEmacsMenuButton"); if (!item) { item = gtk_menu_item_new_with_label ("ITEM CREATION ERROR"); } gtk_widget_show_all (item); if (current_child) gtk_widget_destroy (GTK_WIDGET (current_child)); gtk_menu_bar_insert (GTK_MENU_BAR (menubar), item, menu_position); } else if (LISTP (item_descr)) { /* Need to actually convert it into a menu and slap it in */ GtkWidget *widget; gboolean reused_p = FALSE; /* We may be able to reuse the widget, let's at least check. */ if (current_child && menu_can_reuse_widget (GTK_WIDGET (current_child), XSTRING_DATA (XCAR (item_descr)))) { widget = menu_convert (item_descr, GTK_WIDGET (current_child), menubar_accel_group); reused_p = TRUE; } else { widget = menu_convert (item_descr, NULL, menubar_accel_group); if (current_child) gtk_widget_destroy (GTK_WIDGET (current_child)); gtk_menu_bar_insert (GTK_MENU_BAR (menubar), widget, menu_position); } if (widget) { if (right_justify) gtk_menu_item_right_justify (GTK_MENU_ITEM (widget)); } else { widget = gtk_menu_item_new_with_label ("ERROR"); /* ABORT() */ } gtk_widget_show_all (widget); } else if (STRINGP (item_descr)) { /* Do I really want to be this careful? Anything else in a menubar description is illegal */ } menu_position++; } } /* Need to delete any menu items that were past the bounds of the new one */ { GList *l = NULL; while ((l = g_list_nth (GTK_MENU_SHELL (menubar)->children, menu_position))) { gpointer data = l->data; g_list_remove_link (GTK_MENU_SHELL (menubar)->children, l); if (data) { gtk_widget_destroy (GTK_WIDGET (data)); } } } /* Attach the new accelerator group to the frame. */ gtk_window_add_accel_group (GTK_WINDOW (FRAME_GTK_SHELL_WIDGET(f)), menubar_accel_group); } /* Deal with getting/setting the menubar */ #ifndef GNOME_IS_APP #define GNOME_IS_APP(x) 0 #define gnome_app_set_menus(x,y) #endif static gboolean run_menubar_hook (GtkWidget *widget, GdkEventButton *UNUSED (event), gpointer UNUSED (user_data)) { if (!GTK_MENU_SHELL(widget)->active) { run_hook (Qactivate_menubar_hook); } return(FALSE); } static void create_menubar_widget (struct frame *f) { GUI_ID id = new_gui_id (); GtkWidget *handlebox = NULL; GtkWidget *menubar = gtk_xemacs_menubar_new (f); if (GNOME_IS_APP (FRAME_GTK_SHELL_WIDGET (f))) { gnome_app_set_menus (GNOME_APP (FRAME_GTK_SHELL_WIDGET (f)), GTK_MENU_BAR (menubar)); } else if (dockable_menubar) { handlebox = gtk_handle_box_new (); gtk_handle_box_set_handle_position (GTK_HANDLE_BOX (handlebox), GTK_POS_LEFT); gtk_container_add (GTK_CONTAINER (handlebox), menubar); gtk_box_pack_start (GTK_BOX (FRAME_GTK_CONTAINER_WIDGET (f)), handlebox, FALSE, FALSE, 0); } else { gtk_box_pack_start (GTK_BOX (FRAME_GTK_CONTAINER_WIDGET (f)), menubar, FALSE, FALSE, 0); } gtk_signal_connect (GTK_OBJECT (menubar), "button-press-event", GTK_SIGNAL_FUNC (run_menubar_hook), NULL); FRAME_GTK_MENUBAR_WIDGET (f) = menubar; gtk_object_set_data (GTK_OBJECT (menubar), XEMACS_MENU_GUIID_TAG, (gpointer) id); gtk_object_weakref (GTK_OBJECT (menubar), __remove_gcpro_by_id, (gpointer) id); } static int set_frame_menubar (struct frame *f, int first_time_p) { Lisp_Object menubar; int menubar_visible; /* As for the toolbar, the minibuffer does not have its own menubar. */ struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); if (! FRAME_GTK_P (f)) return 0; /***** first compute the contents of the menubar *****/ if (! first_time_p) { /* evaluate `current-menubar' in the buffer of the selected window of the frame in question. */ menubar = symbol_value_in_buffer (Qcurrent_menubar, w->buffer); } else { /* That's a little tricky the first time since the frame isn't fully initialized yet. */ menubar = Fsymbol_value (Qcurrent_menubar); } if (NILP (menubar)) { menubar = Vblank_menubar; menubar_visible = 0; } else { menubar_visible = !NILP (w->menubar_visible_p); } if (!FRAME_GTK_MENUBAR_WIDGET (f)) { create_menubar_widget (f); } /* Populate the menubar, but nothing is shown yet */ { Lisp_Object old_buffer; int count = specpdl_depth (); old_buffer = Fcurrent_buffer (); record_unwind_protect (Fset_buffer, old_buffer); Fset_buffer (XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer); menu_create_menubar (f, menubar); Fset_buffer (old_buffer); unbind_to (count); } FRAME_GTK_MENUBAR_DATA (f) = Fcons (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer, Qt); return (menubar_visible); } /* Called from gtk_create_widgets() to create the inital menubar of a frame before it is mapped, so that the window is mapped with the menubar already there instead of us tacking it on later and thrashing the window after it is visible. */ int gtk_initialize_frame_menubar (struct frame *f) { create_menubar_widget (f); return set_frame_menubar (f, 1); } static void gtk_update_frame_menubar_internal (struct frame *f) { /* We assume the menubar contents has changed if the global flag is set, or if the current buffer has changed, or if the menubar has never been updated before. */ int menubar_contents_changed = (f->menubar_changed || NILP (FRAME_GTK_MENUBAR_DATA (f)) || (!EQ (XFRAME_GTK_MENUBAR_DATA_LASTBUFF (f), XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer))); gboolean menubar_was_visible = GTK_WIDGET_VISIBLE (FRAME_GTK_MENUBAR_WIDGET (f)); gboolean menubar_will_be_visible = menubar_was_visible; gboolean menubar_visibility_changed; if (menubar_contents_changed) { menubar_will_be_visible = set_frame_menubar (f, 0); } menubar_visibility_changed = menubar_was_visible != menubar_will_be_visible; if (!menubar_visibility_changed) { return; } /* We hide and show the menubar's parent (which is actually the GtkHandleBox)... this is to simplify the code that destroys old menu items, etc. There is no easy way to get the child out of a handle box, and I didn't want to add yet another stupid widget slot to struct gtk_frame. */ if (menubar_will_be_visible) { gtk_widget_show_all (FRAME_GTK_MENUBAR_WIDGET (f)->parent); } else { gtk_widget_hide_all (FRAME_GTK_MENUBAR_WIDGET (f)->parent); } MARK_FRAME_SIZE_SLIPPED (f); } static void gtk_update_frame_menubars (struct frame *f) { GtkWidget *menubar = NULL; assert (FRAME_GTK_P (f)); menubar = FRAME_GTK_MENUBAR_WIDGET (f); if ((GTK_MENU_SHELL (menubar)->active) || (GTK_MENU_SHELL (menubar)->have_grab) || (GTK_MENU_SHELL (menubar)->have_xgrab)) { return; } gtk_update_frame_menubar_internal (f); } static void gtk_free_frame_menubars (struct frame *f) { GtkWidget *menubar_widget; assert (FRAME_GTK_P (f)); menubar_widget = FRAME_GTK_MENUBAR_WIDGET (f); if (menubar_widget) { gtk_widget_destroy (menubar_widget); } } static void popdown_menu_cb (GtkMenuShell *UNUSED (menu), gpointer UNUSED (user_data)) { popup_up_p--; } static void gtk_popup_menu (Lisp_Object menu_desc, Lisp_Object event) { struct Lisp_Event *eev = NULL; GtkWidget *widget = NULL; GtkWidget *menu = NULL; gpointer id = NULL; /* Do basic error checking first... */ if (SYMBOLP (menu_desc)) menu_desc = Fsymbol_value (menu_desc); CHECK_CONS (menu_desc); CHECK_STRING (XCAR (menu_desc)); /* Now lets get down to business... */ widget = menu_descriptor_to_widget (menu_desc, NULL); menu = GTK_MENU_ITEM (widget)->submenu; gtk_widget_set_name (widget, "XEmacsPopupMenu"); id = gtk_object_get_data (GTK_OBJECT (widget), XEMACS_MENU_GUIID_TAG); __activate_menu (GTK_MENU_ITEM (widget), id); if (!NILP (event)) { CHECK_LIVE_EVENT (event); eev = XEVENT (event); if ((eev->event_type != button_press_event) && (eev->event_type != button_release_event)) wrong_type_argument (Qmouse_event_p, event); } else if (!NILP (Vthis_command_keys)) { /* If an event wasn't passed, use the last event of the event sequence currently being executed, if that event is a mouse event. */ eev = XEVENT (Vthis_command_keys); if ((eev->event_type != button_press_event) && (eev->event_type != button_release_event)) eev = NULL; } gtk_widget_show (menu); popup_up_p++; gtk_signal_connect (GTK_OBJECT (menu), "deactivate", GTK_SIGNAL_FUNC (popdown_menu_cb), NULL); gtk_menu_popup (GTK_MENU (menu), NULL, NULL, NULL, NULL, eev ? EVENT_BUTTON_BUTTON (eev) : 0, eev ? eev->timestamp : GDK_CURRENT_TIME); } DEFUN ("gtk-build-xemacs-menu", Fgtk_build_xemacs_menu, 1, 1, 0, /* Returns a GTK menu item from MENU, a standard XEmacs menu description. See the definition of `popup-menu' for more information on the format of MENU. */ (menu)) { GtkWidget *w = menu_descriptor_to_widget (menu, NULL); return (w ? build_gtk_object (GTK_OBJECT (w)) : Qnil); } void syms_of_menubar_gtk (void) { DEFSUBR (Fgtk_build_xemacs_menu); } void console_type_create_menubar_gtk (void) { CONSOLE_HAS_METHOD (gtk, update_frame_menubars); CONSOLE_HAS_METHOD (gtk, free_frame_menubars); CONSOLE_HAS_METHOD (gtk, popup_menu); } void reinit_vars_of_menubar_gtk (void) { dockable_menubar = 1; #ifdef TEAR_OFF_MENUS tear_off_menus = 1; #endif } void vars_of_menubar_gtk (void) { Fprovide (intern ("gtk-menubars")); DEFVAR_BOOL ("menubar-dockable-p", &dockable_menubar /* If non-nil, the frame menubar can be detached into its own top-level window. */ ); #ifdef TEAR_OFF_MENUS DEFVAR_BOOL ("menubar-tearable-p", &tear_off_menus /* If non-nil, menus can be torn off into their own top-level windows. */ ); #endif } /*---------------------------------------------------------------------------*/