# HG changeset patch # User Richard M. Stallman # Date 815070829 0 # Node ID c55f17d3931fc19082ecfb0c67c6b1ec0f53f7ca # Parent 87b725d9d2ae49a63070e0daf990b3c067aaea77 (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. diff -r 87b725d9d2ae -r c55f17d3931f lisp/tmm.el --- a/lisp/tmm.el Mon Oct 30 08:31:08 1995 +0000 +++ b/lisp/tmm.el Mon Oct 30 16:33:49 1995 +0000 @@ -3,6 +3,7 @@ ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Ilya Zakharevich +;; 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 @@ 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 @@ 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 @@ (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 @@ (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 @@ (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 @@ (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)))