diff options
| author | Stefan Monnier | 2011-01-13 21:12:43 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2011-01-13 21:12:43 -0500 |
| commit | fc55380c5c71e863846caeef1500cb46735ee28a (patch) | |
| tree | 777c9b3f53e94bf4b9eb5291f9427e5081d072b4 | |
| parent | 4d789d84b8d74fc01b83277fa9834bb9aa83642b (diff) | |
| download | emacs-fc55380c5c71e863846caeef1500cb46735ee28a.tar.gz emacs-fc55380c5c71e863846caeef1500cb46735ee28a.zip | |
* lisp/emacs-lisp/easymenu.el: Add :enable, 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.
Fixes: debbugs:7754
| -rw-r--r-- | lisp/ChangeLog | 9 | ||||
| -rw-r--r-- | lisp/emacs-lisp/easymenu.el | 84 |
2 files changed, 52 insertions, 41 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 617e3148fc1..a14148bf0e0 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,12 @@ | |||
| 1 | 2011-01-14 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * emacs-lisp/easymenu.el: Add :enable (bug#7754), and obey :label. | ||
| 4 | Require CL. | ||
| 5 | (easy-menu-create-menu, easy-menu-convert-item-1): | ||
| 6 | Use :label rather than nil for labels. Use `case'. | ||
| 7 | Add :enable as alias for :active. | ||
| 8 | (easy-menu-binding): Obey :label. | ||
| 9 | |||
| 1 | 2011-01-13 Stefan Monnier <monnier@iro.umontreal.ca> | 10 | 2011-01-13 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 11 | ||
| 3 | Use run-mode-hooks for major mode hooks (bug#513). | 12 | Use run-mode-hooks for major mode hooks (bug#513). |
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 9992861fc3c..fe096b091db 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el | |||
| @@ -1,7 +1,7 @@ | |||
| 1 | ;;; easymenu.el --- support the easymenu interface for defining a menu | 1 | ;;; easymenu.el --- support the easymenu interface for defining a menu |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1994, 1996, 1998, 1999, 2000, 2001, 2002, 2003, | 3 | ;; Copyright (C) 1994, 1996, 1998, 1999, 2000, 2001, 2002, 2003, |
| 4 | ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | 4 | ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Keywords: emulations | 6 | ;; Keywords: emulations |
| 7 | ;; Author: Richard Stallman <rms@gnu.org> | 7 | ;; Author: Richard Stallman <rms@gnu.org> |
| @@ -30,6 +30,8 @@ | |||
| 30 | 30 | ||
| 31 | ;;; Code: | 31 | ;;; Code: |
| 32 | 32 | ||
| 33 | (eval-when-compile (require 'cl)) | ||
| 34 | |||
| 33 | (defvar easy-menu-precalculate-equivalent-keybindings nil | 35 | (defvar easy-menu-precalculate-equivalent-keybindings nil |
| 34 | "Determine when equivalent key bindings are computed for easy-menu menus. | 36 | "Determine when equivalent key bindings are computed for easy-menu menus. |
| 35 | It can take some time to calculate the equivalent key bindings that are shown | 37 | 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'. | |||
| 66 | 68 | ||
| 67 | :active ENABLE | 69 | :active ENABLE |
| 68 | 70 | ||
| 69 | ENABLE is an expression; the menu is enabled for selection | 71 | ENABLE is an expression; the menu is enabled for selection whenever |
| 70 | whenever this expression's value is non-nil. | 72 | this expression's value is non-nil. `:enable' is an alias for `:active'. |
| 71 | 73 | ||
| 72 | The rest of the elements in MENU, are menu items. | 74 | The rest of the elements in MENU, are menu items. |
| 73 | 75 | ||
| @@ -104,8 +106,8 @@ keyboard equivalent. | |||
| 104 | 106 | ||
| 105 | :active ENABLE | 107 | :active ENABLE |
| 106 | 108 | ||
| 107 | ENABLE is an expression; the item is enabled for selection | 109 | ENABLE is an expression; the item is enabled for selection whenever |
| 108 | whenever this expression's value is non-nil. | 110 | this expression's value is non-nil. `:enable' is an alias for `:active'. |
| 109 | 111 | ||
| 110 | :visible INCLUDE | 112 | :visible INCLUDE |
| 111 | 113 | ||
| @@ -163,10 +165,13 @@ This is expected to be bound to a mouse event." | |||
| 163 | (prog1 (get menu 'menu-prop) | 165 | (prog1 (get menu 'menu-prop) |
| 164 | (setq menu (symbol-function menu)))))) | 166 | (setq menu (symbol-function menu)))))) |
| 165 | (cons 'menu-item | 167 | (cons 'menu-item |
| 166 | (cons (or item-name | 168 | (cons (if (eq :label (car props)) |
| 167 | (if (keymapp menu) | 169 | (prog1 (cadr props) |
| 168 | (keymap-prompt menu)) | 170 | (setq props (cddr props))) |
| 169 | "") | 171 | (or item-name |
| 172 | (if (keymapp menu) | ||
| 173 | (keymap-prompt menu)) | ||
| 174 | "")) | ||
| 170 | (cons menu props))))) | 175 | (cons menu props))))) |
| 171 | 176 | ||
| 172 | ;;;###autoload | 177 | ;;;###autoload |
| @@ -232,15 +237,14 @@ possibly preceded by keyword pairs as described in `easy-menu-define'." | |||
| 232 | (keywordp (setq keyword (car menu-items)))) | 237 | (keywordp (setq keyword (car menu-items)))) |
| 233 | (setq arg (cadr menu-items)) | 238 | (setq arg (cadr menu-items)) |
| 234 | (setq menu-items (cddr menu-items)) | 239 | (setq menu-items (cddr menu-items)) |
| 235 | (cond | 240 | (case keyword |
| 236 | ((eq keyword :filter) | 241 | (:filter |
| 237 | (setq filter `(lambda (menu) | 242 | (setq filter `(lambda (menu) |
| 238 | (easy-menu-filter-return (,arg menu) ,menu-name)))) | 243 | (easy-menu-filter-return (,arg menu) ,menu-name)))) |
| 239 | ((eq keyword :active) (setq enable (or arg ''nil))) | 244 | ((:enable :active) (setq enable (or arg ''nil))) |
| 240 | ((eq keyword :label) (setq label arg)) | 245 | (:label (setq label arg)) |
| 241 | ((eq keyword :help) (setq help arg)) | 246 | (:help (setq help arg)) |
| 242 | ((or (eq keyword :included) (eq keyword :visible)) | 247 | ((:included :visible) (setq visible (or arg ''nil))))) |
| 243 | (setq visible (or arg ''nil))))) | ||
| 244 | (if (equal visible ''nil) | 248 | (if (equal visible ''nil) |
| 245 | nil ; Invisible menu entry, return nil. | 249 | nil ; Invisible menu entry, return nil. |
| 246 | (if (and visible (not (easy-menu-always-true-p visible))) | 250 | (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'." | |||
| 249 | (setq prop (cons :enable (cons enable prop)))) | 253 | (setq prop (cons :enable (cons enable prop)))) |
| 250 | (if filter (setq prop (cons :filter (cons filter prop)))) | 254 | (if filter (setq prop (cons :filter (cons filter prop)))) |
| 251 | (if help (setq prop (cons :help (cons help prop)))) | 255 | (if help (setq prop (cons :help (cons help prop)))) |
| 252 | (if label (setq prop (cons nil (cons label prop)))) | 256 | (if label (setq prop (cons :label (cons label prop)))) |
| 253 | (if filter | 257 | (setq menu (if filter |
| 254 | ;; The filter expects the menu in its XEmacs form and the pre-filter | 258 | ;; The filter expects the menu in its XEmacs form and the |
| 255 | ;; form will only be passed to the filter anyway, so we'd better | 259 | ;; pre-filter form will only be passed to the filter |
| 256 | ;; not convert it at all (it will be converted on the fly by | 260 | ;; anyway, so we'd better not convert it at all (it will |
| 257 | ;; easy-menu-filter-return). | 261 | ;; be converted on the fly by easy-menu-filter-return). |
| 258 | (setq menu menu-items) | 262 | menu-items |
| 259 | (setq menu (append menu (mapcar 'easy-menu-convert-item menu-items)))) | 263 | (append menu (mapcar 'easy-menu-convert-item menu-items)))) |
| 260 | (when prop | 264 | (when prop |
| 261 | (setq menu (easy-menu-make-symbol menu 'noexp)) | 265 | (setq menu (easy-menu-make-symbol menu 'noexp)) |
| 262 | (put menu 'menu-prop prop)) | 266 | (put menu 'menu-prop prop)) |
| @@ -312,7 +316,7 @@ ITEM defines an item as in `easy-menu-define'." | |||
| 312 | ;; Invisible menu item. Don't insert into keymap. | 316 | ;; Invisible menu item. Don't insert into keymap. |
| 313 | (setq remove t) | 317 | (setq remove t) |
| 314 | (when (and (symbolp command) (setq prop (get command 'menu-prop))) | 318 | (when (and (symbolp command) (setq prop (get command 'menu-prop))) |
| 315 | (when (null (car prop)) | 319 | (when (eq :label (car prop)) |
| 316 | (setq label (cadr prop)) | 320 | (setq label (cadr prop)) |
| 317 | (setq prop (cddr prop))) | 321 | (setq prop (cddr prop))) |
| 318 | (setq command (symbol-function command))))) | 322 | (setq command (symbol-function command))))) |
| @@ -331,30 +335,28 @@ ITEM defines an item as in `easy-menu-define'." | |||
| 331 | (setq keyword (aref item count)) | 335 | (setq keyword (aref item count)) |
| 332 | (setq arg (aref item (1+ count))) | 336 | (setq arg (aref item (1+ count))) |
| 333 | (setq count (+ 2 count)) | 337 | (setq count (+ 2 count)) |
| 334 | (cond | 338 | (case keyword |
| 335 | ((or (eq keyword :included) (eq keyword :visible)) | 339 | ((:included :visible) (setq visible (or arg ''nil))) |
| 336 | (setq visible (or arg ''nil))) | 340 | (:key-sequence (setq cache arg cache-specified t)) |
| 337 | ((eq keyword :key-sequence) | 341 | (:keys (setq keys arg no-name nil)) |
| 338 | (setq cache arg cache-specified t)) | 342 | (:label (setq label arg)) |
| 339 | ((eq keyword :keys) (setq keys arg no-name nil)) | 343 | ((:active :enable) (setq active (or arg ''nil))) |
| 340 | ((eq keyword :label) (setq label arg)) | 344 | (:help (setq prop (cons :help (cons arg prop)))) |
| 341 | ((eq keyword :active) (setq active (or arg ''nil))) | 345 | (:suffix (setq suffix arg)) |
| 342 | ((eq keyword :help) (setq prop (cons :help (cons arg prop)))) | 346 | (:style (setq style arg)) |
| 343 | ((eq keyword :suffix) (setq suffix arg)) | 347 | (:selected (setq selected (or arg ''nil))))) |
| 344 | ((eq keyword :style) (setq style arg)) | ||
| 345 | ((eq keyword :selected) (setq selected (or arg ''nil))))) | ||
| 346 | (if suffix | 348 | (if suffix |
| 347 | (setq label | 349 | (setq label |
| 348 | (if (stringp suffix) | 350 | (if (stringp suffix) |
| 349 | (if (stringp label) (concat label " " suffix) | 351 | (if (stringp label) (concat label " " suffix) |
| 350 | (list 'concat label (concat " " suffix))) | 352 | `(concat ,label ,(concat " " suffix))) |
| 351 | (if (stringp label) | 353 | (if (stringp label) |
| 352 | (list 'concat (concat label " ") suffix) | 354 | `(concat ,(concat label " ") ,suffix) |
| 353 | (list 'concat label " " suffix))))) | 355 | `(concat ,label " " ,suffix))))) |
| 354 | (cond | 356 | (cond |
| 355 | ((eq style 'button) | 357 | ((eq style 'button) |
| 356 | (setq label (if (stringp label) (concat "[" label "]") | 358 | (setq label (if (stringp label) (concat "[" label "]") |
| 357 | (list 'concat "[" label "]")))) | 359 | `(concat "[" ,label "]")))) |
| 358 | ((and selected | 360 | ((and selected |
| 359 | (setq style (assq style easy-menu-button-prefix))) | 361 | (setq style (assq style easy-menu-button-prefix))) |
| 360 | (setq prop (cons :button | 362 | (setq prop (cons :button |