diff lisp/prim/menubar.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 0293115a14e9
children 2d532a89d707
line wrap: on
line diff
--- a/lisp/prim/menubar.el	Mon Aug 13 09:00:04 2007 +0200
+++ b/lisp/prim/menubar.el	Mon Aug 13 09:02:59 2007 +0200
@@ -17,7 +17,7 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Free Software Foundation, 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
 ;;; Synched up with: Not in FSF. (Completely divergent from FSF menu-bar.el)
@@ -196,52 +196,61 @@
 	(cons result parent)))))
 
 (defun add-menu-item-1 (leaf-p menu-path new-item before)
-  (if before (setq before (downcase before)))
-  (let* ((item-name (if (vectorp new-item) (aref new-item 0) (car new-item)))
+  ;; This code looks like it could be cleaned up some more
+  ;; Do we really need 6 calls to find-menu-item?
+  (when before (setq before (downcase before)))
+  (let* ((item-name
+	  (cond ((vectorp new-item) (aref new-item 0))
+		((consp   new-item) (car  new-item))
+		(t nil)))
 	 (menubar current-menubar)
 	 (menu (condition-case ()
 		   (car (find-menu-item menubar menu-path))
 		 (error nil)))
-	 (item-found (cond ((not (listp menu))
-		      (signal 'error (list (gettext "not a submenu")
-					   menu-path)))
-		     (menu
-		      (find-menu-item (cdr menu) (list item-name)))
-		     (t
-		      (find-menu-item menubar (list item-name)))
-		     )))
-    (or menubar
-	(error "`current-menubar' is nil: can't add menus to it."))
-    (or menu
-	(let ((rest menu-path)
-	      (so-far menubar))
-	  (while rest
-;;;	    (setq menu (car (find-menu-item (cdr so-far) (list (car rest)))))
-	    (setq menu
-		  (if (eq so-far menubar)
-		      (car (find-menu-item so-far (list (car rest))))
-		    (car (find-menu-item (cdr so-far) (list (car rest))))))
-	    (or menu
-		(let ((rest2 so-far))
-		  (while (and (cdr rest2) (car (cdr rest2)))
-		    (setq rest2 (cdr rest2)))
-		  (setcdr rest2
-		  (nconc (list (setq menu (list (car rest))))
-			 (cdr rest2)))))
-	    (setq so-far menu)
-	    (setq rest (cdr rest)))))
+	 (item-found (cond
+		      ((null item-name)
+		       nil)
+		      ((not (listp menu))
+		       (signal 'error (list (gettext "not a submenu")
+					    menu-path)))
+		      (menu
+		       (find-menu-item (cdr menu) (list item-name)))
+		      (t
+		       (find-menu-item menubar (list item-name)))
+		      )))
+    (unless menubar
+      (error "`current-menubar' is nil: can't add menus to it."))
+    (unless menu
+      (let ((rest menu-path)
+	    (so-far menubar))
+	(while rest
+;;;	  (setq menu (car (find-menu-item (cdr so-far) (list (car rest)))))
+	  (setq menu
+		(if (eq so-far menubar)
+		    (car (find-menu-item so-far (list (car rest))))
+		  (car (find-menu-item (cdr so-far) (list (car rest))))))
+	  (unless menu
+	    (let ((rest2 so-far))
+	      (while (and (cdr rest2) (car (cdr rest2)))
+		(setq rest2 (cdr rest2)))
+	      (setcdr rest2
+		      (nconc (list (setq menu (list (car rest))))
+			     (cdr rest2)))))
+	  (setq so-far menu)
+	  (setq rest (cdr rest)))))
     (if (and item-found (car item-found))
 	;; hack the item in place.
 	(if menu
+	    ;; Isn't it very bad form to use nsubstitute for side effects?
 	    (nsubstitute new-item (car item-found) menu)
 	  (setq current-menubar (nsubstitute new-item
 					     (car item-found)
 					     current-menubar)))
       ;; OK, we have to add the whole thing...
       ;; if BEFORE is specified, try to add it there.
-      (or menu (setq menu current-menubar))
-      (if before
-	  (setq before (car (find-menu-item menu (list before)))))
+      (unless menu (setq menu current-menubar))
+      (when before
+	(setq before (car (find-menu-item menu (list before)))))
       (let ((rest menu)
 	    (added-before nil))
 	(while rest
@@ -250,13 +259,13 @@
 		(setcdr rest (cons new-item (cdr rest)))
 		(setq rest nil added-before t))
 	    (setq rest (cdr rest))))
-	(if (not added-before)
-	    ;; adding before the first item on the menubar itself is harder
-	    (if (and (eq menu menubar) (eq before (car menu)))
-		(setq menu (cons new-item menu)
-		      current-menubar menu)
-	      ;; otherwise, add the item to the end.
-	      (nconc menu (list new-item))))))
+	(when (not added-before)
+	  ;; adding before the first item on the menubar itself is harder
+	  (if (and (eq menu menubar) (eq before (car menu)))
+	      (setq menu (cons new-item menu)
+		    current-menubar menu)
+	    ;; otherwise, add the item to the end.
+	    (nconc menu (list new-item))))))
     (set-menubar-dirty-flag)
     new-item))