;;; 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:
(defvar tmm-table-undef)
;;;###autoload (define-key global-map "\M-`" 'tmm-menubar)
-;;;###autoload (define-key global-map [f10] 'tmm-menubar)
;;;###autoload (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse)
;;;###autoload
(tmm-menubar (car (posn-x-y (event-start event)))))
(defcustom tmm-mid-prompt "==>"
- "*String to insert between shortcut and menu item.
+ "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."
:type 'string
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.
"
- "*Help text to insert on the top of the completion buffer.
+ "Help text to insert on the top of the completion buffer.
To save space, you can set this to nil,
in which case the standard introduction text is deleted too."
:type '(choice string (const nil))
:group 'tmm)
(defcustom tmm-shortcut-style '(downcase upcase)
- "*What letters to use as menu shortcuts.
+ "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."
:type '(choice (const downcase)
:group 'tmm)
(defcustom tmm-shortcut-words 2
- "*How many successive words to try for shortcuts, nil means all.
+ "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."
:type '(choice integer (const nil))
(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)))
tmm-km-list nil t nil
(cons 'history
(- (* 2 history-len) index-of-default))))
- (save-excursion
- (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt)
- (if (get-buffer "*Completions*")
- (progn
- (set-buffer "*Completions*")
- (use-local-map tmm-old-comp-map)
- (bury-buffer (current-buffer))))))))))
+ (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt)
+ (if (get-buffer "*Completions*")
+ (with-current-buffer "*Completions*"
+ (use-local-map tmm-old-comp-map)
+ (bury-buffer (current-buffer)))))))))
(setq choice (cdr (assoc out tmm-km-list)))
(and (null choice)
(> (length out) (length tmm-c-prompt))
(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.
;; Return that keymap.
bind))))
+;; Huh? What's that about? --Stef
(add-hook 'calendar-load-hook (lambda () (require 'cal-menu)))
(provide 'tmm)
-;;; arch-tag: e7ddbdb6-4b95-4da3-afbe-ad6063d112f4
+;; arch-tag: e7ddbdb6-4b95-4da3-afbe-ad6063d112f4
;;; tmm.el ends here
HCoop / bpt / emacs.git / blobdiff