;;; easymenu.el --- support the easymenu interface for defining a menu
-;; Copyright (C) 1994, 1996, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1996, 1998-2011 Free Software Foundation, Inc.
;; Keywords: emulations
;; Author: Richard Stallman <rms@gnu.org>
+;; Package: emacs
;; This file is part of GNU Emacs.
;;; Code:
-(defcustom easy-menu-precalculate-equivalent-keybindings t
+(eval-when-compile (require 'cl))
+
+(defvar easy-menu-precalculate-equivalent-keybindings nil
"Determine when equivalent key bindings are computed for easy-menu menus.
It can take some time to calculate the equivalent key bindings that are shown
in a menu. If the variable is on, then this calculation gives a (maybe
noticeable) delay when a mode is first entered. If the variable is off, then
this delay will come when a menu is displayed the first time. If you never use
-menus, turn this variable off, otherwise it is probably better to keep it on."
- :type 'boolean
- :group 'menu
- :version "20.3")
+menus, turn this variable off, otherwise it is probably better to keep it on.")
+(make-obsolete-variable
+ 'easy-menu-precalculate-equivalent-keybindings nil "23.1")
(defsubst easy-menu-intern (s)
(if (stringp s) (intern s) s))
-;;;###autoload
-(put 'easy-menu-define 'lisp-indent-function 'defun)
;;;###autoload
(defmacro easy-menu-define (symbol maps doc menu)
"Define a menu bar submenu in maps MAPS, according to MENU.
:active ENABLE
-ENABLE is an expression; the menu is enabled for selection
-whenever this expression's value is non-nil.
+ENABLE is an expression; the menu is enabled for selection whenever
+this expression's value is non-nil. `:enable' is an alias for `:active'.
The rest of the elements in MENU, are menu items.
:active ENABLE
-ENABLE is an expression; the item is enabled for selection
-whenever this expression's value is non-nil.
+ENABLE is an expression; the item is enabled for selection whenever
+this expression's value is non-nil. `:enable' is an alias for `:active'.
:visible INCLUDE
as a solid horizontal line.
A menu item can be a list with the same format as MENU. This is a submenu."
+ (declare (indent defun))
`(progn
,(if symbol `(defvar ,symbol nil ,doc))
(easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
(prog1 (get menu 'menu-prop)
(setq menu (symbol-function menu))))))
(cons 'menu-item
- (cons (or item-name
- (if (keymapp menu)
- (keymap-prompt menu))
- "")
+ (cons (if (eq :label (car props))
+ (prog1 (cadr props)
+ (setq props (cddr props)))
+ (or item-name
+ (if (keymapp menu)
+ (keymap-prompt menu))
+ ""))
(cons menu props)))))
;;;###autoload
(keywordp (setq keyword (car menu-items))))
(setq arg (cadr menu-items))
(setq menu-items (cddr menu-items))
- (cond
- ((eq keyword :filter)
+ (case keyword
+ (:filter
(setq filter `(lambda (menu)
(easy-menu-filter-return (,arg menu) ,menu-name))))
- ((eq keyword :active) (setq enable (or arg ''nil)))
- ((eq keyword :label) (setq label arg))
- ((eq keyword :help) (setq help arg))
- ((or (eq keyword :included) (eq keyword :visible))
- (setq visible (or arg ''nil)))))
+ ((:enable :active) (setq enable (or arg ''nil)))
+ (:label (setq label arg))
+ (:help (setq help arg))
+ ((:included :visible) (setq visible (or arg ''nil)))))
(if (equal visible ''nil)
nil ; Invisible menu entry, return nil.
(if (and visible (not (easy-menu-always-true-p visible)))
(setq prop (cons :enable (cons enable prop))))
(if filter (setq prop (cons :filter (cons filter prop))))
(if help (setq prop (cons :help (cons help prop))))
- (if label (setq prop (cons nil (cons label prop))))
- (if filter
- ;; The filter expects the menu in its XEmacs form and the pre-filter
- ;; form will only be passed to the filter anyway, so we'd better
- ;; not convert it at all (it will be converted on the fly by
- ;; easy-menu-filter-return).
- (setq menu menu-items)
- (setq menu (append menu (mapcar 'easy-menu-convert-item menu-items))))
+ (if label (setq prop (cons :label (cons label prop))))
+ (setq menu (if filter
+ ;; The filter expects the menu in its XEmacs form and the
+ ;; pre-filter form will only be passed to the filter
+ ;; anyway, so we'd better not convert it at all (it will
+ ;; be converted on the fly by easy-menu-filter-return).
+ menu-items
+ (append menu (mapcar 'easy-menu-convert-item menu-items))))
(when prop
(setq menu (easy-menu-make-symbol menu 'noexp))
(put menu 'menu-prop prop))
This also helps when the NAME of the entry is recreated each time:
since the menu is built and traversed separately, the lookup
would always fail because the key is `equal' but not `eq'."
- (or (gethash item easy-menu-converted-items-table)
- (puthash item (easy-menu-convert-item-1 item)
- easy-menu-converted-items-table)))
+ (let* ((cache (gethash item easy-menu-converted-items-table))
+ (result (or cache (easy-menu-convert-item-1 item)))
+ (key (car-safe result)))
+ (when (and (listp easy-menu-avoid-duplicate-keys) (symbolp key))
+ ;; Merging multiple entries with the same name is sometimes what we
+ ;; want, but not when the entries are actually different (e.g. same
+ ;; name but different :suffix as seen in cal-menu.el) and appear in
+ ;; the same menu. So we try to detect and resolve conflicts.
+ (while (memq key easy-menu-avoid-duplicate-keys)
+ ;; We need to use some distinct object, ideally a symbol, ideally
+ ;; related to the `name'. Uninterned symbols do not work (they
+ ;; are apparently turned into strings and re-interned later on).
+ (setq key (intern (format "%s-%d" (symbol-name key)
+ (length easy-menu-avoid-duplicate-keys))))
+ (setq result (cons key (cdr result))))
+ (push key easy-menu-avoid-duplicate-keys))
+
+ (unless cache (puthash item result easy-menu-converted-items-table))
+ result))
(defun easy-menu-convert-item-1 (item)
"Parse an item description and convert it to a menu keymap element.
;; Invisible menu item. Don't insert into keymap.
(setq remove t)
(when (and (symbolp command) (setq prop (get command 'menu-prop)))
- (when (null (car prop))
+ (when (eq :label (car prop))
(setq label (cadr prop))
(setq prop (cddr prop)))
(setq command (symbol-function command)))))
(setq keyword (aref item count))
(setq arg (aref item (1+ count)))
(setq count (+ 2 count))
- (cond
- ((or (eq keyword :included) (eq keyword :visible))
- (setq visible (or arg ''nil)))
- ((eq keyword :key-sequence)
- (setq cache arg cache-specified t))
- ((eq keyword :keys) (setq keys arg no-name nil))
- ((eq keyword :label) (setq label arg))
- ((eq keyword :active) (setq active (or arg ''nil)))
- ((eq keyword :help) (setq prop (cons :help (cons arg prop))))
- ((eq keyword :suffix) (setq suffix arg))
- ((eq keyword :style) (setq style arg))
- ((eq keyword :selected) (setq selected (or arg ''nil)))))
+ (case keyword
+ ((:included :visible) (setq visible (or arg ''nil)))
+ (:key-sequence (setq cache arg cache-specified t))
+ (:keys (setq keys arg no-name nil))
+ (:label (setq label arg))
+ ((:active :enable) (setq active (or arg ''nil)))
+ (:help (setq prop (cons :help (cons arg prop))))
+ (:suffix (setq suffix arg))
+ (:style (setq style arg))
+ (:selected (setq selected (or arg ''nil)))))
(if suffix
(setq label
(if (stringp suffix)
(if (stringp label) (concat label " " suffix)
- (list 'concat label (concat " " suffix)))
+ `(concat ,label ,(concat " " suffix)))
(if (stringp label)
- (list 'concat (concat label " ") suffix)
- (list 'concat label " " suffix)))))
+ `(concat ,(concat label " ") ,suffix)
+ `(concat ,label " " ,suffix)))))
(cond
((eq style 'button)
(setq label (if (stringp label) (concat "[" label "]")
- (list 'concat "[" label "]"))))
+ `(concat "[" ,label "]"))))
((and selected
(setq style (assq style easy-menu-button-prefix)))
(setq prop (cons :button
;; It also makes it easier/possible to lookup/change menu bindings
;; via keymap functions.
(let ((key (easy-menu-intern name)))
- (when (listp easy-menu-avoid-duplicate-keys)
- ;; Merging multiple entries with the same name is sometimes what we
- ;; want, but not when the entries are actually different (e.g. same
- ;; name but different :suffix as seen in cal-menu.el) and appear in
- ;; the same menu. So we try to detect and resolve conflicts.
- (while (and (stringp name)
- (memq key easy-menu-avoid-duplicate-keys))
- ;; We need to use some distinct object, ideally a symbol, ideally
- ;; related to the `name'. Uninterned symbols do not work (they
- ;; are apparently turned into strings and re-interned later on).
- (setq key (intern (format "%s (%d)" (symbol-name key)
- (length easy-menu-avoid-duplicate-keys)))))
- (push key easy-menu-avoid-duplicate-keys))
-
(cons key
(and (not remove)
(cons 'menu-item
;; XEmacs needs the following two functions to add and remove menus.
;; In Emacs this is done automatically when switching keymaps, so
-;; here easy-menu-remove is a noop and easy-menu-add only precalculates
-;; equivalent keybindings (if easy-menu-precalculate-equivalent-keybindings
-;; is on).
+;; here easy-menu-remove is a noop.
(defalias 'easy-menu-remove 'ignore
"Remove MENU from the current menu bar.
Contrary to XEmacs, this is a nop on Emacs since menus are automatically
corresponding keymap is activated. On XEmacs this is needed to
actually add the menu to the current menubar.
-This also precalculates equivalent key bindings when
-`easy-menu-precalculate-equivalent-keybindings' is on.
-
You should call this once the menu and keybindings are set up
completely and menu filter functions can be expected to work."
- (when easy-menu-precalculate-equivalent-keybindings
- (if (and (symbolp menu) (not (keymapp menu)) (boundp menu))
- (setq menu (symbol-value menu)))
- (and (keymapp menu) (fboundp 'x-popup-menu)
- (x-popup-menu nil menu))
- ))
+ )
(defun add-submenu (menu-path submenu &optional before in-menu)
"Add submenu SUBMENU in the menu at MENU-PATH.
(provide 'easymenu)
-;; arch-tag: 2a04020d-90d2-476d-a7c6-71e072007a4a
;;; easymenu.el ends here