Mercurial > hg > xemacs-beta
view src/menubar.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 | 19a72041c5ed |
| children | 308d34e9f07d |
line wrap: on
line source
/* Implements an elisp-programmable menubar. Copyright (C) 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Tinker Systems and INS Engineering Corp. Copyright (C) 2001, 2002, 2003, 2005 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. */ /* Authorship: Created by Ben Wing as part of device-abstraction work for 19.12. Menu filters and many other keywords added by Stig for 19.12. Menu accelerators c. 1997? by ??. Moved here from event-stream.c. Much other work post-1996 by ??. */ #include <config.h> #include "lisp.h" #include "buffer.h" #include "device-impl.h" #include "frame-impl.h" #include "gui.h" #include "keymap.h" #include "menubar.h" #include "redisplay.h" #include "specifier.h" #include "window-impl.h" int menubar_show_keybindings; Lisp_Object Vmenubar_configuration; Lisp_Object Qcurrent_menubar; Lisp_Object Qactivate_menubar_hook, Vactivate_menubar_hook; Lisp_Object Vmenubar_visible_p; static Lisp_Object Vcurrent_menubar; /* DO NOT ever reference this. Always go through Qcurrent_menubar. See below. */ Lisp_Object Vblank_menubar; int popup_menu_titles; int in_menu_callback; Lisp_Object Vmenubar_pointer_glyph; /* prefix key(s) that must match in order to activate menu. This is ugly. fix me. */ Lisp_Object Vmenu_accelerator_prefix; /* list of modifier keys to match accelerator for top level menus */ Lisp_Object Vmenu_accelerator_modifiers; /* whether menu accelerators are enabled */ Lisp_Object Vmenu_accelerator_enabled; /* keymap for auxiliary menu accelerator functions */ Lisp_Object Vmenu_accelerator_map; Lisp_Object Qmenu_force; Lisp_Object Qmenu_fallback; Lisp_Object Qmenu_quit; Lisp_Object Qmenu_up; Lisp_Object Qmenu_down; Lisp_Object Qmenu_left; Lisp_Object Qmenu_right; Lisp_Object Qmenu_select; Lisp_Object Qmenu_escape; static int menubar_variable_changed (Lisp_Object UNUSED (sym), Lisp_Object *UNUSED (val), Lisp_Object UNUSED (in_object), int UNUSED (flags)) { MARK_MENUBAR_CHANGED; return 0; } void update_frame_menubars (struct frame *f) { if (f->menubar_changed || f->windows_changed) MAYBE_FRAMEMETH (f, update_frame_menubars, (f)); f->menubar_changed = 0; } void free_frame_menubars (struct frame *f) { /* If we had directly allocated any memory for the menubars instead of using all Lisp_Objects this is where we would now free it. */ MAYBE_FRAMEMETH (f, free_frame_menubars, (f)); } static void menubar_visible_p_changed (Lisp_Object UNUSED (specifier), struct window *UNUSED (w), Lisp_Object UNUSED (oldval)) { MARK_MENUBAR_CHANGED; } static void menubar_visible_p_changed_in_frame (Lisp_Object UNUSED (specifier), struct frame *f, Lisp_Object UNUSED (oldval)) { update_frame_menubars (f); } Lisp_Object current_frame_menubar (const struct frame* f) { struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); return symbol_value_in_buffer (Qcurrent_menubar, w->buffer); } Lisp_Object menu_parse_submenu_keywords (Lisp_Object desc, Lisp_Object gui_item) { Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); /* Menu descriptor should be a list */ CHECK_CONS (desc); /* First element may be menu name, although can be omitted. Let's think that if stuff begins with anything than a keyword or a list (submenu), this is a menu name, expected to be a string */ if (!KEYWORDP (XCAR (desc)) && !CONSP (XCAR (desc))) { CHECK_STRING (XCAR (desc)); pgui_item->name = XCAR (desc); desc = XCDR (desc); if (!NILP (desc)) CHECK_CONS (desc); } /* Walk along all key-value pairs */ while (!NILP(desc) && KEYWORDP (XCAR (desc))) { Lisp_Object key, val; key = XCAR (desc); desc = XCDR (desc); CHECK_CONS (desc); val = XCAR (desc); desc = XCDR (desc); if (!NILP (desc)) CHECK_CONS (desc); gui_item_add_keyval_pair (gui_item, key, val, ERROR_ME); } /* Return the rest - supposed to be a list of items */ return desc; } DEFUN ("menu-find-real-submenu", Fmenu_find_real_submenu, 2, 2, 0, /* Find a submenu descriptor within DESC by following PATH. This function finds a submenu descriptor, either from the description DESC or generated by a filter within DESC. The function regards :config and :included keywords in the DESC, and expands submenus along the PATH using :filter functions. Return value is a descriptor for the submenu, NOT expanded and NOT checked against :config and :included. Also, individual menu items are not looked for, only submenus. See also 'find-menu-item'. */ (desc, path)) { struct gcpro gcpro1, gcpro2; Lisp_Object gui_item = allocate_gui_item (); Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); GCPRO2 (gui_item, desc); { EXTERNAL_LIST_LOOP_2 (elt, path) { /* Verify that DESC describes a menu, not single item */ if (!CONSP (desc)) RETURN_UNGCPRO (Qnil); /* Parse this menu */ desc = menu_parse_submenu_keywords (desc, gui_item); /* Check that this (sub)menu is active */ if (!gui_item_active_p (gui_item)) RETURN_UNGCPRO (Qnil); /* Apply :filter */ if (!NILP (pgui_item->filter)) desc = call1 (pgui_item->filter, desc); /* Find the next menu on the path inside this one */ { EXTERNAL_LIST_LOOP_2 (submenu, desc) { if (CONSP (submenu) && STRINGP (XCAR (submenu)) && !NILP (Fstring_equal (XCAR (submenu), elt))) { desc = submenu; goto descend; } } } /* Submenu not found */ RETURN_UNGCPRO (Qnil); descend: /* Prepare for the next iteration */ gui_item_init (gui_item); } } /* We have successfully descended down the end of the path */ UNGCPRO; return desc; } DEFUN ("popup-menu", Fpopup_menu, 1, 2, 0, /* Pop up the menu described by MENU-DESCRIPTION. A menu description is a list of menu items, strings, and submenus. The first element of a menu must be a string, which is the name of the menu. This is the string that will be displayed in the parent menu, if any. For toplevel menus, it is ignored. This string is not displayed in the menu itself. If an element of a menu is a string, then that string will be presented in the menu as unselectable text. If an element of a menu is a string consisting solely of hyphens, then that item will be presented as a solid horizontal line. If an element of a menu is a list, it is treated as a submenu. The name of that submenu (the first element in the list) will be used as the name of the item representing this menu on the parent. Otherwise, the element must be a vector, which describes a menu item. A menu item can have any of the following forms: [ "name" callback <active-p> ] [ "name" callback <active-p> <suffix> ] [ "name" callback :<keyword> <value> :<keyword> <value> ... ] The name is the string to display on the menu; it is filtered through the resource database, so it is possible for resources to override what string is actually displayed. If the `callback' of a menu item is a symbol, then it must name a command. It will be invoked with `call-interactively'. If it is a list, then it is evaluated with `eval'. The possible keywords are this: :active <form> Same as <active-p> in the first two forms: the expression is evaluated just before the menu is displayed, and the menu will be selectable only if the result is non-nil. :suffix <form> Same as <suffix> in the second form: the expression is evaluated just before the menu is displayed and resulting string is appended to the displayed name, providing a convenient way of adding the name of a command's ``argument'' to the menu, like ``Kill Buffer NAME''. :keys "string" Normally, the keyboard equivalents of commands in menus are displayed when the `callback' is a symbol. This can be used to specify keys for more complex menu items. It is passed through `substitute-command-keys' first. :style <style> Specifies what kind of object this menu item is: nil A normal menu item. toggle A toggle button. radio A radio button. The only difference between toggle and radio buttons is how they are displayed. But for consistency, a toggle button should be used when there is one option whose value can be turned on or off, and radio buttons should be used when there is a set of mutually exclusive options. When using a group of radio buttons, you should arrange for no more than one to be marked as selected at a time. :selected <form> Meaningful only when STYLE is `toggle' or `radio'. This specifies whether the button will be in the selected or unselected state. For example: [ "Save As..." write-file t ] [ "Revert Buffer" revert-buffer (buffer-modified-p) ] [ "Read Only" toggle-read-only :style toggle :selected buffer-read-only ] See menubar.el for many more examples. */ (menu_description, event)) { struct frame *f = decode_frame (Qnil); MAYBE_FRAMEMETH (f, popup_menu, (menu_description, event)); return Qnil; } DEFUN ("compare-menu-text", Fcompare_menu_text, 2, 2, 0, /* Compare the text of two menu items, ignoring accelerator specs and case. Also treat %% as a single %. Return < 0 if STRING1 is less than STRING2, 0 if equal, > 0 if STRING1 is greater than STRING2. */ (string1, string2)) { Ibyte *p; Ibyte *q; CHECK_STRING (string1); CHECK_STRING (string2); p = XSTRING_DATA (string1); q = XSTRING_DATA (string2); for (;;) { Ichar val; if (*p == '%' && *(p + 1) == '%') p++; else if (*p == '%' && *(p + 1) == '_') p += 2; if (*q == '%' && *(q + 1) == '%') q++; else if (*q == '%' && *(q + 1) == '_') q += 2; if (!*p || !*q) return make_int (*p - *q); val = DOWNCASE (0, itext_ichar (p)) - DOWNCASE (0, itext_ichar (q)); if (val) return make_int (val); INC_IBYTEPTR (p); INC_IBYTEPTR (q); } } DEFUN ("normalize-menu-text", Fnormalize_menu_text, 1, 1, 0, /* Convert a menu item name string into normal form, and return the new string. Menu item names should be converted to normal form before being compared. This removes %_'s (accelerator indications) and converts %% to %. The returned string may be the same string as the original. */ (name)) { Charcount end; int i; Ibyte *name_data; Ibyte *string_result; Ibyte *string_result_ptr; Ichar elt; int expecting_underscore = 0; CHECK_STRING (name); end = string_char_length (name); name_data = XSTRING_DATA (name); string_result = alloca_ibytes (end * MAX_ICHAR_LEN); string_result_ptr = string_result; for (i = 0; i < end; i++) { elt = itext_ichar (name_data); if (expecting_underscore) { expecting_underscore = 0; switch (elt) { case '%': /* Allow `%%' to mean `%'. */ string_result_ptr += set_itext_ichar (string_result_ptr, '%'); break; case '_': break; default: string_result_ptr += set_itext_ichar (string_result_ptr, '%'); string_result_ptr += set_itext_ichar (string_result_ptr, elt); } } else if (elt == '%') expecting_underscore = 1; else string_result_ptr += set_itext_ichar (string_result_ptr, elt); INC_IBYTEPTR (name_data); } if (string_result_ptr - string_result == XSTRING_LENGTH (name) && !memcmp (string_result, XSTRING_DATA (name), XSTRING_LENGTH (name))) return name; return make_string (string_result, string_result_ptr - string_result); } void syms_of_menubar (void) { DEFSYMBOL (Qcurrent_menubar); DEFSYMBOL (Qmenu_force); DEFSYMBOL (Qmenu_fallback); DEFSYMBOL (Qmenu_quit); DEFSYMBOL (Qmenu_up); DEFSYMBOL (Qmenu_down); DEFSYMBOL (Qmenu_left); DEFSYMBOL (Qmenu_right); DEFSYMBOL (Qmenu_select); DEFSYMBOL (Qmenu_escape); DEFSUBR (Fpopup_menu); DEFSUBR (Fcompare_menu_text); DEFSUBR (Fnormalize_menu_text); DEFSUBR (Fmenu_find_real_submenu); } void vars_of_menubar (void) { /* put in Vblank_menubar a menubar value which has no visible * items. This is a bit tricky due to various quirks. We * could use '(["" nil nil]), but this is apparently equivalent * to '(nil), and a new frame created with this menubar will * get a vertically-squished menubar. If we use " " as the * button title instead of "", we get an etched button border. * So we use * '(("No active menubar" ["" nil nil])) * which creates a menu whose title is "No active menubar", * and this works fine. */ Vblank_menubar = list1 (list2 (build_defer_string ("No active menubar"), vector3 (build_ascstring (""), Qnil, Qnil))); staticpro (&Vblank_menubar); DEFVAR_BOOL ("popup-menu-titles", &popup_menu_titles /* If true, popup menus will have title bars at the top. */ ); popup_menu_titles = 1; /* #### Replace current menubar with a specifier. */ /* All C code must access the menubar via Qcurrent_menubar because it can be buffer-local. Note that Vcurrent_menubar doesn't need to exist at all, except for the magic function. */ DEFVAR_LISP_MAGIC ("current-menubar", &Vcurrent_menubar /* The current menubar. This may be buffer-local. When the menubar is changed, the function `set-menubar-dirty-flag' has to be called for the menubar to be updated on the frame. See `set-menubar' and `set-buffer-menubar'. A menubar is a list of menus and menu-items. A menu is a list of menu items, keyword-value pairs, strings, and submenus. The first element of a menu must be a string, which is the name of the menu. This is the string that will be displayed in the parent menu, if any. For toplevel menus, it is ignored. This string is not displayed in the menu itself. Menu accelerators can be indicated in the string by putting the sequence "%_" before the character corresponding to the key that will invoke the menu or menu item. Uppercase and lowercase accelerators are equivalent. The sequence "%%" is also special, and is translated into a single %. If no menu accelerator is present in the string, XEmacs will act as if the first character has been tagged as an accelerator. Immediately following the name string of the menu, various optional keyword-value pairs are permitted: currently, :filter, :active, :included, and :config. (See below.) If an element of a menu (or menubar) is a string, then that string will be presented as unselectable text. If an element of a menu is a string consisting solely of hyphens, then that item will be presented as a solid horizontal line. If an element of a menu is a string beginning with "--:", it will be presented as a line whose appearance is controlled by the rest of the text in the string. The allowed line specs are system-dependent, and currently work only under X Windows (with Lucid and Motif menubars); otherwise, a solid horizontal line is presented, as if the string were all hyphens. The possibilities are: "--:singleLine" "--:doubleLine" "--:singleDashedLine" "--:doubleDashedLine" "--:noLine" "--:shadowEtchedIn" "--:shadowEtchedOut" "--:shadowEtchedInDash" "--:shadowEtchedOutDash" "--:shadowDoubleEtchedIn" (Lucid menubars only) "--:shadowDoubleEtchedOut" (Lucid menubars only) "--:shadowDoubleEtchedInDash" (Lucid menubars only) "--:shadowDoubleEtchedOutDash" (Lucid menubars only) If an element of a menu is a list, it is treated as a submenu. The name of that submenu (the first element in the list) will be used as the name of the item representing this menu on the parent. If an element of a menubar is `nil', then it is used to represent the division between the set of menubar-items which are flushleft and those which are flushright. Otherwise, the element must be a vector, which describes a menu item. A menu item is of the following form: [ "name" callback :<keyword> <value> :<keyword> <value> ... ] The following forms are also accepted for compatibility, but deprecated: [ "name" callback <active-p> ] [ "name" callback <active-p> <suffix> ] The name is the string to display on the menu; it is filtered through the resource database, so it is possible for resources to override what string is actually displayed. Menu accelerator indicators (the sequence `%_') are also processed; see above. If the name is not a string, it will be evaluated with `eval', and the result should be a string. If the `callback' of a menu item is a symbol, then it must name a command. It will be invoked with `call-interactively'. If it is a list, then it is evaluated with `eval'. In the deprecated forms, <active-p> is equivalent to using the :active keyword, and <suffix> is equivalent to using the :suffix keyword. The possible keywords are: :active <form> The expression is evaluated just before the menu is displayed, and the menu will be selectable only if the result is non-nil. :suffix <form> The expression is evaluated just before the menu is displayed and the resulting string is appended to the displayed name, providing a convenient way of adding the name of a command's ``argument'' to the menu, like ``Kill Buffer NAME''. :keys "string" Normally, the keyboard equivalents of commands in menus are displayed when the `callback' is a symbol. This can be used to specify keys for more complex menu items. It is passed through `substitute-command-keys' first. :style <style> Specifies what kind of object this menu item is: nil A normal menu item. toggle A toggle button. radio A radio button. button A menubar button. The only difference between toggle and radio buttons is how they are displayed. But for consistency, a toggle button should be used when there is one option whose value can be turned on or off, and radio buttons should be used when there is a set of mutually exclusive options. When using a group of radio buttons, you should arrange for no more than one to be marked as selected at a time. :selected <form> Meaningful only when STYLE is `toggle', `radio' or `button'. This specifies whether the button will be in the selected or unselected state. :included <form> This can be used to control the visibility of a menu or menu item. The form is evaluated and the menu or menu item is only displayed if the result is non-nil. :config <symbol> This is an efficient shorthand for :included (memq symbol menubar-configuration) See the variable `menubar-configuration'. :filter <function> A menu filter can only be used at the beginning of a submenu description (i.e. not in a menu item itself). (Remember that most of the keywords can take evaluated expressions as well as constants.) The filter is used to incrementally create a submenu only when it is selected by the user and not every time the menubar is activated. The filter function is passed the list of menu items in the submenu and must return the modified list to be actually used. The filter MUST NOT destructively modify the list of menu items passed to it. It is called only when the menu is about to be displayed, so other menus may already be displayed. Vile and terrible things will happen if a menu filter function changes the current buffer, window, or frame. It also should not raise, lower, or iconify any frames. Basically, the filter function should have no side-effects. :key-sequence keys Used in FSF Emacs as an hint to an equivalent keybinding. Ignored by XEmacs for easymenu.el compatibility. (XEmacs computes this information automatically.) For example: ("%_File" :filter file-menu-filter ; file-menu-filter is a function that takes ; one argument (a list of menu items) and ; returns a list of menu items [ "Save %_As..." write-file t ] [ "%_Revert Buffer" revert-buffer (buffer-modified-p) ] [ "R%_ead Only" toggle-read-only :style toggle :selected buffer-read-only ] ) See menubar-items.el for many more examples. After the menubar is clicked upon, but before any menus are popped up, the functions on the `activate-menubar-hook' are invoked to make top-level changes to the menus and menubar. Note, however, that the use of menu filters (using the :filter keyword) is usually a more efficient way to dynamically alter or sensitize menus. */, menubar_variable_changed); Vcurrent_menubar = Qnil; DEFVAR_LISP ("activate-menubar-hook", &Vactivate_menubar_hook /* Function or functions called before a menubar menu is pulled down. These functions are called with no arguments, and should interrogate and modify the value of `current-menubar' as desired. The functions on this hook are invoked after the mouse goes down, but before the menu is mapped, and may be used to activate, deactivate, add, or delete items from the menus. However, it is probably the case that using a :filter keyword in a submenu would be a more efficient way of updating menus. See the documentation of `current-menubar'. These functions may return the symbol `t' to assert that they have made no changes to the menubar. If any other value is returned, the menubar is recomputed. If `t' is returned but the menubar has been changed, then the changes may not show up right away. Returning `nil' when the menubar has not changed is not so bad; more computation will be done, but redisplay of the menubar will still be performed optimally. */ ); Vactivate_menubar_hook = Qnil; DEFSYMBOL (Qactivate_menubar_hook); DEFVAR_BOOL ("menubar-show-keybindings", &menubar_show_keybindings /* If true, the menubar will display keyboard equivalents. If false, only the command names will be displayed. */ ); menubar_show_keybindings = 1; DEFVAR_LISP_MAGIC ("menubar-configuration", &Vmenubar_configuration /* A list of symbols, against which the value of the :config tag for each menubar item will be compared. If a menubar item has a :config tag, then it is omitted from the menubar if that tag is not a member of the `menubar-configuration' list. */ , menubar_variable_changed); Vmenubar_configuration = Qnil; DEFVAR_LISP ("menubar-pointer-glyph", &Vmenubar_pointer_glyph /* *The shape of the mouse-pointer when over the menubar. This is a glyph; use `set-glyph-image' to change it. If unspecified in a particular domain, the window-system-provided default pointer is used. */ ); DEFVAR_LISP ("menu-accelerator-prefix", &Vmenu_accelerator_prefix /* Prefix key(s) that must be typed before menu accelerators will be activated. Set this to a value acceptable by define-key. NOTE: This currently only has any effect under X Windows. */ ); Vmenu_accelerator_prefix = Qnil; DEFVAR_LISP ("menu-accelerator-modifiers", &Vmenu_accelerator_modifiers /* Modifier keys which must be pressed to get to the top level menu accelerators. This is a list of modifier key symbols. All modifier keys must be held down while a valid menu accelerator key is pressed in order for the top level menu to become active. NOTE: This currently only has any effect under X Windows. See also menu-accelerator-enabled and menu-accelerator-prefix. */ ); Vmenu_accelerator_modifiers = list1 (Qmeta); DEFVAR_LISP ("menu-accelerator-enabled", &Vmenu_accelerator_enabled /* Whether menu accelerator keys can cause the menubar to become active. If `menu-force' or `menu-fallback', then menu accelerator keys can be used to activate the top level menu. Once the menubar becomes active, the accelerator keys can be used regardless of the value of this variable. menu-force is used to indicate that the menu accelerator key takes precedence over bindings in the current keymap(s). menu-fallback means that bindings in the current keymap take precedence over menu accelerator keys. Thus a top level menu with an accelerator of "T" would be activated on a keypress of Meta-t if menu-accelerator-enabled is menu-force. However, if menu-accelerator-enabled is menu-fallback, then Meta-t will not activate the menubar and will instead run the function transpose-words, to which it is normally bound. See also menu-accelerator-modifiers and menu-accelerator-prefix. */ ); Vmenu_accelerator_enabled = Qnil; DEFVAR_LISP ("menu-accelerator-map", &Vmenu_accelerator_map /* Keymap for use when the menubar is active. The actions menu-quit, menu-up, menu-down, menu-left, menu-right, menu-select and menu-escape can be mapped to keys in this map. NOTE: This currently only has any effect under X Windows. menu-quit Immediately deactivate the menubar and any open submenus without selecting an item. menu-up Move the menu cursor up one row in the current menu. If the move extends past the top of the menu, wrap around to the bottom. menu-down Move the menu cursor down one row in the current menu. If the move extends past the bottom of the menu, wrap around to the top. If executed while the cursor is in the top level menu, move down into the selected menu. menu-left Move the cursor from a submenu into the parent menu. If executed while the cursor is in the top level menu, move the cursor to the left. If the move extends past the left edge of the menu, wrap around to the right edge. menu-right Move the cursor into a submenu. If the cursor is located in the top level menu or is not currently on a submenu heading, then move the cursor to the next top level menu entry. If the move extends past the right edge of the menu, wrap around to the left edge. menu-select Activate the item under the cursor. If the cursor is located on a submenu heading, then move the cursor into the submenu. menu-escape Pop up to the next level of menus. Moves from a submenu into its parent menu. From the top level menu, this deactivates the menubar. This keymap can also contain normal key-command bindings, in which case the menubar is deactivated and the corresponding command is executed. The action bindings used by the menu accelerator code are designed to mimic the actions of menu traversal keys in a commonly used PC operating system. */ ); Fprovide (intern ("menubar")); Fprovide (intern ("menu-accelerator-support")); } void specifier_vars_of_menubar (void) { DEFVAR_SPECIFIER ("menubar-visible-p", &Vmenubar_visible_p /* *Whether the menubar is visible. This is a specifier; use `set-specifier' to change it. */ ); Vmenubar_visible_p = Fmake_specifier (Qboolean); set_specifier_fallback (Vmenubar_visible_p, list1 (Fcons (Qnil, Qt))); set_specifier_caching (Vmenubar_visible_p, offsetof (struct window, menubar_visible_p), menubar_visible_p_changed, offsetof (struct frame, menubar_visible_p), menubar_visible_p_changed_in_frame, 0); } void complex_vars_of_menubar (void) { Vmenubar_pointer_glyph = Fmake_glyph_internal (Qpointer); Vmenu_accelerator_map = Fmake_keymap (Qnil); }