;;; tmm.el --- text mode access to menu-bar
-;; Copyright (C) 1994, 1995, 1996, 2000, 2001, 2002
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1995, 1996, 2000, 2001, 2002, 2003,
+;; 2004, 2005, 2006 Free Software Foundation, Inc.
;; Author: Ilya Zakharevich <ilya@math.mps.ohio-state.edu>
;; Maintainer: FSF
;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
:type '(choice integer (const nil))
:group 'tmm)
+(defface tmm-inactive
+ '((t :inherit shadow))
+ "Face used for inactive menu items."
+ :group 'tmm)
+
;;;###autoload
(defun tmm-prompt (menu &optional in-popup default-item)
"Text-mode emulation of calling the bindings in keymap.
(eq (car-safe (cdr (car tail))) 'menu-item)))
(setq index-of-default (1+ index-of-default)))
(setq tail (cdr tail)))))
- (setq history (reverse (mapcar 'car tmm-km-list)))
+ (let ((prompt (concat "^." (regexp-quote tmm-mid-prompt))))
+ (setq history
+ (reverse (delq nil
+ (mapcar
+ (lambda (elt)
+ (if (string-match prompt (car elt))
+ (car elt)))
+ tmm-km-list)))))
(setq history-len (length history))
(setq history (append history history history history))
(setq tmm-c-prompt (nth (- history-len 1 index-of-default) history))
(defsubst tmm-add-one-shortcut (elt)
;; uses the free vars tmm-next-shortcut-digit and tmm-short-cuts
- (let* ((str (car elt))
- (paren (string-match "(" str))
- (pos 0) (word 0) char)
- (catch 'done ; ??? is this slow?
- (while (and (or (not tmm-shortcut-words) ; no limit on words
- (< word tmm-shortcut-words)) ; try n words
- (setq pos (string-match "\\w+" str pos)) ; get next word
- (not (and paren (> pos paren)))) ; don't go past "(binding.."
- (if (or (= pos 0)
- (/= (aref str (1- pos)) ?.)) ; avoid file extensions
- (let ((shortcut-style
- (if (listp tmm-shortcut-style) ; convert to list
- tmm-shortcut-style
- (list tmm-shortcut-style))))
- (while shortcut-style ; try upcase and downcase variants
- (setq char (funcall (car shortcut-style) (aref str pos)))
- (if (not (memq char tmm-short-cuts)) (throw 'done char))
- (setq shortcut-style (cdr shortcut-style)))))
- (setq word (1+ word))
- (setq pos (match-end 0)))
- (while (<= tmm-next-shortcut-digit ?9) ; no letter shortcut, pick a digit
- (setq char tmm-next-shortcut-digit)
- (setq tmm-next-shortcut-digit (1+ tmm-next-shortcut-digit))
- (if (not (memq char tmm-short-cuts)) (throw 'done char)))
- (setq char nil))
- (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)) ?\ ))
- str)
- (cdr elt))))
+ (cond
+ ((eq (cddr elt) 'ignore)
+ (cons (concat " " (make-string (length tmm-mid-prompt) ?\-)
+ (car elt))
+ (cdr elt)))
+ (t
+ (let* ((str (car elt))
+ (paren (string-match "(" str))
+ (pos 0) (word 0) char)
+ (catch 'done ; ??? is this slow?
+ (while (and (or (not tmm-shortcut-words) ; no limit on words
+ (< word tmm-shortcut-words)) ; try n words
+ (setq pos (string-match "\\w+" str pos)) ; get next word
+ (not (and paren (> pos paren)))) ; don't go past "(binding.."
+ (if (or (= pos 0)
+ (/= (aref str (1- pos)) ?.)) ; avoid file extensions
+ (let ((shortcut-style
+ (if (listp tmm-shortcut-style) ; convert to list
+ tmm-shortcut-style
+ (list tmm-shortcut-style))))
+ (while shortcut-style ; try upcase and downcase variants
+ (setq char (funcall (car shortcut-style) (aref str pos)))
+ (if (not (memq char tmm-short-cuts)) (throw 'done char))
+ (setq shortcut-style (cdr shortcut-style)))))
+ (setq word (1+ word))
+ (setq pos (match-end 0)))
+ (while (<= tmm-next-shortcut-digit ?9) ; no letter shortcut, pick a digit
+ (setq char tmm-next-shortcut-digit)
+ (setq tmm-next-shortcut-digit (1+ tmm-next-shortcut-digit))
+ (if (not (memq char tmm-short-cuts)) (throw 'done char)))
+ (setq char nil))
+ (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)) ?\ ))
+ str)
+ (cdr elt))))))
;; This returns the old map.
(defun tmm-define-keys (minibuffer)
(goto-char 1)
(delete-region 1 (search-forward "Possible completions are:\n")))
+(defun tmm-remove-inactive-mouse-face ()
+ "Remove the mouse-face property from inactive menu items."
+ (let ((inhibit-read-only t)
+ (inactive-string
+ (concat " " (make-string (length tmm-mid-prompt) ?\-)))
+ next)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq next (next-single-char-property-change (point) 'mouse-face))
+ (when (looking-at inactive-string)
+ (remove-text-properties (point) next '(mouse-face))
+ (add-text-properties (point) next '(face tmm-inactive)))
+ (goto-char next)))
+ (set-buffer-modified-p nil)))
+
(defun tmm-add-prompt ()
(remove-hook 'minibuffer-setup-hook 'tmm-add-prompt)
(add-hook 'minibuffer-exit-hook 'tmm-delete-map nil t)
+ (unless tmm-c-prompt
+ (error "No active menu entries"))
(let ((win (selected-window)))
(setq tmm-old-mb-map (tmm-define-keys t))
;; Get window and hide it for electric mode to get correct size
(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
- (set-buffer "*Completions*")
(let ((buffer-read-only nil))
(goto-char (point-min))
(insert tmm-completion-prompt))))
(Electric-pop-up-window "*Completions*")
(with-current-buffer "*Completions*"
(setq tmm-old-comp-map (tmm-define-keys nil))))
-
(insert tmm-c-prompt)))
(defun tmm-delete-map ()
(if (memq c tmm-short-cuts)
(if (equal (buffer-name) "*Completions*")
(progn
- (beginning-of-buffer)
+ (goto-char (point-min))
(re-search-forward
(concat "\\(^\\|[ \t]\\)" (char-to-string c) tmm-mid-prompt))
(choose-completion))
`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 (event (car elt)))
+ (let (km str cache 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))
(setq visible (plist-get plist :visible))
(if visible
(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
;; Verify that the command is enabled;
;; if not, don't mention it.
(when (and km (symbolp km) (get km 'menu-enable))
- (unless (eval (get km 'menu-enable))
- (setq km nil)))
+ (setq km (if (eval (get km 'menu-enable)) km 'ignore)))
(and km str
(or (assoc str tmm-km-list)
(push (cons str (cons event km)) tmm-km-list))))))
(provide 'tmm)
+;;; arch-tag: e7ddbdb6-4b95-4da3-afbe-ad6063d112f4
;;; tmm.el ends here