diff lisp/tmm.el @ 83310:e58cb448e07c

Merged from [e-mail]--gnu-2005 (patch 80-82, 350-422) Patches applied: * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-350 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-351 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-352 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-353 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-354 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-355 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-356 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-357 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-358 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-359 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-360 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-361 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-362 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-363 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-364 Remove "-face" suffix from widget faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-365 Remove "-face" suffix from custom faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-366 Remove "-face" suffix from change-log faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-367 Remove "-face" suffix from compilation faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-368 Remove "-face" suffix from diff-mode faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-369 lisp/longlines.el (longlines-visible-face): Face removed * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-370 Remove "-face" suffix from woman faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-371 Remove "-face" suffix from whitespace-highlight face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-372 Remove "-face" suffix from ruler-mode faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-373 Remove "-face" suffix from show-paren faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-374 Remove "-face" suffix from log-view faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-375 Remove "-face" suffix from smerge faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-376 Remove "-face" suffix from show-tabs faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-377 Remove "-face" suffix from highlight-changes faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-378 Remove "-face" suffix from and downcase info faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-379 Remove "-face" suffix from pcvs faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-380 Update uses of renamed pcvs faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-381 Tweak ChangeLog * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-382 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-383 Remove "-face" suffix from strokes-char face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-384 Remove "-face" suffix from compare-windows face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-385 Remove "-face" suffix from calendar faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-386 Remove "-face" suffix from diary-button face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-387 Remove "-face" suffix from testcover faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-388 Remove "-face" suffix from viper faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-389 Remove "-face" suffix from org faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-390 Remove "-face" suffix from sgml-namespace face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-391 Remove "-face" suffix from table-cell face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-392 Remove "-face" suffix from tex-mode faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-393 Remove "-face" suffix from texinfo-heading face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-394 Remove "-face" suffix from flyspell faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-395 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-396 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-397 Remove "-face" suffix from gomoku faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-398 Remove "-face" suffix from mpuz faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-399 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-400 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-401 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-402 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-403 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-404 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-405 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-406 Merge from gnus--rel--5.10 * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-407 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-408 Remove "-face" suffix from Buffer-menu-buffer face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-409 Remove "-face" suffix from antlr-mode faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-410 Remove "-face" suffix from ebrowse faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-411 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-412 Remove "-face" suffix from flymake faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-413 Remove "-face" suffix from idlwave faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-414 Remove "-face" suffix from sh-script faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-415 Remove "-face" suffix from vhdl-mode faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-416 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-417 Remove "-face" suffix from which-func face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-418 Remove "-face" suffix from cperl-mode faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-419 Remove "-face" suffix from ld-script faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-420 Fix cperl-mode font-lock problem * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-421 Tweak which-func face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-422 Update from CVS * [e-mail]--gnu-2005/gnus--rel--5.10--patch-80 Merge from emacs--cvs-trunk--0 * [e-mail]--gnu-2005/gnus--rel--5.10--patch-81 Update from CVS * [e-mail]--gnu-2005/gnus--rel--5.10--patch-82 Update from CVS git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-350

--- a/lisp/tmm.el	Fri Jun 03 05:49:26 2005 +0000
+++ b/lisp/tmm.el	Wed Jun 15 12:57:51 2005 +0000
@@ -133,6 +133,11 @@
   :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 @@
 				  (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 @@
 
 (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 @@
   (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 @@
 	(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 @@
       (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 ()
@@ -438,7 +474,7 @@
 		   (setq km (and (eval visible) km)))
 	       (setq enable (plist-get plist :enable))
 	       (if enable
-		   (setq km (and (eval enable) km)))
+                   (setq km (if (eval enable) km 'ignore)))
 	       (and str
 		    (consp (nth 3 elt))
 		    (stringp (cdr (nth 3 elt))) ; keyseq cache
@@ -467,8 +503,7 @@
       ;; 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))))))