# HG changeset patch # User Richard M. Stallman # Date 841607268 0 # Node ID 74fc923ff6d53bb4f3f483d556894c8f509cbc08 # Parent 855c8d8ba0f02a62d910bc4b87dbc5f476af1761 (tmm-add-one-shortcut): New subroutine. (tmm-add-shortcuts): Code moved to tmm-add-one-shortcut. Handle tmm-shortcut-style and tmm-shortcut-words. (tmm-define-keys): Use suppress-keymap. Moved use-local-map from the caller here. tmm-short-cuts is now a list of chars, not of one-char strings. (tmm-completion-delete-prompt): New function, used in completion-setup-hook. (tmm-shortcut-style): New variable. (tmm-shortcut-words): New variable. (tmm-shortcut): Handle tmm-shortcut-style. The shortcut searched in tmm-short-cuts is now a char, not a string. diff -r 855c8d8ba0f0 -r 74fc923ff6d5 lisp/tmm.el --- a/lisp/tmm.el Sun Sep 01 19:15:05 1996 +0000 +++ b/lisp/tmm.el Sun Sep 01 19:47:48 1996 +0000 @@ -42,6 +42,7 @@ (defvar tmm-old-comp-map) (defvar tmm-c-prompt) (defvar tmm-km-list) +(defvar tmm-next-shortcut-digit) (defvar tmm-table-undef) ;;;###autoload (define-key global-map "\M-`" 'tmm-menubar) @@ -94,7 +95,9 @@ (tmm-menubar (car (posn-x-y (event-start event))))) (defvar tmm-mid-prompt "==>" - "String to insert between shortcut and menu item or nil.") + "*String to insert between shortcut and menu item. +If nil, there will be no shortcuts. It should not consist only of spaces, +or else the correct item might not be found in the `*Completions*' buffer.") (defvar tmm-mb-map nil "A place to store minibuffer map.") @@ -105,9 +108,19 @@ the item in the minibuffer, and press RET when you are done, or press the marked letters to pick up your choice. Type C-g or ESC ESC ESC to cancel. " - "String to insert at top of completion buffer. -If this is nil, delete even the usual help text -and show just the alternatives.") + "*Help text to insert on the top of the completion buffer. +To save space, you can set this to nil, +in which case the standard introduction text is deleted too.") + +(defvar tmm-shortcut-style '(downcase upcase) + "*What letters to use as menu shortcuts. +Must be either one of the symbols `downcase' or `upcase', +or else a list of the two in the order you prefer.") + +(defvar tmm-shortcut-words 2 + "*How many successive words to try for shortcuts, nil means all. +If you use only one of `downcase' or `upcase' for `tmm-shortcut-style', +specify nil for this variable.") ;;;###autoload (defun tmm-prompt (menu &optional in-popup default-item) @@ -221,77 +234,106 @@ (call-interactively choice)) choice))))) - (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. 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)))) + (let ((tmm-next-shortcut-digit ?0)) + (mapcar 'tmm-add-one-shortcut (reverse list)))) +(defsubst tmm-add-one-shortcut (elt) +;; uses the free vars tmm-next-shortcut-digit and tmm-short-cuts + (let* ((str (car elt)) + (paren (string-match "(" str)) + (pos 0) (word 0) char) + (catch 'done ; ??? is this slow? + (while (and (or (not tmm-shortcut-words) ; no limit on words + (< word tmm-shortcut-words)) ; try n words + (setq pos (string-match "\\w+" str pos)) ; get next word + (not (and paren (> pos paren)))) ; don't go past "(binding.." + (if (or (= pos 0) + (/= (aref str (1- pos)) ?.)) ; avoid file extensions + (let ((shortcut-style + (if (listp tmm-shortcut-style) ; convert to list + tmm-shortcut-style + (list tmm-shortcut-style)))) + (while shortcut-style ; try upcase and downcase variants + (setq char (funcall (car shortcut-style) (aref str pos))) + (if (not (memq char tmm-short-cuts)) (throw 'done char)) + (setq shortcut-style (cdr shortcut-style))))) + (setq word (1+ word)) + (setq pos (match-end 0))) + (while (<= tmm-next-shortcut-digit ?9) ; no letter shortcut, pick a digit + (setq char tmm-next-shortcut-digit) + (setq tmm-next-shortcut-digit (1+ tmm-next-shortcut-digit)) + (if (not (memq char tmm-short-cuts)) (throw 'done char))) + (setq char nil)) + (if char (setq tmm-short-cuts (cons char tmm-short-cuts))) + (cons (concat (if char (concat (char-to-string char) tmm-mid-prompt) + ;; keep them lined up in columns + (make-string (1+ (length tmm-mid-prompt)) ?\ )) + str) + (cdr elt)))) + +;; This returns the old map. (defun tmm-define-keys (minibuffer) - (mapcar (lambda (str) - (define-key (current-local-map) str 'tmm-shortcut) - (define-key (current-local-map) (downcase str) 'tmm-shortcut)) - tmm-short-cuts) - (if minibuffer - (progn - (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) "\C-n" 'next-history-element) - (define-key (current-local-map) "\C-p" 'previous-history-element)))) + (let ((map (make-sparse-keymap))) + (suppress-keymap map t) + (mapcar + (function + (lambda (c) + (if (listp tmm-shortcut-style) + (define-key map (char-to-string c) 'tmm-shortcut) + ;; only one kind of letters are shortcuts, so map both upcase and + ;; downcase input to the same + (define-key map (char-to-string (downcase c)) 'tmm-shortcut) + (define-key map (char-to-string (upcase c)) 'tmm-shortcut)))) + tmm-short-cuts) + (if minibuffer + (progn + (define-key map [pageup] 'tmm-goto-completions) + (define-key map [prior] 'tmm-goto-completions) + (define-key map "\ev" 'tmm-goto-completions) + (define-key map "\C-n" 'next-history-element) + (define-key map "\C-p" 'previous-history-element))) + (prog1 (current-local-map) + (use-local-map (append map (current-local-map)))))) + +(defun tmm-completion-delete-prompt () + (set-buffer standard-output) + (goto-char 1) + (delete-region 1 (search-forward "Possible completions are:\n"))) (defun tmm-add-prompt () (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt) (make-local-hook 'minibuffer-exit-hook) (add-hook 'minibuffer-exit-hook 'tmm-delete-map nil t) (let ((win (selected-window))) - (setq tmm-old-mb-map (current-local-map)) - (use-local-map (append (make-sparse-keymap) tmm-old-mb-map)) - (tmm-define-keys t) + (setq tmm-old-mb-map (tmm-define-keys t)) ;; Get window and hide it for electric mode to get correct size (save-window-excursion (let ((completions (mapcar 'car minibuffer-completion-table))) + (or tmm-completion-prompt + (add-hook 'completion-setup-hook + 'tmm-completion-delete-prompt 'append)) (with-output-to-temp-buffer "*Completions*" - (display-completion-list completions))) + (display-completion-list completions)) + (remove-hook 'completion-setup-hook 'tmm-completion-delete-prompt)) + (if tmm-completion-prompt + (progn (set-buffer "*Completions*") (goto-char 1) - (if tmm-completion-prompt - (insert tmm-completion-prompt) - ;; Delete even the usual help info that all completion buffers have. - (goto-char 1) - (delete-region 1 (search-forward "Possible completions are:\n"))) + (insert tmm-completion-prompt))) ) (save-excursion (other-window 1) ; Electric-pop-up-window does ; not work in minibuffer (set-buffer (window-buffer (Electric-pop-up-window "*Completions*"))) - (setq tmm-old-comp-map (current-local-map)) - (use-local-map (append (make-sparse-keymap) tmm-old-comp-map)) - (tmm-define-keys nil) + + (setq tmm-old-comp-map (tmm-define-keys nil)) + (select-window win) ; Cannot use ; save-window-excursion, since ; it restores the size @@ -306,13 +348,15 @@ (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) + (let ((c last-command-char) s) + (if (symbolp tmm-shortcut-style) + (setq c (funcall tmm-shortcut-style c))) + (if (memq c tmm-short-cuts) (if (equal (buffer-name) "*Completions*") (progn (beginning-of-buffer) (re-search-forward - (concat "\\(^\\|[ \t]\\)" c tmm-mid-prompt)) + (concat "\\(^\\|[ \t]\\)" (char-to-string c) tmm-mid-prompt)) (choose-completion)) (erase-buffer) ; In minibuffer (mapcar (lambda (elt) @@ -320,7 +364,7 @@ (substring (car elt) 0 (min (1+ (length tmm-mid-prompt)) (length (car elt)))) - (concat c tmm-mid-prompt)) + (concat (char-to-string c) tmm-mid-prompt)) (setq s (car elt)))) tmm-km-list) (insert s) @@ -334,7 +378,6 @@ (search-forward tmm-c-prompt) (search-backward tmm-c-prompt)) - (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 @@ -389,7 +432,6 @@ (cons (cons str (cons event km)) tmm-km-list))) )))) - (defun tmm-get-keybind (keyseq) "Return the current binding of KEYSEQ, merging prefix definitions. If KEYSEQ is a prefix key that has local and global bindings,