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
}

/*---------------------------------------------------------------------------*/