branch: elpa/beancount
commit 146b84da97f20a78c4a1a71026da7f25b882c5b9
Author: Vladimir Kazanov <[email protected]>
Commit: Vladimir Kazanov <[email protected]>
tags and links support for xref definitions/references/apropos
---
beancount-tests.el | 104 +++++++++++++++++++++++++++++++++++++++++++++--------
beancount.el | 64 ++++++++++++++++++++++++++-------
2 files changed, 141 insertions(+), 27 deletions(-)
diff --git a/beancount-tests.el b/beancount-tests.el
index 26a86ee988..6b07085ae8 100644
--- a/beancount-tests.el
+++ b/beancount-tests.el
@@ -368,7 +368,7 @@ POSITION provided by Beancount's xref-backend-definitions
lookup."
(xref-buffer-location-position loc))))
(should (equal pos position)))))
-(ert-deftest beancount/xref-backend-definitions ()
+(ert-deftest beancount/xref-backend-definitions-accounts ()
:tags '(xref)
(with-temp-buffer
(insert "
@@ -384,23 +384,54 @@ POSITION provided by Beancount's xref-backend-definitions
lookup."
(beancount-test-xref-definition-pos "Assets:Account2" 41)
(beancount-test-xref-definition-pos "Assets:Account3" 80)))
+(ert-deftest beancount/xref-backend-definitions-tags ()
+ :tags '(xref)
+ (with-temp-buffer
+ (insert "
+2019-01-10 * \"Opening Balances\" #tag1
+ Equity:Opening-Balances
+ Assets:Account1 1.00 TDB900
+
+2019-01-10 * \"Opening Balances\" #tag2
+ Equity:Opening-Balances
+ Assets:Account1 1.00 TDB900
+")
+ (beancount-test-xref-definition-pos "#tag1" 35)
+ (beancount-test-xref-definition-pos "#tag2" 138)))
+
+(ert-deftest beancount/xref-backend-definitions-links ()
+ :tags '(xref)
+ (with-temp-buffer
+ (insert "
+2019-01-10 * \"Opening Balances\" #link1
+ Equity:Opening-Balances
+ Assets:Account1 1.00 TDB900
+
+2019-01-10 * \"Opening Balances\" #link2
+ Equity:Opening-Balances
+ Assets:Account1 1.00 TDB900
+")
+ (beancount-test-xref-definition-pos "#link1" 35)
+ (beancount-test-xref-definition-pos "#link2" 139)))
+
+
(defmacro beancount-with-temp-file (&rest body)
"Generate a temporary file and open it as a current buffer.
Run BODY forms in the buffer's context. Remove both the buffer
and a backing file having completed the test."
(declare (indent 1))
`(let ((file (make-temp-file "beancount-test-"))
- buf)
- (unwind-protect
- (progn (setq buf (find-file-literally file))
- ,@body)
- (ignore-errors (delete-file file))
- (ignore-errors
- (with-current-buffer buf
- (set-buffer-modified-p nil))
- (kill-buffer buf)))))
-
-(ert-deftest beancount/xref-backend-references ()
+ buf)
+ (unwind-protect
+ (progn (setq buf (find-file-literally file))
+ ,@body)
+ (ignore-errors (delete-file file))
+ (ignore-errors
+ (with-current-buffer buf
+ (set-buffer-modified-p nil))
+ (kill-buffer buf)))))
+
+(ert-deftest beancount/xref-backend-references-accounts ()
:tags '(xref)
;; Creating Xref file locations assumes a buffer backed by a file.
(beancount-with-temp-file
@@ -423,6 +454,46 @@ and a backing file having completed the test."
(should (equal (length (xref-backend-references 'beancount
"Assets:Account2")) 2))
(should (equal (length (xref-backend-references 'beancount
"Assets:Account3")) 1))))
+(ert-deftest beancount/xref-backend-references-tags ()
+ :tags '(xref)
+ ;; Creating Xref file locations assumes a buffer backed by a file.
+ (beancount-with-temp-file
+ (insert "
+2019-01-10 * \"More Balances\" #tag1
+ Equity:Opening-Balances
+ Assets:Account1 1.00 TDB900
+
+2019-01-10 * \"Opening Balances\" #tag2
+ Assets:Account1 1.00 TDB900
+ Assets:Account2 2.00 TDB900
+
+2019-01-10 * \"More Balances\" #tag2
+ Equity:Opening-Balances
+ Assets:Account1 1.00 TDB900
+")
+ (should (equal (length (xref-backend-references 'beancount "#tag1")) 1))
+ (should (equal (length (xref-backend-references 'beancount "#tag2")) 2))))
+
+(ert-deftest beancount/xref-backend-references-links ()
+ :tags '(xref)
+ ;; Creating Xref file locations assumes a buffer backed by a file.
+ (beancount-with-temp-file
+ (insert "
+2019-01-10 * \"More Balances\" ^link1
+ Equity:Opening-Balances
+ Assets:Account1 1.00 TDB900
+
+2019-01-10 * \"Opening Balances\" ^link1
+ Assets:Account1 1.00 TDB900
+ Assets:Account2 2.00 TDB900
+
+2019-01-10 * \"More Balances\" ^link2
+ Equity:Opening-Balances
+ Assets:Account1 1.00 TDB900
+")
+ (should (equal (length (xref-backend-references 'beancount "^link1")) 2))
+ (should (equal (length (xref-backend-references 'beancount "^link2")) 1))))
+
(ert-deftest beancount/xref-backend-apropos ()
:tags '(xref)
;; Creating Xref file locations assumes a buffer backed by a file.
@@ -432,12 +503,12 @@ and a backing file having completed the test."
2019-01-01 open Assets:Account2 TDB900
2019-01-01 open Assets:Account3 TDB900
-2019-01-10 * \"Opening Balances\"
+2019-01-10 * \"Opening Balances\" #tag ^link1
Equity:Opening-Balances
Assets:Account1 1.00 TDB900
Assets:Account2 2.00 TDB900
-2019-01-10 * \"More Balances\"
+2019-01-10 * \"More Balances\" #tag ^link2
Equity:Opening-Balances
Assets:Account1 1.00 TDB900
@@ -447,4 +518,7 @@ and a backing file having completed the test."
(should (equal (length (xref-backend-apropos 'beancount "Assets
Account1")) 3))
(should (equal (length (xref-backend-apropos 'beancount "Equity")) 2))
(should (equal (length (xref-backend-apropos 'beancount "Opening")) 2))
- (should (equal (length (xref-backend-apropos 'beancount "Opening Assets"))
0))))
+ (should (equal (length (xref-backend-apropos 'beancount "Opening Assets"))
0))
+ (should (equal (length (xref-backend-apropos 'beancount "tag")) 2))
+ (should (equal (length (xref-backend-apropos 'beancount "link1")) 1))
+ (should (equal (length (xref-backend-apropos 'beancount "link2")) 1))))
diff --git a/beancount.el b/beancount.el
index b0ed7a9cfd..00ffb15844 100644
--- a/beancount.el
+++ b/beancount.el
@@ -37,6 +37,7 @@
(require 'cl-lib)
(require 'xref)
(require 'apropos)
+(require 'rx)
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.beancount\\'" . beancount-mode))
@@ -270,6 +271,12 @@ from the open directive for the relevant account."
;; used in determining the outline level in `beancount-outline-level'.
(defvar beancount-outline-regexp "\\(;;;+\\|\\*+\\)")
+;; Regular expression for all symbols recognised by the Xref backend.
+(defconst beancount-xref-symbol-regexp
+ (rx-to-string `(or (regexp ,beancount-account-regexp)
+ (regexp ,(concat "#[" beancount-tag-chars "]+"))
+ (regexp ,(concat "\\^[" beancount-tag-chars "]+")))))
+
(defun beancount-outline-level ()
(let ((len (- (match-end 1) (match-beginning 1))))
(if (string-equal (substring (match-string 1) 0 1) ";")
@@ -1021,6 +1028,12 @@ Only useful if you have not installed Beancount properly
in your PATH.")
(put 'beancount-link 'bounds-of-thing-at-point
#'beancount--bounds-of-link-at-point)
+(defun beancount--bounds-of-tag-at-point ()
+ (when (thing-at-point-looking-at (concat "\\#[" beancount-tag-chars "]+")
128)
+ (cons (match-beginning 0) (match-end 0))))
+
+(put 'beancount-tag 'bounds-of-thing-at-point
#'beancount--bounds-of-tag-at-point)
+
(defun beancount-linked ()
"Get the \"linked\" info from `beancount-doctor-program'."
(interactive)
@@ -1264,20 +1277,45 @@ Essentially a much simplified version of `next-line'."
(cl-defmethod xref-backend-definitions ((_ (eql beancount)) identifier)
"Find definitions of IDENTIFIER."
- (let ((buf (current-buffer)))
+ (let ((buf (current-buffer))
+ re mgroup)
+ (cond
+ ;; tag
+ ((string-prefix-p "#" identifier)
+ (setq re (concat "#[" beancount-tag-chars "]+"))
+ (setq mgroup 0))
+ ;; link
+ ((string-prefix-p "^" identifier)
+ (setq re (concat "\\^[" beancount-tag-chars "]+"))
+ (setq mgroup 0))
+ ;; account
+ (t
+ (setq re beancount-open-directive-regexp)
+ (setq mgroup 3)))
(cl-loop
- for (def-id . def-pos) in
- (beancount-collect-pos-alist beancount-open-directive-regexp 3)
- if (equal def-id identifier)
- collect
- (xref-make def-id (xref-make-buffer-location buf def-pos)))))
+ for (def-id . def-pos) in
+ (beancount-collect-pos-alist re mgroup)
+ if (equal def-id identifier)
+ collect
+ (xref-make def-id (xref-make-buffer-location buf def-pos)))))
(cl-defmethod xref-backend-references ((_ (eql beancount)) identifier)
"Find references of IDENTIFIER."
- (let ((fname (buffer-file-name)))
+ (let ((fname (buffer-file-name))
+ re)
+ (setq re
+ (cond
+ ;; tag
+ ((string-prefix-p "#" identifier)
+ (concat "#[" beancount-tag-chars "]+"))
+ ;; link
+ ((string-prefix-p "^" identifier)
+ (concat "\\^[" beancount-tag-chars "]+"))
+ ;; account
+ (t beancount-account-regexp)))
(cl-loop
for (ref-id . ref-pos) in
- (beancount-collect-pos-alist beancount-account-regexp 0)
+ (beancount-collect-pos-alist re 0)
if (equal ref-id identifier)
collect
(xref-make ref-id
@@ -1301,7 +1339,7 @@ Essentially a much simplified version of `next-line'."
(fname (buffer-file-name)))
(cl-loop
for (ref-id . ref-pos) in
- (beancount-collect-pos-alist beancount-account-regexp 0)
+ (beancount-collect-pos-alist beancount-xref-symbol-regexp 0)
if (string-match-p pattern-re ref-id)
collect
(xref-make ref-id
@@ -1309,12 +1347,14 @@ Essentially a much simplified version of `next-line'."
fname (line-number-at-pos ref-pos) 0)))))
(cl-defmethod xref-backend-identifier-completion-table ((_ (eql beancount)))
- (beancount-get-account-names))
+ (beancount-collect-unique beancount-xref-symbol-regexp 0))
(cl-defmethod xref-backend-identifier-at-point ((_ (eql beancount)))
"Extract a symbol at point, check if it is an account, return it"
- (when-let ((acc (thing-at-point 'beancount-account)))
- (substring-no-properties acc)))
+ (when-let ((thing (or (thing-at-point 'beancount-account)
+ (thing-at-point 'beancount-link)
+ (thing-at-point 'beancount-tag))))
+ (substring-no-properties thing)))
(provide 'beancount)
;;; beancount.el ends here
