You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

842 lines
31 KiB

5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
1 year ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
1 year ago
5 years ago
5 years ago
5 years ago
1 year ago
  1. ;;; package --- Summary
  2. ;;; Commentary:
  3. ;; A humble try to port leder-mode to beancount
  4. ;;; Code:
  5. (require 'font-lock)
  6. ;(require 'company) ; for company-mode
  7. (require 'pcomplete)
  8. (require 'cl-lib)
  9. (require 'subr-x) ; for hash-table-keys
  10. (defgroup beancount ()
  11. "Editing mode for beancount files."
  12. :group 'beancount)
  13. (defconst beancount-timestamped-directive-names
  14. '("balance"
  15. "open"
  16. "close"
  17. "pad"
  18. "document"
  19. "note"
  20. ;; the ones below are not followed by an account name.
  21. "event"
  22. "price"
  23. "commodity"
  24. "query"
  25. "txn"
  26. "*")
  27. "Directive names that can appear after a date.")
  28. (defconst beancount-account-categories
  29. '("Assets"
  30. "Liabilities"
  31. "Equity"
  32. "Income"
  33. "Expenses"
  34. ; TODO: Fill changed root accounts automatically
  35. "Aktiva"
  36. "Verbindlichkeiten"
  37. "Eigenkapital"
  38. "Ertraege"
  39. "Aufwendungen"))
  40. (defconst beancount-nontimestamped-directive-names
  41. '("pushtag"
  42. "poptag"
  43. "option"
  44. "include"
  45. "plugin")
  46. "Directive names that can appear after a date.")
  47. (defconst beancount-option-names
  48. ;; this list has to be kept in sync with the options definied in
  49. ;; beancount/parser/options.py
  50. '("title"
  51. "name_assets"
  52. "name_equity"
  53. "name_income"
  54. "name_expenses"
  55. "bookin_algorithm"
  56. "bookin_method"
  57. "account_previous_balances"
  58. "account_previous_earnings"
  59. "account_previous_conversions"
  60. "account_current_earnings"
  61. "account_current_conversions"
  62. "account_rounding"
  63. "conversion_currency"
  64. "inferred_tolerance_default"
  65. "inferred_tolerance_multiplier"
  66. "infer_tolerance_from_cost"
  67. "documents"
  68. "operating_currency"
  69. "render_commas"
  70. "plugin_processing_mode"
  71. "plugin"
  72. "long_string_maxlines"
  73. ))
  74. (defconst beancount-directive-names
  75. (append beancount-nontimestamped-directive-names
  76. beancount-timestamped-directive-names)
  77. "A list of directive names.")
  78. (defconst beancount-tag-chars
  79. "[:alnum:]-_/."
  80. "Allowed tag characters.")
  81. (defconst beancount-account-chars
  82. "[:alnum:]-_:"
  83. "Allowed account characters.")
  84. (defconst beancount-account-regexp
  85. "^[ ][ ][a-z]+"
  86. ; (concat (regexp-opt beancount-account-categories)
  87. ;; (rx line-start (seq space
  88. ;; space
  89. ;; (or (literal (regexp-opt beancount-account-categories)))
  90. ;; ; (or "Aufwendungen" "Ertraege")
  91. ;; (zero-or-more (seq ":"
  92. ;; (one-or-more (any alnum "-_"))))))
  93. ; (concat (regexp-opt beancount-account-categories)
  94. ; "\\(?::[[:upper:]][" beancount-account-chars "]+\\)")
  95. "A regular expression to match account names.")
  96. ; TODO: currently shows all texts between ""
  97. (defconst beancount-payee-regexp
  98. "\"\\(.*?\\)\"")
  99. (defconst beancount-date-regexp
  100. "^[12][901][0-9]\\{2\\}-\\(0[1-9]\\|1[012]\\)-\\([012][0-9]\\|3[01]\\)"
  101. "Regular expression for dates.")
  102. (defconst beancount-number-regexp
  103. "[-+]?[0-9,]+\\(?:\\.[0-9]*\\)"
  104. "Regular expression to match decimal numbers.")
  105. (defconst beancount-tag-regexp
  106. (concat "#"
  107. "["
  108. beancount-tag-chars
  109. "]+")
  110. "Regular expression for valid tags.")
  111. (defconst beancount-currency-regexp
  112. "[A-Z][A-Z-_'.]*"
  113. "Regular expression to match currencies.")
  114. (defconst beancount-timestamped-accounts-regexp
  115. (concat beancount-date-regexp
  116. " " ;"\\(\\s-+\\)"
  117. (regexp-opt beancount-timestamped-directive-names)
  118. " ") ;"\\(\\s-+\\)")
  119. "A regular expression to match valid preceding characters before an account name.")
  120. (defconst beancount-amount-and-currency-regex
  121. "\s-*[-]?[0-9,]+[.][0-9]\\{2\\}\s[A-Za-z0-9.]+"
  122. "A regular expression for amounts including currency.")
  123. (defconst beancount-payee-any-status-regex
  124. "^[0-9]+[-/][-/.=0-9]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.+?\\)\\s-*\\(;\\|$\\)")
  125. (defconst beancount-date-and-status-regex
  126. (concat beancount-date-regexp
  127. "\\(\\s-+[\\*!]\\)")
  128. "Returns true for YYYY-MM-DD ! and YYYY-MM-DD *.")
  129. (defconst beancount-valid-prefix-for-directives-regex
  130. (concat "^"
  131. beancount-date-regexp
  132. "[ ]+"
  133. "[a-z]*$"))
  134. (defconst beancount-prefix-for-payee-regex
  135. (concat beancount-date-and-status-regex
  136. " \"" ; space and opening quotes
  137. "\\(?1:" ; opening term, calling it segment 1
  138. "[^\"\n]*" ; any number of chars except quotes and newline
  139. "\\)" ; closing term
  140. ))
  141. (defconst beancount-prefix-for-payeetext-regex
  142. (concat beancount-date-and-status-regex
  143. "\\s-+\"" ; space and opening quotes
  144. "[^\"\n]*" ; any number of chars except quotes and newline
  145. "\"" ; closing quotes
  146. "\\s-+\"" ; space and opening quotes
  147. "\\(?1:" ; opening term, calling it segment 1
  148. "[^\"\n]*" ; any number of chars except quotes and newline
  149. "\\)" ; closing term
  150. ))
  151. (defconst beancount-valid-prefix-for-payee-completion-regex
  152. (concat "\\("
  153. beancount-date-and-status-regex
  154. " \"" ; empty space and open quotes
  155. "[^\"\n]*" ; any number of chars except quotes and newline
  156. "\\(" ; start of optional second quoted term
  157. "\"[ ]+\"" ; closing quotes, whitespaces, opening quotes
  158. "[^\"\n]*" ; any number of chars except quotes and newline
  159. "\\)?" ; end of optional second quoted term
  160. "\\)$" ; the whole regex looks from the right side of the line
  161. ))
  162. (defconst beancount-prefix-for-tag-completion-regex
  163. (concat ;"\\("
  164. beancount-date-and-status-regex
  165. "\\s-+\"" ; empty space and open quotes
  166. "[^\"\n]*" ; any number of chars except quotes and newline
  167. ; "\\(" ; start of optional second quoted term
  168. "\"\\s-+\"" ; closing quotes, whitespaces, opening quotes
  169. "[^\"\n]*" ; any number of chars except quotes and newline
  170. "\"" ; end of optional second quoted term
  171. "\\s-+#"
  172. "\\(?1:"
  173. "[^\"\n]*"
  174. "\\)"
  175. ))
  176. (defconst beancount-comments-regex
  177. (concat ";[^\"\n]*$")) ; right part of the line after a comment symbol if no quote or newline is included
  178. (defconst beancount-empty-line-regex
  179. "^\\(\\s-+\\)" ;; maybe "^[ \t]+" is better
  180. "Returns true for preceding whitespaces.")
  181. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  182. ;; Faces
  183. (defgroup beancount-faces nil "Beancount mode highlighting" :group 'beancount)
  184. (defface beancount-font-default-face
  185. `((t :inherit default))
  186. "Default face"
  187. :group 'beancount-faces)
  188. (defface beancount-font-xact-cleared-face
  189. `((t :foreground "#AAAAAA" :weight normal))
  190. "Default face for cleared transactions"
  191. :group 'beancount-faces)
  192. (defface beancount-font-xact-pending-face
  193. `((t :foreground "#dc322f" :weight bold))
  194. "Default face for pending transactions"
  195. :group 'beancount-faces)
  196. (defface beancount-font-payee-cleared-face
  197. `((t :inherit beancount-font-other-face))
  198. "Default face for pending transactions"
  199. :group 'beancount-faces)
  200. (defface beancount-font-payee-pending-face
  201. `((t :foreground "#f24b61" :weight normal))
  202. "Default face for pending (!) transactions"
  203. :group 'beancount-faces)
  204. (defface beancount-font-other-face
  205. `((t :foreground "#657b83" :weight normal))
  206. "Default face for other transactions"
  207. :group 'beancount-faces)
  208. (defface beancount-font-posting-date-face
  209. `((t :foreground "#cb4b16" :weight normal))
  210. "Default face for dates"
  211. :group 'beancount-faces)
  212. (defface beancount-font-amount-face
  213. `((t :foreground "#cb4b16" :weight normal))
  214. "Default face for amounts"
  215. :group 'beancount-faces)
  216. (defvar beancount-font-lock-directives
  217. `(;; reserved keywords
  218. (,(concat beancount-date-regexp
  219. "\\s-+\\(?1:"
  220. (regexp-opt beancount-directive-names)
  221. "\\)")
  222. . (1 font-lock-keyword-face)) ; use group one of regex search for highlighting, not the whole result
  223. ;; tags & links
  224. ("[#\\^][A-Za-z0-9\-_/.]+" . font-lock-type-face)
  225. ;; comments
  226. (,beancount-comments-regex (0 font-lock-comment-face))
  227. ;; date
  228. (,beancount-date-regexp . 'beancount-font-posting-date-face)
  229. ;; account
  230. (,beancount-account-regexp . 'beancount-font-other-face)
  231. ;; payees
  232. ("\"\\(.*?\\)\"" . font-lock-comment-face)
  233. ;; txn warning
  234. ("! " . font-lock-warning-face)
  235. ))
  236. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  237. ;; Alignments
  238. (defmacro beancount-for-line-in-region (begin end &rest exprs)
  239. "Iterate over each line in region from BEGIN to END (EXPRS)
  240. until an empty line is encountered."
  241. `(save-excursion
  242. (let ((end-marker (copy-marker ,end)))
  243. (goto-char ,begin)
  244. (beginning-of-line)
  245. (while (and (not (eobp)) (< (point) end-marker))
  246. (beginning-of-line)
  247. (progn ,@exprs)
  248. (forward-line 1)
  249. ))))
  250. (defun beancount-align-numbers (begin end)
  251. "Align all numbers in the current buffer from BEGIN to END."
  252. (interactive "r")
  253. ;; loop once in the buffer to find the length of the longest string before the
  254. ;; number.
  255. (let (prefix-widths
  256. number-widths
  257. (number-padding " "))
  258. (beancount-for-line-in-region
  259. begin end
  260. (let ((line (thing-at-point 'line)))
  261. (when (string-match (concat "\\(.*?\\)"
  262. "[ \t]+"
  263. "\\(" beancount-number-regexp "\\)"
  264. "[ \t]+"
  265. beancount-currency-regexp)
  266. line)
  267. (push (length (match-string 1 line)) prefix-widths)
  268. (push (length (match-string 2 line)) number-widths)
  269. )))
  270. (when prefix-widths
  271. ;; Loop again to make the adjustments to the numbers.
  272. (let* ((number-width (apply 'max number-widths))
  273. (number-format (format "%%%ss" number-width))
  274. ;; compute the rightmost column of prefix
  275. (max-prefix-width (apply 'max prefix-widths))
  276. (prefix-format (format "%%-%ss" max-prefix-width))
  277. )
  278. (beancount-for-line-in-region
  279. begin end
  280. (let ((line (thing-at-point 'line)))
  281. (when (string-match (concat "^\\([^\"]*?\\)"
  282. "[ \t]+"
  283. "\\(" beancount-number-regexp "\\)"
  284. "[ \t]+"
  285. "\\(.*\\)$")
  286. line)
  287. (delete-region (line-beginning-position) (line-end-position))
  288. (let* ((prefix (match-string 1 line))
  289. (number (match-string 2 line))
  290. (rest (match-string 3 line)))
  291. (insert (format prefix-format prefix))
  292. (insert number-padding)
  293. (insert (format number-format number))
  294. (insert " ")
  295. (insert rest)))))))))
  296. (defun beancount-hash-keys (hashtable)
  297. "Extract all the keys of the given HASHTABLE. Return a sorted list."
  298. (let (rlist)
  299. (maphash (lambda (k _v) (push k rlist)) hashtable)
  300. (sort rlist 'string<)))
  301. (defvar beancount-accounts nil
  302. "A list of the accounts available in this buffer.
  303. This is a cache of the value computed by `beancount-get-accounts'.")
  304. (make-variable-buffer-local 'beancount-accounts)
  305. (defun beancount-init-accounts ()
  306. "Initialize or reset the list of accounts."
  307. (interactive)
  308. (setq beancount-accounts (beancount-get-accounts-in-buffer)) ;-new
  309. (pcomplete-uniqify-list (nreverse beancount-accounts))
  310. (message "Accounts updated."))
  311. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  312. ;; Navigation
  313. (defun beancount-navigate-start-xact-or-directive-p ()
  314. "Return t if at the beginning of an empty or all-whitespace line."
  315. (not (looking-at "[ \t]\\|\\(^$\\)")))
  316. (defun beancount-navigate-prev-xact-or-directive ()
  317. "Move to the beginning of the next xact or directive."
  318. (interactive)
  319. (beginning-of-line)
  320. (if (beancount-navigate-start-xact-or-directive-p) ;if we are at the start of an xact, move backward to the previous xact
  321. (progn
  322. (forward-line -1)
  323. (if (not (beancount-navigate-start-xact-or-directive-p)) ; we have moved backward and are not at another xact, recurse backward
  324. (beancount-navigate-prev-xact-or-directive)))
  325. (while (not (or (bobp)
  326. (beancount-navigate-start-xact-or-directive-p)))
  327. (forward-line -1))))
  328. (defun beancount-navigate-next-xact-or-directive ()
  329. "Move to the beginning of the next xact or directive."
  330. (interactive)
  331. (beginning-of-line)
  332. (if (beancount-navigate-start-xact-or-directive-p) ; if we are at the start of an xact, move forward to the next xact
  333. (progn
  334. (forward-line)
  335. (if (not (beancount-navigate-start-xact-or-directive-p)) ; we have moved forward and are not at another xact, recurse forward
  336. (beancount-navigate-next-xact-or-directive)))
  337. (while (not (or (eobp) ; we didn't stsrt off at the beginning of an xact
  338. (beancount-navigate-start-xact-or-directive-p)))
  339. (forward-line))))
  340. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  341. ;; Completion
  342. (defun beancount-thing-at-point ()
  343. "Describe thing at points. Return 'transaction, 'posting, or nil.
  344. Leave point at the beginning of the thing under point.")
  345. (defun beancount-trim-trailing-whitespace (str)
  346. "Replace trailing whitespaces in STR."
  347. (replace-regexp-in-string "[ \t]*$" "" str))
  348. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  349. ;; Functions for external programs
  350. (defvar beancount-filename-main buffer-file-name
  351. "File name of the main beancount file for beancount-check.")
  352. (defvar beancount-terminal-name "kitty"
  353. "Name of the terminal emulator to run fava.")
  354. (defvar beancount-fava-exec "/bin/fava"
  355. "Full path of fava executable.")
  356. (defvar beancount-install-dir nil
  357. "Directory in which Beancount's source is located.
  358. Only useful if you have not installed Beancount properly in your PATH")
  359. (defun beancount--run (prog &rest args)
  360. "Random text PROG ARGS."
  361. (let ((process-environment
  362. (if beancount-install-dir
  363. `(,(concat "PYTHONPATH=" beancount-install-dir)
  364. ,(concat "PATH="
  365. (expand-file-name "bin" beancount-install-dir)
  366. ":"
  367. (getenv "PATH"))
  368. ,@process-environment)
  369. process-environment))
  370. (compile-command (mapconcat (lambda (arg)
  371. (if (stringp arg)
  372. (shell-quote-argument arg) ""))
  373. (cons prog args)
  374. " ")))
  375. (call-interactively 'compile)))
  376. (defvar beancount-check-program "bean-check"
  377. "Program to run the parser and validator on an input file.")
  378. (defun beancount-check ()
  379. "Run `beancount-check-program'."
  380. (interactive)
  381. (let ((compilation-read-command nil))
  382. (beancount--run beancount-check-program beancount-filename-main)))
  383. ; (file-relative-name buffer-file-name))))
  384. (defun beancount-fava ()
  385. "Run `beancount-fava' and open the URL in the default browser."
  386. (interactive)
  387. (start-process "termx" nil beancount-terminal-name "-e" beancount-fava-exec beancount-filename-main)
  388. (sleep-for 0.5) ; necessary to prevent an error
  389. (browse-url "127.0.0.1:5000"))
  390. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  391. ;; Completions
  392. (defun beancount-get-accounts-in-buffer ()
  393. "Return a list of all accounts."
  394. (let ((origin (point))
  395. accounts-list)
  396. (save-excursion
  397. (goto-char (point-min))
  398. (while (re-search-forward
  399. beancount-account-regexp nil t)
  400. (setq accounts-list (cons (match-string-no-properties 0)
  401. accounts-list))))
  402. (pcomplete-uniquify-list (nreverse accounts-list))))
  403. (defun beancount-get-payees-in-buffer ()
  404. "Return a list of all payees."
  405. (let ((origin (point))
  406. payees-list)
  407. (save-excursion
  408. (goto-char (point-min))
  409. (while (re-search-forward
  410. "^[0-9- *]*\"\\(?1:.*?\\)\" \"\\(?2:.*?\\)\"" nil t) ; matches are in brackets
  411. (setq payees-list (cons (match-string-no-properties 1) ; get first match, generally the payee
  412. payees-list))))
  413. (pcomplete-uniquify-list (nreverse payees-list))))
  414. (defun beancount-get-payee-text-in-buffer ()
  415. "Return a list of all payees."
  416. (let ((origin (point))
  417. payees-text-list)
  418. (save-excursion
  419. (goto-char (point-min))
  420. (while (re-search-forward
  421. "^[0-9- *]*\"\\(?1:.*?\\)\" \"\\(?2:.*?\\)\"" nil t) ; matches are in brackets
  422. (setq payees-text-list (cons (match-string-no-properties 2) ; get second match, generally a description
  423. payees-text-list))))
  424. (pcomplete-uniquify-list (nreverse payees-text-list))))
  425. (defun beancount-get-tags-in-buffer ()
  426. "Return a list of all tags."
  427. (let ((origin (point))
  428. tags-list)
  429. (save-excursion
  430. (goto-char (point-min))
  431. (while (re-search-forward
  432. beancount-tag-regexp nil t)
  433. (setq tags-list (cons (substring (match-string-no-properties 0) 1)
  434. tags-list))))
  435. (pcomplete-uniquify-list (nreverse tags-list))))
  436. (defun beancount-get-commodities-in-buffer ()
  437. "Return a list of all commodities / currencies."
  438. (let ((origin (point))
  439. commodities-list)
  440. (save-excursion
  441. (goto-char (point-min))
  442. (while (re-search-forward
  443. "^[ ]+[A-Za-z0-9-_:]+[ ]+[-]?[0-9,.]+[ ]+\\([A-Z][A-Z0-9-_.']*[A-Z0-9]\\)" nil t)
  444. (setq commodities-list (cons (match-string-no-properties 1)
  445. commodities-list))))
  446. (pcomplete-uniquify-list (nreverse commodities-list))))
  447. (defun beancount-company--regexp-filter (regexp list)
  448. "Use REGEXP to filter LIST of strings."
  449. (let (new)
  450. (dolist (string list)
  451. (when (string-match regexp string)
  452. (setq new (cons string new))))
  453. ;;new
  454. (setq new (nreverse new))
  455. ; (setq new (reverse new))
  456. new))
  457. (defun beancount-get-transactions-in-buffer ()
  458. "Return a list of all transactions."
  459. (beancount-company--regexp-filter
  460. "[0-9][0-9][0-9][0-9][-/][0-9][0-9][-/][0-9][0-9]"
  461. (mapcar (lambda (s) (substring s 1))
  462. (split-string (buffer-string) "^$" t))))
  463. (defun beancount-company--fuzzy-word-match (prefix candidate)
  464. "Return non-nil if each (partial) word in PREFIX is also in CANDIDATE."
  465. (eq nil
  466. (memq nil
  467. (mapcar
  468. (lambda (pre) (string-match-p (regexp-quote pre) candidate))
  469. (split-string prefix)))))
  470. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  471. ;; Finishing setup
  472. (defvar beancount-mode-map
  473. (let ((map (make-sparse-keymap)))
  474. (define-key map [(meta ?p)] #'beancount-navigate-prev-xact-or-directive)
  475. (define-key map [(meta ?n)] #'beancount-navigate-next-xact-or-directive)
  476. map)
  477. "Keymap for `bean-mode'.")
  478. (easy-menu-define beancount-mode-menu beancount-mode-map
  479. "Beancount menu"
  480. '("Beancount"
  481. ["Customize Ledger Mode" (lambda () (interactive) (customize-group 'beanmode))]))
  482. (defvar beancount-accounts-cache nil
  483. "List of accounts cached for capf.")
  484. (defvar beancount-payees-cache nil
  485. "List of payees cached for capf.")
  486. (defvar beancount-payeetext-cache nil
  487. "List of payee texts cached for capf.")
  488. (defvar beancount-tags-cache nil
  489. "List of tags cached for capf.")
  490. (defvar beancount-commodities-cache nil
  491. "List of commodities / currencies cached for capf.")
  492. (defun beancount-update-payees-text ()
  493. "Get list of all payees text in current buffer."
  494. (interactive)
  495. (setq beancount-payeetext-cache (beancount-get-payee-text-in-buffer)) ;-new
  496. (pcomplete-uniquify-list (nreverse beancount-payeetext-cache)))
  497. (defun beancount-update-accounts-and-payees ()
  498. "Initialize or reset the list of accounts."
  499. (interactive)
  500. (setq beancount-accounts-cache (beancount-get-accounts-in-buffer)) ;-new
  501. (pcomplete-uniquify-list (nreverse beancount-accounts-cache))
  502. (message "Accounts updated.")
  503. (setq beancount-payees-cache (beancount-get-payees-in-buffer)) ;-new
  504. (pcomplete-uniquify-list (nreverse beancount-payees-cache))
  505. (message "Payees updated.")
  506. (setq beancount-payeetext-cache (beancount-get-payee-text-in-buffer)) ;-new
  507. (pcomplete-uniquify-list (nreverse beancount-payeetext-cache))
  508. (message "Payee texts updated.")
  509. (setq beancount-commodities-cache (beancount-get-commodities-in-buffer))
  510. (pcomplete-uniquify-list (nreverse beancount-commodities-cache))
  511. (setq beancount-tags-cache (beancount-get-tags-in-buffer))
  512. (pcomplete-uniquify-list (nreverse beancount-tags-cache))
  513. (message "Tags updated."))
  514. ;;##################################
  515. ;;stuff from https://github.com/debanjum/company-ledger/blob/master/company-ledger.el
  516. (defun company-ledger--regexp-filter (regexp list)
  517. "Use REGEXP to filter LIST of strings."
  518. (let (new)
  519. (dolist (string list)
  520. (when (string-match regexp string)
  521. (setq new (cons string new))))
  522. new))
  523. (defun company-ledger--get-all-postings ()
  524. "Get all paragraphs in buffer containing YYYY[-/]MM[-/]DD in them."
  525. (company-ledger--regexp-filter
  526. "[0-9][0-9][0-9][0-9][-/][0-9][0-9][-/][0-9][0-9]"
  527. (mapcar (lambda (s) (substring s 1))
  528. (split-string (buffer-string) "^$" t))))
  529. (defun company-ledger--fuzzy-word-match (prefix candidate)
  530. "Return non-nil if each (partial) word in PREFIX is also in CANDIDATE."
  531. (eq nil
  532. (memq nil
  533. (mapcar
  534. (lambda (pre) (string-match-p (regexp-quote pre) candidate))
  535. (split-string prefix)))))
  536. (defun company-ledger--next-line-empty-p ()
  537. "Return non-nil if next line empty else false."
  538. (save-excursion
  539. (beginning-of-line)
  540. (forward-line 1)
  541. (or (looking-at "[[:space:]]*$")
  542. (eolp)
  543. (eobp))))
  544. ;;#####################################
  545. (defvar beancount-accounts nil
  546. "A list of accounts available in buffer.")
  547. (make-variable-buffer-local 'beancount-accounts)
  548. (defcustom beancount-account-files nil
  549. "A list of files to provide candidates for account completion."
  550. :type 'list
  551. :group 'beancount)
  552. (defconst beancount-account-regexp
  553. (concat (regexp-opt beancount-account-categories)
  554. "\\(?::[[:upper:]][[:alnum:]-_]+\\)+")
  555. "A regular expression to match account names.")
  556. (defun beancount-collect (regexp n &optional files)
  557. "Return a unique list of REGEXP group N in the current buffer.
  558. Optionally also look at data in selected FILES."
  559. (let ((pos (point)))
  560. (save-excursion
  561. (save-match-data
  562. (let ((hash (make-hash-table :test 'equal)))
  563. (goto-char (point-min))
  564. (while (re-search-forward regexp nil t)
  565. ;; ignore matches around `pos' since that's presumably
  566. ;; what we are currently trying to complete.
  567. (unless (<= (match-beginning 0) pos (match-end 0))
  568. (puthash (match-string-no-properties n) nil hash)))
  569. ;; if `files' are provided, also look into them
  570. (when files
  571. (save-excursion
  572. (dolist (f files)
  573. (with-current-buffer (find-file-noselect f)
  574. (goto-char (point-min))
  575. (while (re-search-forward regexp nil t)
  576. (puthash (match-string-no-properties n) nil hash))))))
  577. (hash-table-keys hash))))))
  578. (defun beancount-account-completion-table (string pred action)
  579. (if (eq action 'metadata) '(metadata (category . beancount-account))
  580. (if (null beancount-accounts)
  581. (setq beancount-accounts
  582. (sort (beancount-collect beancount-account-regexp 0 beancount-account-files) #'string<)))
  583. (complete-with-action action beancount-accounts string pred)))
  584. (defun beancount-looking-at (regexp n pos)
  585. (print (and (looking-at regexp)
  586. (>= pos (match-beginning n))
  587. (<= pos (match-end n))))
  588. (and (looking-at regexp)
  589. (>= pos (match-beginning n))
  590. (<= pos (match-end n))))
  591. ;;;###autoload
  592. (defun beancount-completion-at-point ()
  593. "CAPF for corfu."
  594. (interactive)
  595. (save-excursion
  596. (save-match-data
  597. (let ((pos (point)))
  598. (beginning-of-line)
  599. (cond
  600. ;;works!!!! #####################
  601. ; explicity named group \\(?1:.....\\) for the matching part
  602. ; after date, if a letter follows, offer timestamped directives.
  603. ((beancount-looking-at (concat "\\(?2:" beancount-date-regexp "[ ]\\)" "\\(?1:[A-Za-z]*\\)") 1 pos)
  604. (message "found test rx")
  605. (list (match-beginning 1) (match-end 1)
  606. (mapcar (lambda (s) (concat s " ")) beancount-timestamped-directive-names)))
  607. ;; if line starts with 2 spaces, offer accounts
  608. ;;works!!!! #####################
  609. ((beancount-looking-at "^[ ][ ][A-Za-z]+" 0 pos)
  610. (message "found acc rx")
  611. (list (match-beginning 0) (match-end 0)
  612. (mapcar (lambda (s) (concat " " s)) beancount-accounts-cache)))
  613. ;; if line ends with date and status and an open quote, offer payees
  614. ;;works!!!! #####################
  615. ((beancount-looking-at beancount-prefix-for-payee-regex 1 pos)
  616. (message "found payee rx")
  617. (list (match-beginning 1) (match-end 1)
  618. (mapcar (lambda (s) (concat s "\"")) beancount-payees-cache)))
  619. ;;works!!!! #####################
  620. ((beancount-looking-at beancount-prefix-for-payeetext-regex 1 pos)
  621. ; (beancount-update-payees-text)
  622. (message "found payeetext rx")
  623. (list (match-beginning 1) (match-end 1)
  624. (mapcar (lambda (s) (concat s "\"")) beancount-payeetext-cache)))
  625. ;;works!!!! #####################
  626. ((beancount-looking-at beancount-prefix-for-tag-completion-regex 1 pos)
  627. (message "found tags rx")
  628. (list (match-beginning 1) (match-end 1)
  629. beancount-tags-cache))
  630. ;; new function for whole transactions!
  631. ;; source https://github.com/debanjum/company-ledger/blob/master/company-ledger.el
  632. ;; TODO reverse list, newest one first
  633. ;; current workaround: keyword and year
  634. ((beancount-looking-at "^[A-za-z]+[A-za-z00-9 ]" 0 pos)
  635. (list (match-beginning 0) (match-end 0)
  636. ; (lambda (c) (company-ledger--fuzzy-word-match arg c))
  637. (company-ledger--get-all-postings)))
  638. ; (sort (company-ledger--get-all-postings) #'string-lessp)))
  639. )))))
  640. ;; (sorted t))
  641. ; (list (match-beginning 1) (match-end 1)
  642. ; (mapcar (lambda (s) (concat s " ")) beancount-directive-names)))
  643. ; (delq nil
  644. ; (mapcar (lambda (c)
  645. ; (and (string-prefix-p arg c) c))
  646. ; beancount-payees-cache)))
  647. ;; ;; if line starts with date, offer directives
  648. ;; ((string-match-p beancount-valid-prefix-for-directives-regex (thing-at-point 'line))
  649. ;; (delq nil
  650. ;; (mapcar (lambda (c)
  651. ;; (and (string-prefix-p arg c) c))
  652. ;; beancount-timestamped-directive-names)))
  653. ;; ;; if line starts with date, status and payees, offer tags
  654. ;; ((string-match-p beancount-valid-prefix-for-tag-completion-regex (thing-at-point 'line))
  655. ;; (delq nil
  656. ;; (mapcar (lambda (c)
  657. ;; (and (string-prefix-p (substring arg 1) c) c))
  658. ;; beancount-tags-cache)))
  659. ;; ;; if line starts with accounts and amounts, offer commodities
  660. ;; ((string-match-p (concat "^[ ]+[A-Za-z0-9-_:]+[ ]+[-]?[0-9,.]+[ ]+" beancount-currency-regexp) (thing-at-point 'line))
  661. ;; (delq nil
  662. ;; (mapcar (lambda (c)
  663. ;; (and (string-prefix-p arg c) c))
  664. ;; beancount-commodities-cache)))
  665. ;; ;; if line is empty, offer accounts
  666. ; ((string-match-p "^\\s-+" (thing-at-point 'line))
  667. ; (setq beancount-accounts nil)
  668. ; (list (match-beginning 1) (match-end 1) #'beancount-account-completion-table))
  669. ; ((or (string-match-p "^\\s-+" (thing-at-point 'line))
  670. ;; if the preceding text is allowed before an account, offer accounts
  671. ;; TODO: Not yet working!
  672. ; (string-match-p beancount-timestamped-accounts-regexp (thing-at-point; 'line)))
  673. ; (delq nil
  674. ; (mapcar (lambda (c)
  675. ; (message c)
  676. ; (and (string-prefix-p arg c) c))
  677. ; beancount-accounts-cache)))
  678. ;; ;; if line is empty, offer accounts
  679. ; ((or (string-match-p "^\\s-+" (thing-at-point 'line))
  680. ;; if the preceding text is allowed before an account, offer accounts
  681. ;; TODO: Not yet working!
  682. ; (string-match-p beancount-timestamped-accounts-regexp (thing-at-point 'line)))
  683. ; (delq nil
  684. ; (mapcar (lambda (c)
  685. ; (message c)
  686. ; (and (string-prefix-p arg c) c))
  687. ; beancount-accounts-cache)))
  688. ;; ;; new function for whole transactions!
  689. ;; ;; source https://github.com/debanjum/company-ledger/blob/master/company-ledger.el
  690. ;; ;; these suggestions go when there are no matches for the stuff before
  691. ;; ;;TODO matches only work for first word.
  692. ;; ;;TODO reverse list, newest one first
  693. ; ((delq nil
  694. ; (cl-remove-if-not
  695. ; (lambda (c) (company-ledger--fuzzy-word-match arg c))
  696. ; (company-ledger--get-all-postings))))
  697. ;; ; (cl-remove-if-not
  698. ;; ; (lambda (c) (beancount-company--fuzzy-word-match arg c))
  699. ;; ; (beancount-get-transactions-in-buffer))))
  700. ; )))))
  701. ;; ;;erst hier wird Reihenfolge umgekehrt (jüngste zuerst)!
  702. ;; (sorted t))
  703. ;;end stuff
  704. ;;##################################
  705. ;;;###autoload
  706. (define-derived-mode beancount-mode text-mode "Beancount"
  707. "A mode for editing beancount files.
  708. \\{beancount-mode-map}"
  709. :init-value nil
  710. :lighter " Beancount"
  711. :group 'beancount
  712. ;; customize font-lock for beancount.
  713. (set-syntax-table beancount-mode-syntax-table)
  714. (font-lock-add-keywords nil beancount-font-lock-directives)
  715. (or beancount-accounts-cache
  716. (setq beancount-accounts-cache (beancount-get-accounts-in-buffer))) ;-new
  717. (or beancount-payees-cache
  718. (setq beancount-payees-cache (beancount-get-payees-in-buffer)))
  719. (or beancount-payeetext-cache
  720. (setq beancount-payeetext-cache (beancount-get-payee-text-in-buffer)))
  721. (or beancount-commodities-cache
  722. (setq beancount-commodities-cache (beancount-get-commodities-in-buffer)))
  723. (or beancount-tags-cache
  724. (setq beancount-tags-cache (beancount-get-tags-in-buffer)))
  725. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  726. ;;NEW for completa-at-point-function
  727. ; (add-hook 'completion-at-point-functions #'beancount-completion-at-point nil t)
  728. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  729. )
  730. (provide 'beancount)
  731. ;;; beancount.el ends here