From 628fc01962131d6429918216a6780499e6dff9dd Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Mon, 30 Jul 2012 22:32:10 -0500 Subject: Add ability to visit source line from ldg-report --- lisp/ldg-report.el | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 5a668847..29c5ce4c 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -1,3 +1,6 @@ +(eval-when-compile + (require 'cl)) + (defcustom ledger-reports '(("bal" "ledger -f %(ledger-file) bal") ("reg" "ledger -f %(ledger-file) reg") @@ -66,6 +69,7 @@ text that should replace the format specifier." 'ledger-report-kill) (define-key map [(control ?c) (control ?l) (control ?e)] 'ledger-report-edit) + (define-key map [(control ?c) (control ?c)] 'ledger-report-visit-source) (use-local-map map))) (defun ledger-report-read-name () @@ -234,7 +238,23 @@ the default." (format "Command: %s\n" cmd) (make-string (- (window-width) 1) ?=) "\n") - (shell-command cmd t nil)) + (shell-command + (concat cmd " --prepend-format='%(filename):%(beg_line):'") t nil) + (goto-char (point-min)) + (while (re-search-forward "^\\([^:]+\\)?:\\([0-9]+\\)?:" nil t) + (let ((file (match-string 1)) + (line (string-to-number (match-string 2)))) + (delete-region (match-beginning 0) (match-end 0)) + (set-text-properties (line-beginning-position) (line-end-position) + (list 'ledger-source (cons file line)))))) + +(defun ledger-report-visit-source () + (interactive) + (destructuring-bind (file . line) + (get-text-property (point) 'ledger-source) + (find-file-other-window file) + (goto-char (point-min)) + (forward-line (1- line)))) (defun ledger-report-goto () "Goto the ledger report buffer." @@ -446,3 +466,5 @@ specified line, returns nil." (if (eq (ledger-context-line-type context-info) 'entry) (ledger-context-field-value context-info 'payee) nil)))) + +(provide 'ldg-report) -- cgit v1.2.3 From d203393cab1963cbb6718aa9b3ec9880b49b139f Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Mon, 30 Jul 2012 22:35:21 -0500 Subject: Allow non-register reports to work again --- lisp/ldg-report.el | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 29c5ce4c..9a51c32c 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -238,23 +238,27 @@ the default." (format "Command: %s\n" cmd) (make-string (- (window-width) 1) ?=) "\n") - (shell-command - (concat cmd " --prepend-format='%(filename):%(beg_line):'") t nil) - (goto-char (point-min)) - (while (re-search-forward "^\\([^:]+\\)?:\\([0-9]+\\)?:" nil t) - (let ((file (match-string 1)) - (line (string-to-number (match-string 2)))) - (delete-region (match-beginning 0) (match-end 0)) - (set-text-properties (line-beginning-position) (line-end-position) - (list 'ledger-source (cons file line)))))) + (let ((register-report (string-match " reg\\(ister\\)? " cmd))) + (shell-command + (if register-report + (concat cmd " --prepend-format='%(filename):%(beg_line):'") + cmd) t nil) + (when register-report + (goto-char (point-min)) + (while (re-search-forward "^\\([^:]+\\)?:\\([0-9]+\\)?:" nil t) + (let ((file (match-string 1)) + (line (string-to-number (match-string 2)))) + (delete-region (match-beginning 0) (match-end 0)) + (set-text-properties (line-beginning-position) (line-end-position) + (list 'ledger-source (cons file line)))))))) (defun ledger-report-visit-source () (interactive) - (destructuring-bind (file . line) - (get-text-property (point) 'ledger-source) - (find-file-other-window file) - (goto-char (point-min)) - (forward-line (1- line)))) + (let ((prop (get-text-property (point) 'ledger-source))) + (destructuring-bind (file . line) prop + (find-file-other-window file) + (goto-char (point-min)) + (forward-line (1- line))))) (defun ledger-report-goto () "Goto the ledger report buffer." -- cgit v1.2.3 From e716995311076464e65ed402a9000892e8012d2e Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Wed, 8 Aug 2012 00:34:07 -0500 Subject: Patch reports with markers to allow xact shifting --- lisp/ldg-mode.el | 4 +++- lisp/ldg-report.el | 48 +++++++++++++++++++++++++++++++++++++++++++----- 2 files changed, 46 insertions(+), 6 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 4d13d7d2..6090a312 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -51,7 +51,9 @@ (define-key map [tab] 'pcomplete) (define-key map [(control ?i)] 'pcomplete) (define-key map [(control ?c) tab] 'ledger-fully-complete-entry) - (define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-entry))) + (define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-entry)) + + (ledger-report-patch-reports (current-buffer))) (defun ledger-time-less-p (t1 t2) "Say whether time value T1 is less than time value T2." diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 9a51c32c..f9c6afca 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -231,6 +231,28 @@ the default." (ledger-reports-custom-save)) report-cmd)) +(defvar ledger-report-patch-alist nil) + +(defun ledger-report-patch-reports (buf) + (when ledger-report-patch-alist + (let ((entry (assoc (expand-file-name (buffer-file-name buf)) + ledger-report-patch-alist))) + (when entry + (dolist (b (cdr entry)) + (if (buffer-live-p b) + (with-current-buffer b + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let ((record (get-text-property (point) 'ledger-source))) + (if (and record (not (markerp (cdr record)))) + (setcdr record (with-current-buffer buf + (save-excursion + (goto-char (point-min)) + (forward-line (cdr record)) + (point-marker)))))) + (forward-line 1)))))))))) + (defun ledger-do-report (cmd) "Run a report command line." (goto-char (point-min)) @@ -238,7 +260,8 @@ the default." (format "Command: %s\n" cmd) (make-string (- (window-width) 1) ?=) "\n") - (let ((register-report (string-match " reg\\(ister\\)? " cmd))) + (let ((register-report (string-match " reg\\(ister\\)? " cmd)) + files-in-report) (shell-command (if register-report (concat cmd " --prepend-format='%(filename):%(beg_line):'") @@ -250,15 +273,30 @@ the default." (line (string-to-number (match-string 2)))) (delete-region (match-beginning 0) (match-end 0)) (set-text-properties (line-beginning-position) (line-end-position) - (list 'ledger-source (cons file line)))))))) + (list 'ledger-source (cons file line))) + (let* ((fullpath (expand-file-name file)) + (entry (assoc fullpath ledger-report-patch-alist))) + (if entry + (nconc (cdr entry) (list (current-buffer))) + (push (cons (expand-file-name file) + (list (current-buffer))) + ledger-report-patch-alist)) + (add-to-list 'files-in-report fullpath))) + + (dolist (path files-in-report) + (let ((buf (get-file-buffer path))) + (if (and buf (buffer-live-p buf)) + (ledger-report-patch-reports buf)))))))) (defun ledger-report-visit-source () (interactive) (let ((prop (get-text-property (point) 'ledger-source))) - (destructuring-bind (file . line) prop + (destructuring-bind (file . line-or-marker) prop (find-file-other-window file) - (goto-char (point-min)) - (forward-line (1- line))))) + (if (markerp line-or-marker) + (goto-char line-or-marker) + (goto-char (point-min)) + (forward-line (1- line-or-marker)))))) (defun ledger-report-goto () "Goto the ledger report buffer." -- cgit v1.2.3 From 7b11dad404b4e689393a5725c93ea84507fc2221 Mon Sep 17 00:00:00 2001 From: adamsrl Date: Sun, 14 Oct 2012 16:43:56 -0500 Subject: Added back my patches for johns ldg-mode --- lisp/ldg-report.el | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index f9c6afca..e0744100 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -259,15 +259,16 @@ the default." (insert (format "Report: %s\n" ledger-report-name) (format "Command: %s\n" cmd) (make-string (- (window-width) 1) ?=) - "\n") - (let ((register-report (string-match " reg\\(ister\\)? " cmd)) + "\n\n") + (let ((data-pos (point)) + (register-report (string-match " reg\\(ister\\)? " cmd)) files-in-report) (shell-command (if register-report (concat cmd " --prepend-format='%(filename):%(beg_line):'") cmd) t nil) (when register-report - (goto-char (point-min)) + (goto-char data-pos) (while (re-search-forward "^\\([^:]+\\)?:\\([0-9]+\\)?:" nil t) (let ((file (match-string 1)) (line (string-to-number (match-string 2)))) @@ -283,20 +284,30 @@ the default." ledger-report-patch-alist)) (add-to-list 'files-in-report fullpath))) - (dolist (path files-in-report) - (let ((buf (get-file-buffer path))) - (if (and buf (buffer-live-p buf)) - (ledger-report-patch-reports buf)))))))) + ;; Disable john's "monkey patching" because it didn't work + ;; (dolist (path files-in-report) + ;; (let ((buf (get-file-buffer path))) + ;; (if (and buf (buffer-live-p buf)) + ;; (ledger-report-patch-reports buf)))))))) + ) + (goto-char data-pos) ))) (defun ledger-report-visit-source () (interactive) (let ((prop (get-text-property (point) 'ledger-source))) (destructuring-bind (file . line-or-marker) prop (find-file-other-window file) + (widen) (if (markerp line-or-marker) (goto-char line-or-marker) (goto-char (point-min)) - (forward-line (1- line-or-marker)))))) + (forward-line (1- line-or-marker)) + (re-search-backward "^[0-9]+") + (beginning-of-line) + (let ((start-of-txn (point))) + (forward-paragraph) + (narrow-to-region start-of-txn (point)) + (backward-paragraph)))))) (defun ledger-report-goto () "Goto the ledger report buffer." -- cgit v1.2.3 From 6094c202c152b282098de1002be54b3bcd7ab50c Mon Sep 17 00:00:00 2001 From: adamsrl Date: Mon, 15 Oct 2012 11:47:29 -0500 Subject: Adding goto EOL to fix issue where re-search-forward was including ledger report data in the text properties. --- lisp/ldg-report.el | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index e0744100..9fdf55d2 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -275,6 +275,7 @@ the default." (delete-region (match-beginning 0) (match-end 0)) (set-text-properties (line-beginning-position) (line-end-position) (list 'ledger-source (cons file line))) + (end-of-line) (let* ((fullpath (expand-file-name file)) (entry (assoc fullpath ledger-report-patch-alist))) (if entry @@ -282,15 +283,13 @@ the default." (push (cons (expand-file-name file) (list (current-buffer))) ledger-report-patch-alist)) - (add-to-list 'files-in-report fullpath))) - - ;; Disable john's "monkey patching" because it didn't work - ;; (dolist (path files-in-report) - ;; (let ((buf (get-file-buffer path))) - ;; (if (and buf (buffer-live-p buf)) - ;; (ledger-report-patch-reports buf)))))))) - ) - (goto-char data-pos) ))) + (add-to-list 'files-in-report fullpath)))) + (dolist (path files-in-report) + (let ((buf (get-file-buffer path))) + (if (and buf (buffer-live-p buf)) + (ledger-report-patch-reports buf))))) + (goto-char data-pos))) + (defun ledger-report-visit-source () (interactive) -- cgit v1.2.3 From 9173190a8f1d93bebf14ff795bee46b619fd845a Mon Sep 17 00:00:00 2001 From: adamsrl Date: Mon, 15 Oct 2012 13:29:22 -0500 Subject: Made marker logic for jumping from hyperlinked reports to source files work by simplifying. --- lisp/ldg-report.el | 46 +++++++++------------------------------------- 1 file changed, 9 insertions(+), 37 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 9fdf55d2..9a964195 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -231,28 +231,6 @@ the default." (ledger-reports-custom-save)) report-cmd)) -(defvar ledger-report-patch-alist nil) - -(defun ledger-report-patch-reports (buf) - (when ledger-report-patch-alist - (let ((entry (assoc (expand-file-name (buffer-file-name buf)) - ledger-report-patch-alist))) - (when entry - (dolist (b (cdr entry)) - (if (buffer-live-p b) - (with-current-buffer b - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (let ((record (get-text-property (point) 'ledger-source))) - (if (and record (not (markerp (cdr record)))) - (setcdr record (with-current-buffer buf - (save-excursion - (goto-char (point-min)) - (forward-line (cdr record)) - (point-marker)))))) - (forward-line 1)))))))))) - (defun ledger-do-report (cmd) "Run a report command line." (goto-char (point-min)) @@ -271,23 +249,17 @@ the default." (goto-char data-pos) (while (re-search-forward "^\\([^:]+\\)?:\\([0-9]+\\)?:" nil t) (let ((file (match-string 1)) - (line (string-to-number (match-string 2)))) + (line (string-to-number (match-string 2)))) (delete-region (match-beginning 0) (match-end 0)) (set-text-properties (line-beginning-position) (line-end-position) - (list 'ledger-source (cons file line))) - (end-of-line) - (let* ((fullpath (expand-file-name file)) - (entry (assoc fullpath ledger-report-patch-alist))) - (if entry - (nconc (cdr entry) (list (current-buffer))) - (push (cons (expand-file-name file) - (list (current-buffer))) - ledger-report-patch-alist)) - (add-to-list 'files-in-report fullpath)))) - (dolist (path files-in-report) - (let ((buf (get-file-buffer path))) - (if (and buf (buffer-live-p buf)) - (ledger-report-patch-reports buf))))) + (list 'ledger-source (cons file (save-window-excursion + (save-excursion + (find-file file) + (widen) + (goto-char (point-min)) + (forward-line (1- line)) + (point-marker)))))) + (end-of-line)))) (goto-char data-pos))) -- cgit v1.2.3 From 0bbff75f43a096823c2838ae3b7330cf86a54b78 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 29 Jan 2013 08:50:50 -0700 Subject: fixes the reconcile mode, adds menus for all modes thanks to dk for the is-std defun. --- lisp/ldg-mode.el | 38 +++++++++++++- lisp/ldg-reconcile.el | 136 ++++++++++++++++++++++++++++++-------------------- lisp/ldg-report.el | 15 ++++++ 3 files changed, 132 insertions(+), 57 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 04c6ee1b..caa57e8e 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -19,6 +19,7 @@ (defvar ledger-mode-abbrev-table) + ;;;###autoload (define-derived-mode ledger-mode text-mode "Ledger" "A mode for editing ledger data files." @@ -51,8 +52,41 @@ (define-key map [tab] 'pcomplete) (define-key map [(control ?i)] 'pcomplete) (define-key map [(control ?c) tab] 'ledger-fully-complete-entry) - (define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-entry)) - + (define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-entry) + (define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report) + (define-key map [(control ?c) (control ?o) (control ?g)] 'ledger-report-goto) + (define-key map [(control ?c) (control ?o) (control ?a)] 'ledger-report-redo) + (define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save) + (define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit) + (define-key map [(control ?c) (control ?o) (control ?k)] 'ledger-report-kill) + + + (define-key map [menu-bar] (make-sparse-keymap "ldg-menu")) + (define-key map [menu-bar ldg-menu] (cons "Ledger" map)) + + (define-key map [menu-bar ldg-menu lrk] '("Kill Report" . ledger-report-kill)) + (define-key map [menu-bar ldg-menu lre] '("Edit Report" . ledger-report-edit)) + (define-key map [menu-bar ldg-menu lrs] '("Save Report" . ledger-report-save)) + (define-key map [menu-bar ldg-menu lrr] '("Re-run Report" . ledger-report-redo)) + (define-key map [menu-bar ldg-menu lrg] '("Goto Report" . ledger-report-goto)) + (define-key map [menu-bar ldg-menu lr] '("Run Report" . ledger-report)) + (define-key map [menu-bar ldg-menu s5] '("--")) + (define-key map [menu-bar ldg-menu sm] '("Set Month" . ledger-set-month)) + (define-key map [menu-bar ldg-menu sy] '("Set Year" . ledger-set-year)) + (define-key map [menu-bar ldg-menu s1] '("--")) + (define-key map [menu-bar ldg-menu so] '("Sort Buffer" . ledger-sort)) + (define-key map [menu-bar ldg-menu s2] '("--")) + (define-key map [menu-bar ldg-menu te] '("Toggle Current Posting" . ledger-toggle-current)) + (define-key map [menu-bar ldg-menu tt] '("Toggle Current Transaction" . ledger-toggle-current-entry)) + (define-key map [menu-bar ldg-menu s4] '("--")) + (define-key map [menu-bar ldg-menu de] '("Delete Entry" . ledger-delete-current-entry)) + (define-key map [menu-bar ldg-menu ae] '("Add Entry" . ledger-add-entry)) + (define-key map [menu-bar ldg-menu s3] '("--")) + (define-key map [menu-bar ldg-menu re] '("Reconcile Account" . ledger-reconcile))) + + + + (ledger-report-patch-reports (current-buffer))) (defun ledger-time-less-p (t1 t2) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index d3dda60f..73409e66 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -4,18 +4,24 @@ (defvar ledger-acct nil) (defun ledger-display-balance () + "Calculate the cleared balance of the account being reconciled" (let ((buffer ledger-buf) (account ledger-acct)) (with-temp-buffer - (let ((exit-code (ledger-run-ledger buffer "-C" "balance" account))) - (if (/= 0 exit-code) - (message "Error determining cleared balance") - (goto-char (1- (point-max))) - (goto-char (line-beginning-position)) - (delete-horizontal-space) - (message "Cleared balance = %s" - (buffer-substring-no-properties (point) - (line-end-position)))))))) + (ledger-exec-ledger buffer (current-buffer) "-C" "balance" account) + (goto-char (1- (point-max))) + (goto-char (line-beginning-position)) + (delete-horizontal-space) + (message "Cleared balance = %s" + (buffer-substring-no-properties (point) + (line-end-position)))))) + +(defun is-stdin (file) + "True if ledger file is standard input" + (or + (equal file "") + (equal file "") + (equal file "/dev/stdin"))) (defun ledger-reconcile-toggle () (interactive) @@ -23,18 +29,19 @@ (account ledger-acct) (inhibit-read-only t) cleared) - (when (or (equal (car where) "") (equal (car where) "/dev/stdin")) + (when (is-stdin (car where)) (with-current-buffer ledger-buf - (goto-char (cdr where)) - (setq cleared (ledger-toggle-current 'pending))) + (goto-char (cdr where)) + (setq cleared (ledger-toggle-current-entry))) (if cleared - (add-text-properties (line-beginning-position) - (line-end-position) - (list 'face 'bold)) - (remove-text-properties (line-beginning-position) - (line-end-position) - (list 'face)))) - (forward-line))) + (add-text-properties (line-beginning-position) + (line-end-position) + (list 'face 'bold)) + (remove-text-properties (line-beginning-position) + (line-end-position) + (list 'face)))) + (forward-line) + (ledger-display-balance))) (defun ledger-reconcile-refresh () (interactive) @@ -62,7 +69,7 @@ (defun ledger-reconcile-delete () (interactive) (let ((where (get-text-property (point) 'where))) - (when (or (equal (car where) "") (equal (car where) "/dev/stdin")) + (when (is-stdin (car where)) (with-current-buffer ledger-buf (goto-char (cdr where)) (ledger-delete-current-entry)) @@ -74,7 +81,7 @@ (defun ledger-reconcile-visit () (interactive) (let ((where (get-text-property (point) 'where))) - (when (or (equal (car where) "") (equal (car where) "/dev/stdin")) + (when (is-stdin (car where)) (switch-to-buffer-other-window ledger-buf) (goto-char (cdr where))))) @@ -97,7 +104,7 @@ (let ((where (get-text-property (point) 'where)) (face (get-text-property (point) 'face))) (if (and (eq face 'bold) - (or (equal (car where) "") (equal (car where) "/dev/stdin"))) + (when (is-stdin (car where)))) (with-current-buffer ledger-buf (goto-char (cdr where)) (ledger-toggle-current 'cleared)))) @@ -105,45 +112,48 @@ (ledger-reconcile-save)) (defun ledger-do-reconcile () - (let* ((buf ledger-buf) + "get the uncleared transactions in the account and display them in the *Reconcile* buffer" + (let* ((buf ledger-buf) (account ledger-acct) (items - (with-current-buffer - (apply #'ledger-exec-ledger - buf nil "emacs" account "--uncleared" '("--real")) + (with-temp-buffer + (ledger-exec-ledger buf (current-buffer) "--uncleared" "--real" + "emacs" account) (goto-char (point-min)) (unless (eobp) (unless (looking-at "(") (error (buffer-string))) - (read (current-buffer)))))) - (dolist (item items) - (let ((index 1)) - (dolist (xact (nthcdr 5 item)) - (let ((beg (point)) - (where - (with-current-buffer buf - (cons - (nth 0 item) - (if ledger-clear-whole-entries - (save-excursion - (goto-line (nth 1 item)) - (point-marker)) - (save-excursion - (goto-line (nth 0 xact)) - (point-marker))))))) - (insert (format "%s %-30s %-25s %15s\n" - (format-time-string "%m/%d" (nth 2 item)) - (nth 4 item) (nth 1 xact) (nth 2 xact))) - (if (nth 3 xact) - (set-text-properties beg (1- (point)) - (list 'face 'bold - 'where where)) - (set-text-properties beg (1- (point)) - (list 'where where)))) - (setq index (1+ index))))) - (goto-char (point-min)) - (set-buffer-modified-p nil) - (toggle-read-only t))) + (read (current-buffer)))))) + (dolist (item items) + (let ((index 1)) + (dolist (xact (nthcdr 5 item)) + (let ((beg (point)) + (where + (with-current-buffer buf + (cons + (nth 0 item) + (if ledger-clear-whole-entries + (save-excursion + (goto-line (nth 1 item)) + (point-marker)) + (save-excursion + (goto-line (nth 0 xact)) + (point-marker))))))) + (insert (format "%s %-4s %-30s %-30s %15s\n" + (format-time-string "%Y/%m/%d" (nth 2 item)) + (nth 3 item) + (nth 4 item) (nth 1 xact) (nth 2 xact))) + (if (nth 3 xact) + (set-text-properties beg (1- (point)) + (list 'face 'bold + 'where where)) + (set-text-properties beg (1- (point)) + (list 'where where)))) + (setq index (1+ index))))) + (goto-char (point-min)) + (set-buffer-modified-p nil) + (toggle-read-only t))) + (defun ledger-reconcile (account) (interactive "sAccount to reconcile: ") @@ -176,4 +186,20 @@ (define-key map [?p] 'previous-line) (define-key map [?s] 'ledger-reconcile-save) (define-key map [?q] 'ledger-reconcile-quit) + + (define-key map [menu-bar] (make-sparse-keymap "ldg-recon-menu")) + (define-key map [menu-bar ldg-recon-menu] (cons "Reconcile" map)) + (define-key map [menu-bar ldg-recon-menu qui] '("Quit" . ledger-reconcile-quit)) + (define-key map [menu-bar ldg-recon-menu sep1] '("--")) + (define-key map [menu-bar ldg-recon-menu pre] '("Previous Entry" . previous-line)) + (define-key map [menu-bar ldg-recon-menu vis] '("Visit Entry" . ledger-reconcile-visit)) + (define-key map [menu-bar ldg-recon-menu nex] '("Next Entry" . next-line)) + (define-key map [menu-bar ldg-recon-menu sep2] '("--")) + (define-key map [menu-bar ldg-recon-menu del] '("Delete Entry" . ledger-reconcile-delete)) + (define-key map [menu-bar ldg-recon-menu add] '("Add Entry" . ledger-reconcile-add)) + (define-key map [menu-bar ldg-recon-menu tog] '("Toggle Entry" . ledger-reconcile-toggle)) + (define-key map [menu-bar ldg-recon-menu sep3] '("--")) + (define-key map [menu-bar ldg-recon-menu ref] '("Refresh" . ledger-reconcile-refresh)) + (define-key map [menu-bar ldg-recon-menu sav] '("Save" . ledger-reconcile-save)) + (use-local-map map))) diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index f9c6afca..efd9bdb4 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -70,6 +70,21 @@ text that should replace the format specifier." (define-key map [(control ?c) (control ?l) (control ?e)] 'ledger-report-edit) (define-key map [(control ?c) (control ?c)] 'ledger-report-visit-source) + + + (define-key map [menu-bar] (make-sparse-keymap "ldg-rep")) + (define-key map [menu-bar ldg-rep] (cons "Reports" map)) + + (define-key map [menu-bar ldg-rep lrq] '("Quit" . ledger-report-quit)) + (define-key map [menu-bar ldg-rep s2] '("--")) + (define-key map [menu-bar ldg-rep lrd] '("Scroll Down" . scroll-down)) + (define-key map [menu-bar ldg-rep lru] '("Scroll Up" . scroll-up)) + (define-key map [menu-bar ldg-rep s1] '("--")) + (define-key map [menu-bar ldg-rep lrk] '("Kill Report" . ledger-report-kill)) + (define-key map [menu-bar ldg-rep lrr] '("Re-run Report" . ledger-report-redo)) + (define-key map [menu-bar ldg-rep lre] '("Edit Report" . ledger-report-edit)) + (define-key map [menu-bar ldg-rep lrs] '("Save Report" . ledger-report-save)) + (use-local-map map))) (defun ledger-report-read-name () -- cgit v1.2.3 From eff14723378133469238a9e302677b84c3f7b63e Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 29 Jan 2013 13:57:22 -0700 Subject: Added GPL licensing information to lisp files --- lisp/ldg-complete.el | 21 +++++++++++++++++++++ lisp/ldg-exec.el | 21 +++++++++++++++++++++ lisp/ldg-mode.el | 22 ++++++++++++++++++++++ lisp/ldg-post.el | 21 +++++++++++++++++++++ lisp/ldg-reconcile.el | 21 +++++++++++++++++++++ lisp/ldg-regex.el | 21 +++++++++++++++++++++ lisp/ldg-register.el | 21 +++++++++++++++++++++ lisp/ldg-report.el | 21 +++++++++++++++++++++ lisp/ldg-state.el | 21 +++++++++++++++++++++ lisp/ldg-test.el | 21 +++++++++++++++++++++ lisp/ldg-texi.el | 21 +++++++++++++++++++++ lisp/ldg-xact.el | 21 +++++++++++++++++++++ 12 files changed, 253 insertions(+) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index 7b4b0471..85546156 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -1,3 +1,24 @@ +;;; ldg-complete.el --- Helper code for use with the "ledger" command-line tool + +;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) + +;; This file is not part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free +;; Software Foundation; either version 2, or (at your option) any later +;; version. +;; +;; This is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + ;;(require 'esh-util) ;;(require 'esh-arg) (require 'pcomplete) diff --git a/lisp/ldg-exec.el b/lisp/ldg-exec.el index bf3565b4..ab041fec 100644 --- a/lisp/ldg-exec.el +++ b/lisp/ldg-exec.el @@ -1,3 +1,24 @@ +;;; ldg-exec.el --- Helper code for use with the "ledger" command-line tool + +;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) + +;; This file is not part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free +;; Software Foundation; either version 2, or (at your option) any later +;; version. +;; +;; This is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + (defgroup ledger-exec nil "Interface to the Ledger command-line accounting program." :group 'ledger) diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index e36dc969..842cd582 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -1,3 +1,25 @@ +;;; ldg-mode.el --- Helper code for use with the "ledger" command-line tool + +;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) + +;; This file is not part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free +;; Software Foundation; either version 2, or (at your option) any later +;; version. +;; +;; This is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + + (defsubst ledger-current-year () (format-time-string "%Y")) (defsubst ledger-current-month () diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 05b9d352..7cb525a7 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -1,3 +1,24 @@ +;;; ldg-post.el --- Helper code for use with the "ledger" command-line tool + +;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) + +;; This file is not part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free +;; Software Foundation; either version 2, or (at your option) any later +;; version. +;; +;; This is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + (require 'ldg-regex) (defgroup ledger-post nil diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 08dbc587..011bf400 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -1,3 +1,24 @@ +;;; ldg-reconcile.el --- Helper code for use with the "ledger" command-line tool + +;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) + +;; This file is not part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free +;; Software Foundation; either version 2, or (at your option) any later +;; version. +;; +;; This is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + ;; Reconcile mode (defvar ledger-buf nil) diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el index 1c6b8f06..f2f83937 100644 --- a/lisp/ldg-regex.el +++ b/lisp/ldg-regex.el @@ -1,3 +1,24 @@ +;;; ldg-regex.el --- Helper code for use with the "ledger" command-line tool + +;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) + +;; This file is not part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free +;; Software Foundation; either version 2, or (at your option) any later +;; version. +;; +;; This is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + (require 'rx) (eval-when-compile diff --git a/lisp/ldg-register.el b/lisp/ldg-register.el index 7b5c0d0a..4c397049 100644 --- a/lisp/ldg-register.el +++ b/lisp/ldg-register.el @@ -1,3 +1,24 @@ +;;; ldg-register.el --- Helper code for use with the "ledger" command-line tool + +;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) + +;; This file is not part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free +;; Software Foundation; either version 2, or (at your option) any later +;; version. +;; +;; This is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + (require 'ldg-post) (require 'ldg-state) diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index a1ffe3b0..394c12e7 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -1,3 +1,24 @@ +;;; ldg-report.el --- Helper code for use with the "ledger" command-line tool + +;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) + +;; This file is not part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free +;; Software Foundation; either version 2, or (at your option) any later +;; version. +;; +;; This is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + (eval-when-compile (require 'cl)) diff --git a/lisp/ldg-state.el b/lisp/ldg-state.el index 6a841621..03017b25 100644 --- a/lisp/ldg-state.el +++ b/lisp/ldg-state.el @@ -1,3 +1,24 @@ +;;; ldg-state.el --- Helper code for use with the "ledger" command-line tool + +;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) + +;; This file is not part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free +;; Software Foundation; either version 2, or (at your option) any later +;; version. +;; +;; This is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + (defcustom ledger-clear-whole-entries nil "If non-nil, clear whole entries, not individual transactions." :type 'boolean diff --git a/lisp/ldg-test.el b/lisp/ldg-test.el index 478c62d8..2036ea7b 100644 --- a/lisp/ldg-test.el +++ b/lisp/ldg-test.el @@ -1,3 +1,24 @@ +;;; ldg-test.el --- Helper code for use with the "ledger" command-line tool + +;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) + +;; This file is not part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free +;; Software Foundation; either version 2, or (at your option) any later +;; version. +;; +;; This is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + (defcustom ledger-source-directory "~/src/ledger" "Directory where the Ledger sources are located." :type 'directory diff --git a/lisp/ldg-texi.el b/lisp/ldg-texi.el index b0334099..fefa7d2b 100644 --- a/lisp/ldg-texi.el +++ b/lisp/ldg-texi.el @@ -1,3 +1,24 @@ +;;; ldg-texi.el --- Helper code for use with the "ledger" command-line tool + +;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) + +;; This file is not part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free +;; Software Foundation; either version 2, or (at your option) any later +;; version. +;; +;; This is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + (defvar ledger-path "/Users/johnw/bin/ledger") (defvar ledger-sample-doc-path "/Users/johnw/src/ledger/doc/sample.dat") (defvar ledger-normalization-args "--args-only --columns 80") diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index 6e14a14c..11e6fbaf 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -1,3 +1,24 @@ +;;; ldg-xact.el --- Helper code for use with the "ledger" command-line tool + +;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) + +;; This file is not part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free +;; Software Foundation; either version 2, or (at your option) any later +;; version. +;; +;; This is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + ;; A sample entry sorting function, which works if entry dates are of ;; the form YYYY/mm/dd. -- cgit v1.2.3 From 4d7c4929395421eb039f0d03afafaf55cffd686d Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 5 Feb 2013 12:33:42 -0700 Subject: Lisp code cleanup Most of the files have been touched several times and the indentation structure was wrong. I ran all the files through the emacs indent region function to get back to a baseline --- lisp/ldg-complete.el | 50 +++++++-------- lisp/ldg-exec.el | 4 +- lisp/ldg-fonts.el | 2 +- lisp/ldg-mode.el | 176 +++++++++++++++++++++++++-------------------------- lisp/ldg-new.el | 6 +- lisp/ldg-post.el | 44 ++++++------- lisp/ldg-regex.el | 130 ++++++++++++++++++------------------- lisp/ldg-register.el | 14 ++-- lisp/ldg-report.el | 106 +++++++++++++++---------------- lisp/ldg-sort.el | 14 ++-- lisp/ldg-state.el | 60 +++++++++--------- lisp/ldg-test.el | 8 +-- lisp/ldg-texi.el | 18 +++--- 13 files changed, 316 insertions(+), 316 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index 85546156..996df558 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -89,9 +89,9 @@ (let ((entry (assoc (car elements) root))) (if entry (setq root (cdr entry)) - (setq entry (cons (car elements) (list t))) - (nconc root (list entry)) - (setq root (cdr entry)))) + (setq entry (cons (car elements) (list t))) + (nconc root (list entry)) + (setq root (cdr entry)))) (setq elements (cdr elements))))))))) (defun ledger-accounts () @@ -106,18 +106,18 @@ (setq prefix (concat prefix (and prefix ":") (car elements)) root (cdr entry)) - (setq root nil elements nil))) + (setq root nil elements nil))) (setq elements (cdr elements))) (and root (sort (mapcar (function (lambda (x) - (let ((term (if prefix - (concat prefix ":" (car x)) - (car x)))) - (if (> (length (cdr x)) 1) - (concat term ":") - term)))) + (let ((term (if prefix + (concat prefix ":" (car x)) + (car x)))) + (if (> (length (cdr x)) 1) + (concat term ":") + term)))) (cdr root)) 'string-lessp)))) @@ -129,21 +129,21 @@ (ledger-thing-at-point)) 'entry) (if (null current-prefix-arg) (ledger-entries) ; this completes against entry names - (progn - (let ((text (buffer-substring (line-beginning-position) - (line-end-position)))) - (delete-region (line-beginning-position) - (line-end-position)) - (condition-case err - (ledger-add-entry text t) - ((error) - (insert text)))) - (forward-line) - (goto-char (line-end-position)) - (search-backward ";" (line-beginning-position) t) - (skip-chars-backward " \t0123456789.,") - (throw 'pcompleted t))) - (ledger-accounts))))) + (progn + (let ((text (buffer-substring (line-beginning-position) + (line-end-position)))) + (delete-region (line-beginning-position) + (line-end-position)) + (condition-case err + (ledger-add-entry text t) + ((error) + (insert text)))) + (forward-line) + (goto-char (line-end-position)) + (search-backward ";" (line-beginning-position) t) + (skip-chars-backward " \t0123456789.,") + (throw 'pcompleted t))) + (ledger-accounts))))) (defun ledger-fully-complete-entry () "Do appropriate completion for the thing at point" diff --git a/lisp/ldg-exec.el b/lisp/ldg-exec.el index f13cfa5a..e9cefd20 100644 --- a/lisp/ldg-exec.el +++ b/lisp/ldg-exec.el @@ -68,8 +68,8 @@ (goto-char (point-min)) (delete-horizontal-space) (setq version-strings (split-string - (buffer-substring-no-properties (point) - (+ (point) 12)))) + (buffer-substring-no-properties (point) + (+ (point) 12)))) (if (and (string-match (regexp-quote "Ledger") (car version-strings)) (or (string= needed (car (cdr version-strings))) (string< needed (car (cdr version-strings))))) diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el index 2b7717c6..6032e361 100644 --- a/lisp/ldg-fonts.el +++ b/lisp/ldg-fonts.el @@ -52,7 +52,7 @@ :group 'ledger-faces) (defface ledger-font-comment-face - `((t :foreground "orange" )) + `((t :foreground "orange" )) "Face for Ledger comments" :group 'ledger-faces) diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 4c55cdc0..226009c6 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -43,77 +43,77 @@ customizable to ease retro-entry.") ;;;###autoload (define-derived-mode ledger-mode text-mode "Ledger" - "A mode for editing ledger data files." - (ledger-check-version) - (ledger-post-setup) - - (set (make-local-variable 'comment-start) " ; ") - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'indent-tabs-mode) nil) - - (if (boundp 'font-lock-defaults) - (set (make-local-variable 'font-lock-defaults) - '(ledger-font-lock-keywords nil t))) - - (set (make-local-variable 'pcomplete-parse-arguments-function) - 'ledger-parse-arguments) - (set (make-local-variable 'pcomplete-command-completion-function) - 'ledger-complete-at-point) - (set (make-local-variable 'pcomplete-termination-string) "") - - (let ((map (current-local-map))) - (define-key map [(control ?c) (control ?a)] 'ledger-add-entry) - (define-key map [(control ?c) (control ?d)] 'ledger-delete-current-entry) - (define-key map [(control ?c) (control ?y)] 'ledger-set-year) - (define-key map [(control ?c) (control ?m)] 'ledger-set-month) - (define-key map [(control ?c) (control ?c)] 'ledger-toggle-current) - (define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-entry) - (define-key map [(control ?c) (control ?r)] 'ledger-reconcile) - (define-key map [(control ?c) (control ?s)] 'ledger-sort-region) - (define-key map [(control ?c) (control ?t)] 'ledger-test-run) - (define-key map [(control ?c) (control ?v)] 'ledger-post-edit-amount) - (define-key map [(control ?c) (control ?f)] 'ledger-occur) - (define-key map [tab] 'pcomplete) - (define-key map [(control ?i)] 'pcomplete) - (define-key map [(control ?c) tab] 'ledger-fully-complete-entry) - (define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-entry) - (define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report) - (define-key map [(control ?c) (control ?o) (control ?g)] 'ledger-report-goto) - (define-key map [(control ?c) (control ?o) (control ?a)] 'ledger-report-redo) - (define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save) - (define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit) - (define-key map [(control ?c) (control ?o) (control ?k)] 'ledger-report-kill) - - (define-key map [(meta ?p)] 'ledger-post-prev-xact) - (define-key map [(meta ?n)] 'ledger-post-next-xact) - - (define-key map [menu-bar] (make-sparse-keymap "ldg-menu")) - (define-key map [menu-bar ldg-menu] (cons "Ledger" map)) - - (define-key map [report-kill] '(menu-item "Kill Report" ledger-report-kill :enable ledger-works)) - (define-key map [report-edit] '(menu-item "Edit Report" ledger-report-edit :enable ledger-works)) - (define-key map [report-save] '(menu-item "Save Report" ledger-report-save :enable ledger-works)) - (define-key map [report-rrun] '(menu-item "Re-run Report" ledger-report-redo :enable ledger-works)) - (define-key map [report-goto] '(menu-item "Goto Report" ledger-report-goto :enable ledger-works)) - (define-key map [report-run] '(menu-item "Run Report" ledger-report :enable ledger-works)) - (define-key map [sep5] '(menu-item "--")) - (define-key map [set-month] '(menu-item "Set Month" ledger-set-month :enable ledger-works)) - (define-key map [set-year] '(menu-item "Set Year" ledger-set-year :enable ledger-works)) - (define-key map [sep1] '("--")) - (define-key map [sort-buff] '(menu-item "Sort Buffer" ledger-sort-buffer)) - (define-key map [sort-reg] '(menu-item "Sort Region" ledger-sort-region :enable mark-active)) - (define-key map [sep2] '(menu-item "--")) - (define-key map [toggle-post] '(menu-item "Toggle Current Posting" ledger-toggle-current)) - (define-key map [toggle-xact] '(menu-item "Toggle Current Transaction" ledger-toggle-current-entry)) - (define-key map [sep4] '(menu-item "--")) - (define-key map [edit-amount] '(menu-item "Calc on Amount" ledger-post-edit-amount)) - (define-key map [sep] '(menu-item "--")) - (define-key map [delete-xact] '(menu-item "Delete Entry" ledger-delete-current-entry)) - (define-key map [add-xact] '(menu-item "Add Entry" ledger-add-entry :enable ledger-works)) - (define-key map [sep3] '(menu-item "--")) - (define-key map [reconcile] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works)) - (define-key map [reconcile] '(menu-item "Hide Xacts" ledger-occur)) - )) + "A mode for editing ledger data files." + (ledger-check-version) + (ledger-post-setup) + + (set (make-local-variable 'comment-start) " ; ") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'indent-tabs-mode) nil) + + (if (boundp 'font-lock-defaults) + (set (make-local-variable 'font-lock-defaults) + '(ledger-font-lock-keywords nil t))) + + (set (make-local-variable 'pcomplete-parse-arguments-function) + 'ledger-parse-arguments) + (set (make-local-variable 'pcomplete-command-completion-function) + 'ledger-complete-at-point) + (set (make-local-variable 'pcomplete-termination-string) "") + + (let ((map (current-local-map))) + (define-key map [(control ?c) (control ?a)] 'ledger-add-entry) + (define-key map [(control ?c) (control ?d)] 'ledger-delete-current-entry) + (define-key map [(control ?c) (control ?y)] 'ledger-set-year) + (define-key map [(control ?c) (control ?m)] 'ledger-set-month) + (define-key map [(control ?c) (control ?c)] 'ledger-toggle-current) + (define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-entry) + (define-key map [(control ?c) (control ?r)] 'ledger-reconcile) + (define-key map [(control ?c) (control ?s)] 'ledger-sort-region) + (define-key map [(control ?c) (control ?t)] 'ledger-test-run) + (define-key map [(control ?c) (control ?v)] 'ledger-post-edit-amount) + (define-key map [(control ?c) (control ?f)] 'ledger-occur) + (define-key map [tab] 'pcomplete) + (define-key map [(control ?i)] 'pcomplete) + (define-key map [(control ?c) tab] 'ledger-fully-complete-entry) + (define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-entry) + (define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report) + (define-key map [(control ?c) (control ?o) (control ?g)] 'ledger-report-goto) + (define-key map [(control ?c) (control ?o) (control ?a)] 'ledger-report-redo) + (define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save) + (define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit) + (define-key map [(control ?c) (control ?o) (control ?k)] 'ledger-report-kill) + + (define-key map [(meta ?p)] 'ledger-post-prev-xact) + (define-key map [(meta ?n)] 'ledger-post-next-xact) + + (define-key map [menu-bar] (make-sparse-keymap "ldg-menu")) + (define-key map [menu-bar ldg-menu] (cons "Ledger" map)) + + (define-key map [report-kill] '(menu-item "Kill Report" ledger-report-kill :enable ledger-works)) + (define-key map [report-edit] '(menu-item "Edit Report" ledger-report-edit :enable ledger-works)) + (define-key map [report-save] '(menu-item "Save Report" ledger-report-save :enable ledger-works)) + (define-key map [report-rrun] '(menu-item "Re-run Report" ledger-report-redo :enable ledger-works)) + (define-key map [report-goto] '(menu-item "Goto Report" ledger-report-goto :enable ledger-works)) + (define-key map [report-run] '(menu-item "Run Report" ledger-report :enable ledger-works)) + (define-key map [sep5] '(menu-item "--")) + (define-key map [set-month] '(menu-item "Set Month" ledger-set-month :enable ledger-works)) + (define-key map [set-year] '(menu-item "Set Year" ledger-set-year :enable ledger-works)) + (define-key map [sep1] '("--")) + (define-key map [sort-buff] '(menu-item "Sort Buffer" ledger-sort-buffer)) + (define-key map [sort-reg] '(menu-item "Sort Region" ledger-sort-region :enable mark-active)) + (define-key map [sep2] '(menu-item "--")) + (define-key map [toggle-post] '(menu-item "Toggle Current Posting" ledger-toggle-current)) + (define-key map [toggle-xact] '(menu-item "Toggle Current Transaction" ledger-toggle-current-entry)) + (define-key map [sep4] '(menu-item "--")) + (define-key map [edit-amount] '(menu-item "Calc on Amount" ledger-post-edit-amount)) + (define-key map [sep] '(menu-item "--")) + (define-key map [delete-xact] '(menu-item "Delete Entry" ledger-delete-current-entry)) + (define-key map [add-xact] '(menu-item "Add Entry" ledger-add-entry :enable ledger-works)) + (define-key map [sep3] '(menu-item "--")) + (define-key map [reconcile] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works)) + (define-key map [reconcile] '(menu-item "Hide Xacts" ledger-occur)) + )) (defun ledger-time-less-p (t1 t2) "Say whether time value T1 is less than time value T2." @@ -133,8 +133,8 @@ Return the difference in the format of a time value." (ledger-iterate-entries (function (lambda (start date mark desc) - (if (ledger-time-less-p moment date) - (throw 'found t))))))) + (if (ledger-time-less-p moment date) + (throw 'found t))))))) (defun ledger-iterate-entries (callback) (goto-char (point-min)) @@ -149,18 +149,18 @@ Return the difference in the format of a time value." (let ((found (match-string 2))) (if found (setq current-year (string-to-number found)) - (let ((start (match-beginning 0)) - (year (match-string 3)) - (month (string-to-number (match-string 4))) - (day (string-to-number (match-string 5))) - (mark (match-string 6)) - (desc (match-string 7))) - (if (and year (> (length year) 0)) - (setq year (string-to-number year))) - (funcall callback start - (encode-time 0 0 0 day month - (or year current-year)) - mark desc))))) + (let ((start (match-beginning 0)) + (year (match-string 3)) + (month (string-to-number (match-string 4))) + (day (string-to-number (match-string 5))) + (mark (match-string 6)) + (desc (match-string 7))) + (if (and year (> (length year) 0)) + (setq year (string-to-number year))) + (funcall callback start + (encode-time 0 0 0 day month + (or year current-year)) + mark desc))))) (forward-line)))) (defun ledger-set-year (newyear) @@ -168,14 +168,14 @@ Return the difference in the format of a time value." (interactive "p") (if (= newyear 1) (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) "Set ledger's idea of the current month to the prefix argument." (interactive "p") (if (= newmonth 1) (setq ledger-month (read-string "Month: " (ledger-current-month))) - (setq ledger-month (format "%02d" newmonth)))) + (setq ledger-month (format "%02d" newmonth)))) (defun ledger-add-entry (entry-text &optional insert-at-point) (interactive (list @@ -202,7 +202,7 @@ Return the difference in the format of a time value." (goto-char (point-min)) (if (looking-at "Error: ") (error (buffer-string)) - (buffer-string))) + (buffer-string))) "\n")))) (defun ledger-current-entry-bounds () diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index 1d7d5cac..3ee48897 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -47,9 +47,9 @@ (require 'ldg-fonts) (require 'ldg-occur) -;(autoload #'ledger-mode "ldg-mode" nil t) -;(autoload #'ledger-fully-complete-entry "ldg-complete" nil t) -;(autoload #'ledger-toggle-current "ldg-state" nil t) + ;(autoload #'ledger-mode "ldg-mode" nil t) + ;(autoload #'ledger-fully-complete-entry "ldg-complete" nil t) + ;(autoload #'ledger-toggle-current "ldg-state" nil t) (autoload #'ledger-texi-update-test "ldg-texi" nil t) (autoload #'ledger-texi-update-examples "ldg-texi" nil t) diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index dc033bf8..411911d9 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -66,16 +66,16 @@ PROMPT is a string to prompt with. CHOICES is a list of strings to choose from." (cond - (ledger-post-use-iswitchb - (let* ((iswitchb-use-virtual-buffers nil) - (iswitchb-make-buflist-hook - (lambda () - (setq iswitchb-temp-buflist choices)))) - (iswitchb-read-buffer prompt))) - (ledger-post-use-ido - (ido-completing-read prompt choices)) - (t - (completing-read prompt choices)))) + (ledger-post-use-iswitchb + (let* ((iswitchb-use-virtual-buffers nil) + (iswitchb-make-buflist-hook + (lambda () + (setq iswitchb-temp-buflist choices)))) + (iswitchb-read-buffer prompt))) + (ledger-post-use-ido + (ido-completing-read prompt choices)) + (t + (completing-read prompt choices)))) (defvar ledger-post-current-list nil) @@ -96,12 +96,12 @@ to choose from." (match-end ledger-regex-post-line-group-account)) (insert account) (cond - ((> existing-len account-len) - (insert (make-string (- existing-len account-len) ? ))) - ((< existing-len account-len) - (dotimes (n (- account-len existing-len)) - (if (looking-at "[ \t]\\( [ \t]\\|\t\\)") - (delete-char 1))))))) + ((> existing-len account-len) + (insert (make-string (- existing-len account-len) ? ))) + ((< existing-len account-len) + (dotimes (n (- account-len existing-len)) + (if (looking-at "[ \t]\\( [ \t]\\|\t\\)") + (delete-char 1))))))) (goto-char pos))) (defun ledger-next-amount (&optional end) @@ -130,12 +130,12 @@ This is done so that the last digit falls in COLUMN, which defaults to 52." (setq adjust (- target-col col)) (if (< col target-col) (insert (make-string (- target-col col) ? )) - (move-to-column target-col) - (if (looking-back " ") - (delete-char (- col target-col)) - (skip-chars-forward "^ \t") - (delete-horizontal-space) - (insert " "))) + (move-to-column target-col) + (if (looking-back " ") + (delete-char (- col target-col)) + (skip-chars-forward "^ \t") + (delete-horizontal-space) + (insert " "))) (forward-line)))))) (defun ledger-post-align-amount () diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el index f2f83937..680063f7 100644 --- a/lisp/ldg-regex.el +++ b/lisp/ldg-regex.el @@ -27,10 +27,10 @@ (defmacro ledger-define-regexp (name regex docs &rest args) "Simplify the creation of a Ledger regex and helper functions." (let ((defs - (list - `(defconst - ,(intern (concat "ledger-" (symbol-name name) "-regexp")) - ,(eval regex)))) + (list + `(defconst + ,(intern (concat "ledger-" (symbol-name name) "-regexp")) + ,(eval regex)))) (addend 0) last-group) (if (null args) (progn @@ -38,82 +38,82 @@ defs (list `(defconst - ,(intern - (concat "ledger-regex-" (symbol-name name) "-group")) + ,(intern + (concat "ledger-regex-" (symbol-name name) "-group")) 1))) (nconc defs (list `(defconst - ,(intern (concat "ledger-regex-" (symbol-name name) - "-group--count")) + ,(intern (concat "ledger-regex-" (symbol-name name) + "-group--count")) 1))) (nconc defs (list `(defmacro - ,(intern (concat "ledger-regex-" (symbol-name name))) - (&optional string) + ,(intern (concat "ledger-regex-" (symbol-name name))) + (&optional string) ,(format "Return the match string for the %s" name) (match-string ,(intern (concat "ledger-regex-" (symbol-name name) "-group")) string))))) - - (dolist (arg args) - (let (var grouping target) - (if (symbolp arg) - (setq var arg target arg) - (assert (listp arg)) - (if (= 2 (length arg)) - (setq var (car arg) - target (cadr arg)) - (setq var (car arg) - grouping (cadr arg) - target (caddr arg)))) - - (if (and last-group - (not (eq last-group (or grouping target)))) - (incf addend - (symbol-value - (intern-soft (concat "ledger-regex-" - (symbol-name last-group) - "-group--count"))))) - (nconc - defs - (list - `(defconst - ,(intern (concat "ledger-regex-" (symbol-name name) - "-group-" (symbol-name var))) - ,(+ addend - (symbol-value - (intern-soft - (if grouping - (concat "ledger-regex-" (symbol-name grouping) - "-group-" (symbol-name target)) - (concat "ledger-regex-" (symbol-name target) - "-group")))))))) - (nconc - defs - (list - `(defmacro - ,(intern (concat "ledger-regex-" (symbol-name name) - "-" (symbol-name var))) - (&optional string) - ,(format "Return the sub-group match for the %s %s." - name var) - (match-string - ,(intern (concat "ledger-regex-" (symbol-name name) - "-group-" (symbol-name var))) - string)))) - - (setq last-group (or grouping target)))) - - (nconc defs - (list - `(defconst ,(intern (concat "ledger-regex-" (symbol-name name) - "-group--count")) - ,(length args))))) + + (dolist (arg args) + (let (var grouping target) + (if (symbolp arg) + (setq var arg target arg) + (assert (listp arg)) + (if (= 2 (length arg)) + (setq var (car arg) + target (cadr arg)) + (setq var (car arg) + grouping (cadr arg) + target (caddr arg)))) + + (if (and last-group + (not (eq last-group (or grouping target)))) + (incf addend + (symbol-value + (intern-soft (concat "ledger-regex-" + (symbol-name last-group) + "-group--count"))))) + (nconc + defs + (list + `(defconst + ,(intern (concat "ledger-regex-" (symbol-name name) + "-group-" (symbol-name var))) + ,(+ addend + (symbol-value + (intern-soft + (if grouping + (concat "ledger-regex-" (symbol-name grouping) + "-group-" (symbol-name target)) + (concat "ledger-regex-" (symbol-name target) + "-group")))))))) + (nconc + defs + (list + `(defmacro + ,(intern (concat "ledger-regex-" (symbol-name name) + "-" (symbol-name var))) + (&optional string) + ,(format "Return the sub-group match for the %s %s." + name var) + (match-string + ,(intern (concat "ledger-regex-" (symbol-name name) + "-group-" (symbol-name var))) + string)))) + + (setq last-group (or grouping target)))) + + (nconc defs + (list + `(defconst ,(intern (concat "ledger-regex-" (symbol-name name) + "-group--count")) + ,(length args))))) (cons 'progn defs))) diff --git a/lisp/ldg-register.el b/lisp/ldg-register.el index 4c397049..adb37a1a 100644 --- a/lisp/ldg-register.el +++ b/lisp/ldg-register.el @@ -37,8 +37,8 @@ :group 'ledger-register) (defface ledger-register-pending-face - '((((background light)) (:weight bold)) - (((background dark)) (:weight bold))) + '((((background light)) (:weight bold)) + (((background dark)) (:weight bold))) "Face used to highlight pending entries in a register report." :group 'ledger-register) @@ -55,9 +55,9 @@ (save-excursion (goto-line (nth 1 post)) (point-marker)) - (save-excursion - (goto-line (nth 0 xact)) - (point-marker))))))) + (save-excursion + (goto-line (nth 0 xact)) + (point-marker))))))) (insert (format ledger-register-line-format (format-time-string ledger-register-date-format (nth 2 post)) @@ -66,8 +66,8 @@ (set-text-properties beg (1- (point)) (list 'face 'ledger-register-pending-face 'where where)) - (set-text-properties beg (1- (point)) - (list 'where where)))) + (set-text-properties beg (1- (point)) + (list 'where where)))) (setq index (1+ index))))) (goto-char (point-min)) ) diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 394c12e7..3b831825 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -39,7 +39,7 @@ the substitution. See the documentation of the individual functions in that variable for more information on the behavior of each specifier." :type '(repeat (list (string :tag "Report Name") - (string :tag "Command Line"))) + (string :tag "Command Line"))) :group 'ledger) (defcustom ledger-report-format-specifiers @@ -73,40 +73,40 @@ text that should replace the format specifier." (defvar ledger-report-mode-abbrev-table) (define-derived-mode ledger-report-mode text-mode "Ledger-Report" - "A mode for viewing ledger reports." - (let ((map (make-sparse-keymap))) - (define-key map [? ] 'scroll-up) - (define-key map [backspace] 'scroll-down) - (define-key map [?r] 'ledger-report-redo) - (define-key map [?s] 'ledger-report-save) - (define-key map [?k] 'ledger-report-kill) - (define-key map [?e] 'ledger-report-edit) - (define-key map [?q] 'ledger-report-quit) - (define-key map [(control ?c) (control ?l) (control ?r)] - 'ledger-report-redo) - (define-key map [(control ?c) (control ?l) (control ?S)] - 'ledger-report-save) - (define-key map [(control ?c) (control ?l) (control ?k)] - 'ledger-report-kill) - (define-key map [(control ?c) (control ?l) (control ?e)] - 'ledger-report-edit) - (define-key map [(control ?c) (control ?c)] 'ledger-report-visit-source) - - - (define-key map [menu-bar] (make-sparse-keymap "ldg-rep")) - (define-key map [menu-bar ldg-rep] (cons "Reports" map)) - - (define-key map [menu-bar ldg-rep lrq] '("Quit" . ledger-report-quit)) - (define-key map [menu-bar ldg-rep s2] '("--")) - (define-key map [menu-bar ldg-rep lrd] '("Scroll Down" . scroll-down)) - (define-key map [menu-bar ldg-rep lru] '("Scroll Up" . scroll-up)) - (define-key map [menu-bar ldg-rep s1] '("--")) - (define-key map [menu-bar ldg-rep lrk] '("Kill Report" . ledger-report-kill)) - (define-key map [menu-bar ldg-rep lrr] '("Re-run Report" . ledger-report-redo)) - (define-key map [menu-bar ldg-rep lre] '("Edit Report" . ledger-report-edit)) - (define-key map [menu-bar ldg-rep lrs] '("Save Report" . ledger-report-save)) - - (use-local-map map))) + "A mode for viewing ledger reports." + (let ((map (make-sparse-keymap))) + (define-key map [? ] 'scroll-up) + (define-key map [backspace] 'scroll-down) + (define-key map [?r] 'ledger-report-redo) + (define-key map [?s] 'ledger-report-save) + (define-key map [?k] 'ledger-report-kill) + (define-key map [?e] 'ledger-report-edit) + (define-key map [?q] 'ledger-report-quit) + (define-key map [(control ?c) (control ?l) (control ?r)] + 'ledger-report-redo) + (define-key map [(control ?c) (control ?l) (control ?S)] + 'ledger-report-save) + (define-key map [(control ?c) (control ?l) (control ?k)] + 'ledger-report-kill) + (define-key map [(control ?c) (control ?l) (control ?e)] + 'ledger-report-edit) + (define-key map [(control ?c) (control ?c)] 'ledger-report-visit-source) + + + (define-key map [menu-bar] (make-sparse-keymap "ldg-rep")) + (define-key map [menu-bar ldg-rep] (cons "Reports" map)) + + (define-key map [menu-bar ldg-rep lrq] '("Quit" . ledger-report-quit)) + (define-key map [menu-bar ldg-rep s2] '("--")) + (define-key map [menu-bar ldg-rep lrd] '("Scroll Down" . scroll-down)) + (define-key map [menu-bar ldg-rep lru] '("Scroll Up" . scroll-up)) + (define-key map [menu-bar ldg-rep s1] '("--")) + (define-key map [menu-bar ldg-rep lrk] '("Kill Report" . ledger-report-kill)) + (define-key map [menu-bar ldg-rep lrr] '("Re-run Report" . ledger-report-redo)) + (define-key map [menu-bar ldg-rep lre] '("Edit Report" . ledger-report-edit)) + (define-key map [menu-bar ldg-rep lrs] '("Save Report" . ledger-report-save)) + + (use-local-map map))) (defun ledger-report-read-name () "Read the name of a ledger report to use, with completion. @@ -201,13 +201,13 @@ 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 (expand-file-name ledger-master-file) - (buffer-file-name))) + (buffer-file-name))) (defun ledger-read-string-with-default (prompt default) (let ((default-prompt (concat prompt (if default (concat " (" default "): ") - ": ")))) + ": ")))) (read-string default-prompt nil nil default))) (defun ledger-report-payee-format-specifier () @@ -234,7 +234,7 @@ the default." (default (if (eq (ledger-context-line-type context) 'acct-transaction) (regexp-quote (ledger-context-field-value context 'account)) - nil))) + nil))) (ledger-read-string-with-default "Account" default))) (defun ledger-report-expand-format-specifiers (report-cmd) @@ -248,9 +248,9 @@ the default." (with-current-buffer ledger-buf (shell-quote-argument (funcall f)))) t t expanded-cmd)) - (progn - (set-window-configuration ledger-original-window-cfg) - (error "Invalid ledger report format specifier '%s'" specifier))))) + (progn + (set-window-configuration ledger-original-window-cfg) + (error "Invalid ledger report format specifier '%s'" specifier))))) expanded-cmd)) (defun ledger-report-cmd (report-name edit) @@ -280,12 +280,12 @@ the default." (shell-command (if register-report (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) (let ((file (match-string 1)) - (line (string-to-number (match-string 2)))) + (line (string-to-number (match-string 2)))) (delete-region (match-beginning 0) (match-end 0)) (set-text-properties (line-beginning-position) (line-end-position) (list 'ledger-source (cons file (save-window-excursion @@ -307,14 +307,14 @@ the default." (widen) (if (markerp line-or-marker) (goto-char line-or-marker) - (goto-char (point-min)) - (forward-line (1- line-or-marker)) - (re-search-backward "^[0-9]+") - (beginning-of-line) - (let ((start-of-txn (point))) - (forward-paragraph) - (narrow-to-region start-of-txn (point)) - (backward-paragraph)))))) + (goto-char (point-min)) + (forward-line (1- line-or-marker)) + (re-search-backward "^[0-9]+") + (beginning-of-line) + (let ((start-of-txn (point))) + (forward-paragraph) + (narrow-to-region start-of-txn (point)) + (backward-paragraph)))))) (defun ledger-report-goto () "Goto the ledger report buffer." @@ -487,7 +487,7 @@ specified line, returns nil." (let ((left (forward-line offset))) (if (not (equal left 0)) nil - (ledger-context-at-point))))) + (ledger-context-at-point))))) (defun ledger-context-line-type (context-info) (nth 0 context-info)) @@ -525,6 +525,6 @@ specified line, returns nil." (let ((context-info (ledger-context-other-line i))) (if (eq (ledger-context-line-type context-info) 'entry) (ledger-context-field-value context-info 'payee) - nil)))) + nil)))) (provide 'ldg-report) diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el index 9cecefa4..86e3fa0a 100644 --- a/lisp/ldg-sort.el +++ b/lisp/ldg-sort.el @@ -23,11 +23,11 @@ ;; the form YYYY/mm/dd. (defun ledger-next-record-function () - (if (re-search-forward - (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" - "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t) - (goto-char (match-beginning 0)) - (goto-char (point-max)))) + (if (re-search-forward + (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" + "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max)))) (defun ledger-end-record-function () (forward-paragraph)) @@ -42,7 +42,7 @@ (setq new-beg (point)) (goto-char end) (ledger-next-record-function) ;make sure end of region is at the beginning of - ;next record after the region + ;next record after the region (setq new-end (point)) (narrow-to-region beg end) (goto-char (point-min)) @@ -55,7 +55,7 @@ (defun ledger-sort-buffer () (interactive) - (ledger-sort-region (point-min) (point-max))) + (ledger-sort-region (point-min) (point-max))) (provide 'ldg-sort) \ No newline at end of file diff --git a/lisp/ldg-state.el b/lisp/ldg-state.el index 03017b25..41c0d8f2 100644 --- a/lisp/ldg-state.el +++ b/lisp/ldg-state.el @@ -28,9 +28,9 @@ (if (not (null state)) (if (and style (eq style 'cleared)) 'cleared) - (if (and style (eq style 'pending)) - 'pending - 'cleared))) + (if (and style (eq style 'pending)) + 'pending + 'cleared))) (defun ledger-entry-state () (save-excursion @@ -106,23 +106,23 @@ dropped." (progn (insert "* ") (setq inserted t))) - (if (and style (eq style 'pending)) - (progn - (insert "! ") - (setq inserted t)) - (progn - (insert "* ") - (setq inserted t)))) + (if (and style (eq style 'pending)) + (progn + (insert "! ") + (setq inserted t)) + (progn + (insert "* ") + (setq inserted t)))) (if (and inserted (re-search-forward "\\(\t\\| [ \t]\\)" (line-end-position) t)) (cond - ((looking-at "\t") - (delete-char 1)) - ((looking-at " [ \t]") - (delete-char 2)) - ((looking-at " ") - (delete-char 1)))) + ((looking-at "\t") + (delete-char 1)) + ((looking-at " [ \t]") + (delete-char 2)) + ((looking-at " ") + (delete-char 1)))) (setq clear inserted))))) ;; Clean up the entry so that it displays minimally (save-excursion @@ -135,12 +135,12 @@ dropped." (skip-chars-forward " \t") (let ((cleared (if (member (char-after) '(?\* ?\!)) (char-after) - ? ))) + ? ))) (if first (setq state cleared first nil) - (if (/= state cleared) - (setq hetero t)))) + (if (/= state cleared) + (setq hetero t)))) (forward-line)) (when (and (not hetero) (/= state ? )) (goto-char (car bounds)) @@ -162,12 +162,12 @@ dropped." (if (re-search-forward "\\(\t\\| [ \t]\\)" (line-end-position) t) (cond - ((looking-at "\t") - (delete-char 1)) - ((looking-at " [ \t]") - (delete-char 2)) - ((looking-at " ") - (delete-char 1))))))) + ((looking-at "\t") + (delete-char 1)) + ((looking-at " [ \t]") + (delete-char 2)) + ((looking-at " ") + (delete-char 1))))))) clear)) (defun ledger-toggle-current (&optional style) @@ -186,7 +186,7 @@ dropped." (forward-line) (goto-char (line-beginning-position)))) (ledger-toggle-current-entry style)) - (ledger-toggle-current-transaction style))) + (ledger-toggle-current-transaction style))) (defun ledger-toggle-current-entry (&optional style) (interactive) @@ -201,10 +201,10 @@ dropped." (delete-char 1) (if (and style (eq style 'cleared)) (insert " *"))) - (if (and style (eq style 'pending)) - (insert " ! ") - (insert " * ")) - (setq clear t)))) + (if (and style (eq style 'pending)) + (insert " ! ") + (insert " * ")) + (setq clear t)))) clear)) (provide 'ldg-state) diff --git a/lisp/ldg-test.el b/lisp/ldg-test.el index 2036ea7b..7667a05e 100644 --- a/lisp/ldg-test.el +++ b/lisp/ldg-test.el @@ -67,9 +67,9 @@ (ledger-mode) (if input (insert input) - (insert "2012-03-17 Payee\n") - (insert " Expenses:Food $20\n") - (insert " Assets:Cash\n")) + (insert "2012-03-17 Payee\n") + (insert " Expenses:Food $20\n") + (insert " Assets:Cash\n")) (insert "\ntest reg\n") (if output (insert output)) @@ -90,7 +90,7 @@ (let ((prev-directory default-directory)) (cd ledger-source-directory) (unwind-protect - (async-shell-command (format "\"%s\" %s" command args)) + (async-shell-command (format "\"%s\" %s" command args)) (cd prev-directory))))))) (provide 'ldg-test) diff --git a/lisp/ldg-texi.el b/lisp/ldg-texi.el index fefa7d2b..53e050ce 100644 --- a/lisp/ldg-texi.el +++ b/lisp/ldg-texi.el @@ -94,17 +94,17 @@ (if (string-match "\\$LEDGER" command) (replace-match (format "%s -f \"%s\" %s" ledger-path data-file ledger-normalization-args) t t command) - (concat (format "%s -f \"%s\" %s " ledger-path - data-file ledger-normalization-args) command))) + (concat (format "%s -f \"%s\" %s " ledger-path + data-file ledger-normalization-args) command))) (defun ledger-texi-invoke-command (command) (with-temp-buffer (shell-command command t (current-buffer)) - (if (= (point-min) (point-max)) - (progn - (push-mark nil t) - (message "Command '%s' yielded no result at %d" command (point)) - (ding)) - (buffer-string)))) + (if (= (point-min) (point-max)) + (progn + (push-mark nil t) + (message "Command '%s' yielded no result at %d" command (point)) + (ding)) + (buffer-string)))) (defun ledger-texi-write-test-data (name input) (let ((path (expand-file-name name temporary-file-directory))) @@ -149,7 +149,7 @@ (let ((section-name (if (string= section "smex") "smallexample" - "example")) + "example")) (output (ledger-texi-invoke-command (ledger-texi-expand-command command data-file)))) (insert "@" section-name ?\n output -- cgit v1.2.3 From 867b84c52ea13563d0b507ae0756898cb416ef45 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 7 Feb 2013 11:30:34 -0700 Subject: code formatting cleanup. --- lisp/ldg-report.el | 68 +++++++++++++++++++++++++++--------------------------- 1 file changed, 34 insertions(+), 34 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 3b831825..cdef6ded 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -73,40 +73,40 @@ text that should replace the format specifier." (defvar ledger-report-mode-abbrev-table) (define-derived-mode ledger-report-mode text-mode "Ledger-Report" - "A mode for viewing ledger reports." - (let ((map (make-sparse-keymap))) - (define-key map [? ] 'scroll-up) - (define-key map [backspace] 'scroll-down) - (define-key map [?r] 'ledger-report-redo) - (define-key map [?s] 'ledger-report-save) - (define-key map [?k] 'ledger-report-kill) - (define-key map [?e] 'ledger-report-edit) - (define-key map [?q] 'ledger-report-quit) - (define-key map [(control ?c) (control ?l) (control ?r)] - 'ledger-report-redo) - (define-key map [(control ?c) (control ?l) (control ?S)] - 'ledger-report-save) - (define-key map [(control ?c) (control ?l) (control ?k)] - 'ledger-report-kill) - (define-key map [(control ?c) (control ?l) (control ?e)] - 'ledger-report-edit) - (define-key map [(control ?c) (control ?c)] 'ledger-report-visit-source) - - - (define-key map [menu-bar] (make-sparse-keymap "ldg-rep")) - (define-key map [menu-bar ldg-rep] (cons "Reports" map)) - - (define-key map [menu-bar ldg-rep lrq] '("Quit" . ledger-report-quit)) - (define-key map [menu-bar ldg-rep s2] '("--")) - (define-key map [menu-bar ldg-rep lrd] '("Scroll Down" . scroll-down)) - (define-key map [menu-bar ldg-rep lru] '("Scroll Up" . scroll-up)) - (define-key map [menu-bar ldg-rep s1] '("--")) - (define-key map [menu-bar ldg-rep lrk] '("Kill Report" . ledger-report-kill)) - (define-key map [menu-bar ldg-rep lrr] '("Re-run Report" . ledger-report-redo)) - (define-key map [menu-bar ldg-rep lre] '("Edit Report" . ledger-report-edit)) - (define-key map [menu-bar ldg-rep lrs] '("Save Report" . ledger-report-save)) - - (use-local-map map))) + "A mode for viewing ledger reports." + (let ((map (make-sparse-keymap))) + (define-key map [? ] 'scroll-up) + (define-key map [backspace] 'scroll-down) + (define-key map [?r] 'ledger-report-redo) + (define-key map [?s] 'ledger-report-save) + (define-key map [?k] 'ledger-report-kill) + (define-key map [?e] 'ledger-report-edit) + (define-key map [?q] 'ledger-report-quit) + (define-key map [(control ?c) (control ?l) (control ?r)] + 'ledger-report-redo) + (define-key map [(control ?c) (control ?l) (control ?S)] + 'ledger-report-save) + (define-key map [(control ?c) (control ?l) (control ?k)] + 'ledger-report-kill) + (define-key map [(control ?c) (control ?l) (control ?e)] + 'ledger-report-edit) + (define-key map [(control ?c) (control ?c)] 'ledger-report-visit-source) + + + (define-key map [menu-bar] (make-sparse-keymap "ldg-rep")) + (define-key map [menu-bar ldg-rep] (cons "Reports" map)) + + (define-key map [menu-bar ldg-rep lrq] '("Quit" . ledger-report-quit)) + (define-key map [menu-bar ldg-rep s2] '("--")) + (define-key map [menu-bar ldg-rep lrd] '("Scroll Down" . scroll-down)) + (define-key map [menu-bar ldg-rep lru] '("Scroll Up" . scroll-up)) + (define-key map [menu-bar ldg-rep s1] '("--")) + (define-key map [menu-bar ldg-rep lrk] '("Kill Report" . ledger-report-kill)) + (define-key map [menu-bar ldg-rep lrr] '("Re-run Report" . ledger-report-redo)) + (define-key map [menu-bar ldg-rep lre] '("Edit Report" . ledger-report-edit)) + (define-key map [menu-bar ldg-rep lrs] '("Save Report" . ledger-report-save)) + + (use-local-map map))) (defun ledger-report-read-name () "Read the name of a ledger report to use, with completion. -- cgit v1.2.3 From e3b37ac19edfa5ff8e766258f38d1632b667848e Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 12 Feb 2013 10:35:27 -0700 Subject: Lisp code cleanup. Mostly went through and clarified variable names. Rather than "entry" for everything, use "transaction" and "posting" as appropriate to improve readability. --- lisp/ldg-complete.el | 28 +++++++++++++++------------- lisp/ldg-mode.el | 26 +++++++++++++------------- lisp/ldg-new.el | 4 ---- lisp/ldg-post.el | 5 ++--- lisp/ldg-reconcile.el | 23 ++++++++++++++++++++--- lisp/ldg-register.el | 2 +- lisp/ldg-report.el | 2 +- lisp/ldg-state.el | 16 ++++++++-------- 8 files changed, 60 insertions(+), 46 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index 996df558..b56a85ed 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -30,10 +30,10 @@ (goto-char (line-beginning-position)) (cond ((looking-at "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+") (goto-char (match-end 0)) - 'entry) + 'transaction) ((looking-at "^\\s-+\\([*!]\\s-+\\)?[[(]?\\(.\\)") (goto-char (match-beginning 2)) - 'transaction) + 'posting) ((looking-at "^\\(sun\\|mon\\|tue\\|wed\\|thu\\|fri\\|sat\\)\\s-+") (goto-char (match-end 0)) 'entry) @@ -57,24 +57,26 @@ args))) (cons (reverse args) (reverse begins))))) -(defun ledger-entries () +(defun ledger-payees () (let ((origin (point)) - entries-list) + payees-list) (save-excursion (goto-char (point-min)) (while (re-search-forward (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" - "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t) + "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t) ;matches first line of transaction (unless (and (>= origin (match-beginning 0)) (< origin (match-end 0))) - (setq entries-list (cons (match-string-no-properties 3) - entries-list))))) - (pcomplete-uniqify-list (nreverse entries-list)))) + (setq payees-list (cons (match-string-no-properties 3) + payees-list))))) ;add the payee to the list + (pcomplete-uniqify-list (nreverse payees-list)))) (defvar ledger-account-tree nil) (defun ledger-find-accounts () - (let ((origin (point)) account-path elements) + (let ((origin (point)) + account-path + elements) (save-excursion (setq ledger-account-tree (list t)) (goto-char (point-min)) @@ -126,16 +128,16 @@ (interactive) (while (pcomplete-here (if (eq (save-excursion - (ledger-thing-at-point)) 'entry) + (ledger-thing-at-point)) 'transaction) (if (null current-prefix-arg) - (ledger-entries) ; this completes against entry names + (ledger-payees) ; this completes against payee names (progn (let ((text (buffer-substring (line-beginning-position) (line-end-position)))) (delete-region (line-beginning-position) (line-end-position)) (condition-case err - (ledger-add-entry text t) + (ledger-add-transaction text t) ((error) (insert text)))) (forward-line) @@ -151,7 +153,7 @@ (let ((name (caar (ledger-parse-arguments))) xacts) (save-excursion - (when (eq 'entry (ledger-thing-at-point)) + (when (eq 'transaction (ledger-thing-at-point)) (when (re-search-backward (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" (regexp-quote name) "\\(\t\\|\n\\| [ \t]\\)") nil t) diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 0ff22417..628b4b8a 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -70,8 +70,8 @@ customizable to ease retro-entry.") (make-variable-buffer-local 'highlight-overlay) (let ((map (current-local-map))) - (define-key map [(control ?c) (control ?a)] 'ledger-add-entry) - (define-key map [(control ?c) (control ?d)] 'ledger-delete-current-entry) + (define-key map [(control ?c) (control ?a)] 'ledger-add-transaction) + (define-key map [(control ?c) (control ?d)] 'ledger-delete-current-transaction) (define-key map [(control ?c) (control ?y)] 'ledger-set-year) (define-key map [(control ?c) (control ?m)] 'ledger-set-month) (define-key map [(control ?c) (control ?c)] 'ledger-toggle-current) @@ -119,8 +119,8 @@ customizable to ease retro-entry.") (define-key map [sep4] '(menu-item "--")) (define-key map [edit-amount] '(menu-item "Calc on Amount" ledger-post-edit-amount)) (define-key map [sep] '(menu-item "--")) - (define-key map [delete-xact] '(menu-item "Delete Entry" ledger-delete-current-entry)) - (define-key map [add-xact] '(menu-item "Add Entry" ledger-add-entry :enable ledger-works)) + (define-key map [delete-xact] '(menu-item "Delete Entry" ledger-delete-current-transaction)) + (define-key map [add-xact] '(menu-item "Add Transaction" ledger-add-transaction :enable ledger-works)) (define-key map [sep3] '(menu-item "--")) (define-key map [reconcile] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works)) (define-key map [reconcile] '(menu-item "Hide Xacts" ledger-occur)))) @@ -140,13 +140,13 @@ Return the difference in the format of a time value." (defun ledger-find-slot (moment) (catch 'found - (ledger-iterate-entries + (ledger-iterate-transactions (function (lambda (start date mark desc) (if (ledger-time-less-p moment date) (throw 'found t))))))) -(defun ledger-iterate-entries (callback) +(defun ledger-iterate-transactions (callback) (goto-char (point-min)) (let* ((now (current-time)) (current-year (nth 5 (decode-time now)))) @@ -187,11 +187,11 @@ Return the difference in the format of a time value." (setq ledger-month (read-string "Month: " (ledger-current-month))) (setq ledger-month (format "%02d" newmonth)))) -(defun ledger-add-entry (entry-text &optional insert-at-point) +(defun ledger-add-transaction (transaction-text &optional insert-at-point) (interactive (list - (read-string "Entry: " (concat ledger-year "/" ledger-month "/")))) + (read-string "Transaction: " (concat ledger-year "/" ledger-month "/")))) (let* ((args (with-temp-buffer - (insert entry-text) + (insert transaction-text) (eshell-parse-arguments (point-min) (point-max)))) (ledger-buf (current-buffer)) exit-code) @@ -208,7 +208,7 @@ Return the difference in the format of a time value." (insert (with-temp-buffer (setq exit-code - (apply #'ledger-exec-ledger ledger-buf ledger-buf "entry" + (apply #'ledger-exec-ledger ledger-buf ledger-buf "xact" (mapcar 'eval args))) (goto-char (point-min)) (if (looking-at "Error: ") @@ -219,7 +219,7 @@ Return the difference in the format of a time value." (insert (car args) " \n\n") (end-of-line -1))))) -(defun ledger-current-entry-bounds () +(defun ledger-current-transaction-bounds () (save-excursion (when (or (looking-at "^[0-9]") (re-search-backward "^[0-9]" nil t)) @@ -228,9 +228,9 @@ Return the difference in the format of a time value." (forward-line)) (cons (copy-marker beg) (point-marker)))))) -(defun ledger-delete-current-entry () +(defun ledger-delete-current-transaction () (interactive) - (let ((bounds (ledger-current-entry-bounds))) + (let ((bounds (ledger-current-transaction-bounds))) (delete-region (car bounds) (cdr bounds)))) (provide 'ldg-mode) diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index 3ee48897..ad21564a 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -47,10 +47,6 @@ (require 'ldg-fonts) (require 'ldg-occur) - ;(autoload #'ledger-mode "ldg-mode" nil t) - ;(autoload #'ledger-fully-complete-entry "ldg-complete" nil t) - ;(autoload #'ledger-toggle-current "ldg-state" nil t) - (autoload #'ledger-texi-update-test "ldg-texi" nil t) (autoload #'ledger-texi-update-examples "ldg-texi" nil t) diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index ff664b1d..7b6ac9d5 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -158,7 +158,7 @@ This is done so that the last digit falls in COLUMN, which defaults to 52." (goto-char (line-beginning-position)) (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))) ;determine if the is an amount to edit + (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))) (goto-char (match-beginning 0)) @@ -171,8 +171,7 @@ This is done so that the last digit falls in COLUMN, which defaults to 52." (if (search-backward " " (- (point) 3) t) (goto-char (line-end-position)) (insert " ")) - (calc)) - )))) + (calc)))))) (defun ledger-post-prev-xact () (interactive) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index d59185b1..6179428f 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -119,7 +119,7 @@ (defun ledger-reconcile-add () (interactive) (with-current-buffer ledger-buf - (call-interactively #'ledger-add-entry)) + (call-interactively #'ledger-add-transaction)) (ledger-reconcile-refresh)) (defun ledger-reconcile-delete () @@ -128,7 +128,7 @@ (when (ledger-reconcile-get-buffer where) (with-current-buffer (ledger-reconcile-get-buffer where) (goto-char (cdr where)) - (ledger-delete-current-entry)) + (ledger-delete-current-transaction)) (let ((inhibit-read-only t)) (goto-char (line-beginning-position)) (delete-region (point) (1+ (line-end-position))) @@ -159,6 +159,23 @@ (set-buffer-modified-p nil) (ledger-display-balance)) +(defun ledger-reconcile-finish () + "Mark all pending transactions as cleared, save the buffers and exit reconcile mode" + (interactive) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let ((where (get-text-property (point) 'where)) + (face (get-text-property (point) 'face))) + (if (and (eq face 'bold) + (when (is-stdin (car where)))) + (with-current-buffer ledger-buf + (goto-char (cdr where)) + (ledger-toggle-current 'cleared)))) + (forward-line 1))) + (ledger-reconcile-save)) + + (defun ledger-reconcile-quit () (interactive) (ledger-reconcile-quit-cleanup) @@ -191,7 +208,7 @@ (cons buf (save-excursion - (if ledger-clear-whole-entries + (if ledger-clear-whole-transactions (goto-line (nth 1 emacs-xact)) (goto-line (nth 0 posting))) (1+ (point-marker))))))) ;Add 1 to make sure the marker is within the transaction diff --git a/lisp/ldg-register.el b/lisp/ldg-register.el index adb37a1a..6e98f20d 100644 --- a/lisp/ldg-register.el +++ b/lisp/ldg-register.el @@ -51,7 +51,7 @@ (with-current-buffer data-buffer (cons (nth 0 post) - (if ledger-clear-whole-entries + (if ledger-clear-whole-transactions (save-excursion (goto-line (nth 1 post)) (point-marker)) diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index cdef6ded..2bb83516 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -216,7 +216,7 @@ end of a ledger file which is included in some other file." 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 default." - ;; It is intended copmletion should be available on existing + ;; It is intended completion should be available on existing ;; payees, but the list of possible completions needs to be ;; developed to allow this. (ledger-read-string-with-default "Payee" (regexp-quote (ledger-entry-payee)))) diff --git a/lisp/ldg-state.el b/lisp/ldg-state.el index 41c0d8f2..ac0511f8 100644 --- a/lisp/ldg-state.el +++ b/lisp/ldg-state.el @@ -19,8 +19,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; MA 02111-1307, USA. -(defcustom ledger-clear-whole-entries nil - "If non-nil, clear whole entries, not individual transactions." +(defcustom ledger-clear-whole-transactions nil + "If non-nil, clear whole transactions, not individual postings." :type 'boolean :group 'ledger) @@ -32,7 +32,7 @@ 'pending 'cleared))) -(defun ledger-entry-state () +(defun ledger-transaction-state () (save-excursion (when (or (looking-at "^[0-9]") (re-search-backward "^[0-9]" nil t)) @@ -42,13 +42,13 @@ ((looking-at "\\*\\s-*") 'cleared) (t nil))))) -(defun ledger-transaction-state () +(defun ledger-posting-state () (save-excursion (goto-char (line-beginning-position)) (skip-syntax-forward " ") (cond ((looking-at "!\\s-*") 'pending) ((looking-at "\\*\\s-*") 'cleared) - (t (ledger-entry-state))))) + (t (ledger-transaction-state))))) (defun ledger-toggle-current-transaction (&optional style) "Toggle the cleared status of the transaction under point. @@ -172,15 +172,15 @@ dropped." (defun ledger-toggle-current (&optional style) (interactive) - (if (or ledger-clear-whole-entries - (eq 'entry (ledger-thing-at-point))) + (if (or ledger-clear-whole-transactions + (eq 'transaction (ledger-thing-at-point))) (progn (save-excursion (forward-line) (goto-char (line-beginning-position)) (while (and (not (eolp)) (save-excursion - (not (eq 'entry (ledger-thing-at-point))))) + (not (eq 'transaction (ledger-thing-at-point))))) (if (looking-at "\\s-+[*!]") (ledger-toggle-current-transaction nil)) (forward-line) -- cgit v1.2.3 From 6315c60e43e62397a8c5396ea1f591b61ea6fcdb Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 13 Feb 2013 12:34:09 -0700 Subject: Correct behavior of ledger report when entering a new report ledger-report-save would fail if you entered a new report with a name. It wouldn't save the customization to the disk, and if you tried to save manually it would complain about an identical command. --- lisp/ldg-report.el | 53 +++++++++++++++++++++++++---------------------------- lisp/ldg-xact.el | 11 +++++++++++ 2 files changed, 36 insertions(+), 28 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 2bb83516..552aebc0 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -69,6 +69,7 @@ text that should replace the format specifier." (defvar ledger-report-name-prompt-history nil) (defvar ledger-report-cmd-prompt-history nil) (defvar ledger-original-window-cfg nil) +(defvar ledger-report-saved nil) (defvar ledger-report-mode-abbrev-table) @@ -146,6 +147,7 @@ used to generate the buffer, navigating the buffer, etc." (with-current-buffer (pop-to-buffer (get-buffer-create ledger-report-buffer-name)) (ledger-report-mode) + (set (make-local-variable 'ledger-report-saved) nil) (set (make-local-variable 'ledger-buf) buf) (set (make-local-variable 'ledger-report-name) report-name) (set (make-local-variable 'ledger-original-window-cfg) wcfg) @@ -219,7 +221,7 @@ default." ;; It is intended completion should be available on existing ;; payees, but the list of possible completions needs to be ;; developed to allow this. - (ledger-read-string-with-default "Payee" (regexp-quote (ledger-entry-payee)))) + (ledger-read-string-with-default "Payee" (regexp-quote (ledger-xact-payee)))) (defun ledger-report-account-format-specifier () "Substitute an account name @@ -258,13 +260,15 @@ the default." (let ((report-cmd (car (cdr (assoc report-name ledger-reports))))) ;; logic for substitution goes here (when (or (null report-cmd) edit) - (setq report-cmd (ledger-report-read-command report-cmd))) + (setq report-cmd (ledger-report-read-command report-cmd)) + (setq ledger-report-saved nil)) ;; this is a new report, or edited report (setq report-cmd (ledger-report-expand-format-specifiers report-cmd)) (set (make-local-variable 'ledger-report-cmd) report-cmd) (or (string-empty-p report-name) (ledger-report-name-exists report-name) - (ledger-reports-add report-name report-cmd) - (ledger-reports-custom-save)) + (progn + (ledger-reports-add report-name report-cmd) + (ledger-reports-custom-save))) report-cmd)) (defun ledger-do-report (cmd) @@ -368,20 +372,23 @@ the default." (when (string-empty-p ledger-report-name) (setq ledger-report-name (ledger-report-read-new-name))) - (while (setq existing-name (ledger-report-name-exists ledger-report-name)) - (cond ((y-or-n-p (format "Overwrite existing report named '%s' " - ledger-report-name)) - (when (string-equal - ledger-report-cmd - (car (cdr (assq existing-name ledger-reports)))) - (error "Current command is identical to existing saved one")) - (setq ledger-reports - (assq-delete-all existing-name ledger-reports))) - (t - (setq ledger-report-name (ledger-report-read-new-name))))) - - (ledger-reports-add ledger-report-name ledger-report-cmd) - (ledger-reports-custom-save))) + (if (setq existing-name (ledger-report-name-exists ledger-report-name)) + (cond ((y-or-n-p (format "Overwrite existing report named '%s' " + ledger-report-name)) + (if (string-equal + ledger-report-cmd + (car (cdr (assq existing-name ledger-reports)))) + (message "Nothing to save. Current command is identical to existing saved one") + (progn + (setq ledger-reports + (assq-delete-all existing-name ledger-reports)) + (ledger-reports-add ledger-report-name ledger-report-cmd) + (ledger-reports-custom-save)))) + (t + (progn + (setq ledger-report-name (ledger-report-read-new-name)) + (ledger-reports-add ledger-report-name ledger-report-cmd) + (ledger-reports-custom-save))))))) (defconst ledger-line-config '((entry @@ -517,14 +524,4 @@ specified line, returns nil." (defun ledger-context-goto-field-end (context-info field-name) (goto-char (ledger-context-field-end-position context-info field-name))) -(defun ledger-entry-payee () - "Returns 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))) - (let ((context-info (ledger-context-other-line i))) - (if (eq (ledger-context-line-type context-info) 'entry) - (ledger-context-field-value context-info 'payee) - nil)))) - (provide 'ldg-report) diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index e7402652..ab2c34f4 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -64,4 +64,15 @@ (overlay-put ovl 'face 'ledger-font-highlight-face) (overlay-put ovl 'priority 100)))) +(defun ledger-xact-payee () + "Returns 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))) + (let ((context-info (ledger-context-other-line i))) + (if (eq (ledger-context-line-type context-info) 'entry) + (ledger-context-field-value context-info 'payee) + nil)))) + + (provide 'ldg-xact) \ No newline at end of file -- cgit v1.2.3 From 1074dec8adc3e4d04b3a9a370b787bd8144fa3fc Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 14 Feb 2013 09:49:00 -0700 Subject: Improved ledger-report visit source capabilities --- lisp/ldg-report.el | 91 ++++++++++++++++++++++++++++-------------------------- 1 file changed, 48 insertions(+), 43 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 552aebc0..7f053ce3 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -100,6 +100,7 @@ text that should replace the format specifier." (define-key map [menu-bar ldg-rep lrq] '("Quit" . ledger-report-quit)) (define-key map [menu-bar ldg-rep s2] '("--")) (define-key map [menu-bar ldg-rep lrd] '("Scroll Down" . scroll-down)) + (define-key map [menu-bar ldg-rep vis] '("Visit Source" . ledger-report-visit-source)) (define-key map [menu-bar ldg-rep lru] '("Scroll Up" . scroll-up)) (define-key map [menu-bar ldg-rep s1] '("--")) (define-key map [menu-bar ldg-rep lrk] '("Kill Report" . ledger-report-kill)) @@ -240,20 +241,19 @@ the default." (ledger-read-string-with-default "Account" default))) (defun ledger-report-expand-format-specifiers (report-cmd) - (let ((expanded-cmd report-cmd)) - (while (string-match "%(\\([^)]*\\))" expanded-cmd) - (let* ((specifier (match-string 1 expanded-cmd)) - (f (cdr (assoc specifier ledger-report-format-specifiers)))) - (if f - (setq expanded-cmd (replace-match - (save-match-data - (with-current-buffer ledger-buf - (shell-quote-argument (funcall f)))) - t t expanded-cmd)) - (progn - (set-window-configuration ledger-original-window-cfg) - (error "Invalid ledger report format specifier '%s'" specifier))))) - expanded-cmd)) + (save-match-data + (let ((expanded-cmd report-cmd)) + (set-match-data (list 0 0)) + (while (string-match "%(\\([^)]*\\))" expanded-cmd (match-end 0)) + (let* ((specifier (match-string 1 expanded-cmd)) + (f (cdr (assoc specifier ledger-report-format-specifiers)))) + (if f + (setq expanded-cmd (replace-match + (save-match-data + (with-current-buffer ledger-buf + (shell-quote-argument (funcall f)))) + t t expanded-cmd))))) + expanded-cmd))) (defun ledger-report-cmd (report-name edit) "Get the command line to run the report." @@ -280,45 +280,50 @@ the default." "\n\n") (let ((data-pos (point)) (register-report (string-match " reg\\(ister\\)? " cmd)) - files-in-report) + files-in-report) (shell-command - (if register-report - (concat cmd " --prepend-format='%(filename):%(beg_line):'") + ;; subtotal doe not produce identifiable transactions, so don't + ;; prepend location information for them + (if (and register-report + (not (string-match "--subtotal" cmd))) + (concat cmd " --prepend-format='%(filename):%(beg_line):'") cmd) t nil) (when register-report (goto-char data-pos) - (while (re-search-forward "^\\([^:]+\\)?:\\([0-9]+\\)?:" nil t) - (let ((file (match-string 1)) + (while (re-search-forward "^\\(/[^:]+\\)?:\\([0-9]+\\)?:" nil t) + (let ((file (match-string 1)) (line (string-to-number (match-string 2)))) - (delete-region (match-beginning 0) (match-end 0)) - (set-text-properties (line-beginning-position) (line-end-position) - (list 'ledger-source (cons file (save-window-excursion - (save-excursion - (find-file file) - (widen) - (goto-char (point-min)) - (forward-line (1- line)) - (point-marker)))))) - (end-of-line)))) + (delete-region (match-beginning 0) (match-end 0)) + (set-text-properties (line-beginning-position) (line-end-position) + (list 'ledger-source (cons file (save-window-excursion + (save-excursion + (find-file file) + (widen) + (ledger-goto-line line) + (point-marker)))))) + (end-of-line)))) (goto-char data-pos))) (defun ledger-report-visit-source () (interactive) - (let ((prop (get-text-property (point) 'ledger-source))) - (destructuring-bind (file . line-or-marker) prop - (find-file-other-window file) - (widen) - (if (markerp line-or-marker) - (goto-char line-or-marker) - (goto-char (point-min)) - (forward-line (1- line-or-marker)) - (re-search-backward "^[0-9]+") - (beginning-of-line) - (let ((start-of-txn (point))) - (forward-paragraph) - (narrow-to-region start-of-txn (point)) - (backward-paragraph)))))) + (let* ((prop (get-text-property (point) 'ledger-source)) + (file (if prop (car prop))) + (line-or-marker (if prop (cdr prop)))) + (if (and file line-or-marker) + (progn + (find-file-other-window file) + (widen) + (if (markerp line-or-marker) + (goto-char line-or-marker) + (goto-char (point-min)) + (forward-line (1- line-or-marker)) + (re-search-backward "^[0-9]+") + (beginning-of-line) + (let ((start-of-txn (point))) + (forward-paragraph) + (narrow-to-region start-of-txn (point)) + (backward-paragraph))))))) (defun ledger-report-goto () "Goto the ledger report buffer." -- cgit v1.2.3 From 67201ee8508737cf35c5916953a7b30d01890780 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 14 Feb 2013 11:40:08 -0700 Subject: Add highlighting in the report window if the line is mapped to a file --- lisp/ldg-fonts.el | 5 +++++ lisp/ldg-report.el | 34 +++++++++++++++++++--------------- 2 files changed, 24 insertions(+), 15 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el index d72c9403..cf40c59d 100644 --- a/lisp/ldg-fonts.el +++ b/lisp/ldg-fonts.el @@ -86,6 +86,11 @@ "Default face for pending (!) transactions in the reconcile window" :group 'ledger-faces) +(defface ledger-font-report-clickable-face + `((t :foreground "#cb4b16" :weight normal )) + "Default face for pending (!) transactions in the reconcile window" + :group 'ledger-faces) + (defvar ledger-font-lock-keywords '(("^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)" 2 'ledger-font-pending-face) diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 7f053ce3..711af042 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -165,7 +165,8 @@ used to generate the buffer, navigating the buffer, etc." (defun ledger-report-name-exists (name) "Check to see if the given report name exists. -If name exists, returns the object naming the report, otherwise returns nil." + If name exists, returns the object naming the report, + otherwise returns nil." (unless (string-empty-p name) (car (assoc name ledger-reports)))) @@ -186,9 +187,10 @@ If name exists, returns the object naming the report, otherwise returns nil." (defun ledger-report-ledger-file-format-specifier () "Substitute the full path to master or current ledger file -The master file name is determined by the 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." + The master file name is determined by the 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." (ledger-master-file)) ;; General helper functions @@ -198,10 +200,10 @@ otherwise the current buffer file is used." (defun ledger-master-file () "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 -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." + 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 + 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 (expand-file-name ledger-master-file) (buffer-file-name))) @@ -216,9 +218,9 @@ end of a ledger file which is included in some other file." (defun ledger-report-payee-format-specifier () "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 -default." + 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 + default." ;; It is intended completion should be available on existing ;; payees, but the list of possible completions needs to be ;; developed to allow this. @@ -227,10 +229,10 @@ default." (defun ledger-report-account-format-specifier () "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 -transaction line for an entry, the full account name on that line is -the default." + The user is prompted to enter an account name, which can be any + regular expression identifying an account. If point is on an account + transaction line for an entry, the full account name on that line is + the default." ;; It is intended completion should be available on existing account ;; names, but it remains to be implemented. (let* ((context (ledger-context-at-point)) @@ -301,6 +303,8 @@ the default." (widen) (ledger-goto-line line) (point-marker)))))) + (add-text-properties (line-beginning-position) (line-end-position) + (list 'face 'ledger-font-report-clickable-face)) (end-of-line)))) (goto-char data-pos))) -- cgit v1.2.3 From d8f0b0fa83c6c6984f79dbb918e324a847cdb094 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 14 Feb 2013 15:37:13 -0700 Subject: Code commenting cleanup. --- lisp/ldg-commodities.el | 20 ++++++--- lisp/ldg-complete.el | 26 ++++++++---- lisp/ldg-exec.el | 18 ++++++-- lisp/ldg-fonts.el | 39 ++++++++++------- lisp/ldg-mode.el | 36 ++++++++++++---- lisp/ldg-new.el | 13 +++--- lisp/ldg-occur.el | 45 ++++++++++---------- lisp/ldg-post.el | 32 +++++++++++--- lisp/ldg-reconcile.el | 110 ++++++++++++++++++++++++++---------------------- lisp/ldg-report.el | 68 ++++++++++++++++++------------ lisp/ldg-sort.el | 15 +++++-- lisp/ldg-state.el | 25 +++++++++-- lisp/ldg-xact.el | 36 ++++++++++------ 13 files changed, 309 insertions(+), 174 deletions(-) (limited to 'lisp/ldg-report.el') 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 +;; com> ;; ;; Adapted to ledger mode by Craig Earls @@ -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 "") (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 '%()' where 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 -- cgit v1.2.3 From adfb03cac0d07ede80ad8603eaa15b145ac4f1ef Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 15 Feb 2013 12:11:50 -0700 Subject: Fixed overrun when ledger report would expand argument and cmd would get short --- lisp/ldg-report.el | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 40e54935..370117fc 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -31,7 +31,7 @@ (defcustom ledger-reports '(("bal" "ledger -f %(ledger-file) bal") ("reg" "ledger -f %(ledger-file) reg") - ("payee" "ledger -f %(ledger-file) reg -- %(payee)") + ("payee" "ledger -f %(ledger-file) reg @%(payee)") ("account" "ledger -f %(ledger-file) reg %(account)")) "Definition of reports to run. @@ -79,12 +79,22 @@ text that should replace the format specifier." (defvar ledger-report-mode-abbrev-table) +(defun ledger-report-reverse-lines () + (interactive) + (goto-char (point-min)) + (forward-paragraph) + (next-line) + (save-excursion + (setq inhibit-read-only t) + (reverse-region (point) (point-max)))) + (define-derived-mode ledger-report-mode text-mode "Ledger-Report" "A mode for viewing ledger reports." (let ((map (make-sparse-keymap))) (define-key map [? ] 'scroll-up) (define-key map [backspace] 'scroll-down) (define-key map [?r] 'ledger-report-redo) + (define-key map [?R] 'ledger-report-reverse-lines) (define-key map [?s] 'ledger-report-save) (define-key map [?k] 'ledger-report-kill) (define-key map [?e] 'ledger-report-edit) @@ -109,6 +119,8 @@ text that should replace the format specifier." (define-key map [menu-bar ldg-rep vis] '("Visit Source" . ledger-report-visit-source)) (define-key map [menu-bar ldg-rep lru] '("Scroll Up" . scroll-up)) (define-key map [menu-bar ldg-rep s1] '("--")) + (define-key map [menu-bar ldg-rep rev] '("Reverse report order" . ledger-report-reverse-lines)) + (define-key map [menu-bar ldg-rep s0] '("--")) (define-key map [menu-bar ldg-rep lrk] '("Kill Report" . ledger-report-kill)) (define-key map [menu-bar ldg-rep lrr] '("Re-run Report" . ledger-report-redo)) (define-key map [menu-bar ldg-rep lre] '("Edit Report" . ledger-report-edit)) @@ -255,7 +267,9 @@ used to generate the buffer, navigating the buffer, etc." (save-match-data (let ((expanded-cmd report-cmd)) (set-match-data (list 0 0)) - (while (string-match "%(\\([^)]*\\))" expanded-cmd (match-end 0)) + (while (string-match "%(\\([^)]*\\))" expanded-cmd (if (> (length expanded-cmd) (match-end 0)) + (match-end 0) + (1- (length expanded-cmd)))) (let* ((specifier (match-string 1 expanded-cmd)) (f (cdr (assoc specifier ledger-report-format-specifiers)))) (if f @@ -294,7 +308,7 @@ Optional EDIT the command." (register-report (string-match " reg\\(ister\\)? " cmd)) files-in-report) (shell-command - ;; subtotal doe not produce identifiable transactions, so don't + ;; --subtotal does not produce identifiable transactions, so don't ;; prepend location information for them (if (and register-report (not (string-match "--subtotal" cmd))) -- cgit v1.2.3 From 2c69aa1ff5759a38f458dda69a7b1f6e49294cd0 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 17 Feb 2013 19:47:16 -0700 Subject: A better try to deal with decimal-comma from ledger --- lisp/ldg-commodities.el | 46 ++++++++++++++++++++++++++++++++++++++-------- lisp/ldg-complete.el | 4 ++-- lisp/ldg-post.el | 8 +------- lisp/ldg-reconcile.el | 2 +- lisp/ldg-report.el | 20 +++++++++----------- 5 files changed, 51 insertions(+), 29 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index cf2ee128..04dc23de 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -31,6 +31,12 @@ :type 'string :group 'ledger) +(defcustom ledger-use-decimal-comma nil + "If non-nil the use commas as decimal separator. +This only has effect interfacing to calc mode in edit amount" + :type 'boolean + :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 @@ -40,10 +46,11 @@ (let* ((parts (split-string str)) ;break into number and commodity string (first (car parts)) (second (cadr parts))) - ;"^-*[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 + (ledger-commodity-string-number-decimalize first :from-user)) second) + (list (string-to-number + (ledger-commodity-string-number-decimalize second :from-user)) first)))) fields))) @@ -59,15 +66,38 @@ (list (+ (car c1) (car c2)) (cadr c1)) (error "Can't add different commodities, %S to %S" c1 c2))) +(defun ledger-commodity-string-number-decimalize (number-string direction) + "Take NUMBER-STRING and ensure proper decimalization for use by string-to-number and number-to-string. + +DIRECTION can be :to-user or :from-user. All math calculations +are done with decimal-period, some users may prefer decimal-comma +which must be translated both directions." + (let ((val number-string)) + (if ledger-use-decimal-comma + (cond ((eq direction :from-user) + ;; change string to decimal-period + (while (string-match "," val) + (setq val (replace-match "." nil nil val)))) ;; switch to period separator + ((eq direction :to-user) + ;; change to decimal-comma + (while (string-match "\\." val) + (setq val (replace-match "," nil nil val)))) ;; gets rid of periods + (t + (error "ledger-commodity-string-number-decimalize: direction not properly specified %S" direction)))) + val)) + + + (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))) - (commodity (cadr c1))) - (if (> (length commodity) 1) - (concat val " " commodity) - (concat commodity " " val)))) +(let ((val (ledger-commodity-string-number-decimalize + (number-to-string (car c1)) :to-user)) + (commodity (cadr c1))) + (if (> (length commodity) 1) + (concat val " " commodity) + (concat commodity " " val)))) (defun ledger-read-commodity-string (prompt) "Return a commoditizd value (val 'comm') from COMM. diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index 3fd1b319..3686d0fd 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -164,10 +164,10 @@ Does not use ledger xact" xacts)) (forward-line)) (setq xacts (nreverse xacts))))) + ;; Insert rest-of-name and the postings (when xacts (save-excursion - (insert rest-of-name) - (insert ?\n) + (insert rest-of-name ?\n) (while xacts (insert (car xacts) ?\n) (setq xacts (cdr xacts)))) diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index bdbb4386..14c3c55f 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -51,12 +51,6 @@ :type 'boolean :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" - :type 'boolean - :group 'ledger-post) - (defun ledger-post-all-accounts () "Return a list of all accounts in the buffer." (let ((origin (point)) @@ -185,7 +179,7 @@ BEG, END, and LEN control how far it can align." (goto-char (match-beginning 0)) (delete-region (match-beginning 0) (match-end 0)) (calc) - (if ledger-post-use-decimal-comma + (if ledger-use-decimal-comma (progn (while (string-match "\\." val) (setq val (replace-match "" nil nil val))) ;; gets rid of periods diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 58cb6626..20857127 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -81,7 +81,7 @@ numbers" "Calculate the cleared balance of the account being reconciled." (interactive) (let* ((pending (car (ledger-string-balance-to-commoditized-amount - (car (ledger-reconcile-get-balances))))) + (car (ledger-reconcile-get-balances))))) (target-delta (if ledger-target (-commodity ledger-target pending) nil))) diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 370117fc..944ae2e6 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -21,7 +21,7 @@ ;;; Commentary: -;; +;; Provide facilities for running and saving reports in emacs ;;; Code: @@ -51,7 +51,8 @@ specifier." (defcustom ledger-report-format-specifiers '(("ledger-file" . ledger-report-ledger-file-format-specifier) ("payee" . ledger-report-payee-format-specifier) - ("account" . ledger-report-account-format-specifier)) + ("account" . ledger-report-account-format-specifier) + ("value" . ledger-report-value-format-specifier)) "An alist mapping ledger report format specifiers to implementing functions. The function is called with no parameters and expected to return the @@ -59,15 +60,6 @@ text that should replace the format specifier." :type 'alist :group 'ledger) -;;(define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report) -;;(define-key map [(control ?c) (control ?o) (control ?g)] 'ledger-report-goto) -;;(define-key map [(control ?c) (control ?o) (control ?a)] 'ledger-report-redo) -;;(define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save) -;;(define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit) -;;(define-key map [(control ?c) (control ?o) (control ?k)] 'ledger-report-kill) - -;; Ledger report mode - (defvar ledger-report-buffer-name "*Ledger Report*") (defvar ledger-report-name nil) @@ -128,6 +120,12 @@ text that should replace the format specifier." (use-local-map map))) +(defun ledger-report-value-format-specifier () + "Return a valid meta-data tag name" + ;; It is intended completion should be available on existing account + ;; names, but it remains to be implemented. + (ledger-read-string-with-default "Value: " nil)) + (defun ledger-report-read-name () "Read the name of a ledger report to use, with completion. -- cgit v1.2.3 From 5e0e7e0a973f8a323decbf818e66a6af3ba218fd Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 26 Feb 2013 15:08:52 -0700 Subject: Add reconcile menu entry and correct bug in report that failed on automatically generated xacts --- lisp/ldg-mode.el | 2 ++ lisp/ldg-report.el | 20 +++++++++++--------- 2 files changed, 13 insertions(+), 9 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 96ce576b..37c0f69e 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -128,6 +128,8 @@ (define-key map [toggle-post] '(menu-item "Toggle Current Posting" ledger-toggle-current)) (define-key map [toggle-xact] '(menu-item "Toggle Current Transaction" ledger-toggle-current-entry)) (define-key map [sep4] '(menu-item "--")) + (define-key map [edit-amount] '(menu-item "Reconcile Account" ledger-reconcile)) + (define-key map [sep6] '(menu-item "--")) (define-key map [edit-amount] '(menu-item "Calc on Amount" ledger-post-edit-amount)) (define-key map [sep] '(menu-item "--")) (define-key map [delete-xact] '(menu-item "Delete Entry" ledger-delete-current-transaction)) diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 944ae2e6..4db58494 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -319,16 +319,18 @@ Optional EDIT the command." (let ((file (match-string 1)) (line (string-to-number (match-string 2)))) (delete-region (match-beginning 0) (match-end 0)) - (set-text-properties (line-beginning-position) (line-end-position) - (list 'ledger-source (cons file (save-window-excursion - (save-excursion - (find-file file) - (widen) - (ledger-goto-line line) - (point-marker)))))) - (add-text-properties (line-beginning-position) (line-end-position) + (if file + (progn + (set-text-properties (line-beginning-position) (line-end-position) + (list 'ledger-source (cons file (save-window-excursion + (save-excursion + (find-file file) + (widen) + (ledger-goto-line line) + (point-marker)))))) + (add-text-properties (line-beginning-position) (line-end-position) (list 'face 'ledger-font-report-clickable-face)) - (end-of-line)))) + (end-of-line)))))) (goto-char data-pos))) -- cgit v1.2.3 From 42911df9f5f25914d2be7f48f294ab2fccc06248 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 27 Feb 2013 17:27:52 -0700 Subject: Restructured customization groups. Completed initial draft of ledger-mode documentation --- doc/ledger-mode.texi | 195 ++++++++++++++++++++++++++++++++++++++++++------ lisp/ldg-commodities.el | 8 +- lisp/ldg-exec.el | 2 +- lisp/ldg-init.el | 2 +- lisp/ldg-occur.el | 2 +- lisp/ldg-post.el | 26 +++---- lisp/ldg-reconcile.el | 16 ++-- lisp/ldg-report.el | 9 ++- lisp/ldg-test.el | 14 ++-- lisp/ldg-texi.el | 26 +++++-- 10 files changed, 232 insertions(+), 68 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/doc/ledger-mode.texi b/doc/ledger-mode.texi index 0dc487a2..9b2c1262 100644 --- a/doc/ledger-mode.texi +++ b/doc/ledger-mode.texi @@ -72,7 +72,9 @@ reports and much more... * The Ledger Buffer:: * The Reconcile Buffer:: * The Report Buffer:: -* Installing and Customizing Ledger-mode:: +* Customizing Ledger-mode:: +* Generating Ledger Regression Tests:: +* Embedding Example results in Ledger Documentation:: * Hacking Ledger-mode:: @end menu @@ -83,12 +85,12 @@ reports and much more... @node Introduction to Ledger Mode, The Ledger Buffer, Copying, Top @chapter Introduction to Ledger Mode @menu -* Quick installation:: +* Quick Installation:: * Menus:: * Quick Demo:: @end menu -@node Quick installation, Menus, Introduction to Ledger Mode, Introduction to Ledger Mode +@node Quick Installation, Menus, Introduction to Ledger Mode, Introduction to Ledger Mode @section Quick Installation The emacs lisp source for Ledger-mode is included with the source @@ -107,7 +109,7 @@ This sets up Emacs to automatically recognize files that end with @file{.ledger} and start Ledger mode. Nothing else should be required as long as the ledger command line utility is properly installed. -@node Menus, Quick Demo, Quick installation, Introduction to Ledger Mode +@node Menus, Quick Demo, Quick Installation, Introduction to Ledger Mode @section Menus The vast majority of Ledger-mode functionality is available from the @@ -225,6 +227,12 @@ payees and accounts. Included files are not currently included in the completion scan. Repeatedly hitting @code{TAB} will cycle through the possible completions. +Ledger mode can also help you keep your amounts in alignment. Setting +@code{ledger-post-auto-adjust-amounts} to true tells Ledger-mode to +automatically place any amounts such that their last digit is aligned to +the column specified by @code{ledger-post-amount-alignment-column}, +which defautls to 52. @xref{Ledger Post Customization Group} + @node Editing Amounts, Marking Transactions, Adding Transactions, The Ledger Buffer @section Editing Amounts GNU Calc is a very powerful Reverse Polish Notation calculator built @@ -439,7 +447,7 @@ If for some reason during reconciliation your target amount changes, type @code{t} and enter the new target value. -@node The Report Buffer, Installing and Customizing Ledger-mode, The Reconcile Buffer, Top +@node The Report Buffer, Customizing Ledger-mode, The Reconcile Buffer, Top @chapter The Report Buffer @menu * Running Basic Reports:: @@ -552,36 +560,177 @@ it will reverse the order of the transactions and maintain the proper mathematical sense. -@node Installing and Customizing Ledger-mode, Hacking Ledger-mode, The Report Buffer, Top -@chapter Installing and Customizing Ledger-mode +@node Customizing Ledger-mode, Generating Ledger Regression Tests, The Report Buffer, Top +@chapter Customizing Ledger-mode @menu -* Emacs Initialization File:: * Ledger-mode Customization:: * Customization Variables:: -* Ledger-mode Faces:: @end menu -@node Emacs Initialization File, Ledger-mode Customization, Installing and Customizing Ledger-mode, Installing and Customizing Ledger-mode -@section Emacs Initialization File - -@node Ledger-mode Customization, Ledger-mode Faces, Emacs Initialization File, Installing and Customizing Ledger-mode +@node Ledger-mode Customization, Customization Variables, Customizing Ledger-mode, Customizing Ledger-mode @section Ledger-mode Customization -@node Customization Variables, , Ledger-mode Customization, Installing and Customizing Ledger-mode + +Ledger-mode has several options available for configuration. All +options can be configure through the Emacs customization menus, or +specified in your Emacs initialization file. The complete list of +options is show below. To change the option using the Emacs +customization menu, simply choe customize in the Options menu and look +for Ledger under the data options. Alternately you can choose +``Customize Specific Group'' and enger ``Ledger'' as the group. + +@node Customization Variables, , Ledger-mode Customization, Customizing Ledger-mode @section Customization Variables -@node Ledger-mode Faces, , Customization Variables, Installing and Customizing Ledger-mode -@section Ledger-mode Faces + @menu -* Using EMACS customization menus:: -* Complete list of customization variables:: +* Ledger Customization Group:: +* Ledger Reconcile Customization Group:: +* Ledger Report Customization Group:: +* Ledger Faces Customization Group:: +* Ledger Post Customization Group:: +* Ledger Exec Customization Group:: +* Ledger Test Customization Group:: +* Ledger Texi Customization Group:: @end menu -@node Using EMACS customization menus, Complete list of customization variables, Ledger-mode Faces, Ledger-mode Faces -@subsection Using EMACS customization menus +@node Ledger Customization Group, Ledger Reconcile Customization Group, Customization Variables, Customization Variables +@subsection Ledger Customization Group +@table @code +@item ledger-default-acct-transaction-indent + Default indentation for account transactions in an entry. +@item ledger-occur-use-face-unfolded + If non-nil use a custom face for xacts shown in `ledger-occur' mode using @code{ledger-occur-xact-face}. +@item ledger-clear-whole-transactions + If non-nil, clear whole transactions, not individual postings. +@item ledger-highlight-xact-under-point + If non-nil highlight xact under point using @code{ledger-font-highlight-face}. +@end table + +@node Ledger Reconcile Customization Group, Ledger Report Customization Group, Ledger Customization Group, Customization Variables +@subsection Ledger Reconcile Customization Group + +@table @code +@item ledger-reconcile-default-commodity +The default commodity for use in target calculations in ledger +reconcile. Defaults to $ (USD) +@item ledger-recon-buffer-name + Name to use for reconciliation window. +@item ledger-fold-on-reconcile + If non-nil, limit transactions shown in main buffer to those matching the + reconcile regex. +@item ledger-buffer-tracks-reconcile-buffer + If non-nil, then when the cursor is moved to a new xact in the recon + window. +@item ledger-reconcile-force-window-bottom + If non-nil, make the reconcile window appear along the bottom of the + register window and resize. +@item ledger-reconcile-toggle-to-pending + If non-nil, then toggle between uncleared and pending (@code{!}). If false + toggle between unlceared and cleared (@code{*}) +@end table + +@node Ledger Report Customization Group, Ledger Faces Customization Group, Ledger Reconcile Customization Group, Customization Variables +@subsection Ledger Report Customization Group + +@table @code +@item ledger-reports + Definition of reports to run. +@item ledger-report-format-specifiers + An alist mapping ledger report format specifiers to implementing functions. +@end table + + +@node Ledger Faces Customization Group, Ledger Post Customization Group, Ledger Report Customization Group, Customization Variables +@subsection Ledger Faces Customization Group +Ledger Faces : Ledger mode highlighting +@table @code +@item ledger-font-uncleared-face +Default face for Ledger +@item ledger-font-cleared-face +Default face for cleared (*) transactions +@item ledger-font-highlight-face +Default face for transaction under point +@item ledger-font-pending-face +Default face for pending (!) transactions +@item ledger-font-other-face +Default face for other transactions +@item ledger-font-posting-account-face +Face for Ledger accounts +@item ledger-font-posting-amount-face +Face for Ledger amounts +@item ledger-occur-folded-face +Default face for Ledger occur mode hidden transactions +@item ledger-occur-xact-face +Default face for Ledger occur mode shown transactions +@item ledger-font-comment-face +Face for Ledger comments +@item ledger-font-reconciler-uncleared-face +Default face for uncleared transactions in the reconcile window +@item ledger-font-reconciler-cleared-face +Default face for cleared (*) transactions in the reconcile window +@item ledger-font-reconciler-pending-face +Default face for pending (!) transactions in the reconcile window +@item ledger-font-report-clickable-face +Default face for pending (!) transactions in the reconcile window +@end table + +@node Ledger Post Customization Group, Ledger Exec Customization Group, Ledger Faces Customization Group, Customization Variables +@subsection Ledger Post Customization Group +Ledger Post : +@table @code +@item ledger-post-auto-adjust-amounts +If non-nil, then automatically align amounts to column specified in +@code{ledger-post-amount-alignment-column} +@item ledger-post-amount-alignment-column +The column Ledger-mode uses to align amounts +@item ledger-post-use-completion-engine +Which completion engine to use, iswitchb, ido, or built-in +@item ledger-post-use-ido +@end table + +@node Ledger Exec Customization Group, Ledger Test Customization Group, Ledger Post Customization Group, Customization Variables +@subsection Ledger Exec Customization Group + +Ledger Exec : Interface to the Ledger command-line accounting program. + +@table @code +@item ledger-binary-path +Path to the ledger executable. +@item ledger-init-file-name +Location of the ledger initialization file. nil if you don't have one +@end table + + +@node Ledger Test Customization Group, Ledger Texi Customization Group, Ledger Exec Customization Group, Customization Variables +@subsection Ledger Test Customization Group +@table @code +@item ledger-source-directory + Directory where the Ledger sources are located. +@item ledger-test-binary + Directory where the debug binary. +@end table + +@node Ledger Texi Customization Group, , Ledger Test Customization Group, Customization Variables +@subsection Ledger Texi Customization Group + +@table @code +@item ledger-texi-sample-doc-path +Location for sample data to be used in texi tests, defaults to @file{~/ledger/doc/sample.dat} +@item ledger-texi-normalization-args +texi normalization for producing ledger output, defaults to ``@code{--args-only --columns 80}'' +@end table + +@node Generating Ledger Regression Tests, Embedding Example results in Ledger Documentation, Customizing Ledger-mode, Top +@chapter Generating Ledger Regression Tests + +Work in Progress. + +@node Embedding Example results in Ledger Documentation, Hacking Ledger-mode, Generating Ledger Regression Tests, Top +@chapter Embedding Example results in Ledger Documentation -@node Complete list of customization variables, , Using EMACS customization menus, Ledger-mode Faces -@subsection Complete list of customization variables +Work in Progress. -@node Hacking Ledger-mode, , Installing and Customizing Ledger-mode, Top +@node Hacking Ledger-mode, , Embedding Example results in Ledger Documentation, Top @chapter Hacking Ledger-mode +Work in Progress. @bye diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index 6f835221..c5500785 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -29,13 +29,7 @@ (defcustom ledger-reconcile-default-commodity "$" "The default commodity for use in target calculations in ledger reconcile." :type 'string - :group 'ledger) - -(defcustom ledger-use-decimal-comma nil - "If non-nil the use commas as decimal separator. -This only has effect interfacing to calc mode in edit amount" - :type 'boolean - :group 'ledger) + :group 'ledger-reconcile) (defun ledger-split-commodity-string (str) "Split a commoditized amount into two parts" diff --git a/lisp/ldg-exec.el b/lisp/ldg-exec.el index af5dd3a8..d62fd419 100644 --- a/lisp/ldg-exec.el +++ b/lisp/ldg-exec.el @@ -38,7 +38,7 @@ (defcustom ledger-binary-path "ledger" "Path to the ledger executable." :type 'file - :group 'ledger) + :group 'ledger-exec) (defun ledger-exec-ledger (input-buffer &optional output-buffer &rest args) "Run Ledger using INPUT-BUFFER and optionally capturing output in OUTPUT-BUFFER with ARGS." diff --git a/lisp/ldg-init.el b/lisp/ldg-init.el index fbb4b838..72317088 100644 --- a/lisp/ldg-init.el +++ b/lisp/ldg-init.el @@ -24,7 +24,7 @@ (defcustom ledger-init-file-name "~/.ledgerrc" "Location of the ledger initialization file. nil if you don't have one" - :group 'ledger) + :group 'ledger-exec) (defvar ledger-environment-alist nil) diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index c3f04c5d..1561d6f8 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -35,7 +35,7 @@ (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." + "If non-nil, use a custom face for xacts shown in `ledger-occur' mode using ledger-occur-xact-face." :type 'boolean :group 'ledger) (make-variable-buffer-local 'ledger-occur-use-face-unfolded) diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 14c3c55f..de28a8a9 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -28,7 +28,7 @@ ;;; Code: (defgroup ledger-post nil - "" + "Options for controlling how Ledger-mode deals with postings and completion" :group 'ledger) (defcustom ledger-post-auto-adjust-amounts nil @@ -37,19 +37,17 @@ :group 'ledger-post) (defcustom ledger-post-amount-alignment-column 52 - "If non-nil, ." + "The column Ledger-mode attempts to align amounts to." :type 'integer :group 'ledger-post) -(defcustom ledger-post-use-iswitchb nil - "If non-nil, ." - :type 'boolean - :group 'ledger-post) - -(defcustom ledger-post-use-ido nil - "If non-nil, ." - :type 'boolean - :group 'ledger-post) +(defcustom ledger-post-use-completion-engine :built-in + "Which completion engine to use, :iswitchb or :ido chose those engines, +:built-in uses built-in Ledger-mode completion" + :type '(radio (const :tag "built in completion" :built-in) + (const :tag "ido completion" :ido) + (const :tag "iswitchb completion" :iswitchb) ) + :group 'ledger-post) (defun ledger-post-all-accounts () "Return a list of all accounts in the buffer." @@ -73,13 +71,13 @@ PROMPT is a string to prompt with. CHOICES is a list of strings to choose from." (cond - (ledger-post-use-iswitchb + ((eq ledger-post-use-completion-engine :iswitchb) (let* ((iswitchb-use-virtual-buffers nil) (iswitchb-make-buflist-hook (lambda () (setq iswitchb-temp-buflist choices)))) (iswitchb-read-buffer prompt))) - (ledger-post-use-ido + ((eq ledger-post-use-completion-engine :ido) (ido-completing-read prompt choices)) (t (completing-read prompt choices)))) @@ -114,7 +112,7 @@ PROMPT is a string to prompt with. CHOICES is a list of (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]+;.+?\\|[ \t]*\\)?$" (marker-position end) t) (goto-char (match-beginning 0)) (skip-syntax-forward " ") (- (or (match-end 4) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 6a9d05fd..6093f9df 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -23,7 +23,7 @@ ;;; Commentary: -;; +;; Code to handle reconciling Ledger files wiht outside sources ;;; Code: @@ -32,31 +32,35 @@ (defvar ledger-acct nil) (defvar ledger-target nil) +(defgroup ledger-reconcile nil + "Options for Ledger-mode reconciliation" + :group 'ledger) + (defcustom ledger-recon-buffer-name "*Reconcile*" "Name to use for reconciliation window." - :group 'ledger) + :group 'ledger-reconcile) (defcustom ledger-fold-on-reconcile t "If t, limit transactions shown in main buffer to those matching the reconcile regex." :type 'boolean - :group 'ledger) + :group 'ledger-reconcile) (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." :type 'boolean - :group 'ledger) + :group 'ledger-reconcile) (defcustom ledger-reconcile-force-window-bottom nil "If t make the reconcile window appear along the bottom of the register window and resize." :type 'boolean - :group 'ledger) + :group 'ledger-reconcile) (defcustom ledger-reconcile-toggle-to-pending t "If true then toggle between uncleared and pending. reconcile-finish will mark all pending posting cleared." :type 'boolean - :group 'ledger) + :group 'ledger-reconcile) (defun ledger-reconcile-get-balances () diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 4db58494..0aa91ac0 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -28,6 +28,11 @@ (eval-when-compile (require 'cl)) +(defgroup ledger-report nil + "Customization option for the Report buffer" + :group 'ledger +) + (defcustom ledger-reports '(("bal" "ledger -f %(ledger-file) bal") ("reg" "ledger -f %(ledger-file) reg") @@ -46,7 +51,7 @@ in that variable for more information on the behavior of each specifier." :type '(repeat (list (string :tag "Report Name") (string :tag "Command Line"))) - :group 'ledger) + :group 'ledger-report) (defcustom ledger-report-format-specifiers '(("ledger-file" . ledger-report-ledger-file-format-specifier) @@ -58,7 +63,7 @@ specifier." The function is called with no parameters and expected to return the text that should replace the format specifier." :type 'alist - :group 'ledger) + :group 'ledger-report) (defvar ledger-report-buffer-name "*Ledger Report*") diff --git a/lisp/ldg-test.el b/lisp/ldg-test.el index 7667a05e..dbba9546 100644 --- a/lisp/ldg-test.el +++ b/lisp/ldg-test.el @@ -19,15 +19,19 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; MA 02111-1307, USA. -(defcustom ledger-source-directory "~/src/ledger" - "Directory where the Ledger sources are located." - :type 'directory +(defgroup ledger-test nil + "Definitions for the Ledger testing framework" :group 'ledger) -(defcustom ledger-test-binary "~/Products/ledger/debug/ledger" +(defcustom ledger-source-directory "~/ledger/" "Directory where the Ledger sources are located." + :type 'directory + :group 'ledger-test) + +(defcustom ledger-test-binary "/Products/ledger/debug/ledger" + "Directory where the Ledger debug binary is located." :type 'file - :group 'ledger) + :group 'ledger-test) (defun ledger-test-org-narrow-to-entry () (outline-back-to-heading) diff --git a/lisp/ldg-texi.el b/lisp/ldg-texi.el index 53e050ce..84ba34c2 100644 --- a/lisp/ldg-texi.el +++ b/lisp/ldg-texi.el @@ -19,9 +19,19 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; MA 02111-1307, USA. -(defvar ledger-path "/Users/johnw/bin/ledger") -(defvar ledger-sample-doc-path "/Users/johnw/src/ledger/doc/sample.dat") -(defvar ledger-normalization-args "--args-only --columns 80") +(defgroup ledger-texi nil +"Options for working on Ledger texi documentation" +:group 'ledger) + +(defcustom ledger-texi-sample-doc-path "~/ledger/doc/sample.dat" +"Location for sample data to be used in texi tests" +:type 'file +:group 'ledger-texi) + +(defcustom ledger-texi-normalization-args "--args-only --columns 80" +"texi normalization for producing ledger output" +:type 'string +:group 'ledger-texi) (defun ledger-update-test () (interactive) @@ -92,10 +102,10 @@ (defun ledger-texi-expand-command (command data-file) (if (string-match "\\$LEDGER" command) - (replace-match (format "%s -f \"%s\" %s" ledger-path - data-file ledger-normalization-args) t t command) - (concat (format "%s -f \"%s\" %s " ledger-path - data-file ledger-normalization-args) command))) + (replace-match (format "%s -f \"%s\" %s" ledger-binary-path + data-file ledger-texi-normalization-args) t t command) + (concat (format "%s -f \"%s\" %s " ledger-binary-path + data-file ledger-texi-normalization-args) command))) (defun ledger-texi-invoke-command (command) (with-temp-buffer (shell-command command t (current-buffer)) @@ -122,7 +132,7 @@ (let ((section (match-string 1)) (example-name (match-string 2)) (command (match-string 3)) expanded-command - (data-file ledger-sample-doc-path) + (data-file ledger-texi-sample-doc-path) input output) (goto-char (match-end 0)) (forward-line) -- cgit v1.2.3 From 71d5d6078f0c7237461209fd7ab2ef6f9bf38882 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 28 Feb 2013 11:57:51 -0700 Subject: Make reverse-report SHIFT-R --- lisp/ldg-report.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 0aa91ac0..0728495e 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -91,7 +91,7 @@ text that should replace the format specifier." (define-key map [? ] 'scroll-up) (define-key map [backspace] 'scroll-down) (define-key map [?r] 'ledger-report-redo) - (define-key map [?R] 'ledger-report-reverse-lines) + (define-key map [(shift ?r)] 'ledger-report-reverse-lines) (define-key map [?s] 'ledger-report-save) (define-key map [?k] 'ledger-report-kill) (define-key map [?e] 'ledger-report-edit) -- cgit v1.2.3 From efce6c89362abed1276cd060cec8077777a038e4 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 4 Mar 2013 09:36:34 -0700 Subject: Add acct under point to reconcile prompt. Fix reconcile balance display of empty accounts --- lisp/ldg-commodities.el | 46 ++++++++++++++++++++++++---------------------- lisp/ldg-post.el | 12 ++++++++++++ lisp/ldg-reconcile.el | 9 +++++---- lisp/ldg-report.el | 11 +++-------- 4 files changed, 44 insertions(+), 34 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index a3cc8951..9291136f 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -33,28 +33,30 @@ (defun ledger-split-commodity-string (str) "Split a commoditized amount into two parts" - (let (val - comm) - (with-temp-buffer - (insert str) - (goto-char (point-min)) - (cond ((re-search-forward "-?[1-9][0-9]*[.,][0-9]*" nil t) - ;; found a decimal number - (setq val - (string-to-number - (ledger-commodity-string-number-decimalize - (delete-and-extract-region (match-beginning 0) (match-end 0)) :from-user))) - (goto-char (point-min)) - (re-search-forward "[^[:space:]]" nil t) - (setq comm - (delete-and-extract-region (match-beginning 0) (match-end 0))) - (list val comm)) - ((re-search-forward "0" nil t) - ;; couldn't find a decimal number, look for a single 0, - ;; indicating account with zero balance - (list 0 ledger-reconcile-default-commodity)) - (t - (error "split-commodity-string: cannot parse commodity string: %S" str)))))) + (if (> (length str) 0) + (let (val + comm) + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (cond ((re-search-forward "-?[1-9][0-9]*[.,][0-9]*" nil t) + ;; found a decimal number + (setq val + (string-to-number + (ledger-commodity-string-number-decimalize + (delete-and-extract-region (match-beginning 0) (match-end 0)) :from-user))) + (goto-char (point-min)) + (re-search-forward "[^[:space:]]" nil t) + (setq comm + (delete-and-extract-region (match-beginning 0) (match-end 0))) + (list val comm)) + ((re-search-forward "0" nil t) + ;; couldn't find a decimal number, look for a single 0, + ;; indicating account with zero balance + (list 0 ledger-reconcile-default-commodity)) + (t + (error "split-commodity-string: cannot parse commodity string: %S" str))))) + (list 0 ledger-reconcile-default-commodity))) (defun ledger-string-balance-to-commoditized-amount (str) diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 7105ef7a..6cba305b 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -229,6 +229,18 @@ BEG, END, and LEN control how far it can align." (add-hook 'after-change-functions 'ledger-post-maybe-align t t)) (add-hook 'after-save-hook #'(lambda () (setq ledger-post-current-list nil)))) + +(defun ledger-post-read-account-with-prompt (prompt) + (let* ((context (ledger-context-at-point)) + (default + (if (eq (ledger-context-line-type context) 'acct-transaction) + (regexp-quote (ledger-context-field-value context 'account)) + nil))) + (ledger-read-string-with-default prompt default))) + + (provide 'ldg-post) + + ;;; ldg-post.el ends here diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 33c9f06f..e45ab7c3 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -351,10 +351,11 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (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)) +(defun ledger-reconcile () + "Start reconciling, prompt for account." + (interactive) + (let ((account (ledger-post-read-account-with-prompt "Account to reconcile")) + (buf (current-buffer)) (rbuf (get-buffer ledger-recon-buffer-name))) ;; this means ;; only one ;; *Reconcile* diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 0728495e..ef088f17 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -258,12 +258,7 @@ used to generate the buffer, navigating the buffer, etc." the default." ;; It is intended completion should be available on existing account ;; names, but it remains to be implemented. - (let* ((context (ledger-context-at-point)) - (default - (if (eq (ledger-context-line-type context) 'acct-transaction) - (regexp-quote (ledger-context-field-value context 'account)) - nil))) - (ledger-read-string-with-default "Account" default))) + (ledger-post-read-account-with-prompt "Account")) (defun ledger-report-expand-format-specifiers (report-cmd) "Expand %(account) and %(payee) appearing in REPORT-CMD with thing under point." @@ -437,9 +432,9 @@ Optional EDIT the command." ("^\\(\\([0-9][0-9][0-9][0-9]/\\)?[01]?[0-9]/[0123]?[0-9]\\)[ \t]+\\(\\([!*]\\)[ \t]\\)?[ \t]*\\((\\(.*\\))\\)?[ \t]*\\(.*\\)[ \t]*$" (date nil status nil nil code payee)))) (acct-transaction - (("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$]\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$" + (("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$" (indent account commodity amount nil comment)) - ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$]\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*$" + ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*$" (indent account commodity amount nil)) ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?[0-9]+\\(\\.[0-9]*\\)?\\)[ \t]+\\(.*?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$" (indent account amount nil commodity comment)) -- cgit v1.2.3 From 81eeb210e8e2b33077624fd9d0fd3ef63837701a Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 6 Mar 2013 16:57:07 -0500 Subject: Improved context regex to handles @ and @@ pricing --- lisp/ldg-report.el | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index ef088f17..8d91d9d4 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -432,11 +432,13 @@ Optional EDIT the command." ("^\\(\\([0-9][0-9][0-9][0-9]/\\)?[01]?[0-9]/[0123]?[0-9]\\)[ \t]+\\(\\([!*]\\)[ \t]\\)?[ \t]*\\((\\(.*\\))\\)?[ \t]*\\(.*\\)[ \t]*$" (date nil status nil nil code payee)))) (acct-transaction - (("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$" + (("^\\([ \t]+;\\|;\\)\\s-?\\(.*\\)" + (indent comment)) + ("\\(^[ \t]+\\)\\([:A-Za-z0-9]+?\\)\\s-\\s-+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)$" + (indent account commodity amount)) + ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$" (indent account commodity amount nil comment)) - ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*$" - (indent account commodity amount nil)) - ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?[0-9]+\\(\\.[0-9]*\\)?\\)[ \t]+\\(.*?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$" + ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?[0-9]+\\(\\.[0-9]*\\)?\\)[ \t]+\\(.*?\\)[ \t]*\\(;[ \t]*\\(.*?\\)[ \t]*$\\|@+\\)" (indent account amount nil commodity comment)) ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?[0-9]+\\(\\.[0-9]*\\)?\\)[ \t]+\\(.*?\\)[ \t]*$" (indent account amount nil commodity)) @@ -447,7 +449,13 @@ Optional EDIT the command." ("\\(^[ \t]+\\)\\(.*?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$" (indent account comment)) ("\\(^[ \t]+\\)\\(.*?\\)[ \t]*$" - (indent account)))))) + (indent account)) + +;; Bad regexes + ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*$" + (indent account commodity amount nil)) + + )))) (defun ledger-extract-context-info (line-type pos) "Get context info for current line with LINE-TYPE. -- cgit v1.2.3 From ea72ac29eadad36d2b9e37a168127cff76f2880a Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 18 Mar 2013 10:50:11 -0700 Subject: Enh918 Have occur mode searches stored in mini buffer history --- lisp/ldg-occur.el | 5 ++--- lisp/ldg-report.el | 4 ++-- lisp/ldg-xact.el | 7 ++++--- 3 files changed, 8 insertions(+), 8 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index 8b56d12c..35ca7f3d 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -49,7 +49,7 @@ (defvar ledger-occur-history nil "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 "Last match found.") @@ -95,8 +95,7 @@ When REGEX is nil, unhide everything, and remove higlight" (if ledger-occur-mode (list nil) (list (read-string (concat "Regexp<" (ledger-occur-prompt) - ">: ") "" 'ledger-occur-history )))) - (if (string-equal "" regex) (setq regex (ledger-occur-prompt))) + ">: ") nil 'ledger-occur-history (ledger-occur-prompt))))) (ledger-occur-mode regex (current-buffer))) (defun ledger-occur-prompt () diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 8d91d9d4..8e642a61 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -73,7 +73,7 @@ text that should replace the format specifier." (defvar ledger-report-cmd-prompt-history nil) (defvar ledger-original-window-cfg nil) (defvar ledger-report-saved nil) - +(defvar ledger-minibuffer-history nil) (defvar ledger-report-mode-abbrev-table) (defun ledger-report-reverse-lines () @@ -236,7 +236,7 @@ used to generate the buffer, navigating the buffer, etc." (if default (concat " (" default "): ") ": ")))) - (read-string default-prompt nil nil default))) + (read-string default-prompt nil 'ledger-minibuffer-history default))) (defun ledger-report-payee-format-specifier () "Substitute a payee name. diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index ecd87127..3e4cec4b 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -99,9 +99,10 @@ within the transaction." (ignore (goto-char here)))))) (defun ledger-copy-transaction-at-point (date) - "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 "/")))) + "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 "/") 'ledger-minibuffer-history))) (let* ((here (point)) (extents (ledger-find-xact-extents (point))) (transaction (buffer-substring (car extents) (cadr extents))) -- cgit v1.2.3 From d3fe4c666ff37912245d2a0386ac749737f34843 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 25 Mar 2013 01:21:19 -0400 Subject: Lots of code cleanup. (if () (progn …) ==> (when () …) all over the place MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lisp/ldg-commodities.el | 2 +- lisp/ldg-complete.el | 11 ++--- lisp/ldg-exec.el | 31 ++++++------- lisp/ldg-init.el | 22 ++++----- lisp/ldg-occur.el | 50 ++++++++++----------- lisp/ldg-post.el | 2 +- lisp/ldg-reconcile.el | 117 +++++++++++++++++++++++------------------------- lisp/ldg-report.el | 53 +++++++++++----------- lisp/ldg-schedule.el | 2 +- lisp/ldg-sort.el | 32 ++++++------- lisp/ldg-state.el | 7 ++- lisp/ldg-xact.el | 13 +++--- 12 files changed, 156 insertions(+), 186 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index f664c472..0eb435b5 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -50,7 +50,7 @@ (string-to-number (ledger-commodity-string-number-decimalize (delete-and-extract-region (match-beginning 0) (match-end 0)) :from-user)) - (nth 0 (split-string (buffer-substring (point-min) (point-max)))))) + (nth 0 (split-string (buffer-substring-no-properties (point-min) (point-max)))))) ((re-search-forward "0" nil t) ;; couldn't find a decimal number, look for a single 0, ;; indicating account with zero balance diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index fa0bf87a..a8e73b88 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -19,9 +19,6 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; MA 02111-1307, USA. -;;(require 'esh-util) -;;(require 'esh-arg) - ;;; Commentary: ;; Functions providing payee and account auto complete. @@ -126,8 +123,8 @@ Return tree structure" (if (null current-prefix-arg) (ledger-payees-in-buffer) ;; this completes against payee names (progn - (let ((text (buffer-substring (line-beginning-position) - (line-end-position)))) + (let ((text (buffer-substring-no-properties (line-beginning-position) + (line-end-position)))) (delete-region (line-beginning-position) (line-end-position)) (condition-case err @@ -154,7 +151,7 @@ Does not use ledger xact" ;; Search backward for a matching payee (when (re-search-backward (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.*" - (regexp-quote name) ".*\\)" ) nil t) ;; "\\(\t\\|\n\\| [ \t]\\)" + (regexp-quote name) ".*\\)" ) nil t) (setq rest-of-name (match-string 3)) ;; Start copying the postings (forward-line) @@ -180,7 +177,7 @@ Does not use ledger xact" (defun ledger-pcomplete (&optional interactively) "Complete rip-off of pcomplete from pcomplete.el, only added -ledger-magic-tab in the previos commads list so that +ledger-magic-tab in the previous commands list so that ledger-magic-tab would cycle properly" (interactive "p") (if (and interactively diff --git a/lisp/ldg-exec.el b/lisp/ldg-exec.el index 31621f9f..4a485072 100644 --- a/lisp/ldg-exec.el +++ b/lisp/ldg-exec.el @@ -53,7 +53,7 @@ (with-current-buffer ledger-output-buffer (goto-char (point-min)) (if (and (> (buffer-size) 1) (looking-at (regexp-quote "While"))) - nil + nil ;; failure, there is an error starting with "While" ledger-output-buffer))) (defun ledger-exec-ledger (input-buffer &optional output-buffer &rest args) @@ -77,27 +77,24 @@ (defun ledger-version-greater-p (needed) "Verify the ledger binary is usable for `ledger-mode' (version greater than NEEDED)." (let ((buffer ledger-buf) - (version-strings '()) - (version-number)) + (version-strings '())) (with-temp-buffer - (if (ledger-exec-ledger (current-buffer) (current-buffer) "--version") - (progn - (goto-char (point-min)) - (delete-horizontal-space) - (setq version-strings (split-string - (buffer-substring-no-properties (point) - (point-max)))) - (if (and (string-match (regexp-quote "Ledger") (car version-strings)) - (or (string= needed (car (cdr version-strings))) - (string< needed (car (cdr version-strings))))) - t - nil)))))) + (when (ledger-exec-ledger (current-buffer) (current-buffer) "--version") + (goto-char (point-min)) + (delete-horizontal-space) + (setq version-strings (split-string + (buffer-substring-no-properties (point) + (point-max)))) + (if (and (string-match (regexp-quote "Ledger") (car version-strings)) + (or (string= needed (cadr version-strings)) + (string< needed (cadr version-strings)))) + t ;; success + nil))))) ;;failure (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 + (if (setq ledger-works (ledger-version-greater-p ledger-version-needed)) (message "Good Ledger Version") (message "Bad Ledger Version"))) diff --git a/lisp/ldg-init.el b/lisp/ldg-init.el index 72317088..8e657323 100644 --- a/lisp/ldg-init.el +++ b/lisp/ldg-init.el @@ -33,16 +33,16 @@ (setq ledger-environment-alist nil) (goto-char (point-min)) (while (re-search-forward "^--.+?\\($\\|[ ]\\)" nil t ) - (let ((matchb (match-beginning 0)) ;; save the match data, string-match stomp on it + (let ((matchb (match-beginning 0)) ;; save the match data, string-match stamp on it (matche (match-end 0))) (end-of-line) (setq ledger-environment-alist (append ledger-environment-alist - (list (cons (let ((flag (buffer-substring (+ 2 matchb) matche))) + (list (cons (let ((flag (buffer-substring-no-properties (+ 2 matchb) matche))) (if (string-match "[ \t\n\r]+\\'" flag) (replace-match "" t t flag) flag)) - (let ((value (buffer-substring matche (point) ))) + (let ((value (buffer-substring-no-properties matche (point) ))) (if (> (length value) 0) value t)))))))) @@ -53,16 +53,12 @@ (let ((init-base-name (file-name-nondirectory ledger-init-file-name))) (if (get-buffer init-base-name) ;; init file already loaded, parse it and leave it (ledger-init-parse-initialization init-base-name) - (if (and ;; init file not loaded, load, parse and kill - ledger-init-file-name - (file-exists-p ledger-init-file-name) - (file-readable-p ledger-init-file-name)) - (progn - (find-file-noselect ledger-init-file-name) - (ledger-init-parse-initialization init-base-name) - (kill-buffer init-base-name)))))) - - + (when (and ledger-init-file-name + (file-exists-p ledger-init-file-name) + (file-readable-p ledger-init-file-name)) + (find-file-noselect ledger-init-file-name) + (ledger-init-parse-initialization init-base-name) + (kill-buffer init-base-name))))) (provide 'ldg-init) diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index 28d87b78..a2e53cb0 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -63,27 +63,24 @@ "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 - (if (or (null regex) - (zerop (length regex))) - nil - (concat " Ledger-Narrowed: " regex))) - (force-mode-line-update) - (ledger-occur-remove-overlays) - (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 - (ledger-occur-create-xact-overlays ovl-bounds)) - (setq ledger-occur-overlay-list - (append ledger-occur-overlay-list - (ledger-occur-create-narrowed-overlays buffer-matches))) - (setq ledger-occur-last-match regex) - (if (get-buffer-window buffer) - (select-window (get-buffer-window buffer))))) - (recenter))) + (set-buffer buffer) + (setq ledger-occur-mode + (if (or (null regex) + (zerop (length regex))) + nil + (concat " Ledger-Narrowed: " regex))) + (force-mode-line-update) + (ledger-occur-remove-overlays) + (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 + (append (ledger-occur-create-xact-overlays ovl-bounds) + (ledger-occur-create-narrowed-overlays buffer-matches))) + (setq ledger-occur-last-match regex) + (if (get-buffer-window buffer) + (select-window (get-buffer-window buffer))))) + (recenter)) (defun ledger-occur (regex) "Perform a simple grep in current buffer for the regular expression REGEX. @@ -163,12 +160,11 @@ Argument OVL-BOUNDS contains bounds for the transactions to be left visible." (defun ledger-occur-quit-buffer (buffer) "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) - (force-mode-line-update) - (ledger-occur-remove-overlays) - (recenter))) + (set-buffer buffer) + (setq ledger-occur-mode nil) + (force-mode-line-update) + (ledger-occur-remove-overlays) + (recenter)) (defun ledger-occur-remove-overlays () "Remove the transaction hiding overlays." diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index bbed297d..c831f01a 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -135,7 +135,7 @@ Return the width of the amount field as an integer." (match-end 3)) (point)))) (defvar ledger-post-account-regex - (concat "\\(^[ ]+\\)" + (concat "\\(^[ \t]+\\)" "\\([\\[(*!;a-zA-Z0-9]+?\\)")) (defun ledger-next-account (&optional end) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 3d73cca9..3d3b7c92 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -66,9 +66,10 @@ reconcile-finish will mark all pending posting cleared." (defun ledger-reconcile-get-cleared-or-pending-balance () "Calculate the cleared or pending balance of the account." (interactive) - (let ((buffer ledger-buf) - (account ledger-acct) - (val nil)) + ;; these vars are buffer local, need to hold them for use in the + ;; temp buffer below + (let ((buffer ledger-buf) + (account ledger-acct)) (with-temp-buffer ;; note that in the line below, the --format option is ;; separated from the actual format string. emacs does not @@ -77,16 +78,15 @@ reconcile-finish will mark all pending posting cleared." (if (ledger-exec-ledger buffer (current-buffer) "balance" "--limit" "cleared or pending" "--empty" "--format" "%(display_total)" account) - (setq val - (ledger-split-commodity-string - (buffer-substring-no-properties (point-min) (point-max)))))))) + (ledger-split-commodity-string + (buffer-substring-no-properties (point-min) (point-max))))))) (defun ledger-display-balance () "Display the cleared-or-pending balance. And calculate the target-delta of the account being reconciled." (interactive) (let* ((pending (ledger-reconcile-get-cleared-or-pending-balance))) - (if pending + (when pending (if ledger-target (message "Pending balance: %s, Difference from target: %s" (ledger-commodity-to-string pending) @@ -150,23 +150,21 @@ Return the number of uncleared xacts found." (interactive) (let ((inhibit-read-only t)) (erase-buffer) - (prog1 (ledger-do-reconcile) - (set-buffer-modified-p t) - ;;(goto-char (point-min)) - ))) + (prog1 + (ledger-do-reconcile) + (set-buffer-modified-p t)))) (defun ledger-reconcile-refresh-after-save () "Refresh the recon-window after the ledger buffer is saved." (let ((curbuf (current-buffer)) (curpoint (point)) (recon-buf (get-buffer ledger-recon-buffer-name))) - (if (buffer-live-p recon-buf) - (progn - (with-current-buffer recon-buf - (ledger-reconcile-refresh) - (set-buffer-modified-p nil)) - (select-window (get-buffer-window curbuf)) - (goto-char curpoint))))) + (when (buffer-live-p recon-buf) + (with-current-buffer recon-buf + (ledger-reconcile-refresh) + (set-buffer-modified-p nil)) + (select-window (get-buffer-window curbuf)) + (goto-char curpoint)))) (defun ledger-reconcile-add () "Use ledger xact to add a new transaction." @@ -247,7 +245,7 @@ and exit reconcile mode" (if recon-buf (with-current-buffer recon-buf (ledger-reconcile-quit-cleanup) - (set 'buf ledger-buf) + (setq buf ledger-buf) ;; Make sure you delete the window before you delete the buffer, ;; otherwise, madness ensues (delete-window (get-buffer-window recon-buf)) @@ -261,10 +259,9 @@ and exit reconcile mode" (if (buffer-live-p buf) (with-current-buffer buf (remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t) - (if ledger-narrow-on-reconcile - (progn - (ledger-occur-quit-buffer buf) - (ledger-highlight-xact-under-point))))))) + (when ledger-narrow-on-reconcile + (ledger-occur-quit-buffer buf) + (ledger-highlight-xact-under-point)))))) (defun ledger-marker-where-xact-is (emacs-xact posting) "Find the position of the EMACS-XACT in the `ledger-buf'. @@ -285,14 +282,13 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (ledger-success nil) (xacts (with-temp-buffer - (if (ledger-exec-ledger buf (current-buffer) - "--uncleared" "--real" "emacs" account) - (progn - (setq ledger-success t) - (goto-char (point-min)) - (unless (eobp) - (if (looking-at "(") - (read (current-buffer))))))))) ;current-buffer is the *temp* created above + (when (ledger-exec-ledger buf (current-buffer) + "--uncleared" "--real" "emacs" account) + (setq ledger-success t) + (goto-char (point-min)) + (unless (eobp) + (if (looking-at "(") + (read (current-buffer)))))))) ;current-buffer is the *temp* created above (if (and ledger-success (> (length xacts) 0)) (let ((date-format (cdr (assoc "date-format" ledger-environment-alist)))) (dolist (xact xacts) @@ -351,15 +347,15 @@ moved and recentered. If they aren't strange things happen." (defun ledger-reconcile-track-xact () "Force the ledger buffer to recenter on the transaction at point in the reconcile buffer." - (if (member this-command (list 'next-line - 'previous-line - 'mouse-set-point - 'ledger-reconcile-toggle - 'end-of-buffer - 'beginning-of-buffer)) - (if ledger-buffer-tracks-reconcile-buffer - (save-excursion - (ledger-reconcile-visit t))))) + (if (and ledger-buffer-tracks-reconcile-buffer + (member this-command (list 'next-line + 'previous-line + 'mouse-set-point + 'ledger-reconcile-toggle + 'end-of-buffer + 'beginning-of-buffer))) + (save-excursion + (ledger-reconcile-visit t)))) (defun ledger-reconcile-open-windows (buf rbuf) "Ensure that the ledger buffer BUF is split by RBUF." @@ -373,33 +369,30 @@ moved and recentered. If they aren't strange things happen." (interactive) (let ((account (ledger-post-read-account-with-prompt "Account to reconcile")) (buf (current-buffer)) - (rbuf (get-buffer ledger-recon-buffer-name))) ;; this means - ;; only one - ;; *Reconcile* - ;; buffer, ever - ;; Set up the reconcile buffer - (if rbuf ;; *Reconcile* already exists + (rbuf (get-buffer ledger-recon-buffer-name))) + ;; this means only one *Reconcile* buffer, ever Set up the + ;; reconcile buffer + (if rbuf ;; *Reconcile* already exists (with-current-buffer rbuf - (set 'ledger-acct account) ;; already buffer local - (if (not (eq buf rbuf)) - (progn ;; called from some other ledger-mode buffer - (ledger-reconcile-quit-cleanup) - (set 'ledger-buf buf))) ;; should already be - ;; buffer-local + (set 'ledger-acct account) ;; already buffer local + (when (not (eq buf rbuf)) + ;; called from some other ledger-mode buffer + (ledger-reconcile-quit-cleanup) + (set 'ledger-buf buf)) ;; should already be buffer-local (unless (get-buffer-window rbuf) (ledger-reconcile-open-windows buf rbuf))) - (progn ;; no recon-buffer, starting from scratch. - (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t) - - (with-current-buffer (setq rbuf - (get-buffer-create ledger-recon-buffer-name)) - (ledger-reconcile-open-windows buf rbuf) - (ledger-reconcile-mode) - (make-local-variable 'ledger-target) - (set (make-local-variable 'ledger-buf) buf) - (set (make-local-variable 'ledger-acct) account)))) + ;; no recon-buffer, starting from scratch. + (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t) + + (with-current-buffer (setq rbuf + (get-buffer-create ledger-recon-buffer-name)) + (ledger-reconcile-open-windows buf rbuf) + (ledger-reconcile-mode) + (make-local-variable 'ledger-target) + (set (make-local-variable 'ledger-buf) buf) + (set (make-local-variable 'ledger-acct) account))) ;; Narrow the ledger buffer (with-current-buffer rbuf diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 8e642a61..4f14fdcb 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -30,8 +30,7 @@ (defgroup ledger-report nil "Customization option for the Report buffer" - :group 'ledger -) + :group 'ledger) (defcustom ledger-reports '(("bal" "ledger -f %(ledger-file) bal") @@ -319,18 +318,17 @@ Optional EDIT the command." (let ((file (match-string 1)) (line (string-to-number (match-string 2)))) (delete-region (match-beginning 0) (match-end 0)) - (if file - (progn - (set-text-properties (line-beginning-position) (line-end-position) - (list 'ledger-source (cons file (save-window-excursion - (save-excursion - (find-file file) - (widen) - (ledger-goto-line line) - (point-marker)))))) - (add-text-properties (line-beginning-position) (line-end-position) - (list 'face 'ledger-font-report-clickable-face)) - (end-of-line)))))) + (when file + (set-text-properties (line-beginning-position) (line-end-position) + (list 'ledger-source (cons file (save-window-excursion + (save-excursion + (find-file file) + (widen) + (ledger-goto-line line) + (point-marker)))))) + (add-text-properties (line-beginning-position) (line-end-position) + (list 'face 'ledger-font-report-clickable-face)) + (end-of-line))))) (goto-char data-pos))) @@ -340,20 +338,19 @@ Optional EDIT the command." (let* ((prop (get-text-property (point) 'ledger-source)) (file (if prop (car prop))) (line-or-marker (if prop (cdr prop)))) - (if (and file line-or-marker) - (progn - (find-file-other-window file) - (widen) - (if (markerp line-or-marker) - (goto-char line-or-marker) - (goto-char (point-min)) - (forward-line (1- line-or-marker)) - (re-search-backward "^[0-9]+") - (beginning-of-line) - (let ((start-of-txn (point))) - (forward-paragraph) - (narrow-to-region start-of-txn (point)) - (backward-paragraph))))))) + (when (and file line-or-marker) + (find-file-other-window file) + (widen) + (if (markerp line-or-marker) + (goto-char line-or-marker) + (goto-char (point-min)) + (forward-line (1- line-or-marker)) + (re-search-backward "^[0-9]+") + (beginning-of-line) + (let ((start-of-txn (point))) + (forward-paragraph) + (narrow-to-region start-of-txn (point)) + (backward-paragraph)))))) (defun ledger-report-goto () "Goto the ledger report buffer." diff --git a/lisp/ldg-schedule.el b/lisp/ldg-schedule.el index c2e5ea01..effa20b5 100644 --- a/lisp/ldg-schedule.el +++ b/lisp/ldg-schedule.el @@ -223,7 +223,7 @@ returns true if the date meets the requirements" ;; read the descriptor string into a lisp object the transform the ;; string descriptor into useable things (ledger-transform-auto-tree - (read (buffer-substring (point-min) (point-max)))))) + (read (buffer-substring-no-properties (point-min) (point-max)))))) (defun ledger-transform-auto-tree (tree) "Takes a lisp list of date descriptor strings, TREE, and returns a string with a lambda function of date." diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el index 3ce429fc..ecb86371 100644 --- a/lisp/ldg-sort.el +++ b/lisp/ldg-sort.el @@ -47,26 +47,22 @@ (match-end 0))) (defun ledger-sort-insert-start-mark () - (interactive) - (let (has-old-marker) - (save-excursion - (goto-char (point-min)) - (setq has-old-marker (ledger-sort-find-start)) - (if has-old-marker - (delete-region (match-beginning 0) (match-end 0)))) - (beginning-of-line) - (insert "\n; Ledger-mode: Start sort\n\n"))) + (interactive) + (save-excursion + (goto-char (point-min)) + (if (ledger-sort-find-start) + (delete-region (match-beginning 0) (match-end 0)))) + (beginning-of-line) + (insert "\n; Ledger-mode: Start sort\n\n")) (defun ledger-sort-insert-end-mark () - (interactive) - (let (has-old-marker) - (save-excursion - (goto-char (point-min)) - (setq has-old-marker (ledger-sort-find-end)) - (if has-old-marker - (delete-region (match-beginning 0) (match-end 0)))) - (beginning-of-line) - (insert "\n; Ledger-mode: End sort\n\n"))) + (interactive) + (save-excursion + (goto-char (point-min)) + (if (ledger-sort-find-end) + (delete-region (match-beginning 0) (match-end 0)))) + (beginning-of-line) + (insert "\n; Ledger-mode: End sort\n\n")) (defun ledger-sort-region (beg end) "Sort the region from BEG to END in chronological order." diff --git a/lisp/ldg-state.el b/lisp/ldg-state.el index dd5e42ad..c1027f5c 100644 --- a/lisp/ldg-state.el +++ b/lisp/ldg-state.el @@ -245,10 +245,9 @@ dropped." (eq (ledger-state-from-char (char-after)) 'cleared)) (progn (delete-char 1) - (if (and style (eq style 'cleared)) - (progn - (insert " *") - (setq status 'cleared)))) + (when (and style (eq style 'cleared)) + (insert " *") + (setq status 'cleared))) (if (and style (eq style 'pending)) (progn (insert " ! ") diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index 3e4cec4b..e2180b57 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -44,12 +44,10 @@ within the transaction." (backward-paragraph) (if (/= (point) (point-min)) (forward-line)) - (beginning-of-line) - (setq beg-pos (point)) + (setq beg-pos (line-beginning-position)) (forward-paragraph) (forward-line -1) - (end-of-line) - (setq end-pos (1+ (point))) + (setq end-pos (1+ (line-end-position))) (list beg-pos end-pos)))) @@ -80,11 +78,12 @@ within the transaction." (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 () "Describe thing at points. Return 'transaction, 'posting, or nil." -(let ((here (point))) + (let ((here (point))) (goto-char (line-beginning-position)) (cond ((looking-at "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+") (goto-char (match-end 0)) @@ -105,7 +104,7 @@ within the transaction." (concat ledger-year "/" ledger-month "/") 'ledger-minibuffer-history))) (let* ((here (point)) (extents (ledger-find-xact-extents (point))) - (transaction (buffer-substring (car extents) (cadr extents))) + (transaction (buffer-substring-no-properties (car extents) (cadr extents))) encoded-date) (if (string-match ledger-date-regex date) (setq encoded-date -- cgit v1.2.3 From efed5eb4bfd35a75e013c70f76c34452542eee5e Mon Sep 17 00:00:00 2001 From: Rémi Vanicat Date: Sat, 30 Mar 2013 13:19:54 +0100 Subject: Removing some warning when compiling ledger. * ldg-commodities.el: use #' instead of ' for function quoting * ldg-exec.el: remove the fit-frame function that don't exists and do not use toggle-read-only to make the buffer read-only * ldg-report.el: use forward-line instead of next-line --- lisp/ldg-commodities.el | 2 +- lisp/ldg-exec.el | 3 +-- lisp/ldg-report.el | 2 +- 3 files changed, 3 insertions(+), 4 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index 831d770b..842613c6 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -75,7 +75,7 @@ Returns a list with (value commodity)." (let ((fields (split-string str "[\n\r]"))) ; break any balances ; with multi commodities ; into a list - (mapcar '(lambda (str) + (mapcar #'(lambda (str) (ledger-split-commodity-string str)) fields))) diff --git a/lisp/ldg-exec.el b/lisp/ldg-exec.el index 4a485072..51443ff4 100644 --- a/lisp/ldg-exec.el +++ b/lisp/ldg-exec.el @@ -45,9 +45,8 @@ (with-current-buffer (get-buffer-create "*Ledger Error*") (insert-buffer-substring ledger-output) (make-frame) - (fit-frame) (view-mode) - (toggle-read-only))) + (setq buffer-read-only t))) (defun ledger-exec-success-p (ledger-output-buffer) (with-current-buffer ledger-output-buffer diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 4f14fdcb..04c182dd 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -79,7 +79,7 @@ text that should replace the format specifier." (interactive) (goto-char (point-min)) (forward-paragraph) - (next-line) + (forward-line) (save-excursion (setq inhibit-read-only t) (reverse-region (point) (point-max)))) -- cgit v1.2.3 From 62996f9366fc582f0e2cebe8d88aea9095629239 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 1 Apr 2013 10:15:48 -0700 Subject: Make 'return' visit source in reports, make Visit Source the entry in reconcile mode. --- lisp/ldg-reconcile.el | 2 +- lisp/ldg-report.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 5a6a117a..bec6d175 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -434,7 +434,7 @@ moved and recentered. If they aren't strange things happen." (define-key map [menu-bar ldg-recon-menu qui] '("Quit" . ledger-reconcile-quit)) (define-key map [menu-bar ldg-recon-menu sep1] '("--")) (define-key map [menu-bar ldg-recon-menu pre] '("Previous Entry" . previous-line)) - (define-key map [menu-bar ldg-recon-menu vis] '("Visit Entry" . ledger-reconcile-visit)) + (define-key map [menu-bar ldg-recon-menu vis] '("Visit Source" . ledger-reconcile-visit)) (define-key map [menu-bar ldg-recon-menu nex] '("Next Entry" . next-line)) (define-key map [menu-bar ldg-recon-menu sep2] '("--")) (define-key map [menu-bar ldg-recon-menu del] '("Delete Entry" . ledger-reconcile-delete)) diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 04c182dd..3225d803 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -103,7 +103,7 @@ text that should replace the format specifier." 'ledger-report-kill) (define-key map [(control ?c) (control ?l) (control ?e)] 'ledger-report-edit) - (define-key map [(control ?c) (control ?c)] 'ledger-report-visit-source) + (define-key map [return] 'ledger-report-visit-source) (define-key map [menu-bar] (make-sparse-keymap "ldg-rep")) -- cgit v1.2.3 From 4df990014fede0c7b0c23396f32b1f2c7c636426 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 6 Apr 2013 23:13:49 -0700 Subject: Fixed reconciliation initialization. Now prompts with only account, not status and amount Moved context function to leg-context, from leg-report. Cleaned up many regex in ldg-context. --- lisp/ldg-complete.el | 30 +++++---- lisp/ldg-context.el | 183 ++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/ldg-mode.el | 30 ++++++--- lisp/ldg-new.el | 1 + lisp/ldg-occur.el | 5 ++ lisp/ldg-post.el | 9 --- lisp/ldg-reconcile.el | 2 +- lisp/ldg-report.el | 156 +----------------------------------------- lisp/ldg-state.el | 8 +-- lisp/ldg-xact.el | 19 +----- 10 files changed, 237 insertions(+), 206 deletions(-) create mode 100644 lisp/ldg-context.el (limited to 'lisp/ldg-report.el') diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index f01e6e90..bd907bc8 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -30,9 +30,12 @@ (defun ledger-parse-arguments () "Parse whitespace separated arguments in the current region." - (let* ((info (save-excursion - (cons (ledger-thing-at-point) (point)))) - (begin (cdr info)) + ;; this is more complex than it appears to need, so that it can work + ;; with pcomplete. See pcomplete-parse-arguments-function for + ;; details + (let* ((begin (save-excursion + (ledger-thing-at-point) ;; leave point at beginning of thing under point + (point))) (end (point)) begins args) (save-excursion @@ -45,6 +48,7 @@ args))) (cons (reverse args) (reverse begins))))) + (defun ledger-payees-in-buffer () "Scan buffer and return list of all payees." (let ((origin (point)) @@ -77,12 +81,12 @@ Return tree structure" (match-string-no-properties 2) ":")) (let ((root account-tree)) (while account-elements - (let ((entry (assoc (car account-elements) root))) - (if entry - (setq root (cdr entry)) - (setq entry (cons (car account-elements) (list t))) - (nconc root (list entry)) - (setq root (cdr entry)))) + (let ((xact (assoc (car account-elements) root))) + (if xact + (setq root (cdr xact)) + (setq xact (cons (car account-elements) (list t))) + (nconc root (list xact)) + (setq root (cdr xact)))) (setq account-elements (cdr account-elements))))))) account-tree)) @@ -93,11 +97,11 @@ Return tree structure" (root (ledger-find-accounts-in-buffer)) (prefix nil)) (while (cdr elements) - (let ((entry (assoc (car elements) root))) - (if entry + (let ((xact (assoc (car elements) root))) + (if xact (setq prefix (concat prefix (and prefix ":") (car elements)) - root (cdr entry)) + root (cdr xact)) (setq root nil elements nil))) (setq elements (cdr elements))) (and root @@ -136,7 +140,7 @@ Return tree structure" (throw 'pcompleted t))) (ledger-accounts))))) -(defun ledger-fully-complete-entry () +(defun ledger-fully-complete-xact () "Completes a transaction if there is another matching payee in the buffer. Does not use ledger xact" (interactive) diff --git a/lisp/ldg-context.el b/lisp/ldg-context.el new file mode 100644 index 00000000..8861a30e --- /dev/null +++ b/lisp/ldg-context.el @@ -0,0 +1,183 @@ +;;; ldg-context.el --- Helper code for use with the "ledger" command-line tool + +;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) + +;; This file is not part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free +;; Software Foundation; either version 2, or (at your option) any later +;; version. +;; +;; This is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + + +;;; Commentary: +;; Provide facilities for reflection in ledger buffers + +;;; Code: + +(eval-when-compile + (require 'cl)) + + +(defconst ledger-line-config + '((xact + (("^\\(\\([0-9][0-9][0-9][0-9]/\\)?[01]?[0-9]/[0123]?[0-9]\\)[ \t]+\\(\\([!*]\\)[ \t]\\)?[ \t]*\\((\\(.*\\))\\)?[ \t]*\\(.*?\\)[ \t]*;\\(.*\\)[ \t]*$" + (date nil status nil nil code payee comment)) + ("^\\(\\([0-9][0-9][0-9][0-9]/\\)?[01]?[0-9]/[0123]?[0-9]\\)[ \t]+\\(\\([!*]\\)[ \t]\\)?[ \t]*\\((\\(.*\\))\\)?[ \t]*\\(.*\\)[ \t]*$" + (date nil status nil nil code payee)))) + (acct-transaction + (("^\\([ \t]+;\\|;\\)\\s-?\\(.*\\)" + (indent comment)) + ("\\(^[ \t]+\\)\\([*! ]?\\)\\(.*?\\)\\s-\\s-[ \t]+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*;[ \t]*\\(.*\\)[ \t]*$" + (indent status account commodity amount nil comment)) ;checked 2013-04-06 + ("\\(^[ \t]+\\)\\([*! ]?\\)\\(.*?\\)\\s-\\s-[ \t]+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)$" + (indent status account commodity amount)) ;checked 2013-04-06 + ("\\(^[ \t]+\\)\\([*! ]?\\)\\(.*?\\)\\s-\\s-[ \t]+\\(-?[0-9]+\\.[0-9]*\\)[ \t]+\\(.*?\\)[ \t]*\\(;[ \t]*\\(.*?\\)[ \t]*$\\|@+\\)" + (indent status account amount nil commodity comment)) ;checked 2013-04-06 + ("\\(^[ \t]+\\)\\([*! ]?\\)\\(.*?\\)\\s-\\s-[ \t]+\\(-?[0-9]+\\.[0-9]*\\)[ \t]+\\(.*\\)" + (indent status account amount nil commodity)) ;checked 2013-04-06 + ("\\(^[ \t]+\\)\\([*! ]?\\)\\(.*?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$" + (indent status account comment)) + ("\\(^[ \t]+\\)\\([*! ]?\\)\\(.*?\\)[ \t]*$" + (indent status account)))))) + +(defun ledger-extract-context-info (line-type pos) + "Get context info for current line with LINE-TYPE. + +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) + (dolist (re-info (nth 1 linfo)) + (let ((re (nth 0 re-info)) + (names (nth 1 re-info))) + (unless found + (when (looking-at re) + (setq found t) + (dotimes (i (length names)) + (when (nth i names) + (setq fields (append fields + (list + (list (nth i names) + (match-string-no-properties (1+ i)) + (match-beginning (1+ i)))))))) + (dolist (f fields) + (and (nth 1 f) + (>= pos (nth 2 f)) + (setq field (nth 0 f)))))))) + (list line-type field fields))) + +(defun ledger-thing-at-point () + "Describe thing at points. Return 'transaction, 'posting, or nil. +Leave point at the beginning of the thing under point" + (let ((here (point))) + (goto-char (line-beginning-position)) + (cond ((looking-at "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+") + (goto-char (match-end 0)) + 'transaction) + ((looking-at "^\\s-+\\([*!]\\s-+\\)?[[(]?\\(.\\)") + (goto-char (match-beginning 2)) + 'posting) + ((looking-at "^\\(sun\\|mon\\|tue\\|wed\\|thu\\|fri\\|sat\\)\\s-+") + (goto-char (match-end 0)) + 'day) + (t + (ignore (goto-char here)))))) + +(defun ledger-context-at-point () + "Return a list describing the context around point. + +The contents of the list are the line type, the name of the field +containing point, and for selected line types, the content of +the fields in the line in a association list." + (let ((pos (point))) + (save-excursion + (beginning-of-line) + (let ((first-char (char-after))) + (cond ((equal (point) (line-end-position)) + '(empty-line nil nil)) + ((memq first-char '(?\ ?\t)) + (ledger-extract-context-info 'acct-transaction pos)) + ((memq first-char '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) + (ledger-extract-context-info 'xact pos)) + ((equal first-char ?\=) + '(automated-xact nil nil)) + ((equal first-char ?\~) + '(period-xact nil nil)) + ((equal first-char ?\!) + '(command-directive)) + ((equal first-char ?\;) + '(comment nil nil)) + ((equal first-char ?Y) + '(default-year nil nil)) + ((equal first-char ?P) + '(commodity-price nil nil)) + ((equal first-char ?N) + '(price-ignored-commodity nil nil)) + ((equal first-char ?D) + '(default-commodity nil nil)) + ((equal first-char ?C) + '(commodity-conversion nil nil)) + ((equal first-char ?i) + '(timeclock-i nil nil)) + ((equal first-char ?o) + '(timeclock-o nil nil)) + ((equal first-char ?b) + '(timeclock-b nil nil)) + ((equal first-char ?h) + '(timeclock-h nil nil)) + (t + '(unknown nil nil))))))) + +(defun ledger-context-other-line (offset) + "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." + (save-excursion + (let ((left (forward-line offset))) + (if (not (equal left 0)) + nil + (ledger-context-at-point))))) + +(defun ledger-context-line-type (context-info) + (nth 0 context-info)) + +(defun ledger-context-current-field (context-info) + (nth 1 context-info)) + +(defun ledger-context-field-info (context-info field-name) + (assoc field-name (nth 2 context-info))) + +(defun ledger-context-field-present-p (context-info field-name) + (not (null (ledger-context-field-info context-info field-name)))) + +(defun ledger-context-field-value (context-info field-name) + (nth 1 (ledger-context-field-info context-info field-name))) + +(defun ledger-context-field-position (context-info field-name) + (nth 2 (ledger-context-field-info context-info field-name))) + +(defun ledger-context-field-end-position (context-info field-name) + (+ (ledger-context-field-position context-info field-name) + (length (ledger-context-field-value context-info field-name)))) + +(defun ledger-context-goto-field-start (context-info field-name) + (goto-char (ledger-context-field-position context-info field-name))) + +(defun ledger-context-goto-field-end (context-info field-name) + (goto-char (ledger-context-field-end-position context-info field-name))) + +(provide 'ldg-context) + +;;; ldg-report.el ends here diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index f0af4383..6dea1735 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -39,10 +39,22 @@ (defvar ledger-month (ledger-current-month) "Start a ledger session with the current month, but make it customizable to ease retro-entry.") -(defun ledger-remove-overlays () - "Remove all overlays from the ledger buffer." - (interactive) - (remove-overlays)) +(defun ledger-read-account-with-prompt (prompt) + (let* ((context (ledger-context-at-point)) + (default + (if (and (eq (ledger-context-line-type context) 'acct-transaction) + (eq (ledger-context-current-field context) 'account)) + (regexp-quote (ledger-context-field-value context 'account)) + nil))) + (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 + (if default + (concat " (" default "): ") + ": ")))) + (read-string default-prompt nil 'ledger-minibuffer-history default))) (defun ledger-magic-tab (&optional interactively) "Decide what to with with . @@ -59,7 +71,7 @@ Can be pcomplete, or align-posting" (interactive) (let ((context (car (ledger-context-at-point))) (date-string (format-time-string (cdr (assoc "date-format" ledger-environment-alist))))) - (cond ((eq 'entry context) + (cond ((eq 'xact context) (beginning-of-line) (insert date-string "=")) ((eq 'acct-transaction context) @@ -87,7 +99,7 @@ Can be pcomplete, or align-posting" (set (make-local-variable 'pcomplete-termination-string) "") (add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t) - (add-hook 'before-revert-hook 'ledger-remove-overlays nil t) + (add-hook 'before-revert-hook 'ledger-occur-remove-all-overlays nil t) (make-variable-buffer-local 'highlight-overlay) (ledger-init-load-init-file) @@ -110,8 +122,8 @@ Can be pcomplete, or align-posting" (define-key map [(control ?c) (control ?y)] 'ledger-set-year) (define-key map [tab] 'ledger-magic-tab) (define-key map [(control ?i)] 'ledger-magic-tab) - (define-key map [(control ?c) tab] 'ledger-fully-complete-entry) - (define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-entry) + (define-key map [(control ?c) tab] 'ledger-fully-complete-xact) + (define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-xact) (define-key map [(control ?c) (control ?o) (control ?a)] 'ledger-report-redo) (define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit) @@ -155,7 +167,7 @@ Can be pcomplete, or align-posting" (define-key map [edit-amount] '(menu-item "Calc on Amount" ledger-post-edit-amount)) (define-key map [sep] '(menu-item "--")) (define-key map [delete-xact] '(menu-item "Delete Transaction" ledger-delete-current-transaction)) - (define-key map [cmp-xact] '(menu-item "Complete Transaction" ledger-fully-complete-entry)) + (define-key map [cmp-xact] '(menu-item "Complete Transaction" ledger-fully-complete-xact)) (define-key map [add-xact] '(menu-item "Add Transaction (ledger xact)" ledger-add-transaction :enable ledger-works)) (define-key map [sep3] '(menu-item "--")) (define-key map [reconcile] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works)) diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index b018d217..7c13c80e 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -37,6 +37,7 @@ (require 'esh-arg) (require 'ldg-commodities) (require 'ldg-complete) +(require 'ldg-context) (require 'ldg-exec) (require 'ldg-fonts) (require 'ldg-init) diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index a2e53cb0..1e1308d0 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -59,6 +59,11 @@ "A list of currently active overlays to the ledger buffer.") (make-variable-buffer-local 'ledger-occur-overlay-list) +(defun ledger-remove-all-overlays () + "Remove all overlays from the ledger buffer." + (interactive) + (remove-overlays)) + (defun ledger-occur-mode (regex buffer) "Highlight transactions that match REGEX in BUFFER, hiding others. diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 338264f5..4f80b425 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -251,15 +251,6 @@ BEG, END, and LEN control how far it can align." (add-hook 'after-save-hook #'(lambda () (setq ledger-post-current-list nil)) t t)) -(defun ledger-post-read-account-with-prompt (prompt) - (let* ((context (ledger-context-at-point)) - (default - (if (and (eq (ledger-context-line-type context) 'acct-transaction) - (eq (ledger-context-current-field context) 'account)) - (regexp-quote (ledger-context-field-value context 'account)) - nil))) - (ledger-read-string-with-default prompt default))) - (provide 'ldg-post) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index ff808485..e5a5a8e7 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -377,7 +377,7 @@ moved and recentered. If they aren't strange things happen." (defun ledger-reconcile () "Start reconciling, prompt for account." (interactive) - (let ((account (ledger-post-read-account-with-prompt "Account to reconcile")) + (let ((account (ledger-read-account-with-prompt "Account to reconcile")) (buf (current-buffer)) (rbuf (get-buffer ledger-recon-buffer-name))) ;; this means only one *Reconcile* buffer, ever Set up the diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 3225d803..c3b83f55 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -229,19 +229,11 @@ used to generate the buffer, navigating the buffer, etc." (expand-file-name ledger-master-file) (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 "): ") - ": ")))) - (read-string default-prompt nil 'ledger-minibuffer-history default))) - (defun ledger-report-payee-format-specifier () "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 + point is in an xact, the payee for that xact is used as the default." ;; It is intended completion should be available on existing ;; payees, but the list of possible completions needs to be @@ -253,11 +245,11 @@ used to generate the buffer, navigating the buffer, etc." The user is prompted to enter an account name, which can be any regular expression identifying an account. If point is on an account - transaction line for an entry, the full account name on that line is + posting line for an xact, the full account name on that line is the default." ;; It is intended completion should be available on existing account ;; names, but it remains to be implemented. - (ledger-post-read-account-with-prompt "Account")) + (ledger-read-account-with-prompt "Account")) (defun ledger-report-expand-format-specifiers (report-cmd) "Expand %(account) and %(payee) appearing in REPORT-CMD with thing under point." @@ -422,148 +414,6 @@ Optional EDIT the command." (ledger-reports-add ledger-report-name ledger-report-cmd) (ledger-reports-custom-save))))))) -(defconst ledger-line-config - '((entry - (("^\\(\\([0-9][0-9][0-9][0-9]/\\)?[01]?[0-9]/[0123]?[0-9]\\)[ \t]+\\(\\([!*]\\)[ \t]\\)?[ \t]*\\((\\(.*\\))\\)?[ \t]*\\(.*?\\)[ \t]*;\\(.*\\)[ \t]*$" - (date nil status nil nil code payee comment)) - ("^\\(\\([0-9][0-9][0-9][0-9]/\\)?[01]?[0-9]/[0123]?[0-9]\\)[ \t]+\\(\\([!*]\\)[ \t]\\)?[ \t]*\\((\\(.*\\))\\)?[ \t]*\\(.*\\)[ \t]*$" - (date nil status nil nil code payee)))) - (acct-transaction - (("^\\([ \t]+;\\|;\\)\\s-?\\(.*\\)" - (indent comment)) - ("\\(^[ \t]+\\)\\([:A-Za-z0-9]+?\\)\\s-\\s-+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)$" - (indent account commodity amount)) - ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$" - (indent account commodity amount nil comment)) - ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?[0-9]+\\(\\.[0-9]*\\)?\\)[ \t]+\\(.*?\\)[ \t]*\\(;[ \t]*\\(.*?\\)[ \t]*$\\|@+\\)" - (indent account amount nil commodity comment)) - ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?[0-9]+\\(\\.[0-9]*\\)?\\)[ \t]+\\(.*?\\)[ \t]*$" - (indent account amount nil commodity)) - ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?\\(\\.[0-9]*\\)\\)[ \t]+\\(.*?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$" - (indent account amount nil commodity comment)) - ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?\\(\\.[0-9]*\\)\\)[ \t]+\\(.*?\\)[ \t]*$" - (indent account amount nil commodity)) - ("\\(^[ \t]+\\)\\(.*?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$" - (indent account comment)) - ("\\(^[ \t]+\\)\\(.*?\\)[ \t]*$" - (indent account)) - -;; Bad regexes - ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*$" - (indent account commodity amount nil)) - - )))) - -(defun ledger-extract-context-info (line-type pos) - "Get context info for current line with LINE-TYPE. - -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) - (dolist (re-info (nth 1 linfo)) - (let ((re (nth 0 re-info)) - (names (nth 1 re-info))) - (unless found - (when (looking-at re) - (setq found t) - (dotimes (i (length names)) - (when (nth i names) - (setq fields (append fields - (list - (list (nth i names) - (match-string-no-properties (1+ i)) - (match-beginning (1+ i)))))))) - (dolist (f fields) - (and (nth 1 f) - (>= pos (nth 2 f)) - (setq field (nth 0 f)))))))) - (list line-type field fields))) - -(defun ledger-context-at-point () - "Return a list describing the context around point. - -The contents of the list are the line type, the name of the field -point containing point, and for selected line types, the content of -the fields in the line in a association list." - (let ((pos (point))) - (save-excursion - (beginning-of-line) - (let ((first-char (char-after))) - (cond ((equal (point) (line-end-position)) - '(empty-line nil nil)) - ((memq first-char '(?\ ?\t)) - (ledger-extract-context-info 'acct-transaction pos)) - ((memq first-char '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) - (ledger-extract-context-info 'entry pos)) - ((equal first-char ?\=) - '(automated-entry nil nil)) - ((equal first-char ?\~) - '(period-entry nil nil)) - ((equal first-char ?\!) - '(command-directive)) - ((equal first-char ?\;) - '(comment nil nil)) - ((equal first-char ?Y) - '(default-year nil nil)) - ((equal first-char ?P) - '(commodity-price nil nil)) - ((equal first-char ?N) - '(price-ignored-commodity nil nil)) - ((equal first-char ?D) - '(default-commodity nil nil)) - ((equal first-char ?C) - '(commodity-conversion nil nil)) - ((equal first-char ?i) - '(timeclock-i nil nil)) - ((equal first-char ?o) - '(timeclock-o nil nil)) - ((equal first-char ?b) - '(timeclock-b nil nil)) - ((equal first-char ?h) - '(timeclock-h nil nil)) - (t - '(unknown nil nil))))))) - -(defun ledger-context-other-line (offset) - "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." - (save-excursion - (let ((left (forward-line offset))) - (if (not (equal left 0)) - nil - (ledger-context-at-point))))) - -(defun ledger-context-line-type (context-info) - (nth 0 context-info)) - -(defun ledger-context-current-field (context-info) - (nth 1 context-info)) - -(defun ledger-context-field-info (context-info field-name) - (assoc field-name (nth 2 context-info))) - -(defun ledger-context-field-present-p (context-info field-name) - (not (null (ledger-context-field-info context-info field-name)))) - -(defun ledger-context-field-value (context-info field-name) - (nth 1 (ledger-context-field-info context-info field-name))) - -(defun ledger-context-field-position (context-info field-name) - (nth 2 (ledger-context-field-info context-info field-name))) - -(defun ledger-context-field-end-position (context-info field-name) - (+ (ledger-context-field-position context-info field-name) - (length (ledger-context-field-value context-info field-name)))) - -(defun ledger-context-goto-field-start (context-info field-name) - (goto-char (ledger-context-field-position context-info field-name))) - -(defun ledger-context-goto-field-end (context-info field-name) - (goto-char (ledger-context-field-end-position context-info field-name))) - (provide 'ldg-report) ;;; ldg-report.el ends here diff --git a/lisp/ldg-state.el b/lisp/ldg-state.el index 4f1b3695..6c585f30 100644 --- a/lisp/ldg-state.el +++ b/lisp/ldg-state.el @@ -84,15 +84,15 @@ 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. This function is rather complicated because it must preserve both -the overall formatting of the ledger entry, as well as ensuring +the overall formatting of the ledger xact, as well as ensuring that the most minimal display format is used. This could be -achieved more certainly by passing the entry to ledger for +achieved more certainly by passing the xact to ledger for formatting, but doing so causes inline math expressions to be dropped." (interactive) (let ((bounds (ledger-current-transaction-bounds)) new-status cur-status) - ;; Uncompact the entry, to make it easier to toggle the + ;; Uncompact the xact, to make it easier to toggle the ;; transaction (save-excursion ;; this excursion checks state of entire ;; transaction and unclears if marked @@ -162,7 +162,7 @@ dropped." (setq new-status inserted)))) (setq inhibit-modification-hooks nil)) - ;; This excursion cleans up the entry so that it displays + ;; This excursion cleans up the xact so that it displays ;; minimally. This means that if all posts are cleared, remove ;; the marks and clear the entire transaction. (save-excursion diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index 31b9818f..b66bba04 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -67,12 +67,12 @@ within the transaction." (overlay-put ovl 'priority 100)))) (defun ledger-xact-payee () - "Return the payee of the entry containing point or nil." + "Return the payee of the transaction containing point or nil." (let ((i 0)) (while (eq (ledger-context-line-type (ledger-context-other-line i)) 'acct-transaction) (setq i (- i 1))) (let ((context-info (ledger-context-other-line i))) - (if (eq (ledger-context-line-type context-info) 'entry) + (if (eq (ledger-context-line-type context-info) 'xact) (ledger-context-field-value context-info 'payee) nil)))) @@ -116,21 +116,6 @@ MOMENT is an encoded date" (goto-char (point-min)) (forward-line (1- line-number))) -(defun ledger-thing-at-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)) - 'transaction) - ((looking-at "^\\s-+\\([*!]\\s-+\\)?[[(]?\\(.\\)") - (goto-char (match-beginning 2)) - 'posting) - ((looking-at "^\\(sun\\|mon\\|tue\\|wed\\|thu\\|fri\\|sat\\)\\s-+") - (goto-char (match-end 0)) - 'entry) - (t - (ignore (goto-char here)))))) (defun ledger-copy-transaction-at-point (date) "Ask for a new DATE and copy the transaction under point to that date. Leave point on the first amount." -- cgit v1.2.3