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.

724 lines
26 KiB

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