X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/bfab7c6ec74dc55d640ef36f8cb1790a1420f991..9ed7c8cbcedaa50750bc1811bda2824e235787e8:/lisp/emacs-lisp/easymenu.el diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 8e2f4322c0..7957343714 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -1,17 +1,17 @@ ;;; 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 +;; 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 @@ -19,9 +19,7 @@ ;; 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 . ;;; Commentary: @@ -31,22 +29,21 @@ ;;; 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. @@ -70,8 +67,8 @@ expression has a non-nil value. `:included' is an alias for `:visible'. :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. @@ -108,8 +105,8 @@ keyboard equivalent. :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 @@ -153,6 +150,7 @@ unselectable text. A string consisting solely of hyphens is displayed 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))) @@ -166,10 +164,13 @@ This is expected to be bound to a mouse event." (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 @@ -235,15 +236,14 @@ possibly preceded by keyword pairs as described in `easy-menu-define'." (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))) @@ -252,14 +252,14 @@ possibly preceded by keyword pairs as described in `easy-menu-define'." (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)) @@ -279,9 +279,25 @@ conversion is done from within a filter. 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. @@ -299,7 +315,7 @@ ITEM defines an item as in `easy-menu-define'." ;; 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))))) @@ -318,30 +334,28 @@ ITEM defines an item as in `easy-menu-define'." (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 @@ -378,20 +392,6 @@ ITEM defines an item as in `easy-menu-define'." ;; 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 @@ -499,9 +499,7 @@ To implement dynamic menus, either call this from ;; 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 @@ -515,17 +513,9 @@ On Emacs, menus are already automatically activated when the 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. @@ -685,5 +675,4 @@ In some cases we use that to select between the local and global maps." (provide 'easymenu) -;; arch-tag: 2a04020d-90d2-476d-a7c6-71e072007a4a ;;; easymenu.el ends here