diff options
| -rw-r--r-- | .emacs.local.d/elisp/beancount.el | 653 |
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 |