aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1998-01-30 02:15:13 +0000
committerRichard M. Stallman1998-01-30 02:15:13 +0000
commitd566098596f2feec5725b1c0eebbfa2883a99860 (patch)
treeddfce0fb01ab44df963893ae609ff4c19e1ce6e9
parent104221a01dc59bef2cd1fcbb0d6d36f2e6a6a499 (diff)
downloademacs-d566098596f2feec5725b1c0eebbfa2883a99860.tar.gz
emacs-d566098596f2feec5725b1c0eebbfa2883a99860.zip
(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.
-rw-r--r--lisp/emacs-lisp/easymenu.el115
1 files changed, 58 insertions, 57 deletions
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index 5abda172c1e..ec8c8cd488f 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -140,15 +140,12 @@ possibly preceded by keyword pairs as described in `easy-menu-define'."
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))
@@ -158,35 +155,30 @@ possibly preceded by keyword pairs as described in `easy-menu-define'."
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\\|\
181shadow\\(Double\\)?Etched\\(In\\|Out\\)\\(Dash\\)?\\)\\)$" 179shadow\\(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
@@ -207,12 +199,11 @@ shadow\\(Double\\)?Etched\\(In\\|Out\\)\\(Dash\\)?\\)\\)$"
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.
@@ -228,19 +219,45 @@ shadow\\(Double\\)?Etched\\(In\\|Out\\)\\(Dash\\)?\\)\\)$"
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
@@ -328,38 +345,22 @@ element should be the name of a submenu directly under MENU. This
328submenu is then traversed recursively with the remaining elements of PATH. 345submenu is then traversed recursively with the remaining elements of PATH.
329ITEM is either defined as in `easy-menu-define' or a menu defined earlier 346ITEM is either defined as in `easy-menu-define' or a menu defined earlier
330by `easy-menu-define' or `easy-menu-create-menu'." 347by `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.