Skip to content

Commit

Permalink
Add racket--affix to DRY affixation functions
Browse files Browse the repository at this point in the history
  • Loading branch information
@greghendershott
greghendershott committed Oct 20, 2024
1 parent 1b760f4 commit 85a1c8b
Show file tree
Hide file tree
Showing 5 changed files with 89 additions and 97 deletions.
57 changes: 57 additions & 0 deletions racket-complete.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -89,6 +89,63 @@ displaying inappropriate annotations."
(_
(complete-with-action action completions prefix predicate)))))

(defun racket--affix (prop min-widths strs)
"Use with `apply-partially' to make an :affixation-function.
PROP is a text property attached from index 0 of each of the STRS,
the value of which is a list of suffix columns.
MIN-WIDTHS is a vector of minimum widths for each column -- one
for the string itself, plus the length of the list of suffix
columns.
This function arranges for each suffix column to be aligned,
considering the maximum width of the previous column. Also it
adds the face `completions-annotations' to the suffixes.
When the STRS end in text made invisible by a \\='display \"\"
property -- as is done by `racket--doc-index-make-alist' --
ignore that for purposes of calculating widths."
(let* ((widths (seq-copy min-widths))
(rows
(seq-map (lambda (str)
(let ((visible-str
(substring str
0
(text-property-any 0 (length str)
'display ""
str)))
(suffixes (get-text-property 0 prop str)))
(seq-do-indexed (lambda (col ix)
(aset widths ix
(max (aref widths ix)
(1+ (length col)))))
(cons visible-str suffixes))
(cons str suffixes)))
strs))
(suffix-offsets (make-vector (length widths) 0))
(_ (let ((offset 0))
(seq-do-indexed (lambda (width ix)
(setq offset (+ offset width))
(aset suffix-offsets ix offset))
widths))))
(seq-map
(pcase-lambda (`(,str . ,suffixes))
(list str
""
(apply
#'concat
(seq-map-indexed
(lambda (suffix ix)
(concat
(propertize " "
'display
`(space :align-to ,(aref suffix-offsets ix)))
(propertize (or suffix "")
'face 'completions-annotations)))
suffixes))))
rows)))

(provide 'racket-complete)

;; racket-complete.el ends here
52 changes: 14 additions & 38 deletions racket-describe.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -530,7 +530,7 @@ browser program -- are given `racket-describe-ext-link-face'.

;;; Search local docs

;; For people who don't want to use a web browser at all: Search local
;; For people who don't want to use a web browser: Search local
;; documentation, and view in a `racket-describe-mode' buffer.

(defvar racket--doc-index (make-hash-table :test 'equal)
Expand Down Expand Up @@ -621,7 +621,7 @@ association list, to look up the path and anchor."
(mapcar
(pcase-lambda (`(,uid ,term ,sort ,what ,from ,fams ,path ,anchor))
(let* ((term (propertize term
'racket-affix (list term what from fams)))
'racket-affix (list what from fams)))
(sort (let ((fams (wstr 32
(pcase fams
("Racket" " Racket")
Expand All @@ -647,45 +647,21 @@ association list, to look up the path and anchor."
(list str path anchor)))
items)))

(defun racket--doc-index-affixator (strs)
"Value for completion :affixation-function."
(let ((max-term 16)
(max-what 16)
(max-from 32))
(dolist (str strs)
(pcase-let ((`(,term ,what ,from ,_fams)
(get-text-property 0 'racket-affix str)))
(setq max-term (max max-term (1+ (length term))))
(setq max-what (max max-what (1+ (length what))))
(setq max-from (max max-from (1+ (length from))))))
(seq-map (lambda (str)
(pcase-let*
((`(,term ,what ,from ,fams)
(get-text-property 0 'racket-affix str))
(suffix (concat
(make-string (- max-term (length term)) 32)
what
(make-string (- max-what (length what)) 32)
from
(make-string (- max-from (length from)) 32)
fams))
(suffix (propertize suffix
'face 'completions-annotations)))
(list str "" suffix)))
strs)))

(defun racket-describe-search ()
"Search installed documentation; view using `racket-describe-mode'."
(interactive)
(let ((collection (racket--completion-table
(racket--doc-index)
`((category . ,racket--identifier-category)
(affixation-function . ,#'racket--doc-index-affixator))))
(predicate (lambda (v)
(apply racket-doc-index-predicate-function
(get-text-property 0 'racket-affix (car v)))))
(require-match t)
(initial-input (racket--thing-at-point 'symbol t)))
(let* ((affixator (apply-partially #'racket--affix
'racket-affix
[16 16 32 0]))
(collection (racket--completion-table
(racket--doc-index)
`((category . ,racket--identifier-category)
(affixation-function . ,affixator))))
(predicate (lambda (v)
(apply racket-doc-index-predicate-function
(get-text-property 0 'racket-affix (car v)))))
(require-match t)
(initial-input (racket--thing-at-point 'symbol t)))
(when-let (str (completing-read "Describe: "
collection
predicate
Expand Down
18 changes: 5 additions & 13 deletions racket-input.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -317,20 +317,12 @@ Presents a `completing-read' UI, in which the symbols that would
be inserted are shown as annotations -- a preview unlike what is
currently provided by the Emacs UI for input method."
(interactive)
(let* ((translations racket-input-translations)
(let* ((translations
(seq-map (pcase-lambda (`(,str ,v . _more))
(propertize str 'racket-affix (list v)))
racket-input-translations))
(affixator
(lambda (strs)
(let ((max-len 16))
(dolist (str strs)
(setq max-len (max max-len (1+ (length str)))))
(seq-map (lambda (str)
(let ((v (cadr (assoc str translations))))
(list str
""
(concat
(make-string (- max-len (length str)) 32)
(propertize v 'face 'bold)))))
strs))))
(apply-partially #'racket--affix 'racket-affix [16 0]))
(collection
(racket--completion-table
translations
Expand Down
29 changes: 5 additions & 24 deletions racket-package.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -151,30 +151,11 @@ Allows users to customize via `completion-category-overrides'.")
"Arrange for :category and :affixation-function to show metadata."
(pcase-let*
((pkgs (racket--cmd/await nil `(pkg-list)))
;; Find longest name and stat values, for use by
;; affixation-function to align items.
(`(,max-name . ,max-stat)
(seq-reduce (pcase-lambda (`(,max-name . ,max-stat)
`(,name ,stat ,_desc))
(cons (max max-name (1+ (length name)))
(max max-stat (1+ (length stat)))))
pkgs
(cons 0 0)))
(affix
(lambda (vs)
(seq-map
(lambda (v)
(pcase (assoc v pkgs)
(`(,name ,stat ,desc)
(list v
""
(propertize
(concat (make-string (- max-name (length name)) 32)
stat
(make-string (- max-stat (length stat)) 32)
desc)
'face 'completions-annotations)))))
vs)))
(pkgs (seq-map (pcase-lambda (`(,name ,stat ,desc))
(propertize name
'racket-affix (list stat desc)))
pkgs))
(affix (apply-partially #'racket--affix 'racket-affix [16 10 0]))
(val (completing-read "Describe Racket package: "
(racket--completion-table
pkgs
Expand Down
30 changes: 8 additions & 22 deletions racket-xp-complete.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,36 +45,22 @@ The table includes category and affixation-function metadata.")
;;
;; Reshape that to a list of strings, each propertized with its mod,
;; for use as completion table.
(let ((all nil)
(imports nil)
(metadata `((category . ,racket--identifier-category)
(affixation-function . ,#'racket--xp-binding-completion-affixator))))
(let* ((all nil)
(imports nil)
(affixator (apply-partially #'racket--affix 'racket-affix [32 0]))
(metadata `((category . ,racket--identifier-category)
(affixation-function . ,affixator))))
(dolist (mod+syms mods+syms)
(pcase-let ((`(,mod . ,syms) mod+syms))
(dolist (sym syms)
(push (propertize sym 'racket-module mod) all)
(push (propertize sym 'racket-affix (list mod)) all)
(when mod
(push (propertize sym 'racket-module mod) imports)))))
(push (propertize sym 'racket-affix (list mod)) imports)))))
(setq racket--xp-completion-table-all
(racket--completion-table all metadata))
(setq racket--xp-completion-table-imports
(racket--completion-table imports metadata))))

(defun racket--xp-binding-completion-affixator (strs)
"Value for :affixation-function."
(let ((max-len (seq-reduce (lambda (max-len str)
(max max-len (1+ (length str))))
strs
15)))
(seq-map (lambda (str)
(let* ((leading-space (make-string (- max-len (length str)) 32))
(mod (get-text-property 0 'racket-module str))
(suffix (or mod ""))
(suffix (propertize suffix 'face 'completions-annotations))
(suffix (concat leading-space suffix)))
(list str "" suffix)))
strs)))

(defvar-local racket--xp-module-completions nil
"A completion table for available collection module paths.
Do not `setq' directly; instead call `racket--xp-set-module-completions'.")
Expand Down Expand Up @@ -115,7 +101,7 @@ Do not `setq' directly; instead call `racket--xp-set-module-completions'.")
(list beg
end
racket--xp-completion-table-all
:affixation-function #'racket--xp-binding-completion-affixator
;; ^table metadata already has :affixation-function
:exclusive 'no
:company-location (racket--xp-make-company-location-proc)
:company-doc-buffer (racket--xp-make-company-doc-buffer-proc)))
Expand Down

0 comments on commit 85a1c8b

Please sign in to comment.