[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/icomplete-vertical-mode-improvements 4b2c73f 1/2: Improve icompl
|
From: |
João Távora |
|
Subject: |
scratch/icomplete-vertical-mode-improvements 4b2c73f 1/2: Improve icomplete-vertical-mode and fido-vertical-mode |
|
Date: |
Sun, 30 May 2021 12:34:15 -0400 (EDT) |
branch: scratch/icomplete-vertical-mode-improvements
commit 4b2c73f368ed6f08f374481fd0b0b61b2a804382
Author: João Távora <joaotavora@gmail.com>
Commit: João Távora <joaotavora@gmail.com>
Improve icomplete-vertical-mode and fido-vertical-mode
If icomplete-scroll and icomplete-vertical-mode are turned on,
icomplete-mode feels more like a typical vertical completion chooser.
M-x fido-mode augmented with M-x fido-vertical is the now the
recommended way to experience fido-mode.
* etc/NEWS (icomplete-vertical-mode): Reword.
* lisp/icomplete.el (simple): Require it.
(icomplete-selected-match): New face.
(icomplete-scroll): New user-visible var.
(icomplete-forward-completions): Rework.
(icomplete-backward-completions): Rework.
(icomplete--fido-mode-setup): Prefer icomplete-scroll according to
icomplete-vertical mode.
(icomplete-minibuffer-setup): Initialize icomplete--scrolled-completions.
(icomplete--vertical-minibuffer-setup): Initialize
icomplete-propspects-height
to a more common value.
(fido-vertical-mode): An alias for icomplete-vertical-mode.
(icomplete-exhibit): Init icomplete--scrolled-past. Adjust overlay.
(icomplete--render-vertical): New helper.
(icomplete-completions): Rework. Mostly reformat.
* lisp/simple.el (max-mini-window-height): New helper.
(display-message-or-buffer): Use it.
---
etc/NEWS | 9 +-
lisp/icomplete.el | 365 +++++++++++++++++++++++++++++++++++-------------------
lisp/simple.el | 17 +--
3 files changed, 253 insertions(+), 138 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index c6e7084..2046418 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -534,9 +534,12 @@ indentation is done using SMIE or with the old ad-hoc code.
** Icomplete
+++
-*** New minor mode 'icomplete-vertical-mode'.
-This mode is intended to be used with Icomplete or Fido, to display the
-list of completions candidates vertically instead of horizontally.
+*** New minor mode 'icomplete-vertical-mode', alias 'fido-vertical-mode'
+This mode is intended to be used with Icomplete or Fido, to display
+the list of completions candidates vertically instead of horizontally.
+When used with Fido mode ('M-x fido-mode') it will behave more like a
+typical scrolling dropdown widget instead of rotating the completions
+around and keeping the selection always at the top.
---
** Specific warnings can now be disabled from the warning buffer.
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 91bbb60..2067a40 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,7 +146,6 @@ icompletion is occurring."
:type 'hook
:group 'icomplete)
-
;;;_* Initialization
;;;_ + Internal Variables
@@ -215,6 +220,29 @@ the default otherwise."
;; We're not at all interested in cycling here (bug#34077).
(minibuffer-force-complete nil nil 'dont-cycle))
+;; Apropos `icomplete-scroll': we implement "scrolling icomplete"
+;; within classic icomplete, which is "rotating", by contrast.
+;;
+;; The two variables supporing this are
+;; `icomplete--scrolled-completions' and `icomplete--scrolled-past'.
+;; They come into play when:
+;;
+;; - The user invokes commands `icomplete-forward-completions' and
+;; `icomplete-backward-completions', thus "manually" scrolling to a
+;; given position;
+;;
+;; - The user re-filters a selection that had already been manually
+;; scrolled. The system attempts to keep the previous selection
+;; stable in the face of the new filtering. This is mostly done in
+;; `icomplete--render-vertical'.
+;;
+(defvar icomplete-scroll nil
+ "If non-nil, scroll candidates list instead of rotating it.")
+(defvar icomplete--scrolled-completions nil
+ "If non-nil, tail of completions list manually scrolled to.")
+(defvar icomplete--scrolled-past nil
+ "If non-nil, reverse tail of completions scrolled past.")
+
(defun icomplete-forward-completions ()
"Step forward completions by one entry.
Second entry becomes the first and can be selected with
@@ -223,10 +251,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-scroll
+ (push (pop comps) icomplete--scrolled-past)
+ (setq icomplete--scrolled-completions comps))
+ (t
+ (setcdr (last comps) (cons (pop comps) (cdr last)))))
+ (completion--cache-all-sorted-completions beg end comps))))
(defun icomplete-backward-completions ()
"Step backward completions by one entry.
@@ -236,12 +268,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-scroll icomplete--scrolled-past)
+ (push (pop icomplete--scrolled-past) comps)
+ (setq icomplete--scrolled-completions comps))
+ ((and (not icomplete-scroll)
+ (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)))))
+ (completion--cache-all-sorted-completions beg end comps)))
;;; Helpers for `fido-mode' (or `ido-mode' emulation)
;;;
@@ -351,6 +387,7 @@ if that doesn't produce a completion match."
(setq-local icomplete-tidy-shadowed-file-names t
icomplete-show-matches-on-no-input t
icomplete-hide-common-prefix nil
+ icomplete-scroll (not (null icomplete-vertical-mode))
completion-styles '(flex)
completion-flex-nospace nil
completion-category-defaults nil
@@ -449,6 +486,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--scrolled-completions nil)
(use-local-map (make-composed-keymap icomplete-minibuffer-map
(current-local-map)))
(add-hook 'pre-command-hook #'icomplete-pre-command-hook nil t)
@@ -483,6 +521,7 @@ Usually run by inclusion in `minibuffer-setup-hook'."
(defun icomplete--sorted-completions ()
(or completion-all-sorted-completions
(cl-loop
+ initially (setq icomplete--scrolled-past nil)
with beg = (icomplete--field-beg)
with end = (icomplete--field-end)
with all = (completion-all-sorted-completions beg end)
@@ -576,7 +615,7 @@ Usually run by inclusion in `minibuffer-setup-hook'."
(setq-local icomplete-separator "\n"
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
@@ -593,6 +632,8 @@ resized depends on `resize-mini-windows'."
(add-hook 'icomplete-minibuffer-setup-hook
#'icomplete--vertical-minibuffer-setup)))
+(defalias 'fido-vertical-mode 'icomplete-vertical-mode)
+
@@ -659,13 +700,83 @@ See `icomplete-mode' and `minibuffer-setup-hook'."
deactivate-mark)
;; Do nothing if while-no-input was aborted.
(when (stringp text)
- (move-overlay icomplete-overlay (point) (point) (current-buffer))
+ (move-overlay icomplete-overlay (point-min) (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 'before-string
+ (and icomplete-scroll
+ (let ((past (length icomplete--scrolled-past)))
+ (format
+ "%s/%s "
+ (1+ past)
+ (+ past
+ (safe-length completion-all-sorted-completions))))))
(overlay-put icomplete-overlay 'after-string text))))))))
+(cl-defun icomplete--render-vertical (comps &aux scroll-above scroll-below)
+ ;; Welcome to loopapalooza!
+ ;;
+ ;; First, be mindful of `icomplete-scroll' and manual scrolls. If
+ ;; `icomplete--scrolled-completions' and `icomplete--scrolled-past'
+ ;; are:
+ ;;
+ ;; - both nil, there is no manual scroll;
+ ;; - both non-nil, there is a healthy manual scroll the doesn't need
+ ;; to be readjusted (user just moved around the minibuffer, for
+ ;; example)l
+ ;; - non-nil and nil, respectively, a refiltering took place and we
+ ;; need attempt to readjust them to the new filtered `comps'.
+ (when (and icomplete-scroll
+ icomplete--scrolled-completions
+ (null icomplete--scrolled-past))
+ (cl-loop with preds
+ for (comp . rest) on comps
+ when (equal comp (car icomplete--scrolled-completions))
+ do
+ (setq icomplete--scrolled-past preds
+ comps (cons comp rest))
+ (completion--cache-all-sorted-completions
+ (icomplete--field-beg)
+ (icomplete--field-end)
+ comps)
+ and return nil
+ do (push comp preds)
+ finally (setq icomplete--scrolled-completions nil)))
+ ;; Then, in this pretty ugly loop, collect completions to display
+ ;; above and below the selected one, considering scrolling
+ ;; positions.
+ (cl-loop with preds = icomplete--scrolled-past
+ with succs = (cdr comps)
+ with max-lines = (1- (min icomplete-prospects-height
+ (max-mini-window-height)))
+ with max-above = (- max-lines
+ (cl-loop for (_ . r) on comps
+ repeat (truncate max-lines 2)
+ while (listp r)
+ count 1))
+ repeat max-lines
+ for neighbour = nil
+ if (and preds (> max-above 0)) do
+ (push (setq neighbour (pop preds)) scroll-above)
+ (cl-decf max-above)
+ else if (consp succs) collect
+ (setq neighbour (pop succs)) into scroll-below-aux
+ while neighbour
+ finally (setq scroll-below scroll-below-aux))
+ ;; Now figure out spacing and layout
+ ;;
+ (let ((selected (substring (car comps))))
+ (add-face-text-property 0 (length selected)
+ 'icomplete-selected-match 'append selected)
+ (concat " " icomplete-separator
+ (mapconcat
+ #'identity
+ (nconc scroll-above (list selected) scroll-below)
+ 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 +790,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.
@@ -703,126 +814,126 @@ matches exist."
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 ")" "]")))
;; `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))
+ (if icomplete-vertical-mode
+ (icomplete--render-vertical comps)
+ (let* ((last (if (consp comps) (last comps)))
+ ;; Save the "base size" encoded in `comps' then
+ ;; removing making `comps' a proper list.
+ (base-size (prog1 (cdr last)
+ (if last (setcdr last nil))))
+ (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 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
- (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]"))))))
+ 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)
+ (prog1
+ (if (or (eq most-try t) (and (not icomplete-scroll)
+ (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)))
+ (concat determ
+ "{"
+ (mapconcat 'identity prospects icomplete-separator)
+ (concat (and limit (concat icomplete-separator
ellipsis))
+ "}")))
+ ;; Restore the base-size info, since
completion-all-sorted-completions
+ ;; is cached.
+ (if last (setcdr last base-size))))))))
;;; Iswitchb compatibility
diff --git a/lisp/simple.el b/lisp/simple.el
index 8849919..495b35f 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4217,6 +4217,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.
@@ -4261,14 +4269,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.