;;; tmm.el --- text mode access to menu-bar
;; Copyright (C) 1994, 1995, 1996, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Ilya Zakharevich <ilya@math.mps.ohio-state.edu>
;; Maintainer: FSF
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(mapc (lambda (elt)
(if (stringp elt)
(setq gl-str elt)
- (and (listp elt) (tmm-get-keymap elt not-menu))))
+ (cond
+ ((listp elt) (tmm-get-keymap elt not-menu))
+ ((vectorp elt)
+ (dotimes (i (length elt))
+ (tmm-get-keymap (cons i (aref elt i)) not-menu))))))
menu)
;; Choose an element of tmm-km-list; put it in choice.
(if (and not-menu (= 1 (length tmm-km-list)))
(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
(defun tmm-completion-delete-prompt ()
(set-buffer standard-output)
- (goto-char 1)
- (delete-region 1 (search-forward "Possible completions are:\n")))
+ (goto-char (point-min))
+ (delete-region (point) (search-forward "Possible completions are:\n")))
(defun tmm-remove-inactive-mouse-face ()
"Remove the mouse-face property from inactive menu items."
(or tmm-completion-prompt
(add-hook 'completion-setup-hook
'tmm-completion-delete-prompt 'append))
- (with-output-to-temp-buffer "*Completions*"
- (display-completion-list completions))
- (remove-hook 'completion-setup-hook 'tmm-completion-delete-prompt))
+ (unwind-protect
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list completions))
+ (remove-hook 'completion-setup-hook 'tmm-completion-delete-prompt)))
(set-buffer "*Completions*")
(tmm-remove-inactive-mouse-face)
(when tmm-completion-prompt
(defun tmm-shortcut ()
"Choose the shortcut that the user typed."
(interactive)
- (let ((c last-command-char) s)
+ (let ((c last-command-event) s)
(if (symbolp tmm-shortcut-style)
(setq c (funcall tmm-shortcut-style c)))
(if (memq c tmm-short-cuts)
`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))))
- (setq km (cdr (cdr elt)))
- (and (stringp (car elt)) (setq str (car elt)))
- (and str
- (stringp (cdr (car (cdr elt)))) ; keyseq cache
- (setq cache (cdr (car (cdr elt))))
- cache (setq str (concat str cache))))
+ (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))))
((eq (car-safe elt) 'menu-item)
;; (menu-item TITLE COMMAND KEY ...)
(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 (cdr (cdr elt))))
- (and (stringp (car elt)) (setq str (car elt)))
- (and str
- (stringp (cdr (car (cdr (cdr elt))))) ; keyseq cache
- (setq cache (cdr (car (cdr (cdr elt)))))
- cache (setq str (concat str cache))))
+ (setq km (cdr (cddr elt)))
+ (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.
HCoop / bpt / emacs.git / blobdiff