diff options
author | Craig Earls <enderw88@gmail.com> | 2013-02-14 15:37:13 -0700 |
---|---|---|
committer | Craig Earls <enderw88@gmail.com> | 2013-02-14 15:37:13 -0700 |
commit | d8f0b0fa83c6c6984f79dbb918e324a847cdb094 (patch) | |
tree | 8ad1c2ce408f08276775f252f432a054963b5333 /lisp | |
parent | 6eb97a7c38ba236f7cf38f694e2f579b6406bae5 (diff) | |
download | fork-ledger-d8f0b0fa83c6c6984f79dbb918e324a847cdb094.tar.gz fork-ledger-d8f0b0fa83c6c6984f79dbb918e324a847cdb094.tar.bz2 fork-ledger-d8f0b0fa83c6c6984f79dbb918e324a847cdb094.zip |
Code commenting cleanup.
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/ldg-commodities.el | 20 | ||||
-rw-r--r-- | lisp/ldg-complete.el | 26 | ||||
-rw-r--r-- | lisp/ldg-exec.el | 18 | ||||
-rw-r--r-- | lisp/ldg-fonts.el | 39 | ||||
-rw-r--r-- | lisp/ldg-mode.el | 36 | ||||
-rw-r--r-- | lisp/ldg-new.el | 13 | ||||
-rw-r--r-- | lisp/ldg-occur.el | 45 | ||||
-rw-r--r-- | lisp/ldg-post.el | 32 | ||||
-rw-r--r-- | lisp/ldg-reconcile.el | 110 | ||||
-rw-r--r-- | lisp/ldg-report.el | 68 | ||||
-rw-r--r-- | lisp/ldg-sort.el | 15 | ||||
-rw-r--r-- | lisp/ldg-state.el | 25 | ||||
-rw-r--r-- | lisp/ldg-xact.el | 36 |
13 files changed, 309 insertions, 174 deletions
diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index 94d2ddf0..c007816d 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -33,11 +33,12 @@ ;;; Code: (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 :group 'ledger) (defun ledger-string-balance-to-commoditized-amount (str) + "Return a commoditized amount (val, 'comm') from STR." (let ((fields (split-string str "[\n\r]"))) ; break any balances ; with multi commodities ; into a list @@ -48,29 +49,36 @@ ;"^-*[1-9][0-9]*[.,][0-9]*" (if (string-match "^-*[1-9]+" first) (list (string-to-number first) second) - (list (string-to-number second) first)))) + (list (string-to-number second) first)))) fields))) (defun -commodity (c1 c2) - (if (string= (cadr c1) (cadr c2)) + "Subtract C2 from C1, ensuring their commodities match." + (if (string= (cadr c1) (cadr c2)) (list (- (car c1) (car c2)) (cadr c1)) (error "Can't subtract different commodities %S from %S" c2 c1))) (defun +commodity (c1 c2) + "Add C1 and C2, ensuring their commodities match." (if (string= (cadr c1) (cadr c2)) (list (+ (car c1) (car c2)) (cadr c1)) (error "Can't add different commodities, %S to %S" c1 c2))) (defun ledger-commodity-to-string (c1) - (let ((val (number-to-string (car 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))) (commodity (cadr c1))) (if (> (length commodity) 1) (concat val " " commodity) (concat commodity " " val)))) (defun ledger-read-commodity-string (comm) - (interactive (list (read-from-minibuffer + "Return a commoditizd value (val 'comm') from COMM. +Assumes a space between the value and the commodity." + (interactive (list (read-from-minibuffer (concat "Enter commoditized amount (" ledger-reconcile-default-commodity "): ")))) (let ((parts (split-string comm))) (if parts @@ -86,7 +94,7 @@ ((and (/= 0 valp2) (= valp1 0)) (list valp2 (car parts))) (t - (error "cannot understand commodity")))))))) + (error "Cannot understand commodity")))))))) (provide 'ldg-commodities) diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index a0508a98..82046e07 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -21,10 +21,16 @@ ;;(require 'esh-util) ;;(require 'esh-arg) + +;;; Commentary: +;; Functions providing payee and account auto complete. + (require 'pcomplete) ;; In-place completion support +;;; Code: + (defun ledger-parse-arguments () "Parse whitespace separated arguments in the current region." (let* ((info (save-excursion @@ -43,6 +49,7 @@ (cons (reverse args) (reverse begins))))) (defun ledger-payees-in-buffer () + "Scan buffer and return list of all payees." (let ((origin (point)) payees-list) (save-excursion @@ -58,9 +65,9 @@ (pcomplete-uniqify-list (nreverse payees-list)))) (defun ledger-find-accounts-in-buffer () - "search through buffer and build tree of accounts. Return tree - structure" - (let ((origin (point)) + "Search through buffer and build tree of accounts. +Return tree structure" + (let ((origin (point)) (account-tree (list t)) (account-elements nil)) (save-excursion @@ -69,8 +76,8 @@ "^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)" nil t) (unless (and (>= origin (match-beginning 0)) (< origin (match-end 0))) - (setq account-elements - (split-string + (setq account-elements + (split-string (match-string-no-properties 2) ":")) (let ((root account-tree)) (while account-elements @@ -84,6 +91,7 @@ account-tree)) (defun ledger-accounts () + "Return a tree of all accounts in the buffer." (let* ((current (caar (ledger-parse-arguments))) (elements (and current (split-string current ":"))) (root (ledger-find-accounts-in-buffer)) @@ -110,7 +118,7 @@ 'string-lessp)))) (defun ledger-complete-at-point () - "Do appropriate completion for the thing at point" + "Do appropriate completion for the thing at point." (interactive) (while (pcomplete-here (if (eq (save-excursion @@ -134,8 +142,8 @@ (ledger-accounts))))) (defun ledger-fully-complete-entry () - "Completes a transaction if there is another matching payee in - the buffer. Does not use ledger xact" + "Completes a transaction if there is another matching payee in the buffer. +Does not use ledger xact" (interactive) (let ((name (caar (ledger-parse-arguments))) xacts) @@ -164,3 +172,5 @@ (goto-char (match-end 0)))))) (provide 'ldg-complete) + +;;; ldg-complete.el ends here diff --git a/lisp/ldg-exec.el b/lisp/ldg-exec.el index e9cefd20..af5dd3a8 100644 --- a/lisp/ldg-exec.el +++ b/lisp/ldg-exec.el @@ -19,11 +19,17 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; MA 02111-1307, USA. + +;;; Commentary: +;; Code for executing ledger synchronously. + +;;; Code: + (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 - "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 "Interface to the Ledger command-line accounting program." @@ -35,7 +41,7 @@ :group 'ledger) (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) (error "The variable `ledger-binary-path' has not been set")) (let ((buf (or input-buffer (current-buffer))) @@ -51,6 +57,7 @@ outbuf))) (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 (apply #'ledger-exec-ledger input-buffer nil "emacs" args) (goto-char (point-min)) @@ -59,7 +66,7 @@ (kill-buffer (current-buffer))))) (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) (version-strings '()) (version-number)) @@ -77,6 +84,7 @@ nil)))) (defun ledger-check-version () + "Verify that ledger works and is modern enough." (interactive) (setq ledger-works (ledger-version-greater-p ledger-version-needed)) (if ledger-works @@ -84,3 +92,5 @@ (message "Bad Ledger Version"))) (provide 'ldg-exec) + +;;; ldg-exec.el ends here diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el index cf40c59d..d760140c 100644 --- a/lisp/ldg-fonts.el +++ b/lisp/ldg-fonts.el @@ -20,48 +20,54 @@ ;; 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) -(defface ledger-font-uncleared-face +(defface ledger-font-uncleared-face `((t :foreground "#dc322f" :weight bold )) "Default face for Ledger" :group 'ledger-faces) -(defface ledger-font-cleared-face +(defface ledger-font-cleared-face `((t :foreground "#657b83" :weight normal )) "Default face for cleared (*) transactions" :group 'ledger-faces) -(defface ledger-font-highlight-face +(defface ledger-font-highlight-face `((t :background "white")) "Default face for transaction under point" :group 'ledger-faces) -(defface ledger-font-pending-face +(defface ledger-font-pending-face `((t :foreground "#cb4b16" :weight normal )) "Default face for pending (!) transactions" :group 'ledger-faces) -(defface ledger-font-other-face +(defface ledger-font-other-face `((t :foreground "yellow" )) "Default face for other transactions" :group 'ledger-faces) -(defface ledger-font-posting-account-face +(defface ledger-font-posting-account-face `((t :foreground "#268bd2" )) "Face for Ledger accounts" :group 'ledger-faces) -(defface ledger-font-posting-amount-face +(defface ledger-font-posting-amount-face `((t :foreground "yellow" )) "Face for Ledger amounts" :group 'ledger-faces) -(defface ledger-occur-folded-face +(defface ledger-occur-folded-face `((t :foreground "grey70" :invisible t )) "Default face for Ledger occur mode hidden transactions" :group 'ledger-faces) -(defface ledger-occur-xact-face +(defface ledger-occur-xact-face `((t :background "#eee8d5" )) "Default face for Ledger occur mode shown transactions" :group 'ledger-faces) @@ -71,22 +77,22 @@ "Face for Ledger comments" :group 'ledger-faces) -(defface ledger-font-reconciler-uncleared-face +(defface ledger-font-reconciler-uncleared-face `((t :foreground "#dc322f" :weight bold )) "Default face for uncleared transactions in the reconcile window" :group 'ledger-faces) -(defface ledger-font-reconciler-cleared-face +(defface ledger-font-reconciler-cleared-face `((t :foreground "#657b83" :weight normal )) "Default face for cleared (*) transactions in the reconcile window" :group 'ledger-faces) -(defface ledger-font-reconciler-pending-face +(defface ledger-font-reconciler-pending-face `((t :foreground "#cb4b16" :weight normal )) "Default face for pending (!) transactions in the reconcile window" :group 'ledger-faces) -(defface ledger-font-report-clickable-face +(defface ledger-font-report-clickable-face `((t :foreground "#cb4b16" :weight normal )) "Default face for pending (!) transactions in the reconcile window" :group 'ledger-faces) @@ -95,7 +101,7 @@ (defvar ledger-font-lock-keywords '(("^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)" 2 'ledger-font-pending-face) ("^[0-9]+[-/.=][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)" 2 'ledger-font-cleared-face) - ("^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)" 2 'ledger-font-uncleared-face) + ("^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)" 2 'ledger-font-uncleared-face) ("^\\s-+\\([*]\\s-*\\)?\\(\\([[(]\\)?[^*: ]+?:\\([^]); ]\\|\\s-\\)+?\\([])]\\)?\\)\\( \\| \\|$\\)" @@ -105,4 +111,7 @@ ("^\\([A-Za-z]+ .+\\)" 1 ledger-font-other-face)) "Expressions to highlight in Ledger mode.") -(provide 'ldg-fonts)
\ No newline at end of file + +(provide 'ldg-fonts) + +;;; ldg-fonts.el ends here diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index fc018853..6cab7c9b 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -20,18 +20,24 @@ ;; MA 02111-1307, USA. + +;;; Commentary: +;; Most of the general ledger-mode code is here. + +;;; Code: + (defsubst ledger-current-year () + "The default current year for adding transactions." (format-time-string "%Y")) (defsubst ledger-current-month () + "The default current month for adding transactions." (format-time-string "%m")) (defvar ledger-year (ledger-current-year) - "Start a ledger session with the current year, but make it -customizable to ease retro-entry.") + "Start a ledger session with the current year, but make it customizable to ease retro-entry.") (defvar ledger-month (ledger-current-month) - "Start a ledger session with the current month, but make it -customizable to ease retro-entry.") + "Start a ledger session with the current month, but make it customizable to ease retro-entry.") (defcustom ledger-default-acct-transaction-indent " " "Default indentation for account transactions in an entry." @@ -39,7 +45,8 @@ customizable to ease retro-entry.") :group 'ledger) (defun ledger-remove-overlays () - (interactive) + "Remove all overlays from the ledger buffer." +(interactive) "remove overlays formthe buffer, used if the buffer is reverted" (remove-overlays)) @@ -135,13 +142,15 @@ customizable to ease retro-entry.") (< (nth 1 t1) (nth 1 t2))))) (defun ledger-time-subtract (t1 t2) - "Subtract two time values. Return the difference in the format - of a time value." + "Subtract two time values, T1 - T2. +Return the difference in the format of a time value." (let ((borrow (< (cadr t1) (cadr t2)))) (list (- (car t1) (car t2) (if borrow 1 0)) (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) (defun ledger-find-slot (moment) + "Find the right place in the buffer for a transaction at MOMENT. +MOMENT is an encoded date" (catch 'found (ledger-iterate-transactions (function @@ -150,6 +159,7 @@ customizable to ease retro-entry.") (throw 'found t))))))) (defun ledger-iterate-transactions (callback) + "Iterate through each transaction call CALLBACK for each." (goto-char (point-min)) (let* ((now (current-time)) (current-year (nth 5 (decode-time now)))) @@ -177,20 +187,24 @@ customizable to ease retro-entry.") (forward-line)))) (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") (if (= newyear 1) (setq ledger-year (read-string "Year: " (ledger-current-year))) (setq ledger-year (number-to-string newyear)))) (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") (if (= newmonth 1) (setq ledger-month (read-string "Month: " (ledger-current-month))) (setq ledger-month (format "%02d" newmonth)))) (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 (read-string "Transaction: " (concat ledger-year "/" ledger-month "/")))) (let* ((args (with-temp-buffer @@ -223,6 +237,7 @@ customizable to ease retro-entry.") (end-of-line -1))))) (defun ledger-current-transaction-bounds () + "Return markers for the beginning and end of transaction surrounding point." (save-excursion (when (or (looking-at "^[0-9]") (re-search-backward "^[0-9]" nil t)) @@ -232,8 +247,11 @@ customizable to ease retro-entry.") (cons (copy-marker beg) (point-marker)))))) (defun ledger-delete-current-transaction () + "Delete the transaction surrounging point." (interactive) (let ((bounds (ledger-current-transaction-bounds))) (delete-region (car bounds) (cdr bounds)))) (provide 'ldg-mode) + +;;; ldg-mode.el ends here diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index 3c56c108..ab267747 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -31,7 +31,7 @@ ;; MA 02111-1307, USA. ;;; Commentary: - +;; Load up the ledger mode (require 'ldg-complete) (require 'ldg-exec) (require 'ldg-mode) @@ -49,6 +49,8 @@ (require 'ldg-commodities) +;;; Code: + (autoload #'ledger-texi-update-test "ldg-texi" nil t) (autoload #'ledger-texi-update-examples "ldg-texi" nil t) @@ -57,13 +59,12 @@ :group 'data) (defconst ledger-version "3.0" - "The version of ledger.el currently loaded") - -(provide 'ledger) + "The version of ledger.el currently loaded.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ledger-create-test () + "Create a regression test." (interactive) (save-restriction (org-narrow-to-subtree) @@ -87,4 +88,6 @@ (delete-char 3) (forward-line 1)))))) -;;; ledger.el ends here +(provide 'ledger) + +;;; ldg-new.el ends here diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index d53be09b..417a3d2a 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -25,7 +25,7 @@ ;;; Commentary: ;; Provide code folding to ledger mode. Adapted from original loccur ;; mode by Alexey Veretennikov <alexey dot veretennikov at gmail dot -;; com> +;; com> ;; ;; Adapted to ledger mode by Craig Earls <enderww at gmail dot ;; com> @@ -34,8 +34,8 @@ (defconst ledger-occur-overlay-property-name 'ledger-occur-custom-buffer-grep) -(defcustom ledger-occur-use-face-unfolded t - "if non-nil use a custom face for xacts shown in ledger-occur mode" +(defcustom ledger-occur-use-face-unfolded t + "If non-nil use a custom face for xacts shown in `ledger-occur' mode." :type 'boolean :group 'ledger) (make-variable-buffer-local 'ledger-occur-use-face-unfolded) @@ -49,11 +49,11 @@ (list '(ledger-occur-mode ledger-occur-mode)))) (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) (defvar ledger-occur-last-match nil - "Last match found") + "Last match found.") (make-variable-buffer-local 'ledger-occur-last-match) (defvar ledger-occur-overlay-list nil @@ -61,12 +61,12 @@ (make-variable-buffer-local 'ledger-occur-overlay-list) (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" (progn (set-buffer buffer) - (setq ledger-occur-mode + (setq ledger-occur-mode (if (or (null regex) (zerop (length regex))) nil @@ -76,7 +76,7 @@ When REGEX is nil, unhide everything, and remove higlight" (if ledger-occur-mode (let* ((buffer-matches (ledger-occur-find-matches regex)) (ovl-bounds (ledger-occur-create-xact-overlay-bounds buffer-matches))) - (setq ledger-occur-overlay-list + (setq ledger-occur-overlay-list (ledger-occur-create-xact-overlays ovl-bounds)) (setq ledger-occur-overlay-list (append ledger-occur-overlay-list @@ -86,13 +86,12 @@ When REGEX is nil, unhide everything, and remove higlight" (recenter))) (defun ledger-occur (regex) - "Perform a simple grep in current buffer for the regular - expression REGEX + "Perform a simple grep in current buffer for the regular expression REGEX. 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 of the function unhides lines again" - (interactive + (interactive (if ledger-occur-mode (list nil) (list (read-string (concat "Regexp<" (ledger-occur-prompt) @@ -101,7 +100,7 @@ When REGEX is nil, unhide everything, and remove higlight" (ledger-occur-mode regex (current-buffer))) (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 region(selection), if its size is 1 line" @@ -129,7 +128,7 @@ When REGEX is nil, unhide everything, and remove higlight" ;; the last form in ;; the lambda is the ;; (make-overlay) - (setq prev-end (1+ (cadr match))) + (setq prev-end (1+ (cadr match))) ;; add 1 so that we skip the ;; empty line after the xact (make-overlay @@ -147,7 +146,9 @@ When REGEX is nil, unhide everything, and remove higlight" (defun ledger-occur-create-xact-overlays (ovl-bounds) - (let ((overlays + "Create the overlay for the visible transactions. +Argument OVL-BOUNDS contains bounds for the transactions to be left visible." + (let ((overlays (mapcar (lambda (bnd) (make-overlay (car bnd) @@ -161,8 +162,7 @@ When REGEX is nil, unhide everything, and remove higlight" overlays))) (defun ledger-occur-change-regex (regex buffer) - "use this function to programatically change the overlays, - rather than quitting out and restarting" + "Use this function to programatically change the overlays using REGEX in BUFFER, rather than quitting out and restarting." (progn (set-buffer buffer) (setq ledger-occur-mode nil) @@ -171,8 +171,8 @@ When REGEX is nil, unhide everything, and remove higlight" (recenter))) (defun ledger-occur-quit-buffer (buffer) - "quits hidings transaction in the given buffer. Used for - coordinating ledger-occur with other buffers, like reconcile" + "Quits hidings transaction in the given BUFFER. +Used for coordinating `ledger-occur' with other buffers, like reconcile." (progn (set-buffer buffer) (setq ledger-occur-mode nil) @@ -181,13 +181,15 @@ When REGEX is nil, unhide everything, and remove higlight" (recenter))) (defun ledger-occur-remove-overlays () + "Remove the transaction hiding overlays." (interactive) - (remove-overlays (point-min) + (remove-overlays (point-min) (point-max) ledger-occur-overlay-property-name t) (setq ledger-occur-overlay-list nil)) (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)) (overlays (list))) (when buffer-matches @@ -199,8 +201,7 @@ When REGEX is nil, unhide everything, and remove higlight" (defun ledger-occur-find-matches (regex) - "Returns a list of 2-number tuples, specifying begnning of the - line and end of a line containing matching xact" + "Return a list of 2-number tuples describing the beginning and start of transactions meeting REGEX." (save-excursion (goto-char (point-min)) ;; Set initial values for variables diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 8b0e3db6..bdbb4386 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -19,8 +19,14 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; MA 02111-1307, USA. + +;;; Commentary: +;; Utility functions for dealing with postings. + (require 'ldg-regex) +;;; Code: + (defgroup ledger-post nil "" :group 'ledger) @@ -46,12 +52,13 @@ :group 'ledger-post) (defcustom ledger-post-use-decimal-comma nil - "if non-nil the use commas as decimal separator. This only has - effect interfacing to calc mode in edit amount" + "If non-nil the use commas as decimal separator. +This only has effect interfacing to calc mode in edit amount" :type 'boolean :group 'ledger-post) (defun ledger-post-all-accounts () + "Return a list of all accounts in the buffer." (let ((origin (point)) (ledger-post-list nil) account elements) @@ -68,8 +75,8 @@ (defvar iswitchb-temp-buflist) (defun ledger-post-completing-read (prompt choices) - "Use iswitchb as a completing-read replacement to choose from choices. - PROMPT is a string to prompt with. CHOICES is a list of + "Use iswitchb as a `completing-read' replacement to choose from choices. +PROMPT is a string to prompt with. CHOICES is a list of strings to choose from." (cond (ledger-post-use-iswitchb @@ -86,6 +93,7 @@ (defvar ledger-post-current-list nil) (defun ledger-post-pick-account () + "Insert an account entered by the user." (interactive) (let* ((account (ledger-post-completing-read @@ -111,6 +119,7 @@ (goto-char pos))) (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) (goto-char (match-beginning 0)) (skip-syntax-forward " ") @@ -119,7 +128,7 @@ (defun ledger-align-amounts (&optional column) "Align amounts in the current region. - This is done so that the last digit falls in COLUMN, which +This is done so that the last digit falls in COLUMN, which defaults to 52." (interactive "p") (if (or (null column) (= column 1)) @@ -146,6 +155,7 @@ (forward-line)))))) (defun ledger-post-align-amount () + "Align the amounts in this posting." (interactive) (save-excursion (set-mark (line-beginning-position)) @@ -153,6 +163,8 @@ (ledger-align-amounts))) (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 (goto-char beg) (when (< end (line-end-position)) @@ -161,11 +173,12 @@ (ledger-post-align-amount))))) (defun ledger-post-edit-amount () + "Call 'calc-mode' and push the amount in the posting to the top of stack." (interactive) (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) (goto-char (match-end ledger-regex-post-line-group-account)) ;; go to the and of the account - (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 (if end-of-amount (let ((val (match-string 0))) @@ -189,6 +202,7 @@ (calc)))))) (defun ledger-post-prev-xact () + "Move point to the previous transaction." (interactive) (backward-paragraph) (when (re-search-backward ledger-xact-line-regexp nil t) @@ -197,6 +211,7 @@ (goto-char (match-end ledger-regex-post-line-group-account)))) (defun ledger-post-next-xact () + "Move point to the next transaction." (interactive) (when (re-search-forward ledger-xact-line-regexp nil t) (goto-char (match-beginning 0)) @@ -204,8 +219,11 @@ (goto-char (match-end ledger-regex-post-line-group-account)))) (defun ledger-post-setup () + "Configure `ledger-mode' to auto-align postings." (if ledger-post-auto-adjust-amounts (add-hook 'after-change-functions 'ledger-post-maybe-align t t)) (add-hook 'after-save-hook #'(lambda () (setq ledger-post-current-list nil)))) (provide 'ldg-post) + +;;; ldg-post.el ends here diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 96a10afb..b632a070 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -21,60 +21,64 @@ ;; Reconcile mode + +;;; Commentary: +;; + +;;; Code: + (defvar ledger-buf nil) (defvar ledger-bufs nil) (defvar ledger-acct nil) (defvar ledger-target nil) (defcustom ledger-recon-buffer-name "*Reconcile*" - "Name to use for reconciliation window" + "Name to use for reconciliation window." :group 'ledger) -(defcustom ledger-fold-on-reconcile t - "if t, limit transactions shown in main buffer to those - matching the reconcile regex" +(defcustom ledger-fold-on-reconcile t + "If t, limit transactions shown in main buffer to those matching the reconcile regex." :type 'boolean :group 'ledger) (defcustom ledger-buffer-tracks-reconcile-buffer t - "if t, then when the cursor is moved to a new xact in the recon - window, then that transaction will be shown in its source - buffer." + "If t, then when the cursor is moved to a new xact in the recon window. +Then that transaction will be shown in its source buffer." :type 'boolean :group 'ledger) (defcustom ledger-reconcile-force-window-bottom nil - "If t make the reconcile window appear along the bottom of the - register window and resize" + "If t make the reconcile window appear along the bottom of the register window and resize." :type 'boolean :group 'ledger) (defcustom ledger-reconcile-toggle-to-pending t - "if true then toggle between uncleared and pending. - reconcile-finish will mark all pending posting cleared. " + "If true then toggle between uncleared and pending. +reconcile-finish will mark all pending posting cleared." :type 'boolean :group 'ledger) (defun ledger-reconcile-get-balances () - "Calculate the cleared and uncleared balance of the account being reconciled, - return a list with the account, uncleared and cleared balances as numbers" + "Calculate the cleared and uncleared balance of the account. +Return a list with the account, uncleared and cleared balances as +numbers" (interactive) (let ((buffer ledger-buf) (account ledger-acct) (val nil)) (with-temp-buffer - (ledger-exec-ledger buffer (current-buffer) + (ledger-exec-ledger buffer (current-buffer) ; note that in the line below, the --format option is ; separated from the actual format string. emacs does not ; split arguments like the shell does, so you need to ; specify the individual fields in the command line. - "balance" "--limit" "cleared or pending" + "balance" "--limit" "cleared or pending" "--format" "(\"%(amount)\")" account) (setq val (read (buffer-substring-no-properties (point-min) (point-max))))))) (defun ledger-display-balance () - "Calculate the cleared balance of the account being reconciled" + "Calculate the cleared balance of the account being reconciled." (interactive) (let* ((pending (car (ledger-string-balance-to-commoditized-amount (car (ledger-reconcile-get-balances))))) @@ -83,28 +87,30 @@ nil))) (if target-delta - (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 target-delta)) - (message "Pending balance: %s" + (message "Pending balance: %s" (ledger-commodity-to-string pending))))) (defun is-stdin (file) - "True if ledger file is standard input" + "True if ledger FILE is standard input." (or (equal file "") (equal file "<stdin>") (equal file "/dev/stdin"))) (defun ledger-reconcile-get-buffer (where) + "Return a buffer from WHERE the transaction is." (if (bufferp (car where)) (car where) - (error "buffer not set"))) + (error "Buffer not set"))) (defun ledger-reconcile-toggle () + "Toggle the current transaction, and mark the recon window." (interactive) (let ((where (get-text-property (point) 'where)) (inhibit-read-only t) @@ -113,7 +119,7 @@ (with-current-buffer (ledger-reconcile-get-buffer where) (ledger-goto-line (cdr where)) (forward-char) - (setq status (ledger-toggle-current (if ledger-reconcile-toggle-to-pending + (setq status (ledger-toggle-current (if ledger-reconcile-toggle-to-pending 'pending 'cleared)))) ;; remove the existing face and add the new face @@ -128,7 +134,7 @@ (add-text-properties (line-beginning-position) (line-end-position) (list 'face 'ledger-font-reconciler-cleared-face ))) - (t + (t (add-text-properties (line-beginning-position) (line-end-position) (list 'face 'ledger-font-reconciler-uncleared-face ))))) @@ -137,6 +143,7 @@ (ledger-display-balance))) (defun ledger-reconcile-refresh () + "Force the reconciliation window to refresh." (interactive) (let ((inhibit-read-only t) (line (count-lines (point-min) (point)))) @@ -147,6 +154,7 @@ (forward-line line))) (defun ledger-reconcile-refresh-after-save () + "Refresh the recon-window after the ledger buffer is saved." (let ((buf (get-buffer ledger-recon-buffer-name))) (if buf (with-current-buffer buf @@ -154,12 +162,14 @@ (set-buffer-modified-p nil))))) (defun ledger-reconcile-add () + "Use ledger xact to add a new transaction." (interactive) (with-current-buffer ledger-buf (call-interactively #'ledger-add-transaction)) (ledger-reconcile-refresh)) (defun ledger-reconcile-delete () + "Delete the transactions pointed to in the recon window." (interactive) (let ((where (get-text-property (point) 'where))) (when (ledger-reconcile-get-buffer where) @@ -172,11 +182,12 @@ (set-buffer-modified-p t))))) (defun ledger-reconcile-visit (&optional come-back) + "Recenter ledger buffer on transaction and COME-BACK if non-nil." (interactive) (progn (beginning-of-line) (let* ((where (get-text-property (1+ (point)) 'where)) - (target-buffer (if where + (target-buffer (if where (ledger-reconcile-get-buffer where) nil)) (cur-buf (get-buffer ledger-recon-buffer-name))) @@ -190,6 +201,7 @@ (switch-to-buffer-other-window cur-buf)))))) (defun ledger-reconcile-save () + "Save the ledger buffer." (interactive) (dolist (buf (cons ledger-buf ledger-bufs)) (with-current-buffer buf @@ -198,9 +210,9 @@ (ledger-display-balance)) (defun ledger-reconcile-finish () - "Mark all pending posting or transactions as cleared, depending - on ledger-reconcile-clear-whole-transactions, save the buffers - and exit reconcile mode" + "Mark all pending posting or transactions as cleared. +Depends on ledger-reconcile-clear-whole-transactions, save the buffers +and exit reconcile mode" (interactive) (save-excursion (goto-char (point-min)) @@ -216,6 +228,7 @@ (defun ledger-reconcile-quit () + "Quite the reconcile window without saving ledger buffer." (interactive) (ledger-reconcile-quit-cleanup) (let ((buf ledger-buf) @@ -228,18 +241,18 @@ (set-window-buffer (selected-window) buf))) (defun ledger-reconcile-quit-cleanup () + "Cleanup all hooks established by reconcile mode." (interactive) (let ((buf ledger-buf) (reconcile-buf (get-buffer ledger-recon-buffer-name))) (with-current-buffer buf (remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t) (if ledger-fold-on-reconcile - (ledger-occur-quit-buffer buf))))) + (ledger-occur-quit-buffer buf))))) (defun ledger-marker-where-xact-is (emacs-xact posting) - "find the position of the xact in the ledger-buf buffer using - the emacs output from ledger, return the buffer and a marker - to the beginning of the xact in that buffer" + "Find the position of the EMACS-XACT in the `ledger-buf'. +POSTING is used in `ledger-clear-whole-transactions' is nil." (let ((buf (if (is-stdin (nth 0 emacs-xact)) ledger-buf (find-file-noselect (nth 0 emacs-xact))))) @@ -250,13 +263,12 @@ (nth 0 posting))))) ;; return line-no of posting (defun ledger-do-reconcile () - "get the uncleared transactions in the account and display them - in the *Reconcile* buffer" + "Get the uncleared transactions in the account and display them in the *Reconcile* buffer." (let* ((buf ledger-buf) (account ledger-acct) (xacts - (with-temp-buffer - (ledger-exec-ledger buf (current-buffer) + (with-temp-buffer + (ledger-exec-ledger buf (current-buffer) "--uncleared" "--real" "emacs" account) (goto-char (point-min)) (unless (eobp) @@ -267,7 +279,7 @@ (progn (dolist (xact xacts) (dolist (posting (nthcdr 5 xact)) - (let ((beg (point)) + (let ((beg (point)) (where (ledger-marker-where-xact-is xact posting))) (insert (format "%s %-4s %-30s %-30s %15s\n" (format-time-string "%Y/%m/%d" (nth 2 xact)) @@ -278,13 +290,13 @@ (if (nth 3 posting) (if (eq (nth 3 posting) 'pending) (set-text-properties beg (1- (point)) - (list 'face 'ledger-font-reconciler-pending-face + (list 'face 'ledger-font-reconciler-pending-face 'where where)) (set-text-properties beg (1- (point)) - (list 'face 'ledger-font-reconciler-cleared-face + (list 'face 'ledger-font-reconciler-cleared-face 'where where))) (set-text-properties beg (1- (point)) - (list 'face 'ledger-font-reconciler-uncleared-face + (list 'face 'ledger-font-reconciler-uncleared-face 'where where)))) )) (goto-char (point-max)) (delete-char -1)) ;gets rid of the extra line feed at the bottom of the list @@ -312,6 +324,7 @@ (add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t)))) (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 'previous-line 'mouse-set-point @@ -321,15 +334,14 @@ (ledger-reconcile-visit t))))) (defun ledger-reconcile-open-windows (buf rbuf) - "Ensure that the reconcile buffer has its windows - -Spliting the windows of BUF if needed" + "Ensure that the ledger buffer BUF is split by RBUF." (if ledger-reconcile-force-window-bottom ;;create the *Reconcile* window directly below the ledger buffer. (set-window-buffer (split-window (get-buffer-window buf) nil nil) rbuf) (pop-to-buffer rbuf))) (defun ledger-reconcile (account) + "Start reconciling ACCOUNT." (interactive "sAccount to reconcile: ") (let ((buf (current-buffer)) (rbuf (get-buffer ledger-recon-buffer-name))) ;; this means @@ -339,7 +351,7 @@ Spliting the windows of BUF if needed" (if rbuf ;; *Reconcile* already exists (with-current-buffer rbuf (set 'ledger-acct account) ;; already buffer local - (if (not (eq buf rbuf)) + (if (not (eq buf rbuf)) (progn ;; called from some other ledger-mode buffer (ledger-reconcile-quit-cleanup) (set 'ledger-buf buf))) ;; should already be @@ -370,15 +382,9 @@ Spliting the windows of BUF if needed" (defvar ledger-reconcile-mode-abbrev-table) (defun ledger-reconcile-change-target () + "Change the traget amount for the reconciliation process." (interactive) (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" "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 [?q] 'ledger-reconcile-quit) (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 ldg-recon-menu] (cons "Reconcile" map)) @@ -424,4 +429,7 @@ Spliting the windows of BUF if needed" (add-hook 'kill-buffer-hook 'ledger-reconcile-quit-cleanup nil t))) -(provide 'ldg-reconcile)
\ No newline at end of file +(provide 'ldg-reconcile) +(provide 'ldg-reconcile) + +;;; ldg-reconcile.el ends here diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 711af042..40e54935 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -19,6 +19,12 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; MA 02111-1307, USA. + +;;; Commentary: +;; + +;;; Code: + (eval-when-compile (require 'cl)) @@ -34,7 +40,7 @@ contain format specifiers that are replaced with context sensitive information. Format specifiers have the format '%(<name>)' where <name> is an identifier for the information to be replaced. The `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 in that variable for more information on the behavior of each specifier." @@ -46,7 +52,7 @@ specifier." '(("ledger-file" . ledger-report-ledger-file-format-specifier) ("payee" . ledger-report-payee-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 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) "Run a user-specified report from `ledger-reports'. -Prompts the user for the name of the report to run. If no name is -entered, the user will be prompted for a command line to run. The -command line specified or associated with the selected report name -is run and the output is made available in another buffer for viewing. -If a prefix argument is given and the user selects a valid report -name, the user is prompted with the corresponding command line for -editing before the command is run. +Prompts the user for the REPORT-NAME of the report to run or +EDIT. If no name is entered, the user will be prompted for a +command line to run. The command line specified or associated +with the selected report name is run and the output is made +available in another buffer for viewing. If a prefix argument is +given and the user selects a valid report name, the user is +prompted with the corresponding command line for editing before +the command is run. The output buffer will be in `ledger-report-mode', which defines 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")))) (defun string-empty-p (s) - "Check for the empty string." + "Check S for the empty string." (string-equal "" s)) (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, otherwise returns nil." @@ -171,7 +178,7 @@ used to generate the buffer, navigating the buffer, etc." (car (assoc name ledger-reports)))) (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))) (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)) (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: " (if (null report-cmd) "ledger " report-cmd) nil nil 'ledger-report-cmd-prompt-history)) (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. If it is set, it is used, otherwise the current buffer file is used." @@ -201,7 +208,7 @@ used to generate the buffer, navigating the buffer, etc." "Return the master file for a ledger file. 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 end of a ledger file which is included in some other file." (if ledger-master-file @@ -209,6 +216,7 @@ used to generate the buffer, navigating the buffer, etc." (buffer-file-name))) (defun ledger-read-string-with-default (prompt default) + "Return user supplied string after PROMPT, or DEFAULT." (let ((default-prompt (concat prompt (if default (concat " (" default "): ") @@ -216,7 +224,7 @@ used to generate the buffer, navigating the buffer, etc." (read-string default-prompt nil nil default))) (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 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)))) (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 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))) (defun ledger-report-expand-format-specifiers (report-cmd) + "Expand %(account) and %(payee) appearing in REPORT-CMD with thing under point." (save-match-data (let ((expanded-cmd report-cmd)) (set-match-data (list 0 0)) @@ -258,7 +267,8 @@ used to generate the buffer, navigating the buffer, etc." expanded-cmd))) (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))))) ;; logic for substitution goes here (when (or (null report-cmd) edit) @@ -269,12 +279,12 @@ used to generate the buffer, navigating the buffer, etc." (or (string-empty-p report-name) (ledger-report-name-exists report-name) (progn - (ledger-reports-add report-name report-cmd) + (ledger-reports-add report-name report-cmd) (ledger-reports-custom-save))) report-cmd)) (defun ledger-do-report (cmd) - "Run a report command line." + "Run a report command line CMD." (goto-char (point-min)) (insert (format "Report: %s\n" ledger-report-name) (format "Command: %s\n" cmd) @@ -289,7 +299,8 @@ used to generate the buffer, navigating the buffer, etc." (if (and register-report (not (string-match "--subtotal" cmd))) (concat cmd " --prepend-format='%(filename):%(beg_line):'") - cmd) t nil) + cmd) + t nil) (when register-report (goto-char data-pos) (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 () + "Visit the transaction under point in the report window." (interactive) (let* ((prop (get-text-property (point) 'ledger-source)) (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))) (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)) (if (string-equal ledger-report-cmd @@ -395,7 +407,7 @@ used to generate the buffer, navigating the buffer, etc." (ledger-reports-custom-save)))) (t (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-custom-save))))))) @@ -424,9 +436,9 @@ used to generate the buffer, navigating the buffer, etc." (indent account)))))) (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." (let ((linfo (assoc line-type ledger-line-config)) found field fields) @@ -495,7 +507,7 @@ the fields in the line in a association list." '(unknown nil nil))))))) (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 specified line, returns nil." @@ -534,3 +546,5 @@ specified line, returns nil." (goto-char (ledger-context-field-end-position context-info field-name))) (provide 'ldg-report) + +;;; ldg-report.el ends here diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el index 8a1d9573..361eead8 100644 --- a/lisp/ldg-sort.el +++ b/lisp/ldg-sort.el @@ -19,10 +19,15 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; 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 () + "Move point to next transaction." (if (re-search-forward (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t) @@ -30,9 +35,11 @@ (goto-char (point-max)))) (defun ledger-end-record-function () + "Move point to end of transaction." (forward-paragraph)) (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 ;; automagically (let ((new-beg beg) @@ -57,8 +64,10 @@ 'ledger-end-record-function)))))) (defun ledger-sort-buffer () + "Sort the entire buffer." (interactive) (ledger-sort-region (point-min) (point-max))) +(provide 'ldg-sort) -(provide 'ldg-sort)
\ No newline at end of file +;;; ldg-sort.el ends here diff --git a/lisp/ldg-state.el b/lisp/ldg-state.el index fad7d71c..3e349e4e 100644 --- a/lisp/ldg-state.el +++ b/lisp/ldg-state.el @@ -19,12 +19,19 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; MA 02111-1307, USA. + +;;; Commentary: +;; Utilities for dealing with transaction and posting status. + +;;; Code: + (defcustom ledger-clear-whole-transactions nil "If non-nil, clear whole transactions, not individual postings." :type 'boolean :group 'ledger) (defun ledger-toggle-state (state &optional style) + "Return the correct toggle state given the current STATE, and STYLE." (if (not (null state)) (if (and style (eq style 'cleared)) 'cleared) @@ -33,6 +40,7 @@ 'cleared))) (defun ledger-transaction-state () + "Return the state of the transaction at point." (save-excursion (when (or (looking-at "^[0-9]") (re-search-backward "^[0-9]" nil t)) @@ -43,6 +51,7 @@ (t nil))))) (defun ledger-posting-state () + "Return the state of the posting." (save-excursion (goto-char (line-beginning-position)) (skip-syntax-forward " ") @@ -51,6 +60,7 @@ (t (ledger-transaction-state))))) (defun ledger-char-from-state (state) + "Return the char representation of STATE." (if state (if (eq state 'pending) "!" @@ -58,6 +68,7 @@ "")) (defun ledger-state-from-char (state-char) + "Get state from STATE-CHAR." (cond ((eql state-char ?\!) 'pending) ((eql state-char ?\*) @@ -69,7 +80,7 @@ "Toggle the cleared status of the transaction under point. Optional argument STYLE may be `pending' or `cleared', depending on which type of status the caller wishes to indicate (default is -`cleared'). Returns the new status as 'pending 'cleared or nil. +`cleared'). Returns the new status as 'pending 'cleared or nil. This function is rather complicated because it must preserve both the overall formatting of the ledger entry, as well as ensuring that the most minimal display format is used. This could be @@ -87,7 +98,7 @@ dropped." (setq cur-status (and (member (char-after) '(?\* ?\!)) (ledger-state-from-char (char-after)))) ;;if cur-status if !, or * then delete the marker - (when cur-status + (when cur-status (let ((here (point))) (skip-chars-forward "*! ") (let ((width (- (point) here))) @@ -105,7 +116,7 @@ dropped." (setq new-status nil))) ;;this excursion marks the posting pending or cleared - (save-excursion + (save-excursion (goto-char (line-beginning-position)) (when (looking-at "[ \t]") (skip-chars-forward " \t") @@ -189,6 +200,7 @@ dropped." new-status)) (defun ledger-toggle-current (&optional style) + "Toggle the current thing at point with optional STYLE." (interactive) (if (or ledger-clear-whole-transactions (eq 'transaction (ledger-thing-at-point))) @@ -207,6 +219,7 @@ dropped." (ledger-toggle-current-posting style))) (defun ledger-toggle-current-transaction (&optional style) + "Toggle the transaction at point using optional STYLE." (interactive) (let (status) (save-excursion @@ -219,7 +232,7 @@ dropped." (progn (delete-char 1) (if (and style (eq style 'cleared)) - (progn + (progn (insert " *") (setq status 'cleared)))) (if (and style (eq style 'pending)) @@ -232,3 +245,7 @@ dropped." status)) (provide 'ldg-state) + +(provide 'ldg-state) + +;;; ldg-state.el ends here diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index a1c768ca..94a58542 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -19,19 +19,23 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; 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 - "If t highlight xact under point" + "If t highlight xact under point." :type 'boolean :group 'ledger) (defvar highlight-overlay (list)) (defun ledger-find-xact-extents (pos) - "return point for beginning of xact and and of xact containing - position. Requires empty line separating xacts" + "Return point for beginning of xact and and of xact containing position. +Requires empty line separating xacts. Argument POS is a location +within the transaction." (interactive "d") (save-excursion (goto-char pos) @@ -49,7 +53,8 @@ (defun ledger-highlight-xact-under-point () - (if ledger-highlight-xact-under-point + "Move the highlight overlay to the current transaction." +(if ledger-highlight-xact-under-point (let ((exts (ledger-find-xact-extents (point))) (ovl highlight-overlay)) (if (not highlight-overlay) @@ -63,7 +68,7 @@ (overlay-put ovl 'priority 100)))) (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)) (while (eq (ledger-context-line-type (ledger-context-other-line i)) 'acct-transaction) (setq i (- i 1))) @@ -73,10 +78,12 @@ nil)))) (defsubst ledger-goto-line (line-number) - (goto-char (point-min)) (forward-line (1- line-number))) + "Rapidly move point to line LINE-NUMBER." +(goto-char (point-min)) (forward-line (1- line-number))) (defun ledger-thing-at-point () - (let ((here (point))) + "Describe thing at points. Return 'transaction, 'posting, or nil." +(let ((here (point))) (goto-char (line-beginning-position)) (cond ((looking-at "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+") (goto-char (match-end 0)) @@ -91,9 +98,9 @@ (ignore (goto-char here)))))) (defun ledger-copy-transaction-at-point (date) - (interactive (list - (read-string "Copy to date: " - (concat ledger-year "/" ledger-month "/")))) + "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: " + (concat ledger-year "/" ledger-month "/")))) (let* ((here (point)) (extents (ledger-find-xact-extents (point))) (transaction (buffer-substring (car extents) (cadr extents))) @@ -112,4 +119,7 @@ -(provide 'ldg-xact)
\ No newline at end of file +(provide 'ldg-xact) +(provide 'ldg-xact) + +;;; ldg-xact.el ends here |