Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 09:14:18 +00:00
Code Issues Projects Releases Packages Wiki Activity

Add annotation capability to icomplete-vertical-mode

Browse source 
Co-authored-by Daniel Mendler <mail@daniel-mendler.de>

* lisp/icomplete.el (icomplete--affixate): New helper.
(icomplete--render-vertical): Use it. Rework.
(icomplete-completions): Pass md to icomplete--render-vertical.
This commit is contained in:
João Távora 2021-05-25 22:40:40 +01:00
parent 4b2c73f368
commit 638f54187d
1 changed files with 51 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

61
lisp/icomplete.el
View file

@ -716,7 +716,30 @@ See `icomplete-mode' and `minibuffer-setup-hook'."
(safe-length completion-all-sorted-completions))))))
(overlay-put icomplete-overlay 'after-string text))))))))
(cl-defun icomplete--render-vertical (comps &aux scroll-above scroll-below)
(defun icomplete--affixate (md prospects)
"Affixate PROSPECTS given completion metadata MD.
Return a list of (COMP PREFIX SUFFIX)."
(let ((aff-fun (or (completion-metadata-get md 'affixation-function)
(plist-get completion-extra-properties :affixation-function)))
(ann-fun (or (completion-metadata-get md 'annotation-function)
(plist-get completion-extra-properties :annotation-function))))
(cond (aff-fun
(funcall aff-fun prospects))
(ann-fun
(mapcar
(lambda (comp)
(let ((suffix (or (funcall ann-fun comp) "")))
(list comp ""
;; The default completion UI adds the
;; `completions-annotations' face if no
;; other faces are present.
(if (text-property-not-all 0 (length suffix) 'face nil suffix)
suffix
(propertize suffix 'face 'completions-annotations)))))
prospects))
(prospects))))
(cl-defun icomplete--render-vertical (comps md &aux scroll-above scroll-below)
;; Welcome to loopapalooza!
;;
;; First, be mindful of `icomplete-scroll' and manual scrolls. If
@ -768,14 +791,32 @@ See `icomplete-mode' and `minibuffer-setup-hook'."
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))))
(cl-loop
with selected = (substring (car comps))
initially (add-face-text-property 0 (length selected)
'icomplete-selected-match 'append selected)
with torender = (nconc scroll-above (list selected) scroll-below)
with triplets = (icomplete--affixate md torender)
initially (when (eq triplets torender)
(cl-return-from icomplete--render-vertical
(concat
" \n"
(mapconcat #'identity torender icomplete-separator))))
for (comp prefix) in triplets
maximizing (length prefix) into max-prefix-len
maximizing (length comp) into max-comp-len
finally return
;; Finally, render
;;
(concat
" \n"
(cl-loop for (comp prefix suffix) in triplets
concat prefix
concat (make-string (- max-prefix-len (length prefix)) ? )
concat comp
concat (make-string (- max-comp-len (length comp)) ? )
concat suffix
concat icomplete-separator))))
;;;_ > icomplete-completions (name candidates predicate require-match)
(defun icomplete-completions (name candidates predicate require-match)
@ -821,7 +862,7 @@ matches exist."
(progn ;;(debug (format "Candidates=%S field=%S" candidates name))
(format " %sNo matches%s" open-bracket close-bracket))
(if icomplete-vertical-mode
(icomplete--render-vertical comps)
(icomplete--render-vertical comps md)
(let* ((last (if (consp comps) (last comps)))
;; Save the "base size" encoded in `comps' then
;; removing making `comps' a proper list.