Commit 670ce6ea authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

(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.
parent 6ec8bbd2
...@@ -42,6 +42,7 @@ ...@@ -42,6 +42,7 @@
(defvar tmm-old-comp-map) (defvar tmm-old-comp-map)
(defvar tmm-c-prompt) (defvar tmm-c-prompt)
(defvar tmm-km-list) (defvar tmm-km-list)
(defvar tmm-next-shortcut-digit)
(defvar tmm-table-undef) (defvar tmm-table-undef)
;;;###autoload (define-key global-map "\M-`" 'tmm-menubar) ;;;###autoload (define-key global-map "\M-`" 'tmm-menubar)
...@@ -94,7 +95,9 @@ See the documentation for `tmm-prompt'." ...@@ -94,7 +95,9 @@ See the documentation for `tmm-prompt'."
(tmm-menubar (car (posn-x-y (event-start event))))) (tmm-menubar (car (posn-x-y (event-start event)))))
(defvar tmm-mid-prompt "==>" (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 (defvar tmm-mb-map nil
"A place to store minibuffer map.") "A place to store minibuffer map.")
...@@ -105,9 +108,19 @@ Alternatively, you can use Up/Down keys (or your History keys) to change ...@@ -105,9 +108,19 @@ Alternatively, you can use Up/Down keys (or your History keys) to change
the item in the minibuffer, and press RET when you are done, or press the 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. marked letters to pick up your choice. Type C-g or ESC ESC ESC to cancel.
" "
"String to insert at top of completion buffer. "*Help text to insert on the top of the completion buffer.
If this is nil, delete even the usual help text To save space, you can set this to nil,
and show just the alternatives.") 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 ;;;###autoload
(defun tmm-prompt (menu &optional in-popup default-item) (defun tmm-prompt (menu &optional in-popup default-item)
...@@ -221,77 +234,106 @@ Its value should be an event that has a binding in MENU." ...@@ -221,77 +234,106 @@ Its value should be an event that has a binding in MENU."
(call-interactively choice)) (call-interactively choice))
choice))))) choice)))))
(defun tmm-add-shortcuts (list) (defun tmm-add-shortcuts (list)
"Adds shortcuts to cars of elements of the list. "Adds shortcuts to cars of elements of the list.
Takes a list of lists with a string as car, returns list with Takes a list of lists with a string as car, returns list with
shortcuts added to these cars. shortcuts added to these cars.
Stores a list of all the shortcuts in the free variable `tmm-short-cuts'." Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
(let ((next-shortcut-number 0)) (let ((tmm-next-shortcut-digit ?0))
(mapcar (lambda (elt) (mapcar 'tmm-add-one-shortcut (reverse list))))
(let ((str (car elt)) f b)
(setq f (upcase (substring str 0 1))) (defsubst tmm-add-one-shortcut (elt)
;; If does not work, try beginning of the other word ;; uses the free vars tmm-next-shortcut-digit and tmm-short-cuts
(if (and (member f tmm-short-cuts) (let* ((str (car elt))
(string-match " \\([^ ]\\)" str)) (paren (string-match "(" str))
(setq f (upcase (substring (pos 0) (word 0) char)
str (catch 'done ; ??? is this slow?
(setq b (match-beginning 1)) (1+ b))))) (while (and (or (not tmm-shortcut-words) ; no limit on words
;; If we don't have an unique letter shortcut, (< word tmm-shortcut-words)) ; try n words
;; pick a digit as a shortcut instead. (setq pos (string-match "\\w+" str pos)) ; get next word
(if (member f tmm-short-cuts) (not (and paren (> pos paren)))) ; don't go past "(binding.."
(if (< next-shortcut-number 10) (if (or (= pos 0)
(setq f (format "%d" next-shortcut-number) (/= (aref str (1- pos)) ?.)) ; avoid file extensions
next-shortcut-number (1+ next-shortcut-number)) (let ((shortcut-style
(setq f nil))) (if (listp tmm-shortcut-style) ; convert to list
(if (null f) tmm-shortcut-style
elt (list tmm-shortcut-style))))
(setq tmm-short-cuts (cons f tmm-short-cuts)) (while shortcut-style ; try upcase and downcase variants
(cons (concat f tmm-mid-prompt str) (cdr elt))))) (setq char (funcall (car shortcut-style) (aref str pos)))
(reverse list)))) (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) (defun tmm-define-keys (minibuffer)
(mapcar (lambda (str) (let ((map (make-sparse-keymap)))
(define-key (current-local-map) str 'tmm-shortcut) (suppress-keymap map t)
(define-key (current-local-map) (downcase str) 'tmm-shortcut)) (mapcar
tmm-short-cuts) (function
(if minibuffer (lambda (c)
(progn (if (listp tmm-shortcut-style)
(define-key (current-local-map) [pageup] 'tmm-goto-completions) (define-key map (char-to-string c) 'tmm-shortcut)
(define-key (current-local-map) [prior] 'tmm-goto-completions) ;; only one kind of letters are shortcuts, so map both upcase and
(define-key (current-local-map) "\ev" 'tmm-goto-completions) ;; downcase input to the same
(define-key (current-local-map) "\C-n" 'next-history-element) (define-key map (char-to-string (downcase c)) 'tmm-shortcut)
(define-key (current-local-map) "\C-p" 'previous-history-element)))) (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 () (defun tmm-add-prompt ()
(remove-hook 'minibuffer-setup-hook 'tmm-add-prompt) (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt)
(make-local-hook 'minibuffer-exit-hook) (make-local-hook 'minibuffer-exit-hook)
(add-hook 'minibuffer-exit-hook 'tmm-delete-map nil t) (add-hook 'minibuffer-exit-hook 'tmm-delete-map nil t)
(let ((win (selected-window))) (let ((win (selected-window)))
(setq tmm-old-mb-map (current-local-map)) (setq tmm-old-mb-map (tmm-define-keys t))
(use-local-map (append (make-sparse-keymap) tmm-old-mb-map))
(tmm-define-keys t)
;; Get window and hide it for electric mode to get correct size ;; Get window and hide it for electric mode to get correct size
(save-window-excursion (save-window-excursion
(let ((completions (let ((completions
(mapcar 'car minibuffer-completion-table))) (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*" (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*") (set-buffer "*Completions*")
(goto-char 1) (goto-char 1)
(if tmm-completion-prompt (insert 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")))
) )
(save-excursion (save-excursion
(other-window 1) ; Electric-pop-up-window does (other-window 1) ; Electric-pop-up-window does
; not work in minibuffer ; not work in minibuffer
(set-buffer (window-buffer (Electric-pop-up-window "*Completions*"))) (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)) (setq tmm-old-comp-map (tmm-define-keys nil))
(tmm-define-keys nil)
(select-window win) ; Cannot use (select-window win) ; Cannot use
; save-window-excursion, since ; save-window-excursion, since
; it restores the size ; it restores the size
...@@ -306,13 +348,15 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'." ...@@ -306,13 +348,15 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
(defun tmm-shortcut () (defun tmm-shortcut ()
"Choose the shortcut that the user typed." "Choose the shortcut that the user typed."
(interactive) (interactive)
(let ((c (upcase (char-to-string last-command-char))) s) (let ((c last-command-char) s)
(if (member c tmm-short-cuts) (if (symbolp tmm-shortcut-style)
(setq c (funcall tmm-shortcut-style c)))
(if (memq c tmm-short-cuts)
(if (equal (buffer-name) "*Completions*") (if (equal (buffer-name) "*Completions*")
(progn (progn
(beginning-of-buffer) (beginning-of-buffer)
(re-search-forward (re-search-forward
(concat "\\(^\\|[ \t]\\)" c tmm-mid-prompt)) (concat "\\(^\\|[ \t]\\)" (char-to-string c) tmm-mid-prompt))
(choose-completion)) (choose-completion))
(erase-buffer) ; In minibuffer (erase-buffer) ; In minibuffer
(mapcar (lambda (elt) (mapcar (lambda (elt)
...@@ -320,7 +364,7 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'." ...@@ -320,7 +364,7 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
(substring (car elt) 0 (substring (car elt) 0
(min (1+ (length tmm-mid-prompt)) (min (1+ (length tmm-mid-prompt))
(length (car elt)))) (length (car elt))))
(concat c tmm-mid-prompt)) (concat (char-to-string c) tmm-mid-prompt))
(setq s (car elt)))) (setq s (car elt))))
tmm-km-list) tmm-km-list)
(insert s) (insert s)
...@@ -334,7 +378,6 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'." ...@@ -334,7 +378,6 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
(search-forward tmm-c-prompt) (search-forward tmm-c-prompt)
(search-backward tmm-c-prompt)) (search-backward tmm-c-prompt))
(defun tmm-get-keymap (elt &optional in-x-menu) (defun tmm-get-keymap (elt &optional in-x-menu)
"Prepends (DOCSTRING EVENT BINDING) to free variable `tmm-km-list'. "Prepends (DOCSTRING EVENT BINDING) to free variable `tmm-km-list'.
The values are deduced from the argument ELT, that should be an The values are deduced from the argument ELT, that should be an
...@@ -389,7 +432,6 @@ It uses the free variable `tmm-table-undef' to keep undefined keys." ...@@ -389,7 +432,6 @@ It uses the free variable `tmm-table-undef' to keep undefined keys."
(cons (cons str (cons event km)) tmm-km-list))) (cons (cons str (cons event km)) tmm-km-list)))
)))) ))))
(defun tmm-get-keybind (keyseq) (defun tmm-get-keybind (keyseq)
"Return the current binding of KEYSEQ, merging prefix definitions. "Return the current binding of KEYSEQ, merging prefix definitions.
If KEYSEQ is a prefix key that has local and global bindings, If KEYSEQ is a prefix key that has local and global bindings,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment