Mercurial > emacs
changeset 108497:f35b8e7b8a1f
Backport from trunk: compute shortcuts in tmm.el.
* tmm.el (tmm-prompt): Don't try to precompute bindings.
(tmm-get-keymap): Compute shortcuts since the cache is empty.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Tue, 11 May 2010 16:07:12 -0400 |
| parents | 49f3d201fdd0 |
| children | f01adbed6fd8 c3fda38a8b8b |
| files | lisp/ChangeLog lisp/tmm.el |
| diffstat | 2 files changed, 29 insertions(+), 26 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Tue May 11 20:23:52 2010 +0300 +++ b/lisp/ChangeLog Tue May 11 16:07:12 2010 -0400 @@ -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
--- a/lisp/tmm.el Tue May 11 20:23:52 2010 +0300 +++ b/lisp/tmm.el Tue May 11 16:07:12 2010 -0400 @@ -262,9 +262,6 @@ (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 @@ `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 @@ (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.