From 05ab6e53e2cc82edb0b0916c880bdaa269267528 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 30 May 2021 16:26:02 +0100 Subject: [PATCH] Improve icomplete-vertical-mode and fido-vertical-mode This mode is intended to be used with Icomplete ('M-x icomplete-mode') or Fido ('M-x fido-mode'), to display the list of completions candidates vertically instead of horizontally. When used with Icomplete, completions are rotated and selection kept at the top. When used with Fido, completions scroll like a typical dropdown widget. If the dropdown behaviour is desired for Icomplete (instead of rotation), icomplete-scroll can be adjusted separately by the user. * 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. (fido-vertical-mode): An alias for icomplete-vertical-mode. (icomplete-exhibit): Init icomplete--scrolled-past. Adjust overlay. (icomplete--render-vertical): New helper. (icomplete--sorted-completions): If cache is stale, also invalidate icomplete--scrolled-past. (icomplete-completions): Rework. Mostly reformat. * lisp/simple.el (max-mini-window-lines): New helper. (display-message-or-buffer): Use it. --- etc/NEWS | 10 +- lisp/icomplete.el | 362 ++++++++++++++++++++++++++++++---------------- lisp/simple.el | 21 +-- 3 files changed, 257 insertions(+), 136 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index fe8789c60b3..914e6890321 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -534,9 +534,13 @@ 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 ('M-x icomplete-mode') +or Fido ('M-x fido-mode'), to display the list of completions +candidates vertically instead of horizontally. When used with +Icomplete, completions are rotated and selection kept at the top. +When used with Fido, completions scroll like a typical dropdown +widget. --- ** Specific warnings can now be disabled from the warning buffer. diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 91bbb600136..f813a1776e8 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-lines +(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 @@ -215,6 +221,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 +252,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 +269,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 +388,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 +487,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 +522,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) ; Invalidate scrolled state with beg = (icomplete--field-beg) with end = (icomplete--field-end) with all = (completion-all-sorted-completions beg end) @@ -593,6 +633,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 +701,85 @@ 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 + (truncate (max-mini-window-lines) 1))) + with max-above = (- max-lines + 1 + (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. @@ -703,126 +817,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 cdd77f74c3e..6d216f74d91 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4217,12 +4217,22 @@ 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-lines (&optional frame) + "Compute maximum number of lines for echo area in FRAME. +As defined by `max-mini-window-height'. FRAME defaults to the +selected frame. Result may be a floating-point number, +i.e. include a fractional number of lines." + (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. A pop-up buffer is displayed using `display-buffer' if MESSAGE is too long -for maximum height of the echo area, as defined by `max-mini-window-height' +for maximum height of the echo area, as defined by `max-mini-window-lines' if `resize-mini-windows' is non-nil. Returns either the string shown in the echo area, or when a pop-up @@ -4261,14 +4271,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-lines) 1))) ;; Don't use the echo area if the output buffer is ;; already displayed in the selected frame. -- 2.39.2