| 1 |
|
|---|
| 2 |
|
|---|
| 3 |
|
|---|
| 4 |
|
|---|
| 5 |
|
|---|
| 6 |
|
|---|
| 7 |
|
|---|
| 8 |
|
|---|
| 9 |
|
|---|
| 10 |
|
|---|
| 11 |
|
|---|
| 12 |
|
|---|
| 13 |
|
|---|
| 14 |
|
|---|
| 15 |
|
|---|
| 16 |
|
|---|
| 17 |
|
|---|
| 18 |
|
|---|
| 19 |
|
|---|
| 20 |
|
|---|
| 21 |
|
|---|
| 22 |
|
|---|
| 23 |
|
|---|
| 24 |
|
|---|
| 25 |
|
|---|
| 26 |
|
|---|
| 27 |
|
|---|
| 28 |
|
|---|
| 29 |
|
|---|
| 30 |
|
|---|
| 31 |
|
|---|
| 32 |
|
|---|
| 33 |
|
|---|
| 34 |
(defcustom easy-menu-precalculate-equivalent-keybindings t |
|---|
| 35 |
"Determine when equivalent key bindings are computed for easy-menu menus. |
|---|
| 36 |
It can take some time to calculate the equivalent key bindings that are shown |
|---|
| 37 |
in a menu. If the variable is on, then this calculation gives a (maybe |
|---|
| 38 |
noticeable) delay when a mode is first entered. If the variable is off, then |
|---|
| 39 |
this delay will come when a menu is displayed the first time. If you never use |
|---|
| 40 |
menus, turn this variable off, otherwise it is probably better to keep it on." |
|---|
| 41 |
:type 'boolean |
|---|
| 42 |
:group 'menu |
|---|
| 43 |
:version "20.3") |
|---|
| 44 |
|
|---|
| 45 |
(defsubst easy-menu-intern (s) |
|---|
| 46 |
(if (stringp s) (intern s) s)) |
|---|
| 47 |
|
|---|
| 48 |
|
|---|
| 49 |
(put 'easy-menu-define 'lisp-indent-function 'defun) |
|---|
| 50 |
|
|---|
| 51 |
(defmacro easy-menu-define (symbol maps doc menu) |
|---|
| 52 |
"Define a menu bar submenu in maps MAPS, according to MENU. |
|---|
| 53 |
|
|---|
| 54 |
If SYMBOL is non-nil, store the menu keymap in the value of SYMBOL, |
|---|
| 55 |
and define SYMBOL as a function to pop up the menu, with DOC as its doc string. |
|---|
| 56 |
If SYMBOL is nil, just store the menu keymap into MAPS. |
|---|
| 57 |
|
|---|
| 58 |
The first element of MENU must be a string. It is the menu bar item name. |
|---|
| 59 |
It may be followed by the following keyword argument pairs |
|---|
| 60 |
|
|---|
| 61 |
:filter FUNCTION |
|---|
| 62 |
|
|---|
| 63 |
FUNCTION is a function with one argument, the rest of menu items. |
|---|
| 64 |
It returns the remaining items of the displayed menu. |
|---|
| 65 |
|
|---|
| 66 |
:visible INCLUDE |
|---|
| 67 |
|
|---|
| 68 |
INCLUDE is an expression; this menu is only visible if this |
|---|
| 69 |
expression has a non-nil value. `:included' is an alias for `:visible'. |
|---|
| 70 |
|
|---|
| 71 |
:active ENABLE |
|---|
| 72 |
|
|---|
| 73 |
ENABLE is an expression; the menu is enabled for selection |
|---|
| 74 |
whenever this expression's value is non-nil. |
|---|
| 75 |
|
|---|
| 76 |
The rest of the elements in MENU, are menu items. |
|---|
| 77 |
|
|---|
| 78 |
A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE] |
|---|
| 79 |
|
|---|
| 80 |
NAME is a string--the menu item name. |
|---|
| 81 |
|
|---|
| 82 |
CALLBACK is a command to run when the item is chosen, |
|---|
| 83 |
or a list to evaluate when the item is chosen. |
|---|
| 84 |
|
|---|
| 85 |
ENABLE is an expression; the item is enabled for selection |
|---|
| 86 |
whenever this expression's value is non-nil. |
|---|
| 87 |
|
|---|
| 88 |
Alternatively, a menu item may have the form: |
|---|
| 89 |
|
|---|
| 90 |
[ NAME CALLBACK [ KEYWORD ARG ] ... ] |
|---|
| 91 |
|
|---|
| 92 |
Where KEYWORD is one of the symbols defined below. |
|---|
| 93 |
|
|---|
| 94 |
:keys KEYS |
|---|
| 95 |
|
|---|
| 96 |
KEYS is a string; a complex keyboard equivalent to this menu item. |
|---|
| 97 |
This is normally not needed because keyboard equivalents are usually |
|---|
| 98 |
computed automatically. |
|---|
| 99 |
KEYS is expanded with `substitute-command-keys' before it is used. |
|---|
| 100 |
|
|---|
| 101 |
:key-sequence KEYS |
|---|
| 102 |
|
|---|
| 103 |
KEYS is nil, a string or a vector; nil or a keyboard equivalent to this |
|---|
| 104 |
menu item. |
|---|
| 105 |
This is a hint that will considerably speed up Emacs' first display of |
|---|
| 106 |
a menu. Use `:key-sequence nil' when you know that this menu item has no |
|---|
| 107 |
keyboard equivalent. |
|---|
| 108 |
|
|---|
| 109 |
:active ENABLE |
|---|
| 110 |
|
|---|
| 111 |
ENABLE is an expression; the item is enabled for selection |
|---|
| 112 |
whenever this expression's value is non-nil. |
|---|
| 113 |
|
|---|
| 114 |
:visible INCLUDE |
|---|
| 115 |
|
|---|
| 116 |
INCLUDE is an expression; this item is only visible if this |
|---|
| 117 |
expression has a non-nil value. `:included' is an alias for `:visible'. |
|---|
| 118 |
|
|---|
| 119 |
:suffix FORM |
|---|
| 120 |
|
|---|
| 121 |
FORM is an expression that will be dynamically evaluated and whose |
|---|
| 122 |
value will be concatenated to the menu entry's NAME. |
|---|
| 123 |
|
|---|
| 124 |
:style STYLE |
|---|
| 125 |
|
|---|
| 126 |
STYLE is a symbol describing the type of menu item. The following are |
|---|
| 127 |
defined: |
|---|
| 128 |
|
|---|
| 129 |
toggle: A checkbox. |
|---|
| 130 |
Prepend the name with `(*) ' or `( ) ' depending on if selected or not. |
|---|
| 131 |
radio: A radio button. |
|---|
| 132 |
Prepend the name with `[X] ' or `[ ] ' depending on if selected or not. |
|---|
| 133 |
button: Surround the name with `[' and `]'. Use this for an item in the |
|---|
| 134 |
menu bar itself. |
|---|
| 135 |
anything else means an ordinary menu item. |
|---|
| 136 |
|
|---|
| 137 |
:selected SELECTED |
|---|
| 138 |
|
|---|
| 139 |
SELECTED is an expression; the checkbox or radio button is selected |
|---|
| 140 |
whenever this expression's value is non-nil. |
|---|
| 141 |
|
|---|
| 142 |
:help HELP |
|---|
| 143 |
|
|---|
| 144 |
HELP is a string, the help to display for the menu item. |
|---|
| 145 |
|
|---|
| 146 |
A menu item can be a string. Then that string appears in the menu as |
|---|
| 147 |
unselectable text. A string consisting solely of hyphens is displayed |
|---|
| 148 |
as a solid horizontal line. |
|---|
| 149 |
|
|---|
| 150 |
A menu item can be a list with the same format as MENU. This is a submenu." |
|---|
| 151 |
`(progn |
|---|
| 152 |
,(if symbol `(defvar ,symbol nil ,doc)) |
|---|
| 153 |
(easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu))) |
|---|
| 154 |
|
|---|
| 155 |
|
|---|
| 156 |
(defun easy-menu-do-define (symbol maps doc menu) |
|---|
| 157 |
|
|---|
| 158 |
|
|---|
| 159 |
|
|---|
| 160 |
|
|---|
| 161 |
(let ((keymap (easy-menu-create-menu (car menu) (cdr menu)))) |
|---|
| 162 |
(when symbol |
|---|
| 163 |
(set symbol keymap) |
|---|
| 164 |
(defalias symbol |
|---|
| 165 |
`(lambda (event) ,doc (interactive "@e") |
|---|
| 166 |
|
|---|
| 167 |
|
|---|
| 168 |
(x-popup-menu event |
|---|
| 169 |
(or (and (symbolp ,symbol) |
|---|
| 170 |
(funcall |
|---|
| 171 |
(or (plist-get (get ,symbol 'menu-prop) |
|---|
| 172 |
:filter) |
|---|
| 173 |
'identity) |
|---|
| 174 |
(symbol-function ,symbol))) |
|---|
| 175 |
,symbol))))) |
|---|
| 176 |
(mapcar (lambda (map) |
|---|
| 177 |
(define-key map (vector 'menu-bar (easy-menu-intern (car menu))) |
|---|
| 178 |
(cons 'menu-item |
|---|
| 179 |
(cons (car menu) |
|---|
| 180 |
(if (not (symbolp keymap)) |
|---|
| 181 |
(list keymap) |
|---|
| 182 |
(cons (symbol-function keymap) |
|---|
| 183 |
(get keymap 'menu-prop))))))) |
|---|
| 184 |
(if (keymapp maps) (list maps) maps)))) |
|---|
| 185 |
|
|---|
| 186 |
(defun easy-menu-filter-return (menu &optional name) |
|---|
| 187 |
"Convert MENU to the right thing to return from a menu filter. |
|---|
| 188 |
MENU is a menu as computed by `easy-menu-define' or `easy-menu-create-menu' or |
|---|
| 189 |
a symbol whose value is such a menu. |
|---|
| 190 |
In Emacs a menu filter must return a menu (a keymap), in XEmacs a filter must |
|---|
| 191 |
return a menu items list (without menu name and keywords). |
|---|
| 192 |
This function returns the right thing in the two cases. |
|---|
| 193 |
If NAME is provided, it is used for the keymap." |
|---|
| 194 |
(cond |
|---|
| 195 |
((and (not (keymapp menu)) (consp menu)) |
|---|
| 196 |
|
|---|
| 197 |
|
|---|
| 198 |
(setq menu (easy-menu-create-menu (or name "") menu))) |
|---|
| 199 |
((vectorp menu) |
|---|
| 200 |
|
|---|
| 201 |
(setq menu (cdr (easy-menu-convert-item menu))))) |
|---|
| 202 |
menu) |
|---|
| 203 |
|
|---|
| 204 |
|
|---|
| 205 |
(defun easy-menu-create-menu (menu-name menu-items) |
|---|
| 206 |
"Create a menu called MENU-NAME with items described in MENU-ITEMS. |
|---|
| 207 |
MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items |
|---|
| 208 |
possibly preceded by keyword pairs as described in `easy-menu-define'." |
|---|
| 209 |
(let ((menu (make-sparse-keymap menu-name)) |
|---|
| 210 |
prop keyword arg label enable filter visible help) |
|---|
| 211 |
|
|---|
| 212 |
(while (and menu-items |
|---|
| 213 |
(cdr menu-items) |
|---|
| 214 |
(keywordp (setq keyword (car menu-items)))) |
|---|
| 215 |
(setq arg (cadr menu-items)) |
|---|
| 216 |
(setq menu-items (cddr menu-items)) |
|---|
| 217 |
(cond |
|---|
| 218 |
((eq keyword :filter) |
|---|
| 219 |
(setq filter `(lambda (menu) |
|---|
| 220 |
(easy-menu-filter-return (,arg menu) ,menu-name)))) |
|---|
| 221 |
((eq keyword :active) (setq enable (or arg ''nil))) |
|---|
| 222 |
((eq keyword :label) (setq label arg)) |
|---|
| 223 |
((eq keyword :help) (setq help arg)) |
|---|
| 224 |
((or (eq keyword :included) (eq keyword :visible)) |
|---|
| 225 |
(setq visible (or arg ''nil))))) |
|---|
| 226 |
(if (equal visible ''nil) |
|---|
| 227 |
nil |
|---|
| 228 |
(if (and visible (not (easy-menu-always-true-p visible))) |
|---|
| 229 |
(setq prop (cons :visible (cons visible prop)))) |
|---|
| 230 |
(if (and enable (not (easy-menu-always-true-p enable))) |
|---|
| 231 |
(setq prop (cons :enable (cons enable prop)))) |
|---|
| 232 |
(if filter (setq prop (cons :filter (cons filter prop)))) |
|---|
| 233 |
(if help (setq prop (cons :help (cons help prop)))) |
|---|
| 234 |
(if label (setq prop (cons nil (cons label prop)))) |
|---|
| 235 |
(if filter |
|---|
| 236 |
|
|---|
| 237 |
|
|---|
| 238 |
|
|---|
| 239 |
|
|---|
| 240 |
(setq menu menu-items) |
|---|
| 241 |
(setq menu (append menu (mapcar 'easy-menu-convert-item menu-items)))) |
|---|
| 242 |
(when prop |
|---|
| 243 |
(setq menu (easy-menu-make-symbol menu 'noexp)) |
|---|
| 244 |
(put menu 'menu-prop prop)) |
|---|
| 245 |
menu))) |
|---|
| 246 |
|
|---|
| 247 |
|
|---|
| 248 |
|
|---|
| 249 |
(defvar easy-menu-button-prefix |
|---|
| 250 |
'((radio . :radio) (toggle . :toggle))) |
|---|
| 251 |
|
|---|
| 252 |
(defun easy-menu-do-add-item (menu item &optional before) |
|---|
| 253 |
(setq item (easy-menu-convert-item item)) |
|---|
| 254 |
(easy-menu-define-key menu (easy-menu-intern (car item)) (cdr item) before)) |
|---|
| 255 |
|
|---|
| 256 |
(defvar easy-menu-converted-items-table (make-hash-table :test 'equal)) |
|---|
| 257 |
|
|---|
| 258 |
(defun easy-menu-convert-item (item) |
|---|
| 259 |
"Memoize the value returned by `easy-menu-convert-item-1' called on ITEM. |
|---|
| 260 |
This makes key-shortcut-caching work a *lot* better when this |
|---|
| 261 |
conversion is done from within a filter. |
|---|
| 262 |
This also helps when the NAME of the entry is recreated each time: |
|---|
| 263 |
since the menu is built and traversed separately, the lookup |
|---|
| 264 |
would always fail because the key is `equal' but not `eq'." |
|---|
| 265 |
(or (gethash item easy-menu-converted-items-table) |
|---|
| 266 |
(puthash item (easy-menu-convert-item-1 item) |
|---|
| 267 |
easy-menu-converted-items-table))) |
|---|
| 268 |
|
|---|
| 269 |
(defun easy-menu-convert-item-1 (item) |
|---|
| 270 |
"Parse an item description and convert it to a menu keymap element. |
|---|
| 271 |
ITEM defines an item as in `easy-menu-define'." |
|---|
| 272 |
(let (name command label prop remove help) |
|---|
| 273 |
(cond |
|---|
| 274 |
((stringp item) |
|---|
| 275 |
(setq label item)) |
|---|
| 276 |
((consp item) |
|---|
| 277 |
(setq label (setq name (car item))) |
|---|
| 278 |
(setq command (cdr item)) |
|---|
| 279 |
(if (not (keymapp command)) |
|---|
| 280 |
(setq command (easy-menu-create-menu name command))) |
|---|
| 281 |
(if (null command) |
|---|
| 282 |
|
|---|
| 283 |
(setq remove t) |
|---|
| 284 |
(when (and (symbolp command) (setq prop (get command 'menu-prop))) |
|---|
| 285 |
(when (null (car prop)) |
|---|
| 286 |
(setq label (cadr prop)) |
|---|
| 287 |
(setq prop (cddr prop))) |
|---|
| 288 |
(setq command (symbol-function command))))) |
|---|
| 289 |
((vectorp item) |
|---|
| 290 |
(let* ((ilen (length item)) |
|---|
| 291 |
(active (if (> ilen 2) (or (aref item 2) ''nil) t)) |
|---|
| 292 |
(no-name (not (symbolp (setq command (aref item 1))))) |
|---|
| 293 |
cache cache-specified) |
|---|
| 294 |
(setq label (setq name (aref item 0))) |
|---|
| 295 |
(if no-name (setq command (easy-menu-make-symbol command))) |
|---|
| 296 |
(if (keywordp active) |
|---|
| 297 |
(let ((count 2) |
|---|
| 298 |
keyword arg suffix visible style selected keys) |
|---|
| 299 |
(setq active nil) |
|---|
| 300 |
(while (> ilen count) |
|---|
| 301 |
(setq keyword (aref item count)) |
|---|
| 302 |
(setq arg (aref item (1+ count))) |
|---|
| 303 |
(setq count (+ 2 count)) |
|---|
| 304 |
(cond |
|---|
| 305 |
((or (eq keyword :included) (eq keyword :visible)) |
|---|
| 306 |
(setq visible (or arg ''nil))) |
|---|
| 307 |
((eq keyword :key-sequence) |
|---|
| 308 |
(setq cache arg cache-specified t)) |
|---|
| 309 |
((eq keyword :keys) (setq keys arg no-name nil)) |
|---|
| 310 |
((eq keyword :label) (setq label arg)) |
|---|
| 311 |
((eq keyword :active) (setq active (or arg ''nil))) |
|---|
| 312 |
((eq keyword :help) (setq prop (cons :help (cons arg prop)))) |
|---|
| 313 |
((eq keyword :suffix) (setq suffix arg)) |
|---|
| 314 |
((eq keyword :style) (setq style arg)) |
|---|
| 315 |
((eq keyword :selected) (setq selected (or arg ''nil))))) |
|---|
| 316 |
(if suffix |
|---|
| 317 |
(setq label |
|---|
| 318 |
(if (stringp suffix) |
|---|
| 319 |
(if (stringp label) (concat label " " suffix) |
|---|
| 320 |
(list 'concat label (concat " " suffix))) |
|---|
| 321 |
(if (stringp label) |
|---|
| 322 |
(list 'concat (concat label " ") suffix) |
|---|
| 323 |
(list 'concat label " " suffix))))) |
|---|
| 324 |
(cond |
|---|
| 325 |
((eq style 'button) |
|---|
| 326 |
(setq label (if (stringp label) (concat "[" label "]") |
|---|
| 327 |
(list 'concat "[" label "]")))) |
|---|
| 328 |
((and selected |
|---|
| 329 |
(setq style (assq style easy-menu-button-prefix))) |
|---|
| 330 |
(setq prop (cons :button |
|---|
| 331 |
(cons (cons (cdr style) selected) prop))))) |
|---|
| 332 |
(when (stringp keys) |
|---|
| 333 |
(if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$" |
|---|
| 334 |
keys) |
|---|
| 335 |
(let ((prefix |
|---|
| 336 |
(if (< (match-beginning 0) (match-beginning 1)) |
|---|
| 337 |
(substring keys 0 (match-beginning 1)))) |
|---|
| 338 |
(postfix |
|---|
| 339 |
(if (< (match-end 1) (match-end 0)) |
|---|
| 340 |
(substring keys (match-end 1)))) |
|---|
| 341 |
(cmd (intern (match-string 2 keys)))) |
|---|
| 342 |
(setq keys (and (or prefix postfix) |
|---|
| 343 |
(cons prefix postfix))) |
|---|
| 344 |
(setq keys |
|---|
| 345 |
(and (or keys (not (eq command cmd))) |
|---|
| 346 |
(cons cmd keys)))) |
|---|
| 347 |
(setq cache-specified nil)) |
|---|
| 348 |
(if keys (setq prop (cons :keys (cons keys prop))))) |
|---|
| 349 |
(if (and visible (not (easy-menu-always-true-p visible))) |
|---|
| 350 |
(if (equal visible ''nil) |
|---|
| 351 |
|
|---|
| 352 |
(setq remove t) |
|---|
| 353 |
(setq prop (cons :visible (cons visible prop))))))) |
|---|
| 354 |
(if (and active (not (easy-menu-always-true-p active))) |
|---|
| 355 |
(setq prop (cons :enable (cons active prop)))) |
|---|
| 356 |
(if (and (or no-name cache-specified) |
|---|
| 357 |
(or (null cache) (stringp cache) (vectorp cache))) |
|---|
| 358 |
(setq prop (cons :key-sequence (cons cache prop)))))) |
|---|
| 359 |
(t (error "Invalid menu item in easymenu"))) |
|---|
| 360 |
|
|---|
| 361 |
|
|---|
| 362 |
|
|---|
| 363 |
(cons (easy-menu-intern name) |
|---|
| 364 |
(and (not remove) |
|---|
| 365 |
(cons 'menu-item |
|---|
| 366 |
(cons label |
|---|
| 367 |
(and name |
|---|
| 368 |
(cons command prop)))))))) |
|---|
| 369 |
|
|---|
| 370 |
(defun easy-menu-define-key (menu key item &optional before) |
|---|
| 371 |
"Add binding in MENU for KEY => ITEM. Similar to `define-key-after'. |
|---|
| 372 |
If KEY is not nil then delete any duplications. |
|---|
| 373 |
If ITEM is nil, then delete the definition of KEY. |
|---|
| 374 |
|
|---|
| 375 |
Optional argument BEFORE is nil or a key in MENU. If BEFORE is not nil, |
|---|
| 376 |
put binding before the item in MENU named BEFORE; otherwise, |
|---|
| 377 |
if a binding for KEY is already present in MENU, just change it; |
|---|
| 378 |
otherwise put the new binding last in MENU. |
|---|
| 379 |
BEFORE can be either a string (menu item name) or a symbol |
|---|
| 380 |
\(the fake function key for the menu item). |
|---|
| 381 |
KEY does not have to be a symbol, and comparison is done with equal." |
|---|
| 382 |
(if (symbolp menu) (setq menu (indirect-function menu))) |
|---|
| 383 |
(let ((inserted (null item)) |
|---|
| 384 |
tail done) |
|---|
| 385 |
(while (not done) |
|---|
| 386 |
(cond |
|---|
| 387 |
((or (setq done (or (null (cdr menu)) (keymapp (cdr menu)))) |
|---|
| 388 |
(and before (easy-menu-name-match before (cadr menu)))) |
|---|
| 389 |
|
|---|
| 390 |
|
|---|
| 391 |
|
|---|
| 392 |
(if (null key) (setq done t)) |
|---|
| 393 |
(unless inserted |
|---|
| 394 |
(setcdr menu (cons (cons key item) (cdr menu))) |
|---|
| 395 |
(setq inserted t) |
|---|
| 396 |
(setq menu (cdr menu))) |
|---|
| 397 |
(setq menu (cdr menu))) |
|---|
| 398 |
((and key (equal (car-safe (cadr menu)) key)) |
|---|
| 399 |
(if (or inserted |
|---|
| 400 |
(and before |
|---|
| 401 |
(setq tail (cddr menu)) |
|---|
| 402 |
(not (keymapp tail)) |
|---|
| 403 |
(not (easy-menu-name-match |
|---|
| 404 |
before (car tail))))) |
|---|
| 405 |
(setcdr menu (cddr menu)) |
|---|
| 406 |
(setcdr (cadr menu) item) |
|---|
| 407 |
(setq inserted t) |
|---|
| 408 |
(setq menu (cdr menu)))) |
|---|
| 409 |
(t (setq menu (cdr menu))))))) |
|---|
| 410 |
|
|---|
| 411 |
(defun easy-menu-name-match (name item) |
|---|
| 412 |
"Return t if NAME is the name of menu item ITEM. |
|---|
| 413 |
NAME can be either a string, or a symbol. |
|---|
| 414 |
ITEM should be a keymap binding of the form (KEY . MENU-ITEM)." |
|---|
| 415 |
(if (consp item) |
|---|
| 416 |
(if (symbolp name) |
|---|
| 417 |
(eq (car-safe item) name) |
|---|
| 418 |
(if (stringp name) |
|---|
| 419 |
|
|---|
| 420 |
(or (condition-case nil (member-ignore-case name item) |
|---|
| 421 |
(error nil)) |
|---|
| 422 |
|
|---|
| 423 |
|
|---|
| 424 |
(eq (car-safe item) (intern name))))))) |
|---|
| 425 |
|
|---|
| 426 |
(defun easy-menu-always-true-p (x) |
|---|
| 427 |
"Return true if form X never evaluates to nil." |
|---|
| 428 |
(if (consp x) (and (eq (car x) 'quote) (cadr x)) |
|---|
| 429 |
(or (eq x t) (not (symbolp x))))) |
|---|
| 430 |
|
|---|
| 431 |
(defvar easy-menu-item-count 0) |
|---|
| 432 |
|
|---|
| 433 |
(defun easy-menu-make-symbol (callback &optional noexp) |
|---|
| 434 |
"Return a unique symbol with CALLBACK as function value. |
|---|
| 435 |
When non-nil, NOEXP indicates that CALLBACK cannot be an expression |
|---|
| 436 |
\(i.e. does not need to be turned into a function)." |
|---|
| 437 |
(let ((command |
|---|
| 438 |
(make-symbol (format "menu-function-%d" easy-menu-item-count)))) |
|---|
| 439 |
(setq easy-menu-item-count (1+ easy-menu-item-count)) |
|---|
| 440 |
(fset command |
|---|
| 441 |
(if (or (keymapp callback) (functionp callback) noexp) callback |
|---|
| 442 |
`(lambda () (interactive) ,callback))) |
|---|
| 443 |
command)) |
|---|
| 444 |
|
|---|
| 445 |
|
|---|
| 446 |
(defun easy-menu-change (path name items &optional before map) |
|---|
| 447 |
"Change menu found at PATH as item NAME to contain ITEMS. |
|---|
| 448 |
PATH is a list of strings for locating the menu that |
|---|
| 449 |
should contain a submenu named NAME. |
|---|
| 450 |
ITEMS is a list of menu items, as in `easy-menu-define'. |
|---|
| 451 |
These items entirely replace the previous items in that submenu. |
|---|
| 452 |
|
|---|
| 453 |
If MAP is specified, it should normally be a keymap; nil stands for the local |
|---|
| 454 |
menu-bar keymap. It can also be a symbol, which has earlier been used as the |
|---|
| 455 |
first argument in a call to `easy-menu-define', or the value of such a symbol. |
|---|
| 456 |
|
|---|
| 457 |
If the menu located by PATH has no submenu named NAME, add one. |
|---|
| 458 |
If the optional argument BEFORE is present, add it just before |
|---|
| 459 |
the submenu named BEFORE, otherwise add it at the end of the menu. |
|---|
| 460 |
|
|---|
| 461 |
To implement dynamic menus, either call this from |
|---|
| 462 |
`menu-bar-update-hook' or use a menu filter." |
|---|
| 463 |
(easy-menu-add-item map path (easy-menu-create-menu name items) before)) |
|---|
| 464 |
|
|---|
| 465 |
|
|---|
| 466 |
|
|---|
| 467 |
|
|---|
| 468 |
|
|---|
| 469 |
|
|---|
| 470 |
(defalias 'easy-menu-remove 'ignore |
|---|
| 471 |
"Remove MENU from the current menu bar. |
|---|
| 472 |
Contrary to XEmacs, this is a nop on Emacs since menus are automatically |
|---|
| 473 |
\(de)activated when the corresponding keymap is (de)activated. |
|---|
| 474 |
|
|---|
| 475 |
\(fn MENU)") |
|---|
| 476 |
|
|---|
| 477 |
(defun easy-menu-add (menu &optional map) |
|---|
| 478 |
"Add the menu to the menubar. |
|---|
| 479 |
On Emacs, menus are already automatically activated when the |
|---|
| 480 |
corresponding keymap is activated. On XEmacs this is needed to |
|---|
| 481 |
actually add the menu to the current menubar. |
|---|
| 482 |
|
|---|
| 483 |
This also precalculates equivalent key bindings when |
|---|
| 484 |
`easy-menu-precalculate-equivalent-keybindings' is on. |
|---|
| 485 |
|
|---|
| 486 |
You should call this once the menu and keybindings are set up |
|---|
| 487 |
completely and menu filter functions can be expected to work." |
|---|
| 488 |
(when easy-menu-precalculate-equivalent-keybindings |
|---|
| 489 |
(if (and (symbolp menu) (not (keymapp menu)) (boundp menu)) |
|---|
| 490 |
(setq menu (symbol-value menu))) |
|---|
| 491 |
(and (keymapp menu) (fboundp 'x-popup-menu) |
|---|
| 492 |
(x-popup-menu nil menu)) |
|---|
| 493 |
)) |
|---|
| 494 |
|
|---|
| 495 |
(defun add-submenu (menu-path submenu &optional before in-menu) |
|---|
| 496 |
"Add submenu SUBMENU in the menu at MENU-PATH. |
|---|
| 497 |
If BEFORE is non-nil, add before the item named BEFORE. |
|---|
| 498 |
If IN-MENU is non-nil, follow MENU-PATH in IN-MENU. |
|---|
| 499 |
This is a compatibility function; use `easy-menu-add-item'." |
|---|
| 500 |
(easy-menu-add-item (or in-menu (current-global-map)) |
|---|
| 501 |
(cons "menu-bar" menu-path) |
|---|
| 502 |
submenu before)) |
|---|
| 503 |
|
|---|
| 504 |
(defun easy-menu-add-item (map path item &optional before) |
|---|
| 505 |
"To the submenu of MAP with path PATH, add ITEM. |
|---|
| 506 |
|
|---|
| 507 |
If an item with the same name is already present in this submenu, |
|---|
| 508 |
then ITEM replaces it. Otherwise, ITEM is added to this submenu. |
|---|
| 509 |
In the latter case, ITEM is normally added at the end of the submenu. |
|---|
| 510 |
However, if BEFORE is a string and there is an item in the submenu |
|---|
| 511 |
with that name, then ITEM is added before that item. |
|---|
| 512 |
|
|---|
| 513 |
MAP should normally be a keymap; nil stands for the local menu-bar keymap. |
|---|
| 514 |
It can also be a symbol, which has earlier been used as the first |
|---|
| 515 |
argument in a call to `easy-menu-define', or the value of such a symbol. |
|---|
| 516 |
|
|---|
| 517 |
PATH is a list of strings for locating the submenu where ITEM is to be |
|---|
| 518 |
added. If PATH is nil, MAP itself is used. Otherwise, the first |
|---|
| 519 |
element should be the name of a submenu directly under MAP. This |
|---|
| 520 |
submenu is then traversed recursively with the remaining elements of PATH. |
|---|
| 521 |
|
|---|
| 522 |
ITEM is either defined as in `easy-menu-define' or a non-nil value returned |
|---|
| 523 |
by `easy-menu-item-present-p' or `easy-menu-remove-item' or a menu defined |
|---|
| 524 |
earlier by `easy-menu-define' or `easy-menu-create-menu'." |
|---|
| 525 |
(setq map (easy-menu-get-map map path |
|---|
| 526 |
(and (null map) (null path) |
|---|
| 527 |
(stringp (car-safe item)) |
|---|
| 528 |
(car item)))) |
|---|
| 529 |
(if (and (consp item) (consp (cdr item)) (eq (cadr item) 'menu-item)) |
|---|
| 530 |
|
|---|
| 531 |
|
|---|
| 532 |
(easy-menu-define-key map (easy-menu-intern (car item)) |
|---|
| 533 |
(cdr item) before) |
|---|
| 534 |
(if (or (keymapp item) |
|---|
| 535 |
(and (symbolp item) (keymapp (symbol-value item)) |
|---|
| 536 |
(setq item (symbol-value item)))) |
|---|
| 537 |
|
|---|
| 538 |
(setq item (cons (keymap-prompt item) item))) |
|---|
| 539 |
(easy-menu-do-add-item map item before))) |
|---|
| 540 |
|
|---|
| 541 |
(defun easy-menu-item-present-p (map path name) |
|---|
| 542 |
"In submenu of MAP with path PATH, return non-nil if item NAME is present. |
|---|
| 543 |
MAP and PATH are defined as in `easy-menu-add-item'. |
|---|
| 544 |
NAME should be a string, the name of the element to be looked for." |
|---|
| 545 |
(easy-menu-return-item (easy-menu-get-map map path) name)) |
|---|
| 546 |
|
|---|
| 547 |
(defun easy-menu-remove-item (map path name) |
|---|
| 548 |
"From submenu of MAP with path PATH remove item NAME. |
|---|
| 549 |
MAP and PATH are defined as in `easy-menu-add-item'. |
|---|
| 550 |
NAME should be a string, the name of the element to be removed." |
|---|
| 551 |
(setq map (easy-menu-get-map map path)) |
|---|
| 552 |
(let ((ret (easy-menu-return-item map name))) |
|---|
| 553 |
(if ret (easy-menu-define-key map (easy-menu-intern name) nil)) |
|---|
| 554 |
ret)) |
|---|
| 555 |
|
|---|
| 556 |
(defun easy-menu-return-item (menu name) |
|---|
| 557 |
"In menu MENU try to look for menu item with name NAME. |
|---|
| 558 |
If a menu item is found, return (NAME . item), otherwise return nil. |
|---|
| 559 |
If item is an old format item, a new format item is returned." |
|---|
| 560 |
|
|---|
| 561 |
|
|---|
| 562 |
|
|---|
| 563 |
|
|---|
| 564 |
|
|---|
| 565 |
|
|---|
| 566 |
(let ((item (or (cdr (assq name menu)) |
|---|
| 567 |
(lookup-key menu (vector (easy-menu-intern name))))) |
|---|
| 568 |
ret enable cache label) |
|---|
| 569 |
(cond |
|---|
| 570 |
((stringp (car-safe item)) |
|---|
| 571 |
|
|---|
| 572 |
(setq label (car item)) |
|---|
| 573 |
(when (stringp (car (setq item (cdr item)))) |
|---|
| 574 |
(setq ret (list :help (car item))) |
|---|
| 575 |
(setq item (cdr item))) |
|---|
| 576 |
(when (and (consp item) (consp (car item)) |
|---|
| 577 |
(or (null (caar item)) (numberp (caar item)))) |
|---|
| 578 |
(setq cache (car item)) |
|---|
| 579 |
(setq item (cdr item))) |
|---|
| 580 |
(and (symbolp item) (setq enable (get item 'menu-enable)) |
|---|
| 581 |
(setq ret (cons :enable (cons enable ret)))) |
|---|
| 582 |
(if cache (setq ret (cons cache ret))) |
|---|
| 583 |
(cons name (cons 'menu-enable (cons label (cons item ret))))) |
|---|
| 584 |
(item |
|---|
| 585 |
(cons name item)) |
|---|
| 586 |
))) |
|---|
| 587 |
|
|---|
| 588 |
(defun easy-menu-lookup-name (map name) |
|---|
| 589 |
"Lookup menu item NAME in keymap MAP. |
|---|
| 590 |
Like `lookup-key' except that NAME is not an array but just a single key |
|---|
| 591 |
and that NAME can be a string representing the menu item's name." |
|---|
| 592 |
(or (lookup-key map (vector (easy-menu-intern name))) |
|---|
| 593 |
(when (stringp name) |
|---|
| 594 |
|
|---|
| 595 |
|
|---|
| 596 |
(catch 'found |
|---|
| 597 |
(map-keymap (lambda (key item) |
|---|
| 598 |
(if (condition-case nil (member name item) |
|---|
| 599 |
(error nil)) |
|---|
| 600 |
|
|---|
| 601 |
|
|---|
| 602 |
|
|---|
| 603 |
|
|---|
| 604 |
(throw 'found (lookup-key map (vector key))))) |
|---|
| 605 |
map))))) |
|---|
| 606 |
|
|---|
| 607 |
(defun easy-menu-get-map (map path &optional to-modify) |
|---|
| 608 |
"Return a sparse keymap in which to add or remove an item. |
|---|
| 609 |
MAP and PATH are as defined in `easy-menu-add-item'. |
|---|
| 610 |
|
|---|
| 611 |
TO-MODIFY, if non-nil, is the name of the item the caller |
|---|
| 612 |
wants to modify in the map that we return. |
|---|
| 613 |
In some cases we use that to select between the local and global maps." |
|---|
| 614 |
(setq map |
|---|
| 615 |
(catch 'found |
|---|
| 616 |
(if (and map (symbolp map) (not (keymapp map))) |
|---|
| 617 |
(setq map (symbol-value map))) |
|---|
| 618 |
(let ((maps (if map (list map) (current-active-maps)))) |
|---|
| 619 |
|
|---|
| 620 |
(unless map (push 'menu-bar path)) |
|---|
| 621 |
(dolist (name path) |
|---|
| 622 |
(setq maps |
|---|
| 623 |
(delq nil (mapcar (lambda (map) |
|---|
| 624 |
(setq map (easy-menu-lookup-name |
|---|
| 625 |
map name)) |
|---|
| 626 |
(and (keymapp map) map)) |
|---|
| 627 |
maps)))) |
|---|
| 628 |
|
|---|
| 629 |
|
|---|
| 630 |
(when to-modify |
|---|
| 631 |
(dolist (map maps) |
|---|
| 632 |
(when (easy-menu-lookup-name map to-modify) |
|---|
| 633 |
(throw 'found map)))) |
|---|
| 634 |
|
|---|
| 635 |
(when maps (throw 'found (car maps))) |
|---|
| 636 |
|
|---|
| 637 |
|
|---|
| 638 |
|
|---|
| 639 |
|
|---|
| 640 |
(let* ((name (if path (format "%s" (car (reverse path))))) |
|---|
| 641 |
(newmap (make-sparse-keymap name))) |
|---|
| 642 |
(define-key (or map (current-local-map)) |
|---|
| 643 |
(apply 'vector (mapcar 'easy-menu-intern path)) |
|---|
| 644 |
(if name (cons name newmap) newmap)) |
|---|
| 645 |
newmap)))) |
|---|
| 646 |
(or (keymapp map) (error "Malformed menu in easy-menu: (%s)" map)) |
|---|
| 647 |
map) |
|---|
| 648 |
|
|---|
| 649 |
(provide 'easymenu) |
|---|
| 650 |
|
|---|
| 651 |
|
|---|
| 652 |
|
|---|
| 653 |
|
|---|