Add beancount.el to doom config

emacs/.config/doom/beancount.el

@@ -0,0 +1,1013 @@
+;;; beancount.el --- A major mode to edit Beancount input files. -*- lexical-binding: t -*-
+
+;; Copyright (C) 2013 Martin Blais <blais@furius.ca>
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2019 Daniele Nicolodi <daniele@grinta.net>
+
+;; Version: 0
+;; Author: Martin Blais <blais@furius.ca>
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Author: Daniele Nicolodi <daniele@grinta.net>
+
+;; 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 'subr-x)
+(require 'outline)
+
+(defgroup beancount ()
+  "Editing mode for Beancount files."
+  :group 'beancount)
+
+(defcustom beancount-transaction-indent 2
+  "Transaction indent."
+  :type 'integer)
+
+(defcustom beancount-number-alignment-column 52
+  "Column to which align numbers in postinng definitions. Set to
+0 to automatically determine the minimum column that will allow
+to align all amounts."
+  :type 'integer)
+
+(defcustom beancount-highlight-transaction-at-point nil
+  "If t highlight transaction under point."
+  :type 'boolean)
+
+(defcustom beancount-use-ido t
+  "If non-nil, use ido-style completion rather than the standard."
+  :type 'boolean)
+
+(defcustom beancount-electric-currency nil
+  "If non-nil, make `newline' try to add missing currency to
+complete the posting at point. The correct currency is determined
+from the open directive for the relevant account."
+  :type 'boolean)
+
+(defgroup beancount-faces nil "Beancount mode highlighting" :group 'beancount)
+
+(defface beancount-directive
+  `((t :inherit font-lock-keyword-face))
+  "Face for Beancount directives.")
+
+(defface beancount-tag
+  `((t :inherit font-lock-type-face))
+  "Face for Beancount tags.")
+
+(defface beancount-link
+  `((t :inherit font-lock-type-face))
+  "Face for Beancount links.")
+
+(defface beancount-date
+  `((t :inherit font-lock-constant-face))
+  "Face for Beancount dates.")
+
+(defface beancount-account
+  `((t :inherit font-lock-builtin-face))
+  "Face for Beancount account names.")
+
+(defface beancount-amount
+  `((t :inherit font-lock-default-face))
+  "Face for Beancount amounts.")
+
+(defface beancount-narrative
+  `((t :inherit font-lock-builtin-face))
+  "Face for Beancount transactions narrative.")
+
+(defface beancount-narrative-cleared
+  `((t :inherit font-lock-string-face))
+  "Face for Beancount cleared transactions narrative.")
+
+(defface beancount-narrative-pending
+  `((t :inherit font-lock-keyword-face))
+  "Face for Beancount pending transactions narrative.")
+
+(defface beancount-metadata
+  `((t :inherit font-lock-type-face))
+  "Face for Beancount metadata.")
+
+(defface beancount-highlight
+  `((t :inherit highlight))
+  "Face to highlight Beancount transaction at point.")
+
+(defconst beancount-account-directive-names
+  '("balance"
+    "close"
+    "document"
+    "note"
+    "open"
+    "pad")
+  "Directive bames that can appear after a date and are followd by an account.")
+
+(defconst beancount-no-account-directive-names
+  '("commodity"
+    "event"
+    "price"
+    "query"
+    "txn")
+  "Directive names that can appear after a date and are _not_ followed by an account.")
+
+(defconst beancount-timestamped-directive-names
+  (append beancount-account-directive-names
+          beancount-no-account-directive-names)
+  "Directive names that can appear after a date.")
+
+(defconst beancount-directive-names
+  '("include"
+    "option"
+    "plugin"
+    "poptag"
+    "pushtag")
+  "Directive names that can appear at the beginning of a line.")
+
+(defconst beancount-account-categories
+  '("Assets" "Liabilities" "Equity" "Income" "Expenses"))
+
+(defconst beancount-tag-chars "[:alnum:]-_/.")
+
+(defconst beancount-account-chars "[:alnum:]-_:")
+
+(defconst beancount-option-names
+  ;; This list is kept in sync with the options defined in
+  ;; beancount/parser/options.py.
+  '("account_current_conversions"
+    "account_current_earnings"
+    "account_previous_balances"
+    "account_previous_conversions"
+    "account_previous_earnings"
+    "account_rounding"
+    "allow_deprecated_none_for_tags_and_links"
+    "allow_pipe_separator"
+    "booking_method"
+    "conversion_currency"
+    "documents"
+    "infer_tolerance_from_cost"
+    "inferred_tolerance_default"
+    "inferred_tolerance_multiplier"
+    "insert_pythonpath"
+    "long_string_maxlines"
+    "name_assets"
+    "name_equity"
+    "name_expenses"
+    "name_income"
+    "name_liabilities"
+    "operating_currency"
+    "plugin_processing_mode"
+    "render_commas"
+    "title"))
+
+(defconst beancount-date-regexp "[0-9]\\{4\\}[-/][0-9]\\{2\\}[-/][0-9]\\{2\\}"
+  "A regular expression to match dates.")
+
+(defconst beancount-account-regexp
+  (concat (regexp-opt beancount-account-categories)
+          "\\(?::[[:upper:]][[:alnum:]-_]+\\)+")
+  "A regular expression to match account names.")
+
+(defconst beancount-number-regexp "[-+]?[0-9]+\\(?:,[0-9]\\{3\\}\\)*\\(?:\\.[0-9]*\\)?"
+  "A regular expression to match decimal numbers.")
+
+(defconst beancount-currency-regexp "[A-Z][A-Z-_'.]*"
+  "A regular expression to match currencies.")
+
+(defconst beancount-flag-regexp
+  ;; Single char that is neither a space nor a lower-case letter.
+  "[^ a-z]")
+
+(defconst beancount-transaction-regexp
+  (concat "^\\(" beancount-date-regexp "\\) +"
+          "\\(?:txn +\\)?"
+          "\\(" beancount-flag-regexp "\\) +"
+          "\\(\".*\"\\)"))
+
+(defconst beancount-posting-regexp
+  (concat "^\\s-+"
+          "\\(" beancount-account-regexp "\\)"
+          "\\(?:\\s-+\\(\\(" beancount-number-regexp "\\)"
+          "\\s-+\\(" beancount-currency-regexp "\\)\\)\\)?"))
+
+(defconst beancount-directive-regexp
+  (concat "^\\(" (regexp-opt beancount-directive-names) "\\) +"))
+
+(defconst beancount-timestamped-directive-regexp
+  (concat "^\\(" beancount-date-regexp "\\) +"
+          "\\(" (regexp-opt beancount-timestamped-directive-names) "\\) +"))
+
+(defconst beancount-metadata-regexp
+  "^\\s-+\\([a-z][A-Za-z0-9_-]+:\\)\\s-+\\(.+\\)")
+
+(defvar beancount-outline-regexp "\\(;;;+\\|\\*+\\)")
+
+(defun beancount-outline-level ()
+  (let ((len (- (match-end 1) (match-beginning 1))))
+    (if (equal (substring (match-string 1) 0 1) ";")
+        (- len 2)
+      len)))
+
+(defun beancount-face-by-state (state)
+  (cond ((string-equal state "*") 'beancount-narrative-cleared)
+        ((string-equal state "!") 'beancount-narrative-pending)
+        (t 'beancount-narrative)))
+
+(defun beancount-outline-face ()
+  (if outline-minor-mode
+      (cl-case (funcall outline-level)
+      (1 'org-level-1)
+      (2 'org-level-2)
+      (3 'org-level-3)
+      (4 'org-level-4)
+      (5 'org-level-5)
+      (6 'org-level-6)
+      (otherwise nil))
+    nil))
+
+(defvar beancount-font-lock-keywords
+  `((,beancount-transaction-regexp (1 'beancount-date)
+                                   (2 (beancount-face-by-state (match-string 2)) t)
+                                   (3 (beancount-face-by-state (match-string 2)) t))
+    (,beancount-posting-regexp (1 'beancount-account)
+                               (2 'beancount-amount nil :lax))
+    (,beancount-metadata-regexp (1 'beancount-metadata)
+                                (2 'beancount-metadata t))
+    (,beancount-directive-regexp (1 'beancount-directive))
+    (,beancount-timestamped-directive-regexp (1 'beancount-date)
+                                             (2 'beancount-directive))
+    ;; Fontify section headers when composed with outline-minor-mode.
+    (,(concat "^\\(" beancount-outline-regexp "\\).*") . (0 (beancount-outline-face)))
+    ;; Tags and links.
+    (,(concat "\\#[" beancount-tag-chars "]*") . 'beancount-tag)
+    (,(concat "\\^[" beancount-tag-chars "]*") . 'beancount-link)
+    ;; Number followed by currency not covered by previous rules.
+    (,(concat beancount-number-regexp "\\s-+" beancount-currency-regexp) . 'beancount-amount)
+    ;; Accounts not covered by previous rules.
+    (,beancount-account-regexp . 'beancount-account)
+    ))
+
+(defun beancount-tab-dwim (&optional arg)
+  (interactive "P")
+  (if (and outline-minor-mode
+           (or arg (outline-on-heading-p)))
+      (beancount-outline-cycle arg)
+    (indent-for-tab-command)))
+
+(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 (kbd "TAB") #'beancount-tab-dwim)
+    (define-key map (kbd "M-RET") #'beancount-insert-date)
+    (define-key map (vconcat p [(\')]) #'beancount-insert-account)
+    (define-key map (vconcat p [(control g)]) #'beancount-transaction-clear)
+    (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)
+    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))
+
+;;;###autoload
+(define-derived-mode beancount-mode fundamental-mode "Beancount"
+  "A mode for Beancount files.
+
+\\{beancount-mode-map}"
+  :group 'beancount
+  :syntax-table beancount-mode-syntax-table
+
+  (setq-local paragraph-ignore-fill-prefix t)
+  (setq-local fill-paragraph-function #'beancount-indent-transaction)
+
+  (setq-local comment-start ";")
+  (setq-local comment-start-skip ";+\\s-*")
+  (setq-local comment-add 1)
+
+  (setq-local indent-line-function #'beancount-indent-line)
+  (setq-local indent-region-function #'beancount-indent-region)
+  (setq-local indent-tabs-mode nil)
+
+  (setq-local tab-always-indent 'complete)
+  (setq-local completion-ignore-case t)
+  
+  (add-hook 'completion-at-point-functions #'beancount-completion-at-point nil t)
+  (add-hook 'post-command-hook #'beancount-highlight-transaction-at-point nil t)
+  (add-hook 'post-self-insert-hook #'beancount--electric-currency nil t)
+  
+  (setq-local font-lock-defaults '(beancount-font-lock-keywords))
+  (setq-local font-lock-syntax-table t)
+
+  (setq-local outline-regexp beancount-outline-regexp)
+  (setq-local outline-level #'beancount-outline-level))
+
+(defun beancount-collect-pushed-tags (begin end)
+  "Return list of all pushed (and not popped) tags in the region."
+  (goto-char begin)
+  (let ((tags (make-hash-table :test 'equal)))
+    (while (re-search-forward
+         (concat "^\\(push\\|pop\\)tag\\s-+\\(#[" beancount-tag-chars "]+\\)") end t)
+      (if (string-equal (match-string 1) "push")
+          (puthash (match-string-no-properties 2) nil tags)
+        (remhash (match-string-no-properties 2) tags)))
+    (hash-table-keys tags)))
+
+(defun beancount-goto-transaction-begin ()
+  "Move the cursor to the first line of the transaction definition."
+  (interactive)
+  (beginning-of-line)
+  ;; everything that is indented with at lest one space or tab is part
+  ;; of the transaction definition
+  (while (looking-at-p "[ \t]+")
+    (forward-line -1))
+  (point))
+
+(defun beancount-goto-transaction-end ()
+  "Move the cursor to the line after the transaction definition."
+  (interactive)
+  (beginning-of-line)
+  (if (looking-at-p beancount-transaction-regexp)
+      (forward-line))
+  ;; everything that is indented with at least one space or tab as part
+  ;; of the transaction definition
+  (while (looking-at-p "[ \t]+")
+    (forward-line))
+  (point))
+
+(defun beancount-goto-next-transaction (&optional arg)
+  "Move to the next transaction.
+With an argument move to the next non cleared transaction."
+  (interactive "P")
+  (beancount-goto-transaction-end)
+  (let ((done nil))
+    (while (and (not done)
+                (re-search-forward beancount-transaction-regexp nil t))
+      (if (and arg (string-equal (match-string 2) "*"))
+          (goto-char (match-end 0))
+        (goto-char (match-beginning 0))
+        (setq done t)))
+    (if (not done) (goto-char (point-max)))))
+
+(defun beancount-find-transaction-extents (p)
+  (save-excursion
+    (goto-char p)
+    (list (beancount-goto-transaction-begin)
+          (beancount-goto-transaction-end))))
+
+(defun beancount-inside-transaction-p ()
+  (let ((bounds (beancount-find-transaction-extents (point))))
+    (> (- (cadr bounds) (car bounds)) 0)))
+
+(defun beancount-looking-at (regexp n pos)
+  (and (looking-at regexp)
+       (>= pos (match-beginning n))
+       (<= pos (match-end n))))
+
+(defvar beancount-accounts nil
+  "A list of the accounts available in this buffer.")
+(make-variable-buffer-local 'beancount-accounts)
+
+(defun beancount-completion-at-point ()
+  "Return the completion data relevant for the text at point."
+  (save-excursion
+    (save-match-data
+      (let ((pos (point)))
+        (beginning-of-line)
+        (cond
+         ;; non timestamped directive
+         ((beancount-looking-at "[a-z]*" 0 pos)
+          (list (match-beginning 0) (match-end 0)
+                (mapcar (lambda (s) (concat s " ")) beancount-directive-names)))
+
+         ;; poptag
+         ((beancount-looking-at
+           (concat "poptag\\s-+\\(\\(?:#[" beancount-tag-chars "]*\\)\\)") 1 pos)
+          (list (match-beginning 1) (match-end 1)
+                (beancount-collect-pushed-tags (point-min) (point))))
+
+         ;; option
+         ((beancount-looking-at
+           (concat "^option\\s-+\\(\"[a-z_]*\\)") 1 pos)
+          (list (match-beginning 1) (match-end 1)
+                (mapcar (lambda (s) (concat "\"" s "\" ")) beancount-option-names)))
+
+         ;; timestamped directive
+         ((beancount-looking-at
+           (concat beancount-date-regexp "\\s-+\\([[:alpha:]]*\\)") 1 pos)
+          (list (match-beginning 1) (match-end 1)
+                (mapcar (lambda (s) (concat s " ")) beancount-timestamped-directive-names)))
+
+         ;; timestamped directives followed by account
+         ((beancount-looking-at
+           (concat "^" beancount-date-regexp
+                   "\\s-+" (regexp-opt beancount-account-directive-names)
+                   "\\s-+\\([" beancount-account-chars "]*\\)") 1 pos)
+          (setq beancount-accounts nil)
+          (list (match-beginning 1) (match-end 1) #'beancount-account-completion-table))
+
+         ;; posting
+         ((and (beancount-looking-at
+                (concat "[ \t]+\\([" beancount-account-chars "]*\\)") 1 pos)
+               ;; Do not force the account name to start with a
+               ;; capital, so that it is possible to use substring
+               ;; completion and we can rely on completion to fix
+               ;; capitalization thanks to completion-ignore-case.
+               (beancount-inside-transaction-p))
+          (setq beancount-accounts nil)
+          (list (match-beginning 1) (match-end 1) #'beancount-account-completion-table))
+
+         ;; tags
+         ((beancount-looking-at
+           (concat "[ \t]+#\\([" beancount-tag-chars "]*\\)") 1 pos)
+          (let* ((candidates nil)
+                 (regexp (concat "\\#\\([" beancount-tag-chars "]+\\)"))
+                 (completion-table
+                  (lambda (string pred action)
+                    (if (null candidates)
+                        (setq candidates
+                              (sort (beancount-collect regexp 1) #'string<)))
+                    (complete-with-action action candidates string pred))))
+            (list (match-beginning 1) (match-end 1) completion-table)))
+
+         ;; links
+         ((beancount-looking-at
+           (concat "[ \t]+\\^\\([" beancount-tag-chars "]*\\)") 1 pos)
+          (let* ((candidates nil)
+                 (regexp (concat "\\^\\([" beancount-tag-chars "]+\\)"))
+                 (completion-table
+                  (lambda (string pred action)
+                    (if (null candidates)
+                        (setq candidates
+                              (sort (beancount-collect regexp 1) #'string<)))
+                    (complete-with-action action candidates string pred))))
+            (list (match-beginning 1) (match-end 1) completion-table))))))))
+
+(defun beancount-collect (regexp n)
+  "Return an unique list of REGEXP group N in the current buffer."
+  (let ((pos (point)))
+    (save-excursion
+      (save-match-data
+        (let ((hash (make-hash-table :test 'equal)))
+          (goto-char (point-min))
+          (while (re-search-forward regexp nil t)
+            ;; Ignore matches around `pos' (the point position when
+            ;; entering this funcyion) since that's presumably what
+            ;; we're currently trying to complete.
+            (unless (<= (match-beginning 0) pos (match-end 0))
+              (puthash (match-string-no-properties n) nil hash)))
+          (hash-table-keys hash))))))
+
+(defun beancount-account-completion-table (string pred action)
+  (if (eq action 'metadata) '(metadata (category . beancount-account))
+    (if (null beancount-accounts)
+        (setq beancount-accounts
+              (sort (beancount-collect beancount-account-regexp 0) #'string<)))
+    (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)))
+(add-to-list 'completion-category-defaults beancount--completion-overrides)
+
+(defun beancount-number-alignment-column ()
+  "Return the column to which postings amounts should be aligned to.
+Returns `beancount-number-alignment-column' unless it is 0. In
+that case, scan the buffer to determine the minimum column that
+will allow to align all numbers."
+  (if (> beancount-number-alignment-column 0)
+      beancount-number-alignment-column
+    (save-excursion
+      (save-match-data
+        (let ((account-width 0)
+              (number-width 0))
+          (goto-char (point-min))
+          (while (re-search-forward beancount-posting-regexp nil t)
+            (if (match-string 2)
+                (let ((accw (- (match-end 1) (line-beginning-position)))
+                      (numw (- (match-end 3) (match-beginning 3))))
+                  (setq account-width (max account-width accw)
+                        number-width (max number-width numw)))))
+          (+ account-width 2 number-width))))))
+
+(defun beancount-compute-indentation ()
+  "Return the column to which the current line should be indented."
+  (save-excursion
+    (beginning-of-line)
+    (cond
+     ;; Only timestamped directives start with a digit.
+     ((looking-at-p "[0-9]") 0)
+     ;; Otherwise look at the previous line.
+     ((and (= (forward-line -1) 0)
+           (or (looking-at-p "[ \t].+")
+               (looking-at-p beancount-timestamped-directive-regexp)
+               (looking-at-p beancount-transaction-regexp)))
+      beancount-transaction-indent)
+     ;; Default.
+     (t 0))))
+
+(defun beancount-align-number (target-column)
+  (save-excursion
+    (beginning-of-line)
+    ;; Check if the current line is a posting with a number to align.
+    (when (and (looking-at beancount-posting-regexp)
+               (match-string 2))
+      (let* ((account-end-column (- (match-end 1) (line-beginning-position)))
+             (number-width (- (match-end 3) (match-beginning 3)))
+             (account-end (match-end 1))
+             (number-beginning (match-beginning 3))
+             (spaces (max 2 (- target-column account-end-column number-width))))
+        (unless (eq spaces (- number-beginning account-end))
+          (goto-char account-end)
+          (delete-region account-end number-beginning)
+          (insert (make-string spaces ? )))))))
+
+(defun beancount-indent-line ()
+  (let ((indent (beancount-compute-indentation))
+        (savep (> (current-column) (current-indentation))))
+    (unless (eq indent (current-indentation))
+      (if savep (save-excursion (indent-line-to indent))
+        (indent-line-to indent)))
+    (unless (eq this-command 'beancount-tab-dwim)
+      (beancount-align-number (beancount-number-alignment-column)))))
+
+(defun beancount-indent-region (start end)
+  "Indent a region automagically. START and END specify the region to indent."
+  (let ((deactivate-mark nil)
+        (beancount-number-alignment-column (beancount-number-alignment-column)))
+    (save-excursion
+      (setq end (copy-marker end))
+      (goto-char start)
+      (or (bolp) (forward-line 1))
+      (while (< (point) end)
+        (unless (looking-at-p "\\s-*$")
+          (beancount-indent-line))
+        (forward-line 1))
+      (move-marker end nil))))
+
+(defun beancount-indent-transaction (&optional _justify _region)
+  "Indent Beancount transaction at point."
+  (interactive)
+  (save-excursion
+    (let ((bounds (beancount-find-transaction-extents (point))))
+      (beancount-indent-region (car bounds) (cadr bounds)))))
+
+(defun beancount-transaction-clear (&optional arg)
+  "Clear transaction at point. With a prefix argument set the
+transaction as pending."
+  (interactive "P")
+  (save-excursion
+    (save-match-data
+      (let ((flag (if arg "!" "*")))
+        (beancount-goto-transaction-begin)
+        (if (looking-at beancount-transaction-regexp)
+            (replace-match flag t t nil 2))))))
+
+(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' does not understand functional
+        ;; completion tables thus directly build a list of the
+        ;; accounts in the buffer
+        (let ((beancount-accounts
+               (sort (beancount-collect beancount-account-regexp 0) #'string<)))
+          (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))
+
+(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-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))
+
+(defun beancount--account-currency (account)
+  ;; Build a regexp that matches an open directive that specifies a
+  ;; single account currencydaaee. The currency is match group 1.
+  (let ((re (concat "^" beancount-date-regexp " +open"
+                    "\\s-+" (regexp-quote account)
+                    "\\s-+\\(" beancount-currency-regexp "\\)\\s-+")))
+    (save-excursion
+      (goto-char (point-min))
+      (when (re-search-forward re nil t)
+        ;; The account has declared a single currency, so we can fill it in.
+        (match-string-no-properties 1)))))
+
+(defun beancount--electric-currency ()
+  (when (and beancount-electric-currency (eq last-command-event ?\n))
+    (save-excursion
+      (forward-line -1)
+      (when (and (beancount-inside-transaction-p)
+                 (looking-at (concat "\\s-+\\(" beancount-account-regexp "\\)"
+                                     "\\s-+\\(" beancount-number-regexp "\\)\\s-*$")))
+        ;; Last line is a posting without currency.
+        (let* ((account (match-string 1))
+               (pos (match-end 0))
+               (currency (beancount--account-currency account)))
+          (when currency
+            (save-excursion
+	      (goto-char pos)
+              (insert " " currency))))))))
+
+(defun beancount-insert-date ()
+  "Start a new timestamped directive."
+  (interactive)
+  (unless (bolp) (newline))
+  (insert (format-time-string "%Y-%m-%d") " "))
+
+(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)))
+
+;;; Transaction highligh
+
+(defvar beancount-highlight-overlay (list))
+(make-variable-buffer-local 'beancount-highlight-overlay)
+
+(defun beancount-highlight-overlay-make ()
+  (let ((overlay (make-overlay 1 1)))
+    (overlay-put overlay 'face 'beancount-highlight)
+    (overlay-put overlay 'priority '(nil . 99))
+    overlay))
+
+(defun beancount-highlight-transaction-at-point ()
+  "Move the highlight overlay to the current transaction."
+  (when beancount-highlight-transaction-at-point
+    (unless beancount-highlight-overlay
+      (setq beancount-highlight-overlay (beancount-highlight-overlay-make)))
+    (let* ((bounds (beancount-find-transaction-extents (point)))
+           (begin (car bounds))
+           (end (cadr bounds)))
+      (if (> (- end begin) 0)
+          (move-overlay beancount-highlight-overlay begin end)
+        (move-overlay beancount-highlight-overlay 1 1)))))
+
+;;; Outline minor mode support.
+
+(defun beancount-outline-cycle (&optional arg)
+  "Implement visibility cycling a la `org-mode'.
+
+The behavior of this command is determined by the first matching
+condition among the following:
+
+ 1. When point is at the beginning of the buffer, or when called
+    with a `\\[universal-argument]' universal argument, rotate the entire buffer
+    through 3 states:
+
+   - OVERVIEW: Show only top-level headlines.
+   - CONTENTS: Show all headlines of all levels, but no body text.
+   - SHOW ALL: Show everything.
+
+ 2. When point is at the beginning of a headline, rotate the
+    subtree starting at this line through 3 different states:
+
+   - FOLDED:   Only the main headline is shown.
+   - CHILDREN: The main headline and its direct children are shown.
+               From this state, you can move to one of the children
+               and zoom in further.
+
+   - SUBTREE:  Show the entire subtree, including body text."
+  (interactive "P")
+  (setq deactivate-mark t)
+  (cond
+   ;; Beginning of buffer or called with C-u: Global cycling
+   ((or (equal arg '(4))
+        (and (bobp)
+             ;; org-mode style behaviour - only cycle if not on a heading
+             (not (outline-on-heading-p))))
+    (beancount-cycle-buffer))
+
+   ;; At a heading: rotate between three different views
+   ((save-excursion (beginning-of-line 1) (looking-at outline-regexp))
+    (outline-back-to-heading)
+    (let ((goal-column 0) eoh eol eos)
+      ;; First, some boundaries
+      (save-excursion
+        (save-excursion (beancount-next-line) (setq eol (point)))
+        (outline-end-of-heading)              (setq eoh (point))
+        (outline-end-of-subtree)              (setq eos (point)))
+      ;; Find out what to do next and set `this-command'
+      (cond
+       ((= eos eoh)
+        ;; Nothing is hidden behind this heading
+        (beancount-message "EMPTY ENTRY"))
+       ((>= eol eos)
+        ;; Entire subtree is hidden in one line: open it
+        (outline-show-entry)
+        (outline-show-children)
+        (beancount-message "CHILDREN")
+        (setq
+         this-command 'beancount-cycle-children))
+       ((eq last-command 'beancount-cycle-children)
+        ;; We just showed the children, now show everything.
+        (outline-show-subtree)
+        (beancount-message "SUBTREE"))
+       (t
+        ;; Default action: hide the subtree.
+        (outline-hide-subtree)
+        (beancount-message "FOLDED")))))))
+
+(defvar beancount-current-buffer-visibility-state nil
+  "Current visibility state of buffer.")
+(make-variable-buffer-local 'beancount-current-buffer-visibility-state)
+
+(defvar beancount-current-buffer-visibility-state)
+
+(defun beancount-cycle-buffer (&optional arg)
+  "Rotate the visibility state of the buffer through 3 states:
+  - OVERVIEW: Show only top-level headlines.
+  - CONTENTS: Show all headlines of all levels, but no body text.
+  - SHOW ALL: Show everything.
+
+With a numeric prefix ARG, show all headlines up to that level."
+  (interactive "P")
+  (save-excursion
+    (cond
+     ((integerp arg)
+      (outline-show-all)
+      (outline-hide-sublevels arg))
+     ((eq last-command 'beancount-cycle-overview)
+      ;; We just created the overview - now do table of contents
+      ;; This can be slow in very large buffers, so indicate action
+      ;; Visit all headings and show their offspring
+      (goto-char (point-max))
+      (while (not (bobp))
+        (condition-case nil
+            (progn
+              (outline-previous-visible-heading 1)
+              (outline-show-branches))
+          (error (goto-char (point-min)))))
+      (beancount-message "CONTENTS")
+      (setq this-command 'beancount-cycle-toc
+            beancount-current-buffer-visibility-state 'contents))
+     ((eq last-command 'beancount-cycle-toc)
+      ;; We just showed the table of contents - now show everything
+      (outline-show-all)
+      (beancount-message "SHOW ALL")
+      (setq this-command 'beancount-cycle-showall
+            beancount-current-buffer-visibility-state 'all))
+     (t
+      ;; Default action: go to overview
+      (let ((toplevel
+             (cond
+              (current-prefix-arg
+               (prefix-numeric-value current-prefix-arg))
+              ((save-excursion
+                 (beginning-of-line)
+                 (looking-at outline-regexp))
+               (max 1 (funcall outline-level)))
+              (t 1))))
+        (outline-hide-sublevels toplevel))
+      (beancount-message "OVERVIEW")
+      (setq this-command 'beancount-cycle-overview
+            beancount-current-buffer-visibility-state 'overview)))))
+
+(defun beancount-message (msg)
+  "Display MSG, but avoid logging it in the *Messages* buffer."
+  (let ((message-log-max nil))
+    (message msg)))
+
+(defun beancount-next-line ()
+  "Forward line, but mover over invisible line ends.
+Essentially a much simplified version of `next-line'."
+  (interactive)
+  (beginning-of-line 2)
+  (while (and (not (eobp))
+              (get-char-property (1- (point)) 'invisible))
+    (beginning-of-line 2)))
+
+(provide 'beancount)
+;;; beancount.el ends here