Mercurial > hg > xemacs-beta

comparison lisp/menubar.el @ 225:12579d965149 r20-4b11

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b11
author cvs
date Mon, 13 Aug 2007 10:11:40 +0200
parents 41ff10fd062f
children 0e522484dd2a
comparison
equal deleted inserted replaced
224:4663b37daab6 225:12579d965149
176 "Search MENUBAR for item given by ITEM-PATH-LIST starting from PARENT. 176 "Search MENUBAR for item given by ITEM-PATH-LIST starting from PARENT.
177 Returns (ITEM . PARENT), where PARENT is the immediate parent of 177 Returns (ITEM . PARENT), where PARENT is the immediate parent of
178 the item found. 178 the item found.
179 If the item does not exist, the car of the returned value is nil. 179 If the item does not exist, the car of the returned value is nil.
180 If some menu in the ITEM-PATH-LIST does not exist, an error is signalled." 180 If some menu in the ITEM-PATH-LIST does not exist, an error is signalled."
181 (or (listp item-path-list) 181 (check-argument-type 'listp item-path-list)
182 (signal 'wrong-type-argument (list 'listp item-path-list))) 182 (unless parent
183 (or parent (setq item-path-list (mapcar 'normalize-menu-item-name item-path-list))) 183 (setq item-path-list (mapcar 'normalize-menu-item-name item-path-list)))
184 (if (not (consp menubar)) 184 (if (not (consp menubar))
185 nil 185 nil
186 (let ((rest menubar) 186 (let ((rest menubar)
187 result) 187 result)
188 (if (stringp (car rest)) 188 (when (stringp (car rest))
189 (setq rest (cdr rest))) 189 (setq rest (cdr rest)))
190 (while (keywordp (car rest)) 190 (while (keywordp (car rest))
191 (setq rest (cddr rest))) 191 (setq rest (cddr rest)))
192 (while rest 192 (while rest
193 (if (and (car rest) 193 (if (and (car rest)
194 (equal (car item-path-list) 194 (equal (car item-path-list)
195 (normalize-menu-item-name (if (vectorp (car rest)) 195 (normalize-menu-item-name
196 (aref (car rest) 0) 196 (cond ((vectorp (car rest))
197 (if (stringp (car rest)) 197 (aref (car rest) 0))
198 (car rest) 198 ((stringp (car rest))
199 (car (car rest))))))) 199 (car rest))
200 (setq result (car rest) rest nil) 200 (t
201 (caar rest))))))
202 (setq result (car rest)
203 rest nil)
201 (setq rest (cdr rest)))) 204 (setq rest (cdr rest))))
202 (if (cdr item-path-list) 205 (if (cdr item-path-list)
203 (if (consp result) 206 (cond ((consp result)
204 (find-menu-item (cdr result) (cdr item-path-list) result) 207 (find-menu-item (cdr result) (cdr item-path-list) result))
205 (if result 208 (result
206 (signal 'error (list (gettext "not a submenu") result)) 209 (signal 'error (list (gettext "not a submenu") result)))
207 (signal 'error (list (gettext "no such submenu") (car item-path-list))))) 210 (t
211 (signal 'error (list (gettext "no such submenu")
212 (car item-path-list)))))
208 (cons result parent))))) 213 (cons result parent)))))
209 214
210 (defun add-menu-item-1 (leaf-p menu-path new-item before) 215 (defun add-menu-item-1 (leaf-p menu-path new-item before)
211 ;; This code looks like it could be cleaned up some more 216 ;; This code looks like it could be cleaned up some more
212 ;; Do we really need 6 calls to find-menu-item? 217 ;; Do we really need 6 calls to find-menu-item?