;;; 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 "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-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)))) (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))])) ;; (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)) ;;################################## ;;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)))) ;; hier werden Vorschläge zeitlich rückwärts gemacht (jüngste Einträge zuerst)! ;;;###autoload (defun company-beancountGIT (command &optional arg &rest ignored) "Fuzzy company back-end for ledger, beancount and other ledger-like modes. Provide completion info based on COMMAND and ARG. IGNORED, not used." (interactive (list 'interactive)) (cl-case command (interactive (company-begin-backend 'company-beancount)) (`interactive (company-begin-backend 'company-beancount)) (`prefix (and (eq major-mode 'beancount-mode) (company-grab-symbol))) ; (prefix (and (or (bound-and-true-p beancount-mode) ; (derived-mode-p 'ledger-mode)) ; (company-ledger--next-line-empty-p) ; (thing-at-point 'line t))) (candidates (cl-remove-if-not (lambda (c) (company-ledger--fuzzy-word-match arg c)) (company-ledger--get-all-postings))) (sorted t))) ;;end stuff ;;################################## ;;;###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) (cl-case 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))) ;; 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))) ;;;###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