sfos/ledger
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'next' into ledger-mode-automatic-transactions

Browse source
This commit is contained in:
Craig Earls 2013-03-09 12:27:08 -05:00
commit ca99c0de03
34 changed files with 350 additions and 3110 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
doc/ledger-mode.texi
View file

@ -316,12 +316,14 @@ markup within your ledger. For exmaple
<<< information to not sort >>> <<< information to not sort >>>
@end smallexample @end smallexample
You can use menu entries to insert start and end markers. These
functions will automatically delete old markers and put new new marker
at point.
@node Hiding Transactions, , Sorting Transactions, The Ledger Buffer @node Hiding Transactions, , Sorting Transactions, The Ledger Buffer
@section Hiding Transactions @section Hiding Transactions
Often you will want to run Ledger register reports just to look at a Often you will want to run Ledger register reports just to look at ax
specific set of transactions. If you don't need the running total specific set of transactions. If you don't need the running total
calculation handled by Ledger, Ledger-mode provides a rapid way of calculation handled by Ledger, Ledger-mode provides a rapid way of
narrowing what is displayed in the buffer in a way that is simpler than narrowing what is displayed in the buffer in a way that is simpler than

10
lisp/CMakeLists.txt
View file

@ -1,19 +1,21 @@
set(EMACS_LISP_SOURCES set(EMACS_LISP_SOURCES
ldg-commodities.el
ldg-complete.el ldg-complete.el
ldg-exec.el ldg-exec.el
ldg-fonts.el
ldg-init.el
ldg-mode.el ldg-mode.el
ldg-new.el ldg-new.el
ldg-occur.el
ldg-post.el ldg-post.el
ldg-reconcile.el ldg-reconcile.el
ldg-regex.el ldg-regex.el
ldg-register.el
ldg-report.el ldg-report.el
ldg-sort.el
ldg-state.el ldg-state.el
ldg-test.el ldg-test.el
ldg-texi.el ldg-texi.el
ldg-xact.el ldg-xact.el)
ledger.el
timeclock.el)
# find emacs and complain if not found # find emacs and complain if not found
find_program(EMACS_EXECUTABLE emacs) find_program(EMACS_EXECUTABLE emacs)

46
lisp/ldg-commodities.el
View file

@ -33,28 +33,30 @@
(defun ledger-split-commodity-string (str) (defun ledger-split-commodity-string (str)
"Split a commoditized amount into two parts" "Split a commoditized amount into two parts"
(let (val (if (> (length str) 0)
comm) (let (val
(with-temp-buffer comm)
(insert str) (with-temp-buffer
(goto-char (point-min)) (insert str)
(cond ((re-search-forward "-?[1-9][0-9]*[.,][0-9]*" nil t) (goto-char (point-min))
;; found a decimal number (cond ((re-search-forward "-?[1-9][0-9]*[.,][0-9]*" nil t)
(setq val ;; found a decimal number
(string-to-number (setq val
(ledger-commodity-string-number-decimalize (string-to-number
(delete-and-extract-region (match-beginning 0) (match-end 0)) :from-user))) (ledger-commodity-string-number-decimalize
(goto-char (point-min)) (delete-and-extract-region (match-beginning 0) (match-end 0)) :from-user)))
(re-search-forward "[^[:space:]]" nil t) (goto-char (point-min))
(setq comm (re-search-forward "[^[:space:]]" nil t)
(delete-and-extract-region (match-beginning 0) (match-end 0))) (setq comm
(list val comm)) (delete-and-extract-region (match-beginning 0) (match-end 0)))
((re-search-forward "0" nil t) (list val comm))
;; couldn't find a decimal number, look for a single 0, ((re-search-forward "0" nil t)
;; indicating account with zero balance ;; couldn't find a decimal number, look for a single 0,
(list 0 ledger-reconcile-default-commodity)) ;; indicating account with zero balance
(t (list 0 ledger-reconcile-default-commodity))
(error "split-commodity-string: cannot parse commodity string: %S" str)))))) (t
(error "split-commodity-string: cannot parse commodity string: %S" str)))))
(list 0 ledger-reconcile-default-commodity)))
(defun ledger-string-balance-to-commoditized-amount (str) (defun ledger-string-balance-to-commoditized-amount (str)

11
lisp/ldg-complete.el
View file

@ -145,16 +145,17 @@ Return tree structure"
"Completes a transaction if there is another matching payee in the buffer. "Completes a transaction if there is another matching payee in the buffer.
Does not use ledger xact" Does not use ledger xact"
(interactive) (interactive)
(let ((name (caar (ledger-parse-arguments))) (let* ((name (caar (ledger-parse-arguments)))
rest-of-name (rest-of-name name)
xacts) xacts)
(save-excursion (save-excursion
(when (eq 'transaction (ledger-thing-at-point)) (when (eq 'transaction (ledger-thing-at-point))
(delete-region (point) (+ (length name) (point)))
;; Search backward for a matching payee ;; Search backward for a matching payee
(when (re-search-backward (when (re-search-backward
(concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.*"
(regexp-quote name) ) nil t) ;; "\\(\t\\|\n\\| [ \t]\\)" (regexp-quote name) ".*\\)" ) nil t) ;; "\\(\t\\|\n\\| [ \t]\\)"
(setq rest-of-name (buffer-substring-no-properties (match-end 0) (line-end-position))) (setq rest-of-name (match-string 3))
;; Start copying the postings ;; Start copying the postings
(forward-line) (forward-line)
(while (looking-at "^\\s-+") (while (looking-at "^\\s-+")

81
lisp/ldg-exec.el
View file

@ -40,30 +40,48 @@
:type 'file :type 'file
:group 'ledger-exec) :group 'ledger-exec)
(defun ledger-exec-handle-error (ledger-output)
"Deal with ledger errors contained in LEDGER-OUTPUT."
(with-current-buffer (get-buffer-create "*Ledger Error*")
(insert-buffer-substring ledger-output)
(make-frame)
(fit-frame)
(view-mode)
(toggle-read-only)))
(defun ledger-exec-success-p (ledger-output-buffer)
(with-current-buffer ledger-output-buffer
(goto-char (point-min))
(if (and (> (buffer-size) 1) (looking-at (regexp-quote "While")))
nil
ledger-output-buffer)))
(defun ledger-exec-ledger (input-buffer &optional output-buffer &rest args) (defun ledger-exec-ledger (input-buffer &optional output-buffer &rest args)
"Run Ledger using INPUT-BUFFER and optionally capturing output in OUTPUT-BUFFER with ARGS." "Run Ledger using INPUT-BUFFER and optionally capturing output in OUTPUT-BUFFER with ARGS."
(if (null ledger-binary-path) (if (null ledger-binary-path)
(error "The variable `ledger-binary-path' has not been set")) (error "The variable `ledger-binary-path' has not been set")
(let ((buf (or input-buffer (current-buffer))) (let ((buf (or input-buffer (current-buffer)))
(outbuf (or output-buffer (outbuf (or output-buffer
(generate-new-buffer " *ledger-tmp*")))) (generate-new-buffer " *ledger-tmp*"))))
(with-current-buffer buf (with-current-buffer buf
(let ((coding-system-for-write 'utf-8) (let ((coding-system-for-write 'utf-8)
(coding-system-for-read 'utf-8)) (coding-system-for-read 'utf-8))
(apply #'call-process-region (apply #'call-process-region
(append (list (point-min) (point-max) (append (list (point-min) (point-max)
ledger-binary-path nil outbuf nil "-f" "-") ledger-binary-path nil outbuf nil "-f" "-")
args))) args)))
outbuf))) (if (ledger-exec-success-p outbuf)
outbuf
(ledger-exec-handle-error outbuf))))))
(defun ledger-exec-read (&optional input-buffer &rest args) ;; (defun ledger-exec-read (&optional input-buffer &rest args)
"Run ledger from option INPUT-BUFFER using ARGS, return a list structure of the ledger Emacs output." ;; "Run ledger from option INPUT-BUFFER using ARGS, return a list structure of the ledger Emacs output."
(with-current-buffer ;; (with-current-buffer
(apply #'ledger-exec-ledger input-buffer nil "emacs" args) ;; (apply #'ledger-exec-ledger input-buffer nil "emacs" args)
(goto-char (point-min)) ;; (goto-char (point-min))
(prog1 ;; (prog1
(read (current-buffer)) ;; (read (current-buffer))
(kill-buffer (current-buffer))))) ;; (kill-buffer (current-buffer)))))
(defun ledger-version-greater-p (needed) (defun ledger-version-greater-p (needed)
"Verify the ledger binary is usable for `ledger-mode' (version greater than NEEDED)." "Verify the ledger binary is usable for `ledger-mode' (version greater than NEEDED)."
@ -71,17 +89,18 @@
(version-strings '()) (version-strings '())
(version-number)) (version-number))
(with-temp-buffer (with-temp-buffer
(ledger-exec-ledger buffer (current-buffer) "--version") (if (ledger-exec-ledger (current-buffer) (current-buffer) "--version")
(goto-char (point-min)) (progn
(delete-horizontal-space) (goto-char (point-min))
(setq version-strings (split-string (delete-horizontal-space)
(buffer-substring-no-properties (point) (setq version-strings (split-string
(+ (point) 12)))) (buffer-substring-no-properties (point)
(if (and (string-match (regexp-quote "Ledger") (car version-strings)) (point-max))))
(or (string= needed (car (cdr version-strings))) (if (and (string-match (regexp-quote "Ledger") (car version-strings))
(string< needed (car (cdr version-strings))))) (or (string= needed (car (cdr version-strings)))
t (string< needed (car (cdr version-strings)))))
nil)))) t
nil))))))
(defun ledger-check-version () (defun ledger-check-version ()
"Verify that ledger works and is modern enough." "Verify that ledger works and is modern enough."

2
lisp/ldg-mode.el
View file

@ -116,6 +116,8 @@
(interactive) (interactive)
(customize-group 'ledger)))) (customize-group 'ledger))))
(define-key map [sep1] '("--")) (define-key map [sep1] '("--"))
(define-key map [sort-end] '(menu-item "Mark Sort End" ledger-sort-insert-end-mark))
(define-key map [sort-start] '(menu-item "Mark Sort Beginning" ledger-sort-insert-start-mark))
(define-key map [sort-buff] '(menu-item "Sort Buffer" ledger-sort-buffer)) (define-key map [sort-buff] '(menu-item "Sort Buffer" ledger-sort-buffer))
(define-key map [sort-reg] '(menu-item "Sort Region" ledger-sort-region :enable mark-active)) (define-key map [sort-reg] '(menu-item "Sort Region" ledger-sort-region :enable mark-active))
(define-key map [sep2] '(menu-item "--")) (define-key map [sep2] '(menu-item "--"))

6
lisp/ldg-new.el
View file

@ -32,6 +32,7 @@
;;; Commentary: ;;; Commentary:
;; Load up the ledger mode ;; Load up the ledger mode
(require 'esh-util)
(require 'esh-arg) (require 'esh-arg)
(require 'ldg-commodities) (require 'ldg-commodities)
(require 'ldg-complete) (require 'ldg-complete)
@ -42,7 +43,7 @@
(require 'ldg-occur) (require 'ldg-occur)
(require 'ldg-post) (require 'ldg-post)
(require 'ldg-reconcile) (require 'ldg-reconcile)
(require 'ldg-register) (require 'ldg-regex)
(require 'ldg-report) (require 'ldg-report)
(require 'ldg-sort) (require 'ldg-sort)
(require 'ldg-state) (require 'ldg-state)
@ -123,9 +124,6 @@
(ledger-dump-variable 'ledger-buffer-tracks-reconcile-buffer) (ledger-dump-variable 'ledger-buffer-tracks-reconcile-buffer)
(ledger-dump-variable 'ledger-reconcile-force-window-bottom) (ledger-dump-variable 'ledger-reconcile-force-window-bottom)
(ledger-dump-variable 'ledger-reconcile-toggle-to-pending) (ledger-dump-variable 'ledger-reconcile-toggle-to-pending)
(insert "ldg-register:\n")
(ledger-dump-variable 'ledger-register-date-format)
(ledger-dump-variable 'ledger-register-line-format)
(insert "ldg-reports:\n") (insert "ldg-reports:\n")
(ledger-dump-variable 'ledger-reports) (ledger-dump-variable 'ledger-reports)
(ledger-dump-variable 'ledger-report-format-specifiers) (ledger-dump-variable 'ledger-report-format-specifiers)

4
lisp/ldg-occur.el
View file

@ -41,7 +41,9 @@
(make-variable-buffer-local 'ledger-occur-use-face-unfolded) (make-variable-buffer-local 'ledger-occur-use-face-unfolded)
(defvar ledger-occur-mode nil) ;; name of the minor mode, shown in the mode-line (defvar ledger-occur-mode nil
"name of the minor mode, shown in the mode-line")
(make-variable-buffer-local 'ledger-occur-mode) (make-variable-buffer-local 'ledger-occur-mode)
(or (assq 'ledger-occur-mode minor-mode-alist) (or (assq 'ledger-occur-mode minor-mode-alist)

71
lisp/ldg-post.el
View file

@ -31,16 +31,20 @@
"Default indentation for account transactions in an entry." "Default indentation for account transactions in an entry."
:type 'string :type 'string
:group 'ledger-post) :group 'ledger-post)
(defgroup ledger-post nil (defgroup ledger-post nil
"Options for controlling how Ledger-mode deals with postings and completion" "Options for controlling how Ledger-mode deals with postings and completion"
:group 'ledger) :group 'ledger)
(defcustom ledger-post-auto-adjust-amounts nil (defcustom ledger-post-auto-adjust-postings t
"If non-nil, ." "If non-nil, adjust account and amount to columns set below"
:type 'boolean :type 'boolean
:group 'ledger-post) :group 'ledger-post)
(defcustom ledger-post-account-alignment-column 4
"The column Ledger-mode attempts to align accounts to."
:type 'integer
:group 'ledger-post)
(defcustom ledger-post-amount-alignment-column 52 (defcustom ledger-post-amount-alignment-column 52
"The column Ledger-mode attempts to align amounts to." "The column Ledger-mode attempts to align amounts to."
:type 'integer :type 'integer
@ -123,20 +127,26 @@ PROMPT is a string to prompt with. CHOICES is a list of
(- (or (match-end 4) (- (or (match-end 4)
(match-end 3)) (point)))) (match-end 3)) (point))))
(defun ledger-align-amounts (&optional column) (defun ledger-post-align-postings (&optional column)
"Align amounts and accounts in the current region. "Align amounts and accounts in the current region.
This is done so that the last digit falls in COLUMN, which This is done so that the last digit falls in COLUMN, which
defaults to 52. ledger-default-acct-transaction-indent positions defaults to 52. ledger-post-account-column positions
the account" the account"
(interactive "p") (interactive "p")
(if (or (null column) (= column 1)) (if (or (null column) (= column 1))
(setq column ledger-post-amount-alignment-column)) (setq column ledger-post-amount-alignment-column))
(save-excursion (save-excursion
;; Position the account ;; Position the account
;; (beginning-of-line) (if (not (or (looking-at "[ \t]*[1-9]")
(and (looking-at "[ \t]+\n")
(looking-back "[ \n]" (- (point) 2)))))
(save-excursion
(beginning-of-line)
(set-mark (point))
(delete-horizontal-space)
(insert (make-string ledger-post-account-alignment-column ? )))
(set-mark (point)))
(set-mark (point)) (set-mark (point))
;; (delete-horizontal-space)
;; (insert ledger-default-acct-transaction-indent)
(goto-char (1+ (line-end-position))) (goto-char (1+ (line-end-position)))
(let* ((mark-first (< (mark) (point))) (let* ((mark-first (< (mark) (point)))
(begin (if mark-first (mark) (point))) (begin (if mark-first (mark) (point)))
@ -148,7 +158,7 @@ the account"
(let ((col (current-column)) (let ((col (current-column))
(target-col (- column offset)) (target-col (- column offset))
adjust) adjust)
(setq adjust (- target-col col)) (setq adjust (- target-col col))
(if (< col target-col) (if (< col target-col)
(insert (make-string (- target-col col) ? )) (insert (make-string (- target-col col) ? ))
(move-to-column target-col) (move-to-column target-col)
@ -159,23 +169,24 @@ the account"
(insert " "))) (insert " ")))
(forward-line)))))) (forward-line))))))
(defun ledger-post-align-amount () (defun ledger-post-align-posting ()
"Align the amounts in this posting." "Align the amounts in this posting."
(interactive) (interactive)
(save-excursion (save-excursion
(set-mark (line-beginning-position)) (set-mark (line-beginning-position))
(goto-char (1+ (line-end-position))) (goto-char (1+ (line-end-position)))
(ledger-align-amounts))) (ledger-post-align-postings)))
(defun ledger-post-maybe-align (beg end len) (defun ledger-post-maybe-align (beg end len)
"Align amounts only if point is in a posting. "Align amounts only if point is in a posting.
BEG, END, and LEN control how far it can align." BEG, END, and LEN control how far it can align."
(save-excursion (if ledger-post-auto-adjust-postings
(goto-char beg) (save-excursion
(when (<= end (line-end-position)) (goto-char beg)
(goto-char (line-beginning-position)) (when (<= end (line-end-position))
(if (looking-at ledger-post-line-regexp) (goto-char (line-beginning-position))
(ledger-align-amounts))))) (if (looking-at ledger-post-line-regexp)
(ledger-post-align-postings))))))
(defun ledger-post-edit-amount () (defun ledger-post-edit-amount ()
"Call 'calc-mode' and push the amount in the posting to the top of stack." "Call 'calc-mode' and push the amount in the posting to the top of stack."
@ -186,19 +197,10 @@ BEG, END, and LEN control how far it can align."
(let ((end-of-amount (re-search-forward "[-.,0-9]+" (line-end-position) t))) (let ((end-of-amount (re-search-forward "[-.,0-9]+" (line-end-position) t)))
;; determine if there is an amount to edit ;; determine if there is an amount to edit
(if end-of-amount (if end-of-amount
(let ((val (match-string 0))) (let ((val (ledger-commodity-string-number-decimalize (match-string 0) :from-user)))
(goto-char (match-beginning 0)) (goto-char (match-beginning 0))
(delete-region (match-beginning 0) (match-end 0)) (delete-region (match-beginning 0) (match-end 0))
(calc) (calc)
(if ledger-use-decimal-comma
(progn
(while (string-match "\\." val)
(setq val (replace-match "" nil nil val))) ;; gets rid of periods
(while (string-match "," val)
(setq val (replace-match "." nil nil val)))) ;; switch to period separator
(progn
(while (string-match "," val)
(setq val (replace-match "" nil nil val))))) ;; gets rid of commas
(calc-eval val 'push)) ;; edit the amount (calc-eval val 'push)) ;; edit the amount
(progn ;;make sure there are two spaces after the account name and go to calc (progn ;;make sure there are two spaces after the account name and go to calc
(if (search-backward " " (- (point) 3) t) (if (search-backward " " (- (point) 3) t)
@ -225,10 +227,21 @@ BEG, END, and LEN control how far it can align."
(defun ledger-post-setup () (defun ledger-post-setup ()
"Configure `ledger-mode' to auto-align postings." "Configure `ledger-mode' to auto-align postings."
(if ledger-post-auto-adjust-amounts (add-hook 'after-change-functions 'ledger-post-maybe-align t t)
(add-hook 'after-change-functions 'ledger-post-maybe-align t t))
(add-hook 'after-save-hook #'(lambda () (setq ledger-post-current-list nil)))) (add-hook 'after-save-hook #'(lambda () (setq ledger-post-current-list nil))))
(defun ledger-post-read-account-with-prompt (prompt)
(let* ((context (ledger-context-at-point))
(default
(if (eq (ledger-context-line-type context) 'acct-transaction)
(regexp-quote (ledger-context-field-value context 'account))
nil)))
(ledger-read-string-with-default prompt default)))
(provide 'ldg-post) (provide 'ldg-post)
;;; ldg-post.el ends here ;;; ldg-post.el ends here

85
lisp/ldg-reconcile.el
View file

@ -70,32 +70,29 @@ reconcile-finish will mark all pending posting cleared."
(account ledger-acct) (account ledger-acct)
(val nil)) (val nil))
(with-temp-buffer (with-temp-buffer
(ledger-exec-ledger buffer (current-buffer) ;; note that in the line below, the --format option is
; note that in the line below, the --format option is ;; separated from the actual format string. emacs does not
; separated from the actual format string. emacs does not ;; split arguments like the shell does, so you need to
; split arguments like the shell does, so you need to ;; specify the individual fields in the command line.
; specify the individual fields in the command line. (if (ledger-exec-ledger buffer (current-buffer)
"balance" "--limit" "cleared or pending" "--empty" "balance" "--limit" "cleared or pending" "--empty"
"--format" "%(display_total)" account) "--format" "%(display_total)" account)
(setq val (setq val
(ledger-split-commodity-string (ledger-split-commodity-string
(buffer-substring-no-properties (point-min) (point-max))))))) (buffer-substring-no-properties (point-min) (point-max))))))))
(defun ledger-display-balance () (defun ledger-display-balance ()
"Display the cleared-or-pending balnce and calculate the "Display the cleared-or-pending balance.
target-delta of the account being reconciled." And calculate the target-delta of the account being reconciled."
(interactive) (interactive)
(let* ((pending (ledger-reconcile-get-cleared-or-pending-balance)) (let* ((pending (ledger-reconcile-get-cleared-or-pending-balance)))
(target-delta (if ledger-target (if pending
(-commodity ledger-target pending) (if ledger-target
nil))) (message "Pending balance: %s, Difference from target: %s"
(ledger-commodity-to-string pending)
(if target-delta (ledger-commodity-to-string (-commodity ledger-target pending)))
(message "Pending balance: %s, Difference from target: %s" (message "Pending balance: %s"
(ledger-commodity-to-string pending) (ledger-commodity-to-string pending))))))
(ledger-commodity-to-string target-delta))
(message "Pending balance: %s"
(ledger-commodity-to-string pending)))))
@ -111,7 +108,7 @@ target-delta of the account being reconciled."
"Return a buffer from WHERE the transaction is." "Return a buffer from WHERE the transaction is."
(if (bufferp (car where)) (if (bufferp (car where))
(car where) (car where)
(error "ledger-reconcile-get-buffer: Buffer not set"))) (error "Function ledger-reconcile-get-buffer: Buffer not set")))
(defun ledger-reconcile-toggle () (defun ledger-reconcile-toggle ()
"Toggle the current transaction, and mark the recon window." "Toggle the current transaction, and mark the recon window."
@ -276,23 +273,27 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
"Get the uncleared transactions in the account and display them in the *Reconcile* buffer." "Get the uncleared transactions in the account and display them in the *Reconcile* buffer."
(let* ((buf ledger-buf) (let* ((buf ledger-buf)
(account ledger-acct) (account ledger-acct)
(ledger-success nil)
(xacts (xacts
(with-temp-buffer (with-temp-buffer
(ledger-exec-ledger buf (current-buffer) (if (ledger-exec-ledger buf (current-buffer)
"--uncleared" "--real" "emacs" account) "--uncleared" "--real" "emacs" account)
(goto-char (point-min)) (progn
(unless (eobp) (setq ledger-success t)
(unless (looking-at "(") (goto-char (point-min))
(error (concat "ledger-do-reconcile: " (buffer-string)))) (unless (eobp)
(read (current-buffer)))))) ;current-buffer is the *temp* created above (if (looking-at "(")
(if (> (length xacts) 0) (read (current-buffer))))))))) ;current-buffer is the *temp* created above
(progn (if (and ledger-success (> (length xacts) 0))
(let ((date-format (cdr (assoc "date-format" ledger-environment-alist))))
(dolist (xact xacts) (dolist (xact xacts)
(dolist (posting (nthcdr 5 xact)) (dolist (posting (nthcdr 5 xact))
(let ((beg (point)) (let ((beg (point))
(where (ledger-marker-where-xact-is xact posting))) (where (ledger-marker-where-xact-is xact posting)))
(insert (format "%s %-4s %-30s %-30s %15s\n" (insert (format "%s %-4s %-30s %-30s %15s\n"
(format-time-string "%Y/%m/%d" (nth 2 xact)) (format-time-string (if date-format
date-format
"%Y/%m/%d") (nth 2 xact))
(if (nth 3 xact) (if (nth 3 xact)
(nth 3 xact) (nth 3 xact)
"") "")
@ -310,7 +311,9 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
'where where)))) )) 'where where)))) ))
(goto-char (point-max)) (goto-char (point-max))
(delete-char -1)) ;gets rid of the extra line feed at the bottom of the list (delete-char -1)) ;gets rid of the extra line feed at the bottom of the list
(insert (concat "There are no uncleared entries for " account))) (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)) (goto-char (point-min))
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(toggle-read-only t) (toggle-read-only t)
@ -351,10 +354,11 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
(set-window-buffer (split-window (get-buffer-window buf) nil nil) rbuf) (set-window-buffer (split-window (get-buffer-window buf) nil nil) rbuf)
(pop-to-buffer rbuf))) (pop-to-buffer rbuf)))
(defun ledger-reconcile (account) (defun ledger-reconcile ()
"Start reconciling ACCOUNT." "Start reconciling, prompt for account."
(interactive "sAccount to reconcile: ") (interactive)
(let ((buf (current-buffer)) (let ((account (ledger-post-read-account-with-prompt "Account to reconcile"))
(buf (current-buffer))
(rbuf (get-buffer ledger-recon-buffer-name))) ;; this means (rbuf (get-buffer ledger-recon-buffer-name))) ;; this means
;; only one ;; only one
;; *Reconcile* ;; *Reconcile*
@ -396,7 +400,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
(defvar ledger-reconcile-mode-abbrev-table) (defvar ledger-reconcile-mode-abbrev-table)
(defun ledger-reconcile-change-target () (defun ledger-reconcile-change-target ()
"Change the traget amount for the reconciliation process." "Change the target amount for the reconciliation process."
(interactive) (interactive)
(setq ledger-target (ledger-read-commodity-string "Set reconciliation target"))) (setq ledger-target (ledger-read-commodity-string "Set reconciliation target")))
@ -442,6 +446,5 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
(use-local-map map))) (use-local-map map)))
(provide 'ldg-reconcile) (provide 'ldg-reconcile)
(provide 'ldg-reconcile)
;;; ldg-reconcile.el ends here ;;; ldg-reconcile.el ends here

3
lisp/ldg-regex.el
View file

@ -24,7 +24,8 @@
(eval-when-compile (eval-when-compile
(require 'cl)) (require 'cl))
(defvar ledger-date-regex "\\([0-9]+\\)[/-]\\([0-9]+\\)[/-]\\([0-9]+\\)") (defvar ledger-date-regex
"\\([0-9]+\\)[/-]\\([0-9]+\\)[/-]\\([0-9]+\\)")
(defmacro ledger-define-regexp (name regex docs &rest args) (defmacro ledger-define-regexp (name regex docs &rest args)
"Simplify the creation of a Ledger regex and helper functions." "Simplify the creation of a Ledger regex and helper functions."

86
lisp/ldg-register.el
View file

@ -1,86 +0,0 @@
;;; ldg-register.el --- Helper code for use with the "ledger" command-line tool
;; Copyright (C) 2003-2013 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.
(require 'ldg-post)
(require 'ldg-state)
(defgroup ledger-register nil
""
:group 'ledger)
(defcustom ledger-register-date-format "%m/%d/%y"
"*The date format used for ledger register reports."
:type 'string
:group 'ledger-register)
(defcustom ledger-register-line-format "%s %-30.30s %-25.25s %15s\n"
"*The date format used for ledger register reports."
:type 'string
:group 'ledger-register)
(defface ledger-register-pending-face
'((((background light)) (:weight bold))
(((background dark)) (:weight bold)))
"Face used to highlight pending entries in a register report."
:group 'ledger-register)
(defun ledger-register-render (data-buffer posts)
(dolist (post posts)
(let ((index 1))
(dolist (xact (nthcdr 5 post))
(let ((beg (point))
(where
(with-current-buffer data-buffer
(cons
(nth 0 post)
(if ledger-clear-whole-transactions
(save-excursion
(goto-line (nth 1 post))
(point-marker))
(save-excursion
(goto-line (nth 0 xact))
(point-marker)))))))
(insert (format ledger-register-line-format
(format-time-string ledger-register-date-format
(nth 2 post))
(nth 4 post) (nth 1 xact) (nth 2 xact)))
(if (nth 3 xact)
(set-text-properties beg (1- (point))
(list 'face 'ledger-register-pending-face
'where where))
(set-text-properties beg (1- (point))
(list 'where where))))
(setq index (1+ index)))))
(goto-char (point-min)))
(defun ledger-register-generate (&optional data-buffer &rest args)
(let ((buf (or data-buffer (current-buffer))))
(with-current-buffer (get-buffer-create "*ledger-register*")
(let ((pos (point))
(inhibit-read-only t))
(erase-buffer)
(ledger-register-render buf (apply #'ledger-exec-read buf args))
(goto-char pos))
(set-buffer-modified-p nil)
(toggle-read-only t)
(display-buffer (current-buffer) t))))
(provide 'ldg-register)

25
lisp/ldg-report.el
View file

@ -258,12 +258,7 @@ used to generate the buffer, navigating the buffer, etc."
the default." the default."
;; It is intended completion should be available on existing account ;; It is intended completion should be available on existing account
;; names, but it remains to be implemented. ;; names, but it remains to be implemented.
(let* ((context (ledger-context-at-point)) (ledger-post-read-account-with-prompt "Account"))
(default
(if (eq (ledger-context-line-type context) 'acct-transaction)
(regexp-quote (ledger-context-field-value context 'account))
nil)))
(ledger-read-string-with-default "Account" default)))
(defun ledger-report-expand-format-specifiers (report-cmd) (defun ledger-report-expand-format-specifiers (report-cmd)
"Expand %(account) and %(payee) appearing in REPORT-CMD with thing under point." "Expand %(account) and %(payee) appearing in REPORT-CMD with thing under point."
@ -437,11 +432,13 @@ Optional EDIT the command."
("^\\(\\([0-9][0-9][0-9][0-9]/\\)?[01]?[0-9]/[0123]?[0-9]\\)[ \t]+\\(\\([!*]\\)[ \t]\\)?[ \t]*\\((\\(.*\\))\\)?[ \t]*\\(.*\\)[ \t]*$" ("^\\(\\([0-9][0-9][0-9][0-9]/\\)?[01]?[0-9]/[0123]?[0-9]\\)[ \t]+\\(\\([!*]\\)[ \t]\\)?[ \t]*\\((\\(.*\\))\\)?[ \t]*\\(.*\\)[ \t]*$"
(date nil status nil nil code payee)))) (date nil status nil nil code payee))))
(acct-transaction (acct-transaction
(("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$]\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$" (("^\\([ \t]+;\\|;\\)\\s-?\\(.*\\)"
(indent comment))
("\\(^[ \t]+\\)\\([:A-Za-z0-9]+?\\)\\s-\\s-+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)$"
(indent account commodity amount))
("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$"
(indent account commodity amount nil comment)) (indent account commodity amount nil comment))
("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$]\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*$" ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?[0-9]+\\(\\.[0-9]*\\)?\\)[ \t]+\\(.*?\\)[ \t]*\\(;[ \t]*\\(.*?\\)[ \t]*$\\|@+\\)"
(indent account commodity amount nil))
("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?[0-9]+\\(\\.[0-9]*\\)?\\)[ \t]+\\(.*?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$"
(indent account amount nil commodity comment)) (indent account amount nil commodity comment))
("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?[0-9]+\\(\\.[0-9]*\\)?\\)[ \t]+\\(.*?\\)[ \t]*$" ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?[0-9]+\\(\\.[0-9]*\\)?\\)[ \t]+\\(.*?\\)[ \t]*$"
(indent account amount nil commodity)) (indent account amount nil commodity))
@ -452,7 +449,13 @@ Optional EDIT the command."
("\\(^[ \t]+\\)\\(.*?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$" ("\\(^[ \t]+\\)\\(.*?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$"
(indent account comment)) (indent account comment))
("\\(^[ \t]+\\)\\(.*?\\)[ \t]*$" ("\\(^[ \t]+\\)\\(.*?\\)[ \t]*$"
(indent account)))))) (indent account))
;; Bad regexes
("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*$"
(indent account commodity amount nil))
))))
(defun ledger-extract-context-info (line-type pos) (defun ledger-extract-context-info (line-type pos)
"Get context info for current line with LINE-TYPE. "Get context info for current line with LINE-TYPE.

47
lisp/ldg-sort.el
View file

@ -38,6 +38,36 @@
"Move point to end of transaction." "Move point to end of transaction."
(forward-paragraph)) (forward-paragraph))
(defun ledger-sort-find-start ()
(if (re-search-forward ";.*Ledger-mode:.*Start sort" nil t)
(match-end 0)))
(defun ledger-sort-find-end ()
(if (re-search-forward ";.*Ledger-mode:.*End sort" nil t)
(match-end 0)))
(defun ledger-sort-insert-start-mark ()
(interactive)
(let (has-old-marker)
(save-excursion
(goto-char (point-min))
(setq has-old-marker (ledger-sort-find-start))
(if has-old-marker
(delete-region (match-beginning 0) (match-end 0))))
(beginning-of-line)
(insert "\n; Ledger-mode: Start sort\n\n")))
(defun ledger-sort-insert-end-mark ()
(interactive)
(let (has-old-marker)
(save-excursion
(goto-char (point-min))
(setq has-old-marker (ledger-sort-find-end))
(if has-old-marker
(delete-region (match-beginning 0) (match-end 0))))
(beginning-of-line)
(insert "\n; Ledger-mode: End sort\n\n")))
(defun ledger-sort-region (beg end) (defun ledger-sort-region (beg end)
"Sort the region from BEG to END in chronological order." "Sort the region from BEG to END in chronological order."
(interactive "r") ;; load beg and end from point and mark (interactive "r") ;; load beg and end from point and mark
@ -66,14 +96,15 @@
(defun ledger-sort-buffer () (defun ledger-sort-buffer ()
"Sort the entire buffer." "Sort the entire buffer."
(interactive) (interactive)
(let ((sort-start (point-min)) (goto-char (point-min))
(sort-end (point-max))) (let ((sort-start (ledger-sort-find-start))
(goto-char (point-min)) (sort-end (ledger-sort-find-end)))
(if (re-search-forward ";.*Ledger-mode:.*Start sort" nil t) (ledger-sort-region (if sort-start
(set 'sort-start (match-end 0))) sort-start
(if (re-search-forward ";.*Ledger-mode:.*End sort" nil t) (point-min))
(set 'sort-end (match-end 0))) (if sort-end
(ledger-sort-region sort-start sort-end))) sort-end
(point-max)))))
(provide 'ldg-sort) (provide 'ldg-sort)

80
lisp/ldg-state.el
View file

@ -122,42 +122,48 @@ dropped."
;;this excursion toggles the posting status ;;this excursion toggles the posting status
(save-excursion (save-excursion
(goto-char (line-beginning-position)) (let ((has-align-hook (remove-hook
(when (looking-at "[ \t]") 'after-change-functions
(skip-chars-forward " \t") 'ledger-post-maybe-align t)))
(let ((here (point))
(cur-status (ledger-state-from-char (char-after)))) (goto-char (line-beginning-position))
(skip-chars-forward "*! ") (when (looking-at "[ \t]")
(let ((width (- (point) here))) (skip-chars-forward " \t")
(when (> width 0) (let ((here (point))
(delete-region here (point)) (cur-status (ledger-state-from-char (char-after))))
(save-excursion (skip-chars-forward "*! ")
(if (search-forward " " (line-end-position) t) (let ((width (- (point) here)))
(insert (make-string width ? )))))) (when (> width 0)
(let (inserted) (delete-region here (point))
(if cur-status (save-excursion
(if (and style (eq style 'cleared)) (if (search-forward " " (line-end-position) t)
(progn (insert (make-string width ? ))))))
(insert "* ") (let (inserted)
(setq inserted 'cleared))) (if cur-status
(if (and style (eq style 'pending)) (if (and style (eq style 'cleared))
(progn (progn
(insert "! ") (insert "* ")
(setq inserted 'pending)) (setq inserted 'cleared)))
(progn (if (and style (eq style 'pending))
(insert "* ") (progn
(setq inserted 'cleared)))) (insert "! ")
(if (and inserted (setq inserted 'pending))
(re-search-forward "\\(\t\\| [ \t]\\)" (progn
(line-end-position) t)) (insert "* ")
(cond (setq inserted 'cleared))))
((looking-at "\t") (if (and inserted
(delete-char 1)) (re-search-forward "\\(\t\\| [ \t]\\)"
((looking-at " [ \t]") (line-end-position) t))
(delete-char 2)) (cond
((looking-at " ") ((looking-at "\t")
(delete-char 1)))) (delete-char 1))
(setq new-status inserted))))) ((looking-at " [ \t]")
(delete-char 2))
((looking-at " ")
(delete-char 1))))
(setq new-status inserted))))
(if has-align-hook
(add-hook 'after-change-functions 'ledger-post-maybe-align t t))))
;; This excursion cleans up the entry so that it displays ;; This excursion cleans up the entry so that it displays
;; minimally. This means that if all posts are cleared, remove ;; minimally. This means that if all posts are cleared, remove
@ -254,6 +260,4 @@ dropped."
(provide 'ldg-state) (provide 'ldg-state)
(provide 'ldg-state)
;;; ldg-state.el ends here ;;; ldg-state.el ends here

3
lisp/ldg-xact.el
View file

@ -118,9 +118,6 @@ within the transaction."
(replace-match date) (replace-match date)
(re-search-forward "[1-9][0-9]+\.[0-9]+"))) (re-search-forward "[1-9][0-9]+\.[0-9]+")))
(provide 'ldg-xact)
(provide 'ldg-xact) (provide 'ldg-xact)
;;; ldg-xact.el ends here ;;; ldg-xact.el ends here

1340
lisp/ledger.el
View file

File diff suppressed because it is too large Load diff

1362
lisp/timeclock.el
View file

File diff suppressed because it is too large Load diff

19
src/account.cc
View file

@ -692,12 +692,10 @@ void account_t::xdata_t::details_t::update(post_t& post,
} }
} }
void put_account(property_tree::ptree& pt, const account_t& acct, void put_account(property_tree::ptree& st, const account_t& acct,
function<bool(const account_t&)> pred) function<bool(const account_t&)> pred)
{ {
if (pred(acct)) { if (pred(acct)) {
property_tree::ptree& st(pt.put("account", ""));
std::ostringstream buf; std::ostringstream buf;
buf.width(sizeof(unsigned long) * 2); buf.width(sizeof(unsigned long) * 2);
buf.fill('0'); buf.fill('0');
@ -709,18 +707,15 @@ void put_account(property_tree::ptree& pt, const account_t& acct,
st.put("fullname", acct.fullname()); st.put("fullname", acct.fullname());
value_t total = acct.amount(); value_t total = acct.amount();
if (! total.is_null()) { if (! total.is_null())
property_tree::ptree& t(st.put("account-amount", "")); put_value(st.put("account-amount", ""), total);
put_value(t, total);
}
total = acct.total(); total = acct.total();
if (! total.is_null()) { if (! total.is_null())
property_tree::ptree& t(st.put("account-total", "")); put_value(st.put("account-total", ""), total);
put_value(t, total);
}
foreach (const accounts_map::value_type& pair, acct.accounts) foreach (const accounts_map::value_type& pair, acct.accounts)
put_account(st, *pair.second, pred); put_account(st.add("account", ""), *pair.second, pred);
} }
} }

8
src/amount.cc
View file

@ -1320,13 +1320,11 @@ bool amount_t::valid() const
return true; return true;
} }
void put_amount(property_tree::ptree& pt, const amount_t& amt, void put_amount(property_tree::ptree& st, const amount_t& amt,
bool wrap, bool commodity_details) bool commodity_details)
{ {
property_tree::ptree& st(wrap ? pt.put("amount", "") : pt);
if (amt.has_commodity()) if (amt.has_commodity())
put_commodity(st, amt.commodity(), commodity_details); put_commodity(st.put("commodity", ""), amt.commodity(), commodity_details);
st.put("quantity", amt.quantity_string()); st.put("quantity", amt.quantity_string());
} }

2
src/amount.h
View file

@ -793,7 +793,7 @@ inline std::istream& operator>>(std::istream& in, amount_t& amt) {
} }
void put_amount(property_tree::ptree& pt, const amount_t& amt, void put_amount(property_tree::ptree& pt, const amount_t& amt,
bool wrap = true, bool commodity_details = false); bool commodity_details = false);
} // namespace ledger } // namespace ledger

16
src/annotate.cc
View file

@ -216,19 +216,13 @@ void annotation_t::print(std::ostream& out, bool keep_base,
out << " ((" << *value_expr << "))"; out << " ((" << *value_expr << "))";
} }
void put_annotation(property_tree::ptree& pt, const annotation_t& details) void put_annotation(property_tree::ptree& st, const annotation_t& details)
{ {
property_tree::ptree& st(pt.put("annotation", "")); if (details.price)
put_amount(st.put("price", ""), *details.price);
if (details.price) { if (details.date)
property_tree::ptree& t(st.put("price", "")); put_date(st.put("date", ""), *details.date);
put_amount(t, *details.price, false);
}
if (details.date) {
property_tree::ptree& t(st.put("date", ""));
put_date(t, *details.date, false);
}
if (details.tag) if (details.tag)
st.put("tag", *details.tag); st.put("tag", *details.tag);

6
src/balance.cc
View file

@ -336,12 +336,10 @@ void balance_t::print(std::ostream& out,
amount_printer.close(); amount_printer.close();
} }
void put_balance(property_tree::ptree& pt, const balance_t& bal) void put_balance(property_tree::ptree& st, const balance_t& bal)
{ {
property_tree::ptree& st(pt.put("balance", ""));
foreach (const balance_t::amounts_map::value_type& pair, bal.amounts) foreach (const balance_t::amounts_map::value_type& pair, bal.amounts)
put_amount(st, pair.second); put_amount(st.add("amount", ""), pair.second);
} }
} // namespace ledger } // namespace ledger

6
src/commodity.cc
View file

@ -497,11 +497,9 @@ bool commodity_t::compare_by_commodity::operator()(const amount_t * left,
} }
} }
void put_commodity(property_tree::ptree& pt, const commodity_t& comm, void put_commodity(property_tree::ptree& st, const commodity_t& comm,
bool commodity_details) bool commodity_details)
{ {
property_tree::ptree& st(pt.put("commodity", ""));
std::string flags; std::string flags;
if (! (comm.has_flags(COMMODITY_STYLE_SUFFIXED))) flags += 'P'; if (! (comm.has_flags(COMMODITY_STYLE_SUFFIXED))) flags += 'P';
if (comm.has_flags(COMMODITY_STYLE_SEPARATED)) flags += 'S'; if (comm.has_flags(COMMODITY_STYLE_SEPARATED)) flags += 'S';
@ -512,7 +510,7 @@ void put_commodity(property_tree::ptree& pt, const commodity_t& comm,
st.put("symbol", comm.symbol()); st.put("symbol", comm.symbol());
if (commodity_details && comm.has_annotation()) if (commodity_details && comm.has_annotation())
put_annotation(st, as_annotated_commodity(comm).details); put_annotation(st.put("annotation", ""), as_annotated_commodity(comm).details);
} }
} // namespace ledger } // namespace ledger

9
src/item.cc
View file

@ -600,16 +600,15 @@ string item_context(const item_t& item, const string& desc)
return out.str(); return out.str();
} }
void put_metadata(property_tree::ptree& pt, const item_t::string_map& metadata) void put_metadata(property_tree::ptree& st, const item_t::string_map& metadata)
{ {
property_tree::ptree& st(pt.put("metadata", ""));
foreach (const item_t::string_map::value_type& pair, metadata) { foreach (const item_t::string_map::value_type& pair, metadata) {
if (pair.second.first) { if (pair.second.first) {
property_tree::ptree& vt(st.put("pair", "")); property_tree::ptree& vt(st.add("value", ""));
vt.put("key", pair.first); vt.put("<xmlattr>.key", pair.first);
put_value(vt, *pair.second.first); put_value(vt, *pair.second.first);
} else { } else {
st.put("tag", pair.first); st.add("tag", pair.first);
} }
} }
} }

2
src/mask.h
View file

@ -151,7 +151,7 @@ inline std::ostream& operator<<(std::ostream& out, const mask_t& mask) {
} }
inline void put_mask(property_tree::ptree& pt, const mask_t& mask) { inline void put_mask(property_tree::ptree& pt, const mask_t& mask) {
pt.put("mask", mask.str()); pt.put_value(mask.str());
} }
} // namespace ledger } // namespace ledger

43
src/post.cc
View file

@ -696,10 +696,8 @@ void extend_post(post_t& post, journal_t& journal)
} }
} }
void put_post(property_tree::ptree& pt, const post_t& post) void put_post(property_tree::ptree& st, const post_t& post)
{ {
property_tree::ptree& st(pt.put("posting", ""));
if (post.state() == item_t::CLEARED) if (post.state() == item_t::CLEARED)
st.put("<xmlattr>.state", "cleared"); st.put("<xmlattr>.state", "cleared");
else if (post.state() == item_t::PENDING) else if (post.state() == item_t::PENDING)
@ -710,14 +708,10 @@ void put_post(property_tree::ptree& pt, const post_t& post)
if (post.has_flags(ITEM_GENERATED)) if (post.has_flags(ITEM_GENERATED))
st.put("<xmlattr>.generated", "true"); st.put("<xmlattr>.generated", "true");
if (post._date) { if (post._date)
property_tree::ptree& t(st.put("date", "")); put_date(st.put("date", ""), *post._date);
put_date(t, *post._date, false); if (post._date_aux)
} put_date(st.put("aux-date", ""), *post._date_aux);
if (post._date_aux) {
property_tree::ptree& t(st.put("aux-date", ""));
put_date(t, *post._date_aux, false);
}
if (post.account) { if (post.account) {
property_tree::ptree& t(st.put("account", "")); property_tree::ptree& t(st.put("account", ""));
@ -736,34 +730,27 @@ void put_post(property_tree::ptree& pt, const post_t& post)
if (post.has_xdata() && post.xdata().has_flags(POST_EXT_COMPOUND)) if (post.has_xdata() && post.xdata().has_flags(POST_EXT_COMPOUND))
put_value(t, post.xdata().compound_value); put_value(t, post.xdata().compound_value);
else else
put_amount(t, post.amount); put_amount(t.put("amount", ""), post.amount);
} }
if (post.cost) { if (post.cost)
property_tree::ptree& t(st.put("cost", "")); put_amount(st.put("cost", ""), *post.cost);
put_amount(t, *post.cost, false);
}
if (post.assigned_amount) { if (post.assigned_amount) {
if (post.has_flags(POST_CALCULATED)) { if (post.has_flags(POST_CALCULATED))
property_tree::ptree& t(st.put("balance-assertion", "")); put_amount(st.put("balance-assertion", ""), *post.assigned_amount);
put_amount(t, *post.assigned_amount, false); else
} else { put_amount(st.put("balance-assignment", ""), *post.assigned_amount);
property_tree::ptree& t(st.put("balance-assignment", ""));
put_amount(t, *post.assigned_amount, false);
}
} }
if (post.note) if (post.note)
st.put("note", *post.note); st.put("note", *post.note);
if (post.metadata) if (post.metadata)
put_metadata(st, *post.metadata); put_metadata(st.put("metadata", ""), *post.metadata);
if (post.xdata_ && ! post.xdata_->total.is_null()) { if (post.xdata_ && ! post.xdata_->total.is_null())
property_tree::ptree& t(st.put("total", "")); put_value(st.put("total", ""), post.xdata_->total);
put_value(t, post.xdata_->total);
}
} }
} // namespace ledger } // namespace ledger

18
src/ptree.cc
View file

@ -61,28 +61,28 @@ void format_ptree::flush()
property_tree::ptree& ct(pt.put("ledger.commodities", "")); property_tree::ptree& ct(pt.put("ledger.commodities", ""));
foreach (const commodities_pair& pair, commodities) foreach (const commodities_pair& pair, commodities)
put_commodity(ct, *pair.second, true); put_commodity(ct.add("commodity", ""), *pair.second, true);
property_tree::ptree& at(pt.put("ledger.accounts", "")); property_tree::ptree& at(pt.put("ledger.accounts", ""));
put_account(at, *report.session.journal->master, account_visited_p); put_account(at.add("account", ""), *report.session.journal->master, account_visited_p);
property_tree::ptree& tt(pt.put("ledger.transactions", "")); property_tree::ptree& tt(pt.put("ledger.transactions", ""));
foreach (const xact_t * xact, transactions) { foreach (const xact_t * xact, transactions) {
put_xact(tt, *xact); property_tree::ptree& t(tt.add("transaction", ""));
put_xact(t, *xact);
property_tree::ptree& post_tree(tt.put("postings", "")); property_tree::ptree& post_tree(t.put("postings", ""));
foreach (const post_t * post, xact->posts) foreach (const post_t * post, xact->posts)
if (post->has_xdata() && if (post->has_xdata() &&
post->xdata().has_flags(POST_EXT_VISITED)) post->xdata().has_flags(POST_EXT_VISITED))
put_post(post_tree, *post); put_post(post_tree.add("posting", ""), *post);
} }
switch (format) { switch (format) {
case FORMAT_XML: case FORMAT_XML:
property_tree::write_xml(out, pt); property_tree::xml_writer_settings<char> indented(' ', 2);
break; property_tree::write_xml(out, pt, indented);
case FORMAT_JSON: out << std::endl;
property_tree::write_json(out, pt);
break; break;
} }
} }

3
src/ptree.h
View file

@ -75,8 +75,7 @@ protected:
public: public:
enum format_t { enum format_t {
FORMAT_XML, FORMAT_XML
FORMAT_JSON
} format; } format;
format_ptree(report_t& _report, format_t _format = FORMAT_XML) format_ptree(report_t& _report, format_t _format = FORMAT_XML)

5
src/report.cc
View file

@ -1628,11 +1628,6 @@ expr_t::ptr_op_t report_t::lookup(const symbol_t::kind_t kind,
} }
break; break;
case 'j':
if (is_eq(p, "json"))
return POSTS_REPORTER(new format_ptree(*this,
format_ptree::FORMAT_JSON));
break;
case 'l': case 'l':
if (is_eq(p, "lisp")) if (is_eq(p, "lisp"))
return POSTS_REPORTER(new format_emacs_posts(output_stream)); return POSTS_REPORTER(new format_emacs_posts(output_stream));

1
src/system.hh.in
View file

@ -204,7 +204,6 @@ typedef std::ostream::pos_type ostream_pos_type;
#include <boost/property_tree/ptree.hpp> #include <boost/property_tree/ptree.hpp>
#include <boost/property_tree/xml_parser.hpp> #include <boost/property_tree/xml_parser.hpp>
#include <boost/property_tree/json_parser.hpp>
#include <boost/random/mersenne_twister.hpp> #include <boost/random/mersenne_twister.hpp>
#include <boost/random/uniform_int.hpp> #include <boost/random/uniform_int.hpp>

16
src/times.h
View file

@ -111,20 +111,12 @@ std::string format_date(const date_t& when,
void set_date_format(const char * format); void set_date_format(const char * format);
void set_input_date_format(const char * format); void set_input_date_format(const char * format);
inline void put_datetime(property_tree::ptree& pt, const datetime_t& when, inline void put_datetime(property_tree::ptree& pt, const datetime_t& when) {
bool wrap = true) { pt.put_value(format_datetime(when, FMT_WRITTEN));
if (wrap)
pt.put("datetime", format_datetime(when, FMT_WRITTEN));
else
pt.put_value(format_datetime(when, FMT_WRITTEN));
} }
inline void put_date(property_tree::ptree& pt, const date_t& when, inline void put_date(property_tree::ptree& pt, const date_t& when) {
bool wrap = true) { pt.put_value(format_date(when, FMT_WRITTEN));
if (wrap)
pt.put("date", format_date(when, FMT_WRITTEN));
else
pt.put_value(format_date(when, FMT_WRITTEN));
} }
struct date_traits_t struct date_traits_t

20
src/value.cc
View file

@ -2062,35 +2062,35 @@ void put_value(property_tree::ptree& pt, const value_t& value)
{ {
switch (value.type()) { switch (value.type()) {
case value_t::VOID: case value_t::VOID:
pt.put("void", ""); pt.add("void", "");
break; break;
case value_t::BOOLEAN: case value_t::BOOLEAN:
pt.put("bool", value.as_boolean() ? "true" : "false"); pt.add("bool", value.as_boolean() ? "true" : "false");
break; break;
case value_t::INTEGER: case value_t::INTEGER:
pt.put("int", value.to_string()); pt.add("int", value.to_string());
break; break;
case value_t::AMOUNT: case value_t::AMOUNT:
put_amount(pt, value.as_amount()); put_amount(pt.add("amount", ""), value.as_amount());
break; break;
case value_t::BALANCE: case value_t::BALANCE:
put_balance(pt, value.as_balance()); put_balance(pt.add("balance", ""), value.as_balance());
break; break;
case value_t::DATETIME: case value_t::DATETIME:
put_datetime(pt, value.as_datetime()); put_datetime(pt.add("datetime", ""), value.as_datetime());
break; break;
case value_t::DATE: case value_t::DATE:
put_date(pt, value.as_date()); put_date(pt.add("date", ""), value.as_date());
break; break;
case value_t::STRING: case value_t::STRING:
pt.put("string", value.as_string()); pt.add("string", value.as_string());
break; break;
case value_t::MASK: case value_t::MASK:
put_mask(pt, value.as_mask()); put_mask(pt.add("mask", ""), value.as_mask());
break; break;
case value_t::SEQUENCE: { case value_t::SEQUENCE: {
property_tree::ptree& st(pt.put("sequence", "")); property_tree::ptree& st(pt.add("sequence", ""));
foreach (const value_t& member, value.as_sequence()) foreach (const value_t& member, value.as_sequence())
put_value(st, member); put_value(st, member);
break; break;

18
src/xact.cc
View file

@ -847,10 +847,8 @@ void auto_xact_t::extend_xact(xact_base_t& xact, parse_context_t& context)
} }
} }
void put_xact(property_tree::ptree& pt, const xact_t& xact) void put_xact(property_tree::ptree& st, const xact_t& xact)
{ {
property_tree::ptree& st(pt.put("transaction", ""));
if (xact.state() == item_t::CLEARED) if (xact.state() == item_t::CLEARED)
st.put("<xmlattr>.state", "cleared"); st.put("<xmlattr>.state", "cleared");
else if (xact.state() == item_t::PENDING) else if (xact.state() == item_t::PENDING)
@ -859,14 +857,10 @@ void put_xact(property_tree::ptree& pt, const xact_t& xact)
if (xact.has_flags(ITEM_GENERATED)) if (xact.has_flags(ITEM_GENERATED))
st.put("<xmlattr>.generated", "true"); st.put("<xmlattr>.generated", "true");
if (xact._date) { if (xact._date)
property_tree::ptree& t(st.put("date", "")); put_date(st.put("date", ""), *xact._date);
put_date(t, *xact._date, false); if (xact._date_aux)
} put_date(st.put("aux-date", ""), *xact._date_aux);
if (xact._date_aux) {
property_tree::ptree& t(st.put("aux-date", ""));
put_date(t, *xact._date_aux, false);
}
if (xact.code) if (xact.code)
st.put("code", *xact.code); st.put("code", *xact.code);
@ -877,7 +871,7 @@ void put_xact(property_tree::ptree& pt, const xact_t& xact)
st.put("note", *xact.note); st.put("note", *xact.note);
if (xact.metadata) if (xact.metadata)
put_metadata(st, *xact.metadata); put_metadata(st.put("metadata", ""), *xact.metadata);
} }
} // namespace ledger } // namespace ledger