ledger-commodities.el (6650B)
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 (if (string= (cadr c1) (cadr c2)) 99 (list (-(car c1) (car c2)) (cadr c1)) 100 (error "Can't subtract different commodities %S from %S" c2 c1))) 101 102 (defun ledger-add-commodity (c1 c2) 103 "Add C1 and C2, ensuring their commodities match." 104 (if (string= (cadr c1) (cadr c2)) 105 (list (+ (car c1) (car c2)) (cadr c1)) 106 (error "Can't add different commodities, %S to %S" c1 c2))) 107 108 (defun ledger-strip (str char) 109 "Return STR with CHAR removed." 110 (replace-regexp-in-string char "" str)) 111 112 (defun ledger-string-to-number (str &optional decimal-comma) 113 "Parse STR as a number and return that number. 114 115 Improves builtin `string-to-number' by handling 116 internationalization, and return nil if number can't be parsed. 117 See `ledger-environment-alist' for DECIMAL-COMMA." 118 (let ((nstr (if (or decimal-comma 119 (assoc "decimal-comma" ledger-environment-alist)) 120 (ledger-strip str "[.]") 121 (ledger-strip str ",")))) 122 (while (string-match "," nstr) ;if there is a comma now, it is a decimal point 123 (setq nstr (replace-match "." nil nil nstr))) 124 (string-to-number nstr))) 125 126 (defun ledger-number-to-string (n &optional decimal-comma) 127 "See `number-to-string' for N. 128 DECIMAL-COMMA is as documented in `ledger-environment-alist'." 129 (let ((str (number-to-string n))) 130 (when (or decimal-comma 131 (assoc "decimal-comma" ledger-environment-alist)) 132 (while (string-match "\\." str) 133 (setq str (replace-match "," nil nil str)))) 134 str)) 135 136 (defun ledger-commodity-to-string (c1) 137 "Return string representing C1. 138 Single character commodities are placed ahead of the value, 139 longer ones are after the value." 140 (let ((str (ledger-number-to-string (car c1))) 141 (commodity (cadr c1))) 142 (if (> (length commodity) 1) 143 (concat str " " commodity) 144 (concat commodity " " str)))) 145 146 (defun ledger-read-commodity-string (prompt) 147 "Read an amount from mini-buffer using PROMPT." 148 (let ((str (read-from-minibuffer 149 (concat prompt " (" ledger-reconcile-default-commodity "): "))) 150 comm) 151 (when (and (> (length str) 0) 152 (ledger-split-commodity-string str)) 153 (setq comm (ledger-split-commodity-string str)) 154 (if (cadr comm) 155 comm 156 (list (car comm) ledger-reconcile-default-commodity))))) 157 158 (provide 'ledger-commodities) 159 160 ;;; ledger-commodities.el ends here