diff options
| author | Stefan Monnier | 2000-09-16 23:35:51 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2000-09-16 23:35:51 +0000 |
| commit | 40716cd9c4d41db83dd06cb88dd087eede602f01 (patch) | |
| tree | 691e9f87b7456bf18f8421ce68197ab4d035360b | |
| parent | b74123131b11f3707410a2725dd6eabae3e54109 (diff) | |
| download | emacs-40716cd9c4d41db83dd06cb88dd087eede602f01.tar.gz emacs-40716cd9c4d41db83dd06cb88dd087eede602f01.zip | |
(popup-menu, popup-menu-internal, popup-menu-popup): Remove.
| -rw-r--r-- | lisp/emacs-lisp/lmenu.el | 141 |
1 files changed, 11 insertions, 130 deletions
diff --git a/lisp/emacs-lisp/lmenu.el b/lisp/emacs-lisp/lmenu.el index c67e209821a..eceda361b89 100644 --- a/lisp/emacs-lisp/lmenu.el +++ b/lisp/emacs-lisp/lmenu.el | |||
| @@ -2,7 +2,7 @@ | |||
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Keywords: emulations | 5 | ;; Keywords: emulations obsolete |
| 6 | 6 | ||
| 7 | ;; This file is part of GNU Emacs. | 7 | ;; This file is part of GNU Emacs. |
| 8 | 8 | ||
| @@ -47,6 +47,7 @@ | |||
| 47 | (cons (cons 'current-menubar lucid-menubar-map) | 47 | (cons (cons 'current-menubar lucid-menubar-map) |
| 48 | minor-mode-map-alist))) | 48 | minor-mode-map-alist))) |
| 49 | 49 | ||
| 50 | ;; XEmacs compatibility | ||
| 50 | (defun set-menubar-dirty-flag () | 51 | (defun set-menubar-dirty-flag () |
| 51 | (force-mode-line-update) | 52 | (force-mode-line-update) |
| 52 | (setq lucid-menu-bar-dirty-flag t)) | 53 | (setq lucid-menu-bar-dirty-flag t)) |
| @@ -124,115 +125,7 @@ | |||
| 124 | (setq menu-items (cdr menu-items))) | 125 | (setq menu-items (cdr menu-items))) |
| 125 | menu)) | 126 | menu)) |
| 126 | 127 | ||
| 127 | ;; The value of the cache-symbol for a menu | 128 | ;; XEmacs compatibility function |
| 128 | ;; is | ||
| 129 | ;; unbound -- nothing computed | ||
| 130 | ;; (ORIG . TRANSL) | ||
| 131 | ;; ORIG is the original menu spec list | ||
| 132 | ;; and TRANSL is its translation. | ||
| 133 | |||
| 134 | (defmacro popup-menu (arg) | ||
| 135 | "Pop up the given menu. | ||
| 136 | A menu is a list of menu items, strings, and submenus. | ||
| 137 | |||
| 138 | The first element of a menu must be a string, which is the name of the | ||
| 139 | menu. This is the string that will be displayed in the parent menu, if | ||
| 140 | any. For toplevel menus, it is ignored. This string is not displayed | ||
| 141 | in the menu itself. | ||
| 142 | |||
| 143 | A menu item is a vector containing: | ||
| 144 | |||
| 145 | - the name of the menu item (a string); | ||
| 146 | - the `callback' of that item; | ||
| 147 | - a list of keywords with associated values: | ||
| 148 | - :active active-p a form specifying whether this item is selectable; | ||
| 149 | - :suffix suffix a string to be appended to the name as an `argument' | ||
| 150 | to the command, like `Kill Buffer NAME'; | ||
| 151 | - :keys command-keys a string, suitable for `substitute-command-keys', | ||
| 152 | to specify the keyboard equivalent of a command | ||
| 153 | when the callback is a form (this is not necessary | ||
| 154 | when the callback is a symbol, as the keyboard | ||
| 155 | equivalent is computed automatically in that case); | ||
| 156 | - :style style a symbol: nil for a normal menu item, `toggle' for | ||
| 157 | a toggle button (a single option that can be turned | ||
| 158 | on or off), or `radio' for a radio button (one of a | ||
| 159 | group of mutually exclusive options); | ||
| 160 | - :selected form for `toggle' or `radio' style, a form that specifies | ||
| 161 | whether the button will be in the selected state. | ||
| 162 | |||
| 163 | Alternately, the vector may contain exactly 3 or 4 elements, with the third | ||
| 164 | element specifying `active-p' and the fourth specifying `suffix'. | ||
| 165 | |||
| 166 | If the `callback' of a menu item is a symbol, then it must name a command. | ||
| 167 | It will be invoked with `call-interactively'. If it is a list, then it is | ||
| 168 | evaluated with `eval'. | ||
| 169 | |||
| 170 | If an element of a menu is a string, then that string will be presented in | ||
| 171 | the menu as unselectable text. | ||
| 172 | |||
| 173 | If an element of a menu is a string consisting solely of hyphens, then that | ||
| 174 | item will be presented as a solid horizontal line. | ||
| 175 | |||
| 176 | If an element of a menu is a list, it is treated as a submenu. The name of | ||
| 177 | that submenu (the first element in the list) will be used as the name of the | ||
| 178 | item representing this menu on the parent. | ||
| 179 | |||
| 180 | The syntax, more precisely: | ||
| 181 | |||
| 182 | form := <something to pass to `eval'> | ||
| 183 | command := <a symbol or string, to pass to `call-interactively'> | ||
| 184 | callback := command | form | ||
| 185 | active-p := <t or nil, whether this thing is selectable> | ||
| 186 | text := <string, non selectable> | ||
| 187 | name := <string> | ||
| 188 | suffix := <string> | ||
| 189 | command-keys := <string> | ||
| 190 | object-style := 'nil' | 'toggle' | 'radio' | ||
| 191 | keyword := ':active' active-p | ||
| 192 | | ':suffix' suffix | ||
| 193 | | ':keys' command-keys | ||
| 194 | | ':style' object-style | ||
| 195 | | ':selected' form | ||
| 196 | menu-item := '[' name callback active-p [ suffix ] ']' | ||
| 197 | | '[' name callback [ keyword ]+ ']' | ||
| 198 | menu := '(' name [ menu-item | menu | text ]+ ')'" | ||
| 199 | (if (not (symbolp arg)) | ||
| 200 | `(popup-menu-internal ,arg nil) | ||
| 201 | `(popup-menu-internal ,arg | ||
| 202 | ',(intern (concat "popup-menu-" (symbol-name arg)))))) | ||
| 203 | |||
| 204 | (defun popup-menu-internal (menu cache-symbol) | ||
| 205 | (if (null cache-symbol) | ||
| 206 | ;; If no cache symbol, translate the menu afresh each time. | ||
| 207 | (popup-menu-popup (make-lucid-menu-keymap (car menu) (cdr menu))) | ||
| 208 | ;; We have a cache symbol. See if the cache is valid | ||
| 209 | ;; for the same menu we have now. | ||
| 210 | (or (and (boundp cache-symbol) | ||
| 211 | (consp (symbol-value cache-symbol)) | ||
| 212 | (equal (car (symbol-value cache-symbol)) | ||
| 213 | menu)) | ||
| 214 | ;; If not, update it. | ||
| 215 | (set cache-symbol | ||
| 216 | (cons menu (make-lucid-menu-keymap (car menu) (cdr menu))))) | ||
| 217 | ;; Use the menu in the cache. | ||
| 218 | (popup-menu-popup (cdr (symbol-value cache-symbol))))) | ||
| 219 | |||
| 220 | ;; Pop up MENU-KEYMAP which was made by make-lucid-menu-keymap. | ||
| 221 | (defun popup-menu-popup (menu-keymap) | ||
| 222 | (let ((pos (mouse-pixel-position)) | ||
| 223 | answer cmd) | ||
| 224 | (while (and menu-keymap | ||
| 225 | (setq answer (x-popup-menu (list (list (nth 1 pos) | ||
| 226 | (nthcdr 2 pos)) | ||
| 227 | (car pos)) | ||
| 228 | menu-keymap))) | ||
| 229 | (setq cmd (lookup-key menu-keymap (apply 'vector answer))) | ||
| 230 | (setq menu-keymap nil) | ||
| 231 | (and cmd | ||
| 232 | (if (keymapp cmd) | ||
| 233 | (setq menu-keymap cmd) | ||
| 234 | (call-interactively cmd)))))) | ||
| 235 | |||
| 236 | (defun popup-dialog-box (data) | 129 | (defun popup-dialog-box (data) |
| 237 | "Pop up a dialog box. | 130 | "Pop up a dialog box. |
| 238 | A dialog box description is a list. | 131 | A dialog box description is a list. |
| @@ -287,11 +180,13 @@ The syntax, more precisely: | |||
| 287 | ;; It would not make sense to duplicate them here. | 180 | ;; It would not make sense to duplicate them here. |
| 288 | (defconst default-menubar nil) | 181 | (defconst default-menubar nil) |
| 289 | 182 | ||
| 183 | ;; XEmacs compatibility | ||
| 290 | (defun set-menubar (menubar) | 184 | (defun set-menubar (menubar) |
| 291 | "Set the default menubar to be menubar." | 185 | "Set the default menubar to be menubar." |
| 292 | (setq-default current-menubar (copy-sequence menubar)) | 186 | (setq-default current-menubar (copy-sequence menubar)) |
| 293 | (set-menubar-dirty-flag)) | 187 | (set-menubar-dirty-flag)) |
| 294 | 188 | ||
| 189 | ;; XEmacs compatibility | ||
| 295 | (defun set-buffer-menubar (menubar) | 190 | (defun set-buffer-menubar (menubar) |
| 296 | "Set the buffer-local menubar to be menubar." | 191 | "Set the buffer-local menubar to be menubar." |
| 297 | (make-local-variable 'current-menubar) | 192 | (make-local-variable 'current-menubar) |
| @@ -301,6 +196,7 @@ The syntax, more precisely: | |||
| 301 | 196 | ||
| 302 | ;;; menu manipulation functions | 197 | ;;; menu manipulation functions |
| 303 | 198 | ||
| 199 | ;; XEmacs compatibility | ||
| 304 | (defun find-menu-item (menubar item-path-list &optional parent) | 200 | (defun find-menu-item (menubar item-path-list &optional parent) |
| 305 | "Searches MENUBAR for item given by ITEM-PATH-LIST. | 201 | "Searches MENUBAR for item given by ITEM-PATH-LIST. |
| 306 | Returns (ITEM . PARENT), where PARENT is the immediate parent of | 202 | Returns (ITEM . PARENT), where PARENT is the immediate parent of |
| @@ -330,6 +226,7 @@ Signals an error if the item is not found." | |||
| 330 | (cons result parent))))) | 226 | (cons result parent))))) |
| 331 | 227 | ||
| 332 | 228 | ||
| 229 | ;; XEmacs compatibility | ||
| 333 | (defun disable-menu-item (path) | 230 | (defun disable-menu-item (path) |
| 334 | "Make the named menu item be unselectable. | 231 | "Make the named menu item be unselectable. |
| 335 | PATH is a list of strings which identify the position of the menu item in | 232 | PATH is a list of strings which identify the position of the menu item in |
| @@ -349,6 +246,7 @@ menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." | |||
| 349 | item)) | 246 | item)) |
| 350 | 247 | ||
| 351 | 248 | ||
| 249 | ;; XEmacs compatibility | ||
| 352 | (defun enable-menu-item (path) | 250 | (defun enable-menu-item (path) |
| 353 | "Make the named menu item be selectable. | 251 | "Make the named menu item be selectable. |
| 354 | PATH is a list of strings which identify the position of the menu item in | 252 | PATH is a list of strings which identify the position of the menu item in |
| @@ -430,6 +328,7 @@ menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." | |||
| 430 | (set-menubar-dirty-flag) | 328 | (set-menubar-dirty-flag) |
| 431 | item)) | 329 | item)) |
| 432 | 330 | ||
| 331 | ;; XEmacs compatibility | ||
| 433 | (defun add-menu-item (menu-path item-name function enabled-p &optional before) | 332 | (defun add-menu-item (menu-path item-name function enabled-p &optional before) |
| 434 | "Add a menu item to some menu, creating the menu first if necessary. | 333 | "Add a menu item to some menu, creating the menu first if necessary. |
| 435 | If the named item exists already, it is changed. | 334 | If the named item exists already, it is changed. |
| @@ -450,6 +349,7 @@ BEFORE, if provided, is the name of a menu item before which this item should | |||
| 450 | (add-menu-item-1 t menu-path item-name function enabled-p before)) | 349 | (add-menu-item-1 t menu-path item-name function enabled-p before)) |
| 451 | 350 | ||
| 452 | 351 | ||
| 352 | ;; XEmacs compatibility | ||
| 453 | (defun delete-menu-item (path) | 353 | (defun delete-menu-item (path) |
| 454 | "Remove the named menu item from the menu hierarchy. | 354 | "Remove the named menu item from the menu hierarchy. |
| 455 | PATH is a list of strings which identify the position of the menu item in | 355 | PATH is a list of strings which identify the position of the menu item in |
| @@ -471,6 +371,7 @@ menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." | |||
| 471 | item))) | 371 | item))) |
| 472 | 372 | ||
| 473 | 373 | ||
| 374 | ;; XEmacs compatibility | ||
| 474 | (defun relabel-menu-item (path new-name) | 375 | (defun relabel-menu-item (path new-name) |
| 475 | "Change the string of the specified menu item. | 376 | "Change the string of the specified menu item. |
| 476 | PATH is a list of strings which identify the position of the menu item in | 377 | PATH is a list of strings which identify the position of the menu item in |
| @@ -494,26 +395,6 @@ NEW-NAME is the string that the menu item will be printed as from now on." | |||
| 494 | (set-menubar-dirty-flag) | 395 | (set-menubar-dirty-flag) |
| 495 | item)) | 396 | item)) |
| 496 | 397 | ||
| 497 | (defun add-menu (menu-path menu-name menu-items &optional before) | ||
| 498 | "Add a menu to the menubar or one of its submenus. | ||
| 499 | If the named menu exists already, it is changed. | ||
| 500 | MENU-PATH identifies the menu under which the new menu should be inserted. | ||
| 501 | It is a list of strings; for example, (\"File\") names the top-level \"File\" | ||
| 502 | menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\". | ||
| 503 | If MENU-PATH is nil, then the menu will be added to the menubar itself. | ||
| 504 | MENU-NAME is the string naming the menu to be added. | ||
| 505 | MENU-ITEMS is a list of menu item descriptions. | ||
| 506 | Each menu item should be a vector of three elements: | ||
| 507 | - a string, the name of the menu item; | ||
| 508 | - a symbol naming a command, or a form to evaluate; | ||
| 509 | - and a form whose value determines whether this item is selectable. | ||
| 510 | BEFORE, if provided, is the name of a menu before which this menu should | ||
| 511 | be added, if this menu is not on its parent already. If the menu is already | ||
| 512 | present, it will not be moved." | ||
| 513 | (or menu-name (error "must specify a menu name")) | ||
| 514 | (or menu-items (error "must specify some menu items")) | ||
| 515 | (add-menu-item-1 nil menu-path menu-name menu-items t before)) | ||
| 516 | |||
| 517 | 398 | ||
| 518 | 399 | ||
| 519 | (defvar put-buffer-names-in-file-menu t) | 400 | (defvar put-buffer-names-in-file-menu t) |