diff --git a/racket-complete.el b/racket-complete.el index f15b4b83..103f90e2 100644 --- a/racket-complete.el +++ b/racket-complete.el @@ -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 diff --git a/racket-describe.el b/racket-describe.el index f6f5ff31..95ea0e75 100644 --- a/racket-describe.el +++ b/racket-describe.el @@ -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) @@ -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") @@ -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 diff --git a/racket-input.el b/racket-input.el index 1e86f8a3..c1039470 100644 --- a/racket-input.el +++ b/racket-input.el @@ -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 diff --git a/racket-package.el b/racket-package.el index dcc71a6c..b19c604b 100644 --- a/racket-package.el +++ b/racket-package.el @@ -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 diff --git a/racket-xp-complete.el b/racket-xp-complete.el index 15c974af..607b0860 100644 --- a/racket-xp-complete.el +++ b/racket-xp-complete.el @@ -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'.") @@ -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)))