]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/easymenu.el
Merge from trunk.
[gnu-emacs] / lisp / emacs-lisp / easymenu.el
index 957de4dfe2aed3dc17d1336fa0b8554933e11e6f..7957343714607597d479d1e4ce1e16120edd65f4 100644 (file)
@@ -1,10 +1,10 @@
 ;;; easymenu.el --- support the easymenu interface for defining a menu
 
 ;;; 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>
 
 ;; Keywords: emulations
 ;; Author: Richard Stallman <rms@gnu.org>
+;; Package: emacs
 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 
 
 ;;; Code:
 
 
 ;;; 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
   "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))
 
 
 (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.
 ;;;###autoload
 (defmacro easy-menu-define (symbol maps doc menu)
   "Define a menu bar submenu in maps MAPS, according to MENU.
@@ -68,8 +67,8 @@ expression has a non-nil value.  `:included' is an alias for `:visible'.
 
    :active ENABLE
 
 
    :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.
 
 
 The rest of the elements in MENU, are menu items.
 
@@ -106,8 +105,8 @@ keyboard equivalent.
 
    :active ENABLE
 
 
    :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
 
 
    :visible INCLUDE
 
@@ -151,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."
 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)))
   `(progn
      ,(if symbol `(defvar ,symbol nil ,doc))
      (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
@@ -164,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
                    (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
                 (cons menu props)))))
 
 ;;;###autoload
@@ -233,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))
                (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))))
        (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)))
     (if (equal visible ''nil)
        nil                             ; Invisible menu entry, return nil.
       (if (and visible (not (easy-menu-always-true-p visible)))
@@ -250,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))))
          (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))
       (when prop
        (setq menu (easy-menu-make-symbol menu 'noexp))
        (put menu 'menu-prop prop))
@@ -277,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'."
 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.
 
 (defun easy-menu-convert-item-1 (item)
   "Parse an item description and convert it to a menu keymap element.
@@ -297,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)))
          ;; 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 label (cadr prop))
            (setq prop (cddr prop)))
          (setq command (symbol-function command)))))
@@ -316,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))
                (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)
              (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)
                          (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 "]")
              (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
               ((and selected
                     (setq style (assq style easy-menu-button-prefix)))
                (setq prop (cons :button
@@ -376,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)))
     ;; 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
       (cons key
             (and (not remove)
                  (cons 'menu-item
@@ -497,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
 
 ;; 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
 (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
@@ -513,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.
 
 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."
 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.
 
 (defun add-submenu (menu-path submenu &optional before in-menu)
   "Add submenu SUBMENU in the menu at MENU-PATH.
@@ -683,5 +675,4 @@ In some cases we use that to select between the local and global maps."
 
 (provide 'easymenu)
 
 
 (provide 'easymenu)
 
-;; arch-tag: 2a04020d-90d2-476d-a7c6-71e072007a4a
 ;;; easymenu.el ends here
 ;;; easymenu.el ends here