bug#12638: 24.2.50; FR: Some suggestions for icomplete-mode

[Jambunathan K <kjambunathan@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 405 bytes --]


I do have a patch that works (which I am attaching).  Not sure what you
will think of it.  You can patch it locally and see how it feels.

Speaking of screen estate, I would like to get full view of the
candidate, including prefix.  This helps me make sense out of the
candidate particularly when partial completion is on.

Implementation wise, I may have taken a different (probably amateurish)
route.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: bug-12638-firstcut.diff --]
[-- Type: text/x-diff, Size: 27513 bytes --]

=== modified file 'lisp/hi-lock.el'
--- lisp/hi-lock.el	2012-10-07 00:27:31 +0000
+++ lisp/hi-lock.el	2012-10-23 12:44:54 +0000
@@ -135,12 +135,20 @@
 ;; It can have a function value.
 (put 'hi-lock-file-patterns-policy 'risky-local-variable t)
 
+(defcustom hi-lock-auto-select-face nil
+  "Non-nil if highlighting commands should not prompt for face names.
+When non-nil, each hi-lock command will cycle through faces in
+`hi-lock-face-defaults'."
+  :type 'boolean
+  :group 'hi-lock
+  :version "24.3")
+
 (defgroup hi-lock-faces nil
   "Faces for hi-lock."
   :group 'hi-lock
   :group 'faces)
 
-(defface hi-yellow
+(defface hi-lock-1
   '((((min-colors 88) (background dark))
      (:background "yellow1" :foreground "black"))
     (((background dark)) (:background "yellow" :foreground "black"))
@@ -149,13 +157,13 @@
   "Default face for hi-lock mode."
   :group 'hi-lock-faces)
 
-(defface hi-pink
+(defface hi-lock-2
   '((((background dark)) (:background "pink" :foreground "black"))
     (t (:background "pink")))
   "Face for hi-lock mode."
   :group 'hi-lock-faces)
 
-(defface hi-green
+(defface hi-lock-3
   '((((min-colors 88) (background dark))
      (:background "green1" :foreground "black"))
     (((background dark)) (:background "green" :foreground "black"))
@@ -164,40 +172,50 @@
   "Face for hi-lock mode."
   :group 'hi-lock-faces)
 
-(defface hi-blue
+(defface hi-lock-4
   '((((background dark)) (:background "light blue" :foreground "black"))
     (t (:background "light blue")))
   "Face for hi-lock mode."
   :group 'hi-lock-faces)
 
-(defface hi-black-b
+(defface hi-lock-5
   '((t (:weight bold)))
   "Face for hi-lock mode."
   :group 'hi-lock-faces)
 
-(defface hi-blue-b
+(defface hi-lock-6
   '((((min-colors 88)) (:weight bold :foreground "blue1"))
     (t (:weight bold :foreground "blue")))
   "Face for hi-lock mode."
   :group 'hi-lock-faces)
 
-(defface hi-green-b
+(defface hi-lock-7
   '((((min-colors 88)) (:weight bold :foreground "green1"))
     (t (:weight bold :foreground "green")))
   "Face for hi-lock mode."
   :group 'hi-lock-faces)
 
-(defface hi-red-b
+(defface hi-lock-8
   '((((min-colors 88)) (:weight bold :foreground "red1"))
     (t (:weight bold :foreground "red")))
   "Face for hi-lock mode."
   :group 'hi-lock-faces)
 
-(defface hi-black-hb
+(defface hi-lock-9
   '((t (:weight bold :height 1.67 :inherit variable-pitch)))
   "Face for hi-lock mode."
   :group 'hi-lock-faces)
 
+(define-obsolete-face-alias 'hi-yellow 'hi-lock-1 "24.3")
+(define-obsolete-face-alias 'hi-pink 'hi-lock-2 "24.3")
+(define-obsolete-face-alias 'hi-green 'hi-lock-3 "24.3")
+(define-obsolete-face-alias 'hi-blue 'hi-lock-4 "24.3")
+(define-obsolete-face-alias 'hi-black-b 'hi-lock-5 "24.3")
+(define-obsolete-face-alias 'hi-blue-b 'hi-lock-6 "24.3")
+(define-obsolete-face-alias 'hi-green-b 'hi-lock-7 "24.3")
+(define-obsolete-face-alias 'hi-red-b 'hi-lock-8 "24.3")
+(define-obsolete-face-alias 'hi-black-hb 'hi-lock-9 "24.3")
+
 (defvar hi-lock-file-patterns nil
   "Patterns found in file for hi-lock.  Should not be changed.")
 
@@ -207,12 +225,19 @@
 (define-obsolete-variable-alias 'hi-lock-face-history
                                 'hi-lock-face-defaults "23.1")
 (defvar hi-lock-face-defaults
-  '("hi-yellow" "hi-pink" "hi-green" "hi-blue" "hi-black-b"
-    "hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb")
+  '("hi-lock-1" "hi-lock-2" "hi-lock-3" "hi-lock-4" "hi-lock-5"
+    "hi-lock-6" "hi-lock-7" "hi-lock-8" "hi-lock-9")
   "Default faces for hi-lock interactive functions.")
 
-;;(dolist (f hi-lock-face-defaults)
-;;  (unless (facep f) (error "%s not a face" f)))
+(defvar hi-lock-auto-select-face-defaults
+  (let ((l (copy-sequence hi-lock-face-defaults)))
+    (setcdr (last l) l))
+  "Circular list of faces used for interactive highlighting.
+When `hi-lock-auto-select-face' is non-nil, use the face at the
+head of this list for next interactive highlighting.  See also
+`hi-lock-read-face-name'.")
+
+(make-variable-buffer-local 'hi-lock-auto-select-face-defaults)
 
 (define-obsolete-variable-alias 'hi-lock-regexp-history
                                 'regexp-history
@@ -408,9 +433,9 @@
   (interactive
    (list
     (hi-lock-regexp-okay
-     (read-regexp "Regexp to highlight line" (car regexp-history)))
+     (read-regexp "Regexp to highlight line"))
     (hi-lock-read-face-name)))
-  (or (facep face) (setq face 'hi-yellow))
+  (or (facep face) (setq face 'hi-lock-1))
   (unless hi-lock-mode (hi-lock-mode 1))
   (hi-lock-set-pattern
    ;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ?
@@ -433,9 +458,9 @@
   (interactive
    (list
     (hi-lock-regexp-okay
-     (read-regexp "Regexp to highlight" (car regexp-history)))
+     (read-regexp "Regexp to highlight"))
     (hi-lock-read-face-name)))
-  (or (facep face) (setq face 'hi-yellow))
+  (or (facep face) (setq face 'hi-lock-1))
   (unless hi-lock-mode (hi-lock-mode 1))
   (hi-lock-set-pattern regexp face))
 
@@ -455,9 +480,9 @@
    (list
     (hi-lock-regexp-okay
      (hi-lock-process-phrase
-      (read-regexp "Phrase to highlight" (car regexp-history))))
+      (read-regexp "Phrase to highlight")))
     (hi-lock-read-face-name)))
-  (or (facep face) (setq face 'hi-yellow))
+  (or (facep face) (setq face 'hi-lock-1))
   (unless hi-lock-mode (hi-lock-mode 1))
   (hi-lock-set-pattern regexp face))
 
@@ -466,10 +491,18 @@
 ;;;###autoload
 (defalias 'unhighlight-regexp 'hi-lock-unface-buffer)
 ;;;###autoload
-(defun hi-lock-unface-buffer (regexp)
+(defun hi-lock-unface-buffer (regexp &optional prefix-arg)
   "Remove highlighting of each match to REGEXP set by hi-lock.
-Interactively, prompt for REGEXP, accepting only regexps
-previously inserted by hi-lock interactive functions."
+Interactively, when PREFIX-ARG is non-nil, unhighlight all
+highlighted text in current buffer.  When PREFIX-ARG is nil,
+prompt for REGEXP.  If the cursor is on a previously highlighted
+text and if the associated regexp can be inferred via simple
+heuristics, offer that regexp as default.  Otherwise, prompt for
+REGEXP with completion and limit the choices to only those
+regexps used previously with hi-lock commands.
+
+If this command is invoked via menu, pop-up a list of currently
+highlighted patterns."
   (interactive
    (if (and (display-popup-menus-p)
 	    (listp last-nonmenu-event)
@@ -497,23 +530,63 @@
 	  ;; To prevent that, we return an empty string, which will
 	  ;; effectively disable the rest of the function.
 	  (throw 'snafu '(""))))
-     (let ((history-list (mapcar (lambda (p) (car p))
-                                 hi-lock-interactive-patterns)))
-       (unless hi-lock-interactive-patterns
-         (error "No highlighting to remove"))
+     ;; Un-highlighting triggered via keyboard action.
+     (unless hi-lock-interactive-patterns
+       (error "No highlighting to remove"))
+     ;; Infer the regexp to un-highlight based on cursor position.
+     (let* (candidate-hi-lock-patterns
+	    (default-regexp
+	      (or
+	       ;; When using overlays, there is no ambiguity on the best
+	       ;; choice of regexp.
+	       (let ((desired-serial (get-char-property
+				      (point) 'hi-lock-overlay-regexp)))
+		 (when desired-serial
+		   (catch 'regexp
+		     (maphash
+		      (lambda (regexp serial)
+			(when (= serial desired-serial)
+			  (throw 'regexp regexp)))
+		      hi-lock-string-serialize-hash))))
+	       ;; With font-locking on, check if the cursor is on an
+	       ;; highlighted text.  Checking for hi-lock face is a
+	       ;; good heuristic.
+	       (and (string-match "\\`hi-lock-" (face-name (face-at-point)))
+		    (let* ((hi-text
+			    (buffer-substring-no-properties
+			     (previous-single-property-change (point) 'face)
+			     (next-single-property-change (point) 'face))))
+		      ;; Compute hi-lock patterns that match the
+		      ;; highlighted text at point.  Use this later in
+		      ;; during completing-read.
+		      (setq candidate-hi-lock-patterns
+			    (delq nil
+				  (mapcar
+				   (lambda (hi-lock-pattern)
+				     (let ((regexp (car hi-lock-pattern)))
+				       (and (string-match regexp hi-text)
+					    hi-lock-pattern)))
+				   hi-lock-interactive-patterns)))
+		      ;; Use regexp from the first matching pattern as
+		      ;; a reasonable default.
+		      (caar candidate-hi-lock-patterns))))))
        (list
-        (completing-read "Regexp to unhighlight: "
-                         hi-lock-interactive-patterns nil t
-                         (car (car hi-lock-interactive-patterns))
-                         (cons 'history-list 1))))))
-  (let ((keyword (assoc regexp hi-lock-interactive-patterns)))
-    (when keyword
-      (font-lock-remove-keywords nil (list keyword))
-      (setq hi-lock-interactive-patterns
-            (delq keyword hi-lock-interactive-patterns))
-      (remove-overlays
-       nil nil 'hi-lock-overlay-regexp (hi-lock-string-serialize regexp))
-      (when font-lock-fontified (font-lock-fontify-buffer)))))
+	(and (not current-prefix-arg)
+	     (completing-read "Regexp to unhighlight: "
+			      (or candidate-hi-lock-patterns
+				  hi-lock-interactive-patterns)
+			      nil t default-regexp))
+	current-prefix-arg))))
+  (dolist (re (if (not prefix-arg) (list regexp)
+		(mapcar #'car hi-lock-interactive-patterns)))
+    (let ((keyword (assoc re hi-lock-interactive-patterns)))
+      (when keyword
+	(font-lock-remove-keywords nil (list keyword))
+	(setq hi-lock-interactive-patterns
+	      (delq keyword hi-lock-interactive-patterns))
+	(remove-overlays
+	 nil nil 'hi-lock-overlay-regexp (hi-lock-string-serialize re))
+	(when font-lock-fontified (font-lock-fontify-buffer))))))
 
 ;;;###autoload
 (defun hi-lock-write-interactive-patterns ()
@@ -567,25 +640,33 @@
     regexp))
 
 (defun hi-lock-read-face-name ()
-  "Read face name from minibuffer with completion and history."
-  (intern (completing-read
-           "Highlight using face: "
-           obarray 'facep t
-           (cons (car hi-lock-face-defaults)
-                 (let ((prefix
-                        (try-completion
-                         (substring (car hi-lock-face-defaults) 0 1)
-                         hi-lock-face-defaults)))
-                   (if (and (stringp prefix)
-                            (not (equal prefix (car hi-lock-face-defaults))))
-                       (length prefix) 0)))
-           'face-name-history
-	   (cdr hi-lock-face-defaults))))
+  "Return face name for interactive highlighting.
+When `hi-lock-auto-select-face' is non-nil, return head of
+`hi-lock-auto-select-face-defaults'.  Otherwise, read face name
+from minibuffer with completion and history."
+  (if hi-lock-auto-select-face
+      ;; Return current head and rotate the face list.
+      (prog1 (intern (car hi-lock-auto-select-face-defaults))
+	(setq hi-lock-auto-select-face-defaults
+	      (cdr hi-lock-auto-select-face-defaults)))
+    (intern (completing-read
+	     "Highlight using face: "
+	     obarray 'facep t
+	     (cons (car hi-lock-face-defaults)
+		   (let ((prefix
+			  (try-completion
+			   (substring (car hi-lock-face-defaults) 0 1)
+			   hi-lock-face-defaults)))
+		     (if (and (stringp prefix)
+			      (not (equal prefix (car hi-lock-face-defaults))))
+			 (length prefix) 0)))
+	     'face-name-history
+	     (cdr hi-lock-face-defaults)))))
 
 (defun hi-lock-set-pattern (regexp face)
   "Highlight REGEXP with face FACE."
   (let ((pattern (list regexp (list 0 (list 'quote face) t))))
-    (unless (member pattern hi-lock-interactive-patterns)
+    (unless (assoc regexp hi-lock-interactive-patterns)
       (push pattern hi-lock-interactive-patterns)
       (if font-lock-mode
 	  (progn

=== modified file 'lisp/icomplete.el'
--- lisp/icomplete.el	2012-06-22 17:37:28 +0000
+++ lisp/icomplete.el	2012-10-23 19:51:46 +0000
@@ -120,6 +120,35 @@
   :type 'hook
   :group 'icomplete)
 
+(defcustom icomplete-decorations
+  '( "{" "}" " | " " | ..." "[" "]" " [No match]" " [Matched%s]")
+  "List of strings used by icomplete to display alternatives in minibuffer.
+There are 8 elements in this list:
+1st and 2nd elements enclose the prospects.
+3rd element is the separator between prospects.
+4th element is the string inserted at the end of a truncated list of prospects.
+5th and 6th elements are used as brackets around the common match string which
+can be completed using TAB.
+7th element is the string displayed when there are no matches.
+8th element is displayed if there is a single match."
+  :type '(repeat string)
+  :version "24.3"
+  :group 'icomplete)
+
+(defcustom icomplete-cycle t
+  "Non-nil if cycling is to be enabled in `icomplete-mode'.
+When cycling is enabled, keys \"C-j\", \"C-s\" and \"C-r\" are
+bound to `icomplete-this-match', `icomplete-next-match' and
+`icomplete-prev-match' respectively."
+  :type 'boolean
+  :version "24.3"
+  :group 'icomplete)
+
+(defface icomplete-first-match  '((t :weight bold))
+  "Face used by icomplete for highlighting first match."
+  :version "24.3"
+  :group 'icomplete)
+
 
 ;;;_* Initialization
 
@@ -149,7 +178,7 @@
   "Return strings naming keys bound to FUNC-NAME, or nil if none.
 Examines the prior, not current, buffer, presuming that current buffer
 is minibuffer."
-  (when (commandp func-name)
+  (when (commandp (intern-soft func-name))
     (save-excursion
       (let* ((sym (intern func-name))
 	     (buf (other-buffer nil t))
@@ -169,6 +198,29 @@
 Icomplete does not operate with any specialized completion tables
 except those on this list.")
 
+;;;_  = icomplete-name
+(defvar icomplete-name nil
+  "Minibuffer user input.")
+
+;;;_  = icomplete-matches
+(defvar icomplete-matches nil
+  "Stored value of completion candidates that are on display.
+This is set by `icomplete-exhibit', modified by
+`icomplete-this-match', `icomplete-next-match' and
+`icomplete-prev-match' and cleared by `icomplete-try'.")
+
+;;;_  = icomplete-most-try
+(defvar icomplete-most-try nil
+  "Value of `completion-try-completion'.
+When there are multiple matches, it signifies common match string
+which can be completed using TAB.")
+
+;;;_  = icomplete-try
+(defvar icomplete-try nil
+  "Part of `icomplete-most-try' that is displayed at the prompt.
+Same as `icomplete-most-try' but with whole of `icomplete-name'
+stripped from front, when possible.")
+
 ;;;_ > icomplete-mode (&optional prefix)
 ;;;###autoload
 (define-minor-mode icomplete-mode
@@ -227,7 +279,18 @@
   "Remove completions display \(if any) prior to new user input.
 Should be run in on the minibuffer `pre-command-hook'.  See `icomplete-mode'
 and `minibuffer-setup-hook'."
-  (delete-overlay icomplete-overlay))
+  (unless (memq this-command '(icomplete-this-match icomplete-next-match
+						    icomplete-prev-match))
+    ;; Current command does not belong to icomplete-mode.
+    ;; Clear the matches.
+    (setq icomplete-matches nil)
+    ;; Cleanup local icomplete bindings.
+    (when (eq (key-binding "\C-j") 'icomplete-this-match)
+      (local-unset-key "\C-j")
+      (local-unset-key "\C-s")
+      (local-unset-key "\C-r"))
+    ;; Delete the overlay.
+    (delete-overlay icomplete-overlay)))
 
 ;;;_ > icomplete-exhibit ()
 (defun icomplete-exhibit ()
@@ -235,6 +298,12 @@
 Should be run via minibuffer `post-command-hook'.  See `icomplete-mode'
 and `minibuffer-setup-hook'."
   (when (and icomplete-mode (icomplete-simple-completing-p))
+    ;; Enable icomplete specific key bindings, if needed.
+    (when (and icomplete-cycle
+	       (not (eq (key-binding "\C-j") 'icomplete-this-match)))
+      (local-set-key "\C-j" 'icomplete-this-match)
+      (local-set-key "\C-s" 'icomplete-next-match)
+      (local-set-key "\C-r" 'icomplete-prev-match))
     (save-excursion
       (goto-char (point-max))
                                         ; Insert the match-status information:
@@ -274,6 +343,9 @@
 The display is updated with each minibuffer keystroke during
 minibuffer completion.
 
+A typical display looks like:
+    M-x loa[d-]{load-library | load-file | load-theme}
+
 Prospective completion suffixes (if any) are displayed, bracketed by
 one of \(), \[], or \{} pairs.  The choice of brackets is as follows:
 
@@ -286,96 +358,134 @@
 \(whether complete or not), or ` \[No matches]', if no eligible
 matches exist.  \(Keybindings for uniquely matched commands
 are exhibited within the square braces.)"
-
-  (let* ((md (completion--field-metadata (field-beginning)))
-	 (comps (completion-all-sorted-completions))
-         (last (if (consp comps) (last comps)))
-         (base-size (cdr last))
-         (open-bracket (if require-match "(" "["))
-         (close-bracket (if require-match ")" "]")))
-    ;; `concat'/`mapconcat' is the slow part.
-    (if (not (consp comps))
-        (format " %sNo matches%s" open-bracket close-bracket)
-      (if last (setcdr last nil))
-      (let* ((most-try
-              (if (and base-size (> base-size 0))
-                  (completion-try-completion
-                   name candidates predicate (length name) md)
-                ;; If the `comps' are 0-based, the result should be
-                ;; the same with `comps'.
-                (completion-try-completion
-                 name comps nil (length name) md)))
-	     (most (if (consp most-try) (car most-try)
-                     (if most-try (car comps) "")))
-             ;; Compare name and most, so we can determine if name is
-             ;; a prefix of most, or something else.
-	     (compare (compare-strings name nil nil
-				       most nil nil completion-ignore-case))
-	     (determ (unless (or (eq t compare) (eq t most-try)
-				 (= (setq compare (1- (abs compare)))
-				    (length most)))
-		       (concat open-bracket
-			       (cond
-				((= compare (length name))
-                                 ;; Typical case: name is a prefix.
-				 (substring most compare))
-				((< compare 5) most)
-				(t (concat "..." (substring most compare))))
-			       close-bracket)))
-	     ;;"-prospects" - more than one candidate
-	     (prospects-len (+ (length determ) 6 ;; take {,...} into account
-                               (string-width (buffer-string))))
-             (prospects-max
-              ;; Max total length to use, including the minibuffer content.
-              (* (+ icomplete-prospects-height
-                    ;; If the minibuffer content already uses up more than
-                    ;; one line, increase the allowable space accordingly.
-                    (/ prospects-len (window-width)))
-                 (window-width)))
-             (prefix-len
-              ;; Find the common prefix among `comps'.
-	      ;; We can't use the optimization below because its assumptions
-	      ;; aren't always true, e.g. when completion-cycling (bug#10850):
-	      ;; (if (eq t (compare-strings (car comps) nil (length most)
-	      ;; 			 most nil nil completion-ignore-case))
-	      ;;     ;; Common case.
-	      ;;     (length most)
-	      ;; Else, use try-completion.
-	      (let ((comps-prefix (try-completion "" comps)))
-		(and (stringp comps-prefix)
-		     (length comps-prefix)))) ;;)
-
-	     prospects most-is-exact comp limit)
-	(if (eq most-try t) ;; (or (null (cdr comps))
-	    (setq prospects nil)
-	  (while (and comps (not limit))
-	    (setq comp
-		  (if prefix-len (substring (car comps) prefix-len) (car comps))
-		  comps (cdr comps))
-	    (cond ((string-equal comp "") (setq most-is-exact t))
-		  ((member comp prospects))
-		  (t (setq prospects-len
-                           (+ (string-width comp) 1 prospects-len))
-		     (if (< prospects-len prospects-max)
-			 (push comp prospects)
-		       (setq limit t))))))
-        ;; Restore the base-size info, since completion-all-sorted-completions
-        ;; is cached.
-        (if last (setcdr last base-size))
-	(if prospects
+  (unless icomplete-matches
+    ;; Re-compute the matches.
+    (let* ((md (completion--field-metadata (field-beginning)))
+	   (comps (completion-all-sorted-completions))
+	   (last (if (consp comps) (last comps)))
+	   (base-size (cdr last)))
+      (when (consp comps)
+	(if last (setcdr last nil))
+	(let* ((most-try
+		(if (and base-size (> base-size 0))
+		    (completion-try-completion
+		     name candidates predicate (length name) md)
+		  ;; If the `comps' are 0-based, the result should be
+		  ;; the same with `comps'.
+		  (completion-try-completion
+		   name comps nil (length name) md)))
+	       (most (if (consp most-try) (car most-try)
+		       (if most-try name ""))))
+	  ;; Cache results for use with `icomplete-this-match',
+	  ;; `icomplete-next-match' and `icomplete-prev-match'.
+	  (setq icomplete-name name)
+	  (setq icomplete-matches (nconc (butlast comps) (list (car last))))
+	  ;; If prefix is itself an exact match, move it to the front of
+	  ;; list of matches.
+	  (let ((prefix (let ((comps-prefix (try-completion "" comps)))
+			  (or (and (stringp comps-prefix) comps-prefix) ""))))
+	    (when (member prefix icomplete-matches)
+	      (setq icomplete-matches (cons prefix
+					    (delete prefix icomplete-matches)))))
+	  (setq icomplete-most-try most-try)
+	  ;; Compare name and most, so we can determine if name is
+	  ;; a prefix of most, or something else.
+	  (setq icomplete-try
+		(let ((compare (compare-strings name nil nil
+						most nil nil
+						completion-ignore-case)))
+		  (unless (or (eq t compare) (eq t most-try)
+			      (= (setq compare (1- (abs compare)))
+				 (length most)))
+		    (cond
+		     ((= compare (length name))
+		      ;; Typical case: name is a prefix.
+		      (substring most compare))
+		     ((< compare 5) most)
+		     (t (concat "..." (substring most compare)))))))
+	  ;; Restore the base-size info, since
+	  ;; `completion-all-sorted-completions' is cached.
+	  (if last (setcdr last base-size))))))
+  (if (not icomplete-matches)
+      (nth 6 icomplete-decorations)
+    (let* ((determ (and icomplete-try
+			(concat (nth 4 icomplete-decorations)
+				icomplete-try
+				(nth 5 icomplete-decorations)))))
+      (if (not (eq icomplete-most-try t))
+	  (let* ((comps icomplete-matches)
+		 (prospects-max
+		  ;; Max total length to use, including the
+		  ;; minibuffer content.
+		  (* (+ icomplete-prospects-height
+			;; If the minibuffer content already uses up
+			;; more than one line, increase the
+			;; allowable space accordingly.
+			(/ (string-width (buffer-string)) (window-width)))
+		     (window-width)))
+		 (prospects-len (string-width (buffer-string)))
+		 prospects limit first)
+	    (setq prospects-len
+		  (+ prospects-len (string-width (or determ ""))
+		     ;; Account for { | ...}
+		     (string-width (nth 0 icomplete-decorations))
+		     (string-width (nth 3 icomplete-decorations))
+		     (string-width (nth 1 icomplete-decorations))))
+	    ;; Decorate first of the prospects but remember to make a
+	    ;; copy.  This is to ensure correct behaviour when matches
+	    ;; are cycled with C-s or C-r.
+	    (setq first (copy-sequence (pop comps)))
+	    (put-text-property 0 (length first) 'face
+			       'icomplete-first-match first)
+	    (setq prospects-len (+ prospects-len (string-width first)))
+	    (while (and comps (not limit))
+	      (let* ((p (concat (nth 2 icomplete-decorations) (pop comps))))
+		(setq prospects-len (+ (string-width p) prospects-len))
+		(if (< prospects-len prospects-max)
+		    (setq prospects (concat prospects p))
+		  (setq limit t))))
 	    (concat determ
-		    "{"
-		    (and most-is-exact ",")
-		    (mapconcat 'identity (nreverse prospects) ",")
-		    (and limit ",...")
-		    "}")
-	  (concat determ
-		  " [Matched"
-		  (let ((keys (and icomplete-show-key-bindings
-				   (commandp (intern-soft most))
-				   (icomplete-get-keys most))))
-		    (if keys (concat "; " keys) ""))
-		  "]"))))))
+		    (nth 0 icomplete-decorations)
+		    (concat first prospects)
+		    (and limit (nth 3 icomplete-decorations))
+		    (nth 1 icomplete-decorations)))
+	(concat determ
+		(format (nth 7 icomplete-decorations)
+			(let* ((most (if (consp icomplete-most-try)
+					 (car icomplete-most-try)
+				       (if icomplete-most-try name "")))
+			       (keys (and icomplete-show-key-bindings
+					  (icomplete-get-keys most))))
+			  (if keys (concat "; " keys) ""))))))))
+
+(defun icomplete-this-match ()
+  "Input first of the displayed matches to minibuffer prompt.
+See `icomplete-matches'."
+  (interactive)
+  (delete-region (minibuffer-prompt-end) (point))
+  (when icomplete-matches
+    (insert (car icomplete-matches)))
+  (exit-minibuffer))
+
+(defun icomplete-next-match ()
+  "Shift displayed matches to the left.
+Second of displayed matches is promoted to first position and can
+be selected with `icomplete-this-match'."
+  (interactive)
+  (let ((first (pop icomplete-matches)))
+    (setq icomplete-matches (nconc icomplete-matches (list first)))))
+
+(defun icomplete-prev-match ()
+  "Shift displayed matches to the right.
+Last of displayed matches (which could be truncated from display)
+is promoted to first position and can be selected with
+`icomplete-this-match'."
+  (interactive)
+  (let* ((last-but-one (last icomplete-matches 2))
+	 (last (cdr last-but-one)))
+    (when last
+      (setcdr last-but-one nil)
+      (push (car last) icomplete-matches))))
 
 ;;_* Local emacs vars.
 ;;Local variables:

=== modified file 'lisp/replace.el'
--- lisp/replace.el	2012-10-16 23:27:40 +0000
+++ lisp/replace.el	2012-10-23 12:44:54 +0000
@@ -585,27 +585,32 @@
 When PROMPT doesn't end with a colon and space, it adds a final \": \".
 If DEFAULTS is non-nil, it displays the first default in the prompt.
 
-Non-nil optional arg DEFAULTS is a string or a list of strings that
-are prepended to a list of standard default values, which include the
-string at point, the last isearch regexp, the last isearch string, and
-the last replacement regexp.
+Optional arg DEFAULTS is a string or a list of strings that are
+prepended to a list of standard default values, which include the
+tag at point, the last isearch regexp, the last isearch string,
+and the last replacement regexp.
 
 Non-nil HISTORY is a symbol to use for the history list.
 If HISTORY is nil, `regexp-history' is used."
-  (let* ((default (if (consp defaults) (car defaults) defaults))
-	 (defaults
+  (let* ((defaults
 	   (append
 	    (if (listp defaults) defaults (list defaults))
-	    (list (regexp-quote
-		   (or (funcall (or find-tag-default-function
-				    (get major-mode 'find-tag-default-function)
-				    'find-tag-default))
-		       ""))
-		  (car regexp-search-ring)
-		  (regexp-quote (or (car search-ring) ""))
-		  (car (symbol-value
-			query-replace-from-history-variable)))))
+	    (list
+	     ;; Regexp for tag at point.
+	     (let* ((tagf (or find-tag-default-function
+			      (get major-mode 'find-tag-default-function)
+			      'find-tag-default))
+		    (tag (funcall tagf)))
+	       (cond ((not tag) "")
+		     ((eq tagf 'find-tag-default)
+		      (format "\\_<%s\\_>" (regexp-quote tag)))
+		     (t (regexp-quote tag))))
+	     (car regexp-search-ring)
+	     (regexp-quote (or (car search-ring) ""))
+	     (car (symbol-value
+		   query-replace-from-history-variable)))))
 	 (defaults (delete-dups (delq nil (delete "" defaults))))
+	 (default (car defaults))
 	 ;; Do not automatically add default to the history for empty input.
 	 (history-add-new-input nil)
 	 (input (read-from-minibuffer


[-- Attachment #3: Type: text/plain, Size: 2561 bytes --]



Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> 1. The icomplete candidates are comma separated but WITHOUT spaces.  It
>>    makes readability difficult.
>>    So introduce `icomplete-decorations' which can be a copy of
>>    `ido-decorations' to begin with.  May be the decorations could be
>>    extracted to some other file (minibuffer.el?) and commonly shared by
>>    both ido and icomplete.
>
> The lack of space is on purpose, to save screen real-estate, so it
> indeed needs to be customizable.  But I don't have a strong opinion on
> what the default value should be.
>
>> 2. Support for cycling via C-s and C-r, highlighting and selection of
>>    current head (all much like ido-mode)
>
> Not sure what "highlighting" refers to; if you mean to put the first
> element in bold, then yes, that fine.
>
> Selection of current head can be done with minibuffer-force-complete
> (not bound to any key by default), tho it doesn't exit.  But it should be
> easy to add a minibuffer-force-complete-and-exit.
>
> To get you started the patch below adds a keymap to icomplete.
>
> Cycling would also be useful and should similarly be easy to add (it
> just needs to play around with (completion-all-sorted-completions) and
> store it back via completion--cache-all-sorted-completions, like
> minibuffer-force-complete does).
>
>> I can prepare a patch for (1).
>
> We're in feature freeze, so please wait a few weeks before sending
> your patch.
>
>
>         Stefan
>
>
>
> === modified file 'lisp/icomplete.el'
> *** lisp/icomplete.el	2012-06-22 17:37:28 +0000
> --- lisp/icomplete.el	2012-10-23 19:30:20 +0000
> ***************
> *** 169,174 ****
> --- 169,179 ----
>   Icomplete does not operate with any specialized completion tables
>   except those on this list.")
>   
> + (defvar icomplete-minibuffer-map
> +   (let ((map (make-sparse-keymap)))
> +     (define-key map [?\M-\t] 'minibuffer-force-complete)
> +     map))
> + 
>   ;;;_ > icomplete-mode (&optional prefix)
>   ;;;###autoload
>   (define-minor-mode icomplete-mode
> ***************
> *** 208,213 ****
> --- 213,220 ----
>   Usually run by inclusion in `minibuffer-setup-hook'."
>     (when (and icomplete-mode (icomplete-simple-completing-p))
>       (set (make-local-variable 'completion-show-inline-help) nil)
> +     (use-local-map (make-composed-keymap icomplete-minibuffer-map
> + 					 (current-local-map)))
>       (add-hook 'pre-command-hook
>   	      (lambda () (let ((non-essential t))
>                         (run-hooks 'icomplete-pre-command-hook)))
>
>
>
>
>

--