scratch/icomplete-vertical-mode-improvements 776633a 01/10: Improve icomplete-vertical-mode

[João Távora]

branch: scratch/icomplete-vertical-mode-improvements
commit 776633a5d46e64b9c3d4bb8b6c71d357b5226d3d
Author: João Távora <joaotavora@gmail.com>
Commit: João Távora <joaotavora@gmail.com>

    Improve icomplete-vertical-mode
    
    * lisp/icomplete.el (simple, cl-lib): Require it.
    (icomplete-selected-match): New face.
    (icomplete-rotate): New variable.
    (icomplete--comp-predecessors, icomplete--last-selected): New
    helper variable.
    (icomplete-forward-completions, icomplete-backward-completions):
    Rework
    (icomplete-minibuffer-setup): Initialize icomplete--last-selected.
    (icomplete--render-vertical): New helper.
    (icomplete--vertical-minibuffer-setup): Set icomplete-rotate to nil.
    (icomplete-exhibit): Initialize icomplete--comp-predecessors.
    (icomplete-completions): Rework.  Call icomplete--render-vertical.
    
    * lisp/simple.el (max-mini-window-height): New helper.
    (display-message-or-buffer): Use it.
---
 lisp/icomplete.el | 356 +++++++++++++++++++++++++++++++++---------------------
 lisp/simple.el    |  17 +--
 2 files changed, 225 insertions(+), 148 deletions(-)

diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 91bbb60..60efa88 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -50,6 +50,8 @@
 ;;; Code:
 
 (require 'rfn-eshadow) ; rfn-eshadow-overlay
+(require 'simple) ; max-mini-window-height
+(require 'cl-lib)
 
 (defgroup icomplete nil
   "Show completions dynamically in minibuffer."
@@ -99,6 +101,10 @@ Otherwise this should be a list of the completion tables 
(e.g.,
   "Face used by Icomplete for highlighting first match."
   :version "24.4")
 
+(defface icomplete-selected-match '((t :inherit highlight))
+  "Face used by `icomplete-vertical-mode' for the selected candidate."
+  :version "24.4")
+
 ;;;_* User Customization variables
 (defcustom icomplete-prospects-height 2
   ;; We used to compute how many lines 100 characters would take in
@@ -140,6 +146,8 @@ icompletion is occurring."
   :type 'hook
   :group 'icomplete)
 
+(defvar icomplete-rotate t
+  "If non-nil, cycle around from last completion to first.")
 
 ;;;_* Initialization
 
@@ -215,6 +223,13 @@ the default otherwise."
   ;; We're not at all interested in cycling here (bug#34077).
   (minibuffer-force-complete nil nil 'dont-cycle))
 
+;; Both these variables are only meaningful if `icomplete-rotation' is
+;; nil.
+(defvar icomplete--comp-predecessors nil
+  "When completions to list before the selected one.")
+(defvar icomplete--last-selected nil
+  "Last completion selected.")
+
 (defun icomplete-forward-completions ()
   "Step forward completions by one entry.
 Second entry becomes the first and can be selected with
@@ -223,10 +238,14 @@ Second entry becomes the first and can be selected with
   (let* ((beg (icomplete--field-beg))
          (end (icomplete--field-end))
          (comps (completion-all-sorted-completions beg end))
-        (last (last comps)))
-    (when comps
-      (setcdr last (cons (car comps) (cdr last)))
-      (completion--cache-all-sorted-completions beg end (cdr comps)))))
+         (last (last comps)))
+    (when (consp (cdr comps))
+      (cond (icomplete-rotate
+             (setcdr (last comps) (cons (pop comps) (cdr last))))
+            (t
+             (push (pop comps) icomplete--comp-predecessors)))
+      (completion--cache-all-sorted-completions beg end comps))
+    (setq icomplete--last-selected nil)))
 
 (defun icomplete-backward-completions ()
   "Step backward completions by one entry.
@@ -236,12 +255,16 @@ Last entry becomes the first and can be selected with
   (let* ((beg (icomplete--field-beg))
          (end (icomplete--field-end))
          (comps (completion-all-sorted-completions beg end))
-        (last-but-one (last comps 2))
-        (last (cdr last-but-one)))
-    (when (consp last)               ; At least two elements in comps
-      (setcdr last-but-one (cdr last))
-      (push (car last) comps)
-      (completion--cache-all-sorted-completions beg end comps))))
+        last-but-one)
+    (cond ((and icomplete-rotate
+                (consp (cdr (setq last-but-one (last comps 2)))))
+           ;; At least two elements in comps
+           (push (car (cdr last-but-one)) comps)
+           (setcdr last-but-one (cdr (cdr last-but-one))))
+          (icomplete--comp-predecessors
+           (push (pop icomplete--comp-predecessors) comps)))
+    (completion--cache-all-sorted-completions beg end comps)
+    (setq icomplete--last-selected nil)))
 
 ;;; Helpers for `fido-mode' (or `ido-mode' emulation)
 ;;;
@@ -449,6 +472,7 @@ Usually run by inclusion in `minibuffer-setup-hook'."
   (when (and icomplete-mode (icomplete-simple-completing-p))
     (setq-local icomplete--initial-input (icomplete--field-string))
     (setq-local completion-show-inline-help nil)
+    (setq icomplete--last-selected nil)
     (use-local-map (make-composed-keymap icomplete-minibuffer-map
                                         (current-local-map)))
     (add-hook 'pre-command-hook  #'icomplete-pre-command-hook  nil t)
@@ -574,9 +598,10 @@ Usually run by inclusion in `minibuffer-setup-hook'."
   (use-local-map (make-composed-keymap icomplete-vertical-mode-minibuffer-map
                                        (current-local-map)))
   (setq-local icomplete-separator "\n"
+              icomplete-rotate nil
               icomplete-hide-common-prefix nil
               ;; Ask `icomplete-completions' to return enough completions 
candidates.
-              icomplete-prospects-height 25
+              icomplete-prospects-height 10
               redisplay-adhoc-scroll-in-resize-mini-windows nil))
 
 ;;;###autoload
@@ -612,6 +637,8 @@ Should be run via minibuffer `post-command-hook'.
 See `icomplete-mode' and `minibuffer-setup-hook'."
   (when (and icomplete-mode
              (icomplete-simple-completing-p)) ;Shouldn't be necessary.
+    (unless completion-all-sorted-completions
+      (setq icomplete--comp-predecessors nil))
     (let ((saved-point (point)))
       (save-excursion
         (goto-char (point-max))
@@ -666,6 +693,57 @@ See `icomplete-mode' and `minibuffer-setup-hook'."
               (put-text-property 0 1 'cursor t text)
               (overlay-put icomplete-overlay 'after-string text))))))))
 
+(defun icomplete--render-vertical (comps)
+  ;; First attempt to keep selection stable.
+  (when (and icomplete--last-selected
+             (null icomplete-rotate))
+    (cl-loop
+     with preds
+     for (comp . rest) on comps
+     when (equal comp icomplete--last-selected)
+     do
+     (setq icomplete--comp-predecessors preds
+           comps (cons comp rest))
+     (completion--cache-all-sorted-completions
+      (icomplete--field-beg)
+      (icomplete--field-end)
+      comps)
+     and return nil
+     do (push comp preds)))
+  (cl-loop
+   with preds = (and (null icomplete-rotate) icomplete--comp-predecessors)
+   with max-lines = (1- (min icomplete-prospects-height
+                             (max-mini-window-height)))
+   with succs = (cdr comps)
+   with half = (truncate max-lines 2)
+   with max-before = (+ half
+                        (- half
+                           (cl-loop for (_ . r) on comps
+                                    repeat half
+                                    while (listp r)
+                                    count 1)))
+   with before = (list)
+   repeat max-lines
+   for neighbour = nil
+   if (and preds (> max-before 0)) do
+   (push (setq neighbour (pop preds)) before)
+   (cl-decf max-before)
+   else if (consp succs) collect
+   (setq neighbour (pop succs)) into after
+   while neighbour
+   finally
+   (cl-return
+    (concat " " icomplete-separator
+            (mapconcat
+             #'identity
+             (nconc before
+                    (list
+                     (setq icomplete--last-selected
+                           (propertize (car comps) 'face
+                                       'icomplete-selected-match)))
+                    after)
+             icomplete-separator)))))
+
 ;;;_ > icomplete-completions (name candidates predicate require-match)
 (defun icomplete-completions (name candidates predicate require-match)
   "Identify prospective candidates for minibuffer completion.
@@ -679,7 +757,7 @@ 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.
+         further input is required to distinguish a single one.
 
 If there are multiple possibilities, `icomplete-separator' separates them.
 
@@ -687,142 +765,140 @@ The displays for unambiguous matches have ` [Matched]' 
appended
 \(whether complete or not), or ` [No matches]', if no eligible
 matches exist."
   (let* ((ignored-extension-re
-          (and minibuffer-completing-file-name
-               icomplete-with-completion-tables
-               completion-ignored-extensions
-               (concat "\\(?:\\`\\.\\./\\|"
-                       (regexp-opt completion-ignored-extensions)
-                       "\\)\\'")))
-         (minibuffer-completion-table candidates)
+         (and minibuffer-completing-file-name
+              icomplete-with-completion-tables
+              completion-ignored-extensions
+              (concat "\\(?:\\`\\.\\./\\|"
+                      (regexp-opt completion-ignored-extensions)
+                      "\\)\\'")))
+        (minibuffer-completion-table candidates)
         (minibuffer-completion-predicate
-          (if ignored-extension-re
-              (lambda (cand)
-                (and (not (string-match ignored-extension-re cand))
-                     (or (null predicate)
-                         (funcall predicate cand))))
-            predicate))
+         (if ignored-extension-re
+             (lambda (cand)
+               (and (not (string-match ignored-extension-re cand))
+                    (or (null predicate)
+                        (funcall predicate cand))))
+           predicate))
         (md (completion--field-metadata (icomplete--field-beg)))
         (comps (icomplete--sorted-completions))
-         (last (if (consp comps) (last comps)))
-         (base-size (cdr last))
-         (open-bracket (if require-match "(" "["))
-         (close-bracket (if require-match ")" "]")))
+        (open-bracket (if require-match "(" "["))
+        (close-bracket (if require-match ")" "]")))
     ;; `concat'/`mapconcat' is the slow part.
     (if (not (consp comps))
        (progn ;;(debug (format "Candidates=%S field=%S" candidates name))
          (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))
-            (ellipsis (if (char-displayable-p ?…) "…" "..."))
-            (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))
-                                ;; Don't bother truncating if it doesn't gain
-                                ;; us at least 2 columns.
-                               ((< compare (+ 2 (string-width ellipsis))) most)
-                               (t (concat ellipsis (substring most compare))))
-                              close-bracket)))
-            ;;"-prospects" - more than one candidate
-            (prospects-len (+ (string-width
-                               (or determ (concat open-bracket close-bracket)))
-                              (string-width icomplete-separator)
-                              (+ 2 (string-width ellipsis)) ;; 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)))
-             ;; 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.
-            (prefix (when icomplete-hide-common-prefix
-                      (try-completion "" comps)))
-             (prefix-len
-             (and (stringp prefix)
-                   ;; Only hide the prefix if the corresponding info
-                   ;; is already displayed via `most'.
-                   (string-prefix-p prefix most t)
-                   (length prefix))) ;;)
-            prospects comp limit)
-       (if (or (eq most-try t) (not (consp (cdr comps))))
-           (setq prospects nil)
-         (when (member name comps)
-           ;; NAME is complete but not unique.  This scenario poses
-           ;; following UI issues:
-           ;;
-           ;; - When `icomplete-hide-common-prefix' is non-nil, NAME
-           ;;   is stripped empty.  This would make the entry
-           ;;   inconspicuous.
-           ;;
-           ;; - Due to sorting of completions, NAME may not be the
-           ;;   first of the prospects and could be hidden deep in
-           ;;   the displayed string.
-           ;;
-           ;; - Because of `icomplete-prospects-height' , NAME may
-           ;;   not even be displayed to the user.
-           ;;
-           ;; To circumvent all the above problems, provide a visual
-           ;; cue to the user via an "empty string" in the try
-           ;; completion field.
-           (setq determ (concat open-bracket "" close-bracket)))
-         ;; Compute prospects for display.
-         (while (and comps (not limit))
-           (setq comp
-                 (if prefix-len (substring (car comps) prefix-len) (car comps))
-                 comps (cdr comps))
-           (setq prospects-len
-                  (+ (string-width comp)
-                    (string-width icomplete-separator)
-                    prospects-len))
-           (if (< prospects-len prospects-max)
-               (push comp prospects)
-             (setq limit t))))
-       (setq prospects (nreverse prospects))
-       ;; Decorate first of the prospects.
-       (when prospects
-         (let ((first (copy-sequence (pop prospects))))
-           (put-text-property 0 (length first)
-                              'face 'icomplete-first-match first)
-           (push first prospects)))
-        ;; Restore the base-size info, since completion-all-sorted-completions
-        ;; is cached.
-        (if last (setcdr last base-size))
-       (if prospects
+      (if icomplete-vertical-mode
+         (icomplete--render-vertical comps)
+       (let* ((last (if (consp comps) (last comps)))
+              (base-size (cdr last))
+              (most-try
+               (progn
+                 (if last (setcdr last nil))
+                 (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))
+              (ellipsis (if (char-displayable-p ?…) "…" "..."))
+              (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))
+                                 ;; Don't bother truncating if it doesn't gain
+                                 ;; us at least 2 columns.
+                                 ((< compare (+ 2 (string-width ellipsis))) 
most)
+                                 (t (concat ellipsis (substring most 
compare))))
+                                close-bracket)))
+              ;;"-prospects" - more than one candidate
+              (prospects-len (+ (string-width
+                                 (or determ (concat open-bracket 
close-bracket)))
+                                (string-width icomplete-separator)
+                                (+ 2 (string-width ellipsis)) ;; 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)))
+              ;; 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.
+              (prefix (when icomplete-hide-common-prefix
+                        (try-completion "" comps)))
+              (prefix-len
+               (and (stringp prefix)
+                    ;; Only hide the prefix if the corresponding info
+                    ;; is already displayed via `most'.
+                    (string-prefix-p prefix most t)
+                    (length prefix))) ;;)
+              prospects comp limit)
+         (if (or (eq most-try t) (and icomplete-rotate
+                                      (not (consp (cdr comps)))))
+             (concat determ " [Matched]")
+           (when (member name comps)
+             ;; NAME is complete but not unique.  This scenario poses
+             ;; following UI issues:
+             ;;
+             ;; - When `icomplete-hide-common-prefix' is non-nil, NAME
+             ;;   is stripped empty.  This would make the entry
+             ;;   inconspicuous.
+             ;;
+             ;; - Due to sorting of completions, NAME may not be the
+             ;;   first of the prospects and could be hidden deep in
+             ;;   the displayed string.
+             ;;
+             ;; - Because of `icomplete-prospects-height' , NAME may
+             ;;   not even be displayed to the user.
+             ;;
+             ;; To circumvent all the above problems, provide a visual
+             ;; cue to the user via an "empty string" in the try
+             ;; completion field.
+             (setq determ (concat open-bracket "" close-bracket)))
+           (while (and comps (not limit))
+             (setq comp
+                   (if prefix-len (substring (car comps) prefix-len) (car 
comps))
+                   comps (cdr comps))
+             (setq prospects-len
+                   (+ (string-width comp)
+                      (string-width icomplete-separator)
+                      prospects-len))
+             (if (< prospects-len prospects-max)
+                 (push comp prospects)
+               (setq limit t)))
+           (setq prospects (nreverse prospects))
+           ;; Decorate first of the prospects.
+           (when prospects
+             (let ((first (copy-sequence (pop prospects))))
+               (put-text-property 0 (length first)
+                                  'face 'icomplete-first-match first)
+               (push first prospects)))
+            ;; Restore the base-size info, since 
completion-all-sorted-completions
+           ;; is cached.
+           (if last (setcdr last base-size))
            (concat determ
-                   (if icomplete-vertical-mode " \n" "{")
-                   (mapconcat 'identity prospects (if icomplete-vertical-mode
-                                                       "\n"
-                                                       icomplete-separator))
-                   (unless icomplete-vertical-mode
-                      (concat (and limit (concat icomplete-separator ellipsis))
-                              "}")))
-         (concat determ " [Matched]"))))))
+                   "{"
+                   (mapconcat 'identity prospects icomplete-separator)
+                   (concat (and limit (concat icomplete-separator ellipsis))
+                           "}"))))))))
 
 ;;; Iswitchb compatibility
 
diff --git a/lisp/simple.el b/lisp/simple.el
index 2a90a07..eecbb1e 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4216,6 +4216,14 @@ impose the use of a shell (with its need to quote 
arguments)."
            (shell-command-on-region (point) (point) command
                                     output-buffer nil error-buffer)))))))
 
+(defun max-mini-window-height (&optional frame)
+  "Compute number of lines for `max-mini-window-height' in FRAME.
+FRAME defaults to the selected frame."
+  (cond ((floatp max-mini-window-height) (* (frame-height frame)
+                                           max-mini-window-height))
+       ((integerp max-mini-window-height) max-mini-window-height)
+       (t 1)))
+
 (defun display-message-or-buffer (message &optional buffer-name action frame)
   "Display MESSAGE in the echo area if possible, otherwise in a pop-up buffer.
 MESSAGE may be either a string or a buffer.
@@ -4260,14 +4268,7 @@ and are used only if a pop-up buffer is displayed."
             (cond ((= lines 0))
                   ((and (or (<= lines 1)
                             (<= lines
-                                (if resize-mini-windows
-                                    (cond ((floatp max-mini-window-height)
-                                           (* (frame-height)
-                                              max-mini-window-height))
-                                          ((integerp max-mini-window-height)
-                                           max-mini-window-height)
-                                          (t
-                                           1))
+                                (if resize-mini-windows 
(max-mini-window-height)
                                   1)))
                         ;; Don't use the echo area if the output buffer is
                         ;; already displayed in the selected frame.