diff --git a/user-global/elisp/beancount.el b/user-global/elisp/beancount.el index 39fc28b..458b9f0 100644 --- a/user-global/elisp/beancount.el +++ b/user-global/elisp/beancount.el @@ -9,6 +9,7 @@ (require 'company) ; for company-mode (require 'pcomplete) (require 'cl-lib) +(require 'subr-x) ; for hash-table-keys (defgroup beancount () "Editing mode for beancount files." @@ -26,7 +27,8 @@ "price" "commodity" "query" - "txn") + "txn" + "*") "Directive names that can appear after a date.") (defconst beancount-account-categories @@ -91,9 +93,22 @@ "[: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 - (concat (regexp-opt beancount-account-categories) - "\\(?::[[:upper:]][" beancount-account-chars "]+\\)") + "^[ ][ ][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 "" @@ -101,7 +116,12 @@ "\"\\(.*?\\)\"") (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]" + ; "^[12][901][0-9]\\{2\\}-\\(\\(0[1-9]\\)\\|\\(1[012]\\)\\)-\\(\\([012][0-9]\\)\\|\\(3[01]\\)\\)" "Regular expression for dates.") (defconst beancount-number-regexp @@ -145,6 +165,25 @@ "[ ]+" "[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 @@ -157,16 +196,21 @@ "\\)$" ; the whole regex looks from the right side of the line )) -(defconst beancount-valid-prefix-for-tag-completion-regex +; "^[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 - " \"" ; empty space and open quotes + "\\s-+\"" ; 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 +; "\\(" ; 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 - "\"[ ]+#" + "\"" ; end of optional second quoted term + "\\s-+#" + "\\(?1:" + "[^\"\n]*" + "\\)" ;"\\)$" ; the whole regex looks from the right side of the line )) @@ -225,7 +269,11 @@ (defvar beancount-font-lock-directives `(;; reserved keywords - (,(regexp-opt beancount-directive-names) . font-lock-keyword-face) + (,(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 @@ -236,7 +284,7 @@ (,beancount-account-regexp . 'beancount-font-other-face) ;; payees ("\"\\(.*?\\)\"" . font-lock-comment-face) - ;; txn flags + ;; txn warning ("! " . font-lock-warning-face) )) @@ -440,7 +488,7 @@ Only useful if you have not installed Beancount properly in your PATH") beancount-account-regexp nil t) (setq accounts-list (cons (match-string-no-properties 0) accounts-list)))) - (pcomplete-uniqify-list (nreverse accounts-list)))) + (pcomplete-uniquify-list (nreverse accounts-list)))) (defun beancount-get-payees-in-buffer () "Return a list of all payees." @@ -449,12 +497,24 @@ Only useful if you have not installed Beancount properly in your PATH") (save-excursion (goto-char (point-min)) (while (re-search-forward - "^[0-9- *]*\"\\(.*?\\)\" \"\\(.*?\\)\"" nil t) ; matches are in brackets + "^[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-uniqify-list (nreverse 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." @@ -466,7 +526,7 @@ Only useful if you have not installed Beancount properly in your PATH") beancount-tag-regexp nil t) (setq tags-list (cons (substring (match-string-no-properties 0) 1) tags-list)))) - (pcomplete-uniqify-list (nreverse tags-list)))) + (pcomplete-uniquify-list (nreverse tags-list)))) (defun beancount-get-commodities-in-buffer () "Return a list of all commodities / currencies." @@ -478,7 +538,7 @@ Only useful if you have not installed Beancount properly in your PATH") "^[ ]+[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)))) + (pcomplete-uniquify-list (nreverse commodities-list)))) (defun beancount-company--regexp-filter (regexp list) @@ -535,31 +595,46 @@ Only useful if you have not installed Beancount properly in your PATH") ;; accounts-list)) (defvar beancount-accounts-cache nil - "List of accounts cached for company mode.") + "List of accounts cached for capf.") (defvar beancount-payees-cache nil - "List of payees cached for company mode.") + "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 company mode.") + "List of tags cached for capf.") (defvar beancount-commodities-cache nil - "List of commodities / currencies cached for company mode.") + "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-uniqify-list (nreverse beancount-accounts-cache)) -;; (setq beancount-accounts (beancount-get-accounts)) + (pcomplete-uniquify-list (nreverse beancount-accounts-cache)) (message "Accounts updated.") + (setq beancount-payees-cache (beancount-get-payees-in-buffer)) ;-new - (pcomplete-uniqify-list (nreverse beancount-payees-cache)) + (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-uniqify-list (nreverse beancount-commodities-cache)) + (pcomplete-uniquify-list (nreverse beancount-commodities-cache)) + (setq beancount-tags-cache (beancount-get-tags-in-buffer)) - (pcomplete-uniqify-list (nreverse beancount-tags-cache)) + (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 @@ -628,6 +703,179 @@ Provide completion info based on COMMAND and ARG. IGNORED, not used." (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 ;;################################## @@ -712,10 +960,17 @@ COMMAND, ARG, and IGNORED the regular meanings." (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 + (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) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; )