Bug 951, handle thousand separators.
Rewrote handling for decimal comma to be much simpler. Why can't I see the simple way first?
This commit is contained in:
Craig Earls
parent
b2c88149cb
commit
971bcf22f4
5 changed files with 290 additions and 268 deletions
|
|
@ -36,50 +36,47 @@
|
|||
(defun ledger-split-commodity-string (str)
|
||||
"Split a commoditized string, STR, into two parts.
|
||||
Returns a list with (value commodity)."
|
||||
(if (> (length str) 0)
|
||||
(let ((number-regex (if (assoc "decimal-comma" ledger-environment-alist)
|
||||
ledger-amount-decimal-comma-regex
|
||||
ledger-amount-decimal-period-regex)))
|
||||
(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
|
||||
(string-to-number
|
||||
(ledger-commodity-string-number-decimalize
|
||||
(delete-and-extract-region (match-beginning 0) (match-end 0)) :from-user))
|
||||
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
|
||||
(string-to-number
|
||||
(ledger-commodity-string-number-decimalize
|
||||
(delete-and-extract-region (match-beginning 0) (match-end 0)) :from-user))
|
||||
(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)))
|
||||
(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."
|
||||
(let ((fields (split-string str "[\n\r]"))) ; break any balances
|
||||
; with multi commodities
|
||||
; into a list
|
||||
(mapcar #'(lambda (str)
|
||||
(ledger-split-commodity-string str))
|
||||
fields)))
|
||||
; 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."
|
||||
|
|
@ -93,27 +90,53 @@ Returns a list with (value commodity)."
|
|||
(list (+ (car c1) (car c2)) (cadr c1))
|
||||
(error "Can't add different commodities, %S to %S" c1 c2)))
|
||||
|
||||
(defun ledger-commodity-string-number-decimalize (number-string direction)
|
||||
"Take NUMBER-STRING and ensure proper decimalization for use by string-to-number and number-to-string.
|
||||
(defun ledger-strip (str char)
|
||||
(let (new-str )
|
||||
|
||||
(dolist (ch (append str nil))
|
||||
(unless (= ch char)
|
||||
(setq new-str (append new-str (list ch)))))
|
||||
(concat new-str)))
|
||||
|
||||
DIRECTION can be :to-user or :from-user. All math calculations
|
||||
are done with decimal-period, some users may prefer decimal-comma
|
||||
which must be translated both directions."
|
||||
(let ((val number-string))
|
||||
(if (assoc "decimal-comma" ledger-environment-alist)
|
||||
(cond ((eq direction :from-user)
|
||||
;; change string to decimal-period
|
||||
(while (string-match "," val)
|
||||
(setq val (replace-match "." nil nil val)))) ;; switch to period separator
|
||||
((eq direction :to-user)
|
||||
;; change to decimal-comma
|
||||
(while (string-match "\\." val)
|
||||
(setq val (replace-match "," nil nil val)))) ;; gets rid of periods
|
||||
(t
|
||||
(error "ledger-commodity-string-number-decimalize: direction not properly specified %S" direction)))
|
||||
(while (string-match "," val)
|
||||
(setq val (replace-match "" nil nil val))))
|
||||
val))
|
||||
(defun ledger-string-to-number (str &optional decimal-comma)
|
||||
"improve builtin string-to-number by handling internationalization, and return nil of 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)
|
||||
(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)))
|
||||
(if (or decimal-comma
|
||||
(assoc "decimal-comma" ledger-environment-alist))
|
||||
(while (string-match "\\." str)
|
||||
(setq str (replace-match "," nil nil str)))
|
||||
str)))
|
||||
|
||||
;; (defun ledger-commodity-string-number-decimalize (number-string direction)
|
||||
;; "Take NUMBER-STRING and ensure proper decimalization for use by string-to-number and number-to-string.
|
||||
|
||||
;; DIRECTION can be :to-user or :from-user. All math calculations
|
||||
;; are done with decimal-period, some users may prefer decimal-comma
|
||||
;; which must be translated both directions."
|
||||
;; (let ((val number-string))
|
||||
;; (if (assoc "decimal-comma" ledger-environment-alist)
|
||||
;; (cond ((eq direction :from-user)
|
||||
;; ;; change string to decimal-period
|
||||
;; (while (string-match "," val)
|
||||
;; (setq val (replace-match "." nil nil val)))) ;; switch to period separator
|
||||
;; ((eq direction :to-user)
|
||||
;; ;; change to decimal-comma
|
||||
;; (while (string-match "\\." val)
|
||||
;; (setq val (replace-match "," nil nil val)))) ;; gets rid of periods
|
||||
;; (t
|
||||
;; (error "ledger-commodity-string-number-decimalize: direction not properly specified %S" direction)))
|
||||
;; (while (string-match "," val)
|
||||
;; (setq val (replace-match "" nil nil val))))
|
||||
;; val))
|
||||
|
||||
|
||||
|
||||
|
|
@ -121,12 +144,11 @@ which must be translated both directions."
|
|||
"Return string representing C1.
|
||||
Single character commodities are placed ahead of the value,
|
||||
longer ones are after the value."
|
||||
(let ((val (ledger-commodity-string-number-decimalize
|
||||
(number-to-string (car c1)) :to-user))
|
||||
(commodity (cadr c1)))
|
||||
(let ((str (ledger-number-to-string (car c1)))
|
||||
(commodity (cadr c1)))
|
||||
(if (> (length commodity) 1)
|
||||
(concat val " " commodity)
|
||||
(concat commodity " " val))))
|
||||
(concat str " " commodity)
|
||||
(concat commodity " " str))))
|
||||
|
||||
(defun ledger-read-commodity-string (prompt)
|
||||
(let ((str (read-from-minibuffer
|
||||
|
|
|
|||
|
|
@ -217,7 +217,7 @@ BEG, END, and LEN control how far it can align."
|
|||
(let ((end-of-amount (re-search-forward "[-.,0-9]+" (line-end-position) t)))
|
||||
;; determine if there is an amount to edit
|
||||
(if end-of-amount
|
||||
(let ((val (ledger-commodity-string-number-decimalize (match-string 0) :from-user)))
|
||||
(let ((val (ledger-string-to-number (match-string 0))))
|
||||
(goto-char (match-beginning 0))
|
||||
(delete-region (match-beginning 0) (match-end 0))
|
||||
(calc)
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@
|
|||
(defvar ledger-target nil)
|
||||
|
||||
(defgroup ledger-reconcile nil
|
||||
"Options for Ledger-mode reconciliation"
|
||||
"Options for Ledger-mode reconciliation"
|
||||
:group 'ledger)
|
||||
|
||||
(defcustom ledger-recon-buffer-name "*Reconcile*"
|
||||
|
|
@ -59,8 +59,8 @@ Then that transaction will be shown in its source buffer."
|
|||
(defcustom ledger-reconcile-toggle-to-pending t
|
||||
"If true then toggle between uncleared and pending.
|
||||
reconcile-finish will mark all pending posting cleared."
|
||||
:type 'boolean
|
||||
:group 'ledger-reconcile)
|
||||
:type 'boolean
|
||||
:group 'ledger-reconcile)
|
||||
|
||||
(defcustom ledger-reconcile-default-date-format "%Y/%m/%d"
|
||||
"Default date format for the reconcile buffer"
|
||||
|
|
@ -85,10 +85,10 @@ reconcile-finish will mark all pending posting cleared."
|
|||
;; split arguments like the shell does, so you need to
|
||||
;; specify the individual fields in the command line.
|
||||
(if (ledger-exec-ledger buffer (current-buffer)
|
||||
"balance" "--limit" "cleared or pending" "--empty" "--collapse"
|
||||
"--format" "%(display_total)" account)
|
||||
(ledger-split-commodity-string
|
||||
(buffer-substring-no-properties (point-min) (point-max))))))
|
||||
"balance" "--limit" "cleared or pending" "--empty" "--collapse"
|
||||
"--format" "%(display_total)" account)
|
||||
(ledger-split-commodity-string
|
||||
(buffer-substring-no-properties (point-min) (point-max))))))
|
||||
|
||||
(defun ledger-display-balance ()
|
||||
"Display the cleared-or-pending balance.
|
||||
|
|
@ -96,12 +96,12 @@ And calculate the target-delta of the account being reconciled."
|
|||
(interactive)
|
||||
(let* ((pending (ledger-reconcile-get-cleared-or-pending-balance ledger-buf ledger-acct)))
|
||||
(when pending
|
||||
(if ledger-target
|
||||
(message "Pending balance: %s, Difference from target: %s"
|
||||
(ledger-commodity-to-string pending)
|
||||
(ledger-commodity-to-string (-commodity ledger-target pending)))
|
||||
(message "Pending balance: %s"
|
||||
(ledger-commodity-to-string pending))))))
|
||||
(if ledger-target
|
||||
(message "Pending balance: %s, Difference from target: %s"
|
||||
(ledger-commodity-to-string pending)
|
||||
(ledger-commodity-to-string (-commodity ledger-target pending)))
|
||||
(message "Pending balance: %s"
|
||||
(ledger-commodity-to-string pending))))))
|
||||
|
||||
(defun is-stdin (file)
|
||||
"True if ledger FILE is standard input."
|
||||
|
|
@ -125,27 +125,27 @@ And calculate the target-delta of the account being reconciled."
|
|||
status)
|
||||
(when (ledger-reconcile-get-buffer where)
|
||||
(with-current-buffer (ledger-reconcile-get-buffer where)
|
||||
(ledger-goto-line (cdr where))
|
||||
(forward-char)
|
||||
(setq status (ledger-toggle-current (if ledger-reconcile-toggle-to-pending
|
||||
'pending
|
||||
'cleared))))
|
||||
;; remove the existing face and add the new face
|
||||
(ledger-goto-line (cdr where))
|
||||
(forward-char)
|
||||
(setq status (ledger-toggle-current (if ledger-reconcile-toggle-to-pending
|
||||
'pending
|
||||
'cleared))))
|
||||
;; remove the existing face and add the new face
|
||||
(remove-text-properties (line-beginning-position)
|
||||
(line-end-position)
|
||||
(list 'face))
|
||||
(line-end-position)
|
||||
(list 'face))
|
||||
(cond ((eq status 'pending)
|
||||
(add-text-properties (line-beginning-position)
|
||||
(line-end-position)
|
||||
(list 'face 'ledger-font-reconciler-pending-face )))
|
||||
((eq status 'cleared)
|
||||
(add-text-properties (line-beginning-position)
|
||||
(line-end-position)
|
||||
(list 'face 'ledger-font-reconciler-cleared-face )))
|
||||
(t
|
||||
(add-text-properties (line-beginning-position)
|
||||
(line-end-position)
|
||||
(list 'face 'ledger-font-reconciler-uncleared-face )))))
|
||||
(add-text-properties (line-beginning-position)
|
||||
(line-end-position)
|
||||
(list 'face 'ledger-font-reconciler-pending-face )))
|
||||
((eq status 'cleared)
|
||||
(add-text-properties (line-beginning-position)
|
||||
(line-end-position)
|
||||
(list 'face 'ledger-font-reconciler-cleared-face )))
|
||||
(t
|
||||
(add-text-properties (line-beginning-position)
|
||||
(line-end-position)
|
||||
(list 'face 'ledger-font-reconciler-uncleared-face )))))
|
||||
(forward-line)
|
||||
(beginning-of-line)
|
||||
(ledger-display-balance)))
|
||||
|
|
@ -157,18 +157,18 @@ Return the number of uncleared xacts found."
|
|||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(prog1
|
||||
(ledger-do-reconcile)
|
||||
(ledger-do-reconcile)
|
||||
(set-buffer-modified-p t))))
|
||||
|
||||
(defun ledger-reconcile-refresh-after-save ()
|
||||
"Refresh the recon-window after the ledger buffer is saved."
|
||||
(let ((curbuf (current-buffer))
|
||||
(curpoint (point))
|
||||
(recon-buf (get-buffer ledger-recon-buffer-name)))
|
||||
(curpoint (point))
|
||||
(recon-buf (get-buffer ledger-recon-buffer-name)))
|
||||
(when (buffer-live-p recon-buf)
|
||||
(with-current-buffer recon-buf
|
||||
(ledger-reconcile-refresh)
|
||||
(set-buffer-modified-p nil))
|
||||
(ledger-reconcile-refresh)
|
||||
(set-buffer-modified-p nil))
|
||||
(select-window (get-buffer-window curbuf))
|
||||
(goto-char curpoint))))
|
||||
|
||||
|
|
@ -198,19 +198,19 @@ Return the number of uncleared xacts found."
|
|||
(progn
|
||||
(beginning-of-line)
|
||||
(let* ((where (get-text-property (1+ (point)) 'where))
|
||||
(target-buffer (if where
|
||||
(ledger-reconcile-get-buffer where)
|
||||
nil))
|
||||
(cur-buf (get-buffer ledger-recon-buffer-name)))
|
||||
(target-buffer (if where
|
||||
(ledger-reconcile-get-buffer where)
|
||||
nil))
|
||||
(cur-buf (get-buffer ledger-recon-buffer-name)))
|
||||
(when target-buffer
|
||||
(switch-to-buffer-other-window target-buffer)
|
||||
(ledger-goto-line (cdr where))
|
||||
(forward-char)
|
||||
(recenter)
|
||||
(ledger-highlight-xact-under-point)
|
||||
(forward-char -1)
|
||||
(if come-back
|
||||
(switch-to-buffer-other-window cur-buf))))))
|
||||
(switch-to-buffer-other-window target-buffer)
|
||||
(ledger-goto-line (cdr where))
|
||||
(forward-char)
|
||||
(recenter)
|
||||
(ledger-highlight-xact-under-point)
|
||||
(forward-char -1)
|
||||
(if come-back
|
||||
(switch-to-buffer-other-window cur-buf))))))
|
||||
|
||||
(defun ledger-reconcile-save ()
|
||||
"Save the ledger buffer."
|
||||
|
|
@ -218,7 +218,7 @@ Return the number of uncleared xacts found."
|
|||
(let ((curpoint (point)))
|
||||
(dolist (buf (cons ledger-buf ledger-bufs))
|
||||
(with-current-buffer buf
|
||||
(save-buffer)))
|
||||
(save-buffer)))
|
||||
(with-current-buffer (get-buffer ledger-recon-buffer-name)
|
||||
(set-buffer-modified-p nil)
|
||||
(ledger-display-balance)
|
||||
|
|
@ -247,84 +247,84 @@ and exit reconcile mode"
|
|||
"Quit the reconcile window without saving ledger buffer."
|
||||
(interactive)
|
||||
(let ((recon-buf (get-buffer ledger-recon-buffer-name))
|
||||
buf)
|
||||
buf)
|
||||
(if recon-buf
|
||||
(with-current-buffer recon-buf
|
||||
(ledger-reconcile-quit-cleanup)
|
||||
(setq buf ledger-buf)
|
||||
;; Make sure you delete the window before you delete the buffer,
|
||||
;; otherwise, madness ensues
|
||||
(delete-window (get-buffer-window recon-buf))
|
||||
(kill-buffer recon-buf)
|
||||
(set-window-buffer (selected-window) buf)))))
|
||||
(with-current-buffer recon-buf
|
||||
(ledger-reconcile-quit-cleanup)
|
||||
(setq buf ledger-buf)
|
||||
;; Make sure you delete the window before you delete the buffer,
|
||||
;; otherwise, madness ensues
|
||||
(delete-window (get-buffer-window recon-buf))
|
||||
(kill-buffer recon-buf)
|
||||
(set-window-buffer (selected-window) buf)))))
|
||||
|
||||
(defun ledger-reconcile-quit-cleanup ()
|
||||
"Cleanup all hooks established by reconcile mode."
|
||||
(interactive)
|
||||
(let ((buf ledger-buf))
|
||||
(if (buffer-live-p buf)
|
||||
(with-current-buffer buf
|
||||
(remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t)
|
||||
(when ledger-narrow-on-reconcile
|
||||
(ledger-occur-quit-buffer buf)
|
||||
(ledger-highlight-xact-under-point))))))
|
||||
(with-current-buffer buf
|
||||
(remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t)
|
||||
(when ledger-narrow-on-reconcile
|
||||
(ledger-occur-quit-buffer buf)
|
||||
(ledger-highlight-xact-under-point))))))
|
||||
|
||||
(defun ledger-marker-where-xact-is (emacs-xact posting)
|
||||
"Find the position of the EMACS-XACT in the `ledger-buf'.
|
||||
POSTING is used in `ledger-clear-whole-transactions' is nil."
|
||||
(let ((buf (if (is-stdin (nth 0 emacs-xact))
|
||||
ledger-buf
|
||||
(find-file-noselect (nth 0 emacs-xact)))))
|
||||
ledger-buf
|
||||
(find-file-noselect (nth 0 emacs-xact)))))
|
||||
(cons
|
||||
buf
|
||||
(if ledger-clear-whole-transactions
|
||||
(nth 1 emacs-xact) ;; return line-no of xact
|
||||
(nth 0 posting))))) ;; return line-no of posting
|
||||
(nth 1 emacs-xact) ;; return line-no of xact
|
||||
(nth 0 posting))))) ;; return line-no of posting
|
||||
|
||||
(defun ledger-do-reconcile ()
|
||||
"Return the number of uncleared transactions in the account and display them in the *Reconcile* buffer."
|
||||
(let* ((buf ledger-buf)
|
||||
(account ledger-acct)
|
||||
(ledger-success nil)
|
||||
(ledger-success nil)
|
||||
(xacts
|
||||
(with-temp-buffer
|
||||
(when (ledger-exec-ledger buf (current-buffer)
|
||||
"--uncleared" "--real" "emacs" account)
|
||||
(setq ledger-success t)
|
||||
(goto-char (point-min))
|
||||
(unless (eobp)
|
||||
(if (looking-at "(")
|
||||
(read (current-buffer)))))))) ;current-buffer is the *temp* created above
|
||||
(when (ledger-exec-ledger buf (current-buffer)
|
||||
"--uncleared" "--real" "emacs" account)
|
||||
(setq ledger-success t)
|
||||
(goto-char (point-min))
|
||||
(unless (eobp)
|
||||
(if (looking-at "(")
|
||||
(read (current-buffer)))))))) ;current-buffer is the *temp* created above
|
||||
(if (and ledger-success (> (length xacts) 0))
|
||||
(let ((date-format (cdr (assoc "date-format" ledger-environment-alist))))
|
||||
(dolist (xact xacts)
|
||||
(dolist (posting (nthcdr 5 xact))
|
||||
(let ((beg (point))
|
||||
(where (ledger-marker-where-xact-is xact posting)))
|
||||
(insert (format "%s %-4s %-30s %-30s %15s\n"
|
||||
(format-time-string (if date-format
|
||||
date-format
|
||||
ledger-reconcile-default-date-format) (nth 2 xact))
|
||||
(if (nth 3 xact)
|
||||
(nth 3 xact)
|
||||
"")
|
||||
(nth 4 xact) (nth 1 posting) (nth 2 posting)))
|
||||
(if (nth 3 posting)
|
||||
(if (eq (nth 3 posting) 'pending)
|
||||
(set-text-properties beg (1- (point))
|
||||
(list 'face 'ledger-font-reconciler-pending-face
|
||||
'where where))
|
||||
(set-text-properties beg (1- (point))
|
||||
(list 'face 'ledger-font-reconciler-cleared-face
|
||||
'where where)))
|
||||
(set-text-properties beg (1- (point))
|
||||
(list 'face 'ledger-font-reconciler-uncleared-face
|
||||
'where where)))) ))
|
||||
(goto-char (point-max))
|
||||
(delete-char -1)) ;gets rid of the extra line feed at the bottom of the list
|
||||
(if ledger-success
|
||||
(insert (concat "There are no uncleared entries for " account))
|
||||
(insert "Ledger has reported a problem. Check *Ledger Error* buffer.")))
|
||||
(let ((date-format (cdr (assoc "date-format" ledger-environment-alist))))
|
||||
(dolist (xact xacts)
|
||||
(dolist (posting (nthcdr 5 xact))
|
||||
(let ((beg (point))
|
||||
(where (ledger-marker-where-xact-is xact posting)))
|
||||
(insert (format "%s %-4s %-30s %-30s %15s\n"
|
||||
(format-time-string (if date-format
|
||||
date-format
|
||||
ledger-reconcile-default-date-format) (nth 2 xact))
|
||||
(if (nth 3 xact)
|
||||
(nth 3 xact)
|
||||
"")
|
||||
(nth 4 xact) (nth 1 posting) (nth 2 posting)))
|
||||
(if (nth 3 posting)
|
||||
(if (eq (nth 3 posting) 'pending)
|
||||
(set-text-properties beg (1- (point))
|
||||
(list 'face 'ledger-font-reconciler-pending-face
|
||||
'where where))
|
||||
(set-text-properties beg (1- (point))
|
||||
(list 'face 'ledger-font-reconciler-cleared-face
|
||||
'where where)))
|
||||
(set-text-properties beg (1- (point))
|
||||
(list 'face 'ledger-font-reconciler-uncleared-face
|
||||
'where where)))) ))
|
||||
(goto-char (point-max))
|
||||
(delete-char -1)) ;gets rid of the extra line feed at the bottom of the list
|
||||
(if ledger-success
|
||||
(insert (concat "There are no uncleared entries for " account))
|
||||
(insert "Ledger has reported a problem. Check *Ledger Error* buffer.")))
|
||||
(goto-char (point-min))
|
||||
(set-buffer-modified-p nil)
|
||||
(toggle-read-only t)
|
||||
|
|
@ -338,30 +338,30 @@ ledger buffer is at the bottom of the main window. The key to
|
|||
this is to ensure the window is selected when the buffer point is
|
||||
moved and recentered. If they aren't strange things happen."
|
||||
|
||||
(let ((recon-window (get-buffer-window (get-buffer ledger-recon-buffer-name))))
|
||||
(when recon-window
|
||||
(fit-window-to-buffer recon-window)
|
||||
(with-current-buffer buf
|
||||
(add-hook 'kill-buffer-hook 'ledger-reconcile-quit nil t)
|
||||
(if (get-buffer-window buf)
|
||||
(select-window (get-buffer-window buf)))
|
||||
(goto-char (point-max))
|
||||
(recenter -1))
|
||||
(select-window recon-window)
|
||||
(ledger-reconcile-visit t))
|
||||
(add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t)))
|
||||
(let ((recon-window (get-buffer-window (get-buffer ledger-recon-buffer-name))))
|
||||
(when recon-window
|
||||
(fit-window-to-buffer recon-window)
|
||||
(with-current-buffer buf
|
||||
(add-hook 'kill-buffer-hook 'ledger-reconcile-quit nil t)
|
||||
(if (get-buffer-window buf)
|
||||
(select-window (get-buffer-window buf)))
|
||||
(goto-char (point-max))
|
||||
(recenter -1))
|
||||
(select-window recon-window)
|
||||
(ledger-reconcile-visit t))
|
||||
(add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t)))
|
||||
|
||||
(defun ledger-reconcile-track-xact ()
|
||||
"Force the ledger buffer to recenter on the transaction at point in the reconcile buffer."
|
||||
(if (and ledger-buffer-tracks-reconcile-buffer
|
||||
(member this-command (list 'next-line
|
||||
'previous-line
|
||||
'mouse-set-point
|
||||
'ledger-reconcile-toggle
|
||||
'end-of-buffer
|
||||
'beginning-of-buffer)))
|
||||
(member this-command (list 'next-line
|
||||
'previous-line
|
||||
'mouse-set-point
|
||||
'ledger-reconcile-toggle
|
||||
'end-of-buffer
|
||||
'beginning-of-buffer)))
|
||||
(save-excursion
|
||||
(ledger-reconcile-visit t))))
|
||||
(ledger-reconcile-visit t))))
|
||||
|
||||
(defun ledger-reconcile-open-windows (buf rbuf)
|
||||
"Ensure that the ledger buffer BUF is split by RBUF."
|
||||
|
|
@ -374,39 +374,39 @@ moved and recentered. If they aren't strange things happen."
|
|||
"Start reconciling, prompt for account."
|
||||
(interactive)
|
||||
(let ((account (ledger-read-account-with-prompt "Account to reconcile"))
|
||||
(buf (current-buffer))
|
||||
(buf (current-buffer))
|
||||
(rbuf (get-buffer ledger-recon-buffer-name)))
|
||||
;; this means only one *Reconcile* buffer, ever Set up the
|
||||
;; reconcile buffer
|
||||
(if rbuf ;; *Reconcile* already exists
|
||||
(with-current-buffer rbuf
|
||||
(set 'ledger-acct account) ;; already buffer local
|
||||
(when (not (eq buf rbuf))
|
||||
;; called from some other ledger-mode buffer
|
||||
(ledger-reconcile-quit-cleanup)
|
||||
(set 'ledger-buf buf)) ;; should already be buffer-local
|
||||
(with-current-buffer rbuf
|
||||
(set 'ledger-acct account) ;; already buffer local
|
||||
(when (not (eq buf rbuf))
|
||||
;; called from some other ledger-mode buffer
|
||||
(ledger-reconcile-quit-cleanup)
|
||||
(set 'ledger-buf buf)) ;; should already be buffer-local
|
||||
|
||||
(unless (get-buffer-window rbuf)
|
||||
(ledger-reconcile-open-windows buf rbuf)))
|
||||
(unless (get-buffer-window rbuf)
|
||||
(ledger-reconcile-open-windows buf rbuf)))
|
||||
|
||||
;; no recon-buffer, starting from scratch.
|
||||
(add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t)
|
||||
;; no recon-buffer, starting from scratch.
|
||||
(add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t)
|
||||
|
||||
(with-current-buffer (setq rbuf
|
||||
(get-buffer-create ledger-recon-buffer-name))
|
||||
(ledger-reconcile-open-windows buf rbuf)
|
||||
(ledger-reconcile-mode)
|
||||
(make-local-variable 'ledger-target)
|
||||
(set (make-local-variable 'ledger-buf) buf)
|
||||
(set (make-local-variable 'ledger-acct) account)))
|
||||
(with-current-buffer (setq rbuf
|
||||
(get-buffer-create ledger-recon-buffer-name))
|
||||
(ledger-reconcile-open-windows buf rbuf)
|
||||
(ledger-reconcile-mode)
|
||||
(make-local-variable 'ledger-target)
|
||||
(set (make-local-variable 'ledger-buf) buf)
|
||||
(set (make-local-variable 'ledger-acct) account)))
|
||||
|
||||
;; Narrow the ledger buffer
|
||||
(with-current-buffer rbuf
|
||||
(save-excursion
|
||||
(if ledger-narrow-on-reconcile
|
||||
(ledger-occur-mode account ledger-buf)))
|
||||
(if ledger-narrow-on-reconcile
|
||||
(ledger-occur-mode account ledger-buf)))
|
||||
(if (> (ledger-reconcile-refresh) 0)
|
||||
(ledger-reconcile-change-target))
|
||||
(ledger-reconcile-change-target))
|
||||
(ledger-display-balance))))
|
||||
|
||||
(defvar ledger-reconcile-mode-abbrev-table)
|
||||
|
|
@ -417,45 +417,45 @@ moved and recentered. If they aren't strange things happen."
|
|||
(setq ledger-target (ledger-read-commodity-string ledger-reconcile-target-prompt-string)))
|
||||
|
||||
(define-derived-mode ledger-reconcile-mode text-mode "Reconcile"
|
||||
"A mode for reconciling ledger entries."
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map [(control ?m)] 'ledger-reconcile-visit)
|
||||
(define-key map [return] 'ledger-reconcile-visit)
|
||||
(define-key map [(control ?l)] 'ledger-reconcile-refresh)
|
||||
(define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish)
|
||||
(define-key map [? ] 'ledger-reconcile-toggle)
|
||||
(define-key map [?a] 'ledger-reconcile-add)
|
||||
(define-key map [?d] 'ledger-reconcile-delete)
|
||||
(define-key map [?g] 'ledger-reconcile);
|
||||
(define-key map [?n] 'next-line)
|
||||
(define-key map [?p] 'previous-line)
|
||||
(define-key map [?t] 'ledger-reconcile-change-target)
|
||||
(define-key map [?s] 'ledger-reconcile-save)
|
||||
(define-key map [?q] 'ledger-reconcile-quit)
|
||||
(define-key map [?b] 'ledger-display-balance)
|
||||
"A mode for reconciling ledger entries."
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map [(control ?m)] 'ledger-reconcile-visit)
|
||||
(define-key map [return] 'ledger-reconcile-visit)
|
||||
(define-key map [(control ?l)] 'ledger-reconcile-refresh)
|
||||
(define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish)
|
||||
(define-key map [? ] 'ledger-reconcile-toggle)
|
||||
(define-key map [?a] 'ledger-reconcile-add)
|
||||
(define-key map [?d] 'ledger-reconcile-delete)
|
||||
(define-key map [?g] 'ledger-reconcile);
|
||||
(define-key map [?n] 'next-line)
|
||||
(define-key map [?p] 'previous-line)
|
||||
(define-key map [?t] 'ledger-reconcile-change-target)
|
||||
(define-key map [?s] 'ledger-reconcile-save)
|
||||
(define-key map [?q] 'ledger-reconcile-quit)
|
||||
(define-key map [?b] 'ledger-display-balance)
|
||||
|
||||
(define-key map [menu-bar] (make-sparse-keymap "ldg-recon-menu"))
|
||||
(define-key map [menu-bar ldg-recon-menu] (cons "Reconcile" map))
|
||||
(define-key map [menu-bar ldg-recon-menu qui] '("Quit" . ledger-reconcile-quit))
|
||||
(define-key map [menu-bar ldg-recon-menu sep1] '("--"))
|
||||
(define-key map [menu-bar ldg-recon-menu pre] '("Previous Entry" . previous-line))
|
||||
(define-key map [menu-bar ldg-recon-menu vis] '("Visit Source" . ledger-reconcile-visit))
|
||||
(define-key map [menu-bar ldg-recon-menu nex] '("Next Entry" . next-line))
|
||||
(define-key map [menu-bar ldg-recon-menu sep2] '("--"))
|
||||
(define-key map [menu-bar ldg-recon-menu del] '("Delete Entry" . ledger-reconcile-delete))
|
||||
(define-key map [menu-bar ldg-recon-menu add] '("Add Entry" . ledger-reconcile-add))
|
||||
(define-key map [menu-bar ldg-recon-menu tog] '("Toggle Entry" . ledger-reconcile-toggle))
|
||||
(define-key map [menu-bar ldg-recon-menu sep3] '("--"))
|
||||
(define-key map [menu-bar ldg-recon-menu bal] '("Show Cleared Balance" . ledger-display-balance))
|
||||
(define-key map [menu-bar ldg-recon-menu tgt] '("Change Target Balance" . ledger-reconcile-change-target))
|
||||
(define-key map [menu-bar ldg-recon-menu sep4] '("--"))
|
||||
(define-key map [menu-bar ldg-recon-menu rna] '("Reconcile New Account" . ledger-reconcile))
|
||||
(define-key map [menu-bar ldg-recon-menu sep5] '("--"))
|
||||
(define-key map [menu-bar ldg-recon-menu fin] '("Finish" . ledger-reconcile-finish))
|
||||
(define-key map [menu-bar ldg-recon-menu ref] '("Refresh" . ledger-reconcile-refresh))
|
||||
(define-key map [menu-bar ldg-recon-menu sav] '("Save" . ledger-reconcile-save))
|
||||
(define-key map [menu-bar] (make-sparse-keymap "ldg-recon-menu"))
|
||||
(define-key map [menu-bar ldg-recon-menu] (cons "Reconcile" map))
|
||||
(define-key map [menu-bar ldg-recon-menu qui] '("Quit" . ledger-reconcile-quit))
|
||||
(define-key map [menu-bar ldg-recon-menu sep1] '("--"))
|
||||
(define-key map [menu-bar ldg-recon-menu pre] '("Previous Entry" . previous-line))
|
||||
(define-key map [menu-bar ldg-recon-menu vis] '("Visit Source" . ledger-reconcile-visit))
|
||||
(define-key map [menu-bar ldg-recon-menu nex] '("Next Entry" . next-line))
|
||||
(define-key map [menu-bar ldg-recon-menu sep2] '("--"))
|
||||
(define-key map [menu-bar ldg-recon-menu del] '("Delete Entry" . ledger-reconcile-delete))
|
||||
(define-key map [menu-bar ldg-recon-menu add] '("Add Entry" . ledger-reconcile-add))
|
||||
(define-key map [menu-bar ldg-recon-menu tog] '("Toggle Entry" . ledger-reconcile-toggle))
|
||||
(define-key map [menu-bar ldg-recon-menu sep3] '("--"))
|
||||
(define-key map [menu-bar ldg-recon-menu bal] '("Show Cleared Balance" . ledger-display-balance))
|
||||
(define-key map [menu-bar ldg-recon-menu tgt] '("Change Target Balance" . ledger-reconcile-change-target))
|
||||
(define-key map [menu-bar ldg-recon-menu sep4] '("--"))
|
||||
(define-key map [menu-bar ldg-recon-menu rna] '("Reconcile New Account" . ledger-reconcile))
|
||||
(define-key map [menu-bar ldg-recon-menu sep5] '("--"))
|
||||
(define-key map [menu-bar ldg-recon-menu fin] '("Finish" . ledger-reconcile-finish))
|
||||
(define-key map [menu-bar ldg-recon-menu ref] '("Refresh" . ledger-reconcile-refresh))
|
||||
(define-key map [menu-bar ldg-recon-menu sav] '("Save" . ledger-reconcile-save))
|
||||
|
||||
(use-local-map map)))
|
||||
(use-local-map map)))
|
||||
|
||||
(provide 'ldg-reconcile)
|
||||
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@
|
|||
"-?[1-9][0-9.]*[,]?[0-9]*")
|
||||
|
||||
(defconst ledger-amount-decimal-period-regex
|
||||
"-?[1-9][0-9.]*[.]?[0-9]*")
|
||||
"-?[1-9][0-9,]*[.]?[0-9]*")
|
||||
|
||||
(defconst ledger-other-entries-regex
|
||||
"\\(^[~=A-Za-z].+\\)+")
|
||||
|
|
|
|||
|
|
@ -295,32 +295,32 @@ Optional EDIT the command."
|
|||
"\n\n")
|
||||
(let ((data-pos (point))
|
||||
(register-report (string-match " reg\\(ister\\)? " cmd))
|
||||
files-in-report)
|
||||
files-in-report)
|
||||
(shell-command
|
||||
;; --subtotal does not produce identifiable transactions, so don't
|
||||
;; prepend location information for them
|
||||
(if (and register-report
|
||||
(not (string-match "--subtotal" cmd)))
|
||||
(concat cmd " --prepend-format='%(filename):%(beg_line):'")
|
||||
cmd)
|
||||
(not (string-match "--subtotal" cmd)))
|
||||
(concat cmd " --prepend-format='%(filename):%(beg_line):'")
|
||||
cmd)
|
||||
t nil)
|
||||
(when register-report
|
||||
(goto-char data-pos)
|
||||
(while (re-search-forward "^\\(/[^:]+\\)?:\\([0-9]+\\)?:" nil t)
|
||||
(let ((file (match-string 1))
|
||||
(line (string-to-number (match-string 2))))
|
||||
(delete-region (match-beginning 0) (match-end 0))
|
||||
(when file
|
||||
(set-text-properties (line-beginning-position) (line-end-position)
|
||||
(list 'ledger-source (cons file (save-window-excursion
|
||||
(save-excursion
|
||||
(find-file file)
|
||||
(widen)
|
||||
(ledger-goto-line line)
|
||||
(point-marker))))))
|
||||
(add-text-properties (line-beginning-position) (line-end-position)
|
||||
(list 'face 'ledger-font-report-clickable-face))
|
||||
(end-of-line)))))
|
||||
(let ((file (match-string 1))
|
||||
(line (string-to-number (match-string 2))))
|
||||
(delete-region (match-beginning 0) (match-end 0))
|
||||
(when file
|
||||
(set-text-properties (line-beginning-position) (line-end-position)
|
||||
(list 'ledger-source (cons file (save-window-excursion
|
||||
(save-excursion
|
||||
(find-file file)
|
||||
(widen)
|
||||
(ledger-goto-line line)
|
||||
(point-marker))))))
|
||||
(add-text-properties (line-beginning-position) (line-end-position)
|
||||
(list 'face 'ledger-font-report-clickable-face))
|
||||
(end-of-line)))))
|
||||
(goto-char data-pos)))
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue