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

(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.
parent 97af0368
......@@ -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)))
......
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