|
|
;;; 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)(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.")
;beancount-account-regexp original;"\\(?:A\\(?:ktiva\\|ssets\\|ufwendungen\\)\\|E\\(?:igenkapital\\|quity\\|rtraege\\|xpenses\\)\\|Income\\|Liabilities\\|Verbindlichkeiten\\)\\(?::[[:upper:]][[:alnum:]-_]+\\)+"
;"\\(?:A\\(?:ktiva\\|ssets\\|ufwendungen\\)\\|E\\(?:igenkapital\\|quity\\|rtraege\\|xpenses\\)\\|Income\\|Liabilities\\|Verbindlichkeiten\\)\\(?::[[:upper:]][[:alnum:]-_]+\\)+"; ^[\s\{2\}][Aufwendungen\|Aktiva\[:[:alnum:]-_]+(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]\\)";"\\(^[12][901][0-9]\\{2\\}-\\(0[1-9]\\|1[012]\\)-\\([012][0-9]\\|3[01]\\)\\)";"\\(^[12][901][0-9]\\{2\\}-\\(0[1-9]\\|1[012]\\)-\\(\\([012][0-9]\\)\\(\\|3[01]\\)\\)\\)"; "^[12][901][0-9]\\{2\\}-0[1-9]1[012]-[012][0-9]3[01]" ; "^[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 ))
; "^[12][901][0-9]\\{2\\}-\\(0[1-9]\\|1[012]\\)-\\([012][0-9]\\|3[01]\\)\\(\\s-+[\\*!]\\)\\s-+\"[^\"]*\"\\s-+\"[^\"]*\"\\(?1:\\s-+#\\)"; "^[12][901][0-9]\\{2\\}-\\(0[1-9]\\|1[012]\\)-\\([012][0-9]\\|3[01]\\)\\(\\s-+[\\*!]\\)\\s-+\"[^\"\n]*\"\\s-+\"[^\"\n]*\"\\(?1:\\s-+#\\)"(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]*" "\\)"
;"\\)$" ; 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 (,(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));; (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-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)))); (setq payees-list (cons (match-string-no-properties 2) ; get second match, generally a description; 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))]))
;; (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 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."));; 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)))
;;NEW;;;;;;;;;;;;;;;#####################################(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))));;#####################################
;2022-12-12 ! "Ne"
;;;###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 ]+" 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(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-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-mode.el ends here
|
