;;; 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.
+;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 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 2, 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
+(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.
INCLUDE is an expression; this item is only visible if this
expression has a non-nil value. `:included' is an alias for `:visible'.
+ :label FORM
+
+FORM is an expression that will be dynamically evaluated and whose
+value will be used for the menu entry's text label (the default is NAME).
+
:suffix FORM
FORM is an expression that will be dynamically evaluated and whose
-value will be concatenated to the menu entry's NAME.
+value will be concatenated to the menu entry's label.
:style STYLE
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)))
(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
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.
(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.
(easy-menu-define-key map (easy-menu-intern (car item)) (cdr item) before)))
(defun easy-menu-item-present-p (map path name)
- "In submenu of MAP with path PATH, return non-nil iff item NAME is present.
+ "In submenu of MAP with path PATH, return non-nil if item NAME is present.
MAP and PATH are defined as in `easy-menu-add-item'.
NAME should be a string, the name of the element to be looked for."
(easy-menu-return-item (easy-menu-get-map map path) name))
HCoop / bpt / emacs.git / blobdiff