1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
;;; ledger-commodities.el --- Helper code for use with the "ledger" command-line tool
;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org)
;; This file is not part of GNU Emacs.
;; This is free software; you can redistribute it and/or modify it under
;; the terms of the GNU General Public License as published by the Free
;; Software Foundation; either version 2, or (at your option) any later
;; version.
;;
;; This is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
;; for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA.
;;; Commentary:
;; Helper functions to deal with commoditized numbers. A commoditized
;; number will be a list of value and string where the string contains
;; the commodity
;;; Code:
(require 'ledger-regex)
(defcustom ledger-reconcile-default-commodity "$"
"The default commodity for use in target calculations in ledger reconcile."
:type 'string
:group 'ledger-reconcile)
(defcustom ledger-scale 10000
"The 10 ^ maximum number of digits you would expect to appear in your reports.
This is a cheap way of getting around floating point silliness in subtraction"
:group 'ledger)
(defun ledger-split-commodity-string (str)
"Split a commoditized string, STR, into two parts.
Returns a list with (value commodity)."
(let ((number-regex (if (assoc "decimal-comma" ledger-environment-alist)
ledger-amount-decimal-comma-regex
ledger-amount-decimal-period-regex)))
(if (> (length str) 0)
(with-temp-buffer
(insert str)
(goto-char (point-min))
(cond
((re-search-forward "\"\\(.*\\)\"" nil t) ; look for quoted commodities
(let ((com (delete-and-extract-region
(match-beginning 1)
(match-end 1))))
(if (re-search-forward
number-regex nil t)
(list
(ledger-string-to-number
(delete-and-extract-region (match-beginning 0) (match-end 0)))
com))))
((re-search-forward number-regex nil t)
;; found a number in the current locale, return it in the
;; car. Anything left over is annotation, the first
;; thing should be the commodity, separated by
;; whitespace, return it in the cdr. I can't think of
;; any counterexamples
(list
(ledger-string-to-number
(delete-and-extract-region (match-beginning 0) (match-end 0)))
(nth 0 (split-string (buffer-substring-no-properties (point-min) (point-max))))))
((re-search-forward "0" nil t)
;; couldn't find a decimal number, look for a single 0,
;; indicating account with zero balance
(list 0 ledger-reconcile-default-commodity))))
;; nothing found, return 0
(list 0 ledger-reconcile-default-commodity))))
(defun ledger-string-balance-to-commoditized-amount (str)
"Return a commoditized amount (val, 'comm') from STR."
; break any balances with multi commodities into a list
(mapcar #'(lambda (st)
(ledger-split-commodity-string st))
(split-string str "[\n\r]")))
(defun -commodity (c1 c2)
"Subtract C2 from C1, ensuring their commodities match."
(if (string= (cadr c1) (cadr c2))
; the scaling below is to get around inexact
; subtraction results where, for example 1.23
; - 4.56 = -3.3299999999999996 instead of
; -3.33
(list (/ (- (* ledger-scale (car c1)) (* ledger-scale (car c2))) ledger-scale) (cadr c1))
(error "Can't subtract different commodities %S from %S" c2 c1)))
(defun +commodity (c1 c2)
"Add C1 and C2, ensuring their commodities match."
(if (string= (cadr c1) (cadr c2))
(list (+ (car c1) (car c2)) (cadr c1))
(error "Can't add different commodities, %S to %S" c1 c2)))
(defun ledger-strip (str char)
(let (new-str)
(concat (dolist (ch (append str nil) new-str)
(unless (= ch char)
(setq new-str (append new-str (list ch))))))))
(defun ledger-string-to-number (str &optional decimal-comma)
"improve builtin string-to-number by handling internationalization, and return nil if number can't be parsed"
(let ((nstr (if (or decimal-comma
(assoc "decimal-comma" ledger-environment-alist))
(ledger-strip str ?.)
(ledger-strip str ?,))))
(while (string-match "," nstr) ;if there is a comma now, it is a thousands separator
(setq nstr (replace-match "." nil nil nstr)))
(string-to-number nstr)))
(defun ledger-number-to-string (n &optional decimal-comma)
(let ((str (number-to-string n)))
(when (or decimal-comma
(assoc "decimal-comma" ledger-environment-alist))
(while (string-match "\\." str)
(setq str (replace-match "," nil nil str))))
str))
(defun ledger-commodity-to-string (c1)
"Return string representing C1.
Single character commodities are placed ahead of the value,
longer ones are after the value."
(let ((str (ledger-number-to-string (car c1)))
(commodity (cadr c1)))
(if (> (length commodity) 1)
(concat str " " commodity)
(concat commodity " " str))))
(defun ledger-read-commodity-string (prompt)
(let ((str (read-from-minibuffer
(concat prompt " (" ledger-reconcile-default-commodity "): ")))
comm)
(if (and (> (length str) 0)
(ledger-split-commodity-string str))
(progn
(setq comm (ledger-split-commodity-string str))
(if (cadr comm)
comm
(list (car comm) ledger-reconcile-default-commodity))))))
(provide 'ledger-commodities)
;;; ledger-commodities.el ends here
|
