X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fmenubar.el;h=b26065c44c2bc42e27fc432621d7904b447294bd;hp=44c5b6adc38cbe240057fc60cf3c6104ccd06159;hb=5378ab6d2bb24fd8d39025be1574d406cf91f141;hpb=82f6d62ee211b1d36e8f45fed3ee3edde82b6916

diff --git a/lisp/menubar.el b/lisp/menubar.el
index 44c5b6a..b26065c 100644
--- a/lisp/menubar.el
+++ b/lisp/menubar.el
@@ -523,35 +523,40 @@ button was clicked."
 				     (extent-property extent 'context-menu))
 				 context-extents))))
     (popup-menu
-     (cond ((and global-popup-menu mode-popup-menu)
+     (progn
 	    ;; Merge global-popup-menu and mode-popup-menu
-	    (check-menu-syntax mode-popup-menu)
-	    (let* ((title (car mode-popup-menu))
-		   (items (cdr mode-popup-menu))
+	    (and mode-popup-menu (check-menu-syntax mode-popup-menu))
+	    (let* ((mode-title (and (stringp (car mode-popup-menu))
+				    (car mode-popup-menu)))
+		   (mode-items (if mode-title (cdr mode-popup-menu)
+				 mode-popup-menu))
+		   (global-title (and (stringp (car global-popup-menu))
+				      (car global-popup-menu)))
+		   (global-items (if global-title (cdr global-popup-menu)
+				   global-popup-menu))
 		   mode-filters)
 	      ;; Strip keywords from local menu for attaching them at the top
-	      (while (and items
-			  (keywordp (car items)))
+	      (while (and mode-items
+			  (keywordp (car mode-items)))
 		;; Push both keyword and its argument.
-		(push (pop items) mode-filters)
-		(push (pop items) mode-filters))
+		(push (pop mode-items) mode-filters)
+		(push (pop mode-items) mode-filters))
 	      (setq mode-filters (nreverse mode-filters))
 	      ;; If mode-filters contains a keyword already present in
 	      ;; `global-popup-menu', you will probably lose.
-	      (append (list (car global-popup-menu))
+	      (append (cond ((not popup-menu-titles) (list ""))
+			    (mode-title (list mode-title))
+			    (global-title (list global-title))
+			    (t (list "")))
 		      mode-filters
-		      (cdr global-popup-menu)
-		      '("---" "---")
-		      (if popup-menu-titles (list title))
-		      (if popup-menu-titles '("---" "---"))
-		      items
-		      context-menu-items)))
-	   (t
-	    (append
-	     (or mode-popup-menu
-		 global-popup-menu
-		 (error "No menu defined in this buffer"))
-	     context-menu-items))))
+		      context-menu-items
+		      (and context-menu-items mode-items '("---"))
+		      mode-items
+		      (and (or context-menu-items mode-items)
+			   global-items '("---" "---"))
+		      (and global-title (list global-title))
+		      global-items
+		      ))))
 
     (while (popup-up-p)
       (dispatch-event (next-event)))
@@ -666,6 +671,10 @@ If no response was received, nil is returned.
 
 MENU-DESC and EVENT are as in the call to `popup-menu'."
   ;; partially stolen from w3
+
+  ;; This function is way gross and assumes to much about menu
+  ;; processing that is X specific. Under mswindows popup menus behave
+  ;; in reasonable ways that you can't obstruct.
   (let ((echo-keystrokes 0)
 	new-event)
     (popup-menu menu-desc event)
@@ -674,14 +683,22 @@ MENU-DESC and EVENT are as in the call to `popup-menu'."
 	(setq new-event (next-command-event new-event))
 	(cond ((misc-user-event-p new-event)
 	       (throw 'popup-done new-event))
-	      ((not (popup-up-p))
-	       (setq unread-command-events (cons new-event
-						 unread-command-events))
-	       (throw 'popup-done nil))
 	      ((button-release-event-p new-event);; don't beep twice
 	       nil)
-	      ((event-matches-key-specifier-p (quit-char))
+	      ;; It shows how bogus this function is that the event
+	      ;; arg could be missing and no-one noticed ...
+	      ((event-matches-key-specifier-p new-event (quit-char))
 	       (signal 'quit nil))
+	      ;; mswindows has no pop-down processing (selection is
+	      ;; atomic) so doing anything more makes no sense. Since
+	      ;; popup-up-p is always false under mswindows, this
+	      ;; function has been ordered to do essentially X-specifc
+	      ;; processing after this check.
+	      ((not (popup-up-p))	
+	       (setq unread-command-events (cons new-event
+						 unread-command-events))
+	       (throw 'popup-done nil))
+	      ;; mswindows never gets here
 	      (t
 	       (beep)
 	       (message "please make a choice from the menu.")))))))