branch: externals/tempel
commit adb99a74abdb327d579f064b4326ec4b6f8607dc
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
tempel-complete: Add :company-doc-buffer function
This is useful in combination with corfu-popupinfo-mode.
---
tempel.el | 49 ++++++++++++++++++++++++++++++-------------------
1 file changed, 30 insertions(+), 19 deletions(-)
diff --git a/tempel.el b/tempel.el
index aeb5901150..1763906366 100644
--- a/tempel.el
+++ b/tempel.el
@@ -155,31 +155,40 @@ may be named with `tempel--name' or carry an evaluatable
Lisp expression
"M-<up>" #'tempel-previous
"M-<down>" #'tempel-next)
-(defun tempel--print-element (elt)
- "Return string representation of template ELT."
- (pcase elt
- ('nil nil)
- ((pred stringp) elt)
- (`(s ,name) (symbol-name name))
- (`(,(or 'p 'P) ,_ ,name . ,noinsert)
- (and (not (car noinsert)) (symbol-name name)))
- ((or 'n 'n> '> '& '% 'o) " ")
- (_ "_")))
+(defun tempel--print-template (elts)
+ "Print template ELTS."
+ (cl-loop
+ for elt in elts until (keywordp elt) concat
+ (pcase elt
+ ('nil nil)
+ ((pred stringp) (propertize elt 'face 'completions-annotations))
+ (`(s ,name) (propertize (symbol-name name) 'face
'completions-annotations))
+ (`(,(or 'p 'P) ,_ ,name . ,noinsert)
+ (and (not (car noinsert))
+ (propertize (symbol-name name) 'face 'completions-annotations)))
+ ('> #(" " 0 1 (face completions-annotations)))
+ ((or 'n 'n> '& '% 'o) #("\n" 0 1 (face completions-annotations)))
+ (_ #("_" 0 1 (face shadow))))))
(defun tempel--annotate (templates width ellipsis sep name)
"Annotate template NAME given the list of TEMPLATES.
WIDTH, SEP and ELLIPSIS configure the formatting."
(when-let ((name (intern-soft name))
(elts (cdr (assoc name templates))))
- (concat sep
- (truncate-string-to-width
- (replace-regexp-in-string
- "_+" #("_" 0 1 (face shadow))
- (propertize (replace-regexp-in-string
- "\\s-+" " "
- (mapconcat #'tempel--print-element elts ""))
- 'face 'completions-annotations))
- width 0 ?\s ellipsis))))
+ (concat sep (truncate-string-to-width
+ (replace-regexp-in-string
+ "[ \t\n\r]+" #(" " 0 1 (face completions-annotations))
+ (tempel--print-template elts))
+ width 0 ?\s ellipsis))))
+
+(defun tempel--doc-buffer (templates name)
+ "Create doc buffer for template NAME given the list of TEMPLATES."
+ (when-let ((name (intern-soft name))
+ (elts (cdr (assoc name templates))))
+ (with-current-buffer (get-buffer-create " *tempel-doc*")
+ (erase-buffer)
+ (insert (tempel--print-template elts))
+ (current-buffer))))
(defun tempel--delete-word (word)
"Delete WORD before point."
@@ -674,6 +683,8 @@ If INTERACTIVE is nil the function acts like a capf."
:company-kind (lambda (_) 'snippet)
:exit-function (apply-partially #'tempel--exit templates region)
:company-prefix-length (and tempel-trigger-prefix t)
+ :company-doc-buffer
+ (apply-partially #'tempel--doc-buffer templates)
:annotation-function
(and tempel-complete-annotation
(apply-partially #'tempel--annotate
