X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e5ba1eb9ef811355ad922f17c61a0fb006a2db1a..1bf6d4b5c112dbf6233ff2cfc3b85adfa6cbd291:/lisp/tmm.el

diff --git a/lisp/tmm.el b/lisp/tmm.el
index 759caba560..86c326616a 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -1,7 +1,7 @@
 ;;; 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
@@ -21,8 +21,8 @@
 
 ;; 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:
 
@@ -133,6 +133,11 @@ specify nil for this variable."
   :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.
@@ -193,7 +198,14 @@ Its value should be an event that has a binding in MENU."
 				  (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))
@@ -259,37 +271,43 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
 
 (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)
@@ -319,9 +337,27 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
   (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
@@ -334,8 +370,9 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
 	(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))))
@@ -345,7 +382,6 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
       (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 ()
@@ -362,7 +398,7 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
     (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))
@@ -395,7 +431,7 @@ element of keymap, an `x-popup-menu' argument, or an element of
 `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))
@@ -436,6 +472,9 @@ It uses the free variable `tmm-table-undef' to keep undefined keys."
 	       (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
@@ -464,8 +503,7 @@ It uses the free variable `tmm-table-undef' to keep undefined keys."
       ;; 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))))))
@@ -506,4 +544,5 @@ of `menu-bar-final-items'."
 
 (provide 'tmm)
 
+;;; arch-tag: e7ddbdb6-4b95-4da3-afbe-ad6063d112f4
 ;;; tmm.el ends here