mirror of
https://github.com/doomemacs/doomemacs
synced 2025-08-01 12:17:25 -05:00
feat(beancount): enhance completion across the board
Enhances completion for beancount-mode in the following ways: 1. Adds completion for: - Event directives and values, - The payee field in transactions, - Currencies and commodities, 2. Fixes completion for #tag and ^links not working at the end of a transaction's heading. 3. Completion now scans not only the current file, but any included files (recursively) for candidates if `+beancount-files' is set to `auto`. It can otherwise be set to a list of static files or set to `nil` (reverts to only scanning the current buffer). This applies not only to completion-at-point functions, but also interactive commands like `beancount-insert-account'. This is all very rudimentary and needs polish!
This commit is contained in:
Henrik Lissner
@ -1,5 +1,200 @@
|
||||
;;; lang/beancount/autoload/advice.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defun +beancount--included-files (&optional recursive? context)
|
||||
"Return a list of included files in the current beancount buffer.
|
||||
|
||||
If RECURSIVE? is non-nil, included files will be read for each found include (as
|
||||
will theirs, recursively)."
|
||||
(let ((nested? (eq recursive? 'nested))
|
||||
files)
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(widen)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward
|
||||
(concat "^" (unless nested? "\\(?:;;;# \\)?")
|
||||
(rx "include" (+ " ") "\"" (group (+ (not "\"")))))
|
||||
nil t)
|
||||
(when-let* ((path (match-string-no-properties 1)))
|
||||
(setq path (expand-file-name path))
|
||||
(dolist (file (if (string-match "[[*?]" path)
|
||||
(doom-glob path)
|
||||
(when (file-readable-p path)
|
||||
(list path))))
|
||||
(unless (and context
|
||||
(let ((skip (doom-file-cookie file "skip")))
|
||||
(or (eq skip t)
|
||||
(memq context (ensure-list skip)))))
|
||||
(cl-callf nconc files (list file))
|
||||
(when recursive?
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(let ((default-directory
|
||||
(directory-file-name
|
||||
(file-name-directory file))))
|
||||
(cl-callf nconc files (+beancount--included-files 'nested context)))))))))
|
||||
(if nested?
|
||||
files
|
||||
(delete-dups files))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun +beancount--collect-unique-recursive (regexp n &optional context)
|
||||
(let ((results (make-hash-table :test 'equal)))
|
||||
(dolist (file (cons (buffer-file-name (buffer-base-buffer))
|
||||
(if (eq +beancount-files 'auto)
|
||||
(+beancount--included-files t context)
|
||||
+beancount-files)))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(dolist (x (beancount-collect-pos-alist regexp n))
|
||||
(puthash (car x) `(:file ,file :point ,(cdr x))
|
||||
results))))
|
||||
results))
|
||||
|
||||
(defvar +beancount--completion-cache nil)
|
||||
;;;###autoload
|
||||
(defun +beancount-completion-table (regexp n context &optional sort-fn)
|
||||
(lambda (string pred action)
|
||||
(if (eq action 'metadata)
|
||||
`(metadata
|
||||
(category . ,(intern (format "beancount-%s" context)))
|
||||
(display-sort-function . identity))
|
||||
(make-local-variable '+beancount--completion-cache)
|
||||
(with-current-buffer (let ((win (minibuffer-selected-window)))
|
||||
(if (window-live-p win) (window-buffer win)
|
||||
(current-buffer)))
|
||||
(with-memoization (alist-get context +beancount--completion-cache)
|
||||
(+beancount--collect-unique-recursive regexp n context))
|
||||
(complete-with-action
|
||||
action (sort (hash-table-keys
|
||||
(alist-get context +beancount--completion-cache))
|
||||
(or sort-fn #'string<))
|
||||
string pred)))))
|
||||
|
||||
(defun +beancount-account-completion-table (&optional sort-fn)
|
||||
(cl-callf2 assq-delete-all 'accounts +beancount--completion-cache)
|
||||
(+beancount-completion-table
|
||||
(concat "^" beancount-date-regexp " +open +\\(" beancount-account-regexp "\\)")
|
||||
1 'accounts sort-fn))
|
||||
|
||||
;;;###autoload
|
||||
(defun +beancount-completion-at-point-a ()
|
||||
"Return the completion data relevant for the text at point."
|
||||
(save-excursion
|
||||
(save-match-data
|
||||
(let ((pos (point)))
|
||||
(beginning-of-line)
|
||||
(cond
|
||||
;; non timestamped directive
|
||||
((beancount-looking-at "[a-z]*" 0 pos)
|
||||
(list (match-beginning 0) (match-end 0)
|
||||
(mapcar (lambda (s) (concat s " ")) beancount-directive-names)))
|
||||
|
||||
;; poptag
|
||||
((beancount-looking-at
|
||||
(concat "poptag\\s-+\\(\\(?:#[" beancount-tag-chars "]*\\)\\)") 1 pos)
|
||||
(list (match-beginning 1) (match-end 1)
|
||||
(beancount-collect-pushed-tags (point-min) (point))))
|
||||
|
||||
;; option
|
||||
((beancount-looking-at
|
||||
(concat "^option\\s-+\\(\"[a-z_]*\\)") 1 pos)
|
||||
(list (match-beginning 1) (match-end 1)
|
||||
(mapcar (lambda (s) (concat "\"" s "\" ")) beancount-option-names)))
|
||||
|
||||
;; NEW: event values (scoped by name)
|
||||
;; REVIEW: PR this upstream
|
||||
((beancount-looking-at
|
||||
(concat beancount-date-regexp "\\s-+event\\s-+\"\\([^\"\n]+\\)\"\\s-+\"\\([^\"\n]*\\)")
|
||||
2 pos)
|
||||
(list (match-beginning 2) (match-end 2)
|
||||
(+beancount-completion-table
|
||||
(concat "^" beancount-date-regexp
|
||||
"\\s-+event"
|
||||
"\\s-+\"" (regexp-quote (match-string-no-properties 1)) "\""
|
||||
"\\s-+\"\\([^\"\n]+\\)\"")
|
||||
1 'event-values)))
|
||||
|
||||
;; NEW: event names
|
||||
;; REVIEW: PR this upstream
|
||||
((beancount-looking-at
|
||||
(concat beancount-date-regexp "\\s-+event\\s-+\"\\([^\"\n]*\\)") 1 pos)
|
||||
(list (match-beginning 1) (match-end 1)
|
||||
(+beancount-completion-table
|
||||
(concat "^" beancount-date-regexp
|
||||
"\\s-+event"
|
||||
"\\s-+\"\\([^\"\n]+\\)\"")
|
||||
1 'events)))
|
||||
|
||||
;; NEW: transaction payees
|
||||
;; REVIEW: PR this upstream (?)
|
||||
((beancount-looking-at
|
||||
(concat beancount-date-regexp "\\s-+" beancount-flag-regexp "\\s-+\"\\([^\"\n]*\\)")
|
||||
1 pos)
|
||||
(list (match-beginning 1) (match-end 1)
|
||||
(+beancount-completion-table
|
||||
(concat "^" beancount-date-regexp
|
||||
"\\s-+" beancount-flag-regexp
|
||||
"\\s-+\"\\([a-zA-Z0-9][^\"\n]+\\)\"")
|
||||
1 'payees)))
|
||||
|
||||
;; timestamped directive
|
||||
((beancount-looking-at
|
||||
(concat beancount-date-regexp "\\s-+\\([[:alpha:]]*\\)") 1 pos)
|
||||
(list (match-beginning 1) (match-end 1)
|
||||
(mapcar (lambda (s) (concat s " ")) beancount-timestamped-directive-names)))
|
||||
|
||||
;; timestamped directives followed by account
|
||||
((beancount-looking-at
|
||||
(concat "^" beancount-date-regexp
|
||||
"\\s-+" (regexp-opt beancount-account-directive-names)
|
||||
"\\s-+\\([" beancount-account-chars "]*\\)") 1 pos)
|
||||
(list (match-beginning 1) (match-end 1) (+beancount-account-completion-table)))
|
||||
|
||||
;; pad directive followed by two accounts
|
||||
((beancount-looking-at
|
||||
(concat "^" beancount-date-regexp
|
||||
"\\s-+" (regexp-opt '("pad"))
|
||||
"\\s-+\\([" beancount-account-chars "]*\\)"
|
||||
"\\s-+\\([" beancount-account-chars "]*\\)") 2 pos)
|
||||
(list (match-beginning 2) (match-end 2) (+beancount-account-completion-table)))
|
||||
|
||||
;; posting
|
||||
((and (beancount-looking-at
|
||||
(concat "[ \t]+\\([" beancount-account-chars "]*\\)") 1 pos)
|
||||
;; Do not force the account name to start with a
|
||||
;; capital, so that it is possible to use substring
|
||||
;; completion and we can rely on completion to fix
|
||||
;; capitalization thanks to completion-ignore-case.
|
||||
(beancount-inside-transaction-p))
|
||||
(list (match-beginning 1) (match-end 1) (+beancount-account-completion-table)))
|
||||
|
||||
;; tags & links
|
||||
;; REVIEW: The upstream implementation only completes tags/links at
|
||||
;; indentation and not at the end of transaction heading, where
|
||||
;; they're typically used. This fixes that.
|
||||
((progn
|
||||
(goto-char pos)
|
||||
(and (re-search-backward "[ \t]" (pos-bol) t)
|
||||
(looking-at (concat "[ \t]+\\(\\([#^]\\)[" beancount-tag-chars "]*\\)"))
|
||||
(>= pos (match-beginning 1))
|
||||
(<= pos (match-end 1))))
|
||||
(list (match-beginning 1) (match-end 1)
|
||||
(+beancount-completion-table
|
||||
(concat " \\(" (match-string-no-properties 2) "[" beancount-tag-chars "]+\\)")
|
||||
1 (if (equal (match-string-no-properties 2) "#") 'tags 'links)))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun +beancount-get-account-names-a (&rest _)
|
||||
"Crawl `+beancount-files' for account names."
|
||||
(unless beancount-accounts
|
||||
(setq beancount-accounts
|
||||
(hash-table-keys
|
||||
(+beancount--collect-unique-recursive
|
||||
(concat "^" beancount-date-regexp " +open +\\(" beancount-account-regexp "\\)")
|
||||
1 'accounts))))
|
||||
beancount-accounts)
|
||||
|
||||
;;;###autoload
|
||||
(defun +beancount--flymake-bean-check--run-a (report-fn &rest _ignored)
|
||||
(unless (executable-find flymake-bean-check-executable)
|
||||
|
||||
@ -1,5 +1,23 @@
|
||||
;;; lang/beancount/config.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar +beancount-files 'auto
|
||||
"A list of beancount files to factor into completion & linting.
|
||||
|
||||
Order is important!
|
||||
|
||||
Can also be set to `auto' to automatically (and recursively) crawl include
|
||||
statements to build this file list dynamically (which is cached on a per-buffer
|
||||
basis). The first time this happens it can be very slow in large file
|
||||
hierarchies or with massive beancount files.
|
||||
|
||||
If set to `nil', only the current buffer is considered (the original
|
||||
behavior).")
|
||||
(put '+beancount-files 'safe-local-variable #'stringp)
|
||||
|
||||
|
||||
;;
|
||||
;;; Packages
|
||||
|
||||
(use-package! beancount
|
||||
:mode ("\\.bean\\'" . beancount-mode)
|
||||
:hook (beancount-mode . outline-minor-mode)
|
||||
@ -47,6 +65,21 @@
|
||||
;; REVIEW: PR features 1 and 2 upstream! 3 needs discussing.
|
||||
(advice-add #'flymake-bean-check--run :override #'+beancount--flymake-bean-check--run-a)
|
||||
|
||||
;; HACK: This enhances completion for beancount-mode in the following ways:
|
||||
;;
|
||||
;; 1. Adds completion for:
|
||||
;; - Event directives and values,
|
||||
;; - The payee field in transactions,
|
||||
;; - Currencies and commodities,
|
||||
;; 2. Fixes completion for #tag and ^links not working at the end of a
|
||||
;; transaction's heading.
|
||||
;; 3. Completion now scans not only the current file, but any included files
|
||||
;; (recursively) for candidates. See `+beancount-files' to configure
|
||||
;; this. This applies not only to completion-at-point functions, but also
|
||||
;; interactive commands like `beancount-insert-account'.
|
||||
;; REVIEW: PR this upstream!
|
||||
(advice-add #'beancount-completion-at-point :override #'+beancount-completion-at-point-a)
|
||||
(advice-add #'beancount-get-account-names :override #'+beancount-get-account-names-a)
|
||||
|
||||
(map! :map beancount-mode-map
|
||||
:m "[[" #'+beancount/previous-transaction
|
||||
|
||||
Reference in New Issue
Block a user