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

[Jambunathan K <kjambunathan@gmail.com>]

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


I am attaching a second revision of the earlier patch.  

It is not that patch is final.  It is worthy of further discussion and
experimentation.

Changes are in minibuffer.el and icomplete.el.

1. `minibuffer-summarize-completions' is meant as a replacement for
   `icomplete-exhibit'.  As the name suggests, it is meant to go in to
    minibuffer.el.  It's presence in minibuffer.el proved problematic
   (details in followup mail) and I had to move it to icomplete.el.

   TODO: Handle key binding hints for sole command matches?  Is it
   really necessary.  It seems so `old school'.  May be it made sense
   when Emacs /did not/ provide key binding hints.

2. There is a display overlay that is used in minibuffer (see
   `minibuffer-message').  There is a counterpart in icomplete.el named
   `icomplete-overlay'. 

   I am wondering whether `icomplete-overlay' could be thrown away and
   have it use, yet to be introduced `minibuffer-overlay'.  Should this
   be buffer-local etc etc. I am not sure of.

   I can exchange notes if there is some interest around this area.

3. Apropos `minibuffer-force-complete-and-exit' and `confirm' etc.

    >> +(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))
    >
    > I think it should still call test-completion and obey
    > minibuffer-completion-confirm if that test fails.

  Can `test-completion' fail if the prompt is filled from valid
  candidates? Remember, `minibuffer-force-and-complete-and-exit' doesn't
  rely on manual-typing at the prompt.


--8<---------------cut here---------------start------------->8---


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: bug12638-rev2-20121102.diff --]
[-- Type: text/x-diff, Size: 19936 bytes --]

=== modified file 'lisp/icomplete.el'
--- lisp/icomplete.el	2012-06-22 17:37:28 +0000
+++ lisp/icomplete.el	2012-11-02 11:12:09 +0000
@@ -71,6 +71,9 @@
 (make-obsolete-variable
  'icomplete-prospects-length 'icomplete-prospects-height "23.1")
 
+(defvar icomplete-separator " | "
+  "String used by icomplete to separate alternatives in the minibuffer.")
+
 ;;;_* User Customization variables
 (defcustom icomplete-prospects-height
   ;; 20 is an estimated common size for the prompt + minibuffer content, to
@@ -102,7 +105,14 @@
   :type 'boolean
   :group 'icomplete)
 
-(defcustom icomplete-minibuffer-setup-hook nil
+(defcustom icomplete-minibuffer-setup-hook
+  '((lambda ()
+      (define-key icomplete-minibuffer-map
+	"\C-j" 'minibuffer-force-complete-and-exit)
+      (define-key icomplete-minibuffer-map
+	"\C-s" 'minibuffer-forward-sorted-completions)
+      (define-key icomplete-minibuffer-map
+	"\C-r" 'minibuffer-backward-sorted-completions)))
   "Icomplete-specific customization of minibuffer setup.
 
 This hook is run during minibuffer setup if icomplete is active.
@@ -118,6 +128,21 @@
 will constrain Emacs to a maximum minibuffer height of 3 lines when
 icompletion is occurring."
   :type 'hook
+  :version "24.3"
+  :group 'icomplete)
+
+(defcustom icomplete-hide-common-prefix t
+  "When non-nil, hide common prefix (if any) from completion candidates.
+Default setting (typically) allows more candidates to be shown
+for given `icomplete-prospects-height'.  When nil, show
+candidates in full."
+  :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)
 
 
@@ -169,6 +194,11 @@
 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
@@ -207,7 +237,9 @@
   "Run in minibuffer on activation to establish incremental completion.
 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)
+    ;; (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)))
@@ -227,155 +259,192 @@
   "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 '(minibuffer-force-complete-and-exit minibuffer-forward-sorted-completions
+						    minibuffer-backward-sorted-completions))
+    ;; Current command does not belong to icomplete-mode.
+    ;; Delete the overlay.
+    (delete-overlay icomplete-overlay)))
+
+(defun minibuffer-summarize-completions (&optional separator max-width
+						   first-match-face
+						   strip-common-substring)
+  "Summarize minibuffer completion and return it as a string.
+
+Return one of \"[No match]\", \"[Sole completion]\" or a string
+of the form:
+
+    \"\(TAB-COMPL\){CAND-1 SEPARATOR CAND-2 ... CAND-N SEPARATOR CONTD}\"
+
+CAND-1, CAND-2 etc are completion candidates.
+
+TAB-COMPL, when present, indicates the string to which next
+`minibuffer-complete' will complete to.
+
+CONTD (string \"...\"), when present, indicates that not all
+completions are shown.  To disclose completions that are hidden,
+use `minibuffer-forward-sorted-completions' and
+`minibuffer-backward-sorted-completions'.
+
+SEPARATOR is a string to separate completions.  If nil, use \" | \".
+
+MAX-WIDTH is width in characters, as a multiple of window width,
+to which summary string is capped.  If MAX-WIDTH is not a
+multiple of `\(window-width\)', it is increased suitably.  If it
+is nil (or in any case), it is forcibly increased to just
+accommodate minibuffer contents.
+
+FIRST-MATCH-FACE is a face to be applied to first of the matches,
+which can be input with `minibuffer-force-complete-and-exit'.  If
+nil, use 'bold face.
+
+STRIP-COMMON-SUBSTRING, a boolean, controls whether how
+completion candidates are displayed.  If nil, show completions in
+full.  Otherwise, strip common prefix of all
+completions (obtained with `try-completion') from completions."
+  
+  ;; Set defaults for optional params.
+  (setq separator (or separator " | "))
+  ;; Ensure max-width is big enough to hold current minibuffer
+  ;; content.  Stretch max-width to a multiple of window width.
+  (let* ((content-width (string-width (buffer-string))))
+    (setq max-width (max content-width (or max-width 0)))
+    (setq max-width
+	  (let* ((normalized-height (/ max-width (window-width)))
+		 (normalized-width (* normalized-height (window-width))))
+	    (if (< normalized-height max-width)
+		(+ normalized-width (window-width))
+	      normalized-width))))
+  (setq first-match-face (or first-match-face 'bold))
+  (let* ((beg (field-beginning))
+         (end (field-end))
+         (string (buffer-substring beg end))
+         (md (completion--field-metadata beg))
+         (try-comp (completion-try-completion
+		    string
+		    minibuffer-completion-table
+		    minibuffer-completion-predicate
+		    (- (point) beg)
+		    md)))
+    (cond
+     ;; No match.
+     ((null try-comp)
+      "[No match]")
+     ;; Sole completion.  Exact and unique match.
+     ((eq t try-comp)
+      "[Sole completion]")
+     (t
+      ;; `completed' should be t if some completion was done, which doesn't
+      ;; include simply changing the case of the entered string.  However,
+      ;; for appearance, the string is rewritten if the case changes.
+      (let* ((comp-pos (cdr try-comp))
+             (completion (car try-comp))
+	     (compare (compare-strings completion nil nil
+				       string nil nil
+				       completion-ignore-case))
+             (completed (not (eq t compare)))
+	     (exact (test-completion completion
+	     			     minibuffer-completion-table
+	     			     minibuffer-completion-predicate))
+	     (comps (completion-all-sorted-completions))
+	     ;; Compute common substring, if user wants it stripped from
+	     ;; completion candidates.
+	     (common-substring (when strip-common-substring
+				 (let ((common (try-completion "" comps)))
+				   (when (stringp common) common))))
+	     (common-substring-len (when common-substring
+				     (length common-substring)))
+	     width)
+	;; Trim completion, when possible.
+	(if (not completed)
+	    (setq completion nil)
+	  (setq compare (1- (abs compare)))
+	  (setq completion (if (= compare (length string))
+			       (substring completion compare)
+			     (concat "..." completion))))
+
+	;; Account for various filler characters.
+	(setq width (string-width (concat (buffer-string)
+					  "(...)" "{" separator "..." "}")))
+	;; Add completion.
+	(when completion
+	  (setq width (+ width (string-width completion)))
+	  (unless (< width max-width)
+	    (setq completion nil)))
+
+	;; Add completion candidates.
+	(let* ((last (last comps))
+	       (base-size (cdr last))
+	       first limit prospects)
+	  ;; Remove the base-size tail to get a properly
+	  ;; nil-terminated list that is amenable for easy iteration.
+	  (when last (setcdr last nil))
+
+	  ;; Decorate the first of completion with requested face.
+	  (setq first (copy-sequence (pop comps)))
+	  (put-text-property 0 (length first) 'face first-match-face first)
+	  (setq first (if (not common-substring-len) first
+			(substring first common-substring-len)))
+	  (setq width (+ width (string-width first)))
+	  (when (< width max-width)
+	    (setq prospects first))
+
+	  ;; Rest of the completions.
+	  (while (and comps (not limit))
+	    (let* ((comp (pop comps)))
+	      (setq comp (concat separator
+				 (if (not common-substring-len) comp
+				   (substring comp common-substring-len))))
+	      (setq width (+ width (string-width comp)))
+	      (if (< width max-width)
+		  (setq prospects (concat prospects comp))
+		(setq prospects (concat prospects separator "..."))
+		(setq limit t))))
+
+	  ;; Restore the base-size info, since
+	  ;; `completion-all-sorted-completions' is cached.
+	  (when last (setcdr last base-size))
+
+	  ;; Return summary output.
+	  (concat (and completion (concat "(" completion ")"))
+		  (and prospects (concat "{" prospects "}")))))))))
 
 ;;;_ > icomplete-exhibit ()
 (defun icomplete-exhibit ()
   "Insert icomplete completions display.
 Should be run via minibuffer `post-command-hook'.  See `icomplete-mode'
 and `minibuffer-setup-hook'."
-  (when (and icomplete-mode (icomplete-simple-completing-p))
-    (save-excursion
-      (goto-char (point-max))
+  (if (and icomplete-mode (icomplete-simple-completing-p))
+      (save-excursion
+	(goto-char (point-max))
                                         ; Insert the match-status information:
-      (if (and (> (point-max) (minibuffer-prompt-end))
-	       buffer-undo-list		; Wait for some user input.
-	       (or
-		;; Don't bother with delay after certain number of chars:
-		(> (- (point) (field-beginning)) icomplete-max-delay-chars)
-		;; Don't delay if alternatives number is small enough:
-		(and (sequencep minibuffer-completion-table)
-		     (< (length minibuffer-completion-table)
-			icomplete-delay-completions-threshold))
-		;; Delay - give some grace time for next keystroke, before
-		;; embarking on computing completions:
-		(sit-for icomplete-compute-delay)))
-	  (let ((text (while-no-input
-			 (icomplete-completions
-			  (field-string)
-			  minibuffer-completion-table
-			  minibuffer-completion-predicate
-                         (not minibuffer-completion-confirm))))
-		(buffer-undo-list t)
-		deactivate-mark)
-	    ;; Do nothing if while-no-input was aborted.
-	    (when (stringp text)
-              (move-overlay icomplete-overlay (point) (point) (current-buffer))
-              ;; The current C cursor code doesn't know to use the overlay's
-              ;; marker's stickiness to figure out whether to place the cursor
-              ;; before or after the string, so let's spoon-feed it the pos.
-              (put-text-property 0 1 'cursor t text)
-              (overlay-put icomplete-overlay 'after-string text)))))))
-
-;;;_ > icomplete-completions (name candidates predicate require-match)
-(defun icomplete-completions (name candidates predicate require-match)
-  "Identify prospective candidates for minibuffer completion.
-
-The display is updated with each minibuffer keystroke during
-minibuffer completion.
-
-Prospective completion suffixes (if any) are displayed, bracketed by
-one of \(), \[], or \{} pairs.  The choice of brackets is as follows:
-
-  \(...) - a single prospect is identified and matching is enforced,
-  \[...] - a single prospect is identified but matching is optional, or
-  \{...} - multiple prospects, separated by commas, are indicated, and
-          further input is required to distinguish a single one.
-
-The displays for unambiguous matches have ` [Matched]' appended
-\(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
-	    (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) ""))
-		  "]"))))))
+	(if (and (> (point-max) (minibuffer-prompt-end))
+		 buffer-undo-list	; Wait for some user input.
+		 (or
+		  ;; Don't bother with delay after certain number of chars:
+		  (> (- (point) (field-beginning)) icomplete-max-delay-chars)
+		  ;; Don't delay if alternatives number is small enough:
+		  (and (sequencep minibuffer-completion-table)
+		       (< (length minibuffer-completion-table)
+			  icomplete-delay-completions-threshold))
+		  ;; Delay - give some grace time for next keystroke, before
+		  ;; embarking on computing completions:
+		  (sit-for icomplete-compute-delay)))
+	    (let ((text (while-no-input
+			  (minibuffer-summarize-completions
+			   icomplete-separator
+			   (* icomplete-prospects-height (window-width))
+			   'icomplete-first-match
+			   icomplete-hide-common-prefix)))
+		  (buffer-undo-list t)
+		  deactivate-mark)
+	      ;; Do nothing if while-no-input was aborted.
+	      (when (stringp text)
+		(move-overlay icomplete-overlay (point) (point) (current-buffer))
+		;; The current C cursor code doesn't know to use the overlay's
+		;; marker's stickiness to figure out whether to place the cursor
+		;; before or after the string, so let's spoon-feed it the pos.
+		(put-text-property 0 1 'cursor t text)
+		(overlay-put icomplete-overlay 'after-string text)))))))
 
 ;;_* Local emacs vars.
 ;;Local variables:

=== modified file 'lisp/minibuffer.el'
--- lisp/minibuffer.el	2012-10-28 19:07:52 +0000
+++ lisp/minibuffer.el	2012-11-02 07:57:15 +0000
@@ -1108,12 +1108,68 @@
             (let ((hist (symbol-value minibuffer-history-variable)))
               (setq all (sort all (lambda (c1 c2)
                                     (> (length (member c1 hist))
-                                       (length (member c2 hist))))))))
+                                       (length (member c2 hist)))))))
+	    ;; Bring exact (but not unique) match to the front.
+	    (when (member string all)
+	      (push string all))
+
+	    ;; Delete duplicates.
+	    (delete-dups all))
           ;; Cache the result.  This is not just for speed, but also so that
           ;; repeated calls to minibuffer-force-complete can cycle through
           ;; all possibilities.
           (completion--cache-all-sorted-completions (nconc all base-size))))))
 
+(defun minibuffer-force-complete-and-exit ()
+  "Complete the minibuffer with first of the matches and exit."
+  (interactive)
+  ;; FIXME: Need to deal with the extra-size issue here as well.
+  ;; FIXME: ~/src/emacs/t<M-TAB>/lisp/minibuffer.el completes to
+  ;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
+  (let* ((start (copy-marker (field-beginning)))
+         (end (field-end))
+         ;; (md (completion--field-metadata start))
+         (all (completion-all-sorted-completions))
+         (base (+ start (or (cdr (last all)) 0))))
+    (cond
+     ((not (consp all))
+      (completion--message
+       (if all "No more completions" "No completions")))
+     ((not (consp (cdr all)))
+      (let ((done (equal (car all) (buffer-substring-no-properties base end))))
+        (unless done (completion--replace base end (car all)))
+        (completion--done (buffer-substring-no-properties start (point))
+                          'finished (when done "Sole completion"))
+	(exit-minibuffer)))
+     (t
+      (completion--replace base end (car all))
+      (completion--done (buffer-substring-no-properties start (point))
+			'sole)
+      (exit-minibuffer)))))
+
+(defun minibuffer-forward-sorted-completions ()
+  "Step forward completions by one entry.
+Second entry becomes the first and can be selected with
+`minibuffer-force-complete-and-exit'."
+  (interactive)
+  (let* ((comps (completion-all-sorted-completions))
+	 (last (last comps)))
+    (setcdr last (cons (car comps) (cdr last)))
+    (completion--cache-all-sorted-completions (cdr comps))))
+
+(defun minibuffer-backward-sorted-completions ()
+  "Step backward completions by one entry.
+Last entry becomes the first and can be selected with
+`minibuffer-force-complete-and-exit'."
+  (interactive)
+  (let* ((comps (completion-all-sorted-completions))
+	 (last-but-one (last comps 2))
+	 (last (cdr last-but-one)))
+    (when last
+      (setcdr last-but-one (cdr last))
+      (push (car last) comps)
+      (completion--cache-all-sorted-completions comps))))
+
 (defun minibuffer-force-complete ()
   "Complete the minibuffer to an exact match.
 Repeated uses step through the possible completions."


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


--8<---------------cut here---------------end--------------->8---