ledger-commodities.el (6862B)
1 ;;; ledger-commodities.el --- Helper code for use with the "ledger" command-line tool -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2003-2016 John Wiegley (johnw AT gnu DOT org) 4 5 ;; This file is not part of GNU Emacs. 6 7 ;; This is free software; you can redistribute it and/or modify it under 8 ;; the terms of the GNU General Public License as published by the Free 9 ;; Software Foundation; either version 2, or (at your option) any later 10 ;; version. 11 ;; 12 ;; This is distributed in the hope that it will be useful, but WITHOUT 13 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 14 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 15 ;; for more details. 16 ;; 17 ;; You should have received a copy of the GNU General Public License 18 ;; along with GNU Emacs; see the file COPYING. If not, write to the 19 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, 20 ;; MA 02110-1301 USA. 21 22 ;;; Commentary: 23 ;; Helper functions to deal with commoditized numbers. A commoditized 24 ;; number will be a list of value and string where the string contains 25 ;; the commodity 26 27 ;;; Code: 28 29 (require 'ledger-regex) 30 31 ;; These keep the byte-compiler from warning about them, but have no other 32 ;; effect: 33 (defvar ledger-environment-alist) 34 (declare-function ledger-exec-ledger "ledger-exec" (input-buffer &optional output-buffer &rest args)) 35 36 (defcustom ledger-reconcile-default-commodity "$" 37 "The default commodity for use in target calculations in ledger reconcile." 38 :type 'string 39 :group 'ledger-reconcile) 40 41 (defun ledger-read-commodity-with-prompt (prompt) 42 "Read commodity name after PROMPT. 43 44 Default value is `ledger-reconcile-default-commodity'." 45 (let* ((buffer (current-buffer)) 46 (commodities (with-temp-buffer 47 (ledger-exec-ledger buffer (current-buffer) "commodities") 48 (split-string (buffer-string) "\n" t)))) 49 (completing-read prompt commodities nil t nil nil ledger-reconcile-default-commodity))) 50 51 (defun ledger-split-commodity-string (str) 52 "Split a commoditized string, STR, into two parts. 53 Returns a list with (value commodity)." 54 (let ((number-regex (if (assoc "decimal-comma" ledger-environment-alist) 55 ledger-amount-decimal-comma-regex 56 ledger-amount-decimal-period-regex))) 57 (if (> (length str) 0) 58 (with-temp-buffer 59 (insert str) 60 (goto-char (point-min)) 61 (cond 62 ((re-search-forward "\"\\(.*\\)\"" nil t) ; look for quoted commodities 63 (let ((com (delete-and-extract-region 64 (match-beginning 1) 65 (match-end 1)))) 66 (if (re-search-forward 67 number-regex nil t) 68 (list 69 (ledger-string-to-number 70 (delete-and-extract-region (match-beginning 0) (match-end 0))) 71 com)))) 72 ((re-search-forward number-regex nil t) 73 ;; found a number in the current locale, return it in the 74 ;; car. Anything left over is annotation, the first 75 ;; thing should be the commodity, separated by 76 ;; whitespace, return it in the cdr. I can't think of 77 ;; any counterexamples 78 (list 79 (ledger-string-to-number 80 (delete-and-extract-region (match-beginning 0) (match-end 0))) 81 (nth 0 (split-string (buffer-substring-no-properties (point-min) (point-max)))))) 82 ((re-search-forward "0" nil t) 83 ;; couldn't find a decimal number, look for a single 0, 84 ;; indicating account with zero balance 85 (list 0 ledger-reconcile-default-commodity)) 86 ;; nothing found, return 0 87 (t (list 0 ledger-reconcile-default-commodity))))))) 88 89 (defun ledger-string-balance-to-commoditized-amount (str) 90 "Return a commoditized amount (val, \"comm\") from STR." 91 ; break any balances with multi commodities into a list 92 (mapcar #'(lambda (st) 93 (ledger-split-commodity-string st)) 94 (split-string str "[\n\r]"))) 95 96 (defun ledger-subtract-commodity (c1 c2) 97 "Subtract C2 from C1, ensuring their commodities match. 98 99 As an exception, if the quantity of C2 is zero, C1 is returned 100 directly." 101 (cond 102 ((zerop (car c2)) c1) 103 ((string= (cadr c1) (cadr c2)) 104 (list (- (car c1) (car c2)) (cadr c1))) 105 (t (error "Can't subtract different commodities: %S - %S" c1 c2)))) 106 107 (defun ledger-add-commodity (c1 c2) 108 "Add C1 and C2, ensuring their commodities match. 109 110 As an exception, if the quantity of C2 is zero, C1 is returned 111 directly." 112 (cond 113 ((zerop (car c2)) c1) 114 ((string= (cadr c1) (cadr c2)) 115 (list (+ (car c1) (car c2)) (cadr c1))) 116 (t (error "Can't add different commodities: %S + %S" c1 c2)))) 117 118 (defun ledger-strip (str char) 119 "Return STR with CHAR removed." 120 (replace-regexp-in-string char "" str)) 121 122 (defun ledger-string-to-number (str &optional decimal-comma) 123 "Parse STR as a number and return that number. 124 125 Improves builtin `string-to-number' by handling 126 internationalization, and return nil if number can't be parsed. 127 See `ledger-environment-alist' for DECIMAL-COMMA." 128 (let ((nstr (if (or decimal-comma 129 (assoc "decimal-comma" ledger-environment-alist)) 130 (ledger-strip str "[.]") 131 (ledger-strip str ",")))) 132 (while (string-match "," nstr) ;if there is a comma now, it is a decimal point 133 (setq nstr (replace-match "." nil nil nstr))) 134 (string-to-number nstr))) 135 136 (defun ledger-number-to-string (n &optional decimal-comma) 137 "See `number-to-string' for N. 138 DECIMAL-COMMA is as documented in `ledger-environment-alist'." 139 (let ((str (number-to-string n))) 140 (when (or decimal-comma 141 (assoc "decimal-comma" ledger-environment-alist)) 142 (while (string-match "\\." str) 143 (setq str (replace-match "," nil nil str)))) 144 str)) 145 146 (defun ledger-commodity-to-string (c1) 147 "Return string representing C1. 148 Single character commodities are placed ahead of the value, 149 longer ones are after the value." 150 (let ((str (ledger-number-to-string (car c1))) 151 (commodity (cadr c1))) 152 (if (> (length commodity) 1) 153 (concat str " " commodity) 154 (concat commodity " " str)))) 155 156 (defun ledger-read-commodity-string (prompt) 157 "Read an amount from mini-buffer using PROMPT." 158 (let ((str (read-from-minibuffer 159 (concat prompt " (" ledger-reconcile-default-commodity "): "))) 160 comm) 161 (when (and (> (length str) 0) 162 (ledger-split-commodity-string str)) 163 (setq comm (ledger-split-commodity-string str)) 164 (if (cadr comm) 165 comm 166 (list (car comm) ledger-reconcile-default-commodity))))) 167 168 (provide 'ledger-commodities) 169 170 ;;; ledger-commodities.el ends here