├── .ert-runner ├── .gitignore ├── _assets ├── scaled.gif ├── new_demo.gif ├── sample_reports.gif └── flycheck-hledger.png ├── Cask ├── hledger-suggest.el ├── hledger-webservice.el ├── hledger-input.el ├── README.md ├── hledger-core.el ├── test └── hledger-mode-test.el ├── hledger-mode.el ├── hledger-mail.el ├── hledger-navigate.el ├── hledger-defuns.el ├── LICENSE └── hledger-reports.el /.ert-runner: -------------------------------------------------------------------------------- 1 | -L . 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .cask 2 | -------------------------------------------------------------------------------- /_assets/scaled.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/narendraj9/hledger-mode/HEAD/_assets/scaled.gif -------------------------------------------------------------------------------- /_assets/new_demo.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/narendraj9/hledger-mode/HEAD/_assets/new_demo.gif -------------------------------------------------------------------------------- /_assets/sample_reports.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/narendraj9/hledger-mode/HEAD/_assets/sample_reports.gif -------------------------------------------------------------------------------- /_assets/flycheck-hledger.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/narendraj9/hledger-mode/HEAD/_assets/flycheck-hledger.png -------------------------------------------------------------------------------- /Cask: -------------------------------------------------------------------------------- 1 | (source melpa) 2 | 3 | (package "hledger-mode" "20180821.1433" "a mode for editing hledger files") 4 | 5 | (depends-on "async") 6 | (depends-on "htmlize") 7 | (depends-on "popup") 8 | 9 | (development 10 | (depends-on "ert-runner")) 11 | -------------------------------------------------------------------------------- /hledger-suggest.el: -------------------------------------------------------------------------------- 1 | ;;; hledger-suggest.el --- Providing useful suggestions for new journal entries -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2017 Narendra Joshi 4 | 5 | ;; Author: Narendra Joshi 6 | ;; 7 | ;; Keywords: 8 | 9 | ;; This program is free software; you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | ;;; Commentary: 23 | 24 | ;; This file would contain my attempts to make entries journal entries 25 | ;; as easy as possible for me. That means using the data that I 26 | ;; already have to be as quick as possible in generating future 27 | ;; entries. This would make sure that I don't skip writing entries as 28 | ;; I move through various stages in my life. Whatever, let's see what 29 | ;; this turns into. 30 | ;; 31 | 32 | ;;; Code: 33 | 34 | ; (require 'emlib) ;; not needed yet 35 | 36 | (defvar hledger-suggest-model nil 37 | "Model we will train or read from disk for providing suggestions.") 38 | 39 | (defun hledger-suggest (what) 40 | "Provide suggestion for an entry at the moment. 41 | Argument WHAT is the type of thing we want a suggestion for.") 42 | 43 | 44 | (provide 'hledger-suggest) 45 | ;;; hledger-suggest.el ends here 46 | -------------------------------------------------------------------------------- /hledger-webservice.el: -------------------------------------------------------------------------------- 1 | ;;; hledger-webservice.el --- Helper functions for hledger webservice -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2016 Narendra Joshi 4 | 5 | ;; Author: Narendra Joshi 6 | ;; Keywords: convenience, local 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; This file contains function definitions that would help me fetch 24 | ;; entries stored in the hledger webapp hosted at 25 | ;; https://services.vicarie.in 26 | 27 | ;;; Code: 28 | 29 | (require 'hledger-core) 30 | (require 'hledger-reports) 31 | (require 'json) 32 | 33 | (defcustom hledger-service-fetch-url 34 | "https://services.vicarie.in/api/entry" 35 | "Service url for fetching journal entries." 36 | :type 'string 37 | :group 'hledger) 38 | 39 | (defun hledger-format-comment-string (comment) 40 | "Format the input COMMENT string for insertion into a journal file." 41 | (with-temp-buffer (progn 42 | (if (string-match-p hledger-empty-regex comment) 43 | "" 44 | (electric-indent-mode -1) 45 | (setq-local fill-column (- 70 hledger-comments-column)) 46 | (insert comment) 47 | (insert "\n") 48 | (goto-char (point-min)) 49 | (fill-paragraph) 50 | (setq-local comment-start "; ") 51 | (setq-local comment-end "") 52 | (comment-region (point-min) (point-max)) 53 | (indent-region (point-min) (point-max) hledger-comments-column) 54 | (buffer-string))))) 55 | 56 | 57 | (defun hledger-fetch-entries-insert (entries) 58 | "Insert ENTRIES into a journal buffer." 59 | (let ((result "")) 60 | (dolist (entry (reverse entries)) 61 | (let ((description (cdr (assoc 'description entry))) 62 | (comment (hledger-format-comment-string 63 | (cdr (assoc 'comment entry)))) 64 | (postings (cdr (assoc 'postings entry))) 65 | (date (cdr (assoc 'date entry)))) 66 | (setf result 67 | (concat result 68 | (format "%s %s\n%s" 69 | date 70 | description 71 | comment))) 72 | (dolist (posting (append postings nil)) 73 | (let ((account (cdr (assoc 'account posting))) 74 | (amount (cdr (assoc 'amount posting)))) 75 | (setf result 76 | (concat result 77 | (format " %s %s %s\n" 78 | account 79 | (if (string-match "[0-9]+" amount) 80 | hledger-currency-string 81 | "" ) 82 | amount)))))) 83 | (setf result (concat result "\n"))) 84 | (kill-buffer (current-buffer)) 85 | 86 | (let ((jbuffer (hledger-get-perfin-buffer nil t))) 87 | (with-current-buffer jbuffer 88 | (insert result)) 89 | (pop-to-buffer jbuffer) 90 | (goto-char (point-min))))) 91 | 92 | (defun hledger-fetch-entries () 93 | "Fetch journal entries from `hledger-service-url`. 94 | Show the results in the `hledger-reporting-buffer-name' buffer. 95 | **This is a workaround**." 96 | (interactive) 97 | (browse-url hledger-service-fetch-url) 98 | (read-from-minibuffer "Opening browser. Hit [Enter] after copy. ") 99 | (with-temp-buffer 100 | (yank) 101 | (goto-char (point-min)) 102 | ;; Convert vector returned by json-read to a list 103 | (let ((entries-list (append (json-read) nil))) 104 | (kill-buffer) 105 | (hledger-fetch-entries-insert entries-list))) 106 | (message "Entries copied")) 107 | 108 | (provide 'hledger-webservice) 109 | ;;; hledger-webservice.el ends here 110 | -------------------------------------------------------------------------------- /hledger-input.el: -------------------------------------------------------------------------------- 1 | ;;; hledger-input.el --- Facilities for entering journal entries conveniently -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2017 Narendra Joshi 4 | 5 | ;; Author: Narendra Joshi 6 | ;; Keywords: data 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; This file contains functions that let you enter a journal entry 24 | ;; quickly without opening the journal file. It also let's you 25 | ;; quickly view reports after submitting a new entry. The idea is to 26 | ;; be able to create common workflows that people follow everyday. 27 | 28 | ;;; Code: 29 | (require 'hledger-core) 30 | (require 'hledger-mode) 31 | (require 'hledger-reports) 32 | 33 | (defcustom hledger-input-buffer-height 10 34 | "Number of lines to show in the hledger input buffer." 35 | :group 'hledger 36 | :type 'numebr) 37 | 38 | (defvar hledger-input-pre-commit-hook nil 39 | "Hook run in the input buffer before a commit to `hledger-jfile'.") 40 | 41 | (defvar hledger-input-post-commit-hook nil 42 | "Hook run after commit to `hledger-file' before closing the input buffer. 43 | A useful function for this would be `hledger-show-new-balances'.") 44 | 45 | (defvar hledger-input-mode-map 46 | (let ((map (copy-keymap hledger-mode-map))) 47 | (define-key map (kbd "C-c C-c") 'hledger-commit-input) 48 | (define-key map (kbd "C-c C-k") 'hledger-discard-input) 49 | (define-key map (kbd "C-c e") 'hledger-discard-input-jentry) 50 | map) 51 | "Keymap for hledger input buffers.") 52 | 53 | (defun hledger-create-input-buffer () 54 | "Create and return a buffer in `hledger-mode' for a journal entry. 55 | This setups up the minor mode and narrowing in the input buffer." 56 | (let* ((input-buffer (get-buffer-create "*Journal Entry*"))) 57 | (with-current-buffer input-buffer 58 | ;; No auto saving in this buffer as we want to commit when we 59 | ;; like. 60 | (auto-save-mode -1) 61 | (hledger-input-mode +1) 62 | input-buffer))) 63 | 64 | (defun hledger-get-accounts-in-buffer () 65 | "Return a sequence of accounts currently in buffer." 66 | (let ((result '())) 67 | (save-excursion 68 | (goto-char (point-min)) 69 | (while (search-forward-regexp hledger-account-regex 70 | nil 71 | t) 72 | (push (substring-no-properties (thing-at-point 'hledger-account)) 73 | result))) 74 | result)) 75 | 76 | (defun hledger-show-new-balances () 77 | "Show balances new balances for the accounts in buffer." 78 | (let* ((inhibit-read-only t) 79 | (message-log-max nil) 80 | (accounts (hledger-get-accounts-in-buffer)) 81 | (report-str* (hledger-get-balances accounts)) 82 | (report-str (format "%s\n\n%s\n%s" 83 | (make-string 20 ?―) 84 | report-str* 85 | (make-string 20 ?―)))) 86 | (display-message-or-buffer report-str) 87 | nil)) 88 | 89 | (defun hledger-input-valid-p (input-entry) 90 | "Check the validity of balances in INPUT-ENTRY." 91 | (let* ((temp-file-path (make-temp-file "hledger-input")) 92 | (hledger-jfile temp-file-path)) 93 | (with-temp-file temp-file-path 94 | (insert input-entry) 95 | (insert "\n")) 96 | 97 | (let ((result (hledger-status "balance"))) 98 | (delete-file temp-file-path) 99 | (if (not (consp result)) 100 | t 101 | (message "Error: \n%s\n%s\n%s" 102 | (make-string fill-column ?-) 103 | (cdr result) 104 | (make-string fill-column ?-)) 105 | nil)))) 106 | 107 | (defun hledger-commit-input () 108 | "Commit INPUT-BUFFER contents to `hledger-jfile'. 109 | We are already in the input-buffer." 110 | (interactive) 111 | (run-hooks 'hledger-input-pre-commit-hook) 112 | (let ((new-input (buffer-substring (point-min) 113 | (point-max)))) 114 | (when (hledger-input-valid-p new-input) 115 | (with-current-buffer (find-file-noselect hledger-jfile) 116 | (hledger-go-to-starting-line) 117 | (insert new-input) 118 | (save-buffer) 119 | (kill-buffer)) 120 | (message "Saved input to journal file") 121 | (run-hooks 'hledger-input-post-commit-hook) 122 | (kill-buffer) 123 | ;; Delete the window if it's not the sole window. 124 | (ignore-errors (delete-window))))) 125 | 126 | (defun hledger-discard-input () 127 | "Discard entry in input-buffer and go back to previous window configuration." 128 | (interactive) 129 | (kill-buffer) 130 | (delete-window)) 131 | 132 | (defun hledger-discard-input-jentry () 133 | "Discard the current input buffer and do jentry." 134 | (interactive) 135 | (hledger-discard-input) 136 | (hledger-jentry)) 137 | 138 | (defun hledger-capture () 139 | "Capture a journal entry quickly." 140 | (interactive) 141 | (select-window (split-window-below (- hledger-input-buffer-height)) ) 142 | (switch-to-buffer (hledger-create-input-buffer)) 143 | (hledger-input-mode)) 144 | 145 | (defun hledger-dispatch-command () 146 | "Dispatch to a specific hledger REPORT." 147 | (interactive) 148 | (kill-buffer)) 149 | 150 | (define-minor-mode hledger-input-mode 151 | "A mode for quickly entering journal entries." 152 | :group 'hledger 153 | (hledger-mode) 154 | (use-local-map hledger-input-mode-map)) 155 | 156 | (provide 'hledger-input) 157 | ;;; hledger-input.el ends here 158 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # hledger-mode 2 | 3 | [![MELPA](https://melpa.org/packages/hledger-mode-badge.svg)](https://melpa.org/#/hledger-mode) 4 | 5 | An Emacs major mode for writing [hledger](https://hledger.org/) journals and 6 | generating useful accounting reports. 7 | 8 | ![Sample Reports](_assets/new_demo.gif?raw=true "Reports") 9 | 10 | ## Installation 11 | 12 | The external `hledger` program should be installed first, or most of the report 13 | features won't work. 14 | 15 | This package is available on [MELPA](http://melpa.org/): 16 | 17 | M-x package-install hledger-mode 18 | 19 | If you are not installing from Melpa, to make `hledger-mode` available 20 | to your Emacs add it to `load-path`. 21 | 22 | (add-to-list 'load-path "/path/to/hledger-mode/dir/") 23 | 24 | ## Setup 25 | 26 | ```elisp 27 | ;;; Basic configuration 28 | (require 'hledger-mode) 29 | 30 | ;; To open files with .journal extension in hledger-mode 31 | (add-to-list 'auto-mode-alist '("\\.journal\\'" . hledger-mode)) 32 | 33 | ;; Provide the path to you journal file. 34 | ;; The default location is too opinionated. 35 | (setq hledger-jfile "/path/to/your/journal-file.journal") 36 | 37 | ;;; Auto-completion for account names 38 | ;; For company-mode users, 39 | (add-to-list 'company-backends 'hledger-company) 40 | 41 | ;; For auto-complete users, 42 | (add-to-list 'ac-modes 'hledger-mode) 43 | (add-hook 'hledger-mode-hook 44 | (lambda () 45 | (setq-local ac-sources '(hledger-ac-source)))) 46 | 47 | ;; For easily adjusting dates. 48 | (define-key hledger-mode-map (kbd "") 'hledger-increment-entry-date) 49 | (define-key hledger-mode-map (kbd "") 'hledger-decrement-entry-date) 50 | ``` 51 | 52 | ## Configuration 53 | 54 | For configuring various parameters, e.g. the accounts used for 55 | computing ratios in the overall report, `M-x customize-group` and 56 | customize the `hledger` group. For example, the Emergency Fund Ratio 57 | is computed with expenses incurred in accounts listed in the variable 58 | `hledger-ratios-essential-expense-accounts`. 59 | 60 | ## Usage 61 | 62 | I recommend the following key bindings: 63 | 64 | ```elisp 65 | 66 | ;; Personal Accounting 67 | (global-set-key (kbd "C-c e") 'hledger-jentry) 68 | (global-set-key (kbd "C-c j") 'hledger-run-command) 69 | 70 | ``` 71 | 72 | Once you are in a report buffer after executing a command with 73 | `hledger-run-command`, press `h` to see the list of reports that you 74 | can have a look at. Press `s` in the overall report to see the meaning 75 | of the personal finance ratios for your report. 76 | 77 | To enable email reporting, you would need to setup your email api 78 | credentials. You can set those up with `M-x customize-group hledger`. 79 | 80 | Once you have done so, you can enable monthly email reporting on 81 | `hledger-reporting-day` with the following in your `init.el`: 82 | 83 | ```elisp 84 | 85 | (hledger-enable-reporting) 86 | 87 | ``` 88 | 89 | Here is my configuration with `use-package' declarations: 90 | 91 | ``` elisp 92 | (use-package hledger-mode 93 | :pin manual 94 | :after htmlize 95 | :load-path "packages/rest/hledger-mode/" 96 | :mode ("\\.journal\\'" "\\.hledger\\'") 97 | :commands hledger-enable-reporting 98 | :preface 99 | (defun hledger/next-entry () 100 | "Move to next entry and pulse." 101 | (interactive) 102 | (hledger-next-or-new-entry) 103 | (hledger-pulse-momentary-current-entry)) 104 | 105 | (defface hledger-warning-face 106 | '((((background dark)) 107 | :background "Red" :foreground "White") 108 | (((background light)) 109 | :background "Red" :foreground "White") 110 | (t :inverse-video t)) 111 | "Face for warning" 112 | :group 'hledger) 113 | 114 | (defun hledger/prev-entry () 115 | "Move to last entry and pulse." 116 | (interactive) 117 | (hledger-backward-entry) 118 | (hledger-pulse-momentary-current-entry)) 119 | 120 | :bind (("C-c j" . hledger-run-command) 121 | :map hledger-mode-map 122 | ("C-c e" . hledger-jentry) 123 | ("M-p" . hledger/prev-entry) 124 | ("M-n" . hledger/next-entry)) 125 | :init 126 | (setq hledger-jfile 127 | (expand-file-name "~/miscellany/personal/finance/accounting.journal") 128 | hledger-email-secrets-file (expand-file-name "secrets.el" 129 | emacs-assets-directory)) 130 | ;; Expanded account balances in the overall monthly report are 131 | ;; mostly noise for me and do not convey any meaningful information. 132 | (setq hledger-show-expanded-report nil) 133 | 134 | (when (boundp 'my-hledger-service-fetch-url) 135 | (setq hledger-service-fetch-url 136 | my-hledger-service-fetch-url)) 137 | 138 | :config 139 | (add-hook 'hledger-view-mode-hook #'hl-line-mode) 140 | (add-hook 'hledger-view-mode-hook #'center-text-for-reading) 141 | 142 | (add-hook 'hledger-view-mode-hook 143 | (lambda () 144 | (run-with-timer 1 145 | nil 146 | (lambda () 147 | (when (equal hledger-last-run-command 148 | "balancesheet") 149 | ;; highlight frequently changing accounts 150 | (highlight-regexp "^.*\\(savings\\|cash\\).*$") 151 | (highlight-regexp "^.*credit-card.*$" 152 | 'hledger-warning-face)))))) 153 | 154 | (add-hook 'hledger-mode-hook 155 | (lambda () 156 | (make-local-variable 'company-backends) 157 | (add-to-list 'company-backends 'hledger-company)))) 158 | 159 | (use-package hledger-input 160 | :pin manual 161 | :load-path "packages/rest/hledger-mode/" 162 | :bind (("C-c e" . hledger-capture) 163 | :map hledger-input-mode-map 164 | ("C-c C-b" . popup-balance-at-point)) 165 | :preface 166 | (defun popup-balance-at-point () 167 | "Show balance for account at point in a popup." 168 | (interactive) 169 | (if-let ((account (thing-at-point 'hledger-account))) 170 | (message (hledger-shell-command-to-string (format " balance -N %s " 171 | account))) 172 | (message "No account at point"))) 173 | 174 | :config 175 | (setq hledger-input-buffer-height 20) 176 | (add-hook 'hledger-input-post-commit-hook #'hledger-show-new-balances) 177 | (add-hook 'hledger-input-mode-hook #'auto-fill-mode) 178 | (add-hook 'hledger-input-mode-hook 179 | (lambda () 180 | (make-local-variable 'company-idle-delay) 181 | (setq-local company-idle-delay 0.1)))) 182 | ``` 183 | 184 | ## Auxiliary tools 185 | 186 | You are welcome to use the web application hosted 187 | at [vicarie.in](https://services.vicarie.in) for logging data while 188 | you are away from computer. You can use the command 189 | `hledger-fetch-entries` later on to get those entries into your 190 | journal file. 191 | 192 | If you want real-time checking of your journal, you might want to 193 | install 194 | [flycheck-hledger](https://github.com/DamienCassou/flycheck-hledger/): 195 | 196 | ![flycheck-hledger](_assets/flycheck-hledger.png?raw=true "flycheck-hledger") 197 | 198 | ## Testing 199 | 200 | `hledger-mode` contains automated tests. You may run them by executing 201 | `cask exec ert-runner`. 202 | 203 | You may need to install `cask` locally if you do not already have it 204 | installed, and run `cask install` to install any dependencies that you 205 | may be missing. 206 | 207 | ## Contributing 208 | 209 | This project is new and improving. Please feel free to contribute to 210 | it. You might start with writing a document on contributing to the 211 | project or by refactoring it a bit [See `hledger-reports.el`. It's a 212 | mess.]. 213 | 214 | Cheers! 215 | -------------------------------------------------------------------------------- /hledger-core.el: -------------------------------------------------------------------------------- 1 | ;;; hledger-core.el --- Core major mode facilities -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2016 Narendra Joshi 4 | 5 | ;; Author: Narendra Joshi 6 | ;; Keywords: convenience, local 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; 24 | 25 | ;;; Code: 26 | 27 | (defcustom hledger-jfile "~/.hledger.journal" 28 | "Location of the journal file." 29 | :group 'hledger 30 | :type 'file) 31 | 32 | (defcustom hledger-reporting-buffer-name "*Personal Finance*" 33 | "Name of the buffer for showing or working with reports." 34 | :group 'hledger 35 | :type 'string) 36 | 37 | (defcustom hledger-comments-column 11 38 | "Column number where the comments start." 39 | :group 'hledger 40 | :type 'integer) 41 | 42 | (defcustom hledger-currency-string "₹" 43 | "String to be used for currency. Assumes it is prefixed." 44 | :group 'hledger 45 | :type 'string) 46 | 47 | ;;; Regexes 48 | (defvar hledger-empty-regex "^\\s-*$" 49 | "Regular expression for an empty line.") 50 | (defvar hledger-date-only-regex "^\\s-*[0-9]\\{4\\}[-/][0-9]\\{2\\}[-/][0-9]\\{2\\}\\s-*$" 51 | "Regular expression a line with date only.") 52 | (defvar hledger-date-regex "[0-9]\\{4\\}[-/][0-9]\\{2\\}[-/][0-9]\\{2\\}" 53 | "Regular expression for dates for font lock.") 54 | (defvar hledger-date-and-desc-regex (format "\\<%s\\s-*[\\*!]?\\s-*[^[:space:]]+\\>" hledger-date-regex) 55 | "Regular expression for matching a starting entry with some description.") 56 | 57 | (defvar hledger-account-regex 58 | "\\(\\([^[:space:];\n]+\\(?: [^[:space:];=\n]+\\)*\\)\\)" 59 | "Regular expression for a potential journal account.") 60 | 61 | (defvar hledger-account-leading-regex 62 | "/\\|\\(= \\)\\|\\(?: \\)" 63 | "Regular expression for places where an account name can begin.") 64 | 65 | (defvar hledger-whitespace-account-regex (format "\\s-*%s" hledger-account-regex) 66 | "Regular expression for an account with leading whitespace.") 67 | (defvar hledger-comment-regex "^[ \t]*;" 68 | "Regular expression for a comment in journal file.") 69 | (defvar hledger-empty-comment-regex "^\\s-*;\\s-*$" 70 | "Regular expression to match a comment with no text.") 71 | (defvar hledger-amount-value-regex "[-]?[0-9]+\\(\\.[0-9]+\\)?" 72 | "Regular expression to match a floating point number.") 73 | 74 | (defun hledger-amount-regex () 75 | "Regular expression to match an inserted amount in rupees." 76 | (format "\\<%s\\s-*[-]?[0-9,]+\\(\\.[0-9]+\\)?\\>" (regexp-quote hledger-currency-string))) 77 | 78 | (defun hledger-whitespace-amount-regex () 79 | "Regular expression for whitespace followed by amount." 80 | (format "\\s-*%s" (format "\\<%s\\s-*[-]?[0-9]+\\(\\.[0-9]+\\)?\\>" 81 | (regexp-quote hledger-currency-string)))) 82 | 83 | ;;; Indentation 84 | (defun hledger-line-matchesp (re offset) 85 | "Check if regex RE will match the beginning for line current-line - OFFSET." 86 | (save-excursion 87 | (forward-line offset) 88 | (beginning-of-line) 89 | (looking-at re))) 90 | 91 | ;; Internal functions for looking-at lines' beginnings 92 | (defun hledger-cur-line-matchesp (re) 93 | "Return true if current line has regex RE in the beginning." 94 | (hledger-line-matchesp re 0)) 95 | (defun hledger-prev-line-matchesp (re) 96 | "Return true if previous line has regex RE in the beginning." 97 | (hledger-line-matchesp re -1)) 98 | 99 | ;; Auxiliary funtions[s] 100 | (defun hledger-delete-cur-line () 101 | "Delete the current line." 102 | (delete-region (line-beginning-position) (line-end-position))) 103 | (defun hledger-insert-date () 104 | "Insert date at point." 105 | (insert (format-time-string "%Y-%m-%d "))) 106 | (defun hledger-insert-comment () 107 | "Insert a comment on the current line." 108 | (indent-line-to hledger-comments-column) 109 | (insert "; ")) 110 | (defun hledger-insert-rupee () 111 | "Insert the amount for a transaction in hledger." 112 | (beginning-of-line) 113 | (re-search-forward hledger-whitespace-account-regex) 114 | (insert (concat " " hledger-currency-string " "))) 115 | (defun hledger-delete-rupee-sign () 116 | "Delete the rupee sign." 117 | (beginning-of-line) 118 | (re-search-forward hledger-whitespace-account-regex 119 | (line-end-position) 120 | t) 121 | (delete-region (point) (line-end-position))) 122 | 123 | (defun hledger-acc-line-has-rupeep () 124 | "Return true if the account line has an amount." 125 | (hledger-cur-line-matchesp (concat hledger-whitespace-account-regex 126 | (format "\\s-*%s\\s-*$" 127 | (regexp-quote hledger-currency-string))))) 128 | (defun hledger-expecting-rupeep () 129 | "Return true if we should insert a rupee sign." 130 | (hledger-cur-line-matchesp (concat hledger-whitespace-account-regex 131 | "\\s-*$"))) 132 | 133 | (defun hledger-cur-line-emptyp () 134 | "Return true if the current line is empty." 135 | (hledger-cur-line-matchesp hledger-empty-regex)) 136 | (defun hledger-cur-has-datep () 137 | "Return true if the current line only has a date." 138 | (hledger-cur-line-matchesp hledger-date-only-regex)) 139 | (defun hledger-cur-has-date-and-descp () 140 | "Return true if the current line has a date and description." 141 | (hledger-cur-line-matchesp hledger-date-and-desc-regex)) 142 | (defun hledger-cur-has-empty-commentp () 143 | "Return true if the current line has an empty comment." 144 | (hledger-cur-line-matchesp hledger-empty-comment-regex)) 145 | (defun hledger-cur-has-accp () 146 | "Return true if the current line has an account name." 147 | (hledger-cur-line-matchesp hledger-whitespace-account-regex)) 148 | (defun hledger-cur-starts-with-semicolp () 149 | "Return true if the current line begins with a semicolon." 150 | (hledger-cur-line-matchesp hledger-comment-regex)) 151 | 152 | (defun hledger-prev-line-emptyp () 153 | "Return true if the previous line is empty." 154 | (hledger-prev-line-matchesp hledger-empty-regex)) 155 | (defun hledger-prev-has-datep () 156 | "Return true if the previous line has a date and description." 157 | (hledger-prev-line-matchesp hledger-date-and-desc-regex)) 158 | (defun hledger-prev-has-commentp () 159 | "Return true if the previous line has a comment, even if the comment is empty." 160 | (hledger-prev-line-matchesp hledger-comment-regex)) 161 | (defun hledger-prev-has-accp () 162 | "Return true if the previous line has an account name." 163 | (hledger-prev-line-matchesp hledger-whitespace-account-regex)) 164 | 165 | (defun hledger-indent-empty-line () 166 | "Called when the line to be indented is empty." 167 | (cond 168 | ((hledger-prev-line-emptyp) (hledger-insert-date)) 169 | ((hledger-prev-has-datep) (if (= (current-indentation) tab-width) 170 | (hledger-insert-comment) 171 | (hledger-delete-cur-line) 172 | (indent-line-to tab-width))) 173 | ((hledger-prev-has-commentp) (hledger-insert-comment)) 174 | ((hledger-prev-has-accp) 175 | (indent-line-to tab-width)))) 176 | 177 | (defun hledger-indent-date-line () 178 | "Called when the current line only has a date." 179 | (hledger-delete-cur-line)) 180 | 181 | (defun hledger-indent-comment-line () 182 | "Called when the current line has an empty comment already." 183 | (if (not (hledger-cur-has-empty-commentp)) 184 | (indent-line-to hledger-comments-column) 185 | (hledger-delete-cur-line) 186 | (indent-line-to tab-width))) 187 | 188 | (defun hledger-indent-account-line () 189 | "Called when the line to indent is an account listing line." 190 | (cond 191 | ((hledger-acc-line-has-rupeep) (hledger-delete-rupee-sign)) 192 | ((hledger-expecting-rupeep) (hledger-insert-rupee)) 193 | (t (indent-line-to tab-width)))) 194 | 195 | (defun hledger-indent-line () 196 | "Indent the current line." 197 | (cond 198 | ((hledger-cur-line-emptyp) (hledger-indent-empty-line)) 199 | ((hledger-cur-has-datep) (hledger-indent-date-line)) 200 | ((hledger-cur-starts-with-semicolp) (hledger-indent-comment-line)) 201 | ((hledger-cur-has-accp) (hledger-indent-account-line)))) 202 | 203 | (defun hledger-indent-region-function (start end) 204 | "Indent region (START END) according to `hledger-mode'. 205 | We need a separate function because we do different stuff while 206 | interactively editing an entry." 207 | (save-excursion 208 | (goto-char start) 209 | (while (< (point) end) 210 | (beginning-of-line) 211 | (cond 212 | ((hledger-cur-has-datep) (indent-line-to 0)) 213 | ((hledger-cur-starts-with-semicolp) (indent-line-to hledger-comments-column)) 214 | ((hledger-cur-has-accp) (indent-line-to tab-width))) 215 | (forward-line 1)))) 216 | 217 | 218 | (provide 'hledger-core) 219 | ;;; hledger-core.el ends here 220 | -------------------------------------------------------------------------------- /test/hledger-mode-test.el: -------------------------------------------------------------------------------- 1 | (require 'hledger-core) 2 | 3 | (defun act-name-first-match (nme) 4 | (string-match hledger-account-regex nme) 5 | (match-string 0 nme)) 6 | 7 | (defun first-amount-match (nme) 8 | (string-match (hledger-amount-regex) nme) 9 | (match-string 0 nme)) 10 | 11 | (ert-deftest ert-test-correct-account-no-spaces () 12 | "Account name regex matches account name with no spaces" 13 | (should (equal (act-name-first-match "Revenues:Income") "Revenues:Income"))) 14 | 15 | (ert-deftest ert-test-account-name-with-space () 16 | "Account name regex matches account name with a space" 17 | (should (equal (act-name-first-match "Revenues:Consulting Income") "Revenues:Consulting Income"))) 18 | 19 | (ert-deftest ert-test-malformed-account-is-matched-fully () 20 | "Account name regex match does include amount when not correctly separated" 21 | (should (equal (act-name-first-match "Revenues:Consulting Income $42.00") "Revenues:Consulting Income $42.00"))) 22 | 23 | (ert-deftest ert-test-account-name-matches-with-digit () 24 | "Account name regex matches account name containing digit" 25 | (should (equal (act-name-first-match "Revenues:Consulting Income 9") "Revenues:Consulting Income 9"))) 26 | 27 | (ert-deftest ert-test-account-name-nested () 28 | "Account name may be nested more than one level" 29 | (should (equal (act-name-first-match "Revenues:Consulting Income:Haskell") "Revenues:Consulting Income:Haskell"))) 30 | 31 | (ert-deftest ert-test-account-name-with-non-ascii-and-punctuation () 32 | "Account name regex matches account name with non-ASCII characters and punctuation" 33 | (should (equal (act-name-first-match "Revenues:Consulting Income:Kö Pte. Ltd.") "Revenues:Consulting Income:Kö Pte. Ltd."))) 34 | 35 | (ert-deftest ert-test-account-name-doesnt-match-forbidden-characters () 36 | "Account name regex match stops at forbidden characters" 37 | (let ((m (string-match hledger-account-regex "Revenues:Consulting Income:Company;Co"))) 38 | (should (= (match-beginning 0) 0)) 39 | (should (= (match-end 0) 34)))) 40 | 41 | 42 | (setq hledger-currency-string "$") 43 | 44 | (ert-deftest ert-test-amount-with-different-currency-string () 45 | "Test matching an amount after changing the currency string to dollars" 46 | (should (equal (first-amount-match "$400.00") "$400.00"))) 47 | 48 | (ert-deftest ert-test-amount-with-comma () 49 | "Test amount matching containing a comma" 50 | (should (equal (first-amount-match "$4,000.00") "$4,000.00"))) 51 | 52 | (ert-deftest ert-hledger-account-bounds-is-correct () 53 | (with-temp-buffer 54 | (insert "alias save those spaces = expenses:payee with spaces 55 | 56 | 2023-06-26 Payee | Description ; comment 57 | assets:bank:savings account -INR 100 58 | expenses:payee with spaces INR 100 59 | 60 | 2023-06-27 Description 61 | assets:bank:savings account -$50 62 | expenses:personal $50") 63 | (goto-char 0) 64 | ;; in the middle of an account with spaces 65 | (save-excursion 66 | (search-forward "savings account") 67 | (let* ((bounds (hledger-bounds-of-account-at-point)) 68 | (text (buffer-substring (car bounds) (cdr bounds)))) 69 | (should (string= text "assets:bank:savings account")))) 70 | ;; in an amount 71 | (save-excursion 72 | (search-forward "-INR") 73 | (let ((bounds (hledger-bounds-of-account-at-point))) 74 | (should (null bounds)))) 75 | ;; in a different amount 76 | (save-excursion 77 | (search-forward "$") 78 | (let ((bounds (hledger-bounds-of-account-at-point))) 79 | (should (null bounds)))) 80 | (save-excursion 81 | (search-forward "-$5") 82 | (let ((bounds (hledger-bounds-of-account-at-point))) 83 | (should (null bounds)))) 84 | (save-excursion 85 | (search-forward " $5") 86 | (let ((bounds (hledger-bounds-of-account-at-point))) 87 | (should (null bounds)))) 88 | ;; in the description line 89 | (save-excursion 90 | (search-forward "Payee") 91 | (let ((bounds (hledger-bounds-of-account-at-point))) 92 | (should (null bounds)))) 93 | ;; in an alias value 94 | (save-excursion 95 | (search-forward "with spaces") 96 | (let* ((bounds (hledger-bounds-of-account-at-point)) 97 | (text (buffer-substring (car bounds) (cdr bounds)))) 98 | (should (string= text "expenses:payee with spaces")))))) 99 | 100 | (ert-deftest hledger-date-manipulation-works () 101 | (with-temp-buffer 102 | (insert "2023-07-08") 103 | (backward-char) 104 | (hledger-add-days-to-entry-date 1) 105 | (should (string= (buffer-substring-no-properties (point-min) (point-max)) "2023-07-09")) 106 | (hledger-add-days-to-entry-date -2) 107 | (should (string= (buffer-substring-no-properties (point-min) (point-max)) "2023-07-07")) 108 | (hledger-increment-entry-date) 109 | (hledger-increment-entry-date) 110 | (hledger-increment-entry-date) 111 | (should (string= (buffer-substring-no-properties (point-min) (point-max)) "2023-07-10")) 112 | (hledger-decrement-entry-date) 113 | (hledger-decrement-entry-date) 114 | (should (string= (buffer-substring-no-properties (point-min) (point-max)) "2023-07-08")))) 115 | 116 | (defconst hledger-accounts-should-update-1 117 | "account account1 118 | account account2 119 | 120 | 2023-07-10 Transaction 121 | account1 $5 122 | account3") 123 | 124 | (defconst hledger-accounts-should-update-2 125 | " 126 | alias account4 = account3 127 | 128 | 2023-07-11 Transaction 2 129 | account4 $10 130 | account5 -$10") 131 | 132 | (ert-deftest hledger-accounts-should-not-update () 133 | "With `hledger-invalidate-completions' set to `on-idle', saving or 134 | editing the buffer should not update the accounts cache." 135 | (let* ((file-name (make-temp-file "emacs-hledger-test-" nil nil hledger-accounts-should-update-1)) 136 | (buf (find-file-noselect file-name t)) 137 | (hledger-jfile file-name) 138 | (hledger-invalidate-completions '(on-idle))) 139 | (unwind-protect 140 | (with-current-buffer buf 141 | (hledger-mode) 142 | (should (equal hledger-accounts-cache '("account1" "account2" "account3"))) 143 | (goto-char (point-max)) 144 | (insert hledger-accounts-should-update-2) 145 | ;; A bit of a hack to force an update. 146 | (let ((this-command 'self-insert-command)) 147 | (run-hooks 'post-command-hook)) 148 | (hledger-completion-at-point) 149 | (should (equal hledger-accounts-cache '("account1" "account2" "account3"))) 150 | (save-buffer) 151 | (hledger-completion-at-point) 152 | (should (equal hledger-accounts-cache '("account1" "account2" "account3")))) 153 | (with-current-buffer buf 154 | (set-buffer-modified-p nil) 155 | (kill-buffer buf) 156 | (ignore-errors (delete-file file-name)))))) 157 | 158 | (ert-deftest hledger-accounts-should-update-on-save () 159 | "With `hledger-invalidate-completions' set to `(on-idle 160 | on-save)',editing should not update the accounts cache." 161 | (let* ((file-name (make-temp-file "emacs-hledger-test-" nil nil hledger-accounts-should-update-1)) 162 | (buf (find-file-noselect file-name t)) 163 | (hledger-jfile file-name) 164 | (hledger-invalidate-completions '(on-idle on-save))) 165 | (unwind-protect 166 | (with-current-buffer buf 167 | (hledger-mode) 168 | (should (equal hledger-accounts-cache '("account1" "account2" "account3"))) 169 | (goto-char (point-max)) 170 | (insert hledger-accounts-should-update-2) 171 | ;; A bit of a hack to force an update. 172 | (let ((this-command 'self-insert-command)) 173 | (run-hooks 'post-command-hook)) 174 | (hledger-completion-at-point) 175 | (should (equal hledger-accounts-cache '("account1" "account2" "account3"))) 176 | (save-buffer) 177 | (hledger-completion-at-point) 178 | (should (equal hledger-accounts-cache '("account1" "account2" "account3" "account5")))) 179 | (with-current-buffer buf 180 | (set-buffer-modified-p nil) 181 | (kill-buffer buf) 182 | (ignore-errors (delete-file file-name)))))) 183 | 184 | (ert-deftest hledger-accounts-should-update-on-edit () 185 | "With `hledger-invalidate-completions' set to `(on-idle 186 | on-edit)',saving should not update the accounts cache." 187 | (let* ((file-name (make-temp-file "emacs-hledger-test-" nil nil hledger-accounts-should-update-1)) 188 | (buf (find-file-noselect file-name t)) 189 | (hledger-jfile file-name) 190 | (hledger-invalidate-completions '(on-idle on-edit))) 191 | (unwind-protect 192 | (with-current-buffer buf 193 | (hledger-mode) 194 | (should (equal hledger-accounts-cache '("account1" "account2" "account3"))) 195 | (goto-char (point-max)) 196 | (insert hledger-accounts-should-update-2) 197 | ;; A bit of a hack to force an update. 198 | (let ((this-command 'self-insert-command)) 199 | (run-hooks 'post-command-hook)) 200 | (should (equal hledger-accounts-cache '("account1" "account2" "account3"))) 201 | (hledger-completion-at-point) 202 | (should (equal hledger-accounts-cache '("account1" "account2" "account3" "account5"))) 203 | (save-buffer) 204 | (hledger-completion-at-point) 205 | (should (equal hledger-accounts-cache '("account1" "account2" "account3" "account5")))) 206 | (with-current-buffer buf 207 | (set-buffer-modified-p nil) 208 | (kill-buffer buf) 209 | (ignore-errors (delete-file file-name)))))) 210 | -------------------------------------------------------------------------------- /hledger-mode.el: -------------------------------------------------------------------------------- 1 | ;;; hledger-mode.el --- A mode for writing journal entries for hledger. 2 | 3 | ;; Copyright (C) 2015-2016 Narendra Joshi 4 | ;; Author: Narendra Joshi 5 | ;; URL: https://github.com/narendraj9/hledger-mode.git 6 | ;; Version: 0.1 7 | ;; Keywords: data 8 | ;; Package-Requires: ((emacs "24.4") (popup "0.5.3") (async "1.9") (htmlize "1.47")) 9 | 10 | ;;; Commentary: 11 | ;; 12 | ;; A major mode for writing hledger journal files. It generates some 13 | ;; useful reports along with some financial ratios that can help you 14 | ;; keep a check on your financial health. This is an attempt to 15 | ;; organize personal finances for Emacs users. If you don't like this, 16 | ;; try `ledger-mode'. 17 | ;; 18 | ;; Note: You must have hledger installed to be able to create the 19 | ;; reports: overall report, daily report, balancesheet, income 20 | ;; statement, etc. 21 | ;; 22 | 23 | ;;; Code: 24 | 25 | (require 'hledger-defuns) 26 | (require 'hledger-core) 27 | (require 'hledger-navigate) 28 | (require 'hledger-reports) 29 | (require 'hledger-mail) 30 | (require 'hledger-webservice) 31 | 32 | (defgroup hledger nil 33 | "Customization group hledger-mode." 34 | :group 'data) 35 | 36 | (defcustom hledger-mode-hook nil 37 | "Normal hook for entering ‘hledger-mode’." 38 | :type 'hook 39 | :group 'hledger) 40 | 41 | (defcustom hledger-date-face font-lock-string-face 42 | "Face for date." 43 | :type 'face 44 | :group 'hledger) 45 | 46 | (defcustom hledger-amount-face font-lock-constant-face 47 | "Face for amount." 48 | :type 'face 49 | :group 'hledger) 50 | 51 | (defcustom hledger-account-face font-lock-variable-name-face 52 | "Face for accounts." 53 | :type 'face 54 | :group 'hledger) 55 | 56 | (defcustom hledger-description-face nil 57 | "Face for description text." 58 | :type 'face 59 | :group 'hledger) 60 | 61 | (defcustom hledger-refresh-completions-idle-delay 1 62 | "Update completions in file when Emacs has been idle for this many seconds.") 63 | 64 | (defcustom hledger-invalidate-completions '() 65 | "When to invalidate the data used for autocompletion. Apart 66 | from `on-idle', these events do not refresh the data but only set 67 | a flag for the next time completions are requested." 68 | :type '(set (const :tag "When idle in the buffer" on-idle) 69 | (const :tag "After saving" on-save) 70 | (const :tag "After editing" on-edit)) 71 | :group 'hledger) 72 | 73 | (defvar hledger-accounts-cache nil 74 | "List of accounts cached for ac and company modes.") 75 | 76 | (defvar hledger-must-update-accounts nil 77 | "Flag indicating that the list of accounts has potentially changed 78 | and must be recomputed. For internal use.") 79 | 80 | (defvar hledger-ac-source 81 | `((init . hledger-get-accounts) 82 | (candidates . hledger-accounts-cache)) 83 | "A source for completing account names in a hledger buffer.") 84 | 85 | ;;;###autoload 86 | (defun hledger-company (command &optional arg &rest ignored) 87 | "Company backend for ‘hledger-mode’. 88 | COMMAND, ARG and IGNORED the regular meanings." 89 | (interactive (list 'interactive)) 90 | (pcase command 91 | (`interactive (company-begin-backend 'hledger-company)) 92 | (`prefix (and (eq major-mode 'hledger-mode) 93 | (company-grab-symbol))) 94 | (`candidates 95 | (delq nil 96 | (mapcar (lambda (c) 97 | (and (string-prefix-p arg c) c)) 98 | hledger-accounts-cache))))) 99 | 100 | ;;;###autoload 101 | (defvar hledger-mode-map 102 | (let ((map (make-keymap))) 103 | (define-key map (kbd "C-c C-i") 'hledger-append-clipboard-to-journal) 104 | (define-key map (kbd "C-c C-d") 'hledger-reschedule) 105 | (define-key map (kbd "C-c C-b") 'hledger-edit-amount) 106 | (define-key map (kbd "C-c C-p") 'hledger-backward-entry) 107 | (define-key map (kbd "C-c C-n") 'hledger-next-or-new-entry) 108 | (define-key map (kbd "RET") 'hledger-ret-command) 109 | (define-key map (kbd "") 'hledger-backtab-command) 110 | map)) 111 | 112 | (defvar hledger-view-mode-map 113 | (let ((map (make-sparse-keymap))) 114 | (define-key map (kbd "C-c C-q") 'hledger-kill-reporting-window) 115 | (define-key map (kbd "e") 'hledger-jentry) 116 | (define-key map (kbd "g") 'hledger-redo) 117 | (define-key map (kbd "q") 'bury-buffer) 118 | (define-key map (kbd "h") 'hledger-show-view-mode-help) 119 | (define-key map (kbd "w") 'hledger-copy-to-clipboard) 120 | (define-key map (kbd "j") 'hledger-run-command) 121 | (define-key map (kbd "t") 'hledger-report-ending-today) 122 | (define-key map (kbd "w") 'hledger-widen-results-for-register) 123 | (define-key map (kbd "<") 'hledger-prev-report) 124 | (define-key map (kbd ">") 'hledger-next-report) 125 | (define-key map (kbd "D") 'hledger-report-at-day) 126 | (define-key map (kbd ".") 'hledger-present-report) 127 | (define-key map (kbd "o") (hledger-as-command hledger-overall-report* 128 | "overall")) 129 | (define-key map (kbd "i") (hledger-as-command hledger-incomestatement* 130 | "incomestatement")) 131 | (define-key map (kbd "d") (hledger-as-command hledger-daily-report* 132 | "daily")) 133 | (define-key map (kbd "b") (hledger-as-command hledger-balancesheet* 134 | "balancesheet")) 135 | (define-key map (kbd "") 'hledger-expand-account) 136 | (define-key map (kbd "n") 'next-line) 137 | (define-key map (kbd "p") 'previous-line) 138 | (define-key map (kbd "%") 'hledger-display-percentages) 139 | map)) 140 | 141 | (defun hledger-font-lock-keywords-1 () 142 | "Minimal highlighting expressions for hledger mode." 143 | (list 144 | `(,(concat "^ +" hledger-account-regex) 1 hledger-account-face) 145 | `(,(concat "^account " hledger-account-regex "$") 1 hledger-account-face) 146 | `(,(concat "^alias \\([^[:space:]=;\n]+\\) = " hledger-account-regex "$") 147 | (1 hledger-account-face) 148 | (2 hledger-account-face)) 149 | `(,(concat "^payee " hledger-account-regex "$") 1 hledger-account-face) 150 | `(,hledger-date-regex . hledger-date-face) 151 | `(,(hledger-amount-regex) . hledger-amount-face))) 152 | 153 | (defun hledger-font-lock-defaults () 154 | "Default highlighting expressions for hledger mode." 155 | (list (hledger-font-lock-keywords-1))) 156 | 157 | (defvar hledger-mode-syntax-table (let ((st (make-syntax-table))) 158 | (modify-syntax-entry ?: "_" st) 159 | (modify-syntax-entry ?\; "<" st) 160 | (modify-syntax-entry ?\n ">" st) 161 | st) 162 | "Syntax table for hledger mode.") 163 | 164 | (defun hledger-mode-init () 165 | "Function that does initial setup in the \"major-mode\" function." 166 | (setq font-lock-defaults (hledger-font-lock-defaults)) 167 | (setq-local indent-line-function 'hledger-indent-line) 168 | (setq-local indent-region-function 'hledger-indent-region-function) 169 | (setq-local comment-start "; ") 170 | (setq-local comment-end "") 171 | (setq require-final-newline t) 172 | (electric-indent-local-mode -1) 173 | ;; Make an overlay for current entry if enabled 174 | (when hledger-enable-current-overlay 175 | (add-hook 'post-command-hook 'hledger-update-current-entry-overlay)) 176 | (hledger-update-accounts) 177 | (when (memq 'on-idle hledger-invalidate-completions) 178 | (setq-local hledger-update-accounts-timer 179 | (run-with-idle-timer hledger-refresh-completions-idle-delay t 180 | 'hledger-update-accounts (current-buffer))) 181 | (add-hook 'kill-buffer-hook 182 | (lambda () (cancel-timer hledger-update-accounts-timer)) 183 | nil 184 | t)) 185 | (when (memq 'on-edit hledger-invalidate-completions) 186 | (add-hook 'post-command-hook 'hledger-maybe-update-accounts nil t)) 187 | (when (memq 'on-save hledger-invalidate-completions) 188 | (add-hook 'after-save-hook 'hledger-must-update-accounts nil t)) 189 | (add-to-list (make-local-variable 'completion-at-point-functions) 190 | 'hledger-completion-at-point)) 191 | 192 | ;;;###autoload 193 | (define-derived-mode hledger-mode fundamental-mode "HLedger" () 194 | "Major mode for editing journal files." 195 | :syntax-table hledger-mode-syntax-table 196 | (hledger-mode-init) 197 | (hledger-init-thing-at-point)) 198 | 199 | ;;;###autoload 200 | (define-derived-mode hledger-view-mode special-mode "HLedger View" () 201 | "Major mode for viewing hledger reports. I have a separate major mode 202 | so that the key bindings are not shared between buffers that are used for 203 | viewing reports and the journal file. I require the same kind of syntax 204 | highlighting in both kinds of buffers." 205 | :syntax-table hledger-mode-syntax-table 206 | (setq font-lock-defaults (hledger-font-lock-defaults)) 207 | ;; Populate accounts cache if not already. 208 | (unless hledger-accounts-cache 209 | (hledger-update-accounts)) 210 | ;; Setting up font-lock for partial account names. This is only to 211 | ;; make sure they have the right face in a tree-type report. Why? 212 | ;; Why not!? 213 | (let* ((account-words (apply 'append 214 | (mapcar (lambda (s) 215 | (split-string s ":" t)) 216 | hledger-accounts-cache))) 217 | (font-lock-acc-string (concat "\\<\\(" 218 | (mapconcat 'identity 219 | (delete-dups account-words) 220 | "\\|") 221 | "\\)\\>"))) 222 | ;; Do this only in view mode 223 | (font-lock-add-keywords 'hledger-view-mode 224 | `((,font-lock-acc-string . hledger-account-face) 225 | (":" . hledger-account-face)))) 226 | ;; Avoid wrapping lines in reports 227 | (setq truncate-lines t) 228 | (hledger-init-thing-at-point)) 229 | 230 | (provide 'hledger-mode) 231 | 232 | ;;; hledger-mode.el ends here 233 | -------------------------------------------------------------------------------- /hledger-mail.el: -------------------------------------------------------------------------------- 1 | ;;; hledger-mail.el --- Extension to email reports -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2016 Narendra Joshi 4 | 5 | ;; Author: Narendra Joshi 6 | ;; Keywords: comm, convenience 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; This extension manages sending monthly emails containing hleger 24 | ;; reports to the user. 25 | 26 | ;;; Code: 27 | 28 | (require 'hledger-core) 29 | (require 'hledger-reports) 30 | 31 | (require 'cl-lib) 32 | (require 'url) 33 | (require 'url-http) 34 | 35 | (defcustom hledger-reporting-buffer-name "*Personal Finance*" 36 | "Name of the buffer for showing or working with reports." 37 | :group 'hledger 38 | :type 'string) 39 | 40 | (defcustom hledger-email-api-url "EMAIL_API_URL" 41 | "Email API end-point." 42 | :group 'hledger 43 | :type 'string) 44 | 45 | (defcustom hledger-email-api-password "EMAIL_API_PASSWD" 46 | "Password for the Email API." 47 | :group 'hledger 48 | :type 'string) 49 | 50 | (defcustom hledger-email-api-user "EMAIL_API_USER" 51 | "Username for Email API." 52 | :group 'hledger 53 | :type 'string) 54 | 55 | (defcustom hledger-email-api-sender "SENDER_EMAIL_ID" 56 | "Email id for the sender of your reports." 57 | :group 'hledger 58 | :type 'string) 59 | 60 | (defcustom hledger-email-api-recipient "RECIPIENT_EMAIL_ID" 61 | "Email id for the receiver of your reports, i.e. you!" 62 | :group 'hledger 63 | :type 'string) 64 | 65 | (defcustom hledger-reporting-day 15 66 | "Day of the month for sending email reports. 67 | I am not checking the range. You are own your own." 68 | :group 'hledger 69 | :type 'integer) 70 | 71 | (defcustom hledger-email-reporting-retry-interval 2 72 | "Seconds to wait before retrying to send emails again." 73 | :group 'hledger 74 | :type 'integer) 75 | 76 | (defcustom hledger-email-secrets-file 77 | (and (boundp 'secrets-file) secrets-file) 78 | "Path to the file containing EMAIL API credentials." 79 | :group 'hledger 80 | :type 'string) 81 | 82 | (defvar hledger-email-next-reporting-time 83 | (let* ((time (current-time)) 84 | (day (string-to-number (format-time-string "%d" time))) 85 | (delta-time (days-to-time (- hledger-reporting-day 86 | day)))) 87 | (time-add time delta-time)) 88 | "The next time beyond which we must update this variable. 89 | It is updated after an email has been sent to the user.") 90 | 91 | 92 | (defun hledger-make-multipart-boundary () 93 | "Make the boundary for multipart/form-data. 94 | Creates some slightly unprobably gibberish." 95 | (concat "x" (make-string 18 ?-) (format "%x" (random 99999999999)))) 96 | 97 | (defun hledger-make-multipart-url-data (boundary params) 98 | "Construct a multipart/form-data body string with BOUNDARY and PARAMS." 99 | (concat 100 | (mapconcat (lambda (kv) 101 | (let* ((name (format "%s" (car kv))) 102 | (value (cdr kv)) 103 | (encoded-value (encode-coding-string value 'utf-8))) 104 | (concat (concat "--" boundary) "\n" 105 | "Content-Disposition: form-data; " 106 | "name=\"" name "\"\n\n" 107 | encoded-value "\n"))) 108 | params 109 | "") 110 | "--" boundary "--\n")) 111 | 112 | (defun hledger-send-email-with-mailgun (url headers) 113 | "Send email using Mailgun. 114 | 115 | Returns a boolean value stating if the operation failed or succeeded. 116 | t => success nil => failure 117 | 118 | This function emulates the curl command as available in the Mailgun Docs: 119 | curl -s --user USER-AND-PASSWD URL 120 | -F FROM='Excited User ' \ 121 | -F TO='devs@mailgun.net' \ 122 | -F SUBJECT='Hello' \ 123 | -F TEXT='Testing some Mailgun awesomeness!' 124 | 125 | HEADERS is an assoc-list with the headers of the request. 126 | `((authorization . AUTHORIZATION) 127 | (from . FROM) 128 | (to . TO) 129 | (subject . SUBJECT) 130 | (text . TEXT))" 131 | (let* ((multipart-boundary (hledger-make-multipart-boundary)) 132 | (url-request-method "POST") 133 | (url-request-extra-headers 134 | `(("Content-Type" . ,(format 135 | "multipart/form-data; boundary=%s; charset=utf-8" 136 | multipart-boundary)) 137 | ("Authorization" . ,(concat 138 | "Basic " 139 | (base64-encode-string 140 | (assoc-default 'authorization headers)))))) 141 | (url-request-data 142 | (hledger-make-multipart-url-data multipart-boundary 143 | (assq-delete-all 'authorization 144 | headers)))) 145 | ;; This is a hack until 146 | ;; https://lists.gnu.org/archive/html/bug-gnu-emacs/2016-08/msg00031.html 147 | ;; is fixed. 148 | (let ((_ (defadvice string-bytes (around fake-string-bytes (s)) 149 | (setq ad-return-value (length s)))) 150 | (_ (ad-activate 'string-bytes)) 151 | (url-buffer (url-retrieve-synchronously url)) 152 | (_ (ad-deactivate 'string-bytes))) 153 | ;; Ugly hack ends! 154 | (if (not url-buffer) 155 | nil 156 | (with-current-buffer url-buffer 157 | (url-http-parse-response) 158 | (= url-http-response-status 200)))))) 159 | 160 | (defun hledger-send-text-email (url user-and-password from to subject text) 161 | "Send an email with text body. 162 | URL is the api-endpoint [Mailgun HTTP API endpoint]. 163 | USER-AND-PASSWORD is in the format 'user:password' and is 164 | base64-encoded to make the Authorization header for simple 165 | authentication. 166 | 167 | FROM and TO are email ids for the sender and receiver respectively. 168 | SUBJECT is the subject of the email. 169 | TEXT is the body of the mail." 170 | (hledger-send-email-with-mailgun url `((authorization . ,user-and-password) 171 | (from . ,from) 172 | (to . ,to) 173 | (subject . ,subject) 174 | (text . ,text)))) 175 | 176 | (defun hledger-send-email (url user-and-password from to subject text html) 177 | "Send email with URL, USER-AND-PASSWORD, FROM, TO, SUBJECT and TEXT. 178 | See `hledger-send-text-email'. This function would send an email 179 | with both Text and HTML parts as specified." 180 | (hledger-send-email-with-mailgun url `((authorization . ,user-and-password) 181 | (from . ,from) 182 | (to . ,to) 183 | (subject . ,subject) 184 | (text . ,text) 185 | (html . ,html)))) 186 | 187 | 188 | (defun hledger-compute-next-reporting-time () 189 | "Computes the time we must sent the email reports." 190 | (let* ((now hledger-email-next-reporting-time) 191 | (next-month-time (time-add now (days-to-time 30))) 192 | (next-month-day (string-to-number 193 | (format-time-string "%d" next-month-time))) 194 | (delta (days-to-time (- hledger-reporting-day next-month-day))) 195 | (next-time (time-add next-month-time delta))) 196 | next-time)) 197 | 198 | (defun hledger-generate-reports-to-email () 199 | "Generate the text html for monthly and running reports. 200 | 201 | Returns a cons cell with (text . html). 202 | This requires htmlize.el" 203 | (require 'htmlize) 204 | (let ((hledger-reporting-buffer-name " *Hleder Email Reporting*")) 205 | (hledger-overall-report) 206 | (deactivate-mark t) 207 | (with-current-buffer hledger-reporting-buffer-name 208 | ;; So that no line is highlighted. The buffer is in hledger-view-mode. 209 | (hl-line-mode -1) 210 | (let* ((text (buffer-substring-no-properties (point-min) 211 | (point-max))) 212 | (htmlize-output-type 'inline-css) 213 | (fontified-buffer (htmlize-buffer)) 214 | (html (with-current-buffer fontified-buffer 215 | ;; Make sure that chrome uses a vertical scroll bar 216 | (goto-char (point-min)) 217 | (search-forward " Loading hledger-mode.") 258 | (require 'hledger-mode) 259 | ;; This requires secrets. So, we don't do anything if there is 260 | ;; no secrets file. 261 | (when (file-exists-p ,hledger-email-secrets-file) 262 | (load ,hledger-email-secrets-file) 263 | (let ((epoch (current-time))) 264 | ;; Seed waiting time. To make exponential back-off simpler. 265 | ;; Sleeping times go like this: t(n) = 2 * Σ t(i) for all i < n 266 | ;; and t(0) = `hledger-email-reporting-retry-interval'. 267 | (message "--> Sleeping for %.0f seconds" 268 | hledger-email-reporting-retry-interval) 269 | (sleep-for hledger-email-reporting-retry-interval) 270 | (while (not (ignore-errors (hledger-mail-reports))) 271 | (message "--> Hledger email reporting: Failed.") 272 | (let ((waiting-time (* 2 (time-to-seconds 273 | (time-subtract (current-time) 274 | epoch))))) 275 | (message "--> Sleeping for %.0f seconds" waiting-time) 276 | (sleep-for waiting-time))) 277 | t))) 278 | (lambda (success) 279 | (if success 280 | (progn 281 | (setq hledger-email-next-reporting-time 282 | (hledger-compute-next-reporting-time)) 283 | (customize-save-variable 'hledger-email-next-reporting-time 284 | (hledger-compute-next-reporting-time)) 285 | (message "Hledger email reporting: Ok")) 286 | (message "Hledger email reporting: Failed"))))) 287 | 288 | (defun hledger-mail-monthly-report () 289 | "Email monthly report if not done already for the current month." 290 | (when (time-less-p hledger-email-next-reporting-time (current-time)) 291 | (if (not (ignore-errors (hledger-mail-reports))) 292 | (message "--> Hledger email reporting: Failed.") 293 | (message "--> Mail reporting was successful.") 294 | (setq hledger-email-next-reporting-time 295 | (hledger-compute-next-reporting-time)) 296 | (customize-save-variable 'hledger-email-next-reporting-time 297 | (hledger-compute-next-reporting-time))))) 298 | 299 | (defun hledger-setup-mail-report-timer () 300 | "Setup a timer to send monthly report when idle." 301 | (run-with-idle-timer 15 nil #'hledger-mail-monthly-report)) 302 | 303 | ;;;###autoload 304 | (defun hledger-enable-reporting () 305 | "Report every month on `hledger-reporting-day'." 306 | (add-hook 'hledger-mode-hook #'hledger-setup-mail-report-timer)) 307 | 308 | (provide 'hledger-mail) 309 | ;;; hledger-mail.el ends here 310 | -------------------------------------------------------------------------------- /hledger-navigate.el: -------------------------------------------------------------------------------- 1 | ;;; hledger-navigate.el --- Functions for navigating around an hledger buffer. -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2017 Narendra Joshi 4 | 5 | ;; Author: Narendra Joshi 6 | ;; Keywords: data, convenience 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; 24 | ;; Functions related to navigating an hledger journal file containing 25 | ;; buffer. This file would also have functions for mutating a buffer, 26 | ;; e.g. for changing the date. 27 | 28 | 29 | ;;; Code: 30 | 31 | (require 'hledger-core) 32 | (require 'pulse) 33 | (require 'parse-time) 34 | 35 | (defvar hledger-jentry-hook nil 36 | "Hook for `hledger-jentry'.") 37 | 38 | ;; Things in hledger 39 | (defvar hledger-amount 0 40 | "Variable to be used for looking at amount at point.") 41 | (defvar hledger-date "18-06-1993" 42 | "Variable to be used for looking at date at point.") 43 | (defvar hledger-account "assets" 44 | "Variable to be used for looking at account name at point.") 45 | 46 | (defcustom hledger-enable-current-overlay nil 47 | "Boolean to decide whether to enable current entry overlay." 48 | :group 'hledger 49 | :type 'boolean) 50 | 51 | (defcustom hledger-current-entry-overlay-face 52 | '(:background "dark slate grey" :height 1.1) 53 | "Face for the current journal entry's overlay." 54 | :group 'hledger 55 | :type 'face) 56 | 57 | (defvar hledger-current-entry-beg nil 58 | "Variable to store the (point) for beginning of current entry.") 59 | (make-variable-buffer-local 'hledger-current-entry-beg) 60 | 61 | (defvar hledger-current-entry-end nil 62 | "Variable to store the (point) for end of current entry.") 63 | (make-variable-buffer-local 'hledger-current-entry-end) 64 | 65 | (defvar hledger-current-entry-overlay nil 66 | "Overlay that spans the currently journal entry.") 67 | 68 | (defun hledger-pulse-momentary-current-entry () 69 | "Pulse highlight journal entry at point." 70 | (save-excursion 71 | (pulse-momentary-highlight-region 72 | (if (looking-at hledger-date-regex) 73 | (line-beginning-position) 74 | (or (hledger-backward-entry) 75 | (point-min))) 76 | (or (hledger-forward-entry) (point-max)) 77 | 'next-error))) 78 | 79 | (defun hledger-ret-command () 80 | "Commands run on in ‘hledger-mode’." 81 | (interactive) 82 | (newline-and-indent)) 83 | 84 | (defun hledger-backtab-command () 85 | "Commands runon in ‘hledger-mode’." 86 | (interactive) 87 | (backward-delete-char-untabify tab-width)) 88 | 89 | (defun hledger-kill-reporting-window () 90 | "Kill the reporting buffer and window." 91 | (interactive) 92 | (if (>= (length (window-list)) 2) 93 | (kill-buffer-and-window) 94 | (kill-buffer))) 95 | 96 | (defun hledger-reschedule () 97 | "Reschedule the transaction at point. 98 | Note: This function uses `org-read-date'." 99 | (interactive) 100 | (save-excursion 101 | (let ((new-date (org-read-date))) 102 | (forward-line 0) 103 | (when (not (looking-at hledger-date-regex)) 104 | (search-backward-regexp hledger-date-regex)) 105 | ;; Erase the old date 106 | (delete-region (line-beginning-position) 107 | (search-forward-regexp hledger-date-regex)) 108 | ;; Insert the new date 109 | (insert new-date) 110 | (pulse-momentary-highlight-region (line-beginning-position) 111 | (line-end-position))))) 112 | 113 | (defun hledger-add-days-to-entry-date (days) 114 | "Add a number of days to the date of the entry at point (or 115 | subtract when `days 'is negative)." 116 | (interactive "nDays to add (negative number to subtract): ") 117 | (save-excursion 118 | (forward-line 0) 119 | (when (not (looking-at hledger-date-regex)) 120 | (search-backward-regexp hledger-date-regex)) 121 | (let* ((date (match-string 0)) 122 | (end (match-end 0)) 123 | (parsed (iso8601-parse (concat date "T00:00:00Z"))) 124 | (new-date (encode-time (decoded-time-add parsed (make-decoded-time :day (floor days)))))) 125 | (delete-region (line-beginning-position) 126 | end) 127 | (insert (format-time-string "%Y-%m-%d" new-date t)) 128 | (pulse-momentary-highlight-region (line-beginning-position) 129 | (line-end-position))))) 130 | 131 | (defun hledger-increment-entry-date () 132 | "Add one day to the date of the entry at point." 133 | (interactive) 134 | (hledger-add-days-to-entry-date 1)) 135 | 136 | (defun hledger-decrement-entry-date () 137 | "Decrement one day from the date of the entry at point." 138 | (interactive) 139 | (hledger-add-days-to-entry-date -1)) 140 | 141 | (defun hledger-go-to-starting-line () 142 | "Function to go the first line that stars a new entry. Cleans up whitespace." 143 | (goto-char (point-max)) 144 | (beginning-of-line) 145 | (while (and (looking-at hledger-empty-regex) 146 | (not (bobp))) 147 | (forward-line -1)) 148 | (end-of-line) 149 | (let ((times-yet-to-move (forward-line 2))) 150 | (insert (make-string times-yet-to-move ?\n)))) 151 | 152 | (defun hledger-jentry () 153 | "Make a new entry in the financial journal. Avoids editing old entries." 154 | (interactive) 155 | (find-file hledger-jfile) 156 | (hledger-go-to-starting-line) 157 | (run-hooks 'hledger-jentry-hook) 158 | (recenter)) 159 | 160 | (defun hledger-forward-entry (&optional n) 161 | "Move past N hledger entries. 162 | With a prefix argument, repeat that many times. 163 | Returns nil if we have reached the end of the journal." 164 | (interactive "p") 165 | ;; To make sure we are not on the date of the first entry. 166 | (end-of-line) 167 | (let ((p (search-forward-regexp hledger-date-regex nil t (or n 1)))) 168 | (forward-line 0) 169 | (and p (point)))) 170 | 171 | (defun hledger-next-or-new-entry (&optional n) 172 | "Move to the next entry or the beginning of a new one. 173 | Argument N is passed onto `hledger-forward-entry'." 174 | (interactive "p") 175 | (or (hledger-forward-entry n) 176 | (hledger-go-to-starting-line))) 177 | 178 | (defun hledger-backward-entry (&optional n) 179 | "Move backward by N hledger entries. 180 | With a prefix argument, repeat that many times. 181 | Returns nil if we are at the beginning of the journal." 182 | (interactive "p") 183 | ;; To make sure we skip the current entry. 184 | (forward-line 0) 185 | (when (search-backward-regexp hledger-date-regex nil t (or n 1)))) 186 | 187 | (defun hledger-bounds-of-thing-at-point (thing-regexp &optional sep-regexp) 188 | "Return the (beg . end) point positions for amount at point. 189 | To make this work, one must be either inside or after thing at point in buffer. 190 | Argument THING-REGEXP is the regular expression that matches the thing. 191 | Optional argument SEP-REGEXP is the regular expression that separates things." 192 | (let* ((here (point)) 193 | ;; Search back for separator 194 | (beg (progn 195 | (when (search-backward-regexp (or sep-regexp 196 | "\\s-+") 197 | (point-min) 198 | t) 199 | (search-forward-regexp (or sep-regexp 200 | "\\s-+") 201 | here 202 | t)))) 203 | ;; Search forward for separator 204 | (end-bound (save-excursion 205 | (search-forward-regexp (or sep-regexp 206 | "\\s-+") 207 | (point-max) 208 | t))) 209 | ;; Search for the thing starting the first separator ^ 210 | (end (search-forward-regexp thing-regexp 211 | (or end-bound 212 | (point-max)) 213 | t))) 214 | ;; Restore point 215 | (goto-char here) 216 | ;; If any one of the ends is nil, return nil. 217 | (and (and beg end) 218 | (cons beg end)))) 219 | 220 | (defun hledger-bounds-of-current-entry () 221 | "Return the bounds of the current journal entry." 222 | (save-excursion 223 | (let* ((x (hledger-forward-entry)) 224 | (y (hledger-backward-entry)) 225 | (new-bounds (cond 226 | ((and x y) (cons y x)) 227 | ;; We are at the last entry of the journal. 228 | ;; Either there is a previous entry or there isn't. 229 | ((and y (not x)) (cons (or (hledger-forward-entry) 230 | (point)) 231 | (point-max))) 232 | ;; We are at the first entry of the journal. 233 | ;; Will these ever be reached? 234 | ((not y) (cons x (hledger-forward-entry))))) 235 | (new-x (car new-bounds))) 236 | ;; Skip empty lines from the overlay 237 | (goto-char (cdr new-bounds)) 238 | (while (or (looking-at hledger-empty-regex) 239 | (looking-at hledger-date-regex)) 240 | (forward-line -1)) 241 | (cons new-x (line-end-position))))) 242 | 243 | (defun hledger-bounds-of-account-at-point () 244 | "Return the bounds of an account name at point." 245 | (let ((start (or (save-excursion 246 | (re-search-backward hledger-account-leading-regex (point-at-bol) t) 247 | (goto-char (match-end 0)) 248 | (point)) 249 | (point-at-bol))) 250 | (end (or (save-excursion 251 | (re-search-forward hledger-account-leading-regex (point-at-eol) t) 252 | (point)) 253 | (point-at-eol)))) 254 | (when (and (thing-at-point-looking-at hledger-account-regex (- end start)) 255 | (>= (match-beginning 0) start) 256 | (<= (match-end 0) end)) 257 | (cons (match-beginning 0) (match-end 0))))) 258 | 259 | (defun hledger-bounds-of-date-at-point () 260 | "Return the bounds of date at point." 261 | (hledger-bounds-of-thing-at-point hledger-date-regex)) 262 | 263 | (defun hledger-bounds-of-amount-at-point () 264 | "Return the bounds of a floating point number at point." 265 | (hledger-bounds-of-thing-at-point hledger-amount-value-regex)) 266 | 267 | (defun hledger-init-thing-at-point () 268 | "Setup properties for thingatpt.el." 269 | (put 'hledger-account 270 | 'bounds-of-thing-at-point 271 | 'hledger-bounds-of-account-at-point) 272 | (put 'hledger-amount 273 | 'bounds-of-thing-at-point 274 | 'hledger-bounds-of-amount-at-point) 275 | (put 'hledger-date 276 | 'bounds-of-thing-at-point 277 | 'hledger-bounds-of-date-at-point)) 278 | 279 | (defun hledger-update-current-entry-overlay () 280 | "Update the overlay for the current journal entry." 281 | ;; Only run this in a `hledger-mode' buffer. For example, M-x 282 | ;; command would cause this to fail otherwise. 283 | (when (eq major-mode 'hledger-mode) 284 | ;; Initialize if required. 285 | (unless hledger-current-entry-overlay 286 | (setq hledger-current-entry-overlay 287 | (make-overlay (point-max) (point-max) (current-buffer) t t)) 288 | (overlay-put hledger-current-entry-overlay 289 | 'face hledger-current-entry-overlay-face)) 290 | ;; Now let's update the overlay. 291 | (if (and hledger-current-entry-beg 292 | hledger-current-entry-end 293 | (and (<= hledger-current-entry-beg (point)) 294 | (< (point) hledger-current-entry-end))) 295 | nil 296 | (let* ((bounds-of-entry (hledger-bounds-of-current-entry))) 297 | (setq hledger-current-entry-beg (car bounds-of-entry)) 298 | (setq hledger-current-entry-end (cdr bounds-of-entry)) 299 | (move-overlay hledger-current-entry-overlay 300 | hledger-current-entry-beg 301 | hledger-current-entry-end) 302 | (overlay-put hledger-current-entry-overlay 303 | 'after-string 304 | (propertize " " 305 | 'display 306 | `((space :align-to ,(window-text-width))) 307 | 'face hledger-current-entry-overlay-face 308 | 'cursor t)))))) 309 | 310 | (defun hledger-toggle-star () 311 | "Toggle the star status of a journal entry." 312 | (interactive) 313 | (save-excursion 314 | (let ((there (line-end-position))) 315 | (beginning-of-line) 316 | (while (not (looking-at hledger-date-and-desc-regex)) 317 | (forward-line -1)) 318 | ;; Update the date to today after each toggle 319 | (search-forward-regexp hledger-date-regex nil t) 320 | (delete-region (line-beginning-position) (point)) 321 | (hledger-insert-date) 322 | ;; Now handle the start/unstar stuff 323 | (if (search-forward "*" there t) 324 | (delete-char -3) 325 | (insert "*"))))) 326 | 327 | (defun hledger-op-on-amount (op) 328 | "Apply operation OP on the previous amount in sight." 329 | (save-excursion 330 | (if (search-forward-regexp hledger-amount-value-regex nil t) 331 | (let* ((amount-bounds (bounds-of-thing-at-point 'hledger-amount)) 332 | (amount (string-to-number (thing-at-point 'hledger-amount))) 333 | (beg (car amount-bounds)) 334 | (end (cdr amount-bounds)) 335 | (new-amount (funcall op amount))) 336 | (delete-region beg end) 337 | (insert (format "%s" new-amount)) 338 | (pulse-momentary-highlight-region beg end)) 339 | (message "No journal entry after point.")))) 340 | 341 | (defun hledger-increment-amount (&optional p) 342 | "Increment amount by 1. 343 | With prefix argument P, increment by that number." 344 | (interactive "p") 345 | (hledger-op-on-amount (lambda (amount) 346 | (+ amount (or p 1))))) 347 | 348 | (defun hledger-edit-amount (amount) 349 | "Update the previous amount in the buffer with AMOUNT." 350 | (interactive "nAmount: ") 351 | (hledger-op-on-amount (lambda (_) amount))) 352 | 353 | (provide 'hledger-navigate) 354 | ;;; hledger-navigate.el ends here 355 | -------------------------------------------------------------------------------- /hledger-defuns.el: -------------------------------------------------------------------------------- 1 | ;;; hledger-defuns.el --- Helper functions for hledger-mode.el -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2016 Narendra Joshi 4 | 5 | ;; Author: Narendra Joshi 6 | ;; Keywords: convenience 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; This file contains code for functions defined to make 24 | ;; hledger-mode.el simpler and shorter. 25 | 26 | ;;; Code: 27 | 28 | (require 'cl-lib) 29 | (require 'popup) 30 | 31 | (require 'hledger-core) 32 | 33 | (defcustom hledger-display-percentage-face 34 | '(:foreground "Cornsilk" :background "DarkSlateGray") 35 | "Face for showing the percentage of a set of balances around point." 36 | :group 'hledger 37 | :type 'face) 38 | 39 | (defcustom hledger-percentage-chart-face 40 | '(:foreground "Cornsilk" :background "DarkSlateGray") 41 | "Face for showing the percentage chart." 42 | :group 'hledger 43 | :type 'face) 44 | 45 | (defcustom hledger-percentage-chart-char 46 | ?█ 47 | "Character to use for drawing the percentage chart." 48 | :group 'hledger 49 | :type 'char) 50 | 51 | (defcustom hledger-show-percentage-chart 52 | t 53 | "Boolean to decide if we show the chart alongside percentages." 54 | :group 'hledger 55 | :type 'boolean) 56 | 57 | (defcustom hledger-percentage-chart-width 58 | 20 59 | "Width of the percentage chart.") 60 | 61 | (defun hledger-copy-to-clipboard () 62 | "Copies current buffer contents to clipboard." 63 | (interactive) 64 | (clipboard-kill-ring-save (point-min) (point-max)) 65 | (message "Buffer copied to clipboard")) 66 | 67 | (defun hledger-append-clipboard-to-journal () 68 | "Append clipboard contents to journal file." 69 | (interactive) 70 | (let ((entries (buffer-string))) 71 | (hledger-jentry) 72 | (insert entries) 73 | (format "Fetched entries appended."))) 74 | 75 | (defmacro hledger-as-command (name command) 76 | "Define a function named NAME for hledger COMMAND." 77 | `(defun ,(intern (symbol-name name)) () (interactive) 78 | (setq hledger-last-run-time 0) 79 | (hledger-run-command ,command) 80 | (goto-char (point-min)))) 81 | 82 | (defun hledger-show-view-mode-help () 83 | "Show help in hledger view mode." 84 | (interactive) 85 | (let ((result "")) 86 | ;; Show key binding for single character keys 87 | (map-keymap (lambda (k v) 88 | (when (and (characterp k) 89 | (symbolp v)) 90 | (setq result 91 | (concat result 92 | (format "%c %s\n" 93 | k 94 | (replace-regexp-in-string "hledger-" 95 | "" 96 | (symbol-name v))))))) 97 | (current-local-map)) 98 | (popup-tip result :margin t))) 99 | 100 | (defvar hledger-display-percentages nil 101 | "Variable accompanying `hledger-display-percentags' to maintain state.") 102 | 103 | (defun hledger-remove-overlays () 104 | "Remove overlays from beg to end in `hledger-display-percentages'." 105 | (remove-hook 'post-command-hook #'hledger-remove-overlays) 106 | (remove-overlays (get 'hledger-display-percentages 'beg) 107 | ;; Take into account the margin and just one more 108 | ;; char 109 | (+ 2 (get 'hledger-display-percentages 'end)))) 110 | 111 | (defun hledger-remove-overlays-hook () 112 | "Hook to be called for removing overlays created for % display." 113 | (remove-hook 'post-command-hook #'hledger-remove-overlays-hook) 114 | (add-hook 'post-command-hook #'hledger-remove-overlays)) 115 | 116 | (defun hledger-find-balance-delimits () 117 | "Return the beginning and end point positions for shown --flat bals. 118 | Returns a cons pair of the point values. Returns nil if there is 119 | not balance at point." 120 | (let* ((beg (save-excursion 121 | (forward-line 0) 122 | (while (and (looking-at hledger-whitespace-amount-regex) 123 | (not (bobp))) 124 | (forward-line -1)) 125 | (if (not (looking-at hledger-whitespace-amount-regex)) 126 | (forward-line)) 127 | (point))) 128 | (end (save-excursion 129 | (forward-line 0) 130 | (while (and (looking-at hledger-whitespace-amount-regex) 131 | (not (eobp))) 132 | (forward-line)) 133 | (if (not (looking-at hledger-whitespace-amount-regex)) 134 | (forward-line -1)) 135 | (end-of-line) 136 | (point)))) 137 | (when (< beg end) 138 | (cons beg end)))) 139 | 140 | (defun hledger-display-percentages () 141 | "Display percentages for the balances around the point." 142 | (interactive) 143 | (make-local-variable 'hledger-display-percentages) 144 | (let* ((amounts-with-delims-in-col (hledger-amounts-in-column)) 145 | ;; Delimits for flat account names, i.e lines starting with 146 | ;; amount. 147 | (flat-delims (hledger-find-balance-delimits)) 148 | ;; Prefer flat amounts 149 | (beg-end (or flat-delims 150 | (cdr amounts-with-delims-in-col))) 151 | (beg (and beg-end (car beg-end))) 152 | (end (and beg-end (cdr beg-end))) 153 | (amounts (if flat-delims '() (car amounts-with-delims-in-col))) 154 | ;; Display overlay starting this column if flat-delims is nil 155 | (overlay-column (save-excursion (and end 156 | (goto-char end) 157 | ;; 1+ is the margin value 158 | (1+ (current-column)))))) 159 | (when (and beg end) 160 | (save-excursion 161 | ;; Collect amounts only when we are looking at flat account 162 | ;; names with balances as in income statement. 163 | (when flat-delims 164 | (goto-char end) 165 | (while (re-search-backward hledger-amount-regex beg t) 166 | (push (string-to-number (replace-regexp-in-string 167 | (regexp-quote hledger-currency-string) 168 | "" 169 | (match-string 0))) 170 | amounts))) 171 | ;; Now that we have the amounts. Let's create overlays. 172 | (goto-char beg) 173 | (let* ((pos-amounts (seq-filter (lambda (n) 174 | (< 0 n)) 175 | amounts)) 176 | (neg-amounts (seq-filter (lambda (n) 177 | (not (< 0 n))) 178 | amounts)) 179 | (pos-amounts-sum (cl-reduce '+ pos-amounts :initial-value 0.0)) 180 | (neg-amounts-sum (cl-reduce '+ neg-amounts :initial-value 0.0)) 181 | (hledger-pchart-format 182 | (concat "%-" 183 | (number-to-string hledger-percentage-chart-width) 184 | "s"))) 185 | (dolist (amount amounts) 186 | ;; Overlay for display the percentage 187 | (let ((amounts-sum (if (< 0 amount) 188 | pos-amounts-sum 189 | neg-amounts-sum))) 190 | ;; Add overlay column if it's just a column of amounts. 191 | (overlay-put (make-overlay (+ (line-beginning-position) 192 | (if flat-delims 0 overlay-column)) 193 | (+ (line-beginning-position) 194 | (if flat-delims 0 overlay-column))) 195 | 'after-string 196 | (concat 197 | ;; Percentages 198 | (propertize (format " %5.2f%% " 199 | (* (/ amount amounts-sum) 200 | 100.0)) 201 | 'font-lock-face 202 | hledger-display-percentage-face) 203 | ;; Percentage chart 204 | (propertize 205 | (if hledger-show-percentage-chart 206 | (format hledger-pchart-format 207 | (make-string 208 | (round (* (/ amount amounts-sum) 209 | hledger-percentage-chart-width)) 210 | hledger-percentage-chart-char)) 211 | "") 212 | 'font-lock-face hledger-percentage-chart-face)))) 213 | 214 | (forward-line)))) 215 | (setq hledger-display-percentages t) 216 | (put 'hledger-display-percentages 'beg beg) 217 | (put 'hledger-display-percentages 'end end) 218 | (add-hook 'post-command-hook 'hledger-remove-overlays-hook)))) 219 | 220 | 221 | (defun hledger-sort-flat-balances (prefix) 222 | "Sort the flat balances according the amount value. 223 | This assumes that the amount value appears in the second column 224 | after the currency sign. So, it won't work for different 225 | commodities with differently positioned commodity signs. 226 | Argument PREFIX is the universal argument to decide whether to 227 | reverse the direction of sorting." 228 | (interactive "P") 229 | (let* ((inhibit-read-only t) 230 | (beg-end (hledger-find-balance-delimits)) 231 | (beg (car beg-end)) 232 | (end (cdr beg-end))) 233 | (sort-numeric-fields 2 beg end) 234 | (if (not prefix) 235 | (reverse-region beg end)))) 236 | 237 | 238 | 239 | 240 | 241 | (defun hledger-amounts-in-column () 242 | "Return a sequence of consecutive amounts in current column. 243 | Returns a cons cell with amounts and the delimiting point 244 | values." 245 | (let ((col (current-column)) 246 | (amounts '()) 247 | (end nil) 248 | (beg nil)) 249 | (when (thing-at-point 'hledger-amount) 250 | (save-excursion 251 | ;; Let's go all the way down first 252 | (while (and (thing-at-point 'hledger-amount) 253 | (not (eobp))) 254 | (forward-line) 255 | (move-to-column col)) 256 | ;; Move to the last amount 257 | (forward-line -1) 258 | (move-to-column col) 259 | ;; Store the first end point of the amount 260 | (setq end (cdr (bounds-of-thing-at-point 'hledger-amount))) 261 | ;; Start collection amounts now 262 | (while (and (thing-at-point 'hledger-amount) 263 | (not (bobp))) 264 | (push (string-to-number (thing-at-point 'hledger-amount)) 265 | amounts) 266 | (forward-line -1) 267 | (move-to-column col)) 268 | ;; Move to the first amount 269 | (forward-line) 270 | (move-to-column col) 271 | ;; Store the last end point of the amount 272 | (setq beg (car (bounds-of-thing-at-point 'hledger-amount))) 273 | 274 | ;; Returns (amounts . (beg . end)) 275 | (cons amounts 276 | (cons beg end)))))) 277 | 278 | (defun hledger-group-digits (number) 279 | "Group the digits of NUMBER to make it more readable. 280 | Returns a string with commas added appropriately. 281 | 282 | Note: I am not handling the edge cases here. It's okay if the number 283 | looks ugly when it's small." 284 | (let* ((number-string (number-to-string number)) 285 | (number-hundreds-and-rest (mod number 1000)) 286 | (number-but-hundreds-and-rest (/ number 1000)) 287 | (number-tail-string (format "%03d" number-hundreds-and-rest)) 288 | (number-head-string (if (= 0 number-but-hundreds-and-rest) 289 | "" 290 | (number-to-string number-but-hundreds-and-rest))) 291 | (number-head-pairs (mapcar 'reverse 292 | (reverse (seq-partition 293 | (reverse number-head-string) 294 | 2)))) 295 | (number-head-triplets (mapcar 'reverse 296 | (reverse (seq-partition 297 | (reverse number-head-string) 298 | 3)))) 299 | (number-english-format (concat 300 | (mapconcat 'identity number-head-triplets ",") 301 | (if number-head-triplets "," "") 302 | number-tail-string)) 303 | (number-hindi-format (concat 304 | (mapconcat 'identity number-head-pairs ",") 305 | (if number-head-triplets "," "") 306 | number-tail-string))) 307 | ;; Assuming `hledger-currency-string' is already defined. 308 | (if (and (boundp 'hledger-currency-string) 309 | (equal hledger-currency-string "₹")) 310 | number-hindi-format 311 | number-english-format))) 312 | 313 | (defun hledger-humanize-float-months (n) 314 | "Convert a float value N months into a proper human readable string." 315 | (let* ((whole-part (truncate n)) 316 | (decimal-part (- n whole-part)) 317 | (years (/ whole-part 12)) 318 | (months (mod whole-part 12)) 319 | (days (truncate (* 30 decimal-part)))) 320 | (if (= years days months 0) 321 | "0 days" 322 | (mapconcat 'identity 323 | (seq-filter 324 | (lambda (s) (not (equal s ""))) 325 | (list (if (< 0 years) (format "%d year%s" 326 | years 327 | (if (< 1 years) "s" "")) 328 | "") 329 | (if (< 0 months) (format "%d month%s" 330 | months 331 | (if (< 1 months) "s" "")) 332 | "") 333 | (if (< 0 days) (format "%s%d day%s" 334 | (if (or (< 0 years) (< 0 months)) 335 | "and " 336 | "") 337 | days 338 | (if (< 1 days) "s" "")) 339 | ""))) 340 | " ")))) 341 | 342 | (defun hledger-update-accounts (&optional buffer) 343 | "Update `hledger-accounts-cache' (optionally using `buffer' as 344 | input) and unset `hledger-must-update-accounts'. Will do nothing 345 | if `buffer' is passed but inactive." 346 | (when (or (null buffer) 347 | (eql (current-buffer) buffer)) 348 | (setq hledger-accounts-cache (hledger-get-accounts nil buffer) 349 | hledger-must-update-accounts nil))) 350 | 351 | (defun hledger-maybe-update-accounts (&optional buffer) 352 | "Set the `hledger-must-update-accounts' flag to `t' if the current 353 | command inserts text." 354 | (when (eql this-command 'self-insert-command) 355 | (hledger-must-update-accounts))) 356 | 357 | (defun hledger-must-update-accounts () 358 | "Set the `hledger-must-update-accounts' flag to `t'." 359 | (setq hledger-must-update-accounts t)) 360 | 361 | (defun hledger-completion-at-point () 362 | "Provide completion for accounts." 363 | (interactive) 364 | (when hledger-must-update-accounts 365 | (hledger-update-accounts (current-buffer))) 366 | (let ((bounds 367 | (or (bounds-of-thing-at-point 'hledger-account) 368 | (bounds-of-thing-at-point 'symbol)))) 369 | (when bounds 370 | (list (car bounds) 371 | (cdr bounds) 372 | hledger-accounts-cache 373 | :exclusive 'no)))) 374 | 375 | 376 | (provide 'hledger-defuns) 377 | ;;; hledger-defuns.el ends here 378 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | {one line to give the program's name and a brief idea of what it does.} 635 | Copyright (C) {year} {name of author} 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | {project} Copyright (C) {year} {fullname} 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . -------------------------------------------------------------------------------- /hledger-reports.el: -------------------------------------------------------------------------------- 1 | ;;; hledger-reports.el --- Generating reports with hledger -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2016 Narendra Joshi 4 | 5 | ;; Author: Narendra Joshi 6 | ;; Keywords: convenience, local 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; This file contains functions that are called everywhere else to 24 | ;; generate reports using hledger binary. 25 | 26 | ;;; Code: 27 | 28 | (require 'calendar) 29 | (require 'cl-lib) 30 | (require 'pulse) 31 | 32 | (require 'hledger-core) 33 | 34 | (defconst hledger-jcompletions '("balancesheet" 35 | "daily" 36 | "incomestatement" 37 | "overall" 38 | "stats" 39 | "activity" 40 | "print" 41 | "accounts" 42 | "balance" 43 | "register") 44 | "Commands that can be passed to `hledger-jdo` function defined below.") 45 | 46 | (defcustom hledger-extra-args " " 47 | "Extra arguments included while running Hledger for reports, e.g. -S." 48 | :group 'hledger 49 | :type 'string) 50 | 51 | (defcustom hledger-top-asset-account "assets" 52 | "Top level assets acccount." 53 | :group 'hledger 54 | :type 'string) 55 | 56 | (defcustom hledger-top-expense-account "expenses" 57 | "Top level expense account." 58 | :group 'hledger 59 | :type 'string) 60 | 61 | (defcustom hledger-top-income-account "income" 62 | "Top level income account." 63 | :group 'hledger 64 | :type 'string) 65 | 66 | (defcustom hledger-year-of-birth 1992 67 | "Year in which you were born. 68 | Required for calculating your age." 69 | :group 'hledger 70 | :type 'number) 71 | 72 | (defcustom hledger-life-expectancy 80 73 | "Age upto which you expect to live." 74 | :group 'hledger 75 | :type 'number) 76 | 77 | (defcustom hledger-show-only-unstarred-p t 78 | "Show only the un-tainted entries. 79 | I taint entries with a star, to declare that they haven't been effective yet." 80 | :group 'hledger 81 | :type 'boolean) 82 | 83 | (defcustom hledger-show-expanded-report t 84 | "Show expanded account balances in running report." 85 | :group 'hledger 86 | :type 'boolean) 87 | 88 | (defcustom hledger-running-report-months 89 | 5 90 | "Number of months to show in the running report." 91 | :group 'hledger 92 | :type 'number) 93 | 94 | (defcustom hledger-daily-report-accounts 95 | "expenses" 96 | "Accounts for the daily report." 97 | :group 'hledger 98 | :type 'string) 99 | 100 | (defcustom hledger-ratios-assets-accounts 101 | "assets" 102 | "Account names for total assets." 103 | :group 'hledger 104 | :type 'string) 105 | 106 | (defcustom hledger-ratios-income-accounts 107 | "income" 108 | "Account names for total income so far." 109 | :group 'hledger 110 | :type 'string) 111 | 112 | (defcustom hledger-ratios-liquid-asset-accounts 113 | "assets:bank assets:wallet" 114 | "Account names [separated by spaces] that contain your liquid assets." 115 | :group 'hledger 116 | :type 'string) 117 | 118 | (defcustom hledger-ratios-essential-expense-accounts 119 | "expenses:housing expenses:eating expenses:family" 120 | "Account names [separated by spaces] that contain non-discretionary expenses." 121 | :group 'hledger 122 | :type 'string) 123 | 124 | (defcustom hledger-ratios-debt-accounts 125 | "liabilities" 126 | "Account names [separated by spaces] that are liabilities." 127 | :group 'hledger 128 | :type 'string) 129 | 130 | (defface hledger-report-header-face 131 | '((((class color) (background dark)) 132 | :foreground "Cornsilk" :height 1.1) 133 | (((class color) (background light)) 134 | :foreground "Black" :height 1.1) 135 | (t :inverse-video t)) 136 | "Face for the header with date ranges in the the reports." 137 | :group 'hledger) 138 | 139 | (defface hledger-overall-report-summary-text-face 140 | '((((class color) (background dark)) 141 | :foreground "Cornsilk" :height 1.0) 142 | (((class color) (background light)) 143 | :foreground "Black" :height 1.0) 144 | (t :inverse-video t)) 145 | "Face for the summary text in overall report." 146 | :group 'hledger) 147 | 148 | (defcustom hledger-account-balance-expand-face 149 | '(:foreground "Cornsilk" :background "DarkSlateGray") 150 | "Face for the expanded account names with their balances in current period." 151 | :group 'hledger 152 | :type 'face) 153 | 154 | (defcustom hledger-ratios-net-worth-in-next-x-years 155 | 5 156 | "Number of years for extrapolation of your net-worth." 157 | :group 'hledger 158 | :type 'number) 159 | 160 | (defcustom hledger-extrapolate-savings-rate 161 | 4.0 162 | "Rate of compound interest (in %) with which to extrapolate savings. 163 | This is the annual rate of compound interest. The bank may 164 | choose to do the componding quarterly. Configure 165 | `hledger-extrapolate-savings-period' for that." 166 | :group 'hledger 167 | :type 'float) 168 | 169 | (defcustom hledger-extrapolate-savings-period 170 | 4 171 | "Number of months at which the interest is compounded." 172 | :group 'hledger 173 | :type 'float) 174 | 175 | (defcustom hledger-width-spec 176 | '(100 . 40) 177 | "(# columns for the entry . # columns for description) for an entry." 178 | :group 'hledger 179 | :type 'string) 180 | 181 | (defvar hledger-last-run-command nil 182 | "Last run hledger-command.") 183 | 184 | (defvar hledger-last-run-time 0 185 | "Last month on which a command was run.") 186 | 187 | (defvar hledger-ratios-summary nil 188 | "Summary for the ratios in overall report.") 189 | 190 | (defun hledger-format-time (time) 191 | "Format TIME in \"%Y-%m-%d\"." 192 | (format-time-string "%Y-%m-%d" time)) 193 | 194 | (defun hledger-end-date (time) 195 | "Format TIME so that it can be used as an inclusive --end date." 196 | (let ((next-day (time-add time 197 | (days-to-time 1)))) 198 | (hledger-format-time next-day))) 199 | 200 | (defun hledger-friendlier-time (time) 201 | "Format TIME for the user to understand: %e %B %Y." 202 | (format-time-string "%e %B %Y" time)) 203 | 204 | (defun hledger-nth-of-mth-month (n m) 205 | "Return the Nth of the Mth month. Current month is the zeroth. 206 | 207 | Note: uses `calendar-increment-month' to go back and forth in 208 | time." 209 | (let* ((time-now (current-time)) 210 | (year-now (string-to-number (format-time-string "%Y" time-now))) 211 | (month-now (string-to-number (format-time-string "%m" time-now)))) 212 | (calendar-increment-month month-now year-now m) 213 | ;; Now, we want the Nth of month-now and year-now. 214 | (encode-time 0 0 0 n month-now year-now))) 215 | 216 | (defun hledger-nth-of-this-month (n) 217 | "Return the time value for the Nth day of the current month." 218 | (hledger-nth-of-mth-month n 0)) 219 | 220 | (defun hledger-nth-of-prev-month (n) 221 | "Return the Nth day's time for the previous month." 222 | (hledger-nth-of-mth-month n -1)) 223 | 224 | (defun hledger-beg-reporting-time () 225 | "Return the beginning day for monthly reports." 226 | (let ((today (string-to-number (format-time-string "%d")))) 227 | (if (< hledger-reporting-day today) 228 | (hledger-nth-of-this-month hledger-reporting-day) 229 | (hledger-nth-of-prev-month hledger-reporting-day)))) 230 | 231 | (defun hledger-end-reporting-time () 232 | "Return the end day for monthly reports." 233 | (let ((today (string-to-number (format-time-string "%d")))) 234 | (if (< hledger-reporting-day today) 235 | (hledger-nth-of-mth-month hledger-reporting-day 1) 236 | (hledger-nth-of-this-month hledger-reporting-day)))) 237 | 238 | (defun hledger-status (command-string) 239 | "Return the result of running COMMAND-STRING as a hledger command. 240 | 241 | If the command failed, returns a cons with the error status and 242 | the output to `standard-error' and `standard-output'." 243 | (with-temp-buffer 244 | (let ((status (call-process "hledger" 245 | nil 246 | t 247 | nil 248 | "-f" 249 | (shell-quote-argument hledger-jfile) 250 | command-string))) 251 | (if (= status 0) 252 | (buffer-string) 253 | ;; Error code and the error message 254 | (cons status (buffer-string)))))) 255 | 256 | (defun hledger-shell-command-to-string (command-string) 257 | "Return result of running hledger command COMMAND-STRING." 258 | (shell-command-to-string (concat "hledger -f " hledger-jfile " " 259 | command-string))) 260 | 261 | (defun hledger-ask-and-save-buffer () 262 | "Ask for saving modified buffer before any reporting commands." 263 | (if (and (eq major-mode 'hledger-mode) 264 | (buffer-modified-p) 265 | (yes-or-no-p (format "Save buffer %s? " 266 | (buffer-name)))) 267 | (save-buffer) 268 | (ignore))) 269 | 270 | (defun hledger-get-perfin-buffer (&optional keep-bufferp fetched-entriesp) 271 | "Get/create the `hledger-reporting-buffer-name' buffer. 272 | If the buffer is not intended for editing, then `q` closes it. 273 | `C-c y` copies the whole buffer to clipboard. FIXME: Query Emacs 274 | for the keys for the functions. 275 | 276 | Optional argument KEEP-BUFFERP 277 | if non-nil the `hledger-reporting-buffer-name' is re-used without 278 | erasing its contents. 279 | 280 | Optional argument FETCHED-ENTRIESP if 281 | non-nil, it lands us in the `hledger-mode' ." 282 | (let ((jbuffer (get-buffer-create hledger-reporting-buffer-name))) 283 | (with-current-buffer jbuffer 284 | (if fetched-entriesp 285 | (progn 286 | (hledger-mode)) 287 | (hledger-view-mode)) 288 | (or keep-bufferp (progn (delete-region (point-min) (point-max)) 289 | (delete-all-overlays)))) 290 | jbuffer)) 291 | 292 | ;;;###autoload 293 | (defun hledger-run-command (command) 294 | "Run an hledger COMMAND." 295 | (interactive (list (completing-read "jdo> " 296 | hledger-jcompletions))) 297 | ;; Help other functions keep track of history. 298 | (setq hledger-last-run-command command) 299 | (hledger-ask-and-save-buffer) 300 | (let ((inhibit-read-only t)) 301 | (pcase command 302 | (`"incomestatement" (hledger-monthly-incomestatement)) 303 | (`"daily" (hledger-daily-report)) 304 | (`"overall" (hledger-overall-report) 305 | (pop-to-buffer hledger-reporting-buffer-name) 306 | (delete-other-windows)) 307 | (`"balancesheet" (hledger-jdo (concat "balancesheet --end " 308 | (hledger-end-date (current-time))))) 309 | ;; Allow account completion for 310 | (command (if (and (member command '("balance" "register")) 311 | (called-interactively-p 'interactive)) 312 | (hledger-jdo-with-account-completion command) 313 | (hledger-jdo command))))) 314 | (when (called-interactively-p 'interactive) 315 | (setq hledger-last-run-time 0)) 316 | (pulse-momentary-highlight-region (point-min) 317 | (point-max) 318 | 'next-error)) 319 | 320 | (defun hledger-get-accounts (&optional string buffer) 321 | "Return list of account names with STRING infix present. 322 | STRING can be multiple words separated by a space." 323 | (let* ((dest-buffer (make-temp-name "hledger-output-")) 324 | (constant-args (list "-I" "-f" (if buffer "-" hledger-jfile) "accounts")) 325 | (full-args (if (null string) 326 | constant-args 327 | (append constant-args (list string)))) 328 | (exit-code (if buffer 329 | (with-current-buffer buffer 330 | (apply #'call-process-region nil nil "hledger" nil dest-buffer nil full-args)) 331 | (apply #'call-process "hledger" nil dest-buffer nil full-args))) 332 | (output (string-trim-right (with-current-buffer dest-buffer 333 | (buffer-string))))) 334 | (kill-buffer dest-buffer) 335 | (when (= exit-code 0) 336 | (split-string output "\n")))) 337 | 338 | (defun hledger-get-balances (accounts) 339 | "Return balances for the sequence of ACCOUNTS." 340 | (with-current-buffer (hledger-jdo (mapconcat 'identity 341 | (cons "balance -N" accounts) 342 | " ") 343 | nil t) 344 | (font-lock-ensure) 345 | (let* ((report-str* (buffer-substring (point-min) (point-max)))) 346 | (kill-buffer) 347 | report-str*))) 348 | 349 | (defun hledger-jdo (command &optional keep-bufferp bury-bufferp) 350 | "Run a hledger COMMAND on the journal file. 351 | Returns the buffer with the info inserted. 352 | 353 | If KEEP-BUFFERP is non-nil, it won't erase the old contents. New 354 | info would be prepended to the old one. 355 | 356 | If BURY-BUFFERP is t, the `hledger-reporting-buffer-name' buffer 357 | would not be showm to the user, this is user for using this 358 | function in elisp only for the buffer contents. 359 | 360 | The position of point remains unaltered after this function 361 | call. This is for letting the caller transform the output more 362 | easily." 363 | (let ((jbuffer (hledger-get-perfin-buffer keep-bufferp)) 364 | (jcommand (concat "hledger -f " 365 | (shell-quote-argument hledger-jfile) 366 | " " 367 | command 368 | hledger-extra-args))) 369 | (with-current-buffer jbuffer 370 | (let ((here (point))) 371 | (call-process-shell-command jcommand nil t nil) 372 | ;; Keep the pointer where it was before executing the hledger command 373 | (goto-char here)) 374 | (if bury-bufferp 375 | (bury-buffer jbuffer) 376 | (pop-to-buffer jbuffer) 377 | (delete-other-windows)) 378 | (setq header-line-format 379 | (format "Generated on: %s | %s" 380 | (hledger-friendlier-time (current-time)) 381 | (format-time-string "%A" (current-time))))) 382 | jbuffer)) 383 | 384 | (defun hledger-jdo-with-account-completion (command) 385 | "Run COMMAND with completions for account names." 386 | (let* ((crm-separator " ") 387 | (command-flags 388 | (completing-read-multiple (format "%s: " command) 389 | (mapcar (lambda (account) 390 | (concat account crm-separator)) 391 | (or hledger-accounts-cache 392 | (setq hledger-accounts-cache 393 | (hledger-get-accounts)))))) 394 | (command-string (mapconcat 'identity 395 | (cons command command-flags) 396 | " "))) 397 | (hledger-run-command command-string))) 398 | 399 | (defun hledger-jdo-redo-with (append-string) 400 | "Append APPEND-STRING to `hledger-last-run-command' and re-run." 401 | (hledger-run-command (format "%s%s" 402 | hledger-last-run-command 403 | append-string))) 404 | 405 | (defun hledger-redo () 406 | "Repeat the last command." 407 | (interactive) 408 | (hledger-jdo-redo-with "")) 409 | 410 | (defvar hledger--ic 0 411 | "Variable to track increments in width for register command.") 412 | (defun hledger-widen-results-for-register () 413 | "Widen the results of the last command. 414 | Works only for register command." 415 | (interactive) 416 | (if (not (string-prefix-p "register" hledger-last-run-command)) 417 | (setq hledger--ic 0) 418 | (setq hledger--ic (+ hledger--ic 4)) 419 | (hledger-run-command (format "%s --width %s,%s" 420 | hledger-last-run-command 421 | (+ (car hledger-width-spec) 422 | hledger--ic) 423 | (+ (cdr hledger-width-spec) 424 | (- hledger--ic 3)))))) 425 | 426 | (defun hledger-jreg (pattern) 427 | "Run hledger register command with PATTERN as argument." 428 | (interactive "spattern> ") 429 | (let ((jcmd (concat "register -w 150 " pattern))) 430 | (hledger-jdo jcmd) 431 | (delete-other-windows))) 432 | 433 | (defun hledger-daily-report () 434 | "Report for today's expenses. 435 | This is subject to change based on what things I am budgeting on. 436 | See `hledger-daily-report-accounts'." 437 | (interactive) 438 | (with-current-buffer (hledger-get-perfin-buffer) 439 | (let ((reporting-since (hledger-compute-last-reporting-time)) 440 | (beg-time-string (hledger-format-time (current-time))) 441 | (end-time-string (hledger-end-date (current-time))) 442 | (hledger-underliner (make-string 20 ?═))) 443 | (hledger-jdo (format "balance %s --begin %s --end %s" 444 | hledger-daily-report-accounts 445 | beg-time-string 446 | end-time-string)) 447 | (goto-char (point-min)) 448 | (insert (concat "Today you spent:\n" 449 | hledger-underliner 450 | "\n")) 451 | (goto-char (point-max)) 452 | (insert (concat "\n\nSince " 453 | (hledger-friendlier-time reporting-since) 454 | "\n" 455 | hledger-underliner 456 | "\n")) 457 | (let ((beg (point))) 458 | (hledger-jdo (format "balance %s --begin %s --end %s --depth 2 --flat" 459 | hledger-daily-report-accounts 460 | (hledger-format-time reporting-since) 461 | (hledger-end-date (current-time))) 462 | t) 463 | (goto-char (point-max)) 464 | (forward-line -3) 465 | (end-of-line) 466 | (ignore-errors 467 | (sort-numeric-fields 2 beg (point)) 468 | (reverse-region beg (point)))) 469 | (goto-char (point-min))))) 470 | 471 | (defun hledger-monthly-incomestatement (&optional hide-header-p) 472 | "Incomestatement report but monthly. 473 | You can have move back 474 | and forth in time in the personal finance buffer. I feel that the 475 | complete incomestatement isn't much useful for me. 476 | Optional argument HIDE-HEADER-P if non-nil, header line showing duration isn't shown." 477 | (interactive) 478 | (let* ((beg-time (hledger-beg-reporting-time)) 479 | (end-time (hledger-end-reporting-time)) 480 | (beg-time-string (hledger-format-time beg-time)) 481 | (end-time-string (hledger-format-time end-time))) 482 | (with-current-buffer (hledger-get-perfin-buffer) 483 | (when (not hide-header-p) 484 | (insert (hledger-generate-report-header beg-time end-time)) 485 | (forward-line 2)) 486 | (hledger-jdo (format "incomestatement --flat -b %s -e %s --depth 2" 487 | beg-time-string 488 | end-time-string) 489 | t) 490 | 491 | ;; Sort revenues | Ignore errors encountered during this. 492 | (ignore-errors (when (search-forward "Revenues:") 493 | (forward-line) 494 | (unless (looking-at "--") 495 | (let ((beg (point))) 496 | (while (not (looking-at "--")) 497 | (forward-line)) 498 | (sort-numeric-fields 2 beg (point)) 499 | (reverse-region beg (point)))))) 500 | ;; Same thing again. Need to abstract this sorting stuff. 501 | (ignore-errors (when (search-forward "Expenses:") 502 | (forward-line) 503 | (unless (looking-at "--") 504 | (let ((beg (point))) 505 | (while (not (looking-at "--")) 506 | (forward-line)) 507 | (sort-numeric-fields 2 beg (point)) 508 | (reverse-region beg (point)))))) 509 | (goto-char (point-max)) 510 | (insert "\n\n")))) 511 | 512 | (defun hledger-running-report (&optional keep-bufferp bury-bufferp) 513 | "Show the balance report for the past 5 months. 514 | 515 | If optional argument KEEP-BUFFERP is non-nil, the reporting buffer's 516 | old contents are kept intact. 517 | 518 | If optional argument BURY-BUFFERP is non-nil, does not switch to 519 | the reporting buffer." 520 | (interactive) 521 | (let* ((beg-time-string 522 | (hledger-format-time (hledger-nth-of-mth-month 523 | hledger-reporting-day 524 | (if (< (nth 3 525 | (decode-time (current-time))) 526 | hledger-reporting-day) 527 | (- hledger-running-report-months) 528 | (- 1 hledger-running-report-months))))) 529 | (end-time-string (hledger-format-time (hledger-end-reporting-time)))) 530 | (hledger-jdo (format "balance %s %s --depth 2 -A -p %s" 531 | hledger-top-expense-account 532 | hledger-top-income-account 533 | (shell-quote-argument 534 | (format "every %sth day of month from %s to %s" 535 | hledger-reporting-day 536 | beg-time-string 537 | end-time-string))) 538 | keep-bufferp 539 | bury-bufferp) 540 | (when (not bury-bufferp) 541 | ;; This is because the running report is usually very wide. 542 | (pop-to-buffer (hledger-get-perfin-buffer t)) 543 | (delete-other-windows)) 544 | (with-current-buffer (hledger-get-perfin-buffer t) 545 | ;; Let's sort according to the average column now 546 | (ignore-errors (while (not (looking-at "==")) 547 | (forward-line)) 548 | (forward-line) 549 | (let ((beg (point))) 550 | (while (not (looking-at "--")) 551 | (forward-line)) 552 | (sort-numeric-fields -1 beg (point)) 553 | (reverse-region beg (point)))) 554 | ;; Now adding the expanded Report with all accounts expanded. 555 | (when hledger-show-expanded-report 556 | (goto-char (point-max)) 557 | (insert "\nExpanded Running Report\n=======================\n\n") 558 | (hledger-jdo (format "balance %s %s --tree -A -p %s" 559 | hledger-top-expense-account 560 | hledger-top-asset-account 561 | (shell-quote-argument (format "every %sth day of month from %s to %s" 562 | hledger-reporting-day 563 | beg-time-string 564 | end-time-string))) 565 | t 566 | bury-bufferp))))) 567 | 568 | 569 | (defun hledger-compute-last-reporting-time () 570 | "Return the elapsed time since the report was last prepared." 571 | (let ((day (string-to-number (format-time-string "%d")))) 572 | (if (> day hledger-reporting-day) 573 | (hledger-nth-of-this-month hledger-reporting-day) 574 | (hledger-nth-of-prev-month hledger-reporting-day)))) 575 | 576 | 577 | (defun hledger-compute-total (accounts-string &optional beg end) 578 | "Computes the total for given accounts in ACCOUNTS-STRING. 579 | This function depends upon how `hledger-bin' prints data to the console. 580 | If that changes, things will break. BEG and END are dates." 581 | (or (lax-plist-get (hledger-compute-totals (list accounts-string) beg end) 582 | accounts-string) 583 | 0)) 584 | 585 | (defun hledger-compute-totals (accounts-list &optional beg end) 586 | "Computes the total for a list of accounts in ACCOUNTS-LIST. 587 | See `hledger-compute-total'. 588 | Optional argument BEG is the --begin date string for journal entries. 589 | Optional argument END is the --end date string for journal entries." 590 | (let* ((date-now (hledger-end-date (current-time))) 591 | (output (hledger-shell-command-to-string 592 | (concat " balance " 593 | (mapconcat 'identity accounts-list " ") 594 | (if beg (concat " --begin " beg) "") 595 | " --end " (or end date-now) 596 | " --depth 1" 597 | " --format " 598 | (shell-quote-argument "\"%(account)\" %(total) ")))) 599 | (elisp-string (concat "(" 600 | (replace-regexp-in-string 601 | (concat (regexp-quote hledger-currency-string) 602 | "\\|-") 603 | "" 604 | output) 605 | ")")) 606 | (result (car (read-from-string elisp-string)))) 607 | result)) 608 | 609 | (defun hledger-compute-years-to-retirement* (spending-ratio) 610 | "Given SPENDING-RATIO, find number of years to retirement. 611 | Configure `hledger-life-expectancy' and `hledger-year-of-birth' first. 612 | 613 | SPENDING-RATIO = 1 - savings-ratio 614 | 615 | The assumption is that you are going to keep spending the same 616 | fraction of your income even after you retire. This function 617 | doesn't take into account the current savings that you have 618 | accumulated so far." 619 | (let* ((this-year (nth 5 (decode-time (current-time)))) 620 | (age (- this-year hledger-year-of-birth))) 621 | ;; It's amazing how simple this equation is. It's like with my spending 622 | ;; ratio, I am spending the rest of my days. 623 | (* spending-ratio (- hledger-life-expectancy age)))) 624 | 625 | (defun hledger-compute-years-to-retirement (savings monthly-expenses savings-ratio) 626 | "Compute years to retirement with SAVINGS, MONTHLY-EXPENSES and SAVINGS-RATIO." 627 | (- (hledger-compute-years-to-retirement* (- 1 savings-ratio)) 628 | ;; Buying some years of my life with current savings 629 | (/ savings monthly-expenses 12.0))) 630 | 631 | (defun hledger-generate-ratios () 632 | "Computes various personal finance ratios: 633 | 634 | Computes the emergency fund ratio for the current month. 635 | EFR = (Current liquid assets)/(Monthly essential expenses) 636 | 637 | I consider expenses on housing, eating and family to be 638 | non-discretionary. Shoot for keeping it 6. Too high isn't 639 | efficient. Too low isn't safe. 640 | 641 | Computes the current ratio which gives you an estimate of how your current 642 | asset vs liability situation is. Current ratio = assets / liabilities 643 | 644 | Debt ratio = liabilities / assets 645 | 646 | Returns a plist of the ratios. 647 | 648 | Note: Currently this is extremely inefficient. It spawns hledger 649 | three times." 650 | (interactive) 651 | (let* ((reporting-date-an-year-ago (hledger-format-time (hledger-nth-of-mth-month 652 | hledger-reporting-day 653 | -12))) 654 | (reporting-date-now (hledger-end-date (hledger-end-reporting-time))) 655 | 656 | (totals-plist-1 (hledger-compute-totals 657 | (list hledger-ratios-assets-accounts 658 | hledger-ratios-income-accounts 659 | hledger-ratios-essential-expense-accounts) 660 | reporting-date-an-year-ago 661 | reporting-date-now)) 662 | 663 | ;; For average balances 664 | (total-income-accumulated-this-year 665 | (or (lax-plist-get totals-plist-1 666 | (hledger-get-top-level-acount hledger-ratios-income-accounts)) 667 | 0)) 668 | (total-essential-expenses-this-year 669 | (or (lax-plist-get totals-plist-1 670 | (hledger-get-top-level-acount hledger-ratios-essential-expense-accounts)) 671 | 0)) 672 | 673 | ;; For current balances 674 | (totals-plist-2 (hledger-compute-totals 675 | (list hledger-ratios-liquid-asset-accounts 676 | hledger-ratios-debt-accounts))) 677 | (liquid-assets 678 | (or (lax-plist-get totals-plist-2 679 | (hledger-get-top-level-acount hledger-ratios-liquid-asset-accounts)) 680 | 0)) 681 | (liabilities 682 | (or (lax-plist-get totals-plist-2 683 | (hledger-get-top-level-acount hledger-ratios-debt-accounts)) 684 | 0)) 685 | 686 | ;; For ther rest 687 | (total-assets (hledger-compute-total hledger-top-asset-account)) 688 | (total-expenses (hledger-compute-total hledger-top-expense-account 689 | reporting-date-an-year-ago 690 | reporting-date-now)) 691 | 692 | (monthly-total-expenses (/ total-expenses 12.0)) 693 | (monthly-essential-expenses (/ total-essential-expenses-this-year 12.0)) 694 | (monthly-income (/ total-income-accumulated-this-year 12.0)) 695 | (monthly-savings (- monthly-income monthly-total-expenses)) 696 | 697 | (savings-ratio (/ monthly-savings monthly-income)) 698 | (current-net-worth (- total-assets liabilities)) 699 | (years-to-retirement (hledger-compute-years-to-retirement current-net-worth 700 | monthly-total-expenses 701 | savings-ratio))) 702 | (list 'avg-income (* monthly-income 1.0) ;; Monthly income 703 | 'liquid-assets liquid-assets ;; Liquid\ 704 | 'total-assets total-assets ;; Total / Assets 705 | 'liabilities liabilities 706 | 'avg-expenses (* monthly-total-expenses 1.0) ;; Average expenses 707 | 'avg-monthly-savings monthly-savings ;; Average monthly savings 708 | 'total-assets total-assets ;; Total assets as of now 709 | 'current-net-worth current-net-worth ;; Current net worth 710 | 'efr (/ liquid-assets (* monthly-essential-expenses 1.0)) ;; Emergency-fund-ratio 711 | 'tfr (/ liquid-assets (* monthly-total-expenses 1.0)) ;; Total-fund ratio | Similar to efr. 712 | 'br (/ total-assets monthly-total-expenses) ;; Bankruptcy ratio 713 | 'cr (/ liquid-assets (* liabilities 1.0)) ;; Current ratio 714 | 'sr savings-ratio ;; Savings ratio 715 | 'ytr years-to-retirement ;; Years I will have to keep working for 716 | 'dr (/ liabilities (* total-assets 1.0))))) ;; Debt ratio 717 | 718 | (defun hledger-break-lines (s &optional separator width) 719 | "Add newline characters to string S. 720 | Optional parameter WIDTH decides the maximum width of a line." 721 | (let* ((width* (or width 80)) 722 | (init (seq-take s width*)) 723 | (end-index (string-match " [^ ]*$" init))) 724 | (if (and end-index ;; It's not a single word. 725 | (< width* (length s))) 726 | (concat (seq-take s end-index) 727 | (or separator "\n ") 728 | (hledger-break-lines (seq-drop s end-index))) 729 | s))) 730 | 731 | (defun hledger-compound-money (init periods periodic-rate) 732 | "Compound INIT amount for PERIODS units at PERIODIC-RATE. 733 | PERIODIC-RATE is a percentage." 734 | (* (or init 0) 735 | (expt (+ 1 (/ periodic-rate 100.0)) periods))) 736 | 737 | (defun hledger-extrapolate-monthly-savings (monthly-savings 738 | n 739 | &optional initial-sum) 740 | "Total savings with interest for MONTHLY-SAVINGS in N months. 741 | 742 | I live in India, where banks do compounding quarterly with an 743 | interest rate of 4.0% per year. Configure 744 | `hledger-extrapolate-savings-rate' and 745 | `hledger-extrapolate-savings-period' accordingly. 746 | 747 | Formula: Future value of an annuity = P ([(1 + r)^n - 1]/r). 748 | This assumes that the first payment comes at the end of first 749 | period. 750 | 751 | Optional argument INITIAL-SUM is the amount you have now. You will 752 | earn interest on this amount as well." 753 | (let* ((quarters (/ n 4.0)) 754 | (quarterly-rate% (/ hledger-extrapolate-savings-rate 4.0)) 755 | (quarterly-rate (/ quarterly-rate% 100.0)) 756 | (quarterly-savings (* monthly-savings 4.0))) 757 | ;; Initial sum 758 | (+ (hledger-compound-money initial-sum 759 | quarters 760 | quarterly-rate%) 761 | ;; Future value of Annuity 762 | (* quarterly-savings 763 | (/ (- (expt (+ 1.0 quarterly-rate) quarters) 1.0) 764 | quarterly-rate))))) 765 | 766 | (defun hledger-summarize-ratios (ratios) 767 | "Return a string summary of RATIOS." 768 | (let* ((tfr (plist-get ratios 'tfr)) 769 | (br (plist-get ratios 'br)) 770 | (cr (plist-get ratios 'cr)) 771 | (dr (plist-get ratios 'dr)) 772 | (sr (plist-get ratios 'sr)) 773 | (cnw (plist-get ratios 'current-net-worth)) 774 | (avg-monthly-savings (plist-get ratios 'avg-monthly-savings)) 775 | (extrapolated-savings 776 | (* 12 777 | hledger-ratios-net-worth-in-next-x-years 778 | avg-monthly-savings)) 779 | (extrapolated-net-worth (+ cnw 780 | extrapolated-savings)) 781 | (extrapolated-net-worth-with-compounding 782 | (hledger-extrapolate-monthly-savings avg-monthly-savings 783 | (* 12 hledger-ratios-net-worth-in-next-x-years) 784 | cnw)) 785 | (summary-string 786 | (format 787 | (concat 788 | (make-string 80 ?═) 789 | "\b • Your liquid assets would last %s and total assets %s with this lifestyle. \b\ 790 | • Your liquid assets are %.2f times your liabilities/debt. \b\ 791 | • %.2f%% of your total assets are borrowed. \b\ 792 | • For the past one year, you have been saving %.2f%% of your average income. \b\ 793 | • Your assets would roughly increase by %s %s in the next %s years making your net worth %s %s.\ 794 | If compounded every %s months at %s%% per annum, your net worth would become %s %s. \b" 795 | (make-string 80 ?═) "\n") 796 | ;; @TODO: Show a message asking the user to customize 'hledger 797 | ;; group 798 | (or (ignore-errors (hledger-humanize-float-months tfr)) 799 | "nan") 800 | (or (ignore-errors (hledger-humanize-float-months br)) 801 | "nan") 802 | cr 803 | (* dr 100.0) 804 | (* sr 100.0) 805 | hledger-currency-string 806 | (or (ignore-errors (hledger-group-digits (truncate extrapolated-savings))) 807 | "nan") 808 | hledger-ratios-net-worth-in-next-x-years 809 | hledger-currency-string 810 | (or (ignore-errors (hledger-group-digits (truncate extrapolated-net-worth))) 811 | "nan") 812 | hledger-extrapolate-savings-period 813 | hledger-extrapolate-savings-rate 814 | hledger-currency-string 815 | (or (ignore-errors 816 | (hledger-group-digits 817 | (truncate 818 | extrapolated-net-worth-with-compounding))) 819 | "nan")))) 820 | (mapconcat 'identity 821 | (mapcar 'hledger-break-lines (split-string summary-string "\b")) 822 | "\n"))) 823 | 824 | (defun hledger-overall-report () 825 | "A combination of all the relevant reports." 826 | (interactive) 827 | (message "Generating overall report...") 828 | (let ((inhibit-read-only t)) 829 | (hledger-monthly-incomestatement) 830 | (hledger-running-report t t) 831 | (with-current-buffer (hledger-get-perfin-buffer t) 832 | (let* ((ratios (hledger-generate-ratios)) 833 | (efr (plist-get ratios 'efr)) 834 | (cr (plist-get ratios 'cr)) 835 | (dr (plist-get ratios 'dr)) 836 | (sr (plist-get ratios 'sr)) 837 | 838 | (this-year (nth 5 (decode-time (current-time)))) 839 | (age (- this-year hledger-year-of-birth)) 840 | (ytr (plist-get ratios 'ytr)) 841 | (retiring-at (+ age ytr)) 842 | 843 | (avg-income (plist-get ratios 'avg-income)) 844 | (avg-expenses (plist-get ratios 'avg-expenses)) 845 | (liquid-assets (plist-get ratios 'liquid-assets)) 846 | (total-assets (plist-get ratios 'total-assets)) 847 | (liabilities (plist-get ratios 'liabilities)) 848 | (current-net-worth (plist-get ratios 'current-net-worth)) 849 | (summary (hledger-summarize-ratios ratios))) 850 | (goto-char (point-min)) 851 | (forward-line 2) 852 | (insert (format " 853 | ╔══════════════════════════════════════╦══════════════════════════════════════════╗ 854 | 855 | Emergency Fund Ratio: %-18.2fSavings Ratio: %.2f 856 | Current Ratio: %-25.2fAverage Income: %s %.0f/month 857 | Debt Ratio: %-28.2fAverage Expenses: %s %.0f/month 858 | ────────────────────────────────────────────────────────────────── 859 | Liquid Assets: %s %-23.2fTotal Assets: %s %.2f 860 | Liabilities: %s %-25.2fNet Worth: %s %.2f 861 | ────────────────────────────────────────────────────────────────── 862 | Years to retirement: %-19.0fRetiring at: %.0f 863 | Age:%-36.0fLife Expectancy: %.0f 864 | 865 | ╚══════════════════════════════════════╩══════════════════════════════════════════╝ 866 | 867 | %s 868 | " 869 | efr sr 870 | cr hledger-currency-string avg-income 871 | dr hledger-currency-string avg-expenses 872 | hledger-currency-string liquid-assets 873 | hledger-currency-string total-assets 874 | hledger-currency-string liabilities 875 | hledger-currency-string current-net-worth 876 | ytr 877 | retiring-at 878 | age 879 | hledger-life-expectancy 880 | (propertize summary 881 | 'font-lock-face 882 | 'hledger-overall-report-summary-text-face)))) 883 | (goto-char (point-min)) 884 | (message "Done!")))) 885 | 886 | (defun hledger-run-fn-for-month (m command) 887 | "Run for Mth month, hledger command string COMMAND." 888 | ;; This is the reason dynamic scoping is cool sometimes. 889 | (cl-letf (((symbol-function 'current-time) 890 | (let ((time (hledger-nth-of-mth-month 891 | hledger-reporting-day 892 | m))) 893 | `(lambda () ',time)))) 894 | (funcall command))) 895 | 896 | (defun hledger-run-fn-for-day (m command) 897 | "Run for Mth day relative to today, hledger command string COMMAND." 898 | (cl-letf (((symbol-function 'current-time) 899 | (let ((time (time-add 900 | (current-time) 901 | (days-to-time m)))) 902 | `(lambda () ',time)))) 903 | (funcall command))) 904 | 905 | (defun hledger-day-to-relative (day) 906 | "Return the number of days relative to today the given DAY represents." 907 | (- 908 | (time-to-days (date-to-time (concat day " 00:00:00"))) 909 | (time-to-days (current-time)))) 910 | 911 | (defun hledger-run-command-for-month (m command) 912 | "Run *hledger* command for month M where COMMAND is a string." 913 | (hledger-run-fn-for-month m (lambda () 914 | (hledger-run-command command)))) 915 | 916 | (defun hledger-run-command-for-day (m command) 917 | "Run *hledger* command for day M where COMMAND is a string." 918 | (hledger-run-fn-for-day m (lambda () 919 | (hledger-run-command command)))) 920 | 921 | (defun hledger-generate-report-header (beg-time end-time) 922 | "Generate report header with dates between times BEG-TIME and END-TIME." 923 | (let* ((header-dates (format "%s - %s" 924 | (format-time-string "%e %b %Y" beg-time) 925 | (format-time-string "%e %b %Y" end-time))) 926 | (header-title "Report : ") 927 | (header-filler (make-string (+ (length header-dates) 928 | (length header-title)) 929 | ?═))) 930 | (propertize (format "%s %s\n%s=\n\n" 931 | header-title 932 | header-dates 933 | header-filler) 934 | 'font-lock-face 'hledger-report-header-face))) 935 | 936 | (defun hledger-expand-account () 937 | "Expands account for the month according to `hledger-last-run-time'." 938 | (interactive) 939 | (if (equal hledger-last-run-command "daily") 940 | (hledger-run-fn-for-day hledger-last-run-time 941 | 'hledger-expand-account-for-this-month) 942 | (hledger-run-fn-for-month hledger-last-run-time 943 | 'hledger-expand-account-for-this-month))) 944 | 945 | (defun hledger-expand-account-for-this-month () 946 | "Expand the balance for account in the current line." 947 | (save-excursion 948 | (forward-line 0) 949 | (when (search-forward-regexp hledger-account-regex (line-end-position) t) 950 | (let* ((account (substring-no-properties (match-string 0))) 951 | (drop-count (length (split-string account ":"))) 952 | (beg-time (hledger-beg-reporting-time)) 953 | (end-time (hledger-end-reporting-time)) 954 | (beg-time-string (hledger-format-time beg-time)) 955 | (end-time-string (hledger-format-time end-time)) 956 | (balance-report (hledger-shell-command-to-string 957 | (format "balance %s --flat -b %s -e %s --drop %d -N" 958 | account 959 | beg-time-string 960 | end-time-string 961 | drop-count))) 962 | (text (propertize balance-report 963 | 'font-lock-face 964 | hledger-account-balance-expand-face))) 965 | (forward-line) 966 | (momentary-string-display text 967 | (point) 968 | ?\t 969 | ""))))) 970 | 971 | 972 | (defun hledger-prev-report () 973 | "Takes your current report back in time. 974 | To be called once you have run a report that sets `hledger-last-run-command'." 975 | (interactive) 976 | (hledger-report-at-day (1- hledger-last-run-time))) 977 | 978 | (defun hledger-next-report () 979 | "Takes your report forward in time. 980 | To be called once you have run a report that sets `hledger-last-run-command'." 981 | (interactive) 982 | (hledger-report-at-day (1+ hledger-last-run-time))) 983 | 984 | (defun hledger-report-at-day (day) 985 | "Takes your current report at the given DAY relative to today. 986 | To be called once you have run a report that sets `hledger-last-run-command'." 987 | (interactive (list (hledger-day-to-relative (org-read-date)))) 988 | (setq hledger-last-run-time day) 989 | (pcase hledger-last-run-command 990 | (`"daily" (hledger-run-command-for-day hledger-last-run-time 991 | hledger-last-run-command)) 992 | (`"balancesheet" (hledger-run-command-for-day 993 | hledger-last-run-time 994 | hledger-last-run-command)) 995 | (_ (hledger-run-command-for-month hledger-last-run-time 996 | hledger-last-run-command))) 997 | (pulse-momentary-highlight-region (point-min) 998 | (point-max) 999 | 'next-error)) 1000 | 1001 | (defun hledger-refresh-buffer () 1002 | "Hack to refresh current report using `hledger-prev-report'." 1003 | (interactive) 1004 | (let ((hledger-last-run-time (1+ hledger-last-run-time))) 1005 | (hledger-prev-report))) 1006 | 1007 | (defun hledger-report-ending-today () 1008 | "Refresh report showing balances till today. 1009 | Usually, the balance shown are upto the the last 1010 | `hledger-reporting-date' starting the same date of the previous month." 1011 | (interactive) 1012 | (let ((hledger-reporting-day (string-to-number (format-time-string "%d")))) 1013 | (hledger-refresh-buffer))) 1014 | 1015 | (defun hledger-present-report () 1016 | "Reset time for the current report. 1017 | See `hledger-prev-report'." 1018 | (interactive) 1019 | (setq hledger-last-run-time 0) 1020 | (pcase hledger-last-run-command 1021 | (`"daily" (hledger-run-command-for-day hledger-last-run-time 1022 | hledger-last-run-command)) 1023 | (_ (hledger-run-command-for-month hledger-last-run-time 1024 | hledger-last-run-command)))) 1025 | 1026 | (defun hledger-make-reporting-buffer-read-only () 1027 | "Make the `hledger-reporting-buffer-name' read-only." 1028 | (with-current-buffer (hledger-get-perfin-buffer t) 1029 | (set-text-properties (point-min) 1030 | (point-max) 1031 | '(read-only t front-sticky t)))) 1032 | 1033 | (defun hledger-get-top-level-acount (acc-string) 1034 | "Return the top level account as a symbol from ACC-STRING." 1035 | (car (split-string acc-string ":"))) 1036 | 1037 | (provide 'hledger-reports) 1038 | ;;; hledger-reports.el ends here 1039 | --------------------------------------------------------------------------------