Mercurial > emacs

comparison lisp/emacs-lisp/easymenu.el @ 20801:8aeddd528f57

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(easy-menu-add-item); The BEFORE argument works now. Done by letting `easy-menu-do-add-item' handle it. (easy-menu-do-add-item): Take argument BEFORE instead of PREV. Inserts directly in keymap, instead of calling `define-key-after'. (easy-menu-create-menu): Don't reverse items as `easy-menu-do-add-item' now puts things at the end of keymaps.
author Richard M. Stallman <rms@gnu.org>
date Fri, 30 Jan 1998 02:15:13 +0000
parents 0c51c56d0a4f
children 517de9005275
comparison
equal deleted inserted replaced
20800:43c77517a76c 20801:8aeddd528f57
138 (while (and menu-items (cdr menu-items) 138 (while (and menu-items (cdr menu-items)
139 (symbolp (setq keyword (car menu-items))) 139 (symbolp (setq keyword (car menu-items)))
140 (= ?: (aref (symbol-name keyword) 0))) 140 (= ?: (aref (symbol-name keyword) 0)))
141 (if (eq keyword ':filter) (setq filter (cadr menu-items))) 141 (if (eq keyword ':filter) (setq filter (cadr menu-items)))
142 (setq menu-items (cddr menu-items))) 142 (setq menu-items (cddr menu-items)))
143 ;; Process items in reverse order,
144 ;; since the define-key loop reverses them again.
145 (setq menu-items (reverse menu-items))
146 (while menu-items 143 (while menu-items
147 (setq have-buttons 144 (setq have-buttons
148 (easy-menu-do-add-item menu (car menu-items) have-buttons)) 145 (easy-menu-do-add-item menu (car menu-items) have-buttons))
149 (setq menu-items (cdr menu-items))) 146 (setq menu-items (cdr menu-items)))
150 (when filter 147 (when filter
151 (setq menu (easy-menu-make-symbol menu nil)) 148 (setq menu (easy-menu-make-symbol menu))
152 (put menu 'menu-enable 149 (put menu 'menu-enable
153 `(easy-menu-filter (quote ,menu) (quote ,filter)))) 150 `(easy-menu-filter (quote ,menu) (quote ,filter))))
154 menu)) 151 menu))
155 152
156 153
157 ;; Button prefixes. 154 ;; Button prefixes.
158 (defvar easy-menu-button-prefix 155 (defvar easy-menu-button-prefix
159 '((radio ?* . "( ) ") (toggle ?X . "[ ] "))) 156 '((radio ?* . "( ) ") (toggle ?X . "[ ] ")))
160 157
161 (defun easy-menu-do-add-item (menu item have-buttons &optional prev top) 158 (defun easy-menu-do-add-item (menu item have-buttons &optional before top)
162 ;; Parse an item description and add the item to a keymap. This is 159 ;; Parse an item description and add the item to a keymap. This is
163 ;; the function that is used for item definition by the other easy-menu 160 ;; the function that is used for item definition by the other easy-menu
164 ;; functions. 161 ;; functions.
165 ;; MENU is a sparse keymap. 162 ;; MENU is a sparse keymap i.e. a list starting with the symbol `keymap'.
166 ;; ITEM defines an item as in `easy-menu-define'. 163 ;; ITEM defines an item as in `easy-menu-define'.
167 ;; HAVE-BUTTONS is a string or nil. If not nil, use as item prefix for 164 ;; HAVE-BUTTONS is a string or nil. If not nil, use as item prefix for
168 ;; items that are not toggle or radio buttons to compensate for the 165 ;; items that are not toggle or radio buttons to compensate for the
169 ;; button prefix. 166 ;; button prefix.
170 ;; PREV is nil or a tail in MENU. If PREV is not nil put item after 167 ;; Optional argument BEFORE is nil or a symbol used as a key in MENU. If
171 ;; PREV in MENU, otherwise put it first in MENU. 168 ;; BEFORE is not nil put item before BEFORE in MENU, otherwise if item is
172 ;; If TOP is true, this is an item in the menu bar itself so 169 ;; already present in MENU, just change it, otherwise put it last in MENU.
170 ;; If optional TOP is true, this is an item in the menu bar itself so
173 ;; don't use prefix. In this case HAVE-BUTTONS will be nil. 171 ;; don't use prefix. In this case HAVE-BUTTONS will be nil.
174 (let (command name item-string is-button) 172 (let (command name item-string is-button done inserted)
175 (cond 173 (cond
176 ((stringp item) 174 ((stringp item)
177 (setq item 175 (setq item-string
178 (if (string-match ; If an XEmacs separator 176 (if (string-match ; If an XEmacs separator
179 "^\\(-+\\|\ 177 "^\\(-+\\|\
180 --:\\(\\(no\\|\\(sing\\|doub\\)le\\(Dashed\\)?\\)Line\\|\ 178 --:\\(\\(no\\|\\(sing\\|doub\\)le\\(Dashed\\)?\\)Line\\|\
181 shadow\\(Double\\)?Etched\\(In\\|Out\\)\\(Dash\\)?\\)\\)$" 179 shadow\\(Double\\)?Etched\\(In\\|Out\\)\\(Dash\\)?\\)\\)$"
182 item) "" ; use a single line separator. 180 item) "" ; use a single line separator.
183 (concat have-buttons item))) 181 (concat have-buttons item))))
184 ;; Handle inactive strings specially,
185 ;; allow any number of identical ones.
186 (cond
187 (prev (setq menu prev))
188 ((and (consp (cdr menu)) (stringp (cadr menu))) (setq menu (cdr menu))))
189 (setcdr menu (cons (list nil item) (cdr menu))))
190 ((consp item) 182 ((consp item)
191 (setq name (setq item-string (car item))) 183 (setq name (setq item-string (car item)))
192 (setq command (if (keymapp (setq item (cdr item))) item 184 (setq command (if (keymapp (setq item (cdr item))) item
193 (easy-menu-create-menu name item)))) 185 (easy-menu-create-menu name item))))
194 ((vectorp item) 186 ((vectorp item)
205 (setq arg (aref item (1+ count))) 197 (setq arg (aref item (1+ count)))
206 (setq count (+ 2 count)) 198 (setq count (+ 2 count))
207 (cond 199 (cond
208 ((eq keyword ':keys) (setq keys arg)) 200 ((eq keyword ':keys) (setq keys arg))
209 ((eq keyword ':active) (setq active arg)) 201 ((eq keyword ':active) (setq active arg))
210 ((eq keyword ':suffix) (setq suffix arg)) 202 ((eq keyword ':suffix) (setq suffix (concat " " arg)))
211 ((eq keyword ':style) (setq style arg)) 203 ((eq keyword ':style) (setq style arg))
212 ((eq keyword ':selected) (setq selected arg)))) 204 ((eq keyword ':selected) (setq selected arg))))
205 (if keys (setq suffix (concat suffix " (" keys ")")))
213 (if suffix (setq item-string (concat item-string " " suffix))) 206 (if suffix (setq item-string (concat item-string " " suffix)))
214 (if keys
215 (setq item-string (concat item-string " (" keys ")")))
216 (when (and selected 207 (when (and selected
217 (setq style (assq style easy-menu-button-prefix))) 208 (setq style (assq style easy-menu-button-prefix)))
218 ;; Simulate checkboxes and radio buttons. 209 ;; Simulate checkboxes and radio buttons.
219 (setq item-string (concat (cddr style) item-string)) 210 (setq item-string (concat (cddr style) item-string))
220 (put command 'menu-enable 211 (put command 'menu-enable
226 (setq active nil) ; Already taken care of active. 217 (setq active nil) ; Already taken care of active.
227 (when (not (or have-buttons top)) 218 (when (not (or have-buttons top))
228 (setq have-buttons " ") 219 (setq have-buttons " ")
229 ;; Add prefix to menu items defined so far. 220 ;; Add prefix to menu items defined so far.
230 (easy-menu-change-prefix menu t))))) 221 (easy-menu-change-prefix menu t)))))
231 (if active (put command 'menu-enable active))))) 222 (if active (put command 'menu-enable active))))
223 (t "Illegal menu item in easy menu."))
232 (when name 224 (when name
233 (and (not is-button) have-buttons 225 (and (not is-button) have-buttons
234 (setq item-string (concat have-buttons item-string))) 226 (setq item-string (concat have-buttons item-string)))
235 (setq item (cons item-string command)) 227 (setq name (intern name)))
236 (setq name (vector (intern name))) 228 (setq item (cons item-string command))
237 (if prev (define-key-after menu name item (vector (caar prev))) 229 (if before (setq before (intern before)))
238 (define-key menu name item))) 230 ;; The following loop is simlar to `define-key-after'. It
231 ;; inserts (name . item) in keymap menu.
232 ;; If name is not nil then delete any duplications.
233 ;; If before is not nil, insert before before. Otherwise
234 ;; if name is not nil and it is found in menu, insert there, else
235 ;; insert at end.
236 (while (not done)
237 (cond
238 ((or (setq done (or (null (cdr menu)) (keymapp (cdr menu))))
239 (and before (eq (car-safe (cadr menu)) before)))
240 ;; If name is nil, stop here, otherwise keep going past the
241 ;; inserted element so we can delete any duplications that come
242 ;; later.
243 (if (null name) (setq done t))
244 (unless inserted ; Don't insert more than once.
245 (setcdr menu (cons (cons name item) (cdr menu)))
246 (setq inserted t)
247 (setq menu (cdr menu))))
248 ((and name (eq (car-safe (cadr menu)) name))
249 (if (and before ; Wanted elsewere and
250 (not (setq done ; not the last in this keymap.
251 (or (null (cddr menu)) (keymapp (cddr menu))))))
252 (setcdr menu (cddr menu))
253 (setcdr (cadr menu) item) ; Change item.
254 (setq inserted t))))
255 (setq menu (cdr menu)))
239 have-buttons)) 256 have-buttons))
240 257
241 (defvar easy-menu-item-count 0) 258 (defvar easy-menu-item-count 0)
242 259
243 (defun easy-menu-make-symbol (callback call) 260 (defun easy-menu-make-symbol (callback &optional call)
244 ;; Return a unique symbol with CALLBACK as function value. 261 ;; Return a unique symbol with CALLBACK as function value.
245 ;; If CALL is false then this is a keymap, not a function. 262 ;; If CALL is false then this is a keymap, not a function.
246 ;; Else if CALLBACK is a symbol, avoid the indirection when looking for 263 ;; Else if CALLBACK is a symbol, avoid the indirection when looking for
247 ;; key-bindings in menu. 264 ;; key-bindings in menu.
248 ;; Else make a lambda expression of CALLBACK. 265 ;; Else make a lambda expression of CALLBACK.
326 added. If PATH is nil, MENU itself is used. Otherwise, the first 343 added. If PATH is nil, MENU itself is used. Otherwise, the first
327 element should be the name of a submenu directly under MENU. This 344 element should be the name of a submenu directly under MENU. This
328 submenu is then traversed recursively with the remaining elements of PATH. 345 submenu is then traversed recursively with the remaining elements of PATH.
329 ITEM is either defined as in `easy-menu-define' or a menu defined earlier 346 ITEM is either defined as in `easy-menu-define' or a menu defined earlier
330 by `easy-menu-define' or `easy-menu-create-menu'." 347 by `easy-menu-define' or `easy-menu-create-menu'."
331 (let ((top (not (or menu path))) 348 (let ((top (not (or menu path))))
332 tmp prev next)
333 (setq menu (easy-menu-get-map menu path)) 349 (setq menu (easy-menu-get-map menu path))
334 (or (lookup-key menu (vector (intern (elt item 0)))) 350 (if (or (keymapp item)
335 (and menu (keymapp (cdr menu))) 351 (and (symbolp item) (keymapp (symbol-value item))))
336 (setq tmp (cdr menu))) 352 ;; Item is a keymap, find the prompt string and use as item name.
337 (while (and tmp (not (keymapp tmp)) 353 (let ((tail (easy-menu-get-map item nil)) name)
338 (not (and (consp (car tmp)) (symbolp (caar tmp))))) 354 (if (not (keymapp item)) (setq item tail))
339 (setq tmp (cdr tmp))) 355 (while (and (null name) (consp (setq tail (cdr tail)))
340 (and before (setq before (intern before))) 356 (not (keymapp tail)))
341 (if (or (null tmp) (keymapp tmp) (eq (setq prev (caar tmp)) before)) 357 (if (stringp (car tail)) (setq name (car tail)) ; Got a name.
342 (setq prev nil) 358 (setq tail (cdr tail))))
343 (while (and tmp (not (keymapp tmp)) 359 (setq item (cons name item))))
344 (not (and (consp (car tmp))
345 (eq (caar (setq next tmp)) before))))
346 (if next (setq prev next))
347 (setq next nil)
348 (setq tmp (cdr tmp))))
349 (when (or (keymapp item)
350 (and (symbolp item) (keymapp (symbol-value item))))
351 ;; Item is a keymap, find the prompt string and use as item name.
352 (setq next (easy-menu-get-map item nil))
353 (if (not (keymapp item)) (setq item next))
354 (setq tmp nil) ; No item name yet.
355 (while (and (null tmp) (consp (setq next (cdr next)))
356 (not (keymapp next)))
357 (if (stringp (car next)) (setq tmp (car next)) ; Got a name.
358 (setq next (cdr next))))
359 (setq item (cons tmp item)))
360 (easy-menu-do-add-item menu item 360 (easy-menu-do-add-item menu item
361 (and (not top) (easy-menu-have-button menu) " ") 361 (and (not top) (easy-menu-have-button menu)
362 prev top))) 362 " ")
363 before top)))
363 364
364 (defun easy-menu-item-present-p (menu path name) 365 (defun easy-menu-item-present-p (menu path name)
365 "In submenu of MENU with path PATH, return true iff item NAME is present. 366 "In submenu of MENU with path PATH, return true iff item NAME is present.
366 MENU and PATH are defined as in `easy-menu-add-item'. 367 MENU and PATH are defined as in `easy-menu-add-item'.
367 NAME should be a string, the name of the element to be looked for." 368 NAME should be a string, the name of the element to be looked for."