Mercurial > hg > xemacs-beta

comparison lisp/menubar.el @ 5645:5d3bb1100832

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Remove some utility functions from the global namespace, lisp/ lisp/ChangeLog addition: 2012-04-07 Aidan Kehoe <kehoea@parhasard.net> Remove some utility functions from the global namespace, it's more appropriate to have them as labels (that is, lexically-visible functions.) * behavior.el: * behavior.el (behavior-menu-filter-1): Moved to being a label. * behavior.el (behavior-menu-filter): Use the label. * cus-edit.el (custom-load-symbol-1): Moved to being a label. * cus-edit.el (custom-load-symbol): Use the label. * menubar.el (find-menu-item-1): Moved to being a label. * menubar.el (find-menu-item): Use the label. * window-xemacs.el: * window-xemacs.el (display-buffer-1): Moved to being a label. * window-xemacs.el (display-buffer): Use the label; use (block ...) instead of (catch ...), use prog1 instead of needlessly binding a variable.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 07 Apr 2012 21:57:31 +0100
parents 8861440b1aa4
children cc6f0266bc36
comparison
equal deleted inserted replaced
5644:0df3cedee9ac 5645:5d3bb1100832
176 "Search MENUBAR for item given by ITEM-PATH-LIST. 176 "Search MENUBAR for item given by ITEM-PATH-LIST.
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 (find-menu-item-1 menubar item-path-list)) 181 (labels
182 182 ((find-menu-item-1 (menubar item-path-list &optional parent)
183 (defun find-menu-item-1 (menubar item-path-list &optional parent) 183 (check-argument-type 'listp item-path-list)
184 (check-argument-type 'listp item-path-list) 184 (if (not (consp menubar))
185 (if (not (consp menubar)) 185 nil
186 nil 186 (let ((rest menubar)
187 (let ((rest menubar) 187 result)
188 result) 188 (when (stringp (car rest))
189 (when (stringp (car rest)) 189 (setq rest (cdr rest)))
190 (setq rest (cdr rest))) 190 (while (keywordp (car rest))
191 (while (keywordp (car rest)) 191 (setq rest (cddr rest)))
192 (setq rest (cddr rest))) 192 (while rest
193 (while rest 193 (if (and (car rest)
194 (if (and (car rest) 194 (stringp (car item-path-list))
195 (stringp (car item-path-list)) 195 (= 0 (compare-menu-text (car item-path-list)
196 (= 0 (compare-menu-text (car item-path-list) 196 (menu-item-text (car rest)))))
197 (menu-item-text (car rest))))) 197 (setq result (car rest)
198 (setq result (car rest) 198 rest nil)
199 rest nil) 199 (setq rest (cdr rest))))
200 (setq rest (cdr rest)))) 200 (if (cdr item-path-list)
201 (if (cdr item-path-list) 201 (cond ((consp result)
202 (cond ((consp result) 202 (find-menu-item-1 (cdr result) (cdr item-path-list)
203 (find-menu-item-1 (cdr result) (cdr item-path-list) result)) 203 result))
204 (result 204 (result
205 (signal 'error (list (gettext "not a submenu") result))) 205 (signal 'error (list (gettext "not a submenu") result)))
206 (t 206 (t
207 (signal 'error (list (gettext "no such submenu") 207 (signal 'error (list (gettext "no such submenu")
208 (car item-path-list))))) 208 (car item-path-list)))))
209 (cons result parent))))) 209 (cons result parent))))))
210 (find-menu-item-1 menubar item-path-list)))
210 211
211 (defun add-menu-item-1 (leaf-p menu-path new-item before in-menu) 212 (defun add-menu-item-1 (leaf-p menu-path new-item before in-menu)
212 ;; This code looks like it could be cleaned up some more 213 ;; This code looks like it could be cleaned up some more
213 ;; Do we really need 6 calls to find-menu-item? 214 ;; Do we really need 6 calls to find-menu-item?
214 (let* ((item-name 215 (let* ((item-name