You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
842 lines
31 KiB
842 lines
31 KiB
;;; package --- Summary
|
|
;;; Commentary:
|
|
;; A humble try to port leder-mode to beancount
|
|
|
|
;;; Code:
|
|
|
|
(require 'font-lock)
|
|
;(require 'company) ; for company-mode
|
|
(require 'pcomplete)
|
|
(require 'cl-lib)
|
|
(require 'subr-x) ; for hash-table-keys
|
|
|
|
(defgroup beancount ()
|
|
"Editing mode for beancount files."
|
|
:group 'beancount)
|
|
|
|
(defconst beancount-timestamped-directive-names
|
|
'("balance"
|
|
"open"
|
|
"close"
|
|
"pad"
|
|
"document"
|
|
"note"
|
|
;; the ones below are not followed by an account name.
|
|
"event"
|
|
"price"
|
|
"commodity"
|
|
"query"
|
|
"txn"
|
|
"*")
|
|
"Directive names that can appear after a date.")
|
|
|
|
(defconst beancount-account-categories
|
|
'("Assets"
|
|
"Liabilities"
|
|
"Equity"
|
|
"Income"
|
|
"Expenses"
|
|
; TODO: Fill changed root accounts automatically
|
|
"Aktiva"
|
|
"Verbindlichkeiten"
|
|
"Eigenkapital"
|
|
"Ertraege"
|
|
"Aufwendungen"))
|
|
|
|
(defconst beancount-nontimestamped-directive-names
|
|
'("pushtag"
|
|
"poptag"
|
|
"option"
|
|
"include"
|
|
"plugin")
|
|
"Directive names that can appear after a date.")
|
|
|
|
(defconst beancount-option-names
|
|
;; this list has to be kept in sync with the options definied in
|
|
;; beancount/parser/options.py
|
|
'("title"
|
|
"name_assets"
|
|
"name_equity"
|
|
"name_income"
|
|
"name_expenses"
|
|
"bookin_algorithm"
|
|
"bookin_method"
|
|
"account_previous_balances"
|
|
"account_previous_earnings"
|
|
"account_previous_conversions"
|
|
"account_current_earnings"
|
|
"account_current_conversions"
|
|
"account_rounding"
|
|
"conversion_currency"
|
|
"inferred_tolerance_default"
|
|
"inferred_tolerance_multiplier"
|
|
"infer_tolerance_from_cost"
|
|
"documents"
|
|
"operating_currency"
|
|
"render_commas"
|
|
"plugin_processing_mode"
|
|
"plugin"
|
|
"long_string_maxlines"
|
|
))
|
|
|
|
(defconst beancount-directive-names
|
|
(append beancount-nontimestamped-directive-names
|
|
beancount-timestamped-directive-names)
|
|
"A list of directive names.")
|
|
|
|
(defconst beancount-tag-chars
|
|
"[:alnum:]-_/."
|
|
"Allowed tag characters.")
|
|
|
|
(defconst beancount-account-chars
|
|
"[:alnum:]-_:"
|
|
"Allowed account characters.")
|
|
|
|
(defconst beancount-account-regexp
|
|
"^[ ][ ][a-z]+"
|
|
; (concat (regexp-opt beancount-account-categories)
|
|
;; (rx line-start (seq space
|
|
;; space
|
|
;; (or (literal (regexp-opt beancount-account-categories)))
|
|
;; ; (or "Aufwendungen" "Ertraege")
|
|
;; (zero-or-more (seq ":"
|
|
;; (one-or-more (any alnum "-_"))))))
|
|
; (concat (regexp-opt beancount-account-categories)
|
|
; "\\(?::[[:upper:]][" beancount-account-chars "]+\\)")
|
|
"A regular expression to match account names.")
|
|
|
|
; TODO: currently shows all texts between ""
|
|
(defconst beancount-payee-regexp
|
|
"\"\\(.*?\\)\"")
|
|
|
|
(defconst beancount-date-regexp
|
|
|
|
"^[12][901][0-9]\\{2\\}-\\(0[1-9]\\|1[012]\\)-\\([012][0-9]\\|3[01]\\)"
|
|
"Regular expression for dates.")
|
|
|
|
(defconst beancount-number-regexp
|
|
"[-+]?[0-9,]+\\(?:\\.[0-9]*\\)"
|
|
"Regular expression to match decimal numbers.")
|
|
|
|
(defconst beancount-tag-regexp
|
|
(concat "#"
|
|
"["
|
|
beancount-tag-chars
|
|
"]+")
|
|
"Regular expression for valid tags.")
|
|
|
|
(defconst beancount-currency-regexp
|
|
"[A-Z][A-Z-_'.]*"
|
|
"Regular expression to match currencies.")
|
|
|
|
|
|
(defconst beancount-timestamped-accounts-regexp
|
|
(concat beancount-date-regexp
|
|
" " ;"\\(\\s-+\\)"
|
|
(regexp-opt beancount-timestamped-directive-names)
|
|
" ") ;"\\(\\s-+\\)")
|
|
"A regular expression to match valid preceding characters before an account name.")
|
|
|
|
(defconst beancount-amount-and-currency-regex
|
|
"\s-*[-]?[0-9,]+[.][0-9]\\{2\\}\s[A-Za-z0-9.]+"
|
|
"A regular expression for amounts including currency.")
|
|
|
|
(defconst beancount-payee-any-status-regex
|
|
"^[0-9]+[-/][-/.=0-9]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.+?\\)\\s-*\\(;\\|$\\)")
|
|
|
|
(defconst beancount-date-and-status-regex
|
|
(concat beancount-date-regexp
|
|
"\\(\\s-+[\\*!]\\)")
|
|
"Returns true for YYYY-MM-DD ! and YYYY-MM-DD *.")
|
|
|
|
(defconst beancount-valid-prefix-for-directives-regex
|
|
(concat "^"
|
|
beancount-date-regexp
|
|
"[ ]+"
|
|
"[a-z]*$"))
|
|
|
|
(defconst beancount-prefix-for-payee-regex
|
|
(concat beancount-date-and-status-regex
|
|
" \"" ; space and opening quotes
|
|
"\\(?1:" ; opening term, calling it segment 1
|
|
"[^\"\n]*" ; any number of chars except quotes and newline
|
|
"\\)" ; closing term
|
|
))
|
|
|
|
(defconst beancount-prefix-for-payeetext-regex
|
|
(concat beancount-date-and-status-regex
|
|
"\\s-+\"" ; space and opening quotes
|
|
"[^\"\n]*" ; any number of chars except quotes and newline
|
|
"\"" ; closing quotes
|
|
"\\s-+\"" ; space and opening quotes
|
|
"\\(?1:" ; opening term, calling it segment 1
|
|
"[^\"\n]*" ; any number of chars except quotes and newline
|
|
"\\)" ; closing term
|
|
))
|
|
|
|
(defconst beancount-valid-prefix-for-payee-completion-regex
|
|
(concat "\\("
|
|
beancount-date-and-status-regex
|
|
" \"" ; empty space and open quotes
|
|
"[^\"\n]*" ; any number of chars except quotes and newline
|
|
"\\(" ; start of optional second quoted term
|
|
"\"[ ]+\"" ; closing quotes, whitespaces, opening quotes
|
|
"[^\"\n]*" ; any number of chars except quotes and newline
|
|
"\\)?" ; end of optional second quoted term
|
|
"\\)$" ; the whole regex looks from the right side of the line
|
|
))
|
|
|
|
(defconst beancount-prefix-for-tag-completion-regex
|
|
(concat ;"\\("
|
|
beancount-date-and-status-regex
|
|
"\\s-+\"" ; empty space and open quotes
|
|
"[^\"\n]*" ; any number of chars except quotes and newline
|
|
; "\\(" ; start of optional second quoted term
|
|
"\"\\s-+\"" ; closing quotes, whitespaces, opening quotes
|
|
"[^\"\n]*" ; any number of chars except quotes and newline
|
|
"\"" ; end of optional second quoted term
|
|
"\\s-+#"
|
|
"\\(?1:"
|
|
"[^\"\n]*"
|
|
"\\)"
|
|
))
|
|
|
|
(defconst beancount-comments-regex
|
|
(concat ";[^\"\n]*$")) ; right part of the line after a comment symbol if no quote or newline is included
|
|
|
|
(defconst beancount-empty-line-regex
|
|
"^\\(\\s-+\\)" ;; maybe "^[ \t]+" is better
|
|
"Returns true for preceding whitespaces.")
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Faces
|
|
(defgroup beancount-faces nil "Beancount mode highlighting" :group 'beancount)
|
|
|
|
(defface beancount-font-default-face
|
|
`((t :inherit default))
|
|
"Default face"
|
|
:group 'beancount-faces)
|
|
|
|
(defface beancount-font-xact-cleared-face
|
|
`((t :foreground "#AAAAAA" :weight normal))
|
|
"Default face for cleared transactions"
|
|
:group 'beancount-faces)
|
|
|
|
(defface beancount-font-xact-pending-face
|
|
`((t :foreground "#dc322f" :weight bold))
|
|
"Default face for pending transactions"
|
|
:group 'beancount-faces)
|
|
|
|
(defface beancount-font-payee-cleared-face
|
|
`((t :inherit beancount-font-other-face))
|
|
"Default face for pending transactions"
|
|
:group 'beancount-faces)
|
|
|
|
(defface beancount-font-payee-pending-face
|
|
`((t :foreground "#f24b61" :weight normal))
|
|
"Default face for pending (!) transactions"
|
|
:group 'beancount-faces)
|
|
|
|
(defface beancount-font-other-face
|
|
`((t :foreground "#657b83" :weight normal))
|
|
"Default face for other transactions"
|
|
:group 'beancount-faces)
|
|
|
|
(defface beancount-font-posting-date-face
|
|
`((t :foreground "#cb4b16" :weight normal))
|
|
"Default face for dates"
|
|
:group 'beancount-faces)
|
|
|
|
(defface beancount-font-amount-face
|
|
`((t :foreground "#cb4b16" :weight normal))
|
|
"Default face for amounts"
|
|
:group 'beancount-faces)
|
|
|
|
|
|
(defvar beancount-font-lock-directives
|
|
`(;; reserved keywords
|
|
(,(concat beancount-date-regexp
|
|
"\\s-+\\(?1:"
|
|
(regexp-opt beancount-directive-names)
|
|
"\\)")
|
|
. (1 font-lock-keyword-face)) ; use group one of regex search for highlighting, not the whole result
|
|
;; tags & links
|
|
("[#\\^][A-Za-z0-9\-_/.]+" . font-lock-type-face)
|
|
;; comments
|
|
(,beancount-comments-regex (0 font-lock-comment-face))
|
|
;; date
|
|
(,beancount-date-regexp . 'beancount-font-posting-date-face)
|
|
;; account
|
|
(,beancount-account-regexp . 'beancount-font-other-face)
|
|
;; payees
|
|
("\"\\(.*?\\)\"" . font-lock-comment-face)
|
|
;; txn warning
|
|
("! " . font-lock-warning-face)
|
|
))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Alignments
|
|
|
|
(defmacro beancount-for-line-in-region (begin end &rest exprs)
|
|
"Iterate over each line in region from BEGIN to END (EXPRS)
|
|
until an empty line is encountered."
|
|
`(save-excursion
|
|
(let ((end-marker (copy-marker ,end)))
|
|
(goto-char ,begin)
|
|
(beginning-of-line)
|
|
(while (and (not (eobp)) (< (point) end-marker))
|
|
(beginning-of-line)
|
|
(progn ,@exprs)
|
|
(forward-line 1)
|
|
))))
|
|
|
|
(defun beancount-align-numbers (begin end)
|
|
"Align all numbers in the current buffer from BEGIN to END."
|
|
(interactive "r")
|
|
|
|
;; loop once in the buffer to find the length of the longest string before the
|
|
;; number.
|
|
(let (prefix-widths
|
|
number-widths
|
|
(number-padding " "))
|
|
(beancount-for-line-in-region
|
|
begin end
|
|
(let ((line (thing-at-point 'line)))
|
|
(when (string-match (concat "\\(.*?\\)"
|
|
"[ \t]+"
|
|
"\\(" beancount-number-regexp "\\)"
|
|
"[ \t]+"
|
|
beancount-currency-regexp)
|
|
line)
|
|
(push (length (match-string 1 line)) prefix-widths)
|
|
(push (length (match-string 2 line)) number-widths)
|
|
)))
|
|
|
|
(when prefix-widths
|
|
;; Loop again to make the adjustments to the numbers.
|
|
(let* ((number-width (apply 'max number-widths))
|
|
(number-format (format "%%%ss" number-width))
|
|
;; compute the rightmost column of prefix
|
|
(max-prefix-width (apply 'max prefix-widths))
|
|
(prefix-format (format "%%-%ss" max-prefix-width))
|
|
)
|
|
|
|
(beancount-for-line-in-region
|
|
begin end
|
|
(let ((line (thing-at-point 'line)))
|
|
(when (string-match (concat "^\\([^\"]*?\\)"
|
|
"[ \t]+"
|
|
"\\(" beancount-number-regexp "\\)"
|
|
"[ \t]+"
|
|
"\\(.*\\)$")
|
|
line)
|
|
(delete-region (line-beginning-position) (line-end-position))
|
|
(let* ((prefix (match-string 1 line))
|
|
(number (match-string 2 line))
|
|
(rest (match-string 3 line)))
|
|
(insert (format prefix-format prefix))
|
|
(insert number-padding)
|
|
(insert (format number-format number))
|
|
(insert " ")
|
|
(insert rest)))))))))
|
|
|
|
|
|
(defun beancount-hash-keys (hashtable)
|
|
"Extract all the keys of the given HASHTABLE. Return a sorted list."
|
|
(let (rlist)
|
|
(maphash (lambda (k _v) (push k rlist)) hashtable)
|
|
(sort rlist 'string<)))
|
|
|
|
(defvar beancount-accounts nil
|
|
"A list of the accounts available in this buffer.
|
|
This is a cache of the value computed by `beancount-get-accounts'.")
|
|
(make-variable-buffer-local 'beancount-accounts)
|
|
|
|
(defun beancount-init-accounts ()
|
|
"Initialize or reset the list of accounts."
|
|
(interactive)
|
|
(setq beancount-accounts (beancount-get-accounts-in-buffer)) ;-new
|
|
(pcomplete-uniqify-list (nreverse beancount-accounts))
|
|
(message "Accounts updated."))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Navigation
|
|
|
|
(defun beancount-navigate-start-xact-or-directive-p ()
|
|
"Return t if at the beginning of an empty or all-whitespace line."
|
|
(not (looking-at "[ \t]\\|\\(^$\\)")))
|
|
|
|
(defun beancount-navigate-prev-xact-or-directive ()
|
|
"Move to the beginning of the next xact or directive."
|
|
(interactive)
|
|
(beginning-of-line)
|
|
(if (beancount-navigate-start-xact-or-directive-p) ;if we are at the start of an xact, move backward to the previous xact
|
|
(progn
|
|
(forward-line -1)
|
|
(if (not (beancount-navigate-start-xact-or-directive-p)) ; we have moved backward and are not at another xact, recurse backward
|
|
(beancount-navigate-prev-xact-or-directive)))
|
|
(while (not (or (bobp)
|
|
(beancount-navigate-start-xact-or-directive-p)))
|
|
(forward-line -1))))
|
|
|
|
(defun beancount-navigate-next-xact-or-directive ()
|
|
"Move to the beginning of the next xact or directive."
|
|
(interactive)
|
|
(beginning-of-line)
|
|
(if (beancount-navigate-start-xact-or-directive-p) ; if we are at the start of an xact, move forward to the next xact
|
|
(progn
|
|
(forward-line)
|
|
(if (not (beancount-navigate-start-xact-or-directive-p)) ; we have moved forward and are not at another xact, recurse forward
|
|
(beancount-navigate-next-xact-or-directive)))
|
|
(while (not (or (eobp) ; we didn't stsrt off at the beginning of an xact
|
|
(beancount-navigate-start-xact-or-directive-p)))
|
|
(forward-line))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Completion
|
|
|
|
(defun beancount-thing-at-point ()
|
|
"Describe thing at points. Return 'transaction, 'posting, or nil.
|
|
Leave point at the beginning of the thing under point.")
|
|
|
|
(defun beancount-trim-trailing-whitespace (str)
|
|
"Replace trailing whitespaces in STR."
|
|
(replace-regexp-in-string "[ \t]*$" "" str))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Functions for external programs
|
|
|
|
(defvar beancount-filename-main buffer-file-name
|
|
"File name of the main beancount file for beancount-check.")
|
|
|
|
(defvar beancount-terminal-name "kitty"
|
|
"Name of the terminal emulator to run fava.")
|
|
|
|
(defvar beancount-fava-exec "/bin/fava"
|
|
"Full path of fava executable.")
|
|
|
|
(defvar beancount-install-dir nil
|
|
"Directory in which Beancount's source is located.
|
|
Only useful if you have not installed Beancount properly in your PATH")
|
|
|
|
(defun beancount--run (prog &rest args)
|
|
"Random text PROG ARGS."
|
|
(let ((process-environment
|
|
(if beancount-install-dir
|
|
`(,(concat "PYTHONPATH=" beancount-install-dir)
|
|
,(concat "PATH="
|
|
(expand-file-name "bin" beancount-install-dir)
|
|
":"
|
|
(getenv "PATH"))
|
|
,@process-environment)
|
|
process-environment))
|
|
(compile-command (mapconcat (lambda (arg)
|
|
(if (stringp arg)
|
|
(shell-quote-argument arg) ""))
|
|
(cons prog args)
|
|
" ")))
|
|
(call-interactively 'compile)))
|
|
|
|
(defvar beancount-check-program "bean-check"
|
|
"Program to run the parser and validator on an input file.")
|
|
|
|
(defun beancount-check ()
|
|
"Run `beancount-check-program'."
|
|
(interactive)
|
|
(let ((compilation-read-command nil))
|
|
(beancount--run beancount-check-program beancount-filename-main)))
|
|
; (file-relative-name buffer-file-name))))
|
|
|
|
(defun beancount-fava ()
|
|
"Run `beancount-fava' and open the URL in the default browser."
|
|
(interactive)
|
|
(start-process "termx" nil beancount-terminal-name "-e" beancount-fava-exec beancount-filename-main)
|
|
(sleep-for 0.5) ; necessary to prevent an error
|
|
(browse-url "127.0.0.1:5000"))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Completions
|
|
|
|
(defun beancount-get-accounts-in-buffer ()
|
|
"Return a list of all accounts."
|
|
(let ((origin (point))
|
|
accounts-list)
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (re-search-forward
|
|
beancount-account-regexp nil t)
|
|
(setq accounts-list (cons (match-string-no-properties 0)
|
|
accounts-list))))
|
|
(pcomplete-uniquify-list (nreverse accounts-list))))
|
|
|
|
(defun beancount-get-payees-in-buffer ()
|
|
"Return a list of all payees."
|
|
(let ((origin (point))
|
|
payees-list)
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (re-search-forward
|
|
"^[0-9- *]*\"\\(?1:.*?\\)\" \"\\(?2:.*?\\)\"" nil t) ; matches are in brackets
|
|
(setq payees-list (cons (match-string-no-properties 1) ; get first match, generally the payee
|
|
payees-list))))
|
|
(pcomplete-uniquify-list (nreverse payees-list))))
|
|
|
|
(defun beancount-get-payee-text-in-buffer ()
|
|
"Return a list of all payees."
|
|
(let ((origin (point))
|
|
payees-text-list)
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (re-search-forward
|
|
"^[0-9- *]*\"\\(?1:.*?\\)\" \"\\(?2:.*?\\)\"" nil t) ; matches are in brackets
|
|
(setq payees-text-list (cons (match-string-no-properties 2) ; get second match, generally a description
|
|
payees-text-list))))
|
|
(pcomplete-uniquify-list (nreverse payees-text-list))))
|
|
|
|
(defun beancount-get-tags-in-buffer ()
|
|
"Return a list of all tags."
|
|
(let ((origin (point))
|
|
tags-list)
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (re-search-forward
|
|
beancount-tag-regexp nil t)
|
|
(setq tags-list (cons (substring (match-string-no-properties 0) 1)
|
|
tags-list))))
|
|
(pcomplete-uniquify-list (nreverse tags-list))))
|
|
|
|
(defun beancount-get-commodities-in-buffer ()
|
|
"Return a list of all commodities / currencies."
|
|
(let ((origin (point))
|
|
commodities-list)
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (re-search-forward
|
|
"^[ ]+[A-Za-z0-9-_:]+[ ]+[-]?[0-9,.]+[ ]+\\([A-Z][A-Z0-9-_.']*[A-Z0-9]\\)" nil t)
|
|
(setq commodities-list (cons (match-string-no-properties 1)
|
|
commodities-list))))
|
|
(pcomplete-uniquify-list (nreverse commodities-list))))
|
|
|
|
|
|
(defun beancount-company--regexp-filter (regexp list)
|
|
"Use REGEXP to filter LIST of strings."
|
|
(let (new)
|
|
(dolist (string list)
|
|
(when (string-match regexp string)
|
|
(setq new (cons string new))))
|
|
;;new
|
|
(setq new (nreverse new))
|
|
; (setq new (reverse new))
|
|
new))
|
|
|
|
(defun beancount-get-transactions-in-buffer ()
|
|
"Return a list of all transactions."
|
|
(beancount-company--regexp-filter
|
|
"[0-9][0-9][0-9][0-9][-/][0-9][0-9][-/][0-9][0-9]"
|
|
(mapcar (lambda (s) (substring s 1))
|
|
(split-string (buffer-string) "^$" t))))
|
|
|
|
(defun beancount-company--fuzzy-word-match (prefix candidate)
|
|
"Return non-nil if each (partial) word in PREFIX is also in CANDIDATE."
|
|
(eq nil
|
|
(memq nil
|
|
(mapcar
|
|
(lambda (pre) (string-match-p (regexp-quote pre) candidate))
|
|
(split-string prefix)))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Finishing setup
|
|
|
|
(defvar beancount-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map [(meta ?p)] #'beancount-navigate-prev-xact-or-directive)
|
|
(define-key map [(meta ?n)] #'beancount-navigate-next-xact-or-directive)
|
|
map)
|
|
"Keymap for `bean-mode'.")
|
|
|
|
(easy-menu-define beancount-mode-menu beancount-mode-map
|
|
"Beancount menu"
|
|
'("Beancount"
|
|
["Customize Ledger Mode" (lambda () (interactive) (customize-group 'beanmode))]))
|
|
|
|
(defvar beancount-accounts-cache nil
|
|
"List of accounts cached for capf.")
|
|
|
|
(defvar beancount-payees-cache nil
|
|
"List of payees cached for capf.")
|
|
|
|
(defvar beancount-payeetext-cache nil
|
|
"List of payee texts cached for capf.")
|
|
|
|
(defvar beancount-tags-cache nil
|
|
"List of tags cached for capf.")
|
|
|
|
(defvar beancount-commodities-cache nil
|
|
"List of commodities / currencies cached for capf.")
|
|
|
|
(defun beancount-update-payees-text ()
|
|
"Get list of all payees text in current buffer."
|
|
(interactive)
|
|
(setq beancount-payeetext-cache (beancount-get-payee-text-in-buffer)) ;-new
|
|
(pcomplete-uniquify-list (nreverse beancount-payeetext-cache)))
|
|
|
|
(defun beancount-update-accounts-and-payees ()
|
|
"Initialize or reset the list of accounts."
|
|
(interactive)
|
|
(setq beancount-accounts-cache (beancount-get-accounts-in-buffer)) ;-new
|
|
(pcomplete-uniquify-list (nreverse beancount-accounts-cache))
|
|
(message "Accounts updated.")
|
|
|
|
(setq beancount-payees-cache (beancount-get-payees-in-buffer)) ;-new
|
|
(pcomplete-uniquify-list (nreverse beancount-payees-cache))
|
|
(message "Payees updated.")
|
|
|
|
(setq beancount-payeetext-cache (beancount-get-payee-text-in-buffer)) ;-new
|
|
(pcomplete-uniquify-list (nreverse beancount-payeetext-cache))
|
|
(message "Payee texts updated.")
|
|
|
|
(setq beancount-commodities-cache (beancount-get-commodities-in-buffer))
|
|
(pcomplete-uniquify-list (nreverse beancount-commodities-cache))
|
|
|
|
(setq beancount-tags-cache (beancount-get-tags-in-buffer))
|
|
(pcomplete-uniquify-list (nreverse beancount-tags-cache))
|
|
(message "Tags updated."))
|
|
|
|
;;##################################
|
|
;;stuff from https://github.com/debanjum/company-ledger/blob/master/company-ledger.el
|
|
|
|
(defun company-ledger--regexp-filter (regexp list)
|
|
"Use REGEXP to filter LIST of strings."
|
|
(let (new)
|
|
(dolist (string list)
|
|
(when (string-match regexp string)
|
|
(setq new (cons string new))))
|
|
new))
|
|
|
|
(defun company-ledger--get-all-postings ()
|
|
"Get all paragraphs in buffer containing YYYY[-/]MM[-/]DD in them."
|
|
(company-ledger--regexp-filter
|
|
"[0-9][0-9][0-9][0-9][-/][0-9][0-9][-/][0-9][0-9]"
|
|
(mapcar (lambda (s) (substring s 1))
|
|
(split-string (buffer-string) "^$" t))))
|
|
|
|
(defun company-ledger--fuzzy-word-match (prefix candidate)
|
|
"Return non-nil if each (partial) word in PREFIX is also in CANDIDATE."
|
|
(eq nil
|
|
(memq nil
|
|
(mapcar
|
|
(lambda (pre) (string-match-p (regexp-quote pre) candidate))
|
|
(split-string prefix)))))
|
|
|
|
(defun company-ledger--next-line-empty-p ()
|
|
"Return non-nil if next line empty else false."
|
|
(save-excursion
|
|
(beginning-of-line)
|
|
(forward-line 1)
|
|
(or (looking-at "[[:space:]]*$")
|
|
(eolp)
|
|
(eobp))))
|
|
|
|
;;#####################################
|
|
(defvar beancount-accounts nil
|
|
"A list of accounts available in buffer.")
|
|
(make-variable-buffer-local 'beancount-accounts)
|
|
|
|
(defcustom beancount-account-files nil
|
|
"A list of files to provide candidates for account completion."
|
|
:type 'list
|
|
:group 'beancount)
|
|
|
|
(defconst beancount-account-regexp
|
|
(concat (regexp-opt beancount-account-categories)
|
|
"\\(?::[[:upper:]][[:alnum:]-_]+\\)+")
|
|
"A regular expression to match account names.")
|
|
|
|
(defun beancount-collect (regexp n &optional files)
|
|
"Return a unique list of REGEXP group N in the current buffer.
|
|
Optionally also look at data in selected FILES."
|
|
(let ((pos (point)))
|
|
(save-excursion
|
|
(save-match-data
|
|
(let ((hash (make-hash-table :test 'equal)))
|
|
(goto-char (point-min))
|
|
(while (re-search-forward regexp nil t)
|
|
;; ignore matches around `pos' since that's presumably
|
|
;; what we are currently trying to complete.
|
|
(unless (<= (match-beginning 0) pos (match-end 0))
|
|
(puthash (match-string-no-properties n) nil hash)))
|
|
;; if `files' are provided, also look into them
|
|
(when files
|
|
(save-excursion
|
|
(dolist (f files)
|
|
(with-current-buffer (find-file-noselect f)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward regexp nil t)
|
|
(puthash (match-string-no-properties n) nil hash))))))
|
|
(hash-table-keys hash))))))
|
|
|
|
(defun beancount-account-completion-table (string pred action)
|
|
(if (eq action 'metadata) '(metadata (category . beancount-account))
|
|
(if (null beancount-accounts)
|
|
(setq beancount-accounts
|
|
(sort (beancount-collect beancount-account-regexp 0 beancount-account-files) #'string<)))
|
|
(complete-with-action action beancount-accounts string pred)))
|
|
|
|
(defun beancount-looking-at (regexp n pos)
|
|
(print (and (looking-at regexp)
|
|
(>= pos (match-beginning n))
|
|
(<= pos (match-end n))))
|
|
(and (looking-at regexp)
|
|
(>= pos (match-beginning n))
|
|
(<= pos (match-end n))))
|
|
|
|
;;;###autoload
|
|
(defun beancount-completion-at-point ()
|
|
"CAPF for corfu."
|
|
(interactive)
|
|
(save-excursion
|
|
(save-match-data
|
|
(let ((pos (point)))
|
|
(beginning-of-line)
|
|
(cond
|
|
;;works!!!! #####################
|
|
; explicity named group \\(?1:.....\\) for the matching part
|
|
; after date, if a letter follows, offer timestamped directives.
|
|
((beancount-looking-at (concat "\\(?2:" beancount-date-regexp "[ ]\\)" "\\(?1:[A-Za-z]*\\)") 1 pos)
|
|
(message "found test rx")
|
|
(list (match-beginning 1) (match-end 1)
|
|
(mapcar (lambda (s) (concat s " ")) beancount-timestamped-directive-names)))
|
|
;; if line starts with 2 spaces, offer accounts
|
|
;;works!!!! #####################
|
|
((beancount-looking-at "^[ ][ ][A-Za-z]+" 0 pos)
|
|
(message "found acc rx")
|
|
(list (match-beginning 0) (match-end 0)
|
|
(mapcar (lambda (s) (concat " " s)) beancount-accounts-cache)))
|
|
;; if line ends with date and status and an open quote, offer payees
|
|
;;works!!!! #####################
|
|
((beancount-looking-at beancount-prefix-for-payee-regex 1 pos)
|
|
(message "found payee rx")
|
|
(list (match-beginning 1) (match-end 1)
|
|
(mapcar (lambda (s) (concat s "\"")) beancount-payees-cache)))
|
|
;;works!!!! #####################
|
|
((beancount-looking-at beancount-prefix-for-payeetext-regex 1 pos)
|
|
; (beancount-update-payees-text)
|
|
(message "found payeetext rx")
|
|
(list (match-beginning 1) (match-end 1)
|
|
(mapcar (lambda (s) (concat s "\"")) beancount-payeetext-cache)))
|
|
;;works!!!! #####################
|
|
((beancount-looking-at beancount-prefix-for-tag-completion-regex 1 pos)
|
|
(message "found tags rx")
|
|
(list (match-beginning 1) (match-end 1)
|
|
beancount-tags-cache))
|
|
;; new function for whole transactions!
|
|
;; source https://github.com/debanjum/company-ledger/blob/master/company-ledger.el
|
|
;; TODO reverse list, newest one first
|
|
;; current workaround: keyword and year
|
|
((beancount-looking-at "^[A-za-z]+[A-za-z00-9 ]" 0 pos)
|
|
(list (match-beginning 0) (match-end 0)
|
|
; (lambda (c) (company-ledger--fuzzy-word-match arg c))
|
|
(company-ledger--get-all-postings)))
|
|
; (sort (company-ledger--get-all-postings) #'string-lessp)))
|
|
)))))
|
|
;; (sorted t))
|
|
|
|
; (list (match-beginning 1) (match-end 1)
|
|
; (mapcar (lambda (s) (concat s " ")) beancount-directive-names)))
|
|
; (delq nil
|
|
; (mapcar (lambda (c)
|
|
; (and (string-prefix-p arg c) c))
|
|
; beancount-payees-cache)))
|
|
;; ;; if line starts with date, offer directives
|
|
;; ((string-match-p beancount-valid-prefix-for-directives-regex (thing-at-point 'line))
|
|
;; (delq nil
|
|
;; (mapcar (lambda (c)
|
|
;; (and (string-prefix-p arg c) c))
|
|
;; beancount-timestamped-directive-names)))
|
|
;; ;; if line starts with date, status and payees, offer tags
|
|
;; ((string-match-p beancount-valid-prefix-for-tag-completion-regex (thing-at-point 'line))
|
|
;; (delq nil
|
|
;; (mapcar (lambda (c)
|
|
;; (and (string-prefix-p (substring arg 1) c) c))
|
|
;; beancount-tags-cache)))
|
|
;; ;; if line starts with accounts and amounts, offer commodities
|
|
;; ((string-match-p (concat "^[ ]+[A-Za-z0-9-_:]+[ ]+[-]?[0-9,.]+[ ]+" beancount-currency-regexp) (thing-at-point 'line))
|
|
;; (delq nil
|
|
;; (mapcar (lambda (c)
|
|
;; (and (string-prefix-p arg c) c))
|
|
;; beancount-commodities-cache)))
|
|
;; ;; if line is empty, offer accounts
|
|
; ((string-match-p "^\\s-+" (thing-at-point 'line))
|
|
; (setq beancount-accounts nil)
|
|
; (list (match-beginning 1) (match-end 1) #'beancount-account-completion-table))
|
|
; ((or (string-match-p "^\\s-+" (thing-at-point 'line))
|
|
;; if the preceding text is allowed before an account, offer accounts
|
|
;; TODO: Not yet working!
|
|
; (string-match-p beancount-timestamped-accounts-regexp (thing-at-point; 'line)))
|
|
; (delq nil
|
|
; (mapcar (lambda (c)
|
|
; (message c)
|
|
; (and (string-prefix-p arg c) c))
|
|
; beancount-accounts-cache)))
|
|
;; ;; if line is empty, offer accounts
|
|
; ((or (string-match-p "^\\s-+" (thing-at-point 'line))
|
|
;; if the preceding text is allowed before an account, offer accounts
|
|
;; TODO: Not yet working!
|
|
; (string-match-p beancount-timestamped-accounts-regexp (thing-at-point 'line)))
|
|
; (delq nil
|
|
; (mapcar (lambda (c)
|
|
; (message c)
|
|
; (and (string-prefix-p arg c) c))
|
|
; beancount-accounts-cache)))
|
|
;; ;; new function for whole transactions!
|
|
;; ;; source https://github.com/debanjum/company-ledger/blob/master/company-ledger.el
|
|
;; ;; these suggestions go when there are no matches for the stuff before
|
|
;; ;;TODO matches only work for first word.
|
|
;; ;;TODO reverse list, newest one first
|
|
; ((delq nil
|
|
; (cl-remove-if-not
|
|
; (lambda (c) (company-ledger--fuzzy-word-match arg c))
|
|
; (company-ledger--get-all-postings))))
|
|
|
|
;; ; (cl-remove-if-not
|
|
;; ; (lambda (c) (beancount-company--fuzzy-word-match arg c))
|
|
;; ; (beancount-get-transactions-in-buffer))))
|
|
; )))))
|
|
;; ;;erst hier wird Reihenfolge umgekehrt (jüngste zuerst)!
|
|
;; (sorted t))
|
|
|
|
|
|
;;end stuff
|
|
;;##################################
|
|
|
|
;;;###autoload
|
|
(define-derived-mode beancount-mode text-mode "Beancount"
|
|
"A mode for editing beancount files.
|
|
\\{beancount-mode-map}"
|
|
:init-value nil
|
|
:lighter " Beancount"
|
|
:group 'beancount
|
|
|
|
;; customize font-lock for beancount.
|
|
(set-syntax-table beancount-mode-syntax-table)
|
|
(font-lock-add-keywords nil beancount-font-lock-directives)
|
|
|
|
(or beancount-accounts-cache
|
|
(setq beancount-accounts-cache (beancount-get-accounts-in-buffer))) ;-new
|
|
(or beancount-payees-cache
|
|
(setq beancount-payees-cache (beancount-get-payees-in-buffer)))
|
|
(or beancount-payeetext-cache
|
|
(setq beancount-payeetext-cache (beancount-get-payee-text-in-buffer)))
|
|
(or beancount-commodities-cache
|
|
(setq beancount-commodities-cache (beancount-get-commodities-in-buffer)))
|
|
(or beancount-tags-cache
|
|
(setq beancount-tags-cache (beancount-get-tags-in-buffer)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;NEW for completa-at-point-function
|
|
; (add-hook 'completion-at-point-functions #'beancount-completion-at-point nil t)
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
)
|
|
|
|
(provide 'beancount)
|
|
;;; beancount.el ends here
|