commit/XEmacs: sperber: Bug fix in menubar.el

1 new commit in XEmacs:

https://bitbucket.org/xemacs/xemacs/commits/580ebed3500a/
Changeset:   580ebed3500a
User:        sperber
Date:        2014-01-18 17:40:41
Summary:     Bug fix in menubar.el

2013-12-30  Byrel Mitchell <[email protected]>

	* menubar.el (add-menu-item-1, delete-menu-item): Do not assume
	every top-level menu is on current-menubar.
Affected #:  2 files

diff -r e9d0228c56716b3b9468a1ee64b35722abde5cab -r 580ebed3500a224370cc7f4a6f7ad84f5ecf7530 lisp/ChangeLog
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2013-12-30  Byrel Mitchell <[email protected]>
+
+	* menubar.el (add-menu-item-1, delete-menu-item): Do not assume
+	every top-level menu is on current-menubar.
+
 2013-12-22  Aidan Kehoe  <[email protected]>
 
 	* cl-macs.el:

diff -r e9d0228c56716b3b9468a1ee64b35722abde5cab -r 580ebed3500a224370cc7f4a6f7ad84f5ecf7530 lisp/menubar.el
--- a/lisp/menubar.el
+++ b/lisp/menubar.el
@@ -233,7 +233,7 @@
 		      )))
     (unless menubar
       (error "`current-menubar' is nil: can't add menus to it."))
-    (unless menu
+    (unless menu  ; If we don't have all intervening submenus needed by menu-path, add them.
       (let ((rest menu-path)
 	    (so-far menubar))
 	(while rest
@@ -244,7 +244,7 @@
 		  (car (find-menu-item (cdr so-far) (list (car rest))))))
 	  (unless menu
 	    (let ((rest2 so-far))
-	      (while (and (cdr rest2) (car (cdr rest2)))
+	      (while (and (cdr rest2) (car (cdr rest2))) ; Walk rest2 down so-far till rest2 is the last item before divider or end of list.
 		(setq rest2 (cdr rest2)))
 	      (setcdr rest2
 		      (nconc (list (setq menu (list (car rest))))
@@ -253,15 +253,13 @@
 	  (setq rest (cdr rest)))))
     (if (and item-found (car item-found))
 	;; hack the item in place.
-	(if menu
+	(if (or menu (not (eq (car item-found) (car menubar)))) ;If either replacing in submenu, or replacing non-initial top-level item.  
 	    ;; 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)))
+	    (nsubstitute new-item (car item-found) (or menu menubar))
+	  (setcar menubar new-item))
       ;; OK, we have to add the whole thing...
       ;; if BEFORE is specified, try to add it there.
-      (unless menu (setq menu current-menubar))
+      (unless menu (setq menu menubar))
       (when before
 	(setq before (car (find-menu-item menu (list before)))))
       (let ((rest menu)
@@ -275,8 +273,9 @@
 	(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)
+	      (let ((old-car (cons (car menubar) (cdr menubar))))
+		(setcar menubar new-item)
+		(setcdr menubar old-car))
 	    ;; otherwise, add the item to the end.
 	    (nconc menu (list new-item))))))
     (set-menubar-dirty-flag)
@@ -342,17 +341,17 @@
 menu paths.
 FROM-MENU, if provided, means use that instead of `current-menubar'
 as the menu to change."
-  (let* ((pair (condition-case nil (find-menu-item (or from-menu
-						       current-menubar) path)
+  (let* ((menubar (or from-menu current-menubar))
+	 (pair (condition-case nil (find-menu-item menubar path)
 		 (error nil)))
 	 (item (car pair))
-	 (parent (or (cdr pair) current-menubar)))
+	 (parent (or (cdr pair) menubar)))
     (if (not item)
 	nil
-      ;; the menubar is the only special case, because other menus begin
-      ;; with their name.
-      (if (eq parent current-menubar)
-	  (setq current-menubar (delete* item parent))
+      (if (eq item (car menubar)) ; Deleting first item from a top-level menubar
+	  (progn
+	    (setcar menubar (car (cdr menubar)))
+	    (setcdr menubar (cdr (cdr menubar))))
 	(delete* item parent))
       (set-menubar-dirty-flag)
       item)))

Repository URL: https://bitbucket.org/xemacs/xemacs/

--

This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.