marc
/
config_emacs
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
Browse Source

added beancount

master
marc 5 years ago
parent
f09590823b
commit
ba5dc291d8
1 changed files with 620 additions and 0 deletions
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 620
      user-local/elisp/beancount.el

620
user-local/elisp/beancount.el
View File

@ -0,0 +1,620 @@
;;; package --- Summary
;;; Commentary:
;; A humble try to port leder-mode to beancount
;;; Code:
;(require 'beancount-regex)
(require 'font-lock)
(require 'company) ; for company-mode
(require 'pcomplete)
(require 'cl-lib)
(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
(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-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-valid-prefix-for-tag-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-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
(,(regexp-opt beancount-directive-names) . font-lock-keyword-face)
;; 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 flags
("! " . 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))
;; (setq beancount-accounts (beancount-get-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))
;; (defun beancount-fully-complete-xact ()
;; "Completes a transaction if there is another matching payee in the buffer."
;; (interactive)
;; (let* ((name (beancount-trim-trailing-whitespace (caar (beancount-parse-arguments))))
;; xacf)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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 "urxvt"
"Name of the terminal emulator to run fava.")
(defvar beancount-fava-exec "/opt/fava/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-uniqify-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- *]*\"\\(.*?\\)\" \"\\(.*?\\)\"" nil t) ; matches are in brackets
(setq payees-list (cons (match-string-no-properties 1) ; get first match, generally the payee
payees-list))
(setq payees-list (cons (match-string-no-properties 2) ; get second match, generally a description
payees-list))))
(pcomplete-uniqify-list (nreverse payees-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-uniqify-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-uniqify-list (nreverse commodities-list))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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))]))
;; (defun beancount-get-accounts (&optional string)
;; "Return list of account names with STRING infix present.
;; STRING can be multiple words separated by a space."
;; (let* ((accounts-string (shell-command-to-string
;; (concat "bean-query -q -f csv "
;; "/home/marc/Archiv/Finanzen/transactions_ingdiba.beancount "
;; "'SELECT DISTINCT account ORDER BY ACCOUNT ASC'")))
;; (accounts-list (split-string accounts-string)))
;; accounts-list))
(defvar beancount-accounts-cache nil
"List of accounts cached for company mode.")
(defvar beancount-payees-cache nil
"List of payees cached for company mode.")
(defvar beancount-tags-cache nil
"List of tags cached for company mode.")
(defvar beancount-commodities-cache nil
"List of commodities / currencies cached for company mode.")
(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-uniqify-list (nreverse beancount-accounts-cache))
;; (setq beancount-accounts (beancount-get-accounts))
(message "Accounts updated.")
(setq beancount-payees-cache (beancount-get-payees-in-buffer)) ;-new
(pcomplete-uniqify-list (nreverse beancount-payees-cache))
(message "Payees updated.")
(setq beancount-commodities-cache (beancount-get-commodities-in-buffer))
(pcomplete-uniqify-list (nreverse beancount-commodities-cache))
(setq beancount-tags-cache (beancount-get-tags-in-buffer))
(pcomplete-uniqify-list (nreverse beancount-tags-cache))
(message "Tags updated."))
;; first test for conditional completions
;; e.g. only account names when completion is after a date
;; (defun beancount-company-candidates (prefix)
;; "Check what PREFIX does."
;; (let* (accounts (beancount-accounts-cache))
;; accounts))
;;;###autoload
(defun company-beancount (command &optional arg &rest ignored)
"Company backend for 'beancount-mode'.
COMMAND, ARG, and IGNORED the regular meanings."
(interactive (list 'interactive))
(message arg)
(pcase command
(`interactive (company-begin-backend 'company-beancount))
(`prefix (and (eq major-mode 'beancount-mode)
(company-grab-symbol)))
(`candidates
(cond
;; if line ends with date and status, at max one quoted text, and an open quote, offer payees and explainations
((string-match-p beancount-valid-prefix-for-payee-completion-regex (thing-at-point 'line))
(delq nil
(mapcar (lambda (c)
; (and (string-prefix-p (substring arg 1) c) 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
((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)))
))))
;;;###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-commodities-cache
(setq beancount-commodities-cache (beancount-get-commodities-in-buffer)))
(or beancount-tags-cache
(setq beancount-tags-cache (beancount-get-tags-in-buffer)))
)
(provide 'beancount)
;;; beancount-mode.el ends here
Write Preview
Loading…
Cancel
Save