Skip to content

Commit

Permalink
Improve behaviour for long prompts (#375)
Browse files Browse the repository at this point in the history
  • Loading branch information
@clemera
clemera authored Jan 15, 2021
1 parent 3abbfd9 commit 4d932d9
Show file tree
Hide file tree
Showing 2 changed files with 74 additions and 57 deletions.
9 changes: 5 additions & 4 deletions CHANGELOG.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -117,10 +117,11 @@ The format is based on [Keep a Changelog].
completion session, which has been fixed ([#350], [#352], [#354]).
* When there were no candidates `selectrum-get-current-candidate`
would throw an error, which has been fixed ([#347], [#348]).
* When `auto-hscroll-mode` was set to `current-line` prompts which
exceeded the frame width would introduce constant back and forth
scrolling issues, which has been fixed ([#344], [#345], [#374]).
Currently there is still a cursor display issue on initial input.
* There were UI and display problems when the prompt width exceeded
the available window width. When `auto-hscroll-mode` was set to
`current-line` it would introduce constant back and forth scrolling
issues and other values also wouldn't allow to use such a prompt
correctly ([#344], [#345], [#374], [#375]).
* `selectrum-select-from-history` set variables
`selectrum-should-sort-p`, `selectrum-candidate-inserted-hook`,
`selectrum-candidate-selected-hook` and
Expand Down
122 changes: 69 additions & 53 deletions selectrum.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -721,6 +721,10 @@ the update."
(unless selectrum--skip-updates-p
;; Stay within input area.
(goto-char (max (point) (minibuffer-prompt-end)))
;; Scroll the minibuffer when current prompt exceeds window width.
(let* ((width (window-width)))
(when (> (point-max) width)
(set-window-hscroll nil (- (point) (/ width 4)))))
;; For some reason this resets and thus can't be set in setup hook.
(setq-local truncate-lines t)
(let ((inhibit-read-only t)
Expand Down Expand Up @@ -967,14 +971,17 @@ will be set to `selectrum-num-candidates-displayed' if
(window-resize
window (- dheight wheight) nil nil 'pixelwise))))

(defun selectrum--ensure-single-lines (candidates settings)
(defun selectrum--ensure-single-lines (candidates settings &optional padding)
"Return list of single-line CANDIDATES.
Multi-line candidates are merged into a single line. The resulting
single-line candidates are then shortened by replacing repeated
whitespace and maybe truncating the result.
Multi-line candidates are merged into a single line. The
resulting single-line candidates are then shortened by replacing
repeated whitespace and maybe truncating the result.
The specific details of the formatting are determined by
SETTINGS, see `selectrum-multiline-display-settings'."
SETTINGS, see `selectrum-multiline-display-settings'.
If PADDING is non-nil lines are padded with it."
(let* ((single/lines ())

;; The formatting settings are the same for all multi-line
Expand Down Expand Up @@ -1003,53 +1010,60 @@ SETTINGS, see `selectrum-multiline-display-settings'."
(whitespace/face (cadr whitespace/transformation)))

(dolist (cand candidates (nreverse single/lines))
(if (string-match-p "\n" cand)
(let* ((lines (split-string cand "\n"))
(len (length lines))
(input (minibuffer-contents))
(fmatch (if (string-empty-p input)
(with-temp-buffer
(insert cand)
(goto-char (point-min))
(skip-chars-forward " \t\n")
(buffer-substring (line-beginning-position)
(line-end-position)))
(car (funcall
selectrum-refine-candidates-function
input
lines))))
(match
(propertize
(replace-regexp-in-string
"[ \t][ \t]+"
(propertize whitespace/display 'face whitespace/face)
(or fmatch "") 'fixed-case 'literal)
'selectrum-candidate-display-prefix
(propertize (format "(%d lines)" len)
'face newline/face)))
(annot (replace-regexp-in-string
"\n" (propertize newline/display 'face newline/face)
(replace-regexp-in-string
"[ \t][ \t]+"
(propertize whitespace/display 'face whitespace/face)
(concat (unless (string-empty-p match)
(propertize match/display
'face match/face))
(if (< (length cand) 1000)
cand
(concat
(substring cand 0 1000)
(propertize truncation/display
'face truncation/face))))
;; Replacements should be fixed-case and
;; literal, to make things simpler.
'fixed-case 'literal)
'fixed-case 'literal))
(line (propertize (if (string-empty-p match) " " match)
'selectrum-candidate-display-suffix
annot)))
(push line single/lines))
(push cand single/lines)))))
(let ((line
(if (not (string-match-p "\n" cand))
cand
(let* ((lines (split-string cand "\n"))
(len (length lines))
(input (minibuffer-contents))
(fmatch (if (string-empty-p input)
(with-temp-buffer
(insert cand)
(goto-char (point-min))
(skip-chars-forward " \t\n")
(buffer-substring
(line-beginning-position)
(line-end-position)))
(car (funcall
selectrum-refine-candidates-function
input
lines))))
(match
(propertize
(replace-regexp-in-string
"[ \t][ \t]+"
(propertize whitespace/display
'face whitespace/face)
(or fmatch "") 'fixed-case 'literal)
'selectrum-candidate-display-prefix
(propertize (format "(%d lines)" len)
'face newline/face)))
(annot (replace-regexp-in-string
"\n" (propertize newline/display
'face newline/face)
(replace-regexp-in-string
"[ \t][ \t]+"
(propertize whitespace/display
'face whitespace/face)
(concat
(unless (string-empty-p match)
(propertize match/display
'face match/face))
(if (< (length cand) 1000)
cand
(concat
(substring cand 0 1000)
(propertize truncation/display
'face truncation/face))))
;; Replacements should be fixed-case and
;; literal, to make things simpler.
'fixed-case 'literal)
'fixed-case 'literal)))
(propertize
(if (string-empty-p match) " " match)
'selectrum-candidate-display-suffix
annot)))))
(push (concat padding line) single/lines)))))

(defun selectrum--annotation (fun cand face)
"Return annotation for candidate.
Expand Down Expand Up @@ -1180,6 +1194,8 @@ TABLE defaults to `minibuffer-completion-table'. PRED defaults to
(extend selectrum-extend-current-candidate-highlight)
(show-indices selectrum-show-indices)
(margin-padding selectrum-right-margin-padding)
(padding (when (> (point-max) (window-width))
(make-string (window-hscroll) ?\s)))
(lines
(selectrum--ensure-single-lines
;; First pass the candidates to the highlight function
Expand All @@ -1189,7 +1205,7 @@ TABLE defaults to `minibuffer-completion-table'. PRED defaults to
;; requires this).
(funcall selectrum-highlight-candidates-function
input candidates)
selectrum-multiline-display-settings)))
selectrum-multiline-display-settings padding)))
(with-temp-buffer
(dolist (candidate lines)
(let* ((prefix (get-text-property
Expand Down

0 comments on commit 4d932d9

Please sign in to comment.