;;; easymenu.el --- support the easymenu interface for defining a menu
-;; Copyright (C) 1994, 1996, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007 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.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; 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
(setq menu (cdr (easy-menu-convert-item menu)))))
menu)
+(defvar easy-menu-avoid-duplicate-keys t
+ "Dynamically scoped var to register already used keys in a menu.
+If it holds a list, this is expected to be a list of keys already seen in the
+menu we're processing. Else it means we're not processing a menu.")
+
;;;###autoload
(defun easy-menu-create-menu (menu-name menu-items)
"Create a menu called MENU-NAME with items described in MENU-ITEMS.
MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items
possibly preceded by keyword pairs as described in `easy-menu-define'."
(let ((menu (make-sparse-keymap menu-name))
+ (easy-menu-avoid-duplicate-keys nil)
prop keyword arg label enable filter visible help)
;; Look for keywords.
(while (and menu-items
(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
(cons (cons (cdr style) selected) prop)))))
(when (stringp keys)
- (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$"
- keys)
- (let ((prefix
- (if (< (match-beginning 0) (match-beginning 1))
- (substring keys 0 (match-beginning 1))))
- (postfix
- (if (< (match-end 1) (match-end 0))
- (substring keys (match-end 1))))
- (cmd (intern (match-string 2 keys))))
- (setq keys (and (or prefix postfix)
- (cons prefix postfix)))
- (setq keys
- (and (or keys (not (eq command cmd)))
- (cons cmd keys))))
- (setq cache-specified nil))
- (if keys (setq prop (cons :keys (cons keys prop)))))
+ (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$"
+ keys)
+ (let ((prefix
+ (if (< (match-beginning 0) (match-beginning 1))
+ (substring keys 0 (match-beginning 1))))
+ (postfix
+ (if (< (match-end 1) (match-end 0))
+ (substring keys (match-end 1))))
+ (cmd (intern (match-string 2 keys))))
+ (setq keys (and (or prefix postfix)
+ (cons prefix postfix)))
+ (setq keys
+ (and (or keys (not (eq command cmd)))
+ (cons cmd keys))))
+ (setq cache-specified nil))
+ (if keys (setq prop (cons :keys (cons keys prop)))))
(if (and visible (not (easy-menu-always-true-p visible)))
(if (equal visible ''nil)
;; Invisible menu item. Don't insert into keymap.
;; `intern' the name so as to merge multiple entries with the same name.
;; It also makes it easier/possible to lookup/change menu bindings
;; via keymap functions.
- (cons (easy-menu-intern name)
- (and (not remove)
- (cons 'menu-item
- (cons label
- (and name
- (cons command prop))))))))
+ (let ((key (easy-menu-intern name)))
+ (cons key
+ (and (not remove)
+ (cons 'menu-item
+ (cons label
+ (and name
+ (cons command prop)))))))))
(defun easy-menu-define-key (menu key item &optional before)
"Add binding in MENU for KEY => ITEM. Similar to `define-key-after'.
(make-symbol (format "menu-function-%d" easy-menu-item-count))))
(setq easy-menu-item-count (1+ easy-menu-item-count))
(fset command
- (if (or (keymapp callback) (functionp callback) noexp) callback
+ (if (or (keymapp callback) (commandp callback)
+ ;; `functionp' is probably not needed.
+ (functionp callback) noexp)
+ callback
`(lambda () (interactive) ,callback)))
command))
;; 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