Indent & untabify
M-x mark-whole-buffer M-x indent-region M-x mark-whole-buffer M-x untabify
This commit is contained in:
thdox
parent
35a36f33aa
commit
d2db0f9102
18 changed files with 1146 additions and 1146 deletions
|
|
@ -42,75 +42,75 @@ This is a cheap way of getting around floating point silliness in subtraction"
|
||||||
"Split a commoditized string, STR, into two parts.
|
"Split a commoditized string, STR, into two parts.
|
||||||
Returns a list with (value commodity)."
|
Returns a list with (value commodity)."
|
||||||
(let ((number-regex (if (assoc "decimal-comma" ledger-environment-alist)
|
(let ((number-regex (if (assoc "decimal-comma" ledger-environment-alist)
|
||||||
ledger-amount-decimal-comma-regex
|
ledger-amount-decimal-comma-regex
|
||||||
ledger-amount-decimal-period-regex)))
|
ledger-amount-decimal-period-regex)))
|
||||||
(if (> (length str) 0)
|
(if (> (length str) 0)
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(insert str)
|
(insert str)
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(cond
|
(cond
|
||||||
((re-search-forward "\"\\(.*\\)\"" nil t) ; look for quoted commodities
|
((re-search-forward "\"\\(.*\\)\"" nil t) ; look for quoted commodities
|
||||||
(let ((com (delete-and-extract-region
|
(let ((com (delete-and-extract-region
|
||||||
(match-beginning 1)
|
(match-beginning 1)
|
||||||
(match-end 1))))
|
(match-end 1))))
|
||||||
(if (re-search-forward
|
(if (re-search-forward
|
||||||
number-regex nil t)
|
number-regex nil t)
|
||||||
(list
|
(list
|
||||||
(ledger-string-to-number
|
(ledger-string-to-number
|
||||||
(delete-and-extract-region (match-beginning 0) (match-end 0)))
|
(delete-and-extract-region (match-beginning 0) (match-end 0)))
|
||||||
com))))
|
com))))
|
||||||
((re-search-forward number-regex nil t)
|
((re-search-forward number-regex nil t)
|
||||||
;; found a number in the current locale, return it in the
|
;; found a number in the current locale, return it in the
|
||||||
;; car. Anything left over is annotation, the first
|
;; car. Anything left over is annotation, the first
|
||||||
;; thing should be the commodity, separated by
|
;; thing should be the commodity, separated by
|
||||||
;; whitespace, return it in the cdr. I can't think of
|
;; whitespace, return it in the cdr. I can't think of
|
||||||
;; any counterexamples
|
;; any counterexamples
|
||||||
(list
|
(list
|
||||||
(ledger-string-to-number
|
(ledger-string-to-number
|
||||||
(delete-and-extract-region (match-beginning 0) (match-end 0)))
|
(delete-and-extract-region (match-beginning 0) (match-end 0)))
|
||||||
(nth 0 (split-string (buffer-substring-no-properties (point-min) (point-max))))))
|
(nth 0 (split-string (buffer-substring-no-properties (point-min) (point-max))))))
|
||||||
((re-search-forward "0" nil t)
|
((re-search-forward "0" nil t)
|
||||||
;; couldn't find a decimal number, look for a single 0,
|
;; couldn't find a decimal number, look for a single 0,
|
||||||
;; indicating account with zero balance
|
;; indicating account with zero balance
|
||||||
(list 0 ledger-reconcile-default-commodity))))
|
(list 0 ledger-reconcile-default-commodity))))
|
||||||
;; nothing found, return 0
|
;; nothing found, return 0
|
||||||
(list 0 ledger-reconcile-default-commodity))))
|
(list 0 ledger-reconcile-default-commodity))))
|
||||||
|
|
||||||
(defun ledger-string-balance-to-commoditized-amount (str)
|
(defun ledger-string-balance-to-commoditized-amount (str)
|
||||||
"Return a commoditized amount (val, 'comm') from STR."
|
"Return a commoditized amount (val, 'comm') from STR."
|
||||||
; break any balances with multi commodities into a list
|
; break any balances with multi commodities into a list
|
||||||
(mapcar #'(lambda (st)
|
(mapcar #'(lambda (st)
|
||||||
(ledger-split-commodity-string st))
|
(ledger-split-commodity-string st))
|
||||||
(split-string str "[\n\r]")))
|
(split-string str "[\n\r]")))
|
||||||
|
|
||||||
(defun -commodity (c1 c2)
|
(defun -commodity (c1 c2)
|
||||||
"Subtract C2 from C1, ensuring their commodities match."
|
"Subtract C2 from C1, ensuring their commodities match."
|
||||||
(if (string= (cadr c1) (cadr c2))
|
(if (string= (cadr c1) (cadr c2))
|
||||||
; the scaling below is to get around inexact
|
; the scaling below is to get around inexact
|
||||||
; subtraction results where, for example 1.23
|
; subtraction results where, for example 1.23
|
||||||
; - 4.56 = -3.3299999999999996 instead of
|
; - 4.56 = -3.3299999999999996 instead of
|
||||||
; -3.33
|
; -3.33
|
||||||
(list (/ (- (* ledger-scale (car c1)) (* ledger-scale (car c2))) ledger-scale) (cadr c1))
|
(list (/ (- (* ledger-scale (car c1)) (* ledger-scale (car c2))) ledger-scale) (cadr c1))
|
||||||
(error "Can't subtract different commodities %S from %S" c2 c1)))
|
(error "Can't subtract different commodities %S from %S" c2 c1)))
|
||||||
|
|
||||||
(defun +commodity (c1 c2)
|
(defun +commodity (c1 c2)
|
||||||
"Add C1 and C2, ensuring their commodities match."
|
"Add C1 and C2, ensuring their commodities match."
|
||||||
(if (string= (cadr c1) (cadr c2))
|
(if (string= (cadr c1) (cadr c2))
|
||||||
(list (+ (car c1) (car c2)) (cadr c1))
|
(list (+ (car c1) (car c2)) (cadr c1))
|
||||||
(error "Can't add different commodities, %S to %S" c1 c2)))
|
(error "Can't add different commodities, %S to %S" c1 c2)))
|
||||||
|
|
||||||
(defun ledger-strip (str char)
|
(defun ledger-strip (str char)
|
||||||
(let (new-str)
|
(let (new-str)
|
||||||
(concat (dolist (ch (append str nil) new-str)
|
(concat (dolist (ch (append str nil) new-str)
|
||||||
(unless (= ch char)
|
(unless (= ch char)
|
||||||
(setq new-str (append new-str (list ch))))))))
|
(setq new-str (append new-str (list ch))))))))
|
||||||
|
|
||||||
(defun ledger-string-to-number (str &optional decimal-comma)
|
(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"
|
"improve builtin string-to-number by handling internationalization, and return nil if number can't be parsed"
|
||||||
(let ((nstr (if (or decimal-comma
|
(let ((nstr (if (or decimal-comma
|
||||||
(assoc "decimal-comma" ledger-environment-alist))
|
(assoc "decimal-comma" ledger-environment-alist))
|
||||||
(ledger-strip str ?.)
|
(ledger-strip str ?.)
|
||||||
(ledger-strip str ?,))))
|
(ledger-strip str ?,))))
|
||||||
(while (string-match "," nstr) ;if there is a comma now, it is a thousands separator
|
(while (string-match "," nstr) ;if there is a comma now, it is a thousands separator
|
||||||
(setq nstr (replace-match "." nil nil nstr)))
|
(setq nstr (replace-match "." nil nil nstr)))
|
||||||
(string-to-number nstr)))
|
(string-to-number nstr)))
|
||||||
|
|
@ -128,22 +128,22 @@ Returns a list with (value commodity)."
|
||||||
Single character commodities are placed ahead of the value,
|
Single character commodities are placed ahead of the value,
|
||||||
longer ones are after the value."
|
longer ones are after the value."
|
||||||
(let ((str (ledger-number-to-string (car c1)))
|
(let ((str (ledger-number-to-string (car c1)))
|
||||||
(commodity (cadr c1)))
|
(commodity (cadr c1)))
|
||||||
(if (> (length commodity) 1)
|
(if (> (length commodity) 1)
|
||||||
(concat str " " commodity)
|
(concat str " " commodity)
|
||||||
(concat commodity " " str))))
|
(concat commodity " " str))))
|
||||||
|
|
||||||
(defun ledger-read-commodity-string (prompt)
|
(defun ledger-read-commodity-string (prompt)
|
||||||
(let ((str (read-from-minibuffer
|
(let ((str (read-from-minibuffer
|
||||||
(concat prompt " (" ledger-reconcile-default-commodity "): ")))
|
(concat prompt " (" ledger-reconcile-default-commodity "): ")))
|
||||||
comm)
|
comm)
|
||||||
(if (and (> (length str) 0)
|
(if (and (> (length str) 0)
|
||||||
(ledger-split-commodity-string str))
|
(ledger-split-commodity-string str))
|
||||||
(progn
|
(progn
|
||||||
(setq comm (ledger-split-commodity-string str))
|
(setq comm (ledger-split-commodity-string str))
|
||||||
(if (cadr comm)
|
(if (cadr comm)
|
||||||
comm
|
comm
|
||||||
(list (car comm) ledger-reconcile-default-commodity))))))
|
(list (car comm) ledger-reconcile-default-commodity))))))
|
||||||
|
|
||||||
(provide 'ledger-commodities)
|
(provide 'ledger-commodities)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -34,8 +34,8 @@
|
||||||
;; with pcomplete. See pcomplete-parse-arguments-function for
|
;; with pcomplete. See pcomplete-parse-arguments-function for
|
||||||
;; details
|
;; details
|
||||||
(let* ((begin (save-excursion
|
(let* ((begin (save-excursion
|
||||||
(ledger-thing-at-point) ;; leave point at beginning of thing under point
|
(ledger-thing-at-point) ;; leave point at beginning of thing under point
|
||||||
(point)))
|
(point)))
|
||||||
(end (point))
|
(end (point))
|
||||||
begins args)
|
begins args)
|
||||||
;; to support end of line metadata
|
;; to support end of line metadata
|
||||||
|
|
@ -65,7 +65,7 @@
|
||||||
(unless (and (>= origin (match-beginning 0))
|
(unless (and (>= origin (match-beginning 0))
|
||||||
(< origin (match-end 0)))
|
(< origin (match-end 0)))
|
||||||
(setq payees-list (cons (match-string-no-properties 3)
|
(setq payees-list (cons (match-string-no-properties 3)
|
||||||
payees-list))))) ;; add the payee
|
payees-list))))) ;; add the payee
|
||||||
;; to the list
|
;; to the list
|
||||||
(pcomplete-uniqify-list (nreverse payees-list))))
|
(pcomplete-uniqify-list (nreverse payees-list))))
|
||||||
|
|
||||||
|
|
@ -73,33 +73,33 @@
|
||||||
(defun ledger-find-accounts-in-buffer ()
|
(defun ledger-find-accounts-in-buffer ()
|
||||||
(interactive)
|
(interactive)
|
||||||
(let ((origin (point))
|
(let ((origin (point))
|
||||||
accounts
|
accounts
|
||||||
(account-tree (list t))
|
(account-tree (list t))
|
||||||
(account-elements nil)
|
(account-elements nil)
|
||||||
(seed-regex (ledger-account-any-status-with-seed-regex
|
(seed-regex (ledger-account-any-status-with-seed-regex
|
||||||
(regexp-quote (car pcomplete-args)))))
|
(regexp-quote (car pcomplete-args)))))
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
|
|
||||||
(dolist (account
|
(dolist (account
|
||||||
(delete-dups
|
(delete-dups
|
||||||
(progn
|
(progn
|
||||||
(while (re-search-forward seed-regex nil t)
|
(while (re-search-forward seed-regex nil t)
|
||||||
(unless (between origin (match-beginning 0) (match-end 0))
|
(unless (between origin (match-beginning 0) (match-end 0))
|
||||||
(setq accounts (cons (match-string-no-properties 2) accounts))))
|
(setq accounts (cons (match-string-no-properties 2) accounts))))
|
||||||
accounts)))
|
accounts)))
|
||||||
(let ((root account-tree))
|
(let ((root account-tree))
|
||||||
(setq account-elements
|
(setq account-elements
|
||||||
(split-string
|
(split-string
|
||||||
account ":"))
|
account ":"))
|
||||||
(while account-elements
|
(while account-elements
|
||||||
(let ((xact (assoc (car account-elements) root)))
|
(let ((xact (assoc (car account-elements) root)))
|
||||||
(if xact
|
(if xact
|
||||||
(setq root (cdr xact))
|
(setq root (cdr xact))
|
||||||
(setq xact (cons (car account-elements) (list t)))
|
(setq xact (cons (car account-elements) (list t)))
|
||||||
(nconc root (list xact))
|
(nconc root (list xact))
|
||||||
(setq root (cdr xact))))
|
(setq root (cdr xact))))
|
||||||
(setq account-elements (cdr account-elements))))))
|
(setq account-elements (cdr account-elements))))))
|
||||||
account-tree))
|
account-tree))
|
||||||
|
|
||||||
(defun ledger-find-metadata-in-buffer ()
|
(defun ledger-find-metadata-in-buffer ()
|
||||||
|
|
@ -129,19 +129,19 @@ Return list."
|
||||||
(setq prefix (concat prefix (and prefix ":")
|
(setq prefix (concat prefix (and prefix ":")
|
||||||
(car elements))
|
(car elements))
|
||||||
root (cdr xact))
|
root (cdr xact))
|
||||||
(setq root nil elements nil)))
|
(setq root nil elements nil)))
|
||||||
(setq elements (cdr elements)))
|
(setq elements (cdr elements)))
|
||||||
(setq root (delete (list (car elements) t) root))
|
(setq root (delete (list (car elements) t) root))
|
||||||
(and root
|
(and root
|
||||||
(sort
|
(sort
|
||||||
(mapcar (function
|
(mapcar (function
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(let ((term (if prefix
|
(let ((term (if prefix
|
||||||
(concat prefix ":" (car x))
|
(concat prefix ":" (car x))
|
||||||
(car x))))
|
(car x))))
|
||||||
(if (> (length (cdr x)) 1)
|
(if (> (length (cdr x)) 1)
|
||||||
(concat term ":")
|
(concat term ":")
|
||||||
term))))
|
term))))
|
||||||
(cdr root))
|
(cdr root))
|
||||||
'string-lessp))))
|
'string-lessp))))
|
||||||
|
|
||||||
|
|
@ -155,44 +155,44 @@ Return list."
|
||||||
(delete
|
(delete
|
||||||
(caar (ledger-parse-arguments))
|
(caar (ledger-parse-arguments))
|
||||||
(ledger-payees-in-buffer)) ;; this completes against payee names
|
(ledger-payees-in-buffer)) ;; this completes against payee names
|
||||||
(progn
|
(progn
|
||||||
(let ((text (buffer-substring-no-properties
|
(let ((text (buffer-substring-no-properties
|
||||||
(line-beginning-position)
|
(line-beginning-position)
|
||||||
(line-end-position))))
|
(line-end-position))))
|
||||||
(delete-region (line-beginning-position)
|
(delete-region (line-beginning-position)
|
||||||
(line-end-position))
|
(line-end-position))
|
||||||
(condition-case nil
|
(condition-case nil
|
||||||
(ledger-add-transaction text t)
|
(ledger-add-transaction text t)
|
||||||
(error nil)))
|
(error nil)))
|
||||||
(forward-line)
|
(forward-line)
|
||||||
(goto-char (line-end-position))
|
(goto-char (line-end-position))
|
||||||
(search-backward ";" (line-beginning-position) t)
|
(search-backward ";" (line-beginning-position) t)
|
||||||
(skip-chars-backward " \t0123456789.,")
|
(skip-chars-backward " \t0123456789.,")
|
||||||
(throw 'pcompleted t)))
|
(throw 'pcompleted t)))
|
||||||
(ledger-accounts)))))
|
(ledger-accounts)))))
|
||||||
|
|
||||||
(defun ledger-trim-trailing-whitespace (str)
|
(defun ledger-trim-trailing-whitespace (str)
|
||||||
(let ((s str))
|
(let ((s str))
|
||||||
(when (string-match "[ \t]*$" s)
|
(when (string-match "[ \t]*$" s)
|
||||||
(replace-match "" nil nil s))))
|
(replace-match "" nil nil s))))
|
||||||
|
|
||||||
(defun ledger-fully-complete-xact ()
|
(defun ledger-fully-complete-xact ()
|
||||||
"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 (ledger-trim-trailing-whitespace (caar (ledger-parse-arguments))))
|
(let* ((name (ledger-trim-trailing-whitespace (caar (ledger-parse-arguments))))
|
||||||
(rest-of-name 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)))
|
(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)
|
(regexp-quote name) ".*\\)" ) nil t)
|
||||||
(setq rest-of-name (match-string 3))
|
(setq rest-of-name (match-string 3))
|
||||||
;; Start copying the postings
|
;; Start copying the postings
|
||||||
(forward-line)
|
(forward-line)
|
||||||
(while (looking-at ledger-account-any-status-regex)
|
(while (looking-at ledger-account-any-status-regex)
|
||||||
(setq xacts (cons (buffer-substring-no-properties
|
(setq xacts (cons (buffer-substring-no-properties
|
||||||
(line-beginning-position)
|
(line-beginning-position)
|
||||||
|
|
@ -203,7 +203,7 @@ Does not use ledger xact"
|
||||||
;; Insert rest-of-name and the postings
|
;; Insert rest-of-name and the postings
|
||||||
(when xacts
|
(when xacts
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(insert rest-of-name ?\n)
|
(insert rest-of-name ?\n)
|
||||||
(while xacts
|
(while xacts
|
||||||
(insert (car xacts) ?\n)
|
(insert (car xacts) ?\n)
|
||||||
(setq xacts (cdr xacts))))
|
(setq xacts (cdr xacts))))
|
||||||
|
|
@ -214,54 +214,54 @@ Does not use ledger xact"
|
||||||
|
|
||||||
|
|
||||||
(defcustom ledger-complete-ignore-case t
|
(defcustom ledger-complete-ignore-case t
|
||||||
"Non-nil means that ledger-complete-at-point will be case-insensitive"
|
"Non-nil means that ledger-complete-at-point will be case-insensitive"
|
||||||
:type 'boolean
|
:type 'boolean
|
||||||
:group 'ledger)
|
:group 'ledger)
|
||||||
|
|
||||||
(defun ledger-pcomplete (&optional interactively)
|
(defun ledger-pcomplete (&optional interactively)
|
||||||
"Complete rip-off of pcomplete from pcomplete.el, only added
|
"Complete rip-off of pcomplete from pcomplete.el, only added
|
||||||
ledger-magic-tab in the previous commands list so that
|
ledger-magic-tab in the previous commands list so that
|
||||||
ledger-magic-tab would cycle properly"
|
ledger-magic-tab would cycle properly"
|
||||||
(interactive "p")
|
(interactive "p")
|
||||||
(let ((pcomplete-ignore-case ledger-complete-ignore-case))
|
(let ((pcomplete-ignore-case ledger-complete-ignore-case))
|
||||||
(if (and interactively
|
(if (and interactively
|
||||||
pcomplete-cycle-completions
|
pcomplete-cycle-completions
|
||||||
pcomplete-current-completions
|
pcomplete-current-completions
|
||||||
(memq last-command '(ledger-magic-tab
|
(memq last-command '(ledger-magic-tab
|
||||||
ledger-pcomplete
|
ledger-pcomplete
|
||||||
pcomplete-expand-and-complete
|
pcomplete-expand-and-complete
|
||||||
pcomplete-reverse)))
|
pcomplete-reverse)))
|
||||||
(progn
|
(progn
|
||||||
(delete-backward-char pcomplete-last-completion-length)
|
(delete-backward-char pcomplete-last-completion-length)
|
||||||
(if (eq this-command 'pcomplete-reverse)
|
(if (eq this-command 'pcomplete-reverse)
|
||||||
(progn
|
(progn
|
||||||
(push (car (last pcomplete-current-completions))
|
(push (car (last pcomplete-current-completions))
|
||||||
pcomplete-current-completions)
|
pcomplete-current-completions)
|
||||||
(setcdr (last pcomplete-current-completions 2) nil))
|
(setcdr (last pcomplete-current-completions 2) nil))
|
||||||
(nconc pcomplete-current-completions
|
(nconc pcomplete-current-completions
|
||||||
(list (car pcomplete-current-completions)))
|
(list (car pcomplete-current-completions)))
|
||||||
(setq pcomplete-current-completions
|
(setq pcomplete-current-completions
|
||||||
(cdr pcomplete-current-completions)))
|
(cdr pcomplete-current-completions)))
|
||||||
(pcomplete-insert-entry pcomplete-last-completion-stub
|
(pcomplete-insert-entry pcomplete-last-completion-stub
|
||||||
(car pcomplete-current-completions)
|
(car pcomplete-current-completions)
|
||||||
nil pcomplete-last-completion-raw))
|
nil pcomplete-last-completion-raw))
|
||||||
(setq pcomplete-current-completions nil
|
(setq pcomplete-current-completions nil
|
||||||
pcomplete-last-completion-raw nil)
|
pcomplete-last-completion-raw nil)
|
||||||
(catch 'pcompleted
|
(catch 'pcompleted
|
||||||
(let* ((pcomplete-stub)
|
(let* ((pcomplete-stub)
|
||||||
pcomplete-seen pcomplete-norm-func
|
pcomplete-seen pcomplete-norm-func
|
||||||
pcomplete-args pcomplete-last pcomplete-index
|
pcomplete-args pcomplete-last pcomplete-index
|
||||||
(pcomplete-autolist pcomplete-autolist)
|
(pcomplete-autolist pcomplete-autolist)
|
||||||
(pcomplete-suffix-list pcomplete-suffix-list)
|
(pcomplete-suffix-list pcomplete-suffix-list)
|
||||||
(completions (pcomplete-completions))
|
(completions (pcomplete-completions))
|
||||||
(result (pcomplete-do-complete pcomplete-stub completions)))
|
(result (pcomplete-do-complete pcomplete-stub completions)))
|
||||||
(and result
|
(and result
|
||||||
(not (eq (car result) 'listed))
|
(not (eq (car result) 'listed))
|
||||||
(cdr result)
|
(cdr result)
|
||||||
(pcomplete-insert-entry pcomplete-stub (cdr result)
|
(pcomplete-insert-entry pcomplete-stub (cdr result)
|
||||||
(memq (car result)
|
(memq (car result)
|
||||||
'(sole shortest))
|
'(sole shortest))
|
||||||
pcomplete-last-completion-raw)))))))
|
pcomplete-last-completion-raw)))))))
|
||||||
|
|
||||||
(provide 'ledger-complete)
|
(provide 'ledger-complete)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -54,16 +54,16 @@
|
||||||
|
|
||||||
(defconst ledger-line-config
|
(defconst ledger-line-config
|
||||||
(list (list 'xact (list (ledger-single-line-config date nil status nil code nil payee nil comment)
|
(list (list 'xact (list (ledger-single-line-config date nil status nil code nil payee nil comment)
|
||||||
(ledger-single-line-config date nil status nil code nil payee)
|
(ledger-single-line-config date nil status nil code nil payee)
|
||||||
(ledger-single-line-config date nil status nil payee)))
|
(ledger-single-line-config date nil status nil payee)))
|
||||||
(list 'acct-transaction (list (ledger-single-line-config indent comment)
|
(list 'acct-transaction (list (ledger-single-line-config indent comment)
|
||||||
(ledger-single-line-config indent status account nil commodity amount nil comment)
|
(ledger-single-line-config indent status account nil commodity amount nil comment)
|
||||||
(ledger-single-line-config indent status account nil commodity amount)
|
(ledger-single-line-config indent status account nil commodity amount)
|
||||||
(ledger-single-line-config indent status account nil amount nil commodity comment)
|
(ledger-single-line-config indent status account nil amount nil commodity comment)
|
||||||
(ledger-single-line-config indent status account nil amount nil commodity)
|
(ledger-single-line-config indent status account nil amount nil commodity)
|
||||||
(ledger-single-line-config indent status account nil amount)
|
(ledger-single-line-config indent status account nil amount)
|
||||||
(ledger-single-line-config indent status account nil comment)
|
(ledger-single-line-config indent status account nil comment)
|
||||||
(ledger-single-line-config indent status account)))))
|
(ledger-single-line-config indent status account)))))
|
||||||
|
|
||||||
(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.
|
||||||
|
|
@ -97,7 +97,7 @@ Leave point at the beginning of the thing under point"
|
||||||
(let ((here (point)))
|
(let ((here (point)))
|
||||||
(goto-char (line-beginning-position))
|
(goto-char (line-beginning-position))
|
||||||
(cond ((looking-at "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+")
|
(cond ((looking-at "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+")
|
||||||
(goto-char (match-end 0))
|
(goto-char (match-end 0))
|
||||||
'transaction)
|
'transaction)
|
||||||
((looking-at "^\\s-+\\([*!]\\s-+\\)?[[(]?\\([^\\s-]\\)")
|
((looking-at "^\\s-+\\([*!]\\s-+\\)?[[(]?\\([^\\s-]\\)")
|
||||||
(goto-char (match-beginning 2))
|
(goto-char (match-beginning 2))
|
||||||
|
|
@ -162,7 +162,7 @@ specified line, returns nil."
|
||||||
(let ((left (forward-line offset)))
|
(let ((left (forward-line offset)))
|
||||||
(if (not (equal left 0))
|
(if (not (equal left 0))
|
||||||
nil
|
nil
|
||||||
(ledger-context-at-point)))))
|
(ledger-context-at-point)))))
|
||||||
|
|
||||||
(defun ledger-context-line-type (context-info)
|
(defun ledger-context-line-type (context-info)
|
||||||
(nth 0 context-info))
|
(nth 0 context-info))
|
||||||
|
|
|
||||||
|
|
@ -36,9 +36,9 @@
|
||||||
:group 'ledger)
|
:group 'ledger)
|
||||||
|
|
||||||
(defcustom ledger-mode-should-check-version t
|
(defcustom ledger-mode-should-check-version t
|
||||||
"Should Ledger-mode verify that the executable is working"
|
"Should Ledger-mode verify that the executable is working"
|
||||||
:type 'boolean
|
:type 'boolean
|
||||||
:group 'ledger-exec)
|
:group 'ledger-exec)
|
||||||
|
|
||||||
(defcustom ledger-binary-path "ledger"
|
(defcustom ledger-binary-path "ledger"
|
||||||
"Path to the ledger executable."
|
"Path to the ledger executable."
|
||||||
|
|
@ -56,26 +56,26 @@
|
||||||
(with-current-buffer ledger-output-buffer
|
(with-current-buffer ledger-output-buffer
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(if (and (> (buffer-size) 1) (looking-at (regexp-quote "While")))
|
(if (and (> (buffer-size) 1) (looking-at (regexp-quote "While")))
|
||||||
nil ;; failure, there is an error starting with "While"
|
nil ;; failure, there is an error starting with "While"
|
||||||
ledger-output-buffer)))
|
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)))
|
||||||
(if (ledger-exec-success-p outbuf)
|
(if (ledger-exec-success-p outbuf)
|
||||||
outbuf
|
outbuf
|
||||||
(ledger-exec-handle-error outbuf))))))
|
(ledger-exec-handle-error outbuf))))))
|
||||||
|
|
||||||
(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)."
|
||||||
|
|
@ -83,24 +83,24 @@
|
||||||
(version-strings '()))
|
(version-strings '()))
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(when (ledger-exec-ledger (current-buffer) (current-buffer) "--version")
|
(when (ledger-exec-ledger (current-buffer) (current-buffer) "--version")
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(delete-horizontal-space)
|
(delete-horizontal-space)
|
||||||
(setq version-strings (split-string
|
(setq version-strings (split-string
|
||||||
(buffer-substring-no-properties (point)
|
(buffer-substring-no-properties (point)
|
||||||
(point-max))))
|
(point-max))))
|
||||||
(if (and (string-match (regexp-quote "Ledger") (car version-strings))
|
(if (and (string-match (regexp-quote "Ledger") (car version-strings))
|
||||||
(or (string= needed (cadr version-strings))
|
(or (string= needed (cadr version-strings))
|
||||||
(string< needed (cadr version-strings))))
|
(string< needed (cadr version-strings))))
|
||||||
t ;; success
|
t ;; success
|
||||||
nil))))) ;;failure
|
nil))))) ;;failure
|
||||||
|
|
||||||
(defun ledger-check-version ()
|
(defun ledger-check-version ()
|
||||||
"Verify that ledger works and is modern enough."
|
"Verify that ledger works and is modern enough."
|
||||||
(interactive)
|
(interactive)
|
||||||
(if ledger-mode-should-check-version
|
(if ledger-mode-should-check-version
|
||||||
(if (setq ledger-works (ledger-version-greater-p ledger-version-needed))
|
(if (setq ledger-works (ledger-version-greater-p ledger-version-needed))
|
||||||
(message "Good Ledger Version")
|
(message "Good Ledger Version")
|
||||||
(message "Bad Ledger Version"))))
|
(message "Bad Ledger Version"))))
|
||||||
|
|
||||||
(provide 'ledger-exec)
|
(provide 'ledger-exec)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -30,108 +30,108 @@
|
||||||
|
|
||||||
(defgroup ledger-faces nil "Ledger mode highlighting" :group 'ledger)
|
(defgroup ledger-faces nil "Ledger mode highlighting" :group 'ledger)
|
||||||
(defface ledger-font-payee-uncleared-face
|
(defface ledger-font-payee-uncleared-face
|
||||||
`((t :foreground "#dc322f" :weight bold ))
|
`((t :foreground "#dc322f" :weight bold ))
|
||||||
"Default face for Ledger"
|
"Default face for Ledger"
|
||||||
:group 'ledger-faces)
|
:group 'ledger-faces)
|
||||||
|
|
||||||
(defface ledger-font-payee-cleared-face
|
(defface ledger-font-payee-cleared-face
|
||||||
`((t :foreground "#657b83" :weight normal ))
|
`((t :foreground "#657b83" :weight normal ))
|
||||||
"Default face for cleared (*) transactions"
|
"Default face for cleared (*) transactions"
|
||||||
:group 'ledger-faces)
|
:group 'ledger-faces)
|
||||||
|
|
||||||
(defface ledger-font-xact-highlight-face
|
(defface ledger-font-xact-highlight-face
|
||||||
`((((background dark)) :background "#1a1a1a" )
|
`((((background dark)) :background "#1a1a1a" )
|
||||||
(t :background "#eee8d5"))
|
(t :background "#eee8d5"))
|
||||||
"Default face for transaction under point"
|
"Default face for transaction under point"
|
||||||
:group 'ledger-faces)
|
:group 'ledger-faces)
|
||||||
|
|
||||||
(defface ledger-font-pending-face
|
(defface ledger-font-pending-face
|
||||||
`((t :foreground "#cb4b16" :weight normal ))
|
`((t :foreground "#cb4b16" :weight normal ))
|
||||||
"Default face for pending (!) transactions"
|
"Default face for pending (!) transactions"
|
||||||
:group 'ledger-faces)
|
:group 'ledger-faces)
|
||||||
|
|
||||||
(defface ledger-font-other-face
|
(defface ledger-font-other-face
|
||||||
`((t :foreground "#657b83" ))
|
`((t :foreground "#657b83" ))
|
||||||
"Default face for other transactions"
|
"Default face for other transactions"
|
||||||
:group 'ledger-faces)
|
:group 'ledger-faces)
|
||||||
|
|
||||||
(defface ledger-font-posting-account-face
|
(defface ledger-font-posting-account-face
|
||||||
`((t :foreground "#268bd2" ))
|
`((t :foreground "#268bd2" ))
|
||||||
"Face for Ledger accounts"
|
"Face for Ledger accounts"
|
||||||
:group 'ledger-faces)
|
:group 'ledger-faces)
|
||||||
|
|
||||||
(defface ledger-font-posting-account-cleared-face
|
(defface ledger-font-posting-account-cleared-face
|
||||||
`((t :foreground "#657b83" ))
|
`((t :foreground "#657b83" ))
|
||||||
"Face for Ledger accounts"
|
"Face for Ledger accounts"
|
||||||
:group 'ledger-faces)
|
:group 'ledger-faces)
|
||||||
|
|
||||||
(defface ledger-font-posting-account-pending-face
|
(defface ledger-font-posting-account-pending-face
|
||||||
`((t :foreground "#cb4b16" ))
|
`((t :foreground "#cb4b16" ))
|
||||||
"Face for Ledger accounts"
|
"Face for Ledger accounts"
|
||||||
:group 'ledger-faces)
|
:group 'ledger-faces)
|
||||||
|
|
||||||
(defface ledger-font-posting-amount-face
|
(defface ledger-font-posting-amount-face
|
||||||
`((t :foreground "#cb4b16" ))
|
`((t :foreground "#cb4b16" ))
|
||||||
"Face for Ledger amounts"
|
"Face for Ledger amounts"
|
||||||
:group 'ledger-faces)
|
:group 'ledger-faces)
|
||||||
|
|
||||||
(defface ledger-occur-narrowed-face
|
(defface ledger-occur-narrowed-face
|
||||||
`((t :foreground "grey70" :invisible t ))
|
`((t :foreground "grey70" :invisible t ))
|
||||||
"Default face for Ledger occur mode hidden transactions"
|
"Default face for Ledger occur mode hidden transactions"
|
||||||
:group 'ledger-faces)
|
:group 'ledger-faces)
|
||||||
|
|
||||||
(defface ledger-occur-xact-face
|
(defface ledger-occur-xact-face
|
||||||
`((((background dark)) :background "#1a1a1a" )
|
`((((background dark)) :background "#1a1a1a" )
|
||||||
(t :background "#eee8d5" ))
|
(t :background "#eee8d5" ))
|
||||||
"Default face for Ledger occur mode shown transactions"
|
"Default face for Ledger occur mode shown transactions"
|
||||||
:group 'ledger-faces)
|
:group 'ledger-faces)
|
||||||
|
|
||||||
(defface ledger-font-comment-face
|
(defface ledger-font-comment-face
|
||||||
`((t :foreground "#93a1a1" :slant italic))
|
`((t :foreground "#93a1a1" :slant italic))
|
||||||
"Face for Ledger comments"
|
"Face for Ledger comments"
|
||||||
:group 'ledger-faces)
|
:group 'ledger-faces)
|
||||||
|
|
||||||
(defface ledger-font-reconciler-uncleared-face
|
(defface ledger-font-reconciler-uncleared-face
|
||||||
`((t :foreground "#dc322f" :weight bold ))
|
`((t :foreground "#dc322f" :weight bold ))
|
||||||
"Default face for uncleared transactions in the reconcile window"
|
"Default face for uncleared transactions in the reconcile window"
|
||||||
:group 'ledger-faces)
|
:group 'ledger-faces)
|
||||||
|
|
||||||
(defface ledger-font-reconciler-cleared-face
|
(defface ledger-font-reconciler-cleared-face
|
||||||
`((t :foreground "#657b83" :weight normal ))
|
`((t :foreground "#657b83" :weight normal ))
|
||||||
"Default face for cleared (*) transactions in the reconcile window"
|
"Default face for cleared (*) transactions in the reconcile window"
|
||||||
:group 'ledger-faces)
|
:group 'ledger-faces)
|
||||||
|
|
||||||
(defface ledger-font-reconciler-pending-face
|
(defface ledger-font-reconciler-pending-face
|
||||||
`((t :foreground "#cb4b16" :weight normal ))
|
`((t :foreground "#cb4b16" :weight normal ))
|
||||||
"Default face for pending (!) transactions in the reconcile window"
|
"Default face for pending (!) transactions in the reconcile window"
|
||||||
:group 'ledger-faces)
|
:group 'ledger-faces)
|
||||||
|
|
||||||
(defface ledger-font-report-clickable-face
|
(defface ledger-font-report-clickable-face
|
||||||
`((t :foreground "#cb4b16" :weight normal ))
|
`((t :foreground "#cb4b16" :weight normal ))
|
||||||
"Default face for pending (!) transactions in the reconcile window"
|
"Default face for pending (!) transactions in the reconcile window"
|
||||||
:group 'ledger-faces)
|
:group 'ledger-faces)
|
||||||
|
|
||||||
|
|
||||||
(defvar ledger-font-lock-keywords
|
(defvar ledger-font-lock-keywords
|
||||||
`( ;; (,ledger-other-entries-regex 1
|
`( ;; (,ledger-other-entries-regex 1
|
||||||
;; ledger-font-other-face)
|
;; ledger-font-other-face)
|
||||||
(,ledger-comment-regex 0
|
(,ledger-comment-regex 0
|
||||||
'ledger-font-comment-face)
|
'ledger-font-comment-face)
|
||||||
(,ledger-multiline-comment-regex 0 'ledger-font-comment-face)
|
(,ledger-multiline-comment-regex 0 'ledger-font-comment-face)
|
||||||
(,ledger-payee-pending-regex 2
|
(,ledger-payee-pending-regex 2
|
||||||
'ledger-font-payee-pending-face) ; Works
|
'ledger-font-payee-pending-face) ; Works
|
||||||
(,ledger-payee-cleared-regex 2
|
(,ledger-payee-cleared-regex 2
|
||||||
'ledger-font-payee-cleared-face) ; Works
|
'ledger-font-payee-cleared-face) ; Works
|
||||||
(,ledger-payee-uncleared-regex 2
|
(,ledger-payee-uncleared-regex 2
|
||||||
'ledger-font-payee-uncleared-face) ; Works
|
'ledger-font-payee-uncleared-face) ; Works
|
||||||
(,ledger-account-cleared-regex 2
|
(,ledger-account-cleared-regex 2
|
||||||
'ledger-font-posting-account-cleared-face) ; Works
|
'ledger-font-posting-account-cleared-face) ; Works
|
||||||
(,ledger-account-pending-regex 2
|
(,ledger-account-pending-regex 2
|
||||||
'ledger-font-posting-account-pending-face) ; Works
|
'ledger-font-posting-account-pending-face) ; Works
|
||||||
(,ledger-account-any-status-regex 2
|
(,ledger-account-any-status-regex 2
|
||||||
'ledger-font-posting-account-face) ; Works
|
'ledger-font-posting-account-face) ; Works
|
||||||
(,ledger-other-entries-regex 1
|
(,ledger-other-entries-regex 1
|
||||||
'ledger-font-other-face))
|
'ledger-font-other-face))
|
||||||
"Expressions to highlight in Ledger mode.")
|
"Expressions to highlight in Ledger mode.")
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -37,34 +37,34 @@
|
||||||
(let (environment-alist)
|
(let (environment-alist)
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(while (re-search-forward ledger-init-string-regex nil t )
|
(while (re-search-forward ledger-init-string-regex nil t )
|
||||||
(let ((matchb (match-beginning 0)) ;; save the match data, string-match stamp on it
|
(let ((matchb (match-beginning 0)) ;; save the match data, string-match stamp on it
|
||||||
(matche (match-end 0)))
|
(matche (match-end 0)))
|
||||||
(end-of-line)
|
(end-of-line)
|
||||||
(setq environment-alist
|
(setq environment-alist
|
||||||
(append environment-alist
|
(append environment-alist
|
||||||
(list (cons (let ((flag (buffer-substring-no-properties (+ 2 matchb) matche)))
|
(list (cons (let ((flag (buffer-substring-no-properties (+ 2 matchb) matche)))
|
||||||
(if (string-match "[ \t\n\r]+\\'" flag)
|
(if (string-match "[ \t\n\r]+\\'" flag)
|
||||||
(replace-match "" t t flag)
|
(replace-match "" t t flag)
|
||||||
flag))
|
flag))
|
||||||
(let ((value (buffer-substring-no-properties matche (point) )))
|
(let ((value (buffer-substring-no-properties matche (point) )))
|
||||||
(if (> (length value) 0)
|
(if (> (length value) 0)
|
||||||
value
|
value
|
||||||
t))))))))
|
t))))))))
|
||||||
environment-alist)))
|
environment-alist)))
|
||||||
|
|
||||||
(defun ledger-init-load-init-file ()
|
(defun ledger-init-load-init-file ()
|
||||||
(interactive)
|
(interactive)
|
||||||
(let ((init-base-name (file-name-nondirectory ledger-init-file-name)))
|
(let ((init-base-name (file-name-nondirectory ledger-init-file-name)))
|
||||||
(if (get-buffer init-base-name) ;; init file already loaded, parse it and leave it
|
(if (get-buffer init-base-name) ;; init file already loaded, parse it and leave it
|
||||||
(setq ledger-environment-alist
|
(setq ledger-environment-alist
|
||||||
(ledger-init-parse-initialization init-base-name))
|
(ledger-init-parse-initialization init-base-name))
|
||||||
(when (and ledger-init-file-name
|
(when (and ledger-init-file-name
|
||||||
(file-exists-p ledger-init-file-name)
|
(file-exists-p ledger-init-file-name)
|
||||||
(file-readable-p ledger-init-file-name))
|
(file-readable-p ledger-init-file-name))
|
||||||
(find-file-noselect ledger-init-file-name)
|
(find-file-noselect ledger-init-file-name)
|
||||||
(setq ledger-environment-alist
|
(setq ledger-environment-alist
|
||||||
(ledger-init-parse-initialization init-base-name))
|
(ledger-init-parse-initialization init-base-name))
|
||||||
(kill-buffer init-base-name)))))
|
(kill-buffer init-base-name)))))
|
||||||
|
|
||||||
(provide 'ledger-init)
|
(provide 'ledger-init)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -60,17 +60,17 @@
|
||||||
|
|
||||||
(defun ledger-mode-dump-variable (var)
|
(defun ledger-mode-dump-variable (var)
|
||||||
(if var
|
(if var
|
||||||
(insert (format " %s: %S\n" (symbol-name var) (eval var)))))
|
(insert (format " %s: %S\n" (symbol-name var) (eval var)))))
|
||||||
|
|
||||||
(defun ledger-mode-dump-group (group)
|
(defun ledger-mode-dump-group (group)
|
||||||
"Dump GROUP customizations to current buffer"
|
"Dump GROUP customizations to current buffer"
|
||||||
(let ((members (custom-group-members group nil)))
|
(let ((members (custom-group-members group nil)))
|
||||||
(dolist (member members)
|
(dolist (member members)
|
||||||
(cond ((eq (cadr member) 'custom-group)
|
(cond ((eq (cadr member) 'custom-group)
|
||||||
(insert (format "Group %s:\n" (symbol-name (car member))))
|
(insert (format "Group %s:\n" (symbol-name (car member))))
|
||||||
(ledger-mode-dump-group (car member)))
|
(ledger-mode-dump-group (car member)))
|
||||||
((eq (cadr member) 'custom-variable)
|
((eq (cadr member) 'custom-variable)
|
||||||
(ledger-mode-dump-variable (car member)))))))
|
(ledger-mode-dump-variable (car member)))))))
|
||||||
|
|
||||||
(defun ledger-mode-dump-configuration ()
|
(defun ledger-mode-dump-configuration ()
|
||||||
"Dump all customizations"
|
"Dump all customizations"
|
||||||
|
|
@ -93,10 +93,10 @@
|
||||||
|
|
||||||
(defun ledger-read-account-with-prompt (prompt)
|
(defun ledger-read-account-with-prompt (prompt)
|
||||||
(let* ((context (ledger-context-at-point))
|
(let* ((context (ledger-context-at-point))
|
||||||
(default (if (and (eq (ledger-context-line-type context) 'acct-transaction)
|
(default (if (and (eq (ledger-context-line-type context) 'acct-transaction)
|
||||||
(eq (ledger-context-current-field context) 'account))
|
(eq (ledger-context-current-field context) 'account))
|
||||||
(regexp-quote (ledger-context-field-value context 'account))
|
(regexp-quote (ledger-context-field-value context 'account))
|
||||||
nil)))
|
nil)))
|
||||||
(ledger-read-string-with-default prompt default)))
|
(ledger-read-string-with-default prompt default)))
|
||||||
|
|
||||||
(defun ledger-read-date (prompt)
|
(defun ledger-read-date (prompt)
|
||||||
|
|
@ -114,22 +114,22 @@
|
||||||
(defun ledger-read-string-with-default (prompt default)
|
(defun ledger-read-string-with-default (prompt default)
|
||||||
"Return user supplied string after PROMPT, or DEFAULT."
|
"Return user supplied string after PROMPT, or DEFAULT."
|
||||||
(read-string (concat prompt
|
(read-string (concat prompt
|
||||||
(if default
|
(if default
|
||||||
(concat " (" default "): ")
|
(concat " (" default "): ")
|
||||||
": "))
|
": "))
|
||||||
nil 'ledger-minibuffer-history default))
|
nil 'ledger-minibuffer-history default))
|
||||||
|
|
||||||
(defun ledger-display-balance-at-point ()
|
(defun ledger-display-balance-at-point ()
|
||||||
"Display the cleared-or-pending balance.
|
"Display the cleared-or-pending balance.
|
||||||
And calculate the target-delta of the account being reconciled."
|
And calculate the target-delta of the account being reconciled."
|
||||||
(interactive)
|
(interactive)
|
||||||
(let* ((account (ledger-read-account-with-prompt "Account balance to show"))
|
(let* ((account (ledger-read-account-with-prompt "Account balance to show"))
|
||||||
(buffer (current-buffer))
|
(buffer (current-buffer))
|
||||||
(balance (with-temp-buffer
|
(balance (with-temp-buffer
|
||||||
(ledger-exec-ledger buffer (current-buffer) "cleared" account)
|
(ledger-exec-ledger buffer (current-buffer) "cleared" account)
|
||||||
(if (> (buffer-size) 0)
|
(if (> (buffer-size) 0)
|
||||||
(buffer-substring-no-properties (point-min) (1- (point-max)))
|
(buffer-substring-no-properties (point-min) (1- (point-max)))
|
||||||
(concat account " is empty.")))))
|
(concat account " is empty.")))))
|
||||||
(when balance
|
(when balance
|
||||||
(message balance))))
|
(message balance))))
|
||||||
|
|
||||||
|
|
@ -138,9 +138,9 @@ And calculate the target-delta of the account being reconciled."
|
||||||
And calculate the target-delta of the account being reconciled."
|
And calculate the target-delta of the account being reconciled."
|
||||||
(interactive)
|
(interactive)
|
||||||
(let* ((buffer (current-buffer))
|
(let* ((buffer (current-buffer))
|
||||||
(balance (with-temp-buffer
|
(balance (with-temp-buffer
|
||||||
(ledger-exec-ledger buffer (current-buffer) "stats")
|
(ledger-exec-ledger buffer (current-buffer) "stats")
|
||||||
(buffer-substring-no-properties (point-min) (1- (point-max))))))
|
(buffer-substring-no-properties (point-min) (1- (point-max))))))
|
||||||
(when balance
|
(when balance
|
||||||
(message balance))))
|
(message balance))))
|
||||||
|
|
||||||
|
|
@ -150,17 +150,17 @@ Can indent, complete or align depending on context."
|
||||||
(interactive "p")
|
(interactive "p")
|
||||||
(if (= (point) (line-beginning-position))
|
(if (= (point) (line-beginning-position))
|
||||||
(indent-to ledger-post-account-alignment-column)
|
(indent-to ledger-post-account-alignment-column)
|
||||||
(if (and (> (point) 1)
|
(if (and (> (point) 1)
|
||||||
(looking-back "\\([^ \t]\\)" 1))
|
(looking-back "\\([^ \t]\\)" 1))
|
||||||
(ledger-pcomplete interactively)
|
(ledger-pcomplete interactively)
|
||||||
(ledger-post-align-postings))))
|
(ledger-post-align-postings))))
|
||||||
|
|
||||||
(defvar ledger-mode-abbrev-table)
|
(defvar ledger-mode-abbrev-table)
|
||||||
|
|
||||||
(defvar ledger-date-string-today
|
(defvar ledger-date-string-today
|
||||||
(format-time-string (or
|
(format-time-string (or
|
||||||
(cdr (assoc "date-format" ledger-environment-alist))
|
(cdr (assoc "date-format" ledger-environment-alist))
|
||||||
ledger-default-date-format)))
|
ledger-default-date-format)))
|
||||||
|
|
||||||
(defun ledger-remove-effective-date ()
|
(defun ledger-remove-effective-date ()
|
||||||
"Removes the effective date from a transaction or posting."
|
"Removes the effective date from a transaction or posting."
|
||||||
|
|
@ -228,47 +228,47 @@ With a prefix argument, remove the effective date. "
|
||||||
|
|
||||||
|
|
||||||
(defvar ledger-mode-syntax-table
|
(defvar ledger-mode-syntax-table
|
||||||
(let ((table (make-syntax-table)))
|
(let ((table (make-syntax-table)))
|
||||||
;; Support comments via the syntax table
|
;; Support comments via the syntax table
|
||||||
(modify-syntax-entry ?\; "< b" table)
|
(modify-syntax-entry ?\; "< b" table)
|
||||||
(modify-syntax-entry ?\n "> b" table)
|
(modify-syntax-entry ?\n "> b" table)
|
||||||
table)
|
table)
|
||||||
"Syntax table for `ledger-mode' buffers.")
|
"Syntax table for `ledger-mode' buffers.")
|
||||||
|
|
||||||
(defvar ledger-mode-map
|
(defvar ledger-mode-map
|
||||||
(let ((map (make-sparse-keymap)))
|
(let ((map (make-sparse-keymap)))
|
||||||
(define-key map [(control ?c) (control ?a)] 'ledger-add-transaction)
|
(define-key map [(control ?c) (control ?a)] 'ledger-add-transaction)
|
||||||
(define-key map [(control ?c) (control ?b)] 'ledger-post-edit-amount)
|
(define-key map [(control ?c) (control ?b)] 'ledger-post-edit-amount)
|
||||||
(define-key map [(control ?c) (control ?c)] 'ledger-toggle-current)
|
(define-key map [(control ?c) (control ?c)] 'ledger-toggle-current)
|
||||||
(define-key map [(control ?c) (control ?d)] 'ledger-delete-current-transaction)
|
(define-key map [(control ?c) (control ?d)] 'ledger-delete-current-transaction)
|
||||||
(define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-transaction)
|
(define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-transaction)
|
||||||
(define-key map [(control ?c) (control ?f)] 'ledger-occur)
|
(define-key map [(control ?c) (control ?f)] 'ledger-occur)
|
||||||
(define-key map [(control ?c) (control ?k)] 'ledger-copy-transaction-at-point)
|
(define-key map [(control ?c) (control ?k)] 'ledger-copy-transaction-at-point)
|
||||||
(define-key map [(control ?c) (control ?m)] 'ledger-set-month)
|
(define-key map [(control ?c) (control ?m)] 'ledger-set-month)
|
||||||
(define-key map [(control ?c) (control ?r)] 'ledger-reconcile)
|
(define-key map [(control ?c) (control ?r)] 'ledger-reconcile)
|
||||||
(define-key map [(control ?c) (control ?s)] 'ledger-sort-region)
|
(define-key map [(control ?c) (control ?s)] 'ledger-sort-region)
|
||||||
(define-key map [(control ?c) (control ?t)] 'ledger-insert-effective-date)
|
(define-key map [(control ?c) (control ?t)] 'ledger-insert-effective-date)
|
||||||
(define-key map [(control ?c) (control ?u)] 'ledger-schedule-upcoming)
|
(define-key map [(control ?c) (control ?u)] 'ledger-schedule-upcoming)
|
||||||
(define-key map [(control ?c) (control ?y)] 'ledger-set-year)
|
(define-key map [(control ?c) (control ?y)] 'ledger-set-year)
|
||||||
(define-key map [(control ?c) (control ?p)] 'ledger-display-balance-at-point)
|
(define-key map [(control ?c) (control ?p)] 'ledger-display-balance-at-point)
|
||||||
(define-key map [(control ?c) (control ?l)] 'ledger-display-ledger-stats)
|
(define-key map [(control ?c) (control ?l)] 'ledger-display-ledger-stats)
|
||||||
(define-key map [(control ?c) (control ?q)] 'ledger-post-align-xact)
|
(define-key map [(control ?c) (control ?q)] 'ledger-post-align-xact)
|
||||||
|
|
||||||
(define-key map [tab] 'ledger-magic-tab)
|
(define-key map [tab] 'ledger-magic-tab)
|
||||||
(define-key map [(control tab)] 'ledger-post-align-xact)
|
(define-key map [(control tab)] 'ledger-post-align-xact)
|
||||||
(define-key map [(control ?i)] 'ledger-magic-tab)
|
(define-key map [(control ?i)] 'ledger-magic-tab)
|
||||||
(define-key map [(control ?c) tab] 'ledger-fully-complete-xact)
|
(define-key map [(control ?c) tab] 'ledger-fully-complete-xact)
|
||||||
(define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-xact)
|
(define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-xact)
|
||||||
|
|
||||||
(define-key map [(control ?c) (control ?o) (control ?a)] 'ledger-report-redo)
|
(define-key map [(control ?c) (control ?o) (control ?a)] 'ledger-report-redo)
|
||||||
(define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit)
|
(define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit)
|
||||||
(define-key map [(control ?c) (control ?o) (control ?g)] 'ledger-report-goto)
|
(define-key map [(control ?c) (control ?o) (control ?g)] 'ledger-report-goto)
|
||||||
(define-key map [(control ?c) (control ?o) (control ?k)] 'ledger-report-kill)
|
(define-key map [(control ?c) (control ?o) (control ?k)] 'ledger-report-kill)
|
||||||
(define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report)
|
(define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report)
|
||||||
(define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save)
|
(define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save)
|
||||||
|
|
||||||
(define-key map [(meta ?p)] 'ledger-post-prev-xact)
|
(define-key map [(meta ?p)] 'ledger-post-prev-xact)
|
||||||
(define-key map [(meta ?n)] 'ledger-post-next-xact)
|
(define-key map [(meta ?n)] 'ledger-post-next-xact)
|
||||||
map)
|
map)
|
||||||
"Keymap for `ledger-mode'.")
|
"Keymap for `ledger-mode'.")
|
||||||
|
|
||||||
|
|
@ -315,35 +315,35 @@ With a prefix argument, remove the effective date. "
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(define-derived-mode ledger-mode text-mode "Ledger"
|
(define-derived-mode ledger-mode text-mode "Ledger"
|
||||||
"A mode for editing ledger data files."
|
"A mode for editing ledger data files."
|
||||||
(ledger-check-version)
|
(ledger-check-version)
|
||||||
(ledger-schedule-check-available)
|
(ledger-schedule-check-available)
|
||||||
(ledger-post-setup)
|
(ledger-post-setup)
|
||||||
|
|
||||||
(set-syntax-table ledger-mode-syntax-table)
|
(set-syntax-table ledger-mode-syntax-table)
|
||||||
(set (make-local-variable 'comment-start) "; ")
|
(set (make-local-variable 'comment-start) "; ")
|
||||||
(set (make-local-variable 'comment-end) "")
|
(set (make-local-variable 'comment-end) "")
|
||||||
(set (make-local-variable 'indent-tabs-mode) nil)
|
(set (make-local-variable 'indent-tabs-mode) nil)
|
||||||
|
|
||||||
(if (boundp 'font-lock-defaults)
|
(if (boundp 'font-lock-defaults)
|
||||||
(set (make-local-variable 'font-lock-defaults)
|
(set (make-local-variable 'font-lock-defaults)
|
||||||
'(ledger-font-lock-keywords nil t)))
|
'(ledger-font-lock-keywords nil t)))
|
||||||
(setq font-lock-extend-region-functions
|
(setq font-lock-extend-region-functions
|
||||||
(list #'font-lock-extend-region-wholelines))
|
(list #'font-lock-extend-region-wholelines))
|
||||||
(setq font-lock-multiline nil)
|
(setq font-lock-multiline nil)
|
||||||
|
|
||||||
(set (make-local-variable 'pcomplete-parse-arguments-function)
|
(set (make-local-variable 'pcomplete-parse-arguments-function)
|
||||||
'ledger-parse-arguments)
|
'ledger-parse-arguments)
|
||||||
(set (make-local-variable 'pcomplete-command-completion-function)
|
(set (make-local-variable 'pcomplete-command-completion-function)
|
||||||
'ledger-complete-at-point)
|
'ledger-complete-at-point)
|
||||||
(add-hook 'completion-at-point-functions 'pcomplete-completions-at-point nil t)
|
(add-hook 'completion-at-point-functions 'pcomplete-completions-at-point nil t)
|
||||||
|
|
||||||
(add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t)
|
(add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t)
|
||||||
(add-hook 'before-revert-hook 'ledger-occur-remove-all-overlays nil t)
|
(add-hook 'before-revert-hook 'ledger-occur-remove-all-overlays nil t)
|
||||||
|
|
||||||
(ledger-init-load-init-file)
|
(ledger-init-load-init-file)
|
||||||
|
|
||||||
(set (make-local-variable 'indent-region-function) 'ledger-post-align-postings))
|
(set (make-local-variable 'indent-region-function) 'ledger-post-align-postings))
|
||||||
|
|
||||||
|
|
||||||
(defun ledger-set-year (newyear)
|
(defun ledger-set-year (newyear)
|
||||||
|
|
|
||||||
|
|
@ -65,10 +65,10 @@
|
||||||
When REGEX is nil, unhide everything, and remove higlight"
|
When REGEX is nil, unhide everything, and remove higlight"
|
||||||
(set-buffer buffer)
|
(set-buffer buffer)
|
||||||
(setq ledger-occur-mode
|
(setq ledger-occur-mode
|
||||||
(if (or (null regex)
|
(if (or (null regex)
|
||||||
(zerop (length regex)))
|
(zerop (length regex)))
|
||||||
nil
|
nil
|
||||||
(concat " Ledger-Narrowed: " regex)))
|
(concat " Ledger-Narrowed: " regex)))
|
||||||
(force-mode-line-update)
|
(force-mode-line-update)
|
||||||
(ledger-occur-remove-overlays)
|
(ledger-occur-remove-overlays)
|
||||||
(when ledger-occur-mode
|
(when ledger-occur-mode
|
||||||
|
|
@ -77,7 +77,7 @@ When REGEX is nil, unhide everything, and remove higlight"
|
||||||
(ledger-occur-find-matches regex)))
|
(ledger-occur-find-matches regex)))
|
||||||
(setq ledger-occur-last-match regex)
|
(setq ledger-occur-last-match regex)
|
||||||
(if (get-buffer-window buffer)
|
(if (get-buffer-window buffer)
|
||||||
(select-window (get-buffer-window buffer))))
|
(select-window (get-buffer-window buffer))))
|
||||||
(recenter))
|
(recenter))
|
||||||
|
|
||||||
(defun ledger-occur (regex)
|
(defun ledger-occur (regex)
|
||||||
|
|
@ -89,8 +89,8 @@ When REGEX is nil, unhide everything, and remove higlight"
|
||||||
(interactive
|
(interactive
|
||||||
(if ledger-occur-mode
|
(if ledger-occur-mode
|
||||||
(list nil)
|
(list nil)
|
||||||
(list (read-string (concat "Regexp<" (ledger-occur-prompt) ">: ")
|
(list (read-string (concat "Regexp<" (ledger-occur-prompt) ">: ")
|
||||||
nil 'ledger-occur-history (ledger-occur-prompt)))))
|
nil 'ledger-occur-history (ledger-occur-prompt)))))
|
||||||
(ledger-occur-mode regex (current-buffer)))
|
(ledger-occur-mode regex (current-buffer)))
|
||||||
|
|
||||||
(defun ledger-occur-prompt ()
|
(defun ledger-occur-prompt ()
|
||||||
|
|
@ -108,7 +108,7 @@ When REGEX is nil, unhide everything, and remove higlight"
|
||||||
(if (= (line-number-at-pos pos1)
|
(if (= (line-number-at-pos pos1)
|
||||||
(line-number-at-pos pos2))
|
(line-number-at-pos pos2))
|
||||||
(buffer-substring-no-properties pos1 pos2)))
|
(buffer-substring-no-properties pos1 pos2)))
|
||||||
(current-word))))
|
(current-word))))
|
||||||
prompt))
|
prompt))
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -126,7 +126,7 @@ When REGEX is nil, unhide everything, and remove higlight"
|
||||||
"Create the overlays for the visible transactions.
|
"Create the overlays for the visible transactions.
|
||||||
Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
|
Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
|
||||||
(let* ((beg (caar ovl-bounds))
|
(let* ((beg (caar ovl-bounds))
|
||||||
(end (cadar ovl-bounds)))
|
(end (cadar ovl-bounds)))
|
||||||
(ledger-occur-make-invisible-overlay (point-min) (1- beg))
|
(ledger-occur-make-invisible-overlay (point-min) (1- beg))
|
||||||
(dolist (visible (cdr ovl-bounds))
|
(dolist (visible (cdr ovl-bounds))
|
||||||
(ledger-occur-make-visible-overlay beg end)
|
(ledger-occur-make-visible-overlay beg end)
|
||||||
|
|
@ -148,7 +148,7 @@ Used for coordinating `ledger-occur' with other buffers, like reconcile."
|
||||||
"Remove the transaction hiding overlays."
|
"Remove the transaction hiding overlays."
|
||||||
(interactive)
|
(interactive)
|
||||||
(remove-overlays (point-min)
|
(remove-overlays (point-min)
|
||||||
(point-max) ledger-occur-overlay-property-name t)
|
(point-max) ledger-occur-overlay-property-name t)
|
||||||
(setq ledger-occur-overlay-list nil))
|
(setq ledger-occur-overlay-list nil))
|
||||||
|
|
||||||
(defun ledger-occur-find-matches (regex)
|
(defun ledger-occur-find-matches (regex)
|
||||||
|
|
@ -157,19 +157,19 @@ Used for coordinating `ledger-occur' with other buffers, like reconcile."
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
;; Set initial values for variables
|
;; Set initial values for variables
|
||||||
(let (curpoint
|
(let (curpoint
|
||||||
endpoint
|
endpoint
|
||||||
(lines (list)))
|
(lines (list)))
|
||||||
;; Search loop
|
;; Search loop
|
||||||
(while (not (eobp))
|
(while (not (eobp))
|
||||||
(setq curpoint (point))
|
(setq curpoint (point))
|
||||||
;; if something found
|
;; if something found
|
||||||
(when (setq endpoint (re-search-forward regex nil 'end))
|
(when (setq endpoint (re-search-forward regex nil 'end))
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(let ((bounds (ledger-find-xact-extents (match-beginning 0))))
|
(let ((bounds (ledger-find-xact-extents (match-beginning 0))))
|
||||||
(push bounds lines)
|
(push bounds lines)
|
||||||
(setq curpoint (cadr bounds)))) ;; move to the end of
|
(setq curpoint (cadr bounds)))) ;; move to the end of
|
||||||
;; the xact, no need to
|
;; the xact, no need to
|
||||||
;; search inside it more
|
;; search inside it more
|
||||||
(goto-char curpoint))
|
(goto-char curpoint))
|
||||||
(forward-line 1))
|
(forward-line 1))
|
||||||
(setq lines (nreverse lines)))))
|
(setq lines (nreverse lines)))))
|
||||||
|
|
@ -177,14 +177,14 @@ Used for coordinating `ledger-occur' with other buffers, like reconcile."
|
||||||
(defun ledger-occur-compress-matches (buffer-matches)
|
(defun ledger-occur-compress-matches (buffer-matches)
|
||||||
"identify sequential xacts to reduce number of overlays required"
|
"identify sequential xacts to reduce number of overlays required"
|
||||||
(let ((points (list))
|
(let ((points (list))
|
||||||
(current-beginning (caar buffer-matches))
|
(current-beginning (caar buffer-matches))
|
||||||
(current-end (cadar buffer-matches)))
|
(current-end (cadar buffer-matches)))
|
||||||
(dolist (match (cdr buffer-matches))
|
(dolist (match (cdr buffer-matches))
|
||||||
(if (< (- (car match) current-end) 2)
|
(if (< (- (car match) current-end) 2)
|
||||||
(setq current-end (cadr match))
|
(setq current-end (cadr match))
|
||||||
(push (list current-beginning current-end) points)
|
(push (list current-beginning current-end) points)
|
||||||
(setq current-beginning (car match))
|
(setq current-beginning (car match))
|
||||||
(setq current-end (cadr match))))
|
(setq current-end (cadr match))))
|
||||||
(nreverse (push (list current-beginning current-end) points))))
|
(nreverse (push (list current-beginning current-end) points))))
|
||||||
|
|
||||||
(provide 'ledger-occur)
|
(provide 'ledger-occur)
|
||||||
|
|
|
||||||
|
|
@ -45,8 +45,8 @@
|
||||||
"Which completion engine to use, :iswitchb or :ido chose those engines,
|
"Which completion engine to use, :iswitchb or :ido chose those engines,
|
||||||
:built-in uses built-in Ledger-mode completion"
|
:built-in uses built-in Ledger-mode completion"
|
||||||
:type '(radio (const :tag "built in completion" :built-in)
|
:type '(radio (const :tag "built in completion" :built-in)
|
||||||
(const :tag "ido completion" :ido)
|
(const :tag "ido completion" :ido)
|
||||||
(const :tag "iswitchb completion" :iswitchb) )
|
(const :tag "iswitchb completion" :iswitchb) )
|
||||||
:group 'ledger-post)
|
:group 'ledger-post)
|
||||||
|
|
||||||
(defun ledger-post-all-accounts ()
|
(defun ledger-post-all-accounts ()
|
||||||
|
|
@ -72,15 +72,15 @@
|
||||||
PROMPT is a string to prompt with. CHOICES is a list of strings
|
PROMPT is a string to prompt with. CHOICES is a list of strings
|
||||||
to choose from."
|
to choose from."
|
||||||
(cond ((eq ledger-post-use-completion-engine :iswitchb)
|
(cond ((eq ledger-post-use-completion-engine :iswitchb)
|
||||||
(let* ((iswitchb-use-virtual-buffers nil)
|
(let* ((iswitchb-use-virtual-buffers nil)
|
||||||
(iswitchb-make-buflist-hook
|
(iswitchb-make-buflist-hook
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(setq iswitchb-temp-buflist choices))))
|
(setq iswitchb-temp-buflist choices))))
|
||||||
(iswitchb-read-buffer prompt)))
|
(iswitchb-read-buffer prompt)))
|
||||||
((eq ledger-post-use-completion-engine :ido)
|
((eq ledger-post-use-completion-engine :ido)
|
||||||
(ido-completing-read prompt choices))
|
(ido-completing-read prompt choices))
|
||||||
(t
|
(t
|
||||||
(completing-read prompt choices))))
|
(completing-read prompt choices))))
|
||||||
|
|
||||||
(defvar ledger-post-current-list nil)
|
(defvar ledger-post-current-list nil)
|
||||||
|
|
||||||
|
|
@ -102,12 +102,12 @@ to choose from."
|
||||||
(match-end ledger-regex-post-line-group-account))
|
(match-end ledger-regex-post-line-group-account))
|
||||||
(insert account)
|
(insert account)
|
||||||
(cond
|
(cond
|
||||||
((> existing-len account-len)
|
((> existing-len account-len)
|
||||||
(insert (make-string (- existing-len account-len) ? )))
|
(insert (make-string (- existing-len account-len) ? )))
|
||||||
((< existing-len account-len)
|
((< existing-len account-len)
|
||||||
(dotimes (n (- account-len existing-len))
|
(dotimes (n (- account-len existing-len))
|
||||||
(if (looking-at "[ \t]\\( [ \t]\\|\t\\)")
|
(if (looking-at "[ \t]\\( [ \t]\\|\t\\)")
|
||||||
(delete-char 1)))))))
|
(delete-char 1)))))))
|
||||||
(goto-char pos)))
|
(goto-char pos)))
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -131,11 +131,11 @@ Return the column of the beginning of the account and leave point
|
||||||
at beginning of account"
|
at beginning of account"
|
||||||
(if (> end (point))
|
(if (> end (point))
|
||||||
(when (re-search-forward ledger-account-any-status-regex (1+ end) t)
|
(when (re-search-forward ledger-account-any-status-regex (1+ end) t)
|
||||||
;; the 1+ is to make sure we can catch the newline
|
;; the 1+ is to make sure we can catch the newline
|
||||||
(if (match-beginning 1)
|
(if (match-beginning 1)
|
||||||
(goto-char (match-beginning 1))
|
(goto-char (match-beginning 1))
|
||||||
(goto-char (match-beginning 2)))
|
(goto-char (match-beginning 2)))
|
||||||
(current-column))))
|
(current-column))))
|
||||||
|
|
||||||
(defun ledger-post-align-xact (pos)
|
(defun ledger-post-align-xact (pos)
|
||||||
(interactive "d")
|
(interactive "d")
|
||||||
|
|
@ -150,52 +150,52 @@ region align the posting on the current line."
|
||||||
|
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(if (or (not (mark))
|
(if (or (not (mark))
|
||||||
(not (use-region-p)))
|
(not (use-region-p)))
|
||||||
(set-mark (point)))
|
(set-mark (point)))
|
||||||
|
|
||||||
(let* ((inhibit-modification-hooks t)
|
(let* ((inhibit-modification-hooks t)
|
||||||
(mark-first (< (mark) (point)))
|
(mark-first (< (mark) (point)))
|
||||||
(begin-region (if beg
|
(begin-region (if beg
|
||||||
beg
|
beg
|
||||||
(if mark-first (mark) (point))))
|
(if mark-first (mark) (point))))
|
||||||
(end-region (if end
|
(end-region (if end
|
||||||
end
|
end
|
||||||
(if mark-first (point) (mark))))
|
(if mark-first (point) (mark))))
|
||||||
acct-start-column acct-end-column acct-adjust amt-width
|
acct-start-column acct-end-column acct-adjust amt-width
|
||||||
(lines-left 1))
|
(lines-left 1))
|
||||||
;; Condition point and mark to the beginning and end of lines
|
;; Condition point and mark to the beginning and end of lines
|
||||||
(goto-char end-region)
|
(goto-char end-region)
|
||||||
(setq end-region (line-end-position))
|
(setq end-region (line-end-position))
|
||||||
(goto-char begin-region)
|
(goto-char begin-region)
|
||||||
(goto-char
|
(goto-char
|
||||||
(setq begin-region
|
(setq begin-region
|
||||||
(line-beginning-position)))
|
(line-beginning-position)))
|
||||||
|
|
||||||
;; This is the guts of the alignment loop
|
;; This is the guts of the alignment loop
|
||||||
(while (and (or (setq acct-start-column (ledger-next-account (line-end-position)))
|
(while (and (or (setq acct-start-column (ledger-next-account (line-end-position)))
|
||||||
lines-left)
|
lines-left)
|
||||||
(< (point) end-region))
|
(< (point) end-region))
|
||||||
(when acct-start-column
|
(when acct-start-column
|
||||||
(setq acct-end-column (save-excursion
|
(setq acct-end-column (save-excursion
|
||||||
(goto-char (match-end 2))
|
(goto-char (match-end 2))
|
||||||
(current-column)))
|
(current-column)))
|
||||||
(when (/= (setq acct-adjust (- ledger-post-account-alignment-column acct-start-column)) 0)
|
(when (/= (setq acct-adjust (- ledger-post-account-alignment-column acct-start-column)) 0)
|
||||||
(setq acct-end-column (+ acct-end-column acct-adjust)) ;;adjust the account ending column
|
(setq acct-end-column (+ acct-end-column acct-adjust)) ;;adjust the account ending column
|
||||||
(if (> acct-adjust 0)
|
(if (> acct-adjust 0)
|
||||||
(insert (make-string acct-adjust ? ))
|
(insert (make-string acct-adjust ? ))
|
||||||
(delete-char acct-adjust)))
|
(delete-char acct-adjust)))
|
||||||
(when (setq amt-width (ledger-next-amount (line-end-position)))
|
(when (setq amt-width (ledger-next-amount (line-end-position)))
|
||||||
(if (/= 0 (setq amt-adjust (- (if (> (- ledger-post-amount-alignment-column amt-width)
|
(if (/= 0 (setq amt-adjust (- (if (> (- ledger-post-amount-alignment-column amt-width)
|
||||||
(+ 2 acct-end-column))
|
(+ 2 acct-end-column))
|
||||||
ledger-post-amount-alignment-column ;;we have room
|
ledger-post-amount-alignment-column ;;we have room
|
||||||
(+ acct-end-column 2 amt-width))
|
(+ acct-end-column 2 amt-width))
|
||||||
amt-width
|
amt-width
|
||||||
(current-column))))
|
(current-column))))
|
||||||
(if (> amt-adjust 0)
|
(if (> amt-adjust 0)
|
||||||
(insert (make-string amt-adjust ? ))
|
(insert (make-string amt-adjust ? ))
|
||||||
(delete-char amt-adjust)))))
|
(delete-char amt-adjust)))))
|
||||||
(forward-line)
|
(forward-line)
|
||||||
(setq lines-left (not (eobp))))
|
(setq lines-left (not (eobp))))
|
||||||
(setq inhibit-modification-hooks nil))))
|
(setq inhibit-modification-hooks nil))))
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -209,16 +209,16 @@ region align the posting on the current line."
|
||||||
(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-string (match-string 0)))
|
(let ((val-string (match-string 0)))
|
||||||
(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)
|
||||||
(calc-eval val-string 'push)) ;; edit the amount
|
(calc-eval val-string '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)
|
||||||
(goto-char (line-end-position))
|
(goto-char (line-end-position))
|
||||||
(insert " "))
|
(insert " "))
|
||||||
(calc))))))
|
(calc))))))
|
||||||
|
|
||||||
(defun ledger-post-prev-xact ()
|
(defun ledger-post-prev-xact ()
|
||||||
"Move point to the previous transaction."
|
"Move point to the previous transaction."
|
||||||
|
|
|
||||||
|
|
@ -76,9 +76,9 @@ reconcile-finish will mark all pending posting cleared."
|
||||||
:group 'ledger-reconcile)
|
:group 'ledger-reconcile)
|
||||||
|
|
||||||
(defcustom ledger-reconcile-sort-key "(date)"
|
(defcustom ledger-reconcile-sort-key "(date)"
|
||||||
"Default key for sorting reconcile buffer. For no sorting by default, use '(0)'."
|
"Default key for sorting reconcile buffer. For no sorting by default, use '(0)'."
|
||||||
:type 'string
|
:type 'string
|
||||||
:group 'ledger-reconcile)
|
:group 'ledger-reconcile)
|
||||||
|
|
||||||
(defcustom ledger-reconcile-insert-effective-date nil
|
(defcustom ledger-reconcile-insert-effective-date nil
|
||||||
"If t, prompt for effective date when clearing transactions during reconciliation."
|
"If t, prompt for effective date when clearing transactions during reconciliation."
|
||||||
|
|
@ -97,10 +97,10 @@ reconcile-finish will mark all pending posting cleared."
|
||||||
;; 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)
|
(if (ledger-exec-ledger buffer (current-buffer)
|
||||||
"balance" "--limit" "cleared or pending" "--empty" "--collapse"
|
"balance" "--limit" "cleared or pending" "--empty" "--collapse"
|
||||||
"--format" "%(display_total)" account)
|
"--format" "%(display_total)" account)
|
||||||
(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 balance.
|
"Display the cleared-or-pending balance.
|
||||||
|
|
@ -109,11 +109,11 @@ And calculate the target-delta of the account being reconciled."
|
||||||
(let* ((pending (ledger-reconcile-get-cleared-or-pending-balance ledger-buf ledger-acct)))
|
(let* ((pending (ledger-reconcile-get-cleared-or-pending-balance ledger-buf ledger-acct)))
|
||||||
(when pending
|
(when pending
|
||||||
(if ledger-target
|
(if ledger-target
|
||||||
(message "Pending balance: %s, Difference from target: %s"
|
(message "Pending balance: %s, Difference from target: %s"
|
||||||
(ledger-commodity-to-string pending)
|
(ledger-commodity-to-string pending)
|
||||||
(ledger-commodity-to-string (-commodity ledger-target pending)))
|
(ledger-commodity-to-string (-commodity ledger-target pending)))
|
||||||
(message "Pending balance: %s"
|
(message "Pending balance: %s"
|
||||||
(ledger-commodity-to-string pending))))))
|
(ledger-commodity-to-string pending))))))
|
||||||
|
|
||||||
(defun ledger-is-stdin (file)
|
(defun ledger-is-stdin (file)
|
||||||
"True if ledger FILE is standard input."
|
"True if ledger FILE is standard input."
|
||||||
|
|
@ -126,7 +126,7 @@ And calculate the 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 "Function 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."
|
||||||
|
|
@ -137,30 +137,30 @@ And calculate the target-delta of the account being reconciled."
|
||||||
status)
|
status)
|
||||||
(when (ledger-reconcile-get-buffer where)
|
(when (ledger-reconcile-get-buffer where)
|
||||||
(with-current-buffer (ledger-reconcile-get-buffer where)
|
(with-current-buffer (ledger-reconcile-get-buffer where)
|
||||||
(ledger-goto-line (cdr where))
|
(ledger-goto-line (cdr where))
|
||||||
(forward-char)
|
(forward-char)
|
||||||
(setq status (ledger-toggle-current (if ledger-reconcile-toggle-to-pending
|
(setq status (ledger-toggle-current (if ledger-reconcile-toggle-to-pending
|
||||||
'pending
|
'pending
|
||||||
'cleared)))
|
'cleared)))
|
||||||
(when ledger-reconcile-insert-effective-date
|
(when ledger-reconcile-insert-effective-date
|
||||||
;; Ask for effective date & insert it
|
;; Ask for effective date & insert it
|
||||||
(ledger-insert-effective-date)))
|
(ledger-insert-effective-date)))
|
||||||
;; remove the existing face and add the new face
|
;; remove the existing face and add the new face
|
||||||
(remove-text-properties (line-beginning-position)
|
(remove-text-properties (line-beginning-position)
|
||||||
(line-end-position)
|
(line-end-position)
|
||||||
(list 'face))
|
(list 'face))
|
||||||
(cond ((eq status 'pending)
|
(cond ((eq status 'pending)
|
||||||
(add-text-properties (line-beginning-position)
|
(add-text-properties (line-beginning-position)
|
||||||
(line-end-position)
|
(line-end-position)
|
||||||
(list 'face 'ledger-font-reconciler-pending-face )))
|
(list 'face 'ledger-font-reconciler-pending-face )))
|
||||||
((eq status 'cleared)
|
((eq status 'cleared)
|
||||||
(add-text-properties (line-beginning-position)
|
(add-text-properties (line-beginning-position)
|
||||||
(line-end-position)
|
(line-end-position)
|
||||||
(list 'face 'ledger-font-reconciler-cleared-face )))
|
(list 'face 'ledger-font-reconciler-cleared-face )))
|
||||||
(t
|
(t
|
||||||
(add-text-properties (line-beginning-position)
|
(add-text-properties (line-beginning-position)
|
||||||
(line-end-position)
|
(line-end-position)
|
||||||
(list 'face 'ledger-font-reconciler-uncleared-face )))))
|
(list 'face 'ledger-font-reconciler-uncleared-face )))))
|
||||||
(forward-line)
|
(forward-line)
|
||||||
(beginning-of-line)
|
(beginning-of-line)
|
||||||
(ledger-display-balance)))
|
(ledger-display-balance)))
|
||||||
|
|
@ -172,18 +172,18 @@ Return the number of uncleared xacts found."
|
||||||
(let ((inhibit-read-only t))
|
(let ((inhibit-read-only t))
|
||||||
(erase-buffer)
|
(erase-buffer)
|
||||||
(prog1
|
(prog1
|
||||||
(ledger-do-reconcile ledger-reconcile-sort-key)
|
(ledger-do-reconcile ledger-reconcile-sort-key)
|
||||||
(set-buffer-modified-p t))))
|
(set-buffer-modified-p t))))
|
||||||
|
|
||||||
(defun ledger-reconcile-refresh-after-save ()
|
(defun ledger-reconcile-refresh-after-save ()
|
||||||
"Refresh the recon-window after the ledger buffer is saved."
|
"Refresh the recon-window after the ledger buffer is saved."
|
||||||
(let ((curbuf (current-buffer))
|
(let ((curbuf (current-buffer))
|
||||||
(curpoint (point))
|
(curpoint (point))
|
||||||
(recon-buf (get-buffer ledger-recon-buffer-name)))
|
(recon-buf (get-buffer ledger-recon-buffer-name)))
|
||||||
(when (buffer-live-p recon-buf)
|
(when (buffer-live-p recon-buf)
|
||||||
(with-current-buffer recon-buf
|
(with-current-buffer recon-buf
|
||||||
(ledger-reconcile-refresh)
|
(ledger-reconcile-refresh)
|
||||||
(set-buffer-modified-p nil))
|
(set-buffer-modified-p nil))
|
||||||
(select-window (get-buffer-window curbuf))
|
(select-window (get-buffer-window curbuf))
|
||||||
(goto-char curpoint))))
|
(goto-char curpoint))))
|
||||||
|
|
||||||
|
|
@ -206,7 +206,7 @@ Return the number of uncleared xacts found."
|
||||||
(goto-char (line-beginning-position))
|
(goto-char (line-beginning-position))
|
||||||
(delete-region (point) (1+ (line-end-position)))
|
(delete-region (point) (1+ (line-end-position)))
|
||||||
(set-buffer-modified-p t))
|
(set-buffer-modified-p t))
|
||||||
(ledger-reconcile-refresh))))
|
(ledger-reconcile-refresh))))
|
||||||
|
|
||||||
(defun ledger-reconcile-visit (&optional come-back)
|
(defun ledger-reconcile-visit (&optional come-back)
|
||||||
"Recenter ledger buffer on transaction and COME-BACK if non-nil."
|
"Recenter ledger buffer on transaction and COME-BACK if non-nil."
|
||||||
|
|
@ -214,19 +214,19 @@ Return the number of uncleared xacts found."
|
||||||
(progn
|
(progn
|
||||||
(beginning-of-line)
|
(beginning-of-line)
|
||||||
(let* ((where (get-text-property (1+ (point)) 'where))
|
(let* ((where (get-text-property (1+ (point)) 'where))
|
||||||
(target-buffer (if where
|
(target-buffer (if where
|
||||||
(ledger-reconcile-get-buffer where)
|
(ledger-reconcile-get-buffer where)
|
||||||
nil))
|
nil))
|
||||||
(cur-win (get-buffer-window (get-buffer ledger-recon-buffer-name))))
|
(cur-win (get-buffer-window (get-buffer ledger-recon-buffer-name))))
|
||||||
(when target-buffer
|
(when target-buffer
|
||||||
(switch-to-buffer-other-window target-buffer)
|
(switch-to-buffer-other-window target-buffer)
|
||||||
(ledger-goto-line (cdr where))
|
(ledger-goto-line (cdr where))
|
||||||
(forward-char)
|
(forward-char)
|
||||||
(recenter)
|
(recenter)
|
||||||
(ledger-highlight-xact-under-point)
|
(ledger-highlight-xact-under-point)
|
||||||
(forward-char -1)
|
(forward-char -1)
|
||||||
(if (and come-back cur-win)
|
(if (and come-back cur-win)
|
||||||
(select-window cur-win))))))
|
(select-window cur-win))))))
|
||||||
|
|
||||||
(defun ledger-reconcile-save ()
|
(defun ledger-reconcile-save ()
|
||||||
"Save the ledger buffer."
|
"Save the ledger buffer."
|
||||||
|
|
@ -234,7 +234,7 @@ Return the number of uncleared xacts found."
|
||||||
(let ((curpoint (point)))
|
(let ((curpoint (point)))
|
||||||
(dolist (buf (cons ledger-buf ledger-bufs))
|
(dolist (buf (cons ledger-buf ledger-bufs))
|
||||||
(with-current-buffer buf
|
(with-current-buffer buf
|
||||||
(save-buffer)))
|
(save-buffer)))
|
||||||
(with-current-buffer (get-buffer ledger-recon-buffer-name)
|
(with-current-buffer (get-buffer ledger-recon-buffer-name)
|
||||||
(set-buffer-modified-p nil)
|
(set-buffer-modified-p nil)
|
||||||
(ledger-display-balance)
|
(ledger-display-balance)
|
||||||
|
|
@ -264,88 +264,88 @@ and exit reconcile mode"
|
||||||
"Quit the reconcile window without saving ledger buffer."
|
"Quit the reconcile window without saving ledger buffer."
|
||||||
(interactive)
|
(interactive)
|
||||||
(let ((recon-buf (get-buffer ledger-recon-buffer-name))
|
(let ((recon-buf (get-buffer ledger-recon-buffer-name))
|
||||||
buf)
|
buf)
|
||||||
(if recon-buf
|
(if recon-buf
|
||||||
(with-current-buffer recon-buf
|
(with-current-buffer recon-buf
|
||||||
(ledger-reconcile-quit-cleanup)
|
(ledger-reconcile-quit-cleanup)
|
||||||
(setq buf ledger-buf)
|
(setq buf ledger-buf)
|
||||||
;; Make sure you delete the window before you delete the buffer,
|
;; Make sure you delete the window before you delete the buffer,
|
||||||
;; otherwise, madness ensues
|
;; otherwise, madness ensues
|
||||||
(delete-window (get-buffer-window recon-buf))
|
(delete-window (get-buffer-window recon-buf))
|
||||||
(kill-buffer recon-buf)
|
(kill-buffer recon-buf)
|
||||||
(set-window-buffer (selected-window) buf)))))
|
(set-window-buffer (selected-window) buf)))))
|
||||||
|
|
||||||
(defun ledger-reconcile-quit-cleanup ()
|
(defun ledger-reconcile-quit-cleanup ()
|
||||||
"Cleanup all hooks established by reconcile mode."
|
"Cleanup all hooks established by reconcile mode."
|
||||||
(interactive)
|
(interactive)
|
||||||
(let ((buf ledger-buf))
|
(let ((buf ledger-buf))
|
||||||
(if (buffer-live-p buf)
|
(if (buffer-live-p buf)
|
||||||
(with-current-buffer buf
|
(with-current-buffer buf
|
||||||
(remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t)
|
(remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t)
|
||||||
(when ledger-narrow-on-reconcile
|
(when ledger-narrow-on-reconcile
|
||||||
(ledger-occur-quit-buffer buf)
|
(ledger-occur-quit-buffer buf)
|
||||||
(ledger-highlight-xact-under-point))))))
|
(ledger-highlight-xact-under-point))))))
|
||||||
|
|
||||||
(defun ledger-marker-where-xact-is (emacs-xact posting)
|
(defun ledger-marker-where-xact-is (emacs-xact posting)
|
||||||
"Find the position of the EMACS-XACT in the `ledger-buf'.
|
"Find the position of the EMACS-XACT in the `ledger-buf'.
|
||||||
POSTING is used in `ledger-clear-whole-transactions' is nil."
|
POSTING is used in `ledger-clear-whole-transactions' is nil."
|
||||||
(let ((buf (if (ledger-is-stdin (nth 0 emacs-xact))
|
(let ((buf (if (ledger-is-stdin (nth 0 emacs-xact))
|
||||||
ledger-buf
|
ledger-buf
|
||||||
(find-file-noselect (nth 0 emacs-xact)))))
|
(find-file-noselect (nth 0 emacs-xact)))))
|
||||||
(cons
|
(cons
|
||||||
buf
|
buf
|
||||||
(if ledger-clear-whole-transactions
|
(if ledger-clear-whole-transactions
|
||||||
(nth 1 emacs-xact) ;; return line-no of xact
|
(nth 1 emacs-xact) ;; return line-no of xact
|
||||||
(nth 0 posting))))) ;; return line-no of posting
|
(nth 0 posting))))) ;; return line-no of posting
|
||||||
|
|
||||||
(defun ledger-do-reconcile (&optional sort)
|
(defun ledger-do-reconcile (&optional sort)
|
||||||
"Return the number of uncleared transactions in the account and display them in the *Reconcile* buffer."
|
"Return the number of 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)
|
(ledger-success nil)
|
||||||
(sort-by (if sort
|
(sort-by (if sort
|
||||||
sort
|
sort
|
||||||
"(date)"))
|
"(date)"))
|
||||||
(xacts
|
(xacts
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(when (ledger-exec-ledger buf (current-buffer)
|
(when (ledger-exec-ledger buf (current-buffer)
|
||||||
"--uncleared" "--real" "emacs" "--sort" sort-by account)
|
"--uncleared" "--real" "emacs" "--sort" sort-by account)
|
||||||
(setq ledger-success t)
|
(setq ledger-success t)
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(unless (eobp)
|
(unless (eobp)
|
||||||
(if (looking-at "(")
|
(if (looking-at "(")
|
||||||
(read (current-buffer)))))))) ;current-buffer is the *temp* created above
|
(read (current-buffer)))))))) ;current-buffer is the *temp* created above
|
||||||
(if (and ledger-success (> (length xacts) 0))
|
(if (and ledger-success (> (length xacts) 0))
|
||||||
(let ((date-format (or (cdr (assoc "date-format" ledger-environment-alist))
|
(let ((date-format (or (cdr (assoc "date-format" ledger-environment-alist))
|
||||||
ledger-default-date-format)))
|
ledger-default-date-format)))
|
||||||
(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 %-50s %-30s %15s\n"
|
(insert (format "%s %-4s %-50s %-30s %15s\n"
|
||||||
(format-time-string date-format (nth 2 xact))
|
(format-time-string date-format (nth 2 xact))
|
||||||
(if (nth 3 xact)
|
(if (nth 3 xact)
|
||||||
(nth 3 xact)
|
(nth 3 xact)
|
||||||
"")
|
"")
|
||||||
(truncate-string-to-width
|
(truncate-string-to-width
|
||||||
(nth 4 xact) 49)
|
(nth 4 xact) 49)
|
||||||
(nth 1 posting) (nth 2 posting)))
|
(nth 1 posting) (nth 2 posting)))
|
||||||
(if (nth 3 posting)
|
(if (nth 3 posting)
|
||||||
(if (eq (nth 3 posting) 'pending)
|
(if (eq (nth 3 posting) 'pending)
|
||||||
(set-text-properties beg (1- (point))
|
(set-text-properties beg (1- (point))
|
||||||
(list 'face 'ledger-font-reconciler-pending-face
|
(list 'face 'ledger-font-reconciler-pending-face
|
||||||
'where where))
|
'where where))
|
||||||
(set-text-properties beg (1- (point))
|
(set-text-properties beg (1- (point))
|
||||||
(list 'face 'ledger-font-reconciler-cleared-face
|
(list 'face 'ledger-font-reconciler-cleared-face
|
||||||
'where where)))
|
'where where)))
|
||||||
(set-text-properties beg (1- (point))
|
(set-text-properties beg (1- (point))
|
||||||
(list 'face 'ledger-font-reconciler-uncleared-face
|
(list 'face 'ledger-font-reconciler-uncleared-face
|
||||||
'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
|
||||||
(if ledger-success
|
(if ledger-success
|
||||||
(insert (concat "There are no uncleared entries for " account))
|
(insert (concat "There are no uncleared entries for " account))
|
||||||
(insert "Ledger has reported a problem. Check *Ledger Error* buffer.")))
|
(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)
|
||||||
|
|
@ -363,11 +363,11 @@ moved and recentered. If they aren't strange things happen."
|
||||||
(when recon-window
|
(when recon-window
|
||||||
(fit-window-to-buffer recon-window)
|
(fit-window-to-buffer recon-window)
|
||||||
(with-current-buffer buf
|
(with-current-buffer buf
|
||||||
(add-hook 'kill-buffer-hook 'ledger-reconcile-quit nil t)
|
(add-hook 'kill-buffer-hook 'ledger-reconcile-quit nil t)
|
||||||
(if (get-buffer-window buf)
|
(if (get-buffer-window buf)
|
||||||
(select-window (get-buffer-window buf)))
|
(select-window (get-buffer-window buf)))
|
||||||
(goto-char (point-max))
|
(goto-char (point-max))
|
||||||
(recenter -1))
|
(recenter -1))
|
||||||
(select-window recon-window)
|
(select-window recon-window)
|
||||||
(ledger-reconcile-visit t))
|
(ledger-reconcile-visit t))
|
||||||
(add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t)))
|
(add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t)))
|
||||||
|
|
@ -375,59 +375,59 @@ moved and recentered. If they aren't strange things happen."
|
||||||
(defun ledger-reconcile-track-xact ()
|
(defun ledger-reconcile-track-xact ()
|
||||||
"Force the ledger buffer to recenter on the transaction at point in the reconcile buffer."
|
"Force the ledger buffer to recenter on the transaction at point in the reconcile buffer."
|
||||||
(if (and ledger-buffer-tracks-reconcile-buffer
|
(if (and ledger-buffer-tracks-reconcile-buffer
|
||||||
(member this-command (list 'next-line
|
(member this-command (list 'next-line
|
||||||
'previous-line
|
'previous-line
|
||||||
'mouse-set-point
|
'mouse-set-point
|
||||||
'ledger-reconcile-toggle
|
'ledger-reconcile-toggle
|
||||||
'end-of-buffer
|
'end-of-buffer
|
||||||
'beginning-of-buffer)))
|
'beginning-of-buffer)))
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(ledger-reconcile-visit t))))
|
(ledger-reconcile-visit t))))
|
||||||
|
|
||||||
(defun ledger-reconcile-open-windows (buf rbuf)
|
(defun ledger-reconcile-open-windows (buf rbuf)
|
||||||
"Ensure that the ledger buffer BUF is split by RBUF."
|
"Ensure that the ledger buffer BUF is split by RBUF."
|
||||||
(if ledger-reconcile-force-window-bottom
|
(if ledger-reconcile-force-window-bottom
|
||||||
;;create the *Reconcile* window directly below the ledger buffer.
|
;;create the *Reconcile* window directly below the ledger buffer.
|
||||||
(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 ()
|
(defun ledger-reconcile ()
|
||||||
"Start reconciling, prompt for account."
|
"Start reconciling, prompt for account."
|
||||||
(interactive)
|
(interactive)
|
||||||
(let ((account (ledger-read-account-with-prompt "Account to reconcile"))
|
(let ((account (ledger-read-account-with-prompt "Account to reconcile"))
|
||||||
(buf (current-buffer))
|
(buf (current-buffer))
|
||||||
(rbuf (get-buffer ledger-recon-buffer-name)))
|
(rbuf (get-buffer ledger-recon-buffer-name)))
|
||||||
|
|
||||||
(add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t)
|
(add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t)
|
||||||
|
|
||||||
(if rbuf ;; *Reconcile* already exists
|
(if rbuf ;; *Reconcile* already exists
|
||||||
(with-current-buffer rbuf
|
(with-current-buffer rbuf
|
||||||
(set 'ledger-acct account) ;; already buffer local
|
(set 'ledger-acct account) ;; already buffer local
|
||||||
(when (not (eq buf rbuf))
|
(when (not (eq buf rbuf))
|
||||||
;; called from some other ledger-mode buffer
|
;; called from some other ledger-mode buffer
|
||||||
(ledger-reconcile-quit-cleanup)
|
(ledger-reconcile-quit-cleanup)
|
||||||
(set 'ledger-buf buf)) ;; should already be buffer-local
|
(set 'ledger-buf buf)) ;; should already be buffer-local
|
||||||
|
|
||||||
(unless (get-buffer-window rbuf)
|
(unless (get-buffer-window rbuf)
|
||||||
(ledger-reconcile-open-windows buf rbuf)))
|
(ledger-reconcile-open-windows buf rbuf)))
|
||||||
|
|
||||||
;; no recon-buffer, starting from scratch.
|
;; no recon-buffer, starting from scratch.
|
||||||
|
|
||||||
(with-current-buffer (setq rbuf
|
(with-current-buffer (setq rbuf
|
||||||
(get-buffer-create ledger-recon-buffer-name))
|
(get-buffer-create ledger-recon-buffer-name))
|
||||||
(ledger-reconcile-open-windows buf rbuf)
|
(ledger-reconcile-open-windows buf rbuf)
|
||||||
(ledger-reconcile-mode)
|
(ledger-reconcile-mode)
|
||||||
(make-local-variable 'ledger-target)
|
(make-local-variable 'ledger-target)
|
||||||
(set (make-local-variable 'ledger-buf) buf)
|
(set (make-local-variable 'ledger-buf) buf)
|
||||||
(set (make-local-variable 'ledger-acct) account)))
|
(set (make-local-variable 'ledger-acct) account)))
|
||||||
|
|
||||||
;; Narrow the ledger buffer
|
;; Narrow the ledger buffer
|
||||||
(with-current-buffer rbuf
|
(with-current-buffer rbuf
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(if ledger-narrow-on-reconcile
|
(if ledger-narrow-on-reconcile
|
||||||
(ledger-occur-mode account ledger-buf)))
|
(ledger-occur-mode account ledger-buf)))
|
||||||
(if (> (ledger-reconcile-refresh) 0)
|
(if (> (ledger-reconcile-refresh) 0)
|
||||||
(ledger-reconcile-change-target))
|
(ledger-reconcile-change-target))
|
||||||
(ledger-display-balance))))
|
(ledger-display-balance))))
|
||||||
|
|
||||||
(defvar ledger-reconcile-mode-abbrev-table)
|
(defvar ledger-reconcile-mode-abbrev-table)
|
||||||
|
|
@ -445,31 +445,31 @@ moved and recentered. If they aren't strange things happen."
|
||||||
(ledger-reconcile-refresh)))
|
(ledger-reconcile-refresh)))
|
||||||
|
|
||||||
(defvar ledger-reconcile-mode-map
|
(defvar ledger-reconcile-mode-map
|
||||||
(let ((map (make-sparse-keymap)))
|
(let ((map (make-sparse-keymap)))
|
||||||
(define-key map [(control ?m)] 'ledger-reconcile-visit)
|
(define-key map [(control ?m)] 'ledger-reconcile-visit)
|
||||||
(define-key map [return] 'ledger-reconcile-visit)
|
(define-key map [return] 'ledger-reconcile-visit)
|
||||||
(define-key map [(control ?l)] 'ledger-reconcile-refresh)
|
(define-key map [(control ?l)] 'ledger-reconcile-refresh)
|
||||||
(define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish)
|
(define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish)
|
||||||
(define-key map [? ] 'ledger-reconcile-toggle)
|
(define-key map [? ] 'ledger-reconcile-toggle)
|
||||||
(define-key map [?a] 'ledger-reconcile-add)
|
(define-key map [?a] 'ledger-reconcile-add)
|
||||||
(define-key map [?d] 'ledger-reconcile-delete)
|
(define-key map [?d] 'ledger-reconcile-delete)
|
||||||
(define-key map [?g] 'ledger-reconcile);
|
(define-key map [?g] 'ledger-reconcile);
|
||||||
(define-key map [?n] 'next-line)
|
(define-key map [?n] 'next-line)
|
||||||
(define-key map [?p] 'previous-line)
|
(define-key map [?p] 'previous-line)
|
||||||
(define-key map [?t] 'ledger-reconcile-change-target)
|
(define-key map [?t] 'ledger-reconcile-change-target)
|
||||||
(define-key map [?s] 'ledger-reconcile-save)
|
(define-key map [?s] 'ledger-reconcile-save)
|
||||||
(define-key map [?q] 'ledger-reconcile-quit)
|
(define-key map [?q] 'ledger-reconcile-quit)
|
||||||
(define-key map [?b] 'ledger-display-balance)
|
(define-key map [?b] 'ledger-display-balance)
|
||||||
|
|
||||||
(define-key map [(control ?c) (control ?o)] (ledger-reconcile-change-sort-key-and-refresh "(0)"))
|
(define-key map [(control ?c) (control ?o)] (ledger-reconcile-change-sort-key-and-refresh "(0)"))
|
||||||
|
|
||||||
(define-key map [(control ?c) (control ?a)] (ledger-reconcile-change-sort-key-and-refresh "(amount)"))
|
(define-key map [(control ?c) (control ?a)] (ledger-reconcile-change-sort-key-and-refresh "(amount)"))
|
||||||
|
|
||||||
(define-key map [(control ?c) (control ?d)] (ledger-reconcile-change-sort-key-and-refresh "(date)"))
|
(define-key map [(control ?c) (control ?d)] (ledger-reconcile-change-sort-key-and-refresh "(date)"))
|
||||||
|
|
||||||
(define-key map [(control ?c) (control ?p)] (ledger-reconcile-change-sort-key-and-refresh "(payee)"))
|
(define-key map [(control ?c) (control ?p)] (ledger-reconcile-change-sort-key-and-refresh "(payee)"))
|
||||||
map)
|
map)
|
||||||
"Keymap for `ledger-reconcile-mode'.")
|
"Keymap for `ledger-reconcile-mode'.")
|
||||||
|
|
||||||
(easy-menu-define ledger-reconcile-mode-menu ledger-reconcile-mode-map
|
(easy-menu-define ledger-reconcile-mode-menu ledger-reconcile-mode-map
|
||||||
"Ledger reconcile menu"
|
"Ledger reconcile menu"
|
||||||
|
|
@ -500,7 +500,7 @@ moved and recentered. If they aren't strange things happen."
|
||||||
))
|
))
|
||||||
|
|
||||||
(define-derived-mode ledger-reconcile-mode text-mode "Reconcile"
|
(define-derived-mode ledger-reconcile-mode text-mode "Reconcile"
|
||||||
"A mode for reconciling ledger entries.")
|
"A mode for reconciling ledger entries.")
|
||||||
|
|
||||||
(provide 'ledger-reconcile)
|
(provide 'ledger-reconcile)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -26,12 +26,12 @@
|
||||||
|
|
||||||
(defconst ledger-amount-regex
|
(defconst ledger-amount-regex
|
||||||
(concat "\\( \\|\t\\| \t\\)[ \t]*-?"
|
(concat "\\( \\|\t\\| \t\\)[ \t]*-?"
|
||||||
"\\([A-Z$€£_]+ *\\)?"
|
"\\([A-Z$€£_]+ *\\)?"
|
||||||
"\\(-?[0-9,\\.]+?\\)"
|
"\\(-?[0-9,\\.]+?\\)"
|
||||||
"\\(.[0-9]+\\)?"
|
"\\(.[0-9]+\\)?"
|
||||||
"\\( *[[:word:]€£_\"]+\\)?"
|
"\\( *[[:word:]€£_\"]+\\)?"
|
||||||
"\\([ \t]*[@={]@?[^\n;]+?\\)?"
|
"\\([ \t]*[@={]@?[^\n;]+?\\)?"
|
||||||
"\\([ \t]+;.+?\\|[ \t]*\\)?$"))
|
"\\([ \t]+;.+?\\|[ \t]*\\)?$"))
|
||||||
|
|
||||||
(defconst ledger-amount-decimal-comma-regex
|
(defconst ledger-amount-decimal-comma-regex
|
||||||
"-?[1-9][0-9.]*[,]?[0-9]*")
|
"-?[1-9][0-9.]*[,]?[0-9]*")
|
||||||
|
|
@ -83,10 +83,10 @@
|
||||||
(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."
|
||||||
(let ((defs
|
(let ((defs
|
||||||
(list
|
(list
|
||||||
`(defconst
|
`(defconst
|
||||||
,(intern (concat "ledger-" (symbol-name name) "-regexp"))
|
,(intern (concat "ledger-" (symbol-name name) "-regexp"))
|
||||||
,(eval regex))))
|
,(eval regex))))
|
||||||
(addend 0) last-group)
|
(addend 0) last-group)
|
||||||
(if (null args)
|
(if (null args)
|
||||||
(progn
|
(progn
|
||||||
|
|
@ -94,242 +94,242 @@
|
||||||
defs
|
defs
|
||||||
(list
|
(list
|
||||||
`(defconst
|
`(defconst
|
||||||
,(intern
|
,(intern
|
||||||
(concat "ledger-regex-" (symbol-name name) "-group"))
|
(concat "ledger-regex-" (symbol-name name) "-group"))
|
||||||
1)))
|
1)))
|
||||||
(nconc
|
(nconc
|
||||||
defs
|
defs
|
||||||
(list
|
(list
|
||||||
`(defconst
|
`(defconst
|
||||||
,(intern (concat "ledger-regex-" (symbol-name name)
|
,(intern (concat "ledger-regex-" (symbol-name name)
|
||||||
"-group--count"))
|
"-group--count"))
|
||||||
1)))
|
1)))
|
||||||
(nconc
|
(nconc
|
||||||
defs
|
defs
|
||||||
(list
|
(list
|
||||||
`(defmacro
|
`(defmacro
|
||||||
,(intern (concat "ledger-regex-" (symbol-name name)))
|
,(intern (concat "ledger-regex-" (symbol-name name)))
|
||||||
(&optional string)
|
(&optional string)
|
||||||
,(format "Return the match string for the %s" name)
|
,(format "Return the match string for the %s" name)
|
||||||
(match-string
|
(match-string
|
||||||
,(intern (concat "ledger-regex-" (symbol-name name)
|
,(intern (concat "ledger-regex-" (symbol-name name)
|
||||||
"-group"))
|
"-group"))
|
||||||
string)))))
|
string)))))
|
||||||
|
|
||||||
(dolist (arg args)
|
(dolist (arg args)
|
||||||
(let (var grouping target)
|
(let (var grouping target)
|
||||||
(if (symbolp arg)
|
(if (symbolp arg)
|
||||||
(setq var arg target arg)
|
(setq var arg target arg)
|
||||||
(assert (listp arg))
|
(assert (listp arg))
|
||||||
(if (= 2 (length arg))
|
(if (= 2 (length arg))
|
||||||
(setq var (car arg)
|
(setq var (car arg)
|
||||||
target (cadr arg))
|
target (cadr arg))
|
||||||
(setq var (car arg)
|
(setq var (car arg)
|
||||||
grouping (cadr arg)
|
grouping (cadr arg)
|
||||||
target (caddr arg))))
|
target (caddr arg))))
|
||||||
|
|
||||||
(if (and last-group
|
(if (and last-group
|
||||||
(not (eq last-group (or grouping target))))
|
(not (eq last-group (or grouping target))))
|
||||||
(incf addend
|
(incf addend
|
||||||
(symbol-value
|
(symbol-value
|
||||||
(intern-soft (concat "ledger-regex-"
|
(intern-soft (concat "ledger-regex-"
|
||||||
(symbol-name last-group)
|
(symbol-name last-group)
|
||||||
"-group--count")))))
|
"-group--count")))))
|
||||||
(nconc
|
(nconc
|
||||||
defs
|
defs
|
||||||
(list
|
(list
|
||||||
`(defconst
|
`(defconst
|
||||||
,(intern (concat "ledger-regex-" (symbol-name name)
|
,(intern (concat "ledger-regex-" (symbol-name name)
|
||||||
"-group-" (symbol-name var)))
|
"-group-" (symbol-name var)))
|
||||||
,(+ addend
|
,(+ addend
|
||||||
(symbol-value
|
(symbol-value
|
||||||
(intern-soft
|
(intern-soft
|
||||||
(if grouping
|
(if grouping
|
||||||
(concat "ledger-regex-" (symbol-name grouping)
|
(concat "ledger-regex-" (symbol-name grouping)
|
||||||
"-group-" (symbol-name target))
|
"-group-" (symbol-name target))
|
||||||
(concat "ledger-regex-" (symbol-name target)
|
(concat "ledger-regex-" (symbol-name target)
|
||||||
"-group"))))))))
|
"-group"))))))))
|
||||||
(nconc
|
(nconc
|
||||||
defs
|
defs
|
||||||
(list
|
(list
|
||||||
`(defmacro
|
`(defmacro
|
||||||
,(intern (concat "ledger-regex-" (symbol-name name)
|
,(intern (concat "ledger-regex-" (symbol-name name)
|
||||||
"-" (symbol-name var)))
|
"-" (symbol-name var)))
|
||||||
(&optional string)
|
(&optional string)
|
||||||
,(format "Return the sub-group match for the %s %s."
|
,(format "Return the sub-group match for the %s %s."
|
||||||
name var)
|
name var)
|
||||||
(match-string
|
(match-string
|
||||||
,(intern (concat "ledger-regex-" (symbol-name name)
|
,(intern (concat "ledger-regex-" (symbol-name name)
|
||||||
"-group-" (symbol-name var)))
|
"-group-" (symbol-name var)))
|
||||||
string))))
|
string))))
|
||||||
|
|
||||||
(setq last-group (or grouping target))))
|
(setq last-group (or grouping target))))
|
||||||
|
|
||||||
(nconc defs
|
(nconc defs
|
||||||
(list
|
(list
|
||||||
`(defconst ,(intern (concat "ledger-regex-" (symbol-name name)
|
`(defconst ,(intern (concat "ledger-regex-" (symbol-name name)
|
||||||
"-group--count"))
|
"-group--count"))
|
||||||
,(length args)))))
|
,(length args)))))
|
||||||
|
|
||||||
(cons 'progn defs)))
|
(cons 'progn defs)))
|
||||||
|
|
||||||
(put 'ledger-define-regexp 'lisp-indent-function 1)
|
(put 'ledger-define-regexp 'lisp-indent-function 1)
|
||||||
|
|
||||||
(ledger-define-regexp iso-date
|
(ledger-define-regexp iso-date
|
||||||
( let ((sep '(or ?- ?/)))
|
( let ((sep '(or ?- ?/)))
|
||||||
(rx (group
|
(rx (group
|
||||||
(and (? (and (group (= 4 num)))
|
(and (? (and (group (= 4 num)))
|
||||||
(eval sep))
|
(eval sep))
|
||||||
(group (and num (? num)))
|
(group (and num (? num)))
|
||||||
(eval sep)
|
(eval sep)
|
||||||
(group (and num (? num)))))))
|
(group (and num (? num)))))))
|
||||||
"Match a single date, in its 'written' form.")
|
"Match a single date, in its 'written' form.")
|
||||||
|
|
||||||
(ledger-define-regexp full-date
|
(ledger-define-regexp full-date
|
||||||
(macroexpand
|
(macroexpand
|
||||||
`(rx (and (regexp ,ledger-iso-date-regexp)
|
`(rx (and (regexp ,ledger-iso-date-regexp)
|
||||||
(? (and ?= (regexp ,ledger-iso-date-regexp))))))
|
(? (and ?= (regexp ,ledger-iso-date-regexp))))))
|
||||||
"Match a compound date, of the form ACTUAL=EFFECTIVE"
|
"Match a compound date, of the form ACTUAL=EFFECTIVE"
|
||||||
(actual iso-date)
|
(actual iso-date)
|
||||||
(effective iso-date))
|
(effective iso-date))
|
||||||
|
|
||||||
(ledger-define-regexp state
|
(ledger-define-regexp state
|
||||||
(rx (group (any ?! ?*)))
|
(rx (group (any ?! ?*)))
|
||||||
"Match a transaction or posting's \"state\" character.")
|
"Match a transaction or posting's \"state\" character.")
|
||||||
|
|
||||||
(ledger-define-regexp code
|
(ledger-define-regexp code
|
||||||
(rx (and ?\( (group (+? (not (any ?\))))) ?\)))
|
(rx (and ?\( (group (+? (not (any ?\))))) ?\)))
|
||||||
"Match the transaction code.")
|
"Match the transaction code.")
|
||||||
|
|
||||||
(ledger-define-regexp long-space
|
(ledger-define-regexp long-space
|
||||||
(rx (and (*? blank)
|
(rx (and (*? blank)
|
||||||
(or (and ? (or ? ?\t)) ?\t)))
|
(or (and ? (or ? ?\t)) ?\t)))
|
||||||
"Match a \"long space\".")
|
"Match a \"long space\".")
|
||||||
|
|
||||||
(ledger-define-regexp note
|
(ledger-define-regexp note
|
||||||
(rx (group (+ nonl)))
|
(rx (group (+ nonl)))
|
||||||
"")
|
"")
|
||||||
|
|
||||||
(ledger-define-regexp end-note
|
(ledger-define-regexp end-note
|
||||||
(macroexpand
|
(macroexpand
|
||||||
`(rx (and (regexp ,ledger-long-space-regexp) ?\;
|
`(rx (and (regexp ,ledger-long-space-regexp) ?\;
|
||||||
(regexp ,ledger-note-regexp))))
|
(regexp ,ledger-note-regexp))))
|
||||||
"")
|
"")
|
||||||
|
|
||||||
(ledger-define-regexp full-note
|
(ledger-define-regexp full-note
|
||||||
(macroexpand
|
(macroexpand
|
||||||
`(rx (and line-start (+ blank)
|
`(rx (and line-start (+ blank)
|
||||||
?\; (regexp ,ledger-note-regexp))))
|
?\; (regexp ,ledger-note-regexp))))
|
||||||
"")
|
"")
|
||||||
|
|
||||||
(ledger-define-regexp xact-line
|
(ledger-define-regexp xact-line
|
||||||
(macroexpand
|
(macroexpand
|
||||||
`(rx (and line-start
|
`(rx (and line-start
|
||||||
(regexp ,ledger-full-date-regexp)
|
(regexp ,ledger-full-date-regexp)
|
||||||
(? (and (+ blank) (regexp ,ledger-state-regexp)))
|
(? (and (+ blank) (regexp ,ledger-state-regexp)))
|
||||||
(? (and (+ blank) (regexp ,ledger-code-regexp)))
|
(? (and (+ blank) (regexp ,ledger-code-regexp)))
|
||||||
(+ blank) (+? nonl)
|
(+ blank) (+? nonl)
|
||||||
(? (regexp ,ledger-end-note-regexp))
|
(? (regexp ,ledger-end-note-regexp))
|
||||||
line-end)))
|
line-end)))
|
||||||
"Match a transaction's first line (and optional notes)."
|
"Match a transaction's first line (and optional notes)."
|
||||||
(actual-date full-date actual)
|
(actual-date full-date actual)
|
||||||
(effective-date full-date effective)
|
(effective-date full-date effective)
|
||||||
state
|
state
|
||||||
code
|
code
|
||||||
(note end-note))
|
(note end-note))
|
||||||
|
|
||||||
(ledger-define-regexp account
|
(ledger-define-regexp account
|
||||||
(rx (group (and (not (any blank ?\[ ?\( ?: ?\;)) (*? nonl))))
|
(rx (group (and (not (any blank ?\[ ?\( ?: ?\;)) (*? nonl))))
|
||||||
"")
|
"")
|
||||||
|
|
||||||
(ledger-define-regexp account-kind
|
(ledger-define-regexp account-kind
|
||||||
(rx (group (? (any ?\[ ?\())))
|
(rx (group (? (any ?\[ ?\())))
|
||||||
"")
|
"")
|
||||||
|
|
||||||
(ledger-define-regexp full-account
|
(ledger-define-regexp full-account
|
||||||
(macroexpand
|
(macroexpand
|
||||||
`(rx (and (regexp ,ledger-account-kind-regexp)
|
`(rx (and (regexp ,ledger-account-kind-regexp)
|
||||||
(regexp ,ledger-account-regexp)
|
(regexp ,ledger-account-regexp)
|
||||||
(? (any ?\] ?\))))))
|
(? (any ?\] ?\))))))
|
||||||
""
|
""
|
||||||
(kind account-kind)
|
(kind account-kind)
|
||||||
(name account))
|
(name account))
|
||||||
|
|
||||||
(ledger-define-regexp commodity
|
(ledger-define-regexp commodity
|
||||||
(rx (group
|
(rx (group
|
||||||
(or (and ?\" (+ (not (any ?\"))) ?\")
|
(or (and ?\" (+ (not (any ?\"))) ?\")
|
||||||
(not (any blank ?\n
|
(not (any blank ?\n
|
||||||
digit
|
digit
|
||||||
?- ?\[ ?\]
|
?- ?\[ ?\]
|
||||||
?. ?, ?\; ?+ ?* ?/ ?^ ?? ?: ?& ?| ?! ?=
|
?. ?, ?\; ?+ ?* ?/ ?^ ?? ?: ?& ?| ?! ?=
|
||||||
?\< ?\> ?\{ ?\} ?\( ?\) ?@)))))
|
?\< ?\> ?\{ ?\} ?\( ?\) ?@)))))
|
||||||
"")
|
"")
|
||||||
|
|
||||||
(ledger-define-regexp amount
|
(ledger-define-regexp amount
|
||||||
(rx (group
|
(rx (group
|
||||||
(and (? ?-)
|
(and (? ?-)
|
||||||
(and (+ digit)
|
(and (+ digit)
|
||||||
(*? (and (any ?. ?,) (+ digit))))
|
(*? (and (any ?. ?,) (+ digit))))
|
||||||
(? (and (any ?. ?,) (+ digit))))))
|
(? (and (any ?. ?,) (+ digit))))))
|
||||||
"")
|
"")
|
||||||
|
|
||||||
(ledger-define-regexp commoditized-amount
|
(ledger-define-regexp commoditized-amount
|
||||||
(macroexpand
|
(macroexpand
|
||||||
`(rx (group
|
`(rx (group
|
||||||
(or (and (regexp ,ledger-commodity-regexp)
|
(or (and (regexp ,ledger-commodity-regexp)
|
||||||
(*? blank)
|
(*? blank)
|
||||||
(regexp ,ledger-amount-regexp))
|
(regexp ,ledger-amount-regexp))
|
||||||
(and (regexp ,ledger-amount-regexp)
|
(and (regexp ,ledger-amount-regexp)
|
||||||
(*? blank)
|
(*? blank)
|
||||||
(regexp ,ledger-commodity-regexp))))))
|
(regexp ,ledger-commodity-regexp))))))
|
||||||
"")
|
"")
|
||||||
|
|
||||||
(ledger-define-regexp commodity-annotations
|
(ledger-define-regexp commodity-annotations
|
||||||
(macroexpand
|
(macroexpand
|
||||||
`(rx (* (+ blank)
|
`(rx (* (+ blank)
|
||||||
(or (and ?\{ (regexp ,ledger-commoditized-amount-regexp) ?\})
|
(or (and ?\{ (regexp ,ledger-commoditized-amount-regexp) ?\})
|
||||||
(and ?\[ (regexp ,ledger-iso-date-regexp) ?\])
|
(and ?\[ (regexp ,ledger-iso-date-regexp) ?\])
|
||||||
(and ?\( (not (any ?\))) ?\))))))
|
(and ?\( (not (any ?\))) ?\))))))
|
||||||
"")
|
"")
|
||||||
|
|
||||||
(ledger-define-regexp cost
|
(ledger-define-regexp cost
|
||||||
(macroexpand
|
(macroexpand
|
||||||
`(rx (and (or "@" "@@") (+ blank)
|
`(rx (and (or "@" "@@") (+ blank)
|
||||||
(regexp ,ledger-commoditized-amount-regexp))))
|
(regexp ,ledger-commoditized-amount-regexp))))
|
||||||
"")
|
"")
|
||||||
|
|
||||||
(ledger-define-regexp balance-assertion
|
(ledger-define-regexp balance-assertion
|
||||||
(macroexpand
|
(macroexpand
|
||||||
`(rx (and ?= (+ blank)
|
`(rx (and ?= (+ blank)
|
||||||
(regexp ,ledger-commoditized-amount-regexp))))
|
(regexp ,ledger-commoditized-amount-regexp))))
|
||||||
"")
|
"")
|
||||||
|
|
||||||
(ledger-define-regexp full-amount
|
(ledger-define-regexp full-amount
|
||||||
(macroexpand `(rx (group (+? (not (any ?\;))))))
|
(macroexpand `(rx (group (+? (not (any ?\;))))))
|
||||||
"")
|
"")
|
||||||
|
|
||||||
(ledger-define-regexp post-line
|
(ledger-define-regexp post-line
|
||||||
(macroexpand
|
(macroexpand
|
||||||
`(rx (and line-start (+ blank)
|
`(rx (and line-start (+ blank)
|
||||||
(? (and (regexp ,ledger-state-regexp) (* blank)))
|
(? (and (regexp ,ledger-state-regexp) (* blank)))
|
||||||
(regexp ,ledger-full-account-regexp)
|
(regexp ,ledger-full-account-regexp)
|
||||||
(? (and (regexp ,ledger-long-space-regexp)
|
(? (and (regexp ,ledger-long-space-regexp)
|
||||||
(regexp ,ledger-full-amount-regexp)))
|
(regexp ,ledger-full-amount-regexp)))
|
||||||
(? (regexp ,ledger-end-note-regexp))
|
(? (regexp ,ledger-end-note-regexp))
|
||||||
line-end)))
|
line-end)))
|
||||||
""
|
""
|
||||||
state
|
state
|
||||||
(account-kind full-account kind)
|
(account-kind full-account kind)
|
||||||
(account full-account name)
|
(account full-account name)
|
||||||
(amount full-amount)
|
(amount full-amount)
|
||||||
(note end-note))
|
(note end-note))
|
||||||
|
|
||||||
(defconst ledger-iterate-regex
|
(defconst ledger-iterate-regex
|
||||||
(concat "\\(\\(?:Y\\|year\\)\\s-+\\([0-9]+\\)\\|" ;; Catches a Y/year directive
|
(concat "\\(\\(?:Y\\|year\\)\\s-+\\([0-9]+\\)\\|" ;; Catches a Y/year directive
|
||||||
ledger-iso-date-regexp
|
ledger-iso-date-regexp
|
||||||
"\\([ *!]+\\)" ;; mark
|
"\\([ *!]+\\)" ;; mark
|
||||||
"\\((.*)\\)?" ;; code
|
"\\((.*)\\)?" ;; code
|
||||||
"\\(.*\\)" ;; desc
|
"\\(.*\\)" ;; desc
|
||||||
"\\)"))
|
"\\)"))
|
||||||
|
|
||||||
(provide 'ledger-regex)
|
(provide 'ledger-regex)
|
||||||
|
|
|
||||||
|
|
@ -50,7 +50,7 @@ the substitution. See the documentation of the individual functions
|
||||||
in that variable for more information on the behavior of each
|
in that variable for more information on the behavior of each
|
||||||
specifier."
|
specifier."
|
||||||
:type '(repeat (list (string :tag "Report Name")
|
:type '(repeat (list (string :tag "Report Name")
|
||||||
(string :tag "Command Line")))
|
(string :tag "Command Line")))
|
||||||
:group 'ledger-report)
|
:group 'ledger-report)
|
||||||
|
|
||||||
(defcustom ledger-report-format-specifiers
|
(defcustom ledger-report-format-specifiers
|
||||||
|
|
@ -231,7 +231,7 @@ used to generate the buffer, navigating the buffer, etc."
|
||||||
end of a ledger file which is included in some other file."
|
end of a ledger file which is included in some other file."
|
||||||
(if ledger-master-file
|
(if ledger-master-file
|
||||||
(expand-file-name ledger-master-file)
|
(expand-file-name ledger-master-file)
|
||||||
(buffer-file-name)))
|
(buffer-file-name)))
|
||||||
|
|
||||||
(defun ledger-report-payee-format-specifier ()
|
(defun ledger-report-payee-format-specifier ()
|
||||||
"Substitute a payee name.
|
"Substitute a payee name.
|
||||||
|
|
@ -261,16 +261,16 @@ used to generate the buffer, navigating the buffer, etc."
|
||||||
(let ((expanded-cmd report-cmd))
|
(let ((expanded-cmd report-cmd))
|
||||||
(set-match-data (list 0 0))
|
(set-match-data (list 0 0))
|
||||||
(while (string-match "%(\\([^)]*\\))" expanded-cmd (if (> (length expanded-cmd) (match-end 0))
|
(while (string-match "%(\\([^)]*\\))" expanded-cmd (if (> (length expanded-cmd) (match-end 0))
|
||||||
(match-end 0)
|
(match-end 0)
|
||||||
(1- (length expanded-cmd))))
|
(1- (length expanded-cmd))))
|
||||||
(let* ((specifier (match-string 1 expanded-cmd))
|
(let* ((specifier (match-string 1 expanded-cmd))
|
||||||
(f (cdr (assoc specifier ledger-report-format-specifiers))))
|
(f (cdr (assoc specifier ledger-report-format-specifiers))))
|
||||||
(if f
|
(if f
|
||||||
(setq expanded-cmd (replace-match
|
(setq expanded-cmd (replace-match
|
||||||
(save-match-data
|
(save-match-data
|
||||||
(with-current-buffer ledger-buf
|
(with-current-buffer ledger-buf
|
||||||
(shell-quote-argument (funcall f))))
|
(shell-quote-argument (funcall f))))
|
||||||
t t expanded-cmd)))))
|
t t expanded-cmd)))))
|
||||||
expanded-cmd)))
|
expanded-cmd)))
|
||||||
|
|
||||||
(defun ledger-report-cmd (report-name edit)
|
(defun ledger-report-cmd (report-name edit)
|
||||||
|
|
@ -286,8 +286,8 @@ Optional EDIT the command."
|
||||||
(or (string-empty-p report-name)
|
(or (string-empty-p report-name)
|
||||||
(ledger-report-name-exists report-name)
|
(ledger-report-name-exists report-name)
|
||||||
(progn
|
(progn
|
||||||
(ledger-reports-add report-name report-cmd)
|
(ledger-reports-add report-name report-cmd)
|
||||||
(ledger-reports-custom-save)))
|
(ledger-reports-custom-save)))
|
||||||
report-cmd))
|
report-cmd))
|
||||||
|
|
||||||
(defun ledger-do-report (cmd)
|
(defun ledger-do-report (cmd)
|
||||||
|
|
@ -299,32 +299,32 @@ Optional EDIT the command."
|
||||||
"\n\n")
|
"\n\n")
|
||||||
(let ((data-pos (point))
|
(let ((data-pos (point))
|
||||||
(register-report (string-match " reg\\(ister\\)? " cmd))
|
(register-report (string-match " reg\\(ister\\)? " cmd))
|
||||||
files-in-report)
|
files-in-report)
|
||||||
(shell-command
|
(shell-command
|
||||||
;; --subtotal does not produce identifiable transactions, so don't
|
;; --subtotal does not produce identifiable transactions, so don't
|
||||||
;; prepend location information for them
|
;; prepend location information for them
|
||||||
(if (and register-report
|
(if (and register-report
|
||||||
(not (string-match "--subtotal" cmd)))
|
(not (string-match "--subtotal" cmd)))
|
||||||
(concat cmd " --prepend-format='%(filename):%(beg_line):'")
|
(concat cmd " --prepend-format='%(filename):%(beg_line):'")
|
||||||
cmd)
|
cmd)
|
||||||
t nil)
|
t nil)
|
||||||
(when register-report
|
(when register-report
|
||||||
(goto-char data-pos)
|
(goto-char data-pos)
|
||||||
(while (re-search-forward "^\\(/[^:]+\\)?:\\([0-9]+\\)?:" nil t)
|
(while (re-search-forward "^\\(/[^:]+\\)?:\\([0-9]+\\)?:" nil t)
|
||||||
(let ((file (match-string 1))
|
(let ((file (match-string 1))
|
||||||
(line (string-to-number (match-string 2))))
|
(line (string-to-number (match-string 2))))
|
||||||
(delete-region (match-beginning 0) (match-end 0))
|
(delete-region (match-beginning 0) (match-end 0))
|
||||||
(when file
|
(when file
|
||||||
(set-text-properties (line-beginning-position) (line-end-position)
|
(set-text-properties (line-beginning-position) (line-end-position)
|
||||||
(list 'ledger-source (cons file (save-window-excursion
|
(list 'ledger-source (cons file (save-window-excursion
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(find-file file)
|
(find-file file)
|
||||||
(widen)
|
(widen)
|
||||||
(ledger-goto-line line)
|
(ledger-goto-line line)
|
||||||
(point-marker))))))
|
(point-marker))))))
|
||||||
(add-text-properties (line-beginning-position) (line-end-position)
|
(add-text-properties (line-beginning-position) (line-end-position)
|
||||||
(list 'face 'ledger-font-report-clickable-face))
|
(list 'face 'ledger-font-report-clickable-face))
|
||||||
(end-of-line)))))
|
(end-of-line)))))
|
||||||
(goto-char data-pos)))
|
(goto-char data-pos)))
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -332,21 +332,21 @@ Optional EDIT the command."
|
||||||
"Visit the transaction under point in the report window."
|
"Visit the transaction under point in the report window."
|
||||||
(interactive)
|
(interactive)
|
||||||
(let* ((prop (get-text-property (point) 'ledger-source))
|
(let* ((prop (get-text-property (point) 'ledger-source))
|
||||||
(file (if prop (car prop)))
|
(file (if prop (car prop)))
|
||||||
(line-or-marker (if prop (cdr prop))))
|
(line-or-marker (if prop (cdr prop))))
|
||||||
(when (and file line-or-marker)
|
(when (and file line-or-marker)
|
||||||
(find-file-other-window file)
|
(find-file-other-window file)
|
||||||
(widen)
|
(widen)
|
||||||
(if (markerp line-or-marker)
|
(if (markerp line-or-marker)
|
||||||
(goto-char line-or-marker)
|
(goto-char line-or-marker)
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(forward-line (1- line-or-marker))
|
(forward-line (1- line-or-marker))
|
||||||
(re-search-backward "^[0-9]+")
|
(re-search-backward "^[0-9]+")
|
||||||
(beginning-of-line)
|
(beginning-of-line)
|
||||||
(let ((start-of-txn (point)))
|
(let ((start-of-txn (point)))
|
||||||
(forward-paragraph)
|
(forward-paragraph)
|
||||||
(narrow-to-region start-of-txn (point))
|
(narrow-to-region start-of-txn (point))
|
||||||
(backward-paragraph))))))
|
(backward-paragraph))))))
|
||||||
|
|
||||||
(defun ledger-report-goto ()
|
(defun ledger-report-goto ()
|
||||||
"Goto the ledger report buffer."
|
"Goto the ledger report buffer."
|
||||||
|
|
@ -401,22 +401,22 @@ Optional EDIT the command."
|
||||||
(setq ledger-report-name (ledger-report-read-new-name)))
|
(setq ledger-report-name (ledger-report-read-new-name)))
|
||||||
|
|
||||||
(if (setq existing-name (ledger-report-name-exists ledger-report-name))
|
(if (setq existing-name (ledger-report-name-exists ledger-report-name))
|
||||||
(cond ((y-or-n-p (format "Overwrite existing report named '%s'? "
|
(cond ((y-or-n-p (format "Overwrite existing report named '%s'? "
|
||||||
ledger-report-name))
|
ledger-report-name))
|
||||||
(if (string-equal
|
(if (string-equal
|
||||||
ledger-report-cmd
|
ledger-report-cmd
|
||||||
(car (cdr (assq existing-name ledger-reports))))
|
(car (cdr (assq existing-name ledger-reports))))
|
||||||
(message "Nothing to save. Current command is identical to existing saved one")
|
(message "Nothing to save. Current command is identical to existing saved one")
|
||||||
(progn
|
(progn
|
||||||
(setq ledger-reports
|
(setq ledger-reports
|
||||||
(assq-delete-all existing-name ledger-reports))
|
(assq-delete-all existing-name ledger-reports))
|
||||||
(ledger-reports-add ledger-report-name ledger-report-cmd)
|
(ledger-reports-add ledger-report-name ledger-report-cmd)
|
||||||
(ledger-reports-custom-save))))
|
(ledger-reports-custom-save))))
|
||||||
(t
|
(t
|
||||||
(progn
|
(progn
|
||||||
(setq ledger-report-name (ledger-report-read-new-name))
|
(setq ledger-report-name (ledger-report-read-new-name))
|
||||||
(ledger-reports-add ledger-report-name ledger-report-cmd)
|
(ledger-reports-add ledger-report-name ledger-report-cmd)
|
||||||
(ledger-reports-custom-save)))))))
|
(ledger-reports-custom-save)))))))
|
||||||
|
|
||||||
(provide 'ledger-report)
|
(provide 'ledger-report)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -62,17 +62,17 @@
|
||||||
(and (>= val low) (<= val high)))
|
(and (>= val low) (<= val high)))
|
||||||
|
|
||||||
(defun ledger-schedule-check-available ()
|
(defun ledger-schedule-check-available ()
|
||||||
(setq ledger-schedule-available (and ledger-schedule-file
|
(setq ledger-schedule-available (and ledger-schedule-file
|
||||||
(file-exists-p ledger-schedule-file))))
|
(file-exists-p ledger-schedule-file))))
|
||||||
|
|
||||||
(defun ledger-schedule-days-in-month (month year)
|
(defun ledger-schedule-days-in-month (month year)
|
||||||
"Return number of days in the MONTH, MONTH is from 1 to 12.
|
"Return number of days in the MONTH, MONTH is from 1 to 12.
|
||||||
If year is nil, assume it is not a leap year"
|
If year is nil, assume it is not a leap year"
|
||||||
(if (between month 1 12)
|
(if (between month 1 12)
|
||||||
(if (and year (date-leap-year-p year) (= 2 month))
|
(if (and year (date-leap-year-p year) (= 2 month))
|
||||||
29
|
29
|
||||||
(nth (1- month) '(31 28 31 30 31 30 31 31 30 31 30 31)))
|
(nth (1- month) '(31 28 31 30 31 30 31 31 30 31 30 31)))
|
||||||
(error "Month out of range, MONTH=%S" month)))
|
(error "Month out of range, MONTH=%S" month)))
|
||||||
|
|
||||||
;; Macros to handle date expressions
|
;; Macros to handle date expressions
|
||||||
|
|
||||||
|
|
@ -83,51 +83,51 @@ month. Negative COUNT starts from the end of the month. (EQ
|
||||||
COUNT 0) means EVERY day-of-week (eg. every Saturday)"
|
COUNT 0) means EVERY day-of-week (eg. every Saturday)"
|
||||||
(if (and (between count -6 6) (between day-of-week 0 6))
|
(if (and (between count -6 6) (between day-of-week 0 6))
|
||||||
(cond ((zerop count) ;; Return true if day-of-week matches
|
(cond ((zerop count) ;; Return true if day-of-week matches
|
||||||
`(eq (nth 6 (decode-time date)) ,day-of-week))
|
`(eq (nth 6 (decode-time date)) ,day-of-week))
|
||||||
((> count 0) ;; Positive count
|
((> count 0) ;; Positive count
|
||||||
(let ((decoded (gensym)))
|
(let ((decoded (gensym)))
|
||||||
`(let ((,decoded (decode-time date)))
|
`(let ((,decoded (decode-time date)))
|
||||||
(and (eq (nth 6 ,decoded) ,day-of-week)
|
(and (eq (nth 6 ,decoded) ,day-of-week)
|
||||||
(between (nth 3 ,decoded)
|
(between (nth 3 ,decoded)
|
||||||
,(* (1- count) 7)
|
,(* (1- count) 7)
|
||||||
,(* count 7))))))
|
,(* count 7))))))
|
||||||
((< count 0)
|
((< count 0)
|
||||||
(let ((days-in-month (gensym))
|
(let ((days-in-month (gensym))
|
||||||
(decoded (gensym)))
|
(decoded (gensym)))
|
||||||
`(let* ((,decoded (decode-time date))
|
`(let* ((,decoded (decode-time date))
|
||||||
(,days-in-month (ledger-schedule-days-in-month
|
(,days-in-month (ledger-schedule-days-in-month
|
||||||
(nth 4 ,decoded)
|
(nth 4 ,decoded)
|
||||||
(nth 5 ,decoded))))
|
(nth 5 ,decoded))))
|
||||||
(and (eq (nth 6 ,decoded) ,day-of-week)
|
(and (eq (nth 6 ,decoded) ,day-of-week)
|
||||||
(between (nth 3 ,decoded)
|
(between (nth 3 ,decoded)
|
||||||
(+ ,days-in-month ,(* count 7))
|
(+ ,days-in-month ,(* count 7))
|
||||||
(+ ,days-in-month ,(* (1+ count) 7)))))))
|
(+ ,days-in-month ,(* (1+ count) 7)))))))
|
||||||
(t
|
(t
|
||||||
(error "COUNT out of range, COUNT=%S" count)))
|
(error "COUNT out of range, COUNT=%S" count)))
|
||||||
(error "Invalid argument to ledger-schedule-day-in-month-macro %S %S"
|
(error "Invalid argument to ledger-schedule-day-in-month-macro %S %S"
|
||||||
count
|
count
|
||||||
day-of-week)))
|
day-of-week)))
|
||||||
|
|
||||||
(defun ledger-schedule-constrain-every-count-day (day-of-week skip start-date)
|
(defun ledger-schedule-constrain-every-count-day (day-of-week skip start-date)
|
||||||
"Return a form that is true for every DAY skipping SKIP, starting on START.
|
"Return a form that is true for every DAY skipping SKIP, starting on START.
|
||||||
For example every second Friday, regardless of month."
|
For example every second Friday, regardless of month."
|
||||||
(let ((start-day (nth 6 (decode-time (eval start-date)))))
|
(let ((start-day (nth 6 (decode-time (eval start-date)))))
|
||||||
(if (eq start-day day-of-week) ;; good, can proceed
|
(if (eq start-day day-of-week) ;; good, can proceed
|
||||||
`(zerop (mod (- (time-to-days date) ,(time-to-days (eval start-date))) ,(* skip 7)))
|
`(zerop (mod (- (time-to-days date) ,(time-to-days (eval start-date))) ,(* skip 7)))
|
||||||
(error "START-DATE day of week doesn't match DAY-OF-WEEK"))))
|
(error "START-DATE day of week doesn't match DAY-OF-WEEK"))))
|
||||||
|
|
||||||
(defun ledger-schedule-constrain-date-range (month1 day1 month2 day2)
|
(defun ledger-schedule-constrain-date-range (month1 day1 month2 day2)
|
||||||
"Return a form of DATE that is true if DATE falls between MONTH1 DAY1 and MONTH2 DAY2."
|
"Return a form of DATE that is true if DATE falls between MONTH1 DAY1 and MONTH2 DAY2."
|
||||||
(let ((decoded (gensym))
|
(let ((decoded (gensym))
|
||||||
(target-month (gensym))
|
(target-month (gensym))
|
||||||
(target-day (gensym)))
|
(target-day (gensym)))
|
||||||
`(let* ((,decoded (decode-time date))
|
`(let* ((,decoded (decode-time date))
|
||||||
(,target-month (nth 4 decoded))
|
(,target-month (nth 4 decoded))
|
||||||
(,target-day (nth 3 decoded)))
|
(,target-day (nth 3 decoded)))
|
||||||
(and (and (> ,target-month ,month1)
|
(and (and (> ,target-month ,month1)
|
||||||
(< ,target-month ,month2))
|
(< ,target-month ,month2))
|
||||||
(and (> ,target-day ,day1)
|
(and (> ,target-day ,day1)
|
||||||
(< ,target-day ,day2))))))
|
(< ,target-day ,day2))))))
|
||||||
|
|
||||||
|
|
||||||
(defun ledger-schedule-is-holiday (date)
|
(defun ledger-schedule-is-holiday (date)
|
||||||
|
|
@ -140,46 +140,46 @@ the transaction should be logged for that day."
|
||||||
(interactive "fFile name: ")
|
(interactive "fFile name: ")
|
||||||
(let ((xact-list (list)))
|
(let ((xact-list (list)))
|
||||||
(with-current-buffer
|
(with-current-buffer
|
||||||
(find-file-noselect schedule-file)
|
(find-file-noselect schedule-file)
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(while (re-search-forward "^\\[\\(.*\\)\\] " nil t)
|
(while (re-search-forward "^\\[\\(.*\\)\\] " nil t)
|
||||||
(let ((date-descriptor "")
|
(let ((date-descriptor "")
|
||||||
(transaction nil)
|
(transaction nil)
|
||||||
(xact-start (match-end 0)))
|
(xact-start (match-end 0)))
|
||||||
(setq date-descriptors
|
(setq date-descriptors
|
||||||
(ledger-schedule-read-descriptor-tree
|
(ledger-schedule-read-descriptor-tree
|
||||||
(buffer-substring-no-properties
|
(buffer-substring-no-properties
|
||||||
(match-beginning 0)
|
(match-beginning 0)
|
||||||
(match-end 0))))
|
(match-end 0))))
|
||||||
(forward-paragraph)
|
(forward-paragraph)
|
||||||
(setq transaction (list date-descriptors
|
(setq transaction (list date-descriptors
|
||||||
(buffer-substring-no-properties
|
(buffer-substring-no-properties
|
||||||
xact-start
|
xact-start
|
||||||
(point))))
|
(point))))
|
||||||
(setq xact-list (cons transaction xact-list))))
|
(setq xact-list (cons transaction xact-list))))
|
||||||
xact-list)))
|
xact-list)))
|
||||||
|
|
||||||
(defun ledger-schedule-replace-brackets ()
|
(defun ledger-schedule-replace-brackets ()
|
||||||
"Replace all brackets with parens"
|
"Replace all brackets with parens"
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(while (search-forward "]" nil t)
|
(while (search-forward "]" nil t)
|
||||||
(replace-match ")" nil t))
|
(replace-match ")" nil t))
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(while (search-forward "[" nil t)
|
(while (search-forward "[" nil t)
|
||||||
(replace-match "(" nil t)))
|
(replace-match "(" nil t)))
|
||||||
|
|
||||||
(defvar ledger-schedule-descriptor-regex
|
(defvar ledger-schedule-descriptor-regex
|
||||||
(concat "\\(20[0-9][0-9]\\|[\*]\\)[/\\-]" ;; Year slot
|
(concat "\\(20[0-9][0-9]\\|[\*]\\)[/\\-]" ;; Year slot
|
||||||
"\\([\*EO]\\|[01][0-9]\\)[/\\-]" ;; Month slot
|
"\\([\*EO]\\|[01][0-9]\\)[/\\-]" ;; Month slot
|
||||||
"\\([\*]\\|\\([0-3][0-9]\\)\\|"
|
"\\([\*]\\|\\([0-3][0-9]\\)\\|"
|
||||||
"\\([0-5]"
|
"\\([0-5]"
|
||||||
"\\(\\(Su\\)\\|"
|
"\\(\\(Su\\)\\|"
|
||||||
"\\(Mo\\)\\|"
|
"\\(Mo\\)\\|"
|
||||||
"\\(Tu\\)\\|"
|
"\\(Tu\\)\\|"
|
||||||
"\\(We\\)\\|"
|
"\\(We\\)\\|"
|
||||||
"\\(Th\\)\\|"
|
"\\(Th\\)\\|"
|
||||||
"\\(Fr\\)\\|"
|
"\\(Fr\\)\\|"
|
||||||
"\\(Sa\\)\\)\\)\\)"))
|
"\\(Sa\\)\\)\\)\\)"))
|
||||||
|
|
||||||
(defun ledger-schedule-read-descriptor-tree (descriptor-string)
|
(defun ledger-schedule-read-descriptor-tree (descriptor-string)
|
||||||
"Take a date DESCRIPTOR-STRING and return a function of date that
|
"Take a date DESCRIPTOR-STRING and return a function of date that
|
||||||
|
|
@ -194,11 +194,11 @@ returns true if the date meets the requirements"
|
||||||
(goto-char (point-max))
|
(goto-char (point-max))
|
||||||
;; double quote all the descriptors for string processing later
|
;; double quote all the descriptors for string processing later
|
||||||
(while (re-search-backward ledger-schedule-descriptor-regex nil t) ;; Day slot
|
(while (re-search-backward ledger-schedule-descriptor-regex nil t) ;; Day slot
|
||||||
(goto-char
|
(goto-char
|
||||||
(match-end 0))
|
(match-end 0))
|
||||||
(insert ?\")
|
(insert ?\")
|
||||||
(goto-char (match-beginning 0))
|
(goto-char (match-beginning 0))
|
||||||
(insert "\"" )))
|
(insert "\"" )))
|
||||||
|
|
||||||
;; read the descriptor string into a lisp object the transform the
|
;; read the descriptor string into a lisp object the transform the
|
||||||
;; string descriptor into useable things
|
;; string descriptor into useable things
|
||||||
|
|
@ -206,30 +206,30 @@ returns true if the date meets the requirements"
|
||||||
(read (buffer-substring-no-properties (point-min) (point-max))))))
|
(read (buffer-substring-no-properties (point-min) (point-max))))))
|
||||||
|
|
||||||
(defun ledger-schedule-transform-auto-tree (descriptor-string-list)
|
(defun ledger-schedule-transform-auto-tree (descriptor-string-list)
|
||||||
"Takes a lisp list of date descriptor strings, TREE, and returns a string with a lambda function of date."
|
"Takes a lisp list of date descriptor strings, TREE, and returns a string with a lambda function of date."
|
||||||
;; use funcall to use the lambda function spit out here
|
;; use funcall to use the lambda function spit out here
|
||||||
(if (consp descriptor-string-list)
|
(if (consp descriptor-string-list)
|
||||||
(let (result)
|
(let (result)
|
||||||
(while (consp descriptor-string-list)
|
(while (consp descriptor-string-list)
|
||||||
(let ((newcar (car descriptor-string-list)))
|
(let ((newcar (car descriptor-string-list)))
|
||||||
(if (consp newcar)
|
(if (consp newcar)
|
||||||
(setq newcar (ledger-schedule-transform-auto-tree (car descriptor-string-list))))
|
(setq newcar (ledger-schedule-transform-auto-tree (car descriptor-string-list))))
|
||||||
;; newcar may be a cons now, after ledger-schedule-transfrom-auto-tree
|
;; newcar may be a cons now, after ledger-schedule-transfrom-auto-tree
|
||||||
(if (consp newcar)
|
(if (consp newcar)
|
||||||
(push newcar result)
|
(push newcar result)
|
||||||
;; this is where we actually turn the string descriptor into useful lisp
|
;; this is where we actually turn the string descriptor into useful lisp
|
||||||
(push (ledger-schedule-compile-constraints newcar) result)) )
|
(push (ledger-schedule-compile-constraints newcar) result)) )
|
||||||
(setq descriptor-string-list (cdr descriptor-string-list)))
|
(setq descriptor-string-list (cdr descriptor-string-list)))
|
||||||
|
|
||||||
;; tie up all the clauses in a big or and lambda, and return
|
;; tie up all the clauses in a big or and lambda, and return
|
||||||
;; the lambda function as list to be executed by funcall
|
;; the lambda function as list to be executed by funcall
|
||||||
`(lambda (date)
|
`(lambda (date)
|
||||||
,(nconc (list 'or) (nreverse result) descriptor-string-list)))))
|
,(nconc (list 'or) (nreverse result) descriptor-string-list)))))
|
||||||
|
|
||||||
(defun ledger-schedule-compile-constraints (descriptor-string)
|
(defun ledger-schedule-compile-constraints (descriptor-string)
|
||||||
"Return a list with the year, month and day fields split"
|
"Return a list with the year, month and day fields split"
|
||||||
(let ((fields (split-string descriptor-string "[/\\-]" t))
|
(let ((fields (split-string descriptor-string "[/\\-]" t))
|
||||||
constrain-year constrain-month constrain-day)
|
constrain-year constrain-month constrain-day)
|
||||||
(setq constrain-year (ledger-schedule-constrain-year (nth 0 fields)))
|
(setq constrain-year (ledger-schedule-constrain-year (nth 0 fields)))
|
||||||
(setq constrain-month (ledger-schedule-constrain-month (nth 1 fields)))
|
(setq constrain-month (ledger-schedule-constrain-month (nth 1 fields)))
|
||||||
(setq constrain-day (ledger-schedule-constrain-day (nth 2 fields)))
|
(setq constrain-day (ledger-schedule-constrain-day (nth 2 fields)))
|
||||||
|
|
@ -239,32 +239,32 @@ returns true if the date meets the requirements"
|
||||||
(defun ledger-schedule-constrain-year (str)
|
(defun ledger-schedule-constrain-year (str)
|
||||||
(let ((year-match t))
|
(let ((year-match t))
|
||||||
(cond ((string= str "*")
|
(cond ((string= str "*")
|
||||||
year-match)
|
year-match)
|
||||||
((/= 0 (setq year-match (string-to-number str)))
|
((/= 0 (setq year-match (string-to-number str)))
|
||||||
`(eq (nth 5 (decode-time date)) ,year-match))
|
`(eq (nth 5 (decode-time date)) ,year-match))
|
||||||
(t
|
(t
|
||||||
(error "Improperly specified year constraint: %s" str)))))
|
(error "Improperly specified year constraint: %s" str)))))
|
||||||
|
|
||||||
(defun ledger-schedule-constrain-month (str)
|
(defun ledger-schedule-constrain-month (str)
|
||||||
|
|
||||||
(let ((month-match t))
|
(let ((month-match t))
|
||||||
(cond ((string= str "*")
|
(cond ((string= str "*")
|
||||||
month-match) ;; always match
|
month-match) ;; always match
|
||||||
((/= 0 (setq month-match (string-to-number str)))
|
((/= 0 (setq month-match (string-to-number str)))
|
||||||
(if (between month-match 1 12) ;; no month specified, assume 31 days.
|
(if (between month-match 1 12) ;; no month specified, assume 31 days.
|
||||||
`(eq (nth 4 (decode-time date)) ,month-match)
|
`(eq (nth 4 (decode-time date)) ,month-match)
|
||||||
(error "ledger-schedule-constrain-numerical-month: month out of range %S" month-match)))
|
(error "ledger-schedule-constrain-numerical-month: month out of range %S" month-match)))
|
||||||
(t
|
(t
|
||||||
(error "Improperly specified month constraint: %s" str)))))
|
(error "Improperly specified month constraint: %s" str)))))
|
||||||
|
|
||||||
(defun ledger-schedule-constrain-day (str)
|
(defun ledger-schedule-constrain-day (str)
|
||||||
(let ((day-match t))
|
(let ((day-match t))
|
||||||
(cond ((string= str "*")
|
(cond ((string= str "*")
|
||||||
t)
|
t)
|
||||||
((/= 0 (setq day-match (string-to-number str)))
|
((/= 0 (setq day-match (string-to-number str)))
|
||||||
`(eq (nth 3 (decode-time date)) ,day-match))
|
`(eq (nth 3 (decode-time date)) ,day-match))
|
||||||
(t
|
(t
|
||||||
(error "Improperly specified day constraint: %s" str)))))
|
(error "Improperly specified day constraint: %s" str)))))
|
||||||
|
|
||||||
(defun ledger-schedule-parse-date-descriptor (descriptor)
|
(defun ledger-schedule-parse-date-descriptor (descriptor)
|
||||||
"Parse the date descriptor, return the evaluator"
|
"Parse the date descriptor, return the evaluator"
|
||||||
|
|
@ -273,31 +273,31 @@ returns true if the date meets the requirements"
|
||||||
(defun ledger-schedule-list-upcoming-xacts (candidate-items early horizon)
|
(defun ledger-schedule-list-upcoming-xacts (candidate-items early horizon)
|
||||||
"Search CANDIDATE-ITEMS for xacts that occur within the period today - EARLY to today + HORIZON"
|
"Search CANDIDATE-ITEMS for xacts that occur within the period today - EARLY to today + HORIZON"
|
||||||
(let ((start-date (time-subtract (current-time) (days-to-time early)))
|
(let ((start-date (time-subtract (current-time) (days-to-time early)))
|
||||||
test-date items)
|
test-date items)
|
||||||
(loop for day from 0 to (+ early horizon) by 1 do
|
(loop for day from 0 to (+ early horizon) by 1 do
|
||||||
(setq test-date (time-add start-date (days-to-time day)))
|
(setq test-date (time-add start-date (days-to-time day)))
|
||||||
(dolist (candidate candidate-items items)
|
(dolist (candidate candidate-items items)
|
||||||
(if (funcall (car candidate) test-date)
|
(if (funcall (car candidate) test-date)
|
||||||
(setq items (append items (list (list test-date (cadr candidate))))))))
|
(setq items (append items (list (list test-date (cadr candidate))))))))
|
||||||
items))
|
items))
|
||||||
|
|
||||||
(defun ledger-schedule-already-entered (candidate buffer)
|
(defun ledger-schedule-already-entered (candidate buffer)
|
||||||
(let ((target-date (format-time-string date-format (car candidate)))
|
(let ((target-date (format-time-string date-format (car candidate)))
|
||||||
(target-payee (cadr candidate)))
|
(target-payee (cadr candidate)))
|
||||||
nil))
|
nil))
|
||||||
|
|
||||||
(defun ledger-schedule-create-auto-buffer (candidate-items early horizon ledger-buf)
|
(defun ledger-schedule-create-auto-buffer (candidate-items early horizon ledger-buf)
|
||||||
"Format CANDIDATE-ITEMS for display."
|
"Format CANDIDATE-ITEMS for display."
|
||||||
(let ((candidates (ledger-schedule-list-upcoming-xacts candidate-items early horizon))
|
(let ((candidates (ledger-schedule-list-upcoming-xacts candidate-items early horizon))
|
||||||
(schedule-buf (get-buffer-create ledger-schedule-buffer-name))
|
(schedule-buf (get-buffer-create ledger-schedule-buffer-name))
|
||||||
(date-format (or (cdr (assoc "date-format" ledger-environment-alist))
|
(date-format (or (cdr (assoc "date-format" ledger-environment-alist))
|
||||||
ledger-default-date-format)))
|
ledger-default-date-format)))
|
||||||
(with-current-buffer schedule-buf
|
(with-current-buffer schedule-buf
|
||||||
(erase-buffer)
|
(erase-buffer)
|
||||||
(dolist (candidate candidates)
|
(dolist (candidate candidates)
|
||||||
(if (not (ledger-schedule-already-entered candidate ledger-buf))
|
(if (not (ledger-schedule-already-entered candidate ledger-buf))
|
||||||
(insert (format-time-string date-format (car candidate) ) " " (cadr candidate) "\n")))
|
(insert (format-time-string date-format (car candidate) ) " " (cadr candidate) "\n")))
|
||||||
(ledger-mode))
|
(ledger-mode))
|
||||||
(length candidates)))
|
(length candidates)))
|
||||||
|
|
||||||
(defun ledger-schedule-upcoming (file look-backward look-forward)
|
(defun ledger-schedule-upcoming (file look-backward look-forward)
|
||||||
|
|
@ -315,7 +315,7 @@ Use a prefix arg to change the default value"
|
||||||
(list (read-file-name "Schedule File: " () ledger-schedule-file t)
|
(list (read-file-name "Schedule File: " () ledger-schedule-file t)
|
||||||
(read-number "Look backward: " ledger-schedule-look-backward)
|
(read-number "Look backward: " ledger-schedule-look-backward)
|
||||||
(read-number "Look forward: " ledger-schedule-look-forward))
|
(read-number "Look forward: " ledger-schedule-look-forward))
|
||||||
(list ledger-schedule-file ledger-schedule-look-backward ledger-schedule-look-forward)))
|
(list ledger-schedule-file ledger-schedule-look-backward ledger-schedule-look-forward)))
|
||||||
(ledger-schedule-create-auto-buffer
|
(ledger-schedule-create-auto-buffer
|
||||||
(ledger-schedule-scan-transactions file)
|
(ledger-schedule-scan-transactions file)
|
||||||
look-backward
|
look-backward
|
||||||
|
|
|
||||||
|
|
@ -30,7 +30,7 @@
|
||||||
"Move point to next transaction."
|
"Move point to next transaction."
|
||||||
(if (re-search-forward ledger-payee-any-status-regex nil t)
|
(if (re-search-forward ledger-payee-any-status-regex nil t)
|
||||||
(goto-char (match-beginning 0))
|
(goto-char (match-beginning 0))
|
||||||
(goto-char (point-max))))
|
(goto-char (point-max))))
|
||||||
|
|
||||||
(defun ledger-end-record-function ()
|
(defun ledger-end-record-function ()
|
||||||
"Move point to end of transaction."
|
"Move point to end of transaction."
|
||||||
|
|
@ -49,7 +49,7 @@
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(if (ledger-sort-find-start)
|
(if (ledger-sort-find-start)
|
||||||
(delete-region (match-beginning 0) (match-end 0))))
|
(delete-region (match-beginning 0) (match-end 0))))
|
||||||
(beginning-of-line)
|
(beginning-of-line)
|
||||||
(insert "\n; Ledger-mode: Start sort\n\n"))
|
(insert "\n; Ledger-mode: Start sort\n\n"))
|
||||||
|
|
||||||
|
|
@ -58,7 +58,7 @@
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(if (ledger-sort-find-end)
|
(if (ledger-sort-find-end)
|
||||||
(delete-region (match-beginning 0) (match-end 0))))
|
(delete-region (match-beginning 0) (match-end 0))))
|
||||||
(beginning-of-line)
|
(beginning-of-line)
|
||||||
(insert "\n; Ledger-mode: End sort\n\n"))
|
(insert "\n; Ledger-mode: End sort\n\n"))
|
||||||
|
|
||||||
|
|
@ -71,34 +71,34 @@
|
||||||
(interactive "r") ;; load beg and end from point and mark
|
(interactive "r") ;; load beg and end from point and mark
|
||||||
;; automagically
|
;; automagically
|
||||||
(let ((new-beg beg)
|
(let ((new-beg beg)
|
||||||
(new-end end)
|
(new-end end)
|
||||||
point-delta
|
point-delta
|
||||||
(bounds (ledger-find-xact-extents (point)))
|
(bounds (ledger-find-xact-extents (point)))
|
||||||
target-xact)
|
target-xact)
|
||||||
|
|
||||||
(setq point-delta (- (point) (car bounds)))
|
(setq point-delta (- (point) (car bounds)))
|
||||||
(setq target-xact (buffer-substring (car bounds) (cadr bounds)))
|
(setq target-xact (buffer-substring (car bounds) (cadr bounds)))
|
||||||
(setq inhibit-modification-hooks t)
|
(setq inhibit-modification-hooks t)
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(save-restriction
|
(save-restriction
|
||||||
(goto-char beg)
|
(goto-char beg)
|
||||||
(ledger-next-record-function) ;; make sure point is at the
|
(ledger-next-record-function) ;; make sure point is at the
|
||||||
;; beginning of a xact
|
;; beginning of a xact
|
||||||
(setq new-beg (point))
|
(setq new-beg (point))
|
||||||
(goto-char end)
|
(goto-char end)
|
||||||
(ledger-next-record-function) ;; make sure end of region is at
|
(ledger-next-record-function) ;; make sure end of region is at
|
||||||
;; the beginning of next record
|
;; the beginning of next record
|
||||||
;; after the region
|
;; after the region
|
||||||
(setq new-end (point))
|
(setq new-end (point))
|
||||||
(narrow-to-region new-beg new-end)
|
(narrow-to-region new-beg new-end)
|
||||||
(goto-char new-beg)
|
(goto-char new-beg)
|
||||||
|
|
||||||
(let ((inhibit-field-text-motion t))
|
(let ((inhibit-field-text-motion t))
|
||||||
(sort-subr
|
(sort-subr
|
||||||
nil
|
nil
|
||||||
'ledger-next-record-function
|
'ledger-next-record-function
|
||||||
'ledger-end-record-function
|
'ledger-end-record-function
|
||||||
'ledger-sort-startkey))))
|
'ledger-sort-startkey))))
|
||||||
|
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(re-search-forward (regexp-quote target-xact))
|
(re-search-forward (regexp-quote target-xact))
|
||||||
|
|
@ -109,17 +109,17 @@
|
||||||
"Sort the entire buffer."
|
"Sort the entire buffer."
|
||||||
(interactive)
|
(interactive)
|
||||||
(let (sort-start
|
(let (sort-start
|
||||||
sort-end)
|
sort-end)
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(setq sort-start (ledger-sort-find-start)
|
(setq sort-start (ledger-sort-find-start)
|
||||||
sort-end (ledger-sort-find-end)))
|
sort-end (ledger-sort-find-end)))
|
||||||
(ledger-sort-region (if sort-start
|
(ledger-sort-region (if sort-start
|
||||||
sort-start
|
sort-start
|
||||||
(point-min))
|
(point-min))
|
||||||
(if sort-end
|
(if sort-end
|
||||||
sort-end
|
sort-end
|
||||||
(point-max)))))
|
(point-max)))))
|
||||||
|
|
||||||
(provide 'ledger-sort)
|
(provide 'ledger-sort)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -54,16 +54,16 @@
|
||||||
"Return the char representation of STATE."
|
"Return the char representation of STATE."
|
||||||
(if state
|
(if state
|
||||||
(if (eq state 'pending)
|
(if (eq state 'pending)
|
||||||
"!"
|
"!"
|
||||||
"*")
|
"*")
|
||||||
""))
|
""))
|
||||||
|
|
||||||
(defun ledger-state-from-char (state-char)
|
(defun ledger-state-from-char (state-char)
|
||||||
"Get state from STATE-CHAR."
|
"Get state from STATE-CHAR."
|
||||||
(cond ((eql state-char ?\!) 'pending)
|
(cond ((eql state-char ?\!) 'pending)
|
||||||
((eql state-char ?\*) 'cleared)
|
((eql state-char ?\*) 'cleared)
|
||||||
((eql state-char ?\;) 'comment)
|
((eql state-char ?\;) 'comment)
|
||||||
(t nil)))
|
(t nil)))
|
||||||
|
|
||||||
(defun ledger-toggle-current-posting (&optional style)
|
(defun ledger-toggle-current-posting (&optional style)
|
||||||
"Toggle the cleared status of the transaction under point.
|
"Toggle the cleared status of the transaction under point.
|
||||||
|
|
@ -82,12 +82,12 @@ dropped."
|
||||||
;; Uncompact the xact, to make it easier to toggle the
|
;; Uncompact the xact, to make it easier to toggle the
|
||||||
;; transaction
|
;; transaction
|
||||||
(save-excursion ;; this excursion checks state of entire
|
(save-excursion ;; this excursion checks state of entire
|
||||||
;; transaction and unclears if marked
|
;; transaction and unclears if marked
|
||||||
(goto-char (car bounds)) ;; beginning of xact
|
(goto-char (car bounds)) ;; beginning of xact
|
||||||
(skip-chars-forward "0-9./=\\-") ;; skip the date
|
(skip-chars-forward "0-9./=\\-") ;; skip the date
|
||||||
(skip-chars-forward " \t") ;; skip the white space after the date
|
(skip-chars-forward " \t") ;; skip the white space after the date
|
||||||
(setq cur-status (and (member (char-after) '(?\* ?\!))
|
(setq cur-status (and (member (char-after) '(?\* ?\!))
|
||||||
(ledger-state-from-char (char-after))))
|
(ledger-state-from-char (char-after))))
|
||||||
;;if cur-status if !, or * then delete the marker
|
;;if cur-status if !, or * then delete the marker
|
||||||
(when cur-status
|
(when cur-status
|
||||||
(let ((here (point)))
|
(let ((here (point)))
|
||||||
|
|
@ -98,15 +98,15 @@ dropped."
|
||||||
(if (search-forward " " (line-end-position) t)
|
(if (search-forward " " (line-end-position) t)
|
||||||
(insert (make-string width ? ))))))
|
(insert (make-string width ? ))))))
|
||||||
(forward-line)
|
(forward-line)
|
||||||
;; Shift the cleared/pending status to the postings
|
;; Shift the cleared/pending status to the postings
|
||||||
(while (looking-at "[ \t]")
|
(while (looking-at "[ \t]")
|
||||||
(skip-chars-forward " \t")
|
(skip-chars-forward " \t")
|
||||||
(when (not (eq (ledger-state-from-char (char-after)) 'comment))
|
(when (not (eq (ledger-state-from-char (char-after)) 'comment))
|
||||||
(insert (ledger-char-from-state cur-status) " ")
|
(insert (ledger-char-from-state cur-status) " ")
|
||||||
(if (search-forward " " (line-end-position) t)
|
(if (search-forward " " (line-end-position) t)
|
||||||
(delete-char 2)))
|
(delete-char 2)))
|
||||||
(forward-line))
|
(forward-line))
|
||||||
(setq new-status nil)))
|
(setq new-status nil)))
|
||||||
|
|
||||||
;;this excursion toggles the posting status
|
;;this excursion toggles the posting status
|
||||||
(save-excursion
|
(save-excursion
|
||||||
|
|
@ -114,40 +114,40 @@ dropped."
|
||||||
|
|
||||||
(goto-char (line-beginning-position))
|
(goto-char (line-beginning-position))
|
||||||
(when (looking-at "[ \t]")
|
(when (looking-at "[ \t]")
|
||||||
(skip-chars-forward " \t")
|
(skip-chars-forward " \t")
|
||||||
(let ((here (point))
|
(let ((here (point))
|
||||||
(cur-status (ledger-state-from-char (char-after))))
|
(cur-status (ledger-state-from-char (char-after))))
|
||||||
(skip-chars-forward "*! ")
|
(skip-chars-forward "*! ")
|
||||||
(let ((width (- (point) here)))
|
(let ((width (- (point) here)))
|
||||||
(when (> width 0)
|
(when (> width 0)
|
||||||
(delete-region here (point))
|
(delete-region here (point))
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(if (search-forward " " (line-end-position) t)
|
(if (search-forward " " (line-end-position) t)
|
||||||
(insert (make-string width ? ))))))
|
(insert (make-string width ? ))))))
|
||||||
(let (inserted)
|
(let (inserted)
|
||||||
(if cur-status
|
(if cur-status
|
||||||
(if (and style (eq style 'cleared))
|
(if (and style (eq style 'cleared))
|
||||||
(progn
|
(progn
|
||||||
(insert "* ")
|
(insert "* ")
|
||||||
(setq inserted 'cleared)))
|
(setq inserted 'cleared)))
|
||||||
(if (and style (eq style 'pending))
|
(if (and style (eq style 'pending))
|
||||||
(progn
|
(progn
|
||||||
(insert "! ")
|
(insert "! ")
|
||||||
(setq inserted 'pending))
|
(setq inserted 'pending))
|
||||||
(progn
|
(progn
|
||||||
(insert "* ")
|
(insert "* ")
|
||||||
(setq inserted 'cleared))))
|
(setq inserted 'cleared))))
|
||||||
(if (and inserted
|
(if (and inserted
|
||||||
(re-search-forward "\\(\t\\| [ \t]\\)"
|
(re-search-forward "\\(\t\\| [ \t]\\)"
|
||||||
(line-end-position) t))
|
(line-end-position) t))
|
||||||
(cond
|
(cond
|
||||||
((looking-at "\t")
|
((looking-at "\t")
|
||||||
(delete-char 1))
|
(delete-char 1))
|
||||||
((looking-at " [ \t]")
|
((looking-at " [ \t]")
|
||||||
(delete-char 2))
|
(delete-char 2))
|
||||||
((looking-at " ")
|
((looking-at " ")
|
||||||
(delete-char 1))))
|
(delete-char 1))))
|
||||||
(setq new-status inserted))))
|
(setq new-status inserted))))
|
||||||
(setq inhibit-modification-hooks nil))
|
(setq inhibit-modification-hooks nil))
|
||||||
|
|
||||||
;; This excursion cleans up the xact so that it displays
|
;; This excursion cleans up the xact so that it displays
|
||||||
|
|
@ -162,12 +162,12 @@ dropped."
|
||||||
(while (and (not hetero) (looking-at "[ \t]"))
|
(while (and (not hetero) (looking-at "[ \t]"))
|
||||||
(skip-chars-forward " \t")
|
(skip-chars-forward " \t")
|
||||||
(let ((cur-status (ledger-state-from-char (char-after))))
|
(let ((cur-status (ledger-state-from-char (char-after))))
|
||||||
(if (not (eq cur-status 'comment))
|
(if (not (eq cur-status 'comment))
|
||||||
(if first
|
(if first
|
||||||
(setq state cur-status
|
(setq state cur-status
|
||||||
first nil)
|
first nil)
|
||||||
(if (not (eq state cur-status))
|
(if (not (eq state cur-status))
|
||||||
(setq hetero t)))))
|
(setq hetero t)))))
|
||||||
(forward-line))
|
(forward-line))
|
||||||
(when (and (not hetero) (not (eq state nil)))
|
(when (and (not hetero) (not (eq state nil)))
|
||||||
(goto-char (car bounds))
|
(goto-char (car bounds))
|
||||||
|
|
@ -185,18 +185,18 @@ dropped."
|
||||||
(forward-line))
|
(forward-line))
|
||||||
(goto-char (car bounds))
|
(goto-char (car bounds))
|
||||||
(skip-chars-forward "0-9./=\\-") ;; Skip the date
|
(skip-chars-forward "0-9./=\\-") ;; Skip the date
|
||||||
(skip-chars-forward " \t") ;; Skip the white space
|
(skip-chars-forward " \t") ;; Skip the white space
|
||||||
(insert (ledger-char-from-state state) " ")
|
(insert (ledger-char-from-state state) " ")
|
||||||
(setq new-status state)
|
(setq new-status state)
|
||||||
(if (re-search-forward "\\(\t\\| [ \t]\\)"
|
(if (re-search-forward "\\(\t\\| [ \t]\\)"
|
||||||
(line-end-position) t)
|
(line-end-position) t)
|
||||||
(cond
|
(cond
|
||||||
((looking-at "\t")
|
((looking-at "\t")
|
||||||
(delete-char 1))
|
(delete-char 1))
|
||||||
((looking-at " [ \t]")
|
((looking-at " [ \t]")
|
||||||
(delete-char 2))
|
(delete-char 2))
|
||||||
((looking-at " ")
|
((looking-at " ")
|
||||||
(delete-char 1)))))))
|
(delete-char 1)))))))
|
||||||
new-status))
|
new-status))
|
||||||
|
|
||||||
(defun ledger-toggle-current (&optional style)
|
(defun ledger-toggle-current (&optional style)
|
||||||
|
|
@ -216,30 +216,30 @@ dropped."
|
||||||
(forward-line)
|
(forward-line)
|
||||||
(goto-char (line-beginning-position))))
|
(goto-char (line-beginning-position))))
|
||||||
(ledger-toggle-current-transaction style))
|
(ledger-toggle-current-transaction style))
|
||||||
(ledger-toggle-current-posting style)))
|
(ledger-toggle-current-posting style)))
|
||||||
|
|
||||||
(defun ledger-toggle-current-transaction (&optional style)
|
(defun ledger-toggle-current-transaction (&optional style)
|
||||||
"Toggle the transaction at point using optional STYLE."
|
"Toggle the transaction at point using optional STYLE."
|
||||||
(interactive)
|
(interactive)
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(when (or (looking-at "^[0-9]")
|
(when (or (looking-at "^[0-9]")
|
||||||
(re-search-backward "^[0-9]" nil t))
|
(re-search-backward "^[0-9]" nil t))
|
||||||
(skip-chars-forward "0-9./=\\-")
|
(skip-chars-forward "0-9./=\\-")
|
||||||
(delete-horizontal-space)
|
(delete-horizontal-space)
|
||||||
(if (or (eq (ledger-state-from-char (char-after)) 'pending)
|
(if (or (eq (ledger-state-from-char (char-after)) 'pending)
|
||||||
(eq (ledger-state-from-char (char-after)) 'cleared))
|
(eq (ledger-state-from-char (char-after)) 'cleared))
|
||||||
(progn
|
(progn
|
||||||
(delete-char 1)
|
(delete-char 1)
|
||||||
(when (and style (eq style 'cleared))
|
(when (and style (eq style 'cleared))
|
||||||
(insert " *")
|
(insert " *")
|
||||||
'cleared))
|
'cleared))
|
||||||
(if (and style (eq style 'pending))
|
(if (and style (eq style 'pending))
|
||||||
(progn
|
(progn
|
||||||
(insert " ! ")
|
(insert " ! ")
|
||||||
'pending)
|
'pending)
|
||||||
(progn
|
(progn
|
||||||
(insert " * ")
|
(insert " * ")
|
||||||
'cleared))))))
|
'cleared))))))
|
||||||
|
|
||||||
(provide 'ledger-state)
|
(provide 'ledger-state)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -98,9 +98,9 @@
|
||||||
(ledger-mode)
|
(ledger-mode)
|
||||||
(if input
|
(if input
|
||||||
(insert input)
|
(insert input)
|
||||||
(insert "2012-03-17 Payee\n")
|
(insert "2012-03-17 Payee\n")
|
||||||
(insert " Expenses:Food $20\n")
|
(insert " Expenses:Food $20\n")
|
||||||
(insert " Assets:Cash\n"))
|
(insert " Assets:Cash\n"))
|
||||||
(insert "\ntest reg\n")
|
(insert "\ntest reg\n")
|
||||||
(if output
|
(if output
|
||||||
(insert output))
|
(insert output))
|
||||||
|
|
@ -121,7 +121,7 @@
|
||||||
(let ((prev-directory default-directory))
|
(let ((prev-directory default-directory))
|
||||||
(cd ledger-source-directory)
|
(cd ledger-source-directory)
|
||||||
(unwind-protect
|
(unwind-protect
|
||||||
(async-shell-command (format "\"%s\" %s" command args))
|
(async-shell-command (format "\"%s\" %s" command args))
|
||||||
(cd prev-directory)))))))
|
(cd prev-directory)))))))
|
||||||
|
|
||||||
(provide 'ledger-test)
|
(provide 'ledger-test)
|
||||||
|
|
|
||||||
|
|
@ -20,18 +20,18 @@
|
||||||
;; MA 02110-1301 USA.
|
;; MA 02110-1301 USA.
|
||||||
|
|
||||||
(defgroup ledger-texi nil
|
(defgroup ledger-texi nil
|
||||||
"Options for working on Ledger texi documentation"
|
"Options for working on Ledger texi documentation"
|
||||||
:group 'ledger)
|
:group 'ledger)
|
||||||
|
|
||||||
(defcustom ledger-texi-sample-doc-path "~/ledger/doc/sample.dat"
|
(defcustom ledger-texi-sample-doc-path "~/ledger/doc/sample.dat"
|
||||||
"Location for sample data to be used in texi tests"
|
"Location for sample data to be used in texi tests"
|
||||||
:type 'file
|
:type 'file
|
||||||
:group 'ledger-texi)
|
:group 'ledger-texi)
|
||||||
|
|
||||||
(defcustom ledger-texi-normalization-args "--args-only --columns 80"
|
(defcustom ledger-texi-normalization-args "--args-only --columns 80"
|
||||||
"texi normalization for producing ledger output"
|
"texi normalization for producing ledger output"
|
||||||
:type 'string
|
:type 'string
|
||||||
:group 'ledger-texi)
|
:group 'ledger-texi)
|
||||||
|
|
||||||
(defun ledger-update-test ()
|
(defun ledger-update-test ()
|
||||||
(interactive)
|
(interactive)
|
||||||
|
|
@ -104,17 +104,17 @@
|
||||||
(if (string-match "\\$LEDGER" command)
|
(if (string-match "\\$LEDGER" command)
|
||||||
(replace-match (format "%s -f \"%s\" %s" ledger-binary-path
|
(replace-match (format "%s -f \"%s\" %s" ledger-binary-path
|
||||||
data-file ledger-texi-normalization-args) t t command)
|
data-file ledger-texi-normalization-args) t t command)
|
||||||
(concat (format "%s -f \"%s\" %s " ledger-binary-path
|
(concat (format "%s -f \"%s\" %s " ledger-binary-path
|
||||||
data-file ledger-texi-normalization-args) command)))
|
data-file ledger-texi-normalization-args) command)))
|
||||||
|
|
||||||
(defun ledger-texi-invoke-command (command)
|
(defun ledger-texi-invoke-command (command)
|
||||||
(with-temp-buffer (shell-command command t (current-buffer))
|
(with-temp-buffer (shell-command command t (current-buffer))
|
||||||
(if (= (point-min) (point-max))
|
(if (= (point-min) (point-max))
|
||||||
(progn
|
(progn
|
||||||
(push-mark nil t)
|
(push-mark nil t)
|
||||||
(message "Command '%s' yielded no result at %d" command (point))
|
(message "Command '%s' yielded no result at %d" command (point))
|
||||||
(ding))
|
(ding))
|
||||||
(buffer-string))))
|
(buffer-string))))
|
||||||
|
|
||||||
(defun ledger-texi-write-test-data (name input)
|
(defun ledger-texi-write-test-data (name input)
|
||||||
(let ((path (expand-file-name name temporary-file-directory)))
|
(let ((path (expand-file-name name temporary-file-directory)))
|
||||||
|
|
@ -159,7 +159,7 @@
|
||||||
|
|
||||||
(let ((section-name (if (string= section "smex")
|
(let ((section-name (if (string= section "smex")
|
||||||
"smallexample"
|
"smallexample"
|
||||||
"example"))
|
"example"))
|
||||||
(output (ledger-texi-invoke-command
|
(output (ledger-texi-invoke-command
|
||||||
(ledger-texi-expand-command command data-file))))
|
(ledger-texi-expand-command command data-file))))
|
||||||
(insert "@" section-name ?\n output
|
(insert "@" section-name ?\n output
|
||||||
|
|
|
||||||
|
|
@ -47,28 +47,28 @@ within the transaction."
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(goto-char pos)
|
(goto-char pos)
|
||||||
(list (progn
|
(list (progn
|
||||||
(backward-paragraph)
|
(backward-paragraph)
|
||||||
(if (/= (point) (point-min))
|
(if (/= (point) (point-min))
|
||||||
(forward-line))
|
(forward-line))
|
||||||
(line-beginning-position))
|
(line-beginning-position))
|
||||||
(progn
|
(progn
|
||||||
(forward-paragraph)
|
(forward-paragraph)
|
||||||
(line-beginning-position)))))
|
(line-beginning-position)))))
|
||||||
|
|
||||||
(defun ledger-highlight-xact-under-point ()
|
(defun ledger-highlight-xact-under-point ()
|
||||||
"Move the highlight overlay to the current transaction."
|
"Move the highlight overlay to the current transaction."
|
||||||
(if ledger-highlight-xact-under-point
|
(if ledger-highlight-xact-under-point
|
||||||
(let ((exts (ledger-find-xact-extents (point)))
|
(let ((exts (ledger-find-xact-extents (point)))
|
||||||
(ovl ledger-xact-highlight-overlay))
|
(ovl ledger-xact-highlight-overlay))
|
||||||
(if (not ledger-xact-highlight-overlay)
|
(if (not ledger-xact-highlight-overlay)
|
||||||
(setq ovl
|
(setq ovl
|
||||||
(setq ledger-xact-highlight-overlay
|
(setq ledger-xact-highlight-overlay
|
||||||
(make-overlay (car exts)
|
(make-overlay (car exts)
|
||||||
(cadr exts)
|
(cadr exts)
|
||||||
(current-buffer) t nil)))
|
(current-buffer) t nil)))
|
||||||
(move-overlay ovl (car exts) (cadr exts)))
|
(move-overlay ovl (car exts) (cadr exts)))
|
||||||
(overlay-put ovl 'face 'ledger-font-xact-highlight-face)
|
(overlay-put ovl 'face 'ledger-font-xact-highlight-face)
|
||||||
(overlay-put ovl 'priority 100))))
|
(overlay-put ovl 'priority 100))))
|
||||||
|
|
||||||
(defun ledger-xact-payee ()
|
(defun ledger-xact-payee ()
|
||||||
"Return the payee of the transaction containing point or nil."
|
"Return the payee of the transaction containing point or nil."
|
||||||
|
|
@ -78,7 +78,7 @@ within the transaction."
|
||||||
(let ((context-info (ledger-context-other-line i)))
|
(let ((context-info (ledger-context-other-line i)))
|
||||||
(if (eq (ledger-context-line-type context-info) 'xact)
|
(if (eq (ledger-context-line-type context-info) 'xact)
|
||||||
(ledger-context-field-value context-info 'payee)
|
(ledger-context-field-value context-info 'payee)
|
||||||
nil))))
|
nil))))
|
||||||
|
|
||||||
(defun ledger-time-less-p (t1 t2)
|
(defun ledger-time-less-p (t1 t2)
|
||||||
"Say whether time value T1 is less than time value T2."
|
"Say whether time value T1 is less than time value T2."
|
||||||
|
|
@ -114,19 +114,19 @@ MOMENT is an encoded date"
|
||||||
(let ((found-y-p (match-string 2)))
|
(let ((found-y-p (match-string 2)))
|
||||||
(if found-y-p
|
(if found-y-p
|
||||||
(setq current-year (string-to-number found-y-p)) ;; a Y directive was found
|
(setq current-year (string-to-number found-y-p)) ;; a Y directive was found
|
||||||
(let ((start (match-beginning 0))
|
(let ((start (match-beginning 0))
|
||||||
(year (match-string 4))
|
(year (match-string 4))
|
||||||
(month (string-to-number (match-string 5)))
|
(month (string-to-number (match-string 5)))
|
||||||
(day (string-to-number (match-string 6)))
|
(day (string-to-number (match-string 6)))
|
||||||
(mark (match-string 7))
|
(mark (match-string 7))
|
||||||
(code (match-string 8))
|
(code (match-string 8))
|
||||||
(desc (match-string 9)))
|
(desc (match-string 9)))
|
||||||
(if (and year (> (length year) 0))
|
(if (and year (> (length year) 0))
|
||||||
(setq year (string-to-number year)))
|
(setq year (string-to-number year)))
|
||||||
(funcall callback start
|
(funcall callback start
|
||||||
(encode-time 0 0 0 day month
|
(encode-time 0 0 0 day month
|
||||||
(or year current-year))
|
(or year current-year))
|
||||||
mark desc)))))
|
mark desc)))))
|
||||||
(forward-line))))
|
(forward-line))))
|
||||||
|
|
||||||
(defsubst ledger-goto-line (line-number)
|
(defsubst ledger-goto-line (line-number)
|
||||||
|
|
@ -137,7 +137,7 @@ MOMENT is an encoded date"
|
||||||
(defun ledger-year-and-month ()
|
(defun ledger-year-and-month ()
|
||||||
(let ((sep (if ledger-use-iso-dates
|
(let ((sep (if ledger-use-iso-dates
|
||||||
"-"
|
"-"
|
||||||
"/")))
|
"/")))
|
||||||
(concat ledger-year sep ledger-month sep)))
|
(concat ledger-year sep ledger-month sep)))
|
||||||
|
|
||||||
(defun ledger-copy-transaction-at-point (date)
|
(defun ledger-copy-transaction-at-point (date)
|
||||||
|
|
@ -145,14 +145,14 @@ MOMENT is an encoded date"
|
||||||
(interactive (list
|
(interactive (list
|
||||||
(ledger-read-date "Copy to date: ")))
|
(ledger-read-date "Copy to date: ")))
|
||||||
(let* ((here (point))
|
(let* ((here (point))
|
||||||
(extents (ledger-find-xact-extents (point)))
|
(extents (ledger-find-xact-extents (point)))
|
||||||
(transaction (buffer-substring-no-properties (car extents) (cadr extents)))
|
(transaction (buffer-substring-no-properties (car extents) (cadr extents)))
|
||||||
encoded-date)
|
encoded-date)
|
||||||
(if (string-match ledger-iso-date-regexp date)
|
(if (string-match ledger-iso-date-regexp date)
|
||||||
(setq encoded-date
|
(setq encoded-date
|
||||||
(encode-time 0 0 0 (string-to-number (match-string 4 date))
|
(encode-time 0 0 0 (string-to-number (match-string 4 date))
|
||||||
(string-to-number (match-string 3 date))
|
(string-to-number (match-string 3 date))
|
||||||
(string-to-number (match-string 2 date)))))
|
(string-to-number (match-string 2 date)))))
|
||||||
(ledger-xact-find-slot encoded-date)
|
(ledger-xact-find-slot encoded-date)
|
||||||
(insert transaction "\n")
|
(insert transaction "\n")
|
||||||
(backward-paragraph 2)
|
(backward-paragraph 2)
|
||||||
|
|
@ -191,20 +191,20 @@ correct chronological place in the buffer."
|
||||||
(string-to-number (match-string 2 date)))))
|
(string-to-number (match-string 2 date)))))
|
||||||
(ledger-xact-find-slot date)))
|
(ledger-xact-find-slot date)))
|
||||||
(if (> (length args) 1)
|
(if (> (length args) 1)
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(insert
|
(insert
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(setq exit-code
|
(setq exit-code
|
||||||
(apply #'ledger-exec-ledger ledger-buf (current-buffer) "xact"
|
(apply #'ledger-exec-ledger ledger-buf (current-buffer) "xact"
|
||||||
(mapcar 'eval args)))
|
(mapcar 'eval args)))
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(if (looking-at "Error: ")
|
(if (looking-at "Error: ")
|
||||||
(error (concat "Error in ledger-add-transaction: " (buffer-string)))
|
(error (concat "Error in ledger-add-transaction: " (buffer-string)))
|
||||||
(buffer-string)))
|
(buffer-string)))
|
||||||
"\n"))
|
"\n"))
|
||||||
(progn
|
(progn
|
||||||
(insert (car args) " \n\n")
|
(insert (car args) " \n\n")
|
||||||
(end-of-line -1)))))
|
(end-of-line -1)))))
|
||||||
|
|
||||||
|
|
||||||
(provide 'ledger-xact)
|
(provide 'ledger-xact)
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue