(buffer-end): Doc fix.

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

diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index fb8ee479fd835dfc4c8507f1ce87dfd3d8c1ed40..b0f3b9b9d3e86c6f6a5f04ad06c5f37cd55d25d9 100644 (file)
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -1,6 +1,6 @@
 ;;; 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 Free Software Foundation, Inc.
+;; Copyright (C) 1994,96,98,1999,2000,2004  Free Software Foundation, Inc.

 
 ;; Keywords: emulations
 ;; Author: Richard Stallman <rms@gnu.org>
 
 ;; Keywords: emulations
 ;; Author: Richard Stallman <rms@gnu.org>


@@ -42,23 +42,25 @@ menus, turn this variable off, otherwise it is probably better to keep it on."
   :version "20.3")
 
 (defsubst easy-menu-intern (s)
   :version "20.3")
 
 (defsubst easy-menu-intern (s)

-  (if (stringp s) (intern (downcase s)) 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
 (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.

-The menu keymap is stored in symbol SYMBOL, both as its value
-and as its function definition.  DOC is used as the doc string for SYMBOL.
+
+If SYMBOL is non-nil, store the menu keymap in the value of SYMBOL,
+and define SYMBOL as a function to pop up the menu, with DOC as its doc string.
+If SYMBOL is nil, just store the menu keymap into MAPS.

 
 The first element of MENU must be a string.  It is the menu bar item name.
 It may be followed by the following keyword argument pairs
 
    :filter FUNCTION
 
 
 The first element of MENU must be a string.  It is the menu bar item name.
 It may be followed by the following keyword argument pairs
 
    :filter FUNCTION
 

-FUNCTION is a function with one argument, the menu.  It returns the actual
-menu displayed.
+FUNCTION is a function with one argument, the rest of menu items.
+It returns the remaining items of the displayed menu.

 
    :visible INCLUDE
 
 
    :visible INCLUDE
 


@@ -146,7 +148,7 @@ as a solid horizontal line.
 
 A menu item can be a list with the same format as MENU.  This is a submenu."
   `(progn
 
 A menu item can be a list with the same format as MENU.  This is a submenu."
   `(progn

-     (defvar ,symbol nil ,doc)
+     ,(if symbol `(defvar ,symbol nil ,doc))

      (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
 
 ;;;###autoload
      (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
 
 ;;;###autoload


@@ -156,19 +158,20 @@ A menu item can be a list with the same format as MENU.  This is a submenu."
   ;; compatible.  Therefore everything interesting is done in this
   ;; function.
   (let ((keymap (easy-menu-create-menu (car menu) (cdr menu))))
   ;; compatible.  Therefore everything interesting is done in this
   ;; function.
   (let ((keymap (easy-menu-create-menu (car menu) (cdr menu))))

-    (set symbol keymap)
-    (fset symbol
-         `(lambda (event) ,doc (interactive "@e")
-            ;; FIXME: XEmacs uses popup-menu which calls the binding
-            ;; while x-popup-menu only returns the selection.
-            (x-popup-menu event
-                          (or (and (symbolp ,symbol)
-                                   (funcall
-                                    (or (plist-get (get ,symbol 'menu-prop)
-                                                   :filter)
-                                        'identity)
-                                    (symbol-function ,symbol)))
-                              ,symbol))))
+    (when symbol
+      (set symbol keymap)
+      (fset symbol
+           `(lambda (event) ,doc (interactive "@e")
+              ;; FIXME: XEmacs uses popup-menu which calls the binding
+              ;; while x-popup-menu only returns the selection.
+              (x-popup-menu event
+                            (or (and (symbolp ,symbol)
+                                     (funcall
+                                      (or (plist-get (get ,symbol 'menu-prop)
+                                                     :filter)
+                                          'identity)
+                                      (symbol-function ,symbol)))
+                                ,symbol)))))

     (mapcar (lambda (map)
              (define-key map (vector 'menu-bar (easy-menu-intern (car menu)))
                (cons 'menu-item
     (mapcar (lambda (map)
              (define-key map (vector 'menu-bar (easy-menu-intern (car menu)))
                (cons 'menu-item


@@ -221,9 +224,9 @@ possibly preceded by keyword pairs as described in `easy-menu-define'."
        (setq visible (or arg ''nil)))))
     (if (equal visible ''nil)
        nil                             ; Invisible menu entry, return nil.
        (setq visible (or arg ''nil)))))
     (if (equal visible ''nil)
        nil                             ; Invisible menu entry, return nil.

-      (if (and visible (not (easy-menu-always-true visible)))
+      (if (and visible (not (easy-menu-always-true-p visible)))

          (setq prop (cons :visible (cons visible prop))))
          (setq prop (cons :visible (cons visible prop))))

-      (if (and enable (not (easy-menu-always-true enable)))
+      (if (and enable (not (easy-menu-always-true-p enable)))

          (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))))


@@ -263,14 +266,8 @@ would always fail because the key is `equal' but not `eq'."
               easy-menu-converted-items-table)))
 
 (defun easy-menu-convert-item-1 (item)
               easy-menu-converted-items-table)))
 
 (defun easy-menu-convert-item-1 (item)

-  "Parse an item description and add the item to a keymap.
-This is the function that is used for item definition by the other easy-menu
-functions.
-MENU is a sparse keymap i.e. a list starting with the symbol `keymap'.
-ITEM defines an item as in `easy-menu-define'.
-Optional argument BEFORE is nil or a key in MENU.  If BEFORE is not nil
-put item before BEFORE in MENU, otherwise if item is already present in
-MENU, just change it, otherwise put it last in MENU."
+  "Parse an item description and convert it to a menu keymap element.
+ITEM defines an item as in `easy-menu-define'."

   (let (name command label prop remove help)
     (cond
      ((stringp item)                   ; An item or separator.
   (let (name command label prop remove help)
     (cond
      ((stringp item)                   ; An item or separator.


@@ -340,8 +337,7 @@ MENU, just change it, otherwise put it last in MENU."
                           (postfix
                            (if (< (match-end 1) (match-end 0))
                                (substring keys (match-end 1))))
                           (postfix
                            (if (< (match-end 1) (match-end 0))
                                (substring keys (match-end 1))))

-                          (cmd (intern (substring keys (match-beginning 2)
-                                                  (match-end 2)))))
+                          (cmd (intern (match-string 2 keys))))

                       (setq keys (and (or prefix postfix)
                                       (cons prefix postfix)))
                       (setq keys
                       (setq keys (and (or prefix postfix)
                                       (cons prefix postfix)))
                       (setq keys


@@ -349,12 +345,12 @@ MENU, just change it, otherwise put it last in MENU."
                                  (cons cmd keys))))
                   (setq cache-specified nil))
                 (if keys (setq prop (cons :keys (cons keys prop)))))
                                  (cons cmd keys))))
                   (setq cache-specified nil))
                 (if keys (setq prop (cons :keys (cons keys prop)))))

-             (if (and visible (not (easy-menu-always-true visible)))
+             (if (and visible (not (easy-menu-always-true-p visible)))

                  (if (equal visible ''nil)
                      ;; Invisible menu item. Don't insert into keymap.
                      (setq remove t)
                    (setq prop (cons :visible (cons visible prop)))))))
                  (if (equal visible ''nil)
                      ;; Invisible menu item. Don't insert into keymap.
                      (setq remove t)
                    (setq prop (cons :visible (cons visible prop)))))))

-       (if (and active (not (easy-menu-always-true active)))
+       (if (and active (not (easy-menu-always-true-p active)))

            (setq prop (cons :enable (cons active prop))))
        (if (and (or no-name cache-specified)
                 (or (null cache) (stringp cache) (vectorp cache)))
            (setq prop (cons :enable (cons active prop))))
        (if (and (or no-name cache-specified)
                 (or (null cache) (stringp cache) (vectorp cache)))


@@ -382,6 +378,7 @@ otherwise put the new binding last in MENU.
 BEFORE can be either a string (menu item name) or a symbol
 \(the fake function key for the menu item).
 KEY does not have to be a symbol, and comparison is done with equal."
 BEFORE can be either a string (menu item name) or a symbol
 \(the fake function key for the menu item).
 KEY does not have to be a symbol, and comparison is done with equal."

+  (if (symbolp menu) (setq menu (indirect-function menu)))

   (let ((inserted (null item))         ; Fake already inserted.
        tail done)
     (while (not done)
   (let ((inserted (null item))         ; Fake already inserted.
        tail done)
     (while (not done)


@@ -412,18 +409,20 @@ KEY does not have to be a symbol, and comparison is done with equal."
 
 (defun easy-menu-name-match (name item)
   "Return t if NAME is the name of menu item ITEM.
 
 (defun easy-menu-name-match (name item)
   "Return t if NAME is the name of menu item ITEM.

-NAME can be either a string, or a symbol."
+NAME can be either a string, or a symbol.
+ITEM should be a keymap binding of the form (KEY . MENU-ITEM)."

   (if (consp item)
       (if (symbolp name)
          (eq (car-safe item) name)
        (if (stringp name)
            ;; Match against the text that is displayed to the user.
   (if (consp item)
       (if (symbolp name)
          (eq (car-safe item) name)
        (if (stringp name)
            ;; Match against the text that is displayed to the user.

-           (or (member-ignore-case name item)
+           (or (condition-case nil (member-ignore-case name item)
+                 (error nil))          ;`item' might not be a proper list.

                ;; Also check the string version of the symbol name,
                ;; for backwards compatibility.
                (eq (car-safe item) (intern name)))))))
 
                ;; Also check the string version of the symbol name,
                ;; for backwards compatibility.
                (eq (car-safe item) (intern name)))))))
 

-(defun easy-menu-always-true (x)
+(defun easy-menu-always-true-p (x)

   "Return true if form X never evaluates to nil."
   (if (consp x) (and (eq (car x) 'quote) (cadr x))
     (or (eq x t) (not (symbolp x)))))
   "Return true if form X never evaluates to nil."
   (if (consp x) (and (eq (car x) 'quote) (cadr x))
     (or (eq x t) (not (symbolp x)))))


@@ -456,14 +455,19 @@ the submenu named BEFORE, otherwise add it at the end of the menu.
 
 Either call this from `menu-bar-update-hook' or use a menu filter,
 to implement dynamic menus."
 
 Either call this from `menu-bar-update-hook' or use a menu filter,
 to implement dynamic menus."

-  (easy-menu-add-item nil path (cons name items) before))
+  (easy-menu-add-item nil path (easy-menu-create-menu name items) before))

 
 ;; 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).
 
 ;; 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).

-(defalias 'easy-menu-remove 'ignore)
+(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
+\(de)activated when the corresponding keymap is (de)activated.
+
+\(fn MENU)")

 
 (defun easy-menu-add (menu &optional map)
   "Add the menu to the menubar.
 
 (defun easy-menu-add (menu &optional map)
   "Add the menu to the menubar.


@@ -475,7 +479,9 @@ Do it only if `easy-menu-precalculate-equivalent-keybindings' is on."
   (when easy-menu-precalculate-equivalent-keybindings
     (if (and (symbolp menu) (not (keymapp menu)) (boundp menu))
        (setq menu (symbol-value menu)))
   (when easy-menu-precalculate-equivalent-keybindings
     (if (and (symbolp menu) (not (keymapp menu)) (boundp menu))
        (setq menu (symbol-value menu)))

-    (if (keymapp menu) (x-popup-menu nil 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.


@@ -495,7 +501,7 @@ In the latter case, ITEM is normally added at the end of the submenu.
 However, if BEFORE is a string and there is an item in the submenu
 with that name, then ITEM is added before that item.
 
 However, if BEFORE is a string and there is an item in the submenu
 with that name, then ITEM is added before that item.
 

-MAP should normally be a keymap; nil stands for the global menu-bar keymap.
+MAP should normally be a keymap; nil stands for the local menu-bar keymap.

 It can also be a symbol, which has earlier been used as the first
 argument in a call to `easy-menu-define', or the value of such a symbol.
 
 It can also be a symbol, which has earlier been used as the first
 argument in a call to `easy-menu-define', or the value of such a symbol.
 


@@ -517,15 +523,10 @@ earlier by `easy-menu-define' or `easy-menu-create-menu'."
       (easy-menu-define-key map (easy-menu-intern (car item))
                            (cdr item) before)
     (if (or (keymapp item)
       (easy-menu-define-key map (easy-menu-intern (car item))
                            (cdr item) before)
     (if (or (keymapp item)

-           (and (symbolp item) (keymapp (symbol-value item))))
+           (and (symbolp item) (keymapp (symbol-value item))
+                (setq item (symbol-value item))))

        ;; Item is a keymap, find the prompt string and use as item name.
        ;; Item is a keymap, find the prompt string and use as item name.

-       (let ((tail (easy-menu-get-map item nil)) name)
-         (if (not (keymapp item)) (setq item tail))
-         (while (and (null name) (consp (setq tail (cdr tail)))
-                     (not (keymapp tail)))
-           (if (stringp (car tail)) (setq name (car tail)) ; Got a name.
-             (setq tail (cdr tail))))
-         (setq item (cons name item))))
+       (setq item (cons (keymap-prompt item) item)))

     (easy-menu-do-add-item map item before)))
 
 (defun easy-menu-item-present-p (map path name)
     (easy-menu-do-add-item map item before)))
 
 (defun easy-menu-item-present-p (map path name)


@@ -568,10 +569,24 @@ If item is an old format item, a new format item is returned."
       (cons name item))                        ; Keymap or new menu format
      )))
 
       (cons name item))                        ; Keymap or new menu format
      )))
 

-(defun easy-menu-get-map-look-for-name (name submap)
-  (while (and submap (not (easy-menu-name-match name (car submap))))
-    (setq submap (cdr submap)))
-  submap)
+(defun easy-menu-lookup-name (map name)
+  "Lookup menu item NAME in keymap MAP.
+Like `lookup-key' except that NAME is not an array but just a single key
+and that NAME can be a string representing the menu item's name."
+  (or (lookup-key map (vector (easy-menu-intern name)))
+      (when (stringp name)
+       ;; `lookup-key' failed and we have a menu item name: look at the
+       ;; actual menu entries's names.
+       (catch 'found
+         (map-keymap (lambda (key item)
+                       (if (condition-case nil (member name item)
+                             (error nil))
+                           ;; Found it!!  Look for it again with
+                           ;; `lookup-key' so as to handle inheritance and
+                           ;; to extract the actual command/keymap bound to
+                           ;; `name' from the item (via get_keyelt).
+                           (throw 'found (lookup-key map (vector key)))))
+                     map)))))

 
 (defun easy-menu-get-map (map path &optional to-modify)
   "Return a sparse keymap in which to add or remove an item.
 
 (defun easy-menu-get-map (map path &optional to-modify)
   "Return a sparse keymap in which to add or remove an item.


@@ -582,34 +597,34 @@ wants to modify in the map that we return.
 In some cases we use that to select between the local and global maps."
   (setq map
        (catch 'found
 In some cases we use that to select between the local and global maps."
   (setq map
        (catch 'found

-         (let* ((key (vconcat (unless map '(menu-bar))
-                              (mapcar 'easy-menu-intern path)))
-                (maps (mapcar (lambda (map)
-                                (setq map (lookup-key map key))
-                                (while (and (symbolp map) (keymapp map))
-                                  (setq map (symbol-function map)))
-                                map)
-                              (if map
-                                  (list (if (and (symbolp map)
-                                                 (not (keymapp map)))
-                                            (symbol-value map) map))
-                                (current-active-maps)))))
+         (if (and map (symbolp map) (not (keymapp map)))
+             (setq map (symbol-value map)))
+         (let ((maps (if map (list map) (current-active-maps))))
+           ;; Look for PATH in each map.
+           (unless map (push 'menu-bar path))
+           (dolist (name path)
+             (setq maps
+                   (delq nil (mapcar (lambda (map)
+                                       (setq map (easy-menu-lookup-name
+                                                  map name))
+                                       (and (keymapp map) map))
+                                     maps))))
+

            ;; Prefer a map that already contains the to-be-modified entry.
            (when to-modify
              (dolist (map maps)
            ;; Prefer a map that already contains the to-be-modified entry.
            (when to-modify
              (dolist (map maps)

-               (when (and map (not (integerp map))
-                          (easy-menu-get-map-look-for-name to-modify map))
+               (when (easy-menu-lookup-name map to-modify)

                  (throw 'found map))))
            ;; Use the first valid map.
                  (throw 'found map))))
            ;; Use the first valid map.

-           (dolist (map maps)
-             (when (and map (not (integerp map)))
-               (throw 'found map)))
+           (when maps (throw 'found (car maps)))
+

            ;; Otherwise, make one up.
            ;; Hardcoding current-local-map is lame, but it's difficult
            ;; to know what the caller intended for us to do ;-(
            (let* ((name (if path (format "%s" (car (reverse path)))))
                   (newmap (make-sparse-keymap name)))
            ;; Otherwise, make one up.
            ;; Hardcoding current-local-map is lame, but it's difficult
            ;; to know what the caller intended for us to do ;-(
            (let* ((name (if path (format "%s" (car (reverse path)))))
                   (newmap (make-sparse-keymap name)))

-             (define-key (or map (current-local-map)) key
+             (define-key (or map (current-local-map))
+               (apply 'vector (mapcar 'easy-menu-intern path))

                (if name (cons name newmap) newmap))
              newmap))))
   (or (keymapp map) (error "Malformed menu in easy-menu: (%s)" map))
                (if name (cons name newmap) newmap))
              newmap))))
   (or (keymapp map) (error "Malformed menu in easy-menu: (%s)" map))


@@ -617,4 +632,5 @@ 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