[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/icomplete-vertical-mode-related-work 4ad8e34 1/2: Make icomplete
From: |
João Távora |
Subject: |
scratch/icomplete-vertical-mode-related-work 4ad8e34 1/2: Make icomplete-vertical-mode behave a little more like a dropdown |
Date: |
Mon, 24 May 2021 14:49:29 -0400 (EDT) |
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.