scratch/icomplete-vertical-mode-related-work 4ad8e34 1/2: Make icomplete-vertical-mode behave a little more like a dropdown

[João Távora]

branch: scratch/icomplete-vertical-mode-related-work
commit 4ad8e346b09a36effe5e677f543a767d252b1549
Author: João Távora <joaotavora@gmail.com>
Commit: João Távora <joaotavora@gmail.com>

    Make icomplete-vertical-mode behave a little more like a dropdown
    
    Also try to honour annotation-function.
    
    Still mostly horrible though.
    
    * lisp/icomplete.el (simple): Require it.
    (icomplete-forward-completions): Hack icomplete--predecessors into
    cycled completions.
    (icomplete-completions): Rework icomplete-vertical-mode case.
---
 lisp/icomplete.el | 124 +++++++++++++++++++++++++++++++++++++++---------------
 lisp/simple.el    |  17 ++++----
 2 files changed, 100 insertions(+), 41 deletions(-)

diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 91bbb60..8ce0382 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."
@@ -223,9 +225,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))
+         (reverse (get-text-property 0 'icomplete--predecessors (car comps)))
         (last (last comps)))
     (when comps
-      (setcdr last (cons (car comps) (cdr last)))
+      (setcdr last (cons (car comps) nil))
+      (unless (zerop (length (car comps)))
+        (put-text-property 0 1 'icomplete--predecessors
+                           (cons (car comps) reverse)
+                           (cadr comps)))
       (completion--cache-all-sorted-completions beg end (cdr comps)))))
 
 (defun icomplete-backward-completions ()
@@ -771,7 +778,7 @@ matches exist."
                    (length prefix))) ;;)
             prospects comp limit)
        (if (or (eq most-try t) (not (consp (cdr comps))))
-           (setq prospects nil)
+           (concat determ " [Matched]")
          (when (member name comps)
            ;; NAME is complete but not unique.  This scenario poses
            ;; following UI issues:
@@ -791,38 +798,89 @@ matches exist."
            ;; 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
+          (cond
+           (icomplete-vertical-mode
+            (cl-loop
+             with selected = (propertize (car comps) 'face
+                                         'icomplete-first-match)
+             with neighbour
+             with ann-fun =
+             (or (completion-metadata-get md 'annotation-function)
+                 (plist-get completion-extra-properties :annotation-function))
+             with preds = (get-text-property 0 'icomplete--predecessors
+                                             (car comps))
+             with max-lines = (1- (min icomplete-prospects-height
+                                       (max-mini-window-height)))
+             with all-succs = (cl-loop repeat max-lines
+                                       for s in (cdr comps)
+                                       while s collect s)
+             with max-before = (1- (/ max-lines 2))
+             with before = (list)
+             while (and
+                    all-succs
+                    (< used-lines max-lines)
+                    (< tot-len prospects-max) ; gotta honour this, but why?
+                    )
+             count 1 into used-lines
+             if (and preds (> max-before 0))
+             do (push (setq neighbour (pop preds)) before)
+             and do (cl-decf max-before)
+             else
+             collect (setq neighbour (pop all-succs)) into after
+             sum (length neighbour) into tot-len
+             maximize (length neighbour) into max-len
+             finally
+             (setq max-len (max (length selected) max-len))
+             (let ((all (delete-dups
+                         (nconc before
+                                (list selected)
+                                after))))
+               (cl-return
+                (concat " " icomplete-separator
+                        (mapconcat
+                         (lambda (c)
+                           (let* ((ann (and ann-fun (funcall ann-fun c)))
+                                  (prefix (and
+                                           ann
+                                           (get-text-property 0 'prefix ann)))
+                                  (suffix (or (and
+                                               ann
+                                               (get-text-property 0 'suffix 
ann))
+                                              (and (not prefix) ann))))
+                             (concat prefix c
+                                     (make-string (- max-len (length c)) ? )
+                                     suffix)))
+                         all
+                         icomplete-separator))))))
+           (t
+            ;; Non-vertical icomplete. 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))
            (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.