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

Code commenting cleanup.

Browse source
This commit is contained in:
Craig Earls 2013-02-14 15:37:13 -07:00
parent 6eb97a7c38
commit d8f0b0fa83
13 changed files with 309 additions and 174 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
lisp/ldg-commodities.el
View file

@ -33,11 +33,12 @@
;;; Code: ;;; Code:
(defcustom ledger-reconcile-default-commodity "$" (defcustom ledger-reconcile-default-commodity "$"
"the default commodity for use in target calculations in ledger reconcile" "The default commodity for use in target calculations in ledger reconcile."
:type 'string :type 'string
:group 'ledger) :group 'ledger)
(defun ledger-string-balance-to-commoditized-amount (str) (defun ledger-string-balance-to-commoditized-amount (str)
"Return a commoditized amount (val, 'comm') from STR."
(let ((fields (split-string str "[\n\r]"))) ; break any balances (let ((fields (split-string str "[\n\r]"))) ; break any balances
; with multi commodities ; with multi commodities
; into a list ; into a list
@ -53,16 +54,21 @@
(defun -commodity (c1 c2) (defun -commodity (c1 c2)
"Subtract C2 from C1, 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 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."
(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-commodity-to-string (c1) (defun ledger-commodity-to-string (c1)
"Return string representing C1.
Single character commodities are placed ahead of the value,
longer one are after the value."
(let ((val (number-to-string (car c1))) (let ((val (number-to-string (car c1)))
(commodity (cadr c1))) (commodity (cadr c1)))
(if (> (length commodity) 1) (if (> (length commodity) 1)
@ -70,6 +76,8 @@
(concat commodity " " val)))) (concat commodity " " val))))
(defun ledger-read-commodity-string (comm) (defun ledger-read-commodity-string (comm)
"Return a commoditizd value (val 'comm') from COMM.
Assumes a space between the value and the commodity."
(interactive (list (read-from-minibuffer (interactive (list (read-from-minibuffer
(concat "Enter commoditized amount (" ledger-reconcile-default-commodity "): ")))) (concat "Enter commoditized amount (" ledger-reconcile-default-commodity "): "))))
(let ((parts (split-string comm))) (let ((parts (split-string comm)))
@ -86,7 +94,7 @@
((and (/= 0 valp2) (= valp1 0)) ((and (/= 0 valp2) (= valp1 0))
(list valp2 (car parts))) (list valp2 (car parts)))
(t (t
(error "cannot understand commodity")))))))) (error "Cannot understand commodity"))))))))
(provide 'ldg-commodities) (provide 'ldg-commodities)

20
lisp/ldg-complete.el
View file

@ -21,10 +21,16 @@
;;(require 'esh-util) ;;(require 'esh-util)
;;(require 'esh-arg) ;;(require 'esh-arg)
;;; Commentary:
;; Functions providing payee and account auto complete.
(require 'pcomplete) (require 'pcomplete)
;; In-place completion support ;; In-place completion support
;;; Code:
(defun ledger-parse-arguments () (defun ledger-parse-arguments ()
"Parse whitespace separated arguments in the current region." "Parse whitespace separated arguments in the current region."
(let* ((info (save-excursion (let* ((info (save-excursion
@ -43,6 +49,7 @@
(cons (reverse args) (reverse begins))))) (cons (reverse args) (reverse begins)))))
(defun ledger-payees-in-buffer () (defun ledger-payees-in-buffer ()
"Scan buffer and return list of all payees."
(let ((origin (point)) (let ((origin (point))
payees-list) payees-list)
(save-excursion (save-excursion
@ -58,8 +65,8 @@
(pcomplete-uniqify-list (nreverse payees-list)))) (pcomplete-uniqify-list (nreverse payees-list))))
(defun ledger-find-accounts-in-buffer () (defun ledger-find-accounts-in-buffer ()
"search through buffer and build tree of accounts. Return tree "Search through buffer and build tree of accounts.
structure" Return tree structure"
(let ((origin (point)) (let ((origin (point))
(account-tree (list t)) (account-tree (list t))
(account-elements nil)) (account-elements nil))
@ -84,6 +91,7 @@
account-tree)) account-tree))
(defun ledger-accounts () (defun ledger-accounts ()
"Return a tree of all accounts in the buffer."
(let* ((current (caar (ledger-parse-arguments))) (let* ((current (caar (ledger-parse-arguments)))
(elements (and current (split-string current ":"))) (elements (and current (split-string current ":")))
(root (ledger-find-accounts-in-buffer)) (root (ledger-find-accounts-in-buffer))
@ -110,7 +118,7 @@
'string-lessp)))) 'string-lessp))))
(defun ledger-complete-at-point () (defun ledger-complete-at-point ()
"Do appropriate completion for the thing at point" "Do appropriate completion for the thing at point."
(interactive) (interactive)
(while (pcomplete-here (while (pcomplete-here
(if (eq (save-excursion (if (eq (save-excursion
@ -134,8 +142,8 @@
(ledger-accounts))))) (ledger-accounts)))))
(defun ledger-fully-complete-entry () (defun ledger-fully-complete-entry ()
"Completes a transaction if there is another matching payee in "Completes a transaction if there is another matching payee in the buffer.
the buffer. Does not use ledger xact" Does not use ledger xact"
(interactive) (interactive)
(let ((name (caar (ledger-parse-arguments))) (let ((name (caar (ledger-parse-arguments)))
xacts) xacts)
@ -164,3 +172,5 @@
(goto-char (match-end 0)))))) (goto-char (match-end 0))))))
(provide 'ldg-complete) (provide 'ldg-complete)
;;; ldg-complete.el ends here

18
lisp/ldg-exec.el
View file

@ -19,11 +19,17 @@
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA. ;; MA 02111-1307, USA.
;;; Commentary:
;; Code for executing ledger synchronously.
;;; Code:
(defconst ledger-version-needed "3.0.0" (defconst ledger-version-needed "3.0.0"
"The version of ledger executable needed for interactive features") "The version of ledger executable needed for interactive features.")
(defvar ledger-works nil (defvar ledger-works nil
"Flag showing whether the ledger binary can support ledger-mode interactive features") "Flag showing whether the ledger binary can support `ledger-mode' interactive features.")
(defgroup ledger-exec nil (defgroup ledger-exec nil
"Interface to the Ledger command-line accounting program." "Interface to the Ledger command-line accounting program."
@ -35,7 +41,7 @@
:group 'ledger) :group 'ledger)
(defun ledger-exec-ledger (input-buffer &optional output-buffer &rest args) (defun ledger-exec-ledger (input-buffer &optional output-buffer &rest args)
"Run Ledger." "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)))
@ -51,6 +57,7 @@
outbuf))) outbuf)))
(defun ledger-exec-read (&optional input-buffer &rest args) (defun ledger-exec-read (&optional input-buffer &rest args)
"Run ledger from option INPUT-BUFFER using ARGS, return a list structure of the ledger Emacs output."
(with-current-buffer (with-current-buffer
(apply #'ledger-exec-ledger input-buffer nil "emacs" args) (apply #'ledger-exec-ledger input-buffer nil "emacs" args)
(goto-char (point-min)) (goto-char (point-min))
@ -59,7 +66,7 @@
(kill-buffer (current-buffer))))) (kill-buffer (current-buffer)))))
(defun ledger-version-greater-p (needed) (defun ledger-version-greater-p (needed)
"verify the ledger binary is usable for ledger-mode" "Verify the ledger binary is usable for `ledger-mode' (version greater than NEEDED)."
(let ((buffer ledger-buf) (let ((buffer ledger-buf)
(version-strings '()) (version-strings '())
(version-number)) (version-number))
@ -77,6 +84,7 @@
nil)))) nil))))
(defun ledger-check-version () (defun ledger-check-version ()
"Verify that ledger works and is modern enough."
(interactive) (interactive)
(setq ledger-works (ledger-version-greater-p ledger-version-needed)) (setq ledger-works (ledger-version-greater-p ledger-version-needed))
(if ledger-works (if ledger-works
@ -84,3 +92,5 @@
(message "Bad Ledger Version"))) (message "Bad Ledger Version")))
(provide 'ldg-exec) (provide 'ldg-exec)
;;; ldg-exec.el ends here

9
lisp/ldg-fonts.el
View file

@ -20,6 +20,12 @@
;; MA 02111-1307, USA. ;; MA 02111-1307, USA.
;;; Commentary:
;; All of the faces for ledger mode are defined here.
;;; Code:
(defgroup ledger-faces nil "Ledger mode highlighting" :group 'ledger) (defgroup ledger-faces nil "Ledger mode highlighting" :group 'ledger)
(defface ledger-font-uncleared-face (defface ledger-font-uncleared-face
`((t :foreground "#dc322f" :weight bold )) `((t :foreground "#dc322f" :weight bold ))
@ -105,4 +111,7 @@
("^\\([A-Za-z]+ .+\\)" 1 ledger-font-other-face)) ("^\\([A-Za-z]+ .+\\)" 1 ledger-font-other-face))
"Expressions to highlight in Ledger mode.") "Expressions to highlight in Ledger mode.")
(provide 'ldg-fonts) (provide 'ldg-fonts)
;;; ldg-fonts.el ends here

34
lisp/ldg-mode.el
View file

@ -20,18 +20,24 @@
;; MA 02111-1307, USA. ;; MA 02111-1307, USA.
;;; Commentary:
;; Most of the general ledger-mode code is here.
;;; Code:
(defsubst ledger-current-year () (defsubst ledger-current-year ()
"The default current year for adding transactions."
(format-time-string "%Y")) (format-time-string "%Y"))
(defsubst ledger-current-month () (defsubst ledger-current-month ()
"The default current month for adding transactions."
(format-time-string "%m")) (format-time-string "%m"))
(defvar ledger-year (ledger-current-year) (defvar ledger-year (ledger-current-year)
"Start a ledger session with the current year, but make it "Start a ledger session with the current year, but make it customizable to ease retro-entry.")
customizable to ease retro-entry.")
(defvar ledger-month (ledger-current-month) (defvar ledger-month (ledger-current-month)
"Start a ledger session with the current month, but make it "Start a ledger session with the current month, but make it customizable to ease retro-entry.")
customizable to ease retro-entry.")
(defcustom ledger-default-acct-transaction-indent " " (defcustom ledger-default-acct-transaction-indent " "
"Default indentation for account transactions in an entry." "Default indentation for account transactions in an entry."
@ -39,6 +45,7 @@ customizable to ease retro-entry.")
:group 'ledger) :group 'ledger)
(defun ledger-remove-overlays () (defun ledger-remove-overlays ()
"Remove all overlays from the ledger buffer."
(interactive) (interactive)
"remove overlays formthe buffer, used if the buffer is reverted" "remove overlays formthe buffer, used if the buffer is reverted"
(remove-overlays)) (remove-overlays))
@ -135,13 +142,15 @@ customizable to ease retro-entry.")
(< (nth 1 t1) (nth 1 t2))))) (< (nth 1 t1) (nth 1 t2)))))
(defun ledger-time-subtract (t1 t2) (defun ledger-time-subtract (t1 t2)
"Subtract two time values. Return the difference in the format "Subtract two time values, T1 - T2.
of a time value." Return the difference in the format of a time value."
(let ((borrow (< (cadr t1) (cadr t2)))) (let ((borrow (< (cadr t1) (cadr t2))))
(list (- (car t1) (car t2) (if borrow 1 0)) (list (- (car t1) (car t2) (if borrow 1 0))
(- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
(defun ledger-find-slot (moment) (defun ledger-find-slot (moment)
"Find the right place in the buffer for a transaction at MOMENT.
MOMENT is an encoded date"
(catch 'found (catch 'found
(ledger-iterate-transactions (ledger-iterate-transactions
(function (function
@ -150,6 +159,7 @@ customizable to ease retro-entry.")
(throw 'found t))))))) (throw 'found t)))))))
(defun ledger-iterate-transactions (callback) (defun ledger-iterate-transactions (callback)
"Iterate through each transaction call CALLBACK for each."
(goto-char (point-min)) (goto-char (point-min))
(let* ((now (current-time)) (let* ((now (current-time))
(current-year (nth 5 (decode-time now)))) (current-year (nth 5 (decode-time now))))
@ -177,20 +187,24 @@ customizable to ease retro-entry.")
(forward-line)))) (forward-line))))
(defun ledger-set-year (newyear) (defun ledger-set-year (newyear)
"Set ledger's idea of the current year to the prefix argument." "Set ledger's idea of the current year to the prefix argument NEWYEAR."
(interactive "p") (interactive "p")
(if (= newyear 1) (if (= newyear 1)
(setq ledger-year (read-string "Year: " (ledger-current-year))) (setq ledger-year (read-string "Year: " (ledger-current-year)))
(setq ledger-year (number-to-string newyear)))) (setq ledger-year (number-to-string newyear))))
(defun ledger-set-month (newmonth) (defun ledger-set-month (newmonth)
"Set ledger's idea of the current month to the prefix argument." "Set ledger's idea of the current month to the prefix argument NEWMONTH."
(interactive "p") (interactive "p")
(if (= newmonth 1) (if (= newmonth 1)
(setq ledger-month (read-string "Month: " (ledger-current-month))) (setq ledger-month (read-string "Month: " (ledger-current-month)))
(setq ledger-month (format "%02d" newmonth)))) (setq ledger-month (format "%02d" newmonth))))
(defun ledger-add-transaction (transaction-text &optional insert-at-point) (defun ledger-add-transaction (transaction-text &optional insert-at-point)
"Use ledger xact TRANSACTION-TEXT to add a transaction to the buffer.
If INSERT-AT-POINT is non-nil insert the transaction
there, otherwise call `ledger-find-slot' to insert it at the
correct chronological place in the buffer."
(interactive (list (interactive (list
(read-string "Transaction: " (concat ledger-year "/" ledger-month "/")))) (read-string "Transaction: " (concat ledger-year "/" ledger-month "/"))))
(let* ((args (with-temp-buffer (let* ((args (with-temp-buffer
@ -223,6 +237,7 @@ customizable to ease retro-entry.")
(end-of-line -1))))) (end-of-line -1)))))
(defun ledger-current-transaction-bounds () (defun ledger-current-transaction-bounds ()
"Return markers for the beginning and end of transaction surrounding point."
(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))
@ -232,8 +247,11 @@ customizable to ease retro-entry.")
(cons (copy-marker beg) (point-marker)))))) (cons (copy-marker beg) (point-marker))))))
(defun ledger-delete-current-transaction () (defun ledger-delete-current-transaction ()
"Delete the transaction surrounging point."
(interactive) (interactive)
(let ((bounds (ledger-current-transaction-bounds))) (let ((bounds (ledger-current-transaction-bounds)))
(delete-region (car bounds) (cdr bounds)))) (delete-region (car bounds) (cdr bounds))))
(provide 'ldg-mode) (provide 'ldg-mode)
;;; ldg-mode.el ends here

13
lisp/ldg-new.el
View file

@ -31,7 +31,7 @@
;; MA 02111-1307, USA. ;; MA 02111-1307, USA.
;;; Commentary: ;;; Commentary:
;; Load up the ledger mode
(require 'ldg-complete) (require 'ldg-complete)
(require 'ldg-exec) (require 'ldg-exec)
(require 'ldg-mode) (require 'ldg-mode)
@ -49,6 +49,8 @@
(require 'ldg-commodities) (require 'ldg-commodities)
;;; Code:
(autoload #'ledger-texi-update-test "ldg-texi" nil t) (autoload #'ledger-texi-update-test "ldg-texi" nil t)
(autoload #'ledger-texi-update-examples "ldg-texi" nil t) (autoload #'ledger-texi-update-examples "ldg-texi" nil t)
@ -57,13 +59,12 @@
:group 'data) :group 'data)
(defconst ledger-version "3.0" (defconst ledger-version "3.0"
"The version of ledger.el currently loaded") "The version of ledger.el currently loaded.")
(provide 'ledger)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ledger-create-test () (defun ledger-create-test ()
"Create a regression test."
(interactive) (interactive)
(save-restriction (save-restriction
(org-narrow-to-subtree) (org-narrow-to-subtree)
@ -87,4 +88,6 @@
(delete-char 3) (delete-char 3)
(forward-line 1)))))) (forward-line 1))))))
;;; ledger.el ends here (provide 'ledger)
;;; ldg-new.el ends here

27
lisp/ldg-occur.el
View file

@ -35,7 +35,7 @@
(defconst ledger-occur-overlay-property-name 'ledger-occur-custom-buffer-grep) (defconst ledger-occur-overlay-property-name 'ledger-occur-custom-buffer-grep)
(defcustom ledger-occur-use-face-unfolded t (defcustom ledger-occur-use-face-unfolded t
"if non-nil use a custom face for xacts shown in ledger-occur mode" "If non-nil use a custom face for xacts shown in `ledger-occur' mode."
:type 'boolean :type 'boolean
:group 'ledger) :group 'ledger)
(make-variable-buffer-local 'ledger-occur-use-face-unfolded) (make-variable-buffer-local 'ledger-occur-use-face-unfolded)
@ -49,11 +49,11 @@
(list '(ledger-occur-mode ledger-occur-mode)))) (list '(ledger-occur-mode ledger-occur-mode))))
(defvar ledger-occur-history nil (defvar ledger-occur-history nil
"History of previously searched expressions for the prompt") "History of previously searched expressions for the prompt.")
(make-variable-buffer-local 'ledger-occur-history) (make-variable-buffer-local 'ledger-occur-history)
(defvar ledger-occur-last-match nil (defvar ledger-occur-last-match nil
"Last match found") "Last match found.")
(make-variable-buffer-local 'ledger-occur-last-match) (make-variable-buffer-local 'ledger-occur-last-match)
(defvar ledger-occur-overlay-list nil (defvar ledger-occur-overlay-list nil
@ -61,7 +61,7 @@
(make-variable-buffer-local 'ledger-occur-overlay-list) (make-variable-buffer-local 'ledger-occur-overlay-list)
(defun ledger-occur-mode (regex buffer) (defun ledger-occur-mode (regex buffer)
"Higlight transaction that match REGEX, hiding others "Highlight transactions that match REGEX in BUFFER, hiding others.
When REGEX is nil, unhide everything, and remove higlight" When REGEX is nil, unhide everything, and remove higlight"
(progn (progn
@ -86,8 +86,7 @@ When REGEX is nil, unhide everything, and remove higlight"
(recenter))) (recenter)))
(defun ledger-occur (regex) (defun ledger-occur (regex)
"Perform a simple grep in current buffer for the regular "Perform a simple grep in current buffer for the regular expression REGEX.
expression REGEX
This command hides all xact from the current buffer except This command hides all xact from the current buffer except
those containing the regular expression REGEX. A second call those containing the regular expression REGEX. A second call
@ -101,7 +100,7 @@ When REGEX is nil, unhide everything, and remove higlight"
(ledger-occur-mode regex (current-buffer))) (ledger-occur-mode regex (current-buffer)))
(defun ledger-occur-prompt () (defun ledger-occur-prompt ()
"Returns the default value of the prompt. "Return the default value of the prompt.
Default value for prompt is a current word or active Default value for prompt is a current word or active
region(selection), if its size is 1 line" region(selection), if its size is 1 line"
@ -147,6 +146,8 @@ When REGEX is nil, unhide everything, and remove higlight"
(defun ledger-occur-create-xact-overlays (ovl-bounds) (defun ledger-occur-create-xact-overlays (ovl-bounds)
"Create the overlay for the visible transactions.
Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
(let ((overlays (let ((overlays
(mapcar (lambda (bnd) (mapcar (lambda (bnd)
(make-overlay (make-overlay
@ -161,8 +162,7 @@ When REGEX is nil, unhide everything, and remove higlight"
overlays))) overlays)))
(defun ledger-occur-change-regex (regex buffer) (defun ledger-occur-change-regex (regex buffer)
"use this function to programatically change the overlays, "Use this function to programatically change the overlays using REGEX in BUFFER, rather than quitting out and restarting."
rather than quitting out and restarting"
(progn (progn
(set-buffer buffer) (set-buffer buffer)
(setq ledger-occur-mode nil) (setq ledger-occur-mode nil)
@ -171,8 +171,8 @@ When REGEX is nil, unhide everything, and remove higlight"
(recenter))) (recenter)))
(defun ledger-occur-quit-buffer (buffer) (defun ledger-occur-quit-buffer (buffer)
"quits hidings transaction in the given buffer. Used for "Quits hidings transaction in the given BUFFER.
coordinating ledger-occur with other buffers, like reconcile" Used for coordinating `ledger-occur' with other buffers, like reconcile."
(progn (progn
(set-buffer buffer) (set-buffer buffer)
(setq ledger-occur-mode nil) (setq ledger-occur-mode nil)
@ -181,6 +181,7 @@ When REGEX is nil, unhide everything, and remove higlight"
(recenter))) (recenter)))
(defun ledger-occur-remove-overlays () (defun ledger-occur-remove-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)
@ -188,6 +189,7 @@ When REGEX is nil, unhide everything, and remove higlight"
(defun ledger-occur-create-xact-overlay-bounds (buffer-matches) (defun ledger-occur-create-xact-overlay-bounds (buffer-matches)
"Use BUFFER-MATCHES to produce the overlay for the visible transactions."
(let ((prev-end (point-min)) (let ((prev-end (point-min))
(overlays (list))) (overlays (list)))
(when buffer-matches (when buffer-matches
@ -199,8 +201,7 @@ When REGEX is nil, unhide everything, and remove higlight"
(defun ledger-occur-find-matches (regex) (defun ledger-occur-find-matches (regex)
"Returns a list of 2-number tuples, specifying begnning of the "Return a list of 2-number tuples describing the beginning and start of transactions meeting REGEX."
line and end of a line containing matching xact"
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
;; Set initial values for variables ;; Set initial values for variables

24
lisp/ldg-post.el
View file

@ -19,8 +19,14 @@
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA. ;; MA 02111-1307, USA.
;;; Commentary:
;; Utility functions for dealing with postings.
(require 'ldg-regex) (require 'ldg-regex)
;;; Code:
(defgroup ledger-post nil (defgroup ledger-post nil
"" ""
:group 'ledger) :group 'ledger)
@ -46,12 +52,13 @@
:group 'ledger-post) :group 'ledger-post)
(defcustom ledger-post-use-decimal-comma nil (defcustom ledger-post-use-decimal-comma nil
"if non-nil the use commas as decimal separator. This only has "If non-nil the use commas as decimal separator.
effect interfacing to calc mode in edit amount" This only has effect interfacing to calc mode in edit amount"
:type 'boolean :type 'boolean
:group 'ledger-post) :group 'ledger-post)
(defun ledger-post-all-accounts () (defun ledger-post-all-accounts ()
"Return a list of all accounts in the buffer."
(let ((origin (point)) (let ((origin (point))
(ledger-post-list nil) (ledger-post-list nil)
account elements) account elements)
@ -68,7 +75,7 @@
(defvar iswitchb-temp-buflist) (defvar iswitchb-temp-buflist)
(defun ledger-post-completing-read (prompt choices) (defun ledger-post-completing-read (prompt choices)
"Use iswitchb as a completing-read replacement to choose from choices. "Use iswitchb as a `completing-read' replacement to choose from choices.
PROMPT is a string to prompt with. CHOICES is a list of PROMPT is a string to prompt with. CHOICES is a list of
strings to choose from." strings to choose from."
(cond (cond
@ -86,6 +93,7 @@
(defvar ledger-post-current-list nil) (defvar ledger-post-current-list nil)
(defun ledger-post-pick-account () (defun ledger-post-pick-account ()
"Insert an account entered by the user."
(interactive) (interactive)
(let* ((account (let* ((account
(ledger-post-completing-read (ledger-post-completing-read
@ -111,6 +119,7 @@
(goto-char pos))) (goto-char pos)))
(defun ledger-next-amount (&optional end) (defun ledger-next-amount (&optional end)
"Move point to the next amount, as long as it is not past END."
(when (re-search-forward "\\( \\|\t\\| \t\\)[ \t]*-?\\([A-Z$€£]+ *\\)?\\(-?[0-9,]+?\\)\\(.[0-9]+\\)?\\( *[A-Z$€£]+\\)?\\([ \t]*@@?[^\n;]+?\\)?\\([ \t]+;.+?\\)?$" (marker-position end) t) (when (re-search-forward "\\( \\|\t\\| \t\\)[ \t]*-?\\([A-Z$€£]+ *\\)?\\(-?[0-9,]+?\\)\\(.[0-9]+\\)?\\( *[A-Z$€£]+\\)?\\([ \t]*@@?[^\n;]+?\\)?\\([ \t]+;.+?\\)?$" (marker-position end) t)
(goto-char (match-beginning 0)) (goto-char (match-beginning 0))
(skip-syntax-forward " ") (skip-syntax-forward " ")
@ -146,6 +155,7 @@
(forward-line)))))) (forward-line))))))
(defun ledger-post-align-amount () (defun ledger-post-align-amount ()
"Align the amounts in this posting."
(interactive) (interactive)
(save-excursion (save-excursion
(set-mark (line-beginning-position)) (set-mark (line-beginning-position))
@ -153,6 +163,8 @@
(ledger-align-amounts))) (ledger-align-amounts)))
(defun ledger-post-maybe-align (beg end len) (defun ledger-post-maybe-align (beg end len)
"Align amounts only if point is in a posting.
BEG, END, and LEN control how far it can align."
(save-excursion (save-excursion
(goto-char beg) (goto-char beg)
(when (< end (line-end-position)) (when (< end (line-end-position))
@ -161,6 +173,7 @@
(ledger-post-align-amount))))) (ledger-post-align-amount)))))
(defun ledger-post-edit-amount () (defun ledger-post-edit-amount ()
"Call 'calc-mode' and push the amount in the posting to the top of stack."
(interactive) (interactive)
(goto-char (line-beginning-position)) (goto-char (line-beginning-position))
(when (re-search-forward ledger-post-line-regexp (line-end-position) t) (when (re-search-forward ledger-post-line-regexp (line-end-position) t)
@ -189,6 +202,7 @@
(calc)))))) (calc))))))
(defun ledger-post-prev-xact () (defun ledger-post-prev-xact ()
"Move point to the previous transaction."
(interactive) (interactive)
(backward-paragraph) (backward-paragraph)
(when (re-search-backward ledger-xact-line-regexp nil t) (when (re-search-backward ledger-xact-line-regexp nil t)
@ -197,6 +211,7 @@
(goto-char (match-end ledger-regex-post-line-group-account)))) (goto-char (match-end ledger-regex-post-line-group-account))))
(defun ledger-post-next-xact () (defun ledger-post-next-xact ()
"Move point to the next transaction."
(interactive) (interactive)
(when (re-search-forward ledger-xact-line-regexp nil t) (when (re-search-forward ledger-xact-line-regexp nil t)
(goto-char (match-beginning 0)) (goto-char (match-beginning 0))
@ -204,8 +219,11 @@
(goto-char (match-end ledger-regex-post-line-group-account)))) (goto-char (match-end ledger-regex-post-line-group-account))))
(defun ledger-post-setup () (defun ledger-post-setup ()
"Configure `ledger-mode' to auto-align postings."
(if ledger-post-auto-adjust-amounts (if ledger-post-auto-adjust-amounts
(add-hook 'after-change-functions 'ledger-post-maybe-align t t)) (add-hook 'after-change-functions 'ledger-post-maybe-align t t))
(add-hook 'after-save-hook #'(lambda () (setq ledger-post-current-list nil)))) (add-hook 'after-save-hook #'(lambda () (setq ledger-post-current-list nil))))
(provide 'ldg-post) (provide 'ldg-post)
;;; ldg-post.el ends here

72
lisp/ldg-reconcile.el
View file

@ -21,44 +21,48 @@
;; Reconcile mode ;; Reconcile mode
;;; Commentary:
;;
;;; Code:
(defvar ledger-buf nil) (defvar ledger-buf nil)
(defvar ledger-bufs nil) (defvar ledger-bufs nil)
(defvar ledger-acct nil) (defvar ledger-acct nil)
(defvar ledger-target nil) (defvar ledger-target nil)
(defcustom ledger-recon-buffer-name "*Reconcile*" (defcustom ledger-recon-buffer-name "*Reconcile*"
"Name to use for reconciliation window" "Name to use for reconciliation window."
:group 'ledger) :group 'ledger)
(defcustom ledger-fold-on-reconcile t (defcustom ledger-fold-on-reconcile t
"if t, limit transactions shown in main buffer to those "If t, limit transactions shown in main buffer to those matching the reconcile regex."
matching the reconcile regex"
:type 'boolean :type 'boolean
:group 'ledger) :group 'ledger)
(defcustom ledger-buffer-tracks-reconcile-buffer t (defcustom ledger-buffer-tracks-reconcile-buffer t
"if t, then when the cursor is moved to a new xact in the recon "If t, then when the cursor is moved to a new xact in the recon window.
window, then that transaction will be shown in its source Then that transaction will be shown in its source buffer."
buffer."
:type 'boolean :type 'boolean
:group 'ledger) :group 'ledger)
(defcustom ledger-reconcile-force-window-bottom nil (defcustom ledger-reconcile-force-window-bottom nil
"If t make the reconcile window appear along the bottom of the "If t make the reconcile window appear along the bottom of the register window and resize."
register window and resize"
:type 'boolean :type 'boolean
:group 'ledger) :group 'ledger)
(defcustom ledger-reconcile-toggle-to-pending t (defcustom ledger-reconcile-toggle-to-pending t
"if true then toggle between uncleared and pending. "If true then toggle between uncleared and pending.
reconcile-finish will mark all pending posting cleared." reconcile-finish will mark all pending posting cleared."
:type 'boolean :type 'boolean
:group 'ledger) :group 'ledger)
(defun ledger-reconcile-get-balances () (defun ledger-reconcile-get-balances ()
"Calculate the cleared and uncleared balance of the account being reconciled, "Calculate the cleared and uncleared balance of the account.
return a list with the account, uncleared and cleared balances as numbers" Return a list with the account, uncleared and cleared balances as
numbers"
(interactive) (interactive)
(let ((buffer ledger-buf) (let ((buffer ledger-buf)
(account ledger-acct) (account ledger-acct)
@ -74,7 +78,7 @@
(setq val (read (buffer-substring-no-properties (point-min) (point-max))))))) (setq val (read (buffer-substring-no-properties (point-min) (point-max)))))))
(defun ledger-display-balance () (defun ledger-display-balance ()
"Calculate the cleared balance of the account being reconciled" "Calculate the cleared balance of the account being reconciled."
(interactive) (interactive)
(let* ((pending (car (ledger-string-balance-to-commoditized-amount (let* ((pending (car (ledger-string-balance-to-commoditized-amount
(car (ledger-reconcile-get-balances))))) (car (ledger-reconcile-get-balances)))))
@ -93,18 +97,20 @@
(defun is-stdin (file) (defun is-stdin (file)
"True if ledger file is standard input" "True if ledger FILE is standard input."
(or (or
(equal file "") (equal file "")
(equal file "<stdin>") (equal file "<stdin>")
(equal file "/dev/stdin"))) (equal file "/dev/stdin")))
(defun ledger-reconcile-get-buffer (where) (defun ledger-reconcile-get-buffer (where)
"Return a buffer from WHERE the transaction is."
(if (bufferp (car where)) (if (bufferp (car where))
(car where) (car where)
(error "buffer not set"))) (error "Buffer not set")))
(defun ledger-reconcile-toggle () (defun ledger-reconcile-toggle ()
"Toggle the current transaction, and mark the recon window."
(interactive) (interactive)
(let ((where (get-text-property (point) 'where)) (let ((where (get-text-property (point) 'where))
(inhibit-read-only t) (inhibit-read-only t)
@ -137,6 +143,7 @@
(ledger-display-balance))) (ledger-display-balance)))
(defun ledger-reconcile-refresh () (defun ledger-reconcile-refresh ()
"Force the reconciliation window to refresh."
(interactive) (interactive)
(let ((inhibit-read-only t) (let ((inhibit-read-only t)
(line (count-lines (point-min) (point)))) (line (count-lines (point-min) (point))))
@ -147,6 +154,7 @@
(forward-line line))) (forward-line line)))
(defun ledger-reconcile-refresh-after-save () (defun ledger-reconcile-refresh-after-save ()
"Refresh the recon-window after the ledger buffer is saved."
(let ((buf (get-buffer ledger-recon-buffer-name))) (let ((buf (get-buffer ledger-recon-buffer-name)))
(if buf (if buf
(with-current-buffer buf (with-current-buffer buf
@ -154,12 +162,14 @@
(set-buffer-modified-p nil))))) (set-buffer-modified-p nil)))))
(defun ledger-reconcile-add () (defun ledger-reconcile-add ()
"Use ledger xact to add a new transaction."
(interactive) (interactive)
(with-current-buffer ledger-buf (with-current-buffer ledger-buf
(call-interactively #'ledger-add-transaction)) (call-interactively #'ledger-add-transaction))
(ledger-reconcile-refresh)) (ledger-reconcile-refresh))
(defun ledger-reconcile-delete () (defun ledger-reconcile-delete ()
"Delete the transactions pointed to in the recon window."
(interactive) (interactive)
(let ((where (get-text-property (point) 'where))) (let ((where (get-text-property (point) 'where)))
(when (ledger-reconcile-get-buffer where) (when (ledger-reconcile-get-buffer where)
@ -172,6 +182,7 @@
(set-buffer-modified-p t))))) (set-buffer-modified-p t)))))
(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."
(interactive) (interactive)
(progn (progn
(beginning-of-line) (beginning-of-line)
@ -190,6 +201,7 @@
(switch-to-buffer-other-window cur-buf)))))) (switch-to-buffer-other-window cur-buf))))))
(defun ledger-reconcile-save () (defun ledger-reconcile-save ()
"Save the ledger buffer."
(interactive) (interactive)
(dolist (buf (cons ledger-buf ledger-bufs)) (dolist (buf (cons ledger-buf ledger-bufs))
(with-current-buffer buf (with-current-buffer buf
@ -198,8 +210,8 @@
(ledger-display-balance)) (ledger-display-balance))
(defun ledger-reconcile-finish () (defun ledger-reconcile-finish ()
"Mark all pending posting or transactions as cleared, depending "Mark all pending posting or transactions as cleared.
on ledger-reconcile-clear-whole-transactions, save the buffers Depends on ledger-reconcile-clear-whole-transactions, save the buffers
and exit reconcile mode" and exit reconcile mode"
(interactive) (interactive)
(save-excursion (save-excursion
@ -216,6 +228,7 @@
(defun ledger-reconcile-quit () (defun ledger-reconcile-quit ()
"Quite the reconcile window without saving ledger buffer."
(interactive) (interactive)
(ledger-reconcile-quit-cleanup) (ledger-reconcile-quit-cleanup)
(let ((buf ledger-buf) (let ((buf ledger-buf)
@ -228,6 +241,7 @@
(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."
(interactive) (interactive)
(let ((buf ledger-buf) (let ((buf ledger-buf)
(reconcile-buf (get-buffer ledger-recon-buffer-name))) (reconcile-buf (get-buffer ledger-recon-buffer-name)))
@ -237,9 +251,8 @@
(ledger-occur-quit-buffer buf))))) (ledger-occur-quit-buffer buf)))))
(defun ledger-marker-where-xact-is (emacs-xact posting) (defun ledger-marker-where-xact-is (emacs-xact posting)
"find the position of the xact in the ledger-buf buffer using "Find the position of the EMACS-XACT in the `ledger-buf'.
the emacs output from ledger, return the buffer and a marker POSTING is used in `ledger-clear-whole-transactions' is nil."
to the beginning of the xact in that buffer"
(let ((buf (if (is-stdin (nth 0 emacs-xact)) (let ((buf (if (is-stdin (nth 0 emacs-xact))
ledger-buf ledger-buf
(find-file-noselect (nth 0 emacs-xact))))) (find-file-noselect (nth 0 emacs-xact)))))
@ -250,8 +263,7 @@
(nth 0 posting))))) ;; return line-no of posting (nth 0 posting))))) ;; return line-no of posting
(defun ledger-do-reconcile () (defun ledger-do-reconcile ()
"get the uncleared transactions in the account and display them "Get the uncleared transactions in the account and display them in the *Reconcile* buffer."
in the *Reconcile* buffer"
(let* ((buf ledger-buf) (let* ((buf ledger-buf)
(account ledger-acct) (account ledger-acct)
(xacts (xacts
@ -312,6 +324,7 @@
(add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t)))) (add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t))))
(defun ledger-reconcile-track-xact () (defun ledger-reconcile-track-xact ()
"Force the ledger buffer to recenter on the transactionat point in the reconcile buffer."
(if (member this-command (list 'next-line (if (member this-command (list 'next-line
'previous-line 'previous-line
'mouse-set-point 'mouse-set-point
@ -321,15 +334,14 @@
(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 reconcile buffer has its windows "Ensure that the ledger buffer BUF is split by RBUF."
Spliting the windows of BUF if needed"
(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 (account) (defun ledger-reconcile (account)
"Start reconciling ACCOUNT."
(interactive "sAccount to reconcile: ") (interactive "sAccount to reconcile: ")
(let ((buf (current-buffer)) (let ((buf (current-buffer))
(rbuf (get-buffer ledger-recon-buffer-name))) ;; this means (rbuf (get-buffer ledger-recon-buffer-name))) ;; this means
@ -370,15 +382,9 @@ Spliting the windows of BUF if needed"
(defvar ledger-reconcile-mode-abbrev-table) (defvar ledger-reconcile-mode-abbrev-table)
(defun ledger-reconcile-change-target () (defun ledger-reconcile-change-target ()
"Change the traget amount for the reconciliation process."
(interactive) (interactive)
(setq ledger-target (call-interactively #'ledger-read-commodity-string))) (setq ledger-target (call-interactively #'ledger-read-commodity-string)))
; (setq ledger-target
; (if (and target (> (length target) 0))
; (ledger-string-balance-to-commoditized-amount target))))
(defun ledger-reconcile-display-internals ()
(interactive)
(message "%S %S" ledger-acct ledger-buf))
(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."
@ -397,7 +403,6 @@ Spliting the windows of BUF if needed"
(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 [?i] 'ledger-reconcile-display-internals)
(define-key map [menu-bar] (make-sparse-keymap "ldg-recon-menu")) (define-key map [menu-bar] (make-sparse-keymap "ldg-recon-menu"))
(define-key map [menu-bar ldg-recon-menu] (cons "Reconcile" map)) (define-key map [menu-bar ldg-recon-menu] (cons "Reconcile" map))
@ -425,3 +430,6 @@ Spliting the windows of BUF if needed"
(add-hook 'kill-buffer-hook 'ledger-reconcile-quit-cleanup nil t))) (add-hook 'kill-buffer-hook 'ledger-reconcile-quit-cleanup nil t)))
(provide 'ldg-reconcile) (provide 'ldg-reconcile)
(provide 'ldg-reconcile)
;;; ldg-reconcile.el ends here

64
lisp/ldg-report.el
View file

@ -19,6 +19,12 @@
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA. ;; MA 02111-1307, USA.
;;; Commentary:
;;
;;; Code:
(eval-when-compile (eval-when-compile
(require 'cl)) (require 'cl))
@ -34,7 +40,7 @@ contain format specifiers that are replaced with context sensitive
information. Format specifiers have the format '%(<name>)' where information. Format specifiers have the format '%(<name>)' where
<name> is an identifier for the information to be replaced. The <name> is an identifier for the information to be replaced. The
`ledger-report-format-specifiers' alist variable contains a mapping `ledger-report-format-specifiers' alist variable contains a mapping
from format specifier identifier to a lisp function that implements from format specifier identifier to a Lisp function that implements
the substitution. See the documentation of the individual functions 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."
@ -46,7 +52,7 @@ specifier."
'(("ledger-file" . ledger-report-ledger-file-format-specifier) '(("ledger-file" . ledger-report-ledger-file-format-specifier)
("payee" . ledger-report-payee-format-specifier) ("payee" . ledger-report-payee-format-specifier)
("account" . ledger-report-account-format-specifier)) ("account" . ledger-report-account-format-specifier))
"Alist mapping ledger report format specifiers to implementing functions "An alist mapping ledger report format specifiers to implementing functions.
The function is called with no parameters and expected to return the The function is called with no parameters and expected to return the
text that should replace the format specifier." text that should replace the format specifier."
@ -121,13 +127,14 @@ The empty string and unknown names are allowed."
(defun ledger-report (report-name edit) (defun ledger-report (report-name edit)
"Run a user-specified report from `ledger-reports'. "Run a user-specified report from `ledger-reports'.
Prompts the user for the name of the report to run. If no name is Prompts the user for the REPORT-NAME of the report to run or
entered, the user will be prompted for a command line to run. The EDIT. If no name is entered, the user will be prompted for a
command line specified or associated with the selected report name command line to run. The command line specified or associated
is run and the output is made available in another buffer for viewing. with the selected report name is run and the output is made
If a prefix argument is given and the user selects a valid report available in another buffer for viewing. If a prefix argument is
name, the user is prompted with the corresponding command line for given and the user selects a valid report name, the user is
editing before the command is run. prompted with the corresponding command line for editing before
the command is run.
The output buffer will be in `ledger-report-mode', which defines The output buffer will be in `ledger-report-mode', which defines
commands for saving a new named report based on the command line commands for saving a new named report based on the command line
@ -159,11 +166,11 @@ used to generate the buffer, navigating the buffer, etc."
(message "q to quit; r to redo; e to edit; k to kill; s to save; SPC and DEL to scroll")))) (message "q to quit; r to redo; e to edit; k to kill; s to save; SPC and DEL to scroll"))))
(defun string-empty-p (s) (defun string-empty-p (s)
"Check for the empty string." "Check S for the empty string."
(string-equal "" s)) (string-equal "" s))
(defun ledger-report-name-exists (name) (defun ledger-report-name-exists (name)
"Check to see if the given report name exists. "Check to see if the given report NAME exists.
If name exists, returns the object naming the report, If name exists, returns the object naming the report,
otherwise returns nil." otherwise returns nil."
@ -171,7 +178,7 @@ used to generate the buffer, navigating the buffer, etc."
(car (assoc name ledger-reports)))) (car (assoc name ledger-reports))))
(defun ledger-reports-add (name cmd) (defun ledger-reports-add (name cmd)
"Add a new report to `ledger-reports'." "Add a new report NAME and CMD to `ledger-reports'."
(setq ledger-reports (cons (list name cmd) ledger-reports))) (setq ledger-reports (cons (list name cmd) ledger-reports)))
(defun ledger-reports-custom-save () (defun ledger-reports-custom-save ()
@ -179,15 +186,15 @@ used to generate the buffer, navigating the buffer, etc."
(customize-save-variable 'ledger-reports ledger-reports)) (customize-save-variable 'ledger-reports ledger-reports))
(defun ledger-report-read-command (report-cmd) (defun ledger-report-read-command (report-cmd)
"Read the command line to create a report." "Read the command line to create a report from REPORT-CMD."
(read-from-minibuffer "Report command line: " (read-from-minibuffer "Report command line: "
(if (null report-cmd) "ledger " report-cmd) (if (null report-cmd) "ledger " report-cmd)
nil nil 'ledger-report-cmd-prompt-history)) nil nil 'ledger-report-cmd-prompt-history))
(defun ledger-report-ledger-file-format-specifier () (defun ledger-report-ledger-file-format-specifier ()
"Substitute the full path to master or current ledger file "Substitute the full path to master or current ledger file.
The master file name is determined by the ledger-master-file The master file name is determined by the variable `ledger-master-file'
buffer-local variable which can be set using file variables. buffer-local variable which can be set using file variables.
If it is set, it is used, otherwise the current buffer file is If it is set, it is used, otherwise the current buffer file is
used." used."
@ -201,7 +208,7 @@ used to generate the buffer, navigating the buffer, etc."
"Return the master file for a ledger file. "Return the master file for a ledger file.
The master file is either the file for the current ledger buffer or the The master file is either the file for the current ledger buffer or the
file specified by the buffer-local variable ledger-master-file. Typically file specified by the buffer-local variable `ledger-master-file'. Typically
this variable would be set in a file local variable comment block at the this variable would be set in a file local variable comment block at the
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
@ -209,6 +216,7 @@ used to generate the buffer, navigating the buffer, etc."
(buffer-file-name))) (buffer-file-name)))
(defun ledger-read-string-with-default (prompt default) (defun ledger-read-string-with-default (prompt default)
"Return user supplied string after PROMPT, or DEFAULT."
(let ((default-prompt (concat prompt (let ((default-prompt (concat prompt
(if default (if default
(concat " (" default "): ") (concat " (" default "): ")
@ -216,7 +224,7 @@ used to generate the buffer, navigating the buffer, etc."
(read-string default-prompt nil nil default))) (read-string default-prompt nil nil default)))
(defun ledger-report-payee-format-specifier () (defun ledger-report-payee-format-specifier ()
"Substitute a payee name "Substitute a payee name.
The user is prompted to enter a payee and that is substitued. If The user is prompted to enter a payee and that is substitued. If
point is in an entry, the payee for that entry is used as the point is in an entry, the payee for that entry is used as the
@ -227,7 +235,7 @@ used to generate the buffer, navigating the buffer, etc."
(ledger-read-string-with-default "Payee" (regexp-quote (ledger-xact-payee)))) (ledger-read-string-with-default "Payee" (regexp-quote (ledger-xact-payee))))
(defun ledger-report-account-format-specifier () (defun ledger-report-account-format-specifier ()
"Substitute an account name "Substitute an account name.
The user is prompted to enter an account name, which can be any The user is prompted to enter an account name, which can be any
regular expression identifying an account. If point is on an account regular expression identifying an account. If point is on an account
@ -243,6 +251,7 @@ used to generate the buffer, navigating the buffer, etc."
(ledger-read-string-with-default "Account" default))) (ledger-read-string-with-default "Account" default)))
(defun ledger-report-expand-format-specifiers (report-cmd) (defun ledger-report-expand-format-specifiers (report-cmd)
"Expand %(account) and %(payee) appearing in REPORT-CMD with thing under point."
(save-match-data (save-match-data
(let ((expanded-cmd report-cmd)) (let ((expanded-cmd report-cmd))
(set-match-data (list 0 0)) (set-match-data (list 0 0))
@ -258,7 +267,8 @@ used to generate the buffer, navigating the buffer, etc."
expanded-cmd))) expanded-cmd)))
(defun ledger-report-cmd (report-name edit) (defun ledger-report-cmd (report-name edit)
"Get the command line to run the report." "Get the command line to run the report name REPORT-NAME.
Optional EDIT the command."
(let ((report-cmd (car (cdr (assoc report-name ledger-reports))))) (let ((report-cmd (car (cdr (assoc report-name ledger-reports)))))
;; logic for substitution goes here ;; logic for substitution goes here
(when (or (null report-cmd) edit) (when (or (null report-cmd) edit)
@ -274,7 +284,7 @@ used to generate the buffer, navigating the buffer, etc."
report-cmd)) report-cmd))
(defun ledger-do-report (cmd) (defun ledger-do-report (cmd)
"Run a report command line." "Run a report command line CMD."
(goto-char (point-min)) (goto-char (point-min))
(insert (format "Report: %s\n" ledger-report-name) (insert (format "Report: %s\n" ledger-report-name)
(format "Command: %s\n" cmd) (format "Command: %s\n" cmd)
@ -289,7 +299,8 @@ used to generate the buffer, navigating the buffer, etc."
(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) t nil) cmd)
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)
@ -310,6 +321,7 @@ used to generate the buffer, navigating the buffer, etc."
(defun ledger-report-visit-source () (defun ledger-report-visit-source ()
"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)))
@ -382,7 +394,7 @@ used to generate the buffer, navigating the buffer, etc."
(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
@ -424,9 +436,9 @@ used to generate the buffer, navigating the buffer, etc."
(indent account)))))) (indent account))))))
(defun ledger-extract-context-info (line-type pos) (defun ledger-extract-context-info (line-type pos)
"Get context info for current line. "Get context info for current line with LINE-TYPE.
Assumes point is at beginning of line, and the pos argument specifies Assumes point is at beginning of line, and the POS argument specifies
where the \"users\" point was." where the \"users\" point was."
(let ((linfo (assoc line-type ledger-line-config)) (let ((linfo (assoc line-type ledger-line-config))
found field fields) found field fields)
@ -495,7 +507,7 @@ the fields in the line in a association list."
'(unknown nil nil))))))) '(unknown nil nil)))))))
(defun ledger-context-other-line (offset) (defun ledger-context-other-line (offset)
"Return a list describing context of line offset for existing position. "Return a list describing context of line OFFSET from existing position.
Offset can be positive or negative. If run out of buffer before reaching Offset can be positive or negative. If run out of buffer before reaching
specified line, returns nil." specified line, returns nil."
@ -534,3 +546,5 @@ specified line, returns nil."
(goto-char (ledger-context-field-end-position context-info field-name))) (goto-char (ledger-context-field-end-position context-info field-name)))
(provide 'ldg-report) (provide 'ldg-report)
;;; ldg-report.el ends here

15
lisp/ldg-sort.el
View file

@ -19,10 +19,15 @@
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA. ;; MA 02111-1307, USA.
;; A sample entry sorting function, which works if entry dates are of
;; the form YYYY/mm/dd.
;;; Commentary:
;;
;;; Code:
(defun ledger-next-record-function () (defun ledger-next-record-function ()
"Move point to next transaction."
(if (re-search-forward (if (re-search-forward
(concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
"\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t) "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t)
@ -30,9 +35,11 @@
(goto-char (point-max)))) (goto-char (point-max))))
(defun ledger-end-record-function () (defun ledger-end-record-function ()
"Move point to end of transaction."
(forward-paragraph)) (forward-paragraph))
(defun ledger-sort-region (beg end) (defun ledger-sort-region (beg end)
"Sort the region from BEG to END in chronological order."
(interactive "r") ;; load beg and end from point and mark (interactive "r") ;; load beg and end from point and mark
;; automagically ;; automagically
(let ((new-beg beg) (let ((new-beg beg)
@ -57,8 +64,10 @@
'ledger-end-record-function)))))) 'ledger-end-record-function))))))
(defun ledger-sort-buffer () (defun ledger-sort-buffer ()
"Sort the entire buffer."
(interactive) (interactive)
(ledger-sort-region (point-min) (point-max))) (ledger-sort-region (point-min) (point-max)))
(provide 'ldg-sort) (provide 'ldg-sort)
;;; ldg-sort.el ends here

17
lisp/ldg-state.el
View file

@ -19,12 +19,19 @@
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA. ;; MA 02111-1307, USA.
;;; Commentary:
;; Utilities for dealing with transaction and posting status.
;;; Code:
(defcustom ledger-clear-whole-transactions nil (defcustom ledger-clear-whole-transactions nil
"If non-nil, clear whole transactions, not individual postings." "If non-nil, clear whole transactions, not individual postings."
:type 'boolean :type 'boolean
:group 'ledger) :group 'ledger)
(defun ledger-toggle-state (state &optional style) (defun ledger-toggle-state (state &optional style)
"Return the correct toggle state given the current STATE, and STYLE."
(if (not (null state)) (if (not (null state))
(if (and style (eq style 'cleared)) (if (and style (eq style 'cleared))
'cleared) 'cleared)
@ -33,6 +40,7 @@
'cleared))) 'cleared)))
(defun ledger-transaction-state () (defun ledger-transaction-state ()
"Return the state of the transaction at point."
(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))
@ -43,6 +51,7 @@
(t nil))))) (t nil)))))
(defun ledger-posting-state () (defun ledger-posting-state ()
"Return the state of the posting."
(save-excursion (save-excursion
(goto-char (line-beginning-position)) (goto-char (line-beginning-position))
(skip-syntax-forward " ") (skip-syntax-forward " ")
@ -51,6 +60,7 @@
(t (ledger-transaction-state))))) (t (ledger-transaction-state)))))
(defun ledger-char-from-state (state) (defun ledger-char-from-state (state)
"Return the char representation of STATE."
(if state (if state
(if (eq state 'pending) (if (eq state 'pending)
"!" "!"
@ -58,6 +68,7 @@
"")) ""))
(defun ledger-state-from-char (state-char) (defun ledger-state-from-char (state-char)
"Get state from STATE-CHAR."
(cond ((eql state-char ?\!) (cond ((eql state-char ?\!)
'pending) 'pending)
((eql state-char ?\*) ((eql state-char ?\*)
@ -189,6 +200,7 @@ dropped."
new-status)) new-status))
(defun ledger-toggle-current (&optional style) (defun ledger-toggle-current (&optional style)
"Toggle the current thing at point with optional STYLE."
(interactive) (interactive)
(if (or ledger-clear-whole-transactions (if (or ledger-clear-whole-transactions
(eq 'transaction (ledger-thing-at-point))) (eq 'transaction (ledger-thing-at-point)))
@ -207,6 +219,7 @@ dropped."
(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."
(interactive) (interactive)
(let (status) (let (status)
(save-excursion (save-excursion
@ -232,3 +245,7 @@ dropped."
status)) status))
(provide 'ldg-state) (provide 'ldg-state)
(provide 'ldg-state)
;;; ldg-state.el ends here

24
lisp/ldg-xact.el
View file

@ -19,19 +19,23 @@
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA. ;; MA 02111-1307, USA.
;; A sample entry sorting function, which works if entry dates are of
;; the form YYYY/mm/dd. ;;; Commentary:
;; Utilites for running ledger synchronously.
;;; Code:
(defcustom ledger-highlight-xact-under-point t (defcustom ledger-highlight-xact-under-point t
"If t highlight xact under point" "If t highlight xact under point."
:type 'boolean :type 'boolean
:group 'ledger) :group 'ledger)
(defvar highlight-overlay (list)) (defvar highlight-overlay (list))
(defun ledger-find-xact-extents (pos) (defun ledger-find-xact-extents (pos)
"return point for beginning of xact and and of xact containing "Return point for beginning of xact and and of xact containing position.
position. Requires empty line separating xacts" Requires empty line separating xacts. Argument POS is a location
within the transaction."
(interactive "d") (interactive "d")
(save-excursion (save-excursion
(goto-char pos) (goto-char pos)
@ -49,6 +53,7 @@
(defun ledger-highlight-xact-under-point () (defun ledger-highlight-xact-under-point ()
"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 highlight-overlay)) (ovl highlight-overlay))
@ -63,7 +68,7 @@
(overlay-put ovl 'priority 100)))) (overlay-put ovl 'priority 100))))
(defun ledger-xact-payee () (defun ledger-xact-payee ()
"Returns the payee of the entry containing point or nil." "Return the payee of the entry containing point or nil."
(let ((i 0)) (let ((i 0))
(while (eq (ledger-context-line-type (ledger-context-other-line i)) 'acct-transaction) (while (eq (ledger-context-line-type (ledger-context-other-line i)) 'acct-transaction)
(setq i (- i 1))) (setq i (- i 1)))
@ -73,9 +78,11 @@
nil)))) nil))))
(defsubst ledger-goto-line (line-number) (defsubst ledger-goto-line (line-number)
"Rapidly move point to line LINE-NUMBER."
(goto-char (point-min)) (forward-line (1- line-number))) (goto-char (point-min)) (forward-line (1- line-number)))
(defun ledger-thing-at-point () (defun ledger-thing-at-point ()
"Describe thing at points. Return 'transaction, 'posting, or nil."
(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-+")
@ -91,7 +98,7 @@
(ignore (goto-char here)))))) (ignore (goto-char here))))))
(defun ledger-copy-transaction-at-point (date) (defun ledger-copy-transaction-at-point (date)
(interactive (list "Ask for a new DATE and copy the transaction under point to that date. Leave point on the first amount."(interactive (list
(read-string "Copy to date: " (read-string "Copy to date: "
(concat ledger-year "/" ledger-month "/")))) (concat ledger-year "/" ledger-month "/"))))
(let* ((here (point)) (let* ((here (point))
@ -113,3 +120,6 @@
(provide 'ldg-xact) (provide 'ldg-xact)
(provide 'ldg-xact)
;;; ldg-xact.el ends here