(tmm-old-mb-map): Initialize to nil.

(tmm-delete-map): Don't use tmm-old-mb-map if nil.
(tmm-add-prompt): Bind C-n and C-p.
Put only the shortcuts into the completion buffer's map.
Produce the completion list by hand so as not to sort it.
(tmm-prompt): Start at the first item in the menu.
Don't reverse tmm-km-list; reverse compl-list instead.
Use try-completion in last-ditch attempt to find a match.
Rename compl-list to history.
(tmm-get-keybind): Put more local bindings last in a menu.
Major rewrite.
(tmm-menubar): Handle menu-bar-final-items.
(tmm-remove-shortcuts): Function deleted.
(tmm-add-shortcuts): If we can't find a letter shortcut,
use a numeric shortcut.

1 files changed, 125 insertions, 94 deletions

diff --git a/lisp/tmm.el b/lisp/tmm.el
index 17dbedc39c0..51fc76bdb4a 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -3,6 +3,7 @@
 ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
 
 ;; Author: Ilya Zakharevich <ilya@math.mps.ohio-state.edu>
+;; Maintainer: FSF
 
 ;; This file is part of GNU Emacs.
 
@@ -32,13 +33,10 @@
 ;;; tmm-menubar.
 
 (require 'electric)
-;(define-key minibuffer-local-must-match-map [pageup] 'tmm-goto-completions)
-;(define-key minibuffer-local-must-match-map [prior] 'tmm-goto-completions)
-;(define-key minibuffer-local-must-match-map "\ev" 'tmm-goto-completions)
 
 ;;; The following will be localized, added only to pacify the compiler.
 (defvar tmm-short-cuts)
-(defvar tmm-old-mb-map)
+(defvar tmm-old-mb-map nil)
 (defvar tmm-old-comp-map)
 (defvar tmm-c-prompt)
 (defvar tmm-km-list)
@@ -52,7 +50,18 @@
 See the documentation for `tmm-prompt'."
   (interactive)
   (run-hooks 'menu-bar-update-hook)
-  (tmm-prompt (tmm-get-keybind [menu-bar])))
+  ;; Obey menu-bar-final-items; put those items last.
+  (let ((menu-bar (tmm-get-keybind [menu-bar])))
+    (let ((list menu-bar-final-items))
+      (while list
+	(let ((item (car list)))
+	  ;; ITEM is the name of an item that we want to put last.
+	  ;; Find it in MENU-BAR and move it to the end.
+	  (let ((this-one (assq item menu-bar)))
+	    (setq menu-bar (append (delq this-one menu-bar)
+				   (list this-one)))))
+	(setq list (cdr list))))
+    (tmm-prompt menu-bar)))
 
 (defvar tmm-mid-prompt "==>"
   "String to insert between shortcut and menu item or nil.")
@@ -79,44 +88,44 @@ The last alternative is currently a hack, you cannot use mouse reliably.
 If the optional argument IN-POPUP is set, is argument-compatible with 
 `x-popup-menu', otherwise the argument BIND should be a cdr of sparse keymap."
   (if in-popup (if bind (setq bind in-popup) (x-popup-menu nil in-popup)))
-  (let (gl-str tmm-km-list out compl-list compl-list-l tmm-table-undef tmm-c-prompt
+  (let (gl-str tmm-km-list out history history-len tmm-table-undef tmm-c-prompt
 	       tmm-old-mb-map tmm-old-comp-map tmm-short-cuts)
     (run-hooks 'activate-menubar-hook)
     (mapcar (function (lambda (elt)
 			(if (stringp elt)
 			    (setq gl-str elt)
-			  (and (listp elt) (tmm-get-keymap elt in-popup)))
-			)) bind)
+			  (and (listp elt) (tmm-get-keymap elt in-popup)))))
+	    bind)
     (and tmm-km-list
-	 (if tmm-mid-prompt
-	     (setq tmm-km-list (reverse (tmm-add-shortcuts tmm-km-list)))
-	   t)
-	 (setq compl-list (mapcar 'car tmm-km-list))
-	 (setq compl-list-l (length compl-list))
-	 (setq compl-list (append compl-list compl-list compl-list compl-list))
-	 (setq tmm-c-prompt (nth (1- compl-list-l) compl-list))
-	 (add-hook 'minibuffer-setup-hook 'tmm-add-prompt)
-	 (unwind-protect
-	     (setq out
-		   (completing-read
-		    (concat gl-str " (up/down to change, PgUp to menu): ")
-		    tmm-km-list nil t nil
-		    (cons 'compl-list (* 2 compl-list-l))))
-	   ;;(add-hook 'minibuffer-setup-hook 'tmm-remove-shortcuts)
-	   ;;(save-excursion
-	   ;;  (set-buffer "*Completions*")
-	   ;;  (use-local-map tmm-old-mb-map))
-	   (save-excursion
-	     (set-buffer "*Completions*")
-	     (use-local-map tmm-old-comp-map)
-	     (bury-buffer (current-buffer)))
-	   ))
+	 (progn
+	   (if tmm-mid-prompt
+	       (setq tmm-km-list (tmm-add-shortcuts tmm-km-list))
+	     t)
+	   (setq history (reverse (mapcar 'car tmm-km-list)))
+	   (setq history-len (length history))
+	   (setq history (append history history history history))
+	   (setq tmm-c-prompt (nth (1- history-len) history))
+	   (add-hook 'minibuffer-setup-hook 'tmm-add-prompt)
+	   (unwind-protect
+	       (setq out
+		     (completing-read
+		      (concat gl-str " (up/down to change, PgUp to menu): ")
+		      tmm-km-list nil t nil
+		      (cons 'history (* 2 history-len))))
+	     (save-excursion
+	       (set-buffer "*Completions*")
+	       (use-local-map tmm-old-comp-map)
+	       (bury-buffer (current-buffer)))
+	     )))
     (setq bind (cdr (assoc out tmm-km-list)))
     (and (null bind)
 	 (> (length out) (length tmm-c-prompt))
 	 (string= (substring out 0 (length tmm-c-prompt)) tmm-c-prompt)
 	 (setq out (substring out (length tmm-c-prompt))
 	       bind (cdr (assoc out tmm-km-list))))
+    (and (null bind)
+	 (setq out (try-completion out tmm-km-list)
+	       bind (cdr (assoc  out tmm-km-list))))
     (setq last-command-event (car bind))
     (setq bind (cdr bind))
     (if bind
@@ -138,28 +147,34 @@ If the optional argument IN-POPUP is set, is argument-compatible with
 	       bind)))
       gl-str)))
 
-(defun tmm-remove-shortcuts ()
-  (use-local-map tmm-mb-map))
 
 (defun tmm-add-shortcuts (list)
   "Adds shortcuts to cars of elements of the list.
 Takes a list of lists with a string as car, returns list with
-shortcuts added to these cars. Adds the shortcuts to a free variable
-`tmm-short-cuts'."
-  (mapcar (lambda (elt)
-	    (let ((str (car elt)) f b)
-	      (setq f (upcase (substring str 0 1)))
-	      ;; If does not work, try beginning of the other word
-	      (if (and (member f tmm-short-cuts)
-		       (string-match " \\([^ ]\\)" str))
-		  (setq f (upcase (substring
-				   str
-				   (setq b (match-beginning 1)) (1+ b)))))
-	      (if (member f tmm-short-cuts)
-		  elt
-		(setq tmm-short-cuts (cons f tmm-short-cuts))
-		(cons (concat f tmm-mid-prompt str) (cdr elt)))))
-	  (reverse list)))
+shortcuts added to these cars.
+Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
+  (let ((next-shortcut-number 0))
+    (mapcar (lambda (elt)
+	      (let ((str (car elt)) f b)
+		(setq f (upcase (substring str 0 1)))
+		;; If does not work, try beginning of the other word
+		(if (and (member f tmm-short-cuts)
+			 (string-match " \\([^ ]\\)" str))
+		    (setq f (upcase (substring
+				     str
+				     (setq b (match-beginning 1)) (1+ b)))))
+		;; If we don't have an unique letter shortcut,
+		;; pick a digit as a shortcut instead.
+		(if (member f tmm-short-cuts)
+		    (if (< next-shortcut-number 10)
+			(setq f (format "%d" next-shortcut-number)
+			      next-shortcut-number (1+ next-shortcut-number))
+		      (setq f nil)))
+		(if (null f)
+		    elt
+		  (setq tmm-short-cuts (cons f tmm-short-cuts))
+		  (cons (concat f tmm-mid-prompt str) (cdr elt)))))
+	    (reverse list))))
 
 (defun tmm-add-prompt ()
   (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt)
@@ -170,15 +185,20 @@ shortcuts added to these cars. Adds the shortcuts to a free variable
 	      (define-key map str 'tmm-shortcut)
 	      (define-key map (downcase str) 'tmm-shortcut))
 	    tmm-short-cuts)
-    (define-key map [pageup] 'tmm-goto-completions)
-    (define-key map [prior] 'tmm-goto-completions)
-    (define-key map "\ev" 'tmm-goto-completions)
-    (define-key map "\e\e" 'abort-recursive-edit)
     (setq tmm-old-mb-map (current-local-map))
     (use-local-map (append map (cdr tmm-old-mb-map)))
+    (define-key (current-local-map) [pageup] 'tmm-goto-completions)
+    (define-key (current-local-map) [prior] 'tmm-goto-completions)
+    (define-key (current-local-map) "\ev" 'tmm-goto-completions)
+    (define-key (current-local-map) "\e\e" 'abort-recursive-edit)
+    (define-key (current-local-map) "\C-n" 'next-history-element)
+    (define-key (current-local-map) "\C-p" 'previous-history-element)
     ;; Get window and hide it for electric mode to get correct size
     (save-window-excursion 
-      (minibuffer-completion-help)
+      (let ((completions
+	     (mapcar 'car minibuffer-completion-table)))
+	(with-output-to-temp-buffer "*Completions*"
+	  (display-completion-list completions)))
       (set-buffer "*Completions*")
       (goto-char 1)
       (insert tmm-completion-prompt)
@@ -197,36 +217,37 @@ shortcuts added to these cars. Adds the shortcuts to a free variable
 
 (defun tmm-delete-map ()
   (remove-hook 'minibuffer-exit-hook 'tmm-delete-map t)
-  (use-local-map tmm-old-mb-map))
+  (if tmm-old-mb-map
+      (use-local-map tmm-old-mb-map)))
 
 (defun tmm-shortcut ()
+  "Choose the shortcut that the user typed."
   (interactive)
   (let ((c (upcase (char-to-string last-command-char))) s)
     (if (member c tmm-short-cuts)
-	  (if (equal (buffer-name) "*Completions*")
-	      (progn
-		(beginning-of-buffer)
-		(re-search-forward
-		 (concat "\\(^\\|[ \t]\\)" c tmm-mid-prompt))
-		(choose-completion))
-	    (erase-buffer)		; In minibuffer
-	    (mapcar (lambda (elt)
-		      (if (string=
-		       (substring (car elt) 0 
-				  (min (1+ (length tmm-mid-prompt))
-				       (length (car elt))))
-		       (concat c tmm-mid-prompt))
-			  (setq s (car elt))))
-		    tmm-km-list)
-	    (insert s)
-	    (exit-minibuffer)))))
+	(if (equal (buffer-name) "*Completions*")
+	    (progn
+	      (beginning-of-buffer)
+	      (re-search-forward
+	       (concat "\\(^\\|[ \t]\\)" c tmm-mid-prompt))
+	      (choose-completion))
+	  (erase-buffer)		; In minibuffer
+	  (mapcar (lambda (elt)
+		    (if (string=
+			 (substring (car elt) 0 
+				    (min (1+ (length tmm-mid-prompt))
+					 (length (car elt))))
+			 (concat c tmm-mid-prompt))
+			(setq s (car elt))))
+		  tmm-km-list)
+	  (insert s)
+	  (exit-minibuffer)))))
 
 (defun tmm-goto-completions ()
   (interactive)
   (setq tmm-c-prompt (buffer-string))
   (erase-buffer)
-  (switch-to-buffer-other-window
-   "*Completions*")
+  (switch-to-buffer-other-window "*Completions*")
   (search-forward tmm-c-prompt)
   (search-backward tmm-c-prompt))
 
@@ -234,7 +255,7 @@ shortcuts added to these cars. Adds the shortcuts to a free variable
 (defun tmm-get-keymap (elt &optional in-x-menu) 
   "Prepends (DOCSTRING EVENT BINDING) to free variable `tmm-km-list'.
 The values are deduced from the argument ELT, that should be an
-element of keymap, on `x-popup-menu' argument, or an element of
+element of keymap, an `x-popup-menu' argument, or an element of
 `x-popup-menu' argument (when IN-X-MENU is not-nil).
 Does it only if it is not already there. Uses free variable 
 `tmm-table-undef' to keep undefined keys."
@@ -287,26 +308,36 @@ Does it only if it is not already there. Uses free variable
 
 
 (defun tmm-get-keybind (keyseq)
-  "Gets binding from all the tables, can have some junk inside."
+  "Return the current binding of KEYSEQ, merging prefix definitions.
+If KEYSEQ is a prefix key that has local and gloibal bindings,
+we merge them into a single keymap which shows the proper order of the menu.
+However, for the menu bar itself, the value does not take account
+of `menu-bar-final-items'."
   (let (allbind bind)
-    (setq allbind (mapcar 'cdr (minor-mode-key-binding keyseq))) 
-    (setq allbind (append allbind (list (local-key-binding keyseq))))
-    (setq allbind (append allbind (list (global-key-binding keyseq))))
-					; list of bindings
-    (mapcar (lambda (in)
-	      (if (and (symbolp in) (keymapp in))
-		  (setq in (symbol-value in)))
-	      (and in
-		   (or (eq bind 'undefined) (not bind)
-		       (and (keymapp bind) (keymapp in)))
-		   (if (keymapp bind)
-		       (setq bind (append bind (cdr in)))
-		     (setq bind in)
-		     )
-		   )
-	      )
-	    allbind)
-    bind))
+    (setq bind (key-binding keyseq))
+    ;; If KEYSEQ is a prefix key, then BIND is either nil
+    ;; or a symbol defined as a keymap (which satisfies keymapp).
+    (if (keymapp bind)
+	(setq bind nil))
+    ;; If we have a non-keymap definition, return that.
+    (or bind
+	(progn
+	  ;; Otherwise, it is a prefix, so make a list of the subcommands.
+	  ;; Make a list of all the bindings in all the keymaps.
+	  (setq allbind (mapcar 'cdr (minor-mode-key-binding keyseq))) 
+	  (setq allbind (cons (local-key-binding keyseq) allbind))
+	  (setq allbind (cons (global-key-binding keyseq) allbind))
+	  ;; Merge all the elements of ALLBIND into one keymap.
+	  (mapcar (lambda (in)
+		    (if (and (symbolp in) (keymapp in))
+			(setq in (symbol-function in)))
+		    (and in (keymapp in)
+			 (if (keymapp bind)
+			     (setq bind (nconc bind (copy-sequence (cdr in))))
+			   (setq bind (copy-sequence in)))))
+		  allbind)
+	  ;; Return that keymap.
+	  bind))))
 
 (add-hook 'calendar-load-hook (lambda () (require 'cal-menu)))