procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Backport from trunk: compute shortcuts in tmm.el.

Browse source 
* tmm.el (tmm-prompt): Don't try to precompute bindings.
(tmm-get-keymap): Compute shortcuts since the cache is empty.

Fixes: debbugs:6171
This commit is contained in:
Stefan Monnier 2010-05-11 16:07:12 -04:00
parent c8670ded9c
commit dc9ed79496
2 changed files with 29 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
lisp/ChangeLog
View file

@ -1,3 +1,8 @@
2010-05-11 Stefan Monnier <monnier@iro.umontreal.ca>
* tmm.el (tmm-prompt): Don't try to precompute bindings.
(tmm-get-keymap): Compute shortcuts (bug#6171).
2010-05-10 Glenn Morris <rgm@gnu.org>
* desktop.el (desktop-save-buffer-p): Don't mistakenly include

50
lisp/tmm.el
View file

@ -262,9 +262,6 @@ Its value should be an event that has a binding in MENU."
(condition-case nil
(require 'mouse)
(error nil))
(condition-case nil
(x-popup-menu nil choice) ; Get the shortcuts
(error nil))
(tmm-prompt choice))
;; We just handled a menu keymap and found a command.
(choice
@ -445,33 +442,30 @@ element of keymap, an `x-popup-menu' argument, or an element of
`x-popup-menu' argument (when IN-X-MENU is not-nil).
This function adds the element only if it is not already present.
It uses the free variable `tmm-table-undef' to keep undefined keys."
(let (km str cache plist filter visible enable (event (car elt)))
(let (km str plist filter visible enable (event (car elt)))
(setq elt (cdr elt))
(if (eq elt 'undefined)
(setq tmm-table-undef (cons (cons event nil) tmm-table-undef))
(unless (assoc event tmm-table-undef)
(cond ((if (listp elt)
(or (keymapp elt) (eq (car elt) 'lambda))
(fboundp elt))
(and (symbolp elt) (fboundp elt)))
(setq km elt))
((if (listp (cdr-safe elt))
(or (keymapp (cdr-safe elt))
(eq (car (cdr-safe elt)) 'lambda))
(fboundp (cdr-safe elt)))
(and (symbolp (cdr-safe elt)) (fboundp (cdr-safe elt))))
(setq km (cdr elt))
(and (stringp (car elt)) (setq str (car elt))))
((if (listp (cdr-safe (cdr-safe elt)))
(or (keymapp (cdr-safe (cdr-safe elt)))
(eq (car (cdr-safe (cdr-safe elt))) 'lambda))
(fboundp (cdr-safe (cdr-safe elt))))
(and (symbolp (cdr-safe (cdr-safe elt)))
(fboundp (cdr-safe (cdr-safe elt)))))
(setq km (cddr elt))
(and (stringp (car elt)) (setq str (car elt)))
(and str
(stringp (cdr-safe (cadr elt))) ; keyseq cache
(setq cache (cdr (cadr elt)))
cache (setq str (concat str cache))))
(and (stringp (car elt)) (setq str (car elt))))
((eq (car-safe elt) 'menu-item)
;; (menu-item TITLE COMMAND KEY ...)
@ -488,30 +482,34 @@ It uses the free variable `tmm-table-undef' to keep undefined keys."
(setq km (and (eval visible) km)))
(setq enable (plist-get plist :enable))
(if enable
(setq km (if (eval enable) km 'ignore)))
(and str
(consp (nth 3 elt))
(stringp (cdr (nth 3 elt))) ; keyseq cache
(setq cache (cdr (nth 3 elt)))
cache
(setq str (concat str cache))))
(setq km (if (eval enable) km 'ignore))))
((if (listp (cdr-safe (cdr-safe (cdr-safe elt))))
(or (keymapp (cdr-safe (cdr-safe (cdr-safe elt))))
(eq (car (cdr-safe (cdr-safe (cdr-safe elt)))) 'lambda))
(fboundp (cdr-safe (cdr-safe (cdr-safe elt)))))
(and (symbolp (cdr-safe (cdr-safe (cdr-safe elt))))
(fboundp (cdr-safe (cdr-safe (cdr-safe elt))))))
; New style of easy-menu
(setq km (cdr (cddr elt)))
(and (stringp (car elt)) (setq str (car elt)))
(and str
(stringp (cdr-safe (car (cddr elt)))) ; keyseq cache
(setq cache (cdr (car (cdr (cdr elt)))))
cache (setq str (concat str cache))))
(and (stringp (car elt)) (setq str (car elt))))
((stringp event) ; x-popup or x-popup element
(if (or in-x-menu (stringp (car-safe elt)))
(setq str event event nil km elt)
(setq str event event nil km (cons 'keymap elt))))))
(setq str event event nil km (cons 'keymap elt)))))
(unless (eq km 'ignore)
(let ((binding (where-is-internal km nil t)))
(when binding
(setq binding (key-description binding))
;; Try to align the keybindings.
(let ((colwidth (min 30 (- (/ (window-width) 2) 10))))
(setq str
(concat str
(make-string (max 2 (- colwidth
(string-width str)
(string-width binding)))
?\s)
binding)))))))
(and km (stringp km) (setq str km))
;; Verify that the command is enabled;
;; if not, don't mention it.