diff --git a/modules/lang/beancount/autoload/advice.el b/modules/lang/beancount/autoload/advice.el index 8bcb0790a..624d3f880 100644 --- a/modules/lang/beancount/autoload/advice.el +++ b/modules/lang/beancount/autoload/advice.el @@ -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) diff --git a/modules/lang/beancount/config.el b/modules/lang/beancount/config.el index 1e2e22436..c72ff6e07 100644 --- a/modules/lang/beancount/config.el +++ b/modules/lang/beancount/config.el @@ -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