config_emacs/user-global/elisp/beancount.el

;;; 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
  "[ ][ \t]+;.*\|^[;*].*")  ; 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 "foot"
  "Name of the terminal emulator to run fava.")

(defvar beancount-fava-exec "/usr/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))))

;;does not work currently!
;;use source /opt/fava/.env/bin/activate
;;fava /mnt/archiv/Finanzen/Transaktionen/transactions.beancount
(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