aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.emacs.local.d/elisp/beancount.el653
1 files changed, 0 insertions, 653 deletions
diff --git a/.emacs.local.d/elisp/beancount.el b/.emacs.local.d/elisp/beancount.el
deleted file mode 100644
index 7ca2a02..0000000
--- a/.emacs.local.d/elisp/beancount.el
+++ /dev/null
@@ -1,653 +0,0 @@
-;;; beancount.el --- A minor mode that can be used to edit beancount input files.
-
-;; Copyright (C) 2013 Martin Blais <blais@furius.ca>
-;; Copyright (C) 2015 Free Software Foundation, Inc.
-
-;; Version: 0
-;; Author: Martin Blais <blais@furius.ca>
-;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
-
-;; This file is not part of GNU Emacs.
-
-;; This package is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This package is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this package. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; TODO: Add a flymake rule, using bean-check
-
-;;; Code:
-
-(autoload 'ido-completing-read "ido")
-(require 'font-lock)
-
-(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-nontimestamped-directive-names
- '("pushtag"
- "poptag"
- "option"
- "include"
- "plugin")
- "Directive names that can appear after a date.")
-
-(defvar beancount-directive-names
- (append beancount-nontimestamped-directive-names
- beancount-timestamped-directive-names)
- "A list of the directive names.")
-
-(defconst beancount-tag-chars "[:alnum:]-_/.")
-
-(defconst beancount-account-categories
- '("Assets" "Liabilities" "Equity" "Income" "Expenses"))
-
-(defconst beancount-account-chars "[:alnum:]-_:")
-
-(defconst beancount-option-names
- ;; This list is kept in sync with the options defined in
- ;; beancount/parser/options.py.
- ;; Note: We should eventually build a tool that spits out the current list
- ;; automatically.
- '("title"
- "name_assets"
- "name_liabilities"
- "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"
- ))
-
-(defvar beancount-font-lock-keywords
- `(;; Reserved keywords
- (,(regexp-opt beancount-directive-names) . font-lock-keyword-face)
-
- ;; Tags & Links
- ("[#\\^][A-Za-z0-9\-_/.]+" . font-lock-type-face)
-
- ;; Date
- ("[0-9][0-9][0-9][0-9][-/][0-9][0-9][-/][0-9][0-9]" . font-lock-constant-face)
-
- ;; Account
- ("\\([A-Z][A-Za-z0-9\-]+:\\)+\\([A-Z][A-Za-z0-9\-]+\\)" . font-lock-builtin-face)
-
- ;; Txn Flags
- ("! " . font-lock-warning-face)
-
- ;; Number + Currency
- ;;; ("\\([\\-+]?[0-9,]+\\(\\.[0-9]+\\)?\\)\\s-+\\([A-Z][A-Z0-9'\.]\\{1,10\\}\\)" . )
- ))
-
-
-(defvar beancount-mode-map-prefix [(control c)]
- "The prefix key used to bind Beancount commands in Emacs")
-
-(defvar beancount-mode-map
- (let ((map (make-sparse-keymap))
- (p beancount-mode-map-prefix))
- (define-key map (vconcat p [(\')]) #'beancount-insert-account)
- (define-key map (vconcat p [(control g)]) #'beancount-transaction-set-flag)
- (define-key map (vconcat p [(r)]) #'beancount-init-accounts)
- (define-key map (vconcat p [(l)]) #'beancount-check)
- (define-key map (vconcat p [(q)]) #'beancount-query)
- (define-key map (vconcat p [(x)]) #'beancount-context)
- (define-key map (vconcat p [(k)]) #'beancount-linked)
- (define-key map (vconcat p [(p)]) #'beancount-insert-prices)
- (define-key map (vconcat p [(\;)]) #'beancount-align-to-previous-number)
- (define-key map (vconcat p [(\:)]) #'beancount-align-numbers)
-
- ;; FIXME: Binding TAB breaks expected org-mode behavior to fold/unfold. We
- ;; need to find a better solution.
- ;;(define-key map [?\t] #'beancount-tab)
- map))
-
-(defvar beancount-mode-syntax-table
- (let ((st (make-syntax-table)))
- (modify-syntax-entry ?\" "\"\"" st)
- (modify-syntax-entry ?\; "<" st)
- (modify-syntax-entry ?\n ">" st)
- st))
-
-(defun beancount--goto-bob () (goto-char (point-min)))
-
-;;;###autoload
-(define-minor-mode beancount-mode
- "A minor mode to help editing Beancount files.
-This can be used within other text modes, in particular, org-mode
-is great for sectioning large files with many transactions.
-
-\\{beancount-mode-map}"
- :init-value nil
- :lighter " Beancount"
- :group 'beancount
-
- ;; The following is mostly lifted from lisp-mode.
-
- (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
- (set (make-local-variable 'fill-paragraph-function) #'lisp-fill-paragraph)
-
- (set (make-local-variable 'comment-start) ";; ")
-
- ;; Look within the line for a ; following an even number of backslashes
- ;; after either a non-backslash or the line beginning.
- (set (make-local-variable 'comment-start-skip)
- "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
- ;; Font lock mode uses this only when it KNOWS a comment is starting.
- ;; FIXME: Why bother?
- (set (make-local-variable 'font-lock-comment-start-skip) ";+ *")
- ;; Default to `;;' in comment-region.
- (set (make-local-variable 'comment-add) 1)
-
- ;; Org-mode sets both of these to `org-comment-or-uncomment-region',
- ;; which doesn't know about our ";" comments.
- (kill-local-variable 'comment-region-function)
- (kill-local-variable 'uncomment-region-function)
-
- ;; No tabs by default.
- (set (make-local-variable 'indent-tabs-mode) nil)
-
- (add-hook 'completion-at-point-functions
- #'beancount-completion-at-point nil t)
- (set (make-local-variable 'completion-ignore-case) t)
-
- ;; Customize font-lock for beancount.
- ;;
- (set-syntax-table beancount-mode-syntax-table)
- (when (fboundp 'syntax-ppss-flush-cache)
- (syntax-ppss-flush-cache (point-min))
- (set (make-local-variable 'syntax-begin-function) #'beancount--goto-bob))
- ;; Force font-lock to use the syntax-table to find strings-and-comments,
- ;; regardless of what the "host major mode" decided.
- (set (make-local-variable 'font-lock-keywords-only) nil)
- ;; Important: you have to use 'nil for the mode here because in certain major
- ;; modes (e.g. org-mode) the font-lock-keywords is a buffer-local variable.
- (if beancount-mode
- (font-lock-add-keywords nil beancount-font-lock-keywords)
- (font-lock-remove-keywords nil beancount-font-lock-keywords))
- (if (fboundp 'font-lock-flush)
- (font-lock-flush)
- (with-no-warnings (font-lock-fontify-buffer)))
-
- (when beancount-mode
- (beancount-init-accounts))
- )
-
-(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))
- (message "Accounts updated."))
-
-(defvar beancount-date-regexp "[0-9][0-9][0-9][0-9][-/][0-9][0-9][-/][0-9][0-9]"
- "A regular expression to match dates.")
-
-(defvar beancount-account-regexp
- (concat (regexp-opt beancount-account-categories)
- "\\(?::[[:upper:]][" beancount-account-chars "]+\\)")
- "A regular expression to match account names.")
-
-(defvar beancount-number-regexp "[-+]?[0-9,]+\\(?:\\.[0-9]*\\)?"
- "A regular expression to match decimal numbers in beancount.")
-
-(defvar beancount-currency-regexp "[A-Z][A-Z-_'.]*"
- "A regular expression to match currencies in beancount.")
-
-(defun beancount-tab ()
- "Try to use the right meaning of TAB."
- (interactive)
- (let ((cdata (beancount-completion-at-point)))
- (if cdata
- ;; There's beancount-specific completion at point.
- (call-interactively #'completion-at-point)
- (let* ((beancount-mode nil)
- (fallback (key-binding (this-command-keys))))
- (if (commandp fallback)
- (command-execute fallback))))))
-
-(defun beancount-tags (prefix)
- "Return list of all tags starting with PREFIX in current buffer.
-Excludes tags appearing on the current line."
- (unless (string-match "\\`[#^]" prefix)
- (error "Unexpected prefix to search tags: %S" prefix))
- (let ((found ())
- (re (concat prefix "[" beancount-tag-chars "]*")))
- (save-excursion
- (forward-line 0)
- (while (re-search-backward re nil t)
- (push (match-string 0) found)))
- ;; Ignore tags on current line.
- (save-excursion
- (forward-line 1)
- (while (re-search-forward re nil t)
- (push (match-string 0) found)))
- (delete-dups found)))
-
-(defconst beancount-txn-regexp
- ;; For the full definition of a flag, see the rule that emits FLAG in
- ;; beancount/parser/lexer.l. For this, let's assume that it's a single char
- ;; that's neither a space nor a lower-case letter. This should be updated as
- ;; the parser is improved.
- "^[0-9-/]+ +\\(?:txn +\\)?[^ [:lower:]]\\($\\| \\)")
-
-(defun beancount-inside-txn-p ()
- ;; FIXME: The doc doesn't actually say how the legs of a transaction can be
- ;; layed out. We assume that they all start with some space on the line.
- (save-excursion
- (forward-line 0)
- (while (and (looking-at "[ \t]") (not (bobp)))
- (forward-line -1))
- (looking-at beancount-txn-regexp)))
-
-(defun beancount-completion-at-point ()
- "Return the completion data relevant for the text at point."
- (let ((bp (buffer-substring (line-beginning-position) (point))))
- (cond
- ((string-match "\\`[a-z]*\\'" bp)
- ;; A directive starting at BOL (hence non-timestamped).
- (list (line-beginning-position)
- (save-excursion (skip-chars-forward "a-z") (point))
- '("pushtag" "poptag")))
-
- ((string-match
- (concat "\\`option +\\(\"[a-z_]*\\)?\\'")
- bp)
- (list (- (point)
- (if (match-end 1) (- (match-end 1) (match-beginning 1)) 0))
- (save-excursion (skip-chars-forward "a-z_")
- (if (looking-at "\"") (forward-char 1))
- (point))
- (mapcar (lambda (s) (concat "\"" s "\"")) beancount-option-names)))
-
- ((string-match
- (concat "\\`poptag +\\(#[" beancount-tag-chars "]*\\)?\\'")
- bp)
- (list (- (point)
- (if (match-end 1) (- (match-end 1) (match-beginning 1)) 0))
- (save-excursion (skip-chars-forward beancount-tag-chars) (point))
- (save-excursion
- (let ((opened ()))
- (while (re-search-backward
- (concat "^pushtag +\\(#[" beancount-tag-chars "]+\\)")
- nil t)
- (push (match-string 1) opened))
- opened))))
-
- ((string-match "\\`[0-9-/]+ +\\([[:alpha:]]*\\'\\)" bp)
- ;; A timestamped directive.
- (list (- (point) (- (match-end 1) (match-beginning 1)))
- (save-excursion (skip-chars-forward "[:alpha:]") (point))
- beancount-timestamped-directive-names))
-
- ((and (beancount-inside-txn-p)
- (string-match (concat "\\`[ \t]+\\(["
- beancount-account-chars "]*\\)\\'")
- bp))
- ;; Hopefully, an account name. We don't force the partially-written
- ;; account name to start with a capital, so that it's possible to use
- ;; substring completion and also so we can rely on completion to put the
- ;; right capitalization (thanks to completion-ignore-case).
- (list (- (point) (- (match-end 1) (match-beginning 1)))
- (save-excursion (skip-chars-forward beancount-account-chars)
- (point))
- #'beancount-account-completion-table))
-
- ((string-match (concat "\\`[0-9-/]+ +\\("
- (regexp-opt beancount-timestamped-directive-names)
- "\\) +\\([" beancount-account-chars "]*\\'\\)")
- bp)
- (list (- (point) (- (match-end 2) (match-beginning 2)))
- (save-excursion (skip-chars-forward beancount-account-chars)
- (point))
- (if (equal (match-string 1 bp) "open")
- (append
- (mapcar (lambda (c) (concat c ":")) beancount-account-categories)
- beancount-accounts)
- #'beancount-account-completion-table)))
-
- ((string-match (concat "[#^][" beancount-tag-chars "]*\\'") bp)
- (list (- (point) (- (match-end 0) (match-beginning 0)))
- (save-excursion (skip-chars-forward beancount-tag-chars) (point))
- (completion-table-dynamic #'beancount-tags))))))
-
-(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<)))
-
-(defun beancount-get-accounts ()
- "Heuristically obtain a list of all the accounts used in all the postings.
-We ignore patterns seen the line 'exclude-line'. If ALL is non-nil, look
-for account names in postings as well (default is to look at the @defaccount
-declarations only."
- (let ((accounts (make-hash-table :test 'equal)))
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward beancount-account-regexp nil t)
- (puthash (match-string-no-properties 0) nil accounts)))
- (sort (beancount-hash-keys accounts) 'string<)))
-
-(defcustom beancount-use-ido t
- "If non-nil, use ido-style completion rather than the standard completion."
- :type 'boolean)
-
-(defun beancount-account-completion-table (string pred action)
- (if (eq action 'metadata)
- '(metadata (category . beancount-account))
- (complete-with-action action beancount-accounts string pred)))
-
-;; Default to substring completion for beancount accounts.
-(defconst beancount--completion-overrides
- '(beancount-account (styles basic partial-completion substring)))
-(cond
- ((boundp 'completion-category-defaults)
- (add-to-list 'completion-category-defaults beancount--completion-overrides))
- ((and (boundp 'completion-category-overrides)
- (not (assq 'beancount-account completion-category-overrides)))
- (push beancount--completion-overrides completion-category-overrides)))
-
-(defun beancount-insert-account (account-name)
- "Insert one of the valid account names in this file.
-Uses ido niceness according to `beancount-use-ido'."
- (interactive
- (list
- (if beancount-use-ido
- ;; `ido-completing-read' is too dumb to understand functional
- ;; completion tables!
- (ido-completing-read "Account: " beancount-accounts
- nil nil (thing-at-point 'word))
- (completing-read "Account: " #'beancount-account-completion-table
- nil t (thing-at-point 'word)))))
- (let ((bounds (bounds-of-thing-at-point 'word)))
- (when bounds
- (delete-region (car bounds) (cdr bounds))))
- (insert account-name))
-
-
-(defun beancount-transaction-set-flag ()
- (interactive)
- (save-excursion
- (backward-paragraph 1)
- (forward-line 1)
- (while (search-forward "!" (line-end-position) t)
- (replace-match "*"))))
-
-
-(defmacro beancount-for-line-in-region (begin end &rest exprs)
- "Iterate over each line in region 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-max-accounts-width (begin end)
- "Return the minimum widths of a list of account names on a list
-of lines. Initial whitespace is ignored."
- (let* (widths)
- (beancount-for-line-in-region
- begin end
- (let* ((line (thing-at-point 'line)))
- (when (string-match
- (concat "^[ \t]*\\(" beancount-account-regexp "\\)") line)
- (push (length (match-string 1 line)) widths))))
- (apply 'max widths)))
-
-
-(defun beancount-align-numbers (begin end &optional requested-currency-column)
- "Align all numbers in the given region. CURRENCY-COLUMN is the character
-at which to align the beginning of the amount's currency. If not specified, use
-the smallest columns that will align all the numbers. With a prefix argument,
-align with the fill-column."
- (interactive "r")
-
- ;; With a prefix argument, align with the fill-column.
- (when current-prefix-arg
- (setq requested-currency-column fill-column))
-
- ;; Loop once in the region 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 rightmost column of prefix.
- (max-prefix-width (apply 'max prefix-widths))
- (max-prefix-width
- (if requested-currency-column
- (max (- requested-currency-column (length number-padding) number-width 1)
- max-prefix-width)
- max-prefix-width))
- (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-align-to-previous-number ()
- "Align postings under the point's paragraph.
-This function looks for a posting in the previous transaction to
-determine the column at which to align the transaction, or otherwise
-the fill column, and align all the postings of this transaction to
-this column."
- (interactive)
- (let* ((begin (save-excursion
- (beancount-beginning-of-directive)
- (point)))
- (end (save-excursion
- (goto-char begin)
- (forward-paragraph 1)
- (point)))
- (currency-column (or (beancount-find-previous-alignment-column)
- fill-column)))
- (beancount-align-numbers begin end currency-column)))
-
-
-(defun beancount-beginning-of-directive ()
- "Move point to the beginning of the enclosed or preceding directive."
- (beginning-of-line)
- (while (and (> (point) (point-min))
- (not (looking-at
- "[0-9][0-9][0-9][0-9][\-/][0-9][0-9][\-/][0-9][0-9]")))
- (forward-line -1)))
-
-
-(defun beancount-find-previous-alignment-column ()
- "Find the preceding column to align amounts with.
-This is used to align transactions at the same column as that of
-the previous transaction in the file. This function merely finds
-what that column is and returns it (an integer)."
- ;; Go hunting for the last column with a suitable posting.
- (let (column)
- (save-excursion
- ;; Go to the beginning of the enclosing directive.
- (beancount-beginning-of-directive)
- (forward-line -1)
-
- ;; Find the last posting with an amount and a currency on it.
- (let ((posting-regexp (concat
- "\\s-+"
- beancount-account-regexp "\\s-+"
- beancount-number-regexp "\\s-+"
- "\\(" beancount-currency-regexp "\\)"))
- (balance-regexp (concat
- beancount-date-regexp "\\s-+"
- "balance" "\\s-+"
- beancount-account-regexp "\\s-+"
- beancount-number-regexp "\\s-+"
- "\\(" beancount-currency-regexp "\\)")))
- (while (and (> (point) (point-min))
- (not (or (looking-at posting-regexp)
- (looking-at balance-regexp))))
- (forward-line -1))
- (when (or (looking-at posting-regexp)
- (looking-at balance-regexp))
- (setq column (- (match-beginning 1) (point))))
- ))
- column))
-
-(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.")
-
-(defvar beancount-check-program "bean-check"
- "Program to run to run just the parser and validator on an
- input file.")
-
-(defvar compilation-read-command)
-
-(defun beancount--run (prog &rest 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)))
-
-(defun beancount-check ()
- "Run `beancount-check-program'."
- (interactive)
- (let ((compilation-read-command nil))
- (beancount--run beancount-check-program
- (file-relative-name buffer-file-name))))
-
-(defvar beancount-query-program "bean-query"
- "Program to run to run just the parser and validator on an
- input file.")
-
-(defun beancount-query ()
- "Run bean-query."
- (interactive)
- ;; Don't let-bind compilation-read-command this time, since the default
- ;; command is incomplete.
- (beancount--run beancount-query-program
- (file-relative-name buffer-file-name) t))
-
-
-(defvar beancount-doctor-program "bean-doctor"
- "Program to run the doctor commands.")
-
-(defun beancount-context ()
- "Get the \"context\" from `beancount-doctor-program'."
- (interactive)
- (let ((compilation-read-command nil))
- (beancount--run beancount-doctor-program "context"
- (file-relative-name buffer-file-name)
- (number-to-string (line-number-at-pos)))))
-
-
-(defun beancount-linked ()
- "Get the \"linked\" info from `beancount-doctor-program'."
- (interactive)
- (let ((compilation-read-command nil))
- (beancount--run beancount-doctor-program "linked"
- (file-relative-name buffer-file-name)
- (number-to-string (line-number-at-pos)))))
-
-(defvar beancount-price-program "bean-price"
- "Program to run the price fetching commands.")
-
-(defun beancount-insert-prices ()
- "Run bean-price on the current file and insert the output inline."
- (interactive)
- (call-process beancount-price-program nil t nil
- (file-relative-name buffer-file-name)))
-
-
-(provide 'beancount)
-;;; beancount.el ends here
nihil fit ex nihilo