aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2011-01-13 21:12:43 -0500
committerStefan Monnier2011-01-13 21:12:43 -0500
commitfc55380c5c71e863846caeef1500cb46735ee28a (patch)
tree777c9b3f53e94bf4b9eb5291f9427e5081d072b4
parent4d789d84b8d74fc01b83277fa9834bb9aa83642b (diff)
downloademacs-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/ChangeLog9
-rw-r--r--lisp/emacs-lisp/easymenu.el84
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 @@
12011-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
12011-01-13 Stefan Monnier <monnier@iro.umontreal.ca> 102011-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.
35It can take some time to calculate the equivalent key bindings that are shown 37It 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
69ENABLE is an expression; the menu is enabled for selection 71ENABLE is an expression; the menu is enabled for selection whenever
70whenever this expression's value is non-nil. 72this expression's value is non-nil. `:enable' is an alias for `:active'.
71 73
72The rest of the elements in MENU, are menu items. 74The 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
107ENABLE is an expression; the item is enabled for selection 109ENABLE is an expression; the item is enabled for selection whenever
108whenever this expression's value is non-nil. 110this 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