(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)))