;;; tmm.el --- text mode access to menu-bar
;; Copyright (C) 1994, 1995, 1996, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Ilya Zakharevich <ilya@math.mps.ohio-state.edu>
;; Maintainer: FSF
;; 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 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
(defvar tmm-short-cuts)
(defvar tmm-old-mb-map nil)
(defvar tmm-old-comp-map)
-(defvar tmm-c-prompt)
+(defvar tmm-c-prompt nil)
(defvar tmm-km-list)
(defvar tmm-next-shortcut-digit)
(defvar tmm-table-undef)
(list this-one)))))
(setq list (cdr list))))
(if x-position
- (let ((tail menu-bar)
- this-one
- (column 0))
- (while (and tail (< column x-position))
+ (let ((tail menu-bar) (column 0)
+ this-one name visible)
+ (while (and tail (<= column x-position))
(setq this-one (car tail))
- (if (and (consp (car tail))
- (consp (cdr (car tail)))
- (stringp (nth 1 (car tail))))
- (setq column (+ column
- (length (nth 1 (car tail)))
- 1)))
+ (if (and (consp this-one)
+ (consp (cdr this-one))
+ (setq name ;simple menu
+ (cond ((stringp (nth 1 this-one))
+ (nth 1 this-one))
+ ;extended menu
+ ((stringp (nth 2 this-one))
+ (setq visible (plist-get
+ (nthcdr 4 this-one) :visible))
+ (unless (and visible (not (eval visible)))
+ (nth 2 this-one))))))
+ (setq column (+ column (length name) 1)))
(setq tail (cdr tail)))
(setq menu-bar-item (car this-one))))
(tmm-prompt menu-bar nil menu-bar-item)))
(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))
;; We use this to decide the initial minibuffer contents
;; and initial history position.
(if default-item
- (let ((tail menu))
+ (let ((tail menu) visible)
(while (and tail
(not (eq (car-safe (car tail)) default-item)))
;; Be careful to count only the elements of MENU
;; that actually constitute menu bar items.
(if (and (consp (car tail))
(or (stringp (car-safe (cdr (car tail))))
- (eq (car-safe (cdr (car tail))) 'menu-item)))
+ (and
+ (eq (car-safe (cdr (car tail))) 'menu-item)
+ (progn
+ (setq visible
+ (plist-get
+ (nthcdr 4 (car tail)) :visible))
+ (or (not visible) (eval visible))))))
(setq index-of-default (1+ index-of-default)))
(setq tail (cdr tail)))))
(let ((prompt (concat "^." (regexp-quote tmm-mid-prompt))))
(setq history (append history history history history))
(setq tmm-c-prompt (nth (- history-len 1 index-of-default) history))
(add-hook 'minibuffer-setup-hook 'tmm-add-prompt)
- (save-excursion
- (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) 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)))))
- ))))
+ (if default-item
+ (setq out (car (nth index-of-default tmm-km-list)))
+ (save-excursion
+ (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) index-of-default))))
+ (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))
(if char (setq tmm-short-cuts (cons char tmm-short-cuts)))
(cons (concat (if char (concat (char-to-string char) tmm-mid-prompt)
;; keep them lined up in columns
- (make-string (1+ (length tmm-mid-prompt)) ?\ ))
+ (make-string (1+ (length tmm-mid-prompt)) ?\s))
str)
(cdr elt))))))
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)
+ (let (allbind bind minorbind localbind globalbind)
(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).
(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))
+ (setq minorbind (mapcar 'cdr (minor-mode-key-binding keyseq)))
+ (setq localbind (local-key-binding keyseq))
+ (setq globalbind (copy-sequence (cdr (global-key-binding keyseq))))
+
+ ;; If items have been redefined/undefined locally, remove them from
+ ;; the global list.
+ (dolist (minor minorbind)
+ (dolist (item (cdr minor))
+ (setq globalbind (assq-delete-all (car-safe item) globalbind))))
+ (dolist (item (cdr localbind))
+ (setq globalbind (assq-delete-all (car-safe item) globalbind)))
+
+ (setq globalbind (cons 'keymap globalbind))
+ (setq allbind (cons globalbind (cons localbind minorbind)))
+
;; Merge all the elements of ALLBIND into one keymap.
(mapc (lambda (in)
(if (and (symbolp in) (keymapp in))
;; 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