mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-22 18:35:09 +00:00
Code Issues Releases Activity

* lisp/emacs-lisp/easymenu.el: Add :enable, and obey :label. Require CL.

Browse Source 
(easy-menu-create-menu, easy-menu-convert-item-1):
Use :label rather than nil for labels.  Use `case'.
Add :enable as alias for :active.
(easy-menu-binding): Obey :label.

Fixes: debbugs:7754
This commit is contained in:
Stefan Monnier 2011-01-13 21:12:43 -05:00
parent 4d789d84b8
commit fc55380c5c
2 changed files with 52 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lisp/ChangeLog
View File

@ -1,3 +1,12 @@
2011-01-14 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/easymenu.el: Add :enable (bug#7754), and obey :label.
Require CL.
(easy-menu-create-menu, easy-menu-convert-item-1):
Use :label rather than nil for labels. Use `case'.
Add :enable as alias for :active.
(easy-menu-binding): Obey :label.
2011-01-13 Stefan Monnier <monnier@iro.umontreal.ca> 2011-01-13 Stefan Monnier <monnier@iro.umontreal.ca>
Use run-mode-hooks for major mode hooks (bug#513). Use run-mode-hooks for major mode hooks (bug#513).

84
lisp/emacs-lisp/easymenu.el
View File

@ -1,7 +1,7 @@
;;; 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, ;; Copyright (C) 1994, 1996, 1998, 1999, 2000, 2001, 2002, 2003,
;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
;; Keywords: emulations ;; Keywords: emulations
;; Author: Richard Stallman <rms@gnu.org> ;; Author: Richard Stallman <rms@gnu.org>
@ -30,6 +30,8 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
(defvar easy-menu-precalculate-equivalent-keybindings nil (defvar easy-menu-precalculate-equivalent-keybindings nil
"Determine when equivalent key bindings are computed for easy-menu menus. "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 It can take some time to calculate the equivalent key bindings that are shown
@ -66,8 +68,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 ENABLE is an expression; the menu is enabled for selection whenever
whenever this expression's value is non-nil. 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.
@ -104,8 +106,8 @@ keyboard equivalent.
:active ENABLE :active ENABLE
ENABLE is an expression; the item is enabled for selection ENABLE is an expression; the item is enabled for selection whenever
whenever this expression's value is non-nil. this expression's value is non-nil. `:enable' is an alias for `:active'.
:visible INCLUDE :visible INCLUDE
@ -163,10 +165,13 @@ This is expected to be bound to a mouse event."
(prog1 (get menu 'menu-prop) (prog1 (get menu 'menu-prop)
(setq menu (symbol-function menu)))))) (setq menu (symbol-function menu))))))
(cons 'menu-item (cons 'menu-item
(cons (or item-name (cons (if (eq :label (car props))
(if (keymapp menu) (prog1 (cadr props)
(keymap-prompt menu)) (setq props (cddr props)))
"") (or item-name
(if (keymapp menu)
(keymap-prompt menu))
""))
(cons menu props))))) (cons menu props)))))
;;;###autoload ;;;###autoload
@ -232,15 +237,14 @@ possibly preceded by keyword pairs as described in `easy-menu-define'."
(keywordp (setq keyword (car menu-items)))) (keywordp (setq keyword (car menu-items))))
(setq arg (cadr menu-items)) (setq arg (cadr menu-items))
(setq menu-items (cddr menu-items)) (setq menu-items (cddr menu-items))
(cond (case keyword
((eq keyword :filter) (:filter
(setq filter `(lambda (menu) (setq filter `(lambda (menu)
(easy-menu-filter-return (,arg menu) ,menu-name)))) (easy-menu-filter-return (,arg menu) ,menu-name))))
((eq keyword :active) (setq enable (or arg ''nil))) ((:enable :active) (setq enable (or arg ''nil)))
((eq keyword :label) (setq label arg)) (:label (setq label arg))
((eq keyword :help) (setq help arg)) (:help (setq help arg))
((or (eq keyword :included) (eq keyword :visible)) ((:included :visible) (setq visible (or arg ''nil)))))
(setq visible (or arg ''nil)))))
(if (equal visible ''nil) (if (equal visible ''nil)
nil ; Invisible menu entry, return nil. nil ; Invisible menu entry, return nil.
(if (and visible (not (easy-menu-always-true-p visible))) (if (and visible (not (easy-menu-always-true-p visible)))
@ -249,14 +253,14 @@ possibly preceded by keyword pairs as described in `easy-menu-define'."
(setq prop (cons :enable (cons enable prop)))) (setq prop (cons :enable (cons enable prop))))
(if filter (setq prop (cons :filter (cons filter prop)))) (if filter (setq prop (cons :filter (cons filter prop))))
(if help (setq prop (cons :help (cons help prop)))) (if help (setq prop (cons :help (cons help prop))))
(if label (setq prop (cons nil (cons label prop)))) (if label (setq prop (cons :label (cons label prop))))
(if filter (setq menu (if filter
;; The filter expects the menu in its XEmacs form and the pre-filter ;; The filter expects the menu in its XEmacs form and the
;; form will only be passed to the filter anyway, so we'd better ;; pre-filter form will only be passed to the filter
;; not convert it at all (it will be converted on the fly by ;; anyway, so we'd better not convert it at all (it will
;; easy-menu-filter-return). ;; be converted on the fly by easy-menu-filter-return).
(setq menu menu-items) menu-items
(setq menu (append menu (mapcar 'easy-menu-convert-item menu-items)))) (append menu (mapcar 'easy-menu-convert-item menu-items))))
(when prop (when prop
(setq menu (easy-menu-make-symbol menu 'noexp)) (setq menu (easy-menu-make-symbol menu 'noexp))
(put menu 'menu-prop prop)) (put menu 'menu-prop prop))
@ -312,7 +316,7 @@ ITEM defines an item as in `easy-menu-define'."
;; Invisible menu item. Don't insert into keymap. ;; Invisible menu item. Don't insert into keymap.
(setq remove t) (setq remove t)
(when (and (symbolp command) (setq prop (get command 'menu-prop))) (when (and (symbolp command) (setq prop (get command 'menu-prop)))
(when (null (car prop)) (when (eq :label (car prop))
(setq label (cadr prop)) (setq label (cadr prop))
(setq prop (cddr prop))) (setq prop (cddr prop)))
(setq command (symbol-function command))))) (setq command (symbol-function command)))))
@ -331,30 +335,28 @@ ITEM defines an item as in `easy-menu-define'."
(setq keyword (aref item count)) (setq keyword (aref item count))
(setq arg (aref item (1+ count))) (setq arg (aref item (1+ count)))
(setq count (+ 2 count)) (setq count (+ 2 count))
(cond (case keyword
((or (eq keyword :included) (eq keyword :visible)) ((:included :visible) (setq visible (or arg ''nil)))
(setq visible (or arg ''nil))) (:key-sequence (setq cache arg cache-specified t))
((eq keyword :key-sequence) (:keys (setq keys arg no-name nil))
(setq cache arg cache-specified t)) (:label (setq label arg))
((eq keyword :keys) (setq keys arg no-name nil)) ((:active :enable) (setq active (or arg ''nil)))
((eq keyword :label) (setq label arg)) (:help (setq prop (cons :help (cons arg prop))))
((eq keyword :active) (setq active (or arg ''nil))) (:suffix (setq suffix arg))
((eq keyword :help) (setq prop (cons :help (cons arg prop)))) (:style (setq style arg))
((eq keyword :suffix) (setq suffix arg)) (:selected (setq selected (or arg ''nil)))))
((eq keyword :style) (setq style arg))
((eq keyword :selected) (setq selected (or arg ''nil)))))
(if suffix (if suffix
(setq label (setq label
(if (stringp suffix) (if (stringp suffix)
(if (stringp label) (concat label " " 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) `(concat ,(concat label " ") ,suffix)
(list 'concat label " " suffix))))) `(concat ,label " " ,suffix)))))
(cond (cond
((eq style 'button) ((eq style 'button)
(setq label (if (stringp label) (concat "[" label "]") (setq label (if (stringp label) (concat "[" label "]")
(list 'concat "[" label "]")))) `(concat "[" ,label "]"))))
((and selected ((and selected
(setq style (assq style easy-menu-button-prefix))) (setq style (assq style easy-menu-button-prefix)))
(setq prop (cons :button (setq prop (cons :button