Add 2010 to copyright years.

[gnu-emacs] / lisp / emacs-lisp / easymenu.el

diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index 19df1a16a11e21377e3cc97ecbf552b0b4e6cd09..470f0f677797bd00431d4bbd1360308356fcff13 100644 (file)
--- 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,
 ;;; 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>
 
 ;; This file is part of GNU Emacs.
 
 
 ;; Keywords: emulations
 ;; Author: Richard Stallman <rms@gnu.org>
 
 ;; 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
 ;; 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 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
 ;; 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:
 
 
 ;;; Commentary:
 


@@ -31,16 +29,15 @@
 
 ;;; Code:
 
 
 ;;; 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
   "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))


@@ -116,10 +113,15 @@ whenever this expression's value is non-nil.
 INCLUDE is an expression; this item is only visible if this
 expression has a non-nil value.  `:included' is an alias for `:visible'.
 
 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
    :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
 
 
    :style STYLE
 


@@ -211,12 +213,18 @@ If NAME is provided, it is used for the keymap."
    (setq menu (cdr (easy-menu-convert-item menu)))))
  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))
 ;;;###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
        prop keyword arg label enable filter visible help)
     ;; Look for keywords.
     (while (and menu-items


@@ -268,9 +276,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.


@@ -336,22 +360,22 @@ ITEM defines an item as in `easy-menu-define'."
                (setq prop (cons :button
                                 (cons (cons (cdr style) selected) prop)))))
              (when (stringp keys)
                (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.
              (if (and visible (not (easy-menu-always-true-p visible)))
                  (if (equal visible ''nil)
                      ;; Invisible menu item. Don't insert into keymap.


@@ -366,12 +390,13 @@ ITEM defines an item as in `easy-menu-define'."
     ;; `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.
     ;; `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'.
 
 (defun easy-menu-define-key (menu key item &optional before)
   "Add binding in MENU for KEY => ITEM.  Similar to `define-key-after'.


@@ -444,7 +469,10 @@ When non-nil, NOEXP indicates that CALLBACK cannot be an expression
         (make-symbol (format "menu-function-%d" easy-menu-item-count))))
     (setq easy-menu-item-count (1+ easy-menu-item-count))
     (fset command
         (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))
 
            `(lambda () (interactive) ,callback)))
     command))
 


@@ -470,9 +498,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


@@ -486,17 +512,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.


@@ -546,7 +564,7 @@ earlier by `easy-menu-define' or `easy-menu-create-menu'."
     (easy-menu-define-key map (easy-menu-intern (car item)) (cdr item) before)))
 
 (defun easy-menu-item-present-p (map path name)
     (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))
 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))