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') 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 e6acb5a9ccd65bd1f50f52ddc8e6d349e7dabd3a Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Mon, 30 Jul 2012 22:32:29 -0500 Subject: Require ldg-report from ldg-new (for now) --- lisp/ldg-new.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index 64377bb9..8505fe4a 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -36,6 +36,7 @@ (require 'ldg-mode) (require 'ldg-complete) (require 'ldg-state) +(require 'ldg-report) ;(autoload #'ledger-mode "ldg-mode" nil t) ;(autoload #'ledger-fully-complete-entry "ldg-complete" nil t) -- 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') 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') 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') 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') 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') 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 855432c4cd32b03b0751cffb0e215f2ceefdc6e5 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 16 Jan 2013 11:44:13 -0800 Subject: Fixed ledger-add-entry copied ledger-iterate-entries, ledger-set-year and ledger-set-month from the old ledger.el. Changed ledger-add-entry to use ledger-exec-ledger vice the old ledger-run-ledger. --- lisp/ldg-mode.el | 43 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 42 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 6090a312..04c6ee1b 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -76,6 +76,47 @@ Return the difference in the format of a time value." (if (ledger-time-less-p moment date) (throw 'found t))))))) +(defun ledger-iterate-entries (callback) + (goto-char (point-min)) + (let* ((now (current-time)) + (current-year (nth 5 (decode-time now)))) + (while (not (eobp)) + (when (looking-at + (concat "\\(Y\\s-+\\([0-9]+\\)\\|" + "\\([0-9]\\{4\\}+\\)?[./]?" + "\\([0-9]+\\)[./]\\([0-9]+\\)\\s-+" + "\\(\\*\\s-+\\)?\\(.+\\)\\)")) + (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))))) + (forward-line)))) + +(defun ledger-set-year (newyear) + "Set ledger's idea of the current year to the prefix argument." + (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." + (interactive "p") + (if (= newmonth 1) + (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) (interactive "sEntry: ") (let* ((args (with-temp-buffer @@ -95,7 +136,7 @@ Return the difference in the format of a time value." (insert (with-temp-buffer (setq exit-code - (apply #'ledger-run-ledger ledger-buf "entry" + (apply #'ledger-exec-ledger ledger-buf ledger-buf "entry" (mapcar 'eval args))) (goto-char (point-min)) (if (looking-at "Error: ") -- cgit v1.2.3 From 24b791ad078e36cfd8f895544636320467aa70ce Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Wed, 16 Jan 2013 17:50:31 -0600 Subject: Apply patch to update ldg-reconcile.el --- lisp/ldg-reconcile.el | 40 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 39 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index baeadc33..d3dda60f 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -105,7 +105,45 @@ (ledger-reconcile-save)) (defun ledger-do-reconcile () - ) + (let* ((buf ledger-buf) + (account ledger-acct) + (items + (with-current-buffer + (apply #'ledger-exec-ledger + buf nil "emacs" account "--uncleared" '("--real")) + (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))) (defun ledger-reconcile (account) (interactive "sAccount to reconcile: ") -- 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') 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 426e1056518301456959e27fd0bbb16829274a1b Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 29 Jan 2013 12:16:47 -0700 Subject: Fixed the new ledger mod so that loading leg-new.el is sufficient The reconcile package and the xact package didn't provide themselves, and the leg-new module didn't load up everything it needed. --- lisp/ldg-new.el | 13 +++++++++---- lisp/ldg-reconcile.el | 2 ++ lisp/ldg-xact.el | 1 + 3 files changed, 12 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index 8505fe4a..d9e0fc60 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -32,12 +32,17 @@ ;;; Commentary: -(require 'ldg-post) -(require 'ldg-mode) (require 'ldg-complete) -(require 'ldg-state) +(require 'ldg-exec) +(require 'ldg-mode) +(require 'ldg-post) +(require 'ldg-reconcile) +(require 'ldg-register) (require 'ldg-report) - +(require 'ldg-state) +(require 'ldg-test) +(require 'ldg-texi) +(require 'ldg-xact) ;(autoload #'ledger-mode "ldg-mode" nil t) ;(autoload #'ledger-fully-complete-entry "ldg-complete" nil t) ;(autoload #'ledger-toggle-current "ldg-state" nil t) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 73409e66..08dbc587 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -203,3 +203,5 @@ (define-key map [menu-bar ldg-recon-menu sav] '("Save" . ledger-reconcile-save)) (use-local-map map))) + +(provide 'ldg-reconcile) \ No newline at end of file diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index e1f165a7..6e14a14c 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -18,3 +18,4 @@ (lambda () (forward-paragraph)))))) +(provide 'ldg-xact) \ No newline at end of file -- cgit v1.2.3 From 619b6abd5ca3713a01c1fcb38a055f037cbc30af Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 29 Jan 2013 12:47:27 -0700 Subject: Fixes the set-year and set-month functions Also adds current year and month to the entry prompt. --- lisp/ldg-mode.el | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index caa57e8e..e36dc969 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -1,3 +1,16 @@ +(defsubst ledger-current-year () + (format-time-string "%Y")) +(defsubst ledger-current-month () + (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.") +(defvar ledger-month (ledger-current-month) + "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." :type 'string @@ -152,7 +165,8 @@ Return the difference in the format of a time value." (setq ledger-month (format "%02d" newmonth)))) (defun ledger-add-entry (entry-text &optional insert-at-point) - (interactive "sEntry: ") + (interactive (list + (read-string "Entry: " (concat ledger-year "/" ledger-month "/")))) (let* ((args (with-temp-buffer (insert entry-text) (eshell-parse-arguments (point-min) (point-max)))) -- 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') 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 97550db9bd08671d6b5c84a6a99a61c4779c0cee Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 30 Jan 2013 13:27:51 -0700 Subject: Removed call to ledger-reports-patch-reports This function was never defined and appeared to nothing. I caused errors on some system by not existing. --- lisp/ldg-mode.el | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 842cd582..128dfeac 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -117,12 +117,7 @@ customizable to ease retro-entry.") (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))) + (define-key map [menu-bar ldg-menu re] '("Reconcile Account" . ledger-reconcile)))) (defun ledger-time-less-p (t1 t2) "Say whether time value T1 is less than time value T2." -- cgit v1.2.3 From 0e16ce75f0c219cb83568c1a5b2362bd5028768d Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 30 Jan 2013 21:50:23 -0700 Subject: Add ability to reconcile new account without switching recon buffers Show cleared balance on command Update documentation --- doc/ledger3.texi | 6 +++++- lisp/ldg-reconcile.el | 11 +++++++++++ 2 files changed, 16 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/doc/ledger3.texi b/doc/ledger3.texi index ee4c990b..79ce0b0d 100644 --- a/doc/ledger3.texi +++ b/doc/ledger3.texi @@ -2502,13 +2502,17 @@ all of the uncleared transactions. The reconcile buffer has several functions: @item C-x C-s to save changes (to the ledger file as well). @item q - quite the reconcile mode + quit the reconcile mode @item n p next line or previous line @item A add entry @item D delete entry + @item g + reconcile new account + @item b + show cleared balance in mini-buffer @item C-l refresh display @end table diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 011bf400..aaccfb07 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -26,6 +26,7 @@ (defun ledger-display-balance () "Calculate the cleared balance of the account being reconciled" + (interactive) (let ((buffer ledger-buf) (account ledger-acct)) (with-temp-buffer @@ -64,6 +65,11 @@ (forward-line) (ledger-display-balance))) +(defun ledger-reconcile-new-account (account) + (interactive "sAccount to reconcile: ") + (set (make-local-variable 'ledger-acct) account) + (ledger-reconcile-refresh)) + (defun ledger-reconcile-refresh () (interactive) (let ((inhibit-read-only t) @@ -203,10 +209,12 @@ (define-key map [? ] 'ledger-reconcile-toggle) (define-key map [?a] 'ledger-reconcile-add) (define-key map [?d] 'ledger-reconcile-delete) + (define-key map [?g] 'ledger-reconcile-new-account) (define-key map [?n] 'next-line) (define-key map [?p] 'previous-line) (define-key map [?s] 'ledger-reconcile-save) (define-key map [?q] 'ledger-reconcile-quit) + (define-key map [?b] 'ledger-display-balance) (define-key map [menu-bar] (make-sparse-keymap "ldg-recon-menu")) (define-key map [menu-bar ldg-recon-menu] (cons "Reconcile" map)) @@ -220,6 +228,9 @@ (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 bal] '("Show Cleared Balance" . ledger-display-balance)) + (define-key map [menu-bar ldg-recon-menu sep4] '("--")) + (define-key map [menu-bar ldg-recon-menu rna] '("Reconcile New Account" . ledger-reconcile-new-account)) (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)) -- cgit v1.2.3 From 5c91124955b2c570b071dc81ac971f9c75b406cf Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 31 Jan 2013 15:13:00 -0700 Subject: WIP. ledger-sort-region still drops the first transaction in the region. --- lisp/ldg-mode.el | 4 ++-- lisp/ldg-xact.el | 35 +++++++++++++++++++++++------------ 2 files changed, 25 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 128dfeac..9efe7618 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -82,7 +82,7 @@ customizable to ease retro-entry.") (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) + (define-key map [(control ?c) (control ?s)] 'ledger-sort-buffer) (define-key map [(control ?c) (control ?t)] 'ledger-test-run) (define-key map [tab] 'pcomplete) (define-key map [(control ?i)] 'pcomplete) @@ -109,7 +109,7 @@ customizable to ease retro-entry.") (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 so] '("Sort Buffer or Region" . ledger-sort-buffer)) (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)) diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index 11e6fbaf..8907f58e 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -22,21 +22,32 @@ ;; A sample entry sorting function, which works if entry dates are of ;; the form YYYY/mm/dd. -(defun ledger-sort () - (interactive) - (save-excursion - (goto-char (point-min)) - (sort-subr - nil - (function - (lambda () +(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))))) - (function - (lambda () - (forward-paragraph)))))) + (goto-char (point-max)))) + +(defun ledger-end-record-function () + (forward-paragraph)) + +(defun ledger-sort-region (beg end) + (interactive "r") ;load beg and end from point and mark automagically + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (message "%s %s %s" beg end (point-min)) + (let ((inhibit-field-text-motion t)) + (sort-subr + nil + 'ledger-next-record-function + 'ledger-end-record-function))))) + +(defun ledger-sort-buffer () + (interactive) + (ledger-sort-region (point-min) (point-max))) + (provide 'ldg-xact) \ No newline at end of file -- cgit v1.2.3 From 7cb3b099867b0537ae055431dc33454836eb0bc6 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 31 Jan 2013 22:15:10 -0700 Subject: Customizable font-locking Moved font code into separate file. created faces that can be customized in using the emacs customizations menu group ledger-faces --- lisp/ldg-fonts.el | 73 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/ldg-mode.el | 13 ---------- lisp/ldg-new.el | 1 + 3 files changed, 74 insertions(+), 13 deletions(-) create mode 100644 lisp/ldg-fonts.el (limited to 'lisp') diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el new file mode 100644 index 00000000..9f98a9fd --- /dev/null +++ b/lisp/ldg-fonts.el @@ -0,0 +1,73 @@ +;;; ldg-fonts.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-faces nil "Ledger mode highlighting" :group 'ledger) +(defface ledger-font-uncleared-face + `((t :foreground "green" :weight bold )) + "Default face for Ledger" + :group 'ledger-faces) + +(defface ledger-font-cleared-face + `((t :foreground "grey70" :weight normal )) + "Default face for cleared (*) transactions" + :group 'ledger-faces) + +(defface ledger-font-pending-face + `((t :foreground "yellow" :weight normal )) + "Default face for pending (!) transactions" + :group 'ledger-faces) + +(defface ledger-font-other-face + `((t :foreground "yellow" )) + "Default face for other transactions" + :group 'ledger-faces) + +(defface ledger-font-posting-account-face + `((t :foreground "lightblue" )) + "Face for Ledger accounts" + :group 'ledger-faces) + +(defface ledger-font-posting-amount-face + `((t :foreground "yellow" )) + "Face for Ledger amounts" + :group 'ledger-faces) + +(defface ledger-font-comment-face + `((t :foreground "orange" )) + "Face for Ledger comments" + :group 'ledger-faces) + + +(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) + ("^\\s-+\\([*]\\s-*\\)?\\(\\([[(]\\)?[^*: + ]+?:\\([^]); + ]\\|\\s-\\)+?\\([])]\\)?\\)\\( \\| \\|$\\)" + 2 'ledger-font-posting-account-face) ; works + ("\\( \\| \\|^\\)\\(;.*\\)" 2 'ledger-font-comment-face) ; works + ("^\\([~=].+\\)" 1 ledger-font-other-face) + ("^\\([A-Za-z]+ .+\\)" 1 ledger-font-other-face)) + "Expressions to highlight in Ledger mode.") + +(provide 'ldg-fonts) \ No newline at end of file diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 128dfeac..10497749 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -38,19 +38,6 @@ customizable to ease retro-entry.") :type 'string :group 'ledger) -(defvar bold 'bold) -(defvar ledger-font-lock-keywords - '(("\\( \\| \\|^\\)\\(;.*\\)" 2 font-lock-comment-face) - ("^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)" 2 bold) - ;;("^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)" - ;; 2 font-lock-type-face) - ("^\\s-+\\([*]\\s-*\\)?\\(\\([[(]\\)?[^*: - ]+?:\\([^]); - ]\\|\\s-\\)+?\\([])]\\)?\\)\\( \\| \\|$\\)" - 2 font-lock-keyword-face) - ("^\\([~=].+\\)" 1 font-lock-function-name-face) - ("^\\([A-Za-z]+ .+\\)" 1 font-lock-function-name-face)) - "Expressions to highlight in Ledger mode.") (defvar ledger-mode-abbrev-table) diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index d9e0fc60..4793f662 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -43,6 +43,7 @@ (require 'ldg-test) (require 'ldg-texi) (require 'ldg-xact) +(require 'ldg-fonts) ;(autoload #'ledger-mode "ldg-mode" nil t) ;(autoload #'ledger-fully-complete-entry "ldg-complete" nil t) ;(autoload #'ledger-toggle-current "ldg-state" nil t) -- cgit v1.2.3 From 0675208a63837b0ce6802b5124bb90514f07b5e0 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 1 Feb 2013 10:19:47 -0700 Subject: Add regional sort facility to ledger mode C-c C-s now bound to ledger-sort-region. ledger-sort-region is smart and find the beginning of the first xact within the region and the beginning of the first xact AFTER the region so that it can keep posing structure intact --- doc/ledger3.texi | 2 +- lisp/ldg-mode.el | 5 +++-- lisp/ldg-new.el | 1 + lisp/ldg-sort.el | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/ldg-xact.el | 26 ------------------------ 5 files changed, 67 insertions(+), 29 deletions(-) create mode 100644 lisp/ldg-sort.el (limited to 'lisp') diff --git a/doc/ledger3.texi b/doc/ledger3.texi index 79ce0b0d..ac0208bd 100644 --- a/doc/ledger3.texi +++ b/doc/ledger3.texi @@ -2376,7 +2376,7 @@ reconcile uncleared entries related to an account @item C-c C-d delete the current entry @item C-c C-s -sort all entries in the journal by date. Drop comments outside of entries +sort all entries in the region. @item C-c C-o C-r run a ledger report @item C-C C-o C-g diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 6179747d..001ec8eb 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -69,7 +69,7 @@ customizable to ease retro-entry.") (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-buffer) + (define-key map [(control ?c) (control ?s)] 'ledger-sort-region) (define-key map [(control ?c) (control ?t)] 'ledger-test-run) (define-key map [tab] 'pcomplete) (define-key map [(control ?i)] 'pcomplete) @@ -96,7 +96,8 @@ customizable to ease retro-entry.") (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 or Region" . ledger-sort-buffer)) + (define-key map [menu-bar ldg-menu so1] '("Sort Buffer" . ledger-sort-buffer)) + (define-key map [menu-bar ldg-menu so2] '("Sort Region" . ledger-sort-region)) (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)) diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index 4793f662..c885cf21 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -43,6 +43,7 @@ (require 'ldg-test) (require 'ldg-texi) (require 'ldg-xact) +(require 'ldg-sort) (require 'ldg-fonts) ;(autoload #'ledger-mode "ldg-mode" nil t) ;(autoload #'ledger-fully-complete-entry "ldg-complete" nil t) diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el new file mode 100644 index 00000000..e1988413 --- /dev/null +++ b/lisp/ldg-sort.el @@ -0,0 +1,62 @@ +;;; 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. + +(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)))) + +(defun ledger-end-record-function () + (forward-paragraph)) + +(defun ledger-sort-region (beg end) + (interactive "r") ;load beg and end from point and mark automagically + (let ((new-beg beg) + (new-end end)) + (save-excursion + (save-restriction + (ledger-next-record-function) ;make sure point is at the beginning of a xact + (message "beg: %s end: %s" new-beg new-end) + (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 + (setq new-end (point)) + (narrow-to-region beg end) + (goto-char (point-min)) + + (let ((inhibit-field-text-motion t)) + (sort-subr + nil + 'ledger-next-record-function + 'ledger-end-record-function)))))) + +(defun ledger-sort-buffer () + (interactive) + (ledger-sort-region (point-min) (point-max))) + + +(provide 'ldg-sort) \ No newline at end of file diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index 8907f58e..1df7d79a 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -22,32 +22,6 @@ ;; A sample entry sorting function, which works if entry dates are of ;; 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)))) - -(defun ledger-end-record-function () - (forward-paragraph)) - -(defun ledger-sort-region (beg end) - (interactive "r") ;load beg and end from point and mark automagically - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (message "%s %s %s" beg end (point-min)) - (let ((inhibit-field-text-motion t)) - (sort-subr - nil - 'ledger-next-record-function - 'ledger-end-record-function))))) - -(defun ledger-sort-buffer () - (interactive) - (ledger-sort-region (point-min) (point-max))) (provide 'ldg-xact) \ No newline at end of file -- cgit v1.2.3 From edd82b2639e8a4d1f865dfae898caf678a9e7cbd Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 1 Feb 2013 11:39:48 -0700 Subject: Add custom faces to the reconciler --- lisp/ldg-fonts.el | 15 +++++++++++++++ lisp/ldg-reconcile.el | 17 +++++++++++------ 2 files changed, 26 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el index 9f98a9fd..2b7717c6 100644 --- a/lisp/ldg-fonts.el +++ b/lisp/ldg-fonts.el @@ -56,6 +56,21 @@ "Face for Ledger comments" :group 'ledger-faces) +(defface ledger-font-reconciler-uncleared-face + `((t :foreground "green" :weight normal )) + "Default face for uncleared transactions in the reconcile window" + :group 'ledger-faces) + +(defface ledger-font-reconciler-cleared-face + `((t :foreground "grey70" :weight normal )) + "Default face for cleared (*) transactions in the reconcile window" + :group 'ledger-faces) + +(defface ledger-font-reconciler-pending-face + `((t :foreground "yellow" :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-reconcile.el b/lisp/ldg-reconcile.el index aaccfb07..02d0662a 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -55,13 +55,17 @@ (with-current-buffer ledger-buf (goto-char (cdr where)) (setq cleared (ledger-toggle-current-entry))) + ;remove the existing face and add the new face + (remove-text-properties (line-beginning-position) + (line-end-position) + (list 'face)) (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)))) + (list 'face 'ledger-font-reconciler-cleared-face )) + (add-text-properties (line-beginning-position) + (line-end-position) + (list 'face 'ledger-font-reconciler-uncleared-face )))) (forward-line) (ledger-display-balance))) @@ -172,10 +176,11 @@ (nth 4 item) (nth 1 xact) (nth 2 xact))) (if (nth 3 xact) (set-text-properties beg (1- (point)) - (list 'face 'bold + (list 'face 'ledger-font-reconciler-cleared-face 'where where)) (set-text-properties beg (1- (point)) - (list 'where where)))) + (list 'face 'ledger-font-reconciler-uncleared-face + 'where where)))) (setq index (1+ index))))) (goto-char (point-min)) (set-buffer-modified-p nil) -- cgit v1.2.3 From 36e77bd357e41dc02b79617401845640d02963f6 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 1 Feb 2013 16:15:51 -0700 Subject: Check for ledger executable and version Altered menu creation so that menu functions are disable if there is no ledger executable available command keys will also warn if ledger isn't working remove a debug message from leg-sort --- lisp/ldg-exec.el | 31 +++++++++++++++++++++++++ lisp/ldg-mode.el | 70 +++++++++++++++++++++++++++++++------------------------- lisp/ldg-sort.el | 1 - 3 files changed, 70 insertions(+), 32 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-exec.el b/lisp/ldg-exec.el index ab041fec..f13cfa5a 100644 --- a/lisp/ldg-exec.el +++ b/lisp/ldg-exec.el @@ -19,6 +19,12 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; MA 02111-1307, USA. +(defconst ledger-version-needed "3.0.0" + "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") + (defgroup ledger-exec nil "Interface to the Ledger command-line accounting program." :group 'ledger) @@ -52,4 +58,29 @@ (read (current-buffer)) (kill-buffer (current-buffer))))) +(defun ledger-version-greater-p (needed) + "verify the ledger binary is usable for ledger-mode" + (let ((buffer ledger-buf) + (version-strings '()) + (version-number)) + (with-temp-buffer + (ledger-exec-ledger buffer (current-buffer) "--version") + (goto-char (point-min)) + (delete-horizontal-space) + (setq version-strings (split-string + (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))))) + t + nil)))) + +(defun ledger-check-version () + (interactive) + (setq ledger-works (ledger-version-greater-p ledger-version-needed)) + (if ledger-works + (message "Good Ledger Version") + (message "Bad Ledger Version"))) + (provide 'ldg-exec) diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 001ec8eb..91bfb973 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -41,10 +41,18 @@ customizable to ease retro-entry.") (defvar ledger-mode-abbrev-table) +(defmacro ledger-run-if-works (func-to-call) + "Macro to run func-to-call only if the ledger-works variable is non-nil" + `(lambda () + (interactive) + (if ledger-works + (funcall ,func-to-call) + (message "Cannot run ledger, check your ledger executable")))) ;;;###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) " ; ") @@ -62,50 +70,50 @@ customizable to ease retro-entry.") (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 ?a)] (ledger-run-if-works '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 ?y)] (ledger-run-if-works 'ledger-set-year)) + (define-key map [(control ?c) (control ?m)] (ledger-run-if-works '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 ?r)] (ledger-run-if-works '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 ?t)] (ledger-run-if-works 'ledger-test-run)) (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 [(control ?c) (control ?o) (control ?r)] (ledger-run-if-works 'ledger-report)) + (define-key map [(control ?c) (control ?o) (control ?g)] (ledger-run-if-works 'ledger-report-goto)) + (define-key map [(control ?c) (control ?o) (control ?a)] (ledger-run-if-works 'ledger-report-redo)) + (define-key map [(control ?c) (control ?o) (control ?s)] (ledger-run-if-works 'ledger-report-save)) + (define-key map [(control ?c) (control ?o) (control ?e)] (ledger-run-if-works 'ledger-report-edit)) + (define-key map [(control ?c) (control ?o) (control ?k)] (ledger-run-if-works '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 so1] '("Sort Buffer" . ledger-sort-buffer)) - (define-key map [menu-bar ldg-menu so2] '("Sort Region" . ledger-sort-region)) - (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)))) + (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 [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)))) (defun ledger-time-less-p (t1 t2) "Say whether time value T1 is less than time value T2." diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el index e1988413..9cecefa4 100644 --- a/lisp/ldg-sort.el +++ b/lisp/ldg-sort.el @@ -39,7 +39,6 @@ (save-excursion (save-restriction (ledger-next-record-function) ;make sure point is at the beginning of a xact - (message "beg: %s end: %s" new-beg new-end) (setq new-beg (point)) (goto-char end) (ledger-next-record-function) ;make sure end of region is at the beginning of -- cgit v1.2.3 From c875de881a3998ec9a9815acded80f381701e711 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 1 Feb 2013 21:59:51 -0700 Subject: Fixed key-binges The fancy lambdas detecting whether or not the command could be run weren't passing interactive arguments --- lisp/ldg-mode.el | 34 +++++++++++++++------------------- 1 file changed, 15 insertions(+), 19 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 91bfb973..c6d899de 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -41,14 +41,6 @@ customizable to ease retro-entry.") (defvar ledger-mode-abbrev-table) -(defmacro ledger-run-if-works (func-to-call) - "Macro to run func-to-call only if the ledger-works variable is non-nil" - `(lambda () - (interactive) - (if ledger-works - (funcall ,func-to-call) - (message "Cannot run ledger, check your ledger executable")))) - ;;;###autoload (define-derived-mode ledger-mode text-mode "Ledger" "A mode for editing ledger data files." @@ -70,25 +62,29 @@ customizable to ease retro-entry.") (set (make-local-variable 'pcomplete-termination-string) "") (let ((map (current-local-map))) - (define-key map [(control ?c) (control ?a)] (ledger-run-if-works 'ledger-add-entry)) +; (define-key map [(control ?c) (control ?a)] '(lambda (account) +; (interactive "sAccount:") +; (if ledger-works +; (ledger-add-entry account)))) + (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-run-if-works 'ledger-set-year)) - (define-key map [(control ?c) (control ?m)] (ledger-run-if-works 'ledger-set-month)) + (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-run-if-works 'ledger-reconcile)) + (define-key map [(control ?c) (control ?r)] 'ledger-reconcile) (define-key map [(control ?c) (control ?s)] 'ledger-sort-region) - (define-key map [(control ?c) (control ?t)] (ledger-run-if-works 'ledger-test-run)) + (define-key map [(control ?c) (control ?t)] 'ledger-test-run) (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-run-if-works 'ledger-report)) - (define-key map [(control ?c) (control ?o) (control ?g)] (ledger-run-if-works 'ledger-report-goto)) - (define-key map [(control ?c) (control ?o) (control ?a)] (ledger-run-if-works 'ledger-report-redo)) - (define-key map [(control ?c) (control ?o) (control ?s)] (ledger-run-if-works 'ledger-report-save)) - (define-key map [(control ?c) (control ?o) (control ?e)] (ledger-run-if-works 'ledger-report-edit)) - (define-key map [(control ?c) (control ?o) (control ?k)] (ledger-run-if-works 'ledger-report-kill)) + (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")) -- cgit v1.2.3 From 7c618e541d4c1e5e4ac476b6724abf2ec97a38b2 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 1 Feb 2013 22:34:28 -0700 Subject: Added menu and keybinding for ledger-post-edit-amount editing the amount with calc is too cool for school. I can't believe I didn't see it before. It is in the docs now as well. --- doc/ledger3.texi | 13 +++++++++++++ lisp/ldg-mode.el | 11 ++++++----- lisp/ldg-post.el | 5 ----- 3 files changed, 19 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/doc/ledger3.texi b/doc/ledger3.texi index be7d7e98..815c770b 100644 --- a/doc/ledger3.texi +++ b/doc/ledger3.texi @@ -2403,6 +2403,7 @@ kill the ledger report buffer * Manual Entry Support:: * Automagically Adding new entries:: * Clearing Transactions:: +* Calculating Values with EMACS Calc:: @end menu @node Manual Entry Support, Automagically Adding new entries, Working with entries, Working with entries @@ -2487,6 +2488,18 @@ If, for some reason you need to clear a specific posting in the transaction you can type @code{C-c C-c} and the posting at point will be toggled. +@node Calculating Values with EMACS Calc, , Clearing Transactions, Working with entries +@subsubsection Calculating Values with EMACS Calc + +EMACS come with a very power calculator built in. You can use it to +easily insert calculated amounts directly into your ledger buffer. From +the menu, select @code{Calc on Amount}. Calc will pull the current +amount to the top of the calc stack. Calulate the value as you normally +would with an RPN calculator. When you have the desired value on thetop +of the calc stack, press @code{y}, and calc will insert the value +in place of the previous amount. + + @node Reconciling accounts, Generating Reports, Working with entries, Using EMACS @subsection Reconciling accounts diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index c6d899de..c185c198 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -62,10 +62,6 @@ customizable to ease retro-entry.") (set (make-local-variable 'pcomplete-termination-string) "") (let ((map (current-local-map))) -; (define-key map [(control ?c) (control ?a)] '(lambda (account) -; (interactive "sAccount:") -; (if ledger-works -; (ledger-add-entry account)))) (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) @@ -75,6 +71,7 @@ customizable to ease retro-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 [tab] 'pcomplete) (define-key map [(control ?i)] 'pcomplete) (define-key map [(control ?c) tab] 'ledger-fully-complete-entry) @@ -86,7 +83,9 @@ customizable to ease retro-entry.") (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)) @@ -106,6 +105,8 @@ customizable to ease retro-entry.") (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 "--")) diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 7cb525a7..14a8cdad 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -183,11 +183,6 @@ This is done so that the last digit falls in COLUMN, which defaults to 52." (goto-char (match-end ledger-regex-post-line-group-account)))) (defun ledger-post-setup () - (let ((map (current-local-map))) - (define-key map [(meta ?p)] 'ledger-post-prev-xact) - (define-key map [(meta ?n)] 'ledger-post-next-xact) - (define-key map [(control ?c) (control ?c)] 'ledger-post-pick-account) - (define-key map [(control ?c) (control ?e)] 'ledger-post-edit-amount)) (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)))) -- cgit v1.2.3 From cf76c2559904740e7ea7f99965c01814d3799349 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 2 Feb 2013 09:15:03 -0700 Subject: If there is no XACT code print blank, not "nil" --- lisp/ldg-reconcile.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 02d0662a..753c2fa5 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -172,7 +172,9 @@ (point-marker))))))) (insert (format "%s %-4s %-30s %-30s %15s\n" (format-time-string "%Y/%m/%d" (nth 2 item)) - (nth 3 item) + (if (nth 3 item) + (nth 3 item) + "") (nth 4 item) (nth 1 xact) (nth 2 xact))) (if (nth 3 xact) (set-text-properties beg (1- (point)) -- cgit v1.2.3 From c4c088b55b2528292cf8b84eb36632f7d4343075 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 4 Feb 2013 10:08:34 -0700 Subject: Fixed ledger-post-edit-amount so that it can be called from the and of an account with a null amount. It automagically determines if the account has two spaces after and if not inserts them. --- lisp/ldg-post.el | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 14a8cdad..dc033bf8 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -156,16 +156,23 @@ This is done so that the last digit falls in COLUMN, which defaults to 52." (defun ledger-post-edit-amount () (interactive) (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)) - (when (re-search-forward "[-.,0-9]+" (line-end-position) t) - (let ((val (match-string 0))) - (goto-char (match-beginning 0)) - (delete-region (match-beginning 0) (match-end 0)) - (calc) - (while (string-match "," val) - (setq val (replace-match "" nil nil val))) - (calc-eval val 'push))))) + (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 + (if end-of-amount + (let ((val (match-string 0))) + (goto-char (match-beginning 0)) + (delete-region (match-beginning 0) (match-end 0)) + (calc) + (while (string-match "," val) + (setq val (replace-match "" nil nil val))) ;gets rid of commas + (calc-eval val 'push)) ;edit the amount + (progn ;make sure there are two spaces after the account name and go to calc + (if (search-backward " " (- (point) 3) t) + (goto-char (line-end-position)) + (insert " ")) + (calc)) + )))) (defun ledger-post-prev-xact () (interactive) -- cgit v1.2.3 From 71de1e6cdcdea280f5bf63a8a2e3d7a22411c663 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 5 Feb 2013 11:07:36 -0700 Subject: Enh 246 add code folding to ledger mode Based on loccur. Hides everything but the xacts that match a regex. Linked to reconcile mode so that when you reconcile an account on xacts with that account are shown. Documentation updated --- doc/ledger3.texi | 51 +++++++++- lisp/ldg-mode.el | 5 +- lisp/ldg-new.el | 2 + lisp/ldg-occur.el | 252 ++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/ldg-reconcile.el | 165 ++++++++++++++++++--------------- 5 files changed, 394 insertions(+), 81 deletions(-) create mode 100644 lisp/ldg-occur.el (limited to 'lisp') diff --git a/doc/ledger3.texi b/doc/ledger3.texi index 815c770b..ce062104 100644 --- a/doc/ledger3.texi +++ b/doc/ledger3.texi @@ -2367,6 +2367,8 @@ add a new entry, based on previous entries toggle cleared status of an entire entry @item C-c C-c toggle cleared status of an individual posting +@item C-c C-f +toggle folding mode. When on shows only transactions that meet a given REGEX @item C-c C-y set default year for entry mode @item C-c C-m @@ -2401,12 +2403,13 @@ kill the ledger report buffer @subsection Working with entries @menu * Manual Entry Support:: +* Hiding Transactions:: * Automagically Adding new entries:: * Clearing Transactions:: * Calculating Values with EMACS Calc:: @end menu -@node Manual Entry Support, Automagically Adding new entries, Working with entries, Working with entries +@node Manual Entry Support, Hiding Transactions, Working with entries, Working with entries @subsubsection Manual Entry Support @cindex completion @@ -2427,8 +2430,38 @@ habit to get in to prevent misspellings of accounts. Remember Ledger does not validate the names of payees or account so a misspelled account will be interpreted as a new account by ledger. +@node Hiding Transactions, Automagically Adding new entries, Manual Entry Support, Working with entries +@subsubsection Hiding Transactions + +There are several ways to organize Ledger data files. You can use a +master file and @code{include} one file for each real bank or brokerage +account, separate files for major expense categories, a mix of those +ideas, or throw every transaction in to one giant file. The biggest +drawback to uing one file is that it can get confusing finding specific +transactions in the file. + +Ledger mode has a special transaction hiding mode that you can use to +hide all transactions except those that meet a regular expression you +provide. By default this command is bound to @code{C-c C-f}. EMACS +will ask for a regular expression, which at its simplest is just text +you want to match. For example, lets say you want to review the +transactions in your checking account named @code{"Assets:Checking"}. +Type @code{C-c C-f}, then type @code{Checking} in the minibuffer. EMACS +will hide all other transactions and highlight the remaining +transactions. You can edit them without fear that your other +transaction have had anything done, they are only hidden from view. + +The color used to highlight the xaction can be customized in the EMACS +customization menu. It is called @code{ledger-occur-xact-face}, and can +be changed to alter any charactistic of a font that you want. If you +don't want any highlighting, simply set +@code{ledger-occur-use-face-unfolded} to @code{nil} in the customization +menu. + +To clear the highlighting and show all transactions, type @code{C-c C-f} +again. -@node Automagically Adding new entries, Clearing Transactions, Manual Entry Support, Working with entries +@node Automagically Adding new entries, Clearing Transactions, Hiding Transactions, Working with entries @subsubsection Automagically Adding new entries @cindex new transactions in EMACS @cindex EMACS, adding new transactions @@ -2463,7 +2496,7 @@ ordered by date, not at the bottom of the file. If you need to include spaces in the payee name, then surrond the name of the payee with double quotes, otherwise ledger will interpret the second part of the name as an account. -@node Clearing Transactions, , Automagically Adding new entries, Working with entries +@node Clearing Transactions, Calculating Values with EMACS Calc, Automagically Adding new entries, Working with entries @subsubsection Clearing Transactions and Postings @cindex clearing transactions in EMACS @cindex EMACS, clear transaction @@ -2491,7 +2524,7 @@ toggled. @node Calculating Values with EMACS Calc, , Clearing Transactions, Working with entries @subsubsection Calculating Values with EMACS Calc -EMACS come with a very power calculator built in. You can use it to +EMACS come with a very powerful calculator built in. You can use it to easily insert calculated amounts directly into your ledger buffer. From the menu, select @code{Calc on Amount}. Calc will pull the current amount to the top of the calc stack. Calulate the value as you normally @@ -2529,6 +2562,14 @@ all of the uncleared transactions. The reconcile buffer has several functions: @item C-l refresh display @end table + +By default the reconcile mode uses transaction hiding to show only +transaction eligible for your reconcile. Th reconcile widow itself will +only show a summary of uncleared transaction while the main buffer will +show all transaction meeting the regex, cleared or not. This behavior +can be disabled by setting @code{ledger-fold-on-reconcile} to nil in the +emacs customization menus. + @node Generating Reports, , Reconciling accounts, Using EMACS @subsection Generating Reports @@ -2539,7 +2580,7 @@ retyping the command line, or writing shell scripts for simple one line commands. To generate a report, select the @code{Run Reports} menu, or type -@code{C-c C-o C-r}. Emacs will prompt for a report name. If it +@code{C-c C-o C-r}. EMACS will prompt for a report name. If it recognizes the name it will run the report again. If it is a new name, or blank it will respond by giving you an example command line to edit. Hitting return willrun the report and present it in a new buffer. diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index c185c198..4c55cdc0 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -72,6 +72,7 @@ customizable to ease retro-entry.") (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) @@ -110,7 +111,9 @@ customizable to ease retro-entry.") (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 "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." diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index c885cf21..1d7d5cac 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -45,6 +45,8 @@ (require 'ldg-xact) (require 'ldg-sort) (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) diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el new file mode 100644 index 00000000..9cf7f3b1 --- /dev/null +++ b/lisp/ldg-occur.el @@ -0,0 +1,252 @@ +;;; 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. + + + + +;;; Commentary: +;; Provide code folding to ledger mode. Adapted from original loccur +;; mode by Alexey Veretennikov +;; +;; Adapted to ledger mode by Craig Earls + +;;; Code: + +(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 + `((t :background "blue" :weight normal )) + "Default face for Ledger occur mode shown transactions" + :group 'ledger-faces) + +(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" + :group 'ledger) +(make-variable-buffer-local 'ledger-occur-use-face-unfolded) + + +(defvar ledger-occur-mode nil) ;; name of the minor mode, shown in the mode-line +(make-variable-buffer-local 'ledger-occur-mode) + +(or (assq 'ledger-occur-mode minor-mode-alist) + (nconc minor-mode-alist + (list '(ledger-occur-mode ledger-occur-mode)))) + +(defvar ledger-occur-history nil + "History of previously searched expressions for the prompt") +(make-variable-buffer-local 'ledger-occur-history) + +(defvar ledger-occur-last-match nil + "Last match found") +(make-variable-buffer-local 'ledger-occur-last-match) + +(defvar ledger-occur-overlay-list nil + "A list of currently active overlays to the ledger buffer.") +(make-variable-buffer-local 'ledger-occur-overlay-list) + + +(defun ledger-occur-mode (regex buffer) + (save-excursion + (set-buffer buffer) + (setq ledger-occur-mode + (if (or ledger-occur-mode + (null regex) + (zerop (length regex))) + nil + (concat " Ledger-Folded: " 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-folded-overlays buffer-matches))) + (setq ledger-occur-last-match regex)) + (recenter)))) + +(defun ledger-occur (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 + of the function unhides lines again" + (interactive + (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))) + (ledger-occur-mode regex (current-buffer))) + +(defun ledger-occur-prompt () + "Returns the default value of the prompt. + + Default value for prompt is a current word or active + region(selection), if its size is 1 line" + (let ((prompt + (if (and transient-mark-mode + mark-active) + (let ((pos1 (region-beginning)) + (pos2 (region-end))) + ;; Check if the start and the of an active region is on + ;; the same line + (if (= (line-number-at-pos pos1) + (line-number-at-pos pos2)) + (buffer-substring-no-properties pos1 pos2))) + (current-word)))) + prompt)) + +(defun ledger-occur-create-folded-overlays(buffer-matches) + (let ((overlays + (let ((prev-end (point-min)) + (temp (point-max))) + (mapcar (lambda (match) + (progn + (setq temp prev-end) ;need a swap so that the + ;last form in the lambda + ;is the (make-overlay) + (setq prev-end (1+ (cadr match))) ;add 1 so + ;that we skip + ;the empty + ;line after + ;the xact + (make-overlay + temp + (car match) + (current-buffer) t nil))) + buffer-matches)))) + (mapcar (lambda (ovl) + (overlay-put ovl ledger-occur-overlay-property-name t) + (overlay-put ovl 'invisible t) + (overlay-put ovl 'intangible t)) + (push (make-overlay (cadr (car(last buffer-matches))) + (point-max) + (current-buffer) t nil) overlays)))) + + +(defun ledger-occur-create-xact-overlays (ovl-bounds) + (let ((overlays + (mapcar (lambda (bnd) + (make-overlay + (car bnd) + (cadr bnd) + (current-buffer) t nil)) + ovl-bounds))) + (mapcar (lambda (ovl) + (overlay-put ovl ledger-occur-overlay-property-name t) + (if ledger-occur-use-face-unfolded + (overlay-put ovl 'face 'ledger-occur-xact-face ))) + overlays))) + +(defun ledger-occur-change-regex (regex buffer) + "use this function to programatically change the overlays, + rather than quitting out and restarting" + (progn + (set-buffer buffer) + (setq ledger-occur-mode nil) + (force-mode-line-update) + (ledger-occur-mode regex buffer) + (recenter))) + +(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))) + +(defun ledger-occur-remove-overlays () + (interactive) + (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) + (let ((prev-end (point-min)) + (overlays (list))) + (when buffer-matches + (mapcar (lambda (line) + (push (list (car line) (cadr line)) overlays) + (setq prev-end (cadr line))) + buffer-matches) + (setq overlays (nreverse overlays))))) + +(defun ledger-occur-find-xact-extents (pos) + "return point for beginning of xact and and of xact containing + position. Requires empty line separating xacts" + (interactive "d") + (save-excursion + (goto-char pos) + (let ((end-pos pos) + (beg-pos pos)) + (backward-paragraph) + (next-line) + (beginning-of-line) + (setq beg-pos (point)) + (forward-paragraph) + (previous-line) + (end-of-line) + (setq end-pos (1+ (point))) + (list beg-pos end-pos)))) + +(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" + (save-excursion + (goto-char (point-min)) + ;; Set initial values for variables + (let ((curpoint nil) + (endpoint nil) + (lines (list))) + ;; Search loop + (while (not (eobp)) + (setq curpoint (point)) + ;; if something found + (when (setq endpoint (re-search-forward regex nil 'end)) + (save-excursion + (let ((bounds (ledger-occur-find-xact-extents (match-beginning 0)))) + (push bounds lines) + (setq curpoint (cadr bounds)))) ;move to the end of the + ;xact, no need to search + ;inside it more + (goto-char curpoint)) + (forward-line 1)) + (setq lines (nreverse lines))))) + + +(provide 'ldg-occur) + +;;; ldg-occur.el ends here diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 753c2fa5..0cac33c5 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -24,6 +24,12 @@ (defvar ledger-buf nil) (defvar ledger-acct nil) +(defcustom ledger-fold-on-reconcile t + "if t, limit transactions shown in main buffer to those + matching the reconcile regex" + :group 'ledger) +(make-variable-buffer-local 'ledger-fold-on-reconcilex) + (defun ledger-display-balance () "Calculate the cleared balance of the account being reconciled" (interactive) @@ -55,10 +61,10 @@ (with-current-buffer ledger-buf (goto-char (cdr where)) (setq cleared (ledger-toggle-current-entry))) - ;remove the existing face and add the new face + ;remove the existing face and add the new face (remove-text-properties (line-beginning-position) - (line-end-position) - (list 'face)) + (line-end-position) + (list 'face)) (if cleared (add-text-properties (line-beginning-position) (line-end-position) @@ -72,7 +78,11 @@ (defun ledger-reconcile-new-account (account) (interactive "sAccount to reconcile: ") (set (make-local-variable 'ledger-acct) account) - (ledger-reconcile-refresh)) + (let ((buf (current-buffer))) + (if ledger-fold-on-reconcile + (ledger-occur-change-regex account ledger-buf)) + (set-buffer buf) + (ledger-reconcile-refresh))) (defun ledger-reconcile-refresh () (interactive) @@ -125,7 +135,10 @@ (defun ledger-reconcile-quit () (interactive) - (kill-buffer (current-buffer))) + (let ((buf ledger-buf)) + (kill-buffer (current-buffer)) + (if ledger-fold-on-reconcile + (ledger-occur-quit-buffer buf)))) (defun ledger-reconcile-finish () (interactive) @@ -144,49 +157,49 @@ (defun ledger-do-reconcile () "get the uncleared transactions in the account and display them in the *Reconcile* buffer" - (let* ((buf ledger-buf) + (let* ((buf ledger-buf) (account ledger-acct) (items (with-temp-buffer (ledger-exec-ledger buf (current-buffer) "--uncleared" "--real" - "emacs" account) + "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 %-4s %-30s %-30s %15s\n" - (format-time-string "%Y/%m/%d" (nth 2 item)) - (if (nth 3 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 'ledger-font-reconciler-cleared-face - 'where where)) - (set-text-properties beg (1- (point)) - (list 'face 'ledger-font-reconciler-uncleared-face - 'where where)))) - (setq index (1+ index))))) - (goto-char (point-min)) - (set-buffer-modified-p nil) - (toggle-read-only t))) + (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)) + (if (nth 3 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 'ledger-font-reconciler-cleared-face + 'where where)) + (set-text-properties beg (1- (point)) + (list 'face 'ledger-font-reconciler-uncleared-face + 'where where)))) + (setq index (1+ index))))) + (goto-char (point-min)) + (set-buffer-modified-p nil) + (toggle-read-only t))) (defun ledger-reconcile (account) @@ -196,6 +209,8 @@ (if rbuf (kill-buffer rbuf)) (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save) + (if ledger-fold-on-reconcile + (ledger-occur-mode account buf)) (with-current-buffer (pop-to-buffer (get-buffer-create "*Reconcile*")) (ledger-reconcile-mode) @@ -206,41 +221,41 @@ (defvar ledger-reconcile-mode-abbrev-table) (define-derived-mode ledger-reconcile-mode text-mode "Reconcile" - "A mode for reconciling ledger entries." - (let ((map (make-sparse-keymap))) - (define-key map [(control ?m)] 'ledger-reconcile-visit) - (define-key map [return] 'ledger-reconcile-visit) - (define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish) - (define-key map [(control ?x) (control ?s)] 'ledger-reconcile-save) - (define-key map [(control ?l)] 'ledger-reconcile-refresh) - (define-key map [? ] 'ledger-reconcile-toggle) - (define-key map [?a] 'ledger-reconcile-add) - (define-key map [?d] 'ledger-reconcile-delete) - (define-key map [?g] 'ledger-reconcile-new-account) - (define-key map [?n] 'next-line) - (define-key map [?p] 'previous-line) - (define-key map [?s] 'ledger-reconcile-save) - (define-key map [?q] 'ledger-reconcile-quit) - (define-key map [?b] 'ledger-display-balance) - - (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 bal] '("Show Cleared Balance" . ledger-display-balance)) - (define-key map [menu-bar ldg-recon-menu sep4] '("--")) - (define-key map [menu-bar ldg-recon-menu rna] '("Reconcile New Account" . ledger-reconcile-new-account)) - (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))) + "A mode for reconciling ledger entries." + (let ((map (make-sparse-keymap))) + (define-key map [(control ?m)] 'ledger-reconcile-visit) + (define-key map [return] 'ledger-reconcile-visit) + (define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish) + (define-key map [(control ?x) (control ?s)] 'ledger-reconcile-save) + (define-key map [(control ?l)] 'ledger-reconcile-refresh) + (define-key map [? ] 'ledger-reconcile-toggle) + (define-key map [?a] 'ledger-reconcile-add) + (define-key map [?d] 'ledger-reconcile-delete) + (define-key map [?g] 'ledger-reconcile-new-account) + (define-key map [?n] 'next-line) + (define-key map [?p] 'previous-line) + (define-key map [?s] 'ledger-reconcile-save) + (define-key map [?q] 'ledger-reconcile-quit) + (define-key map [?b] 'ledger-display-balance) + + (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 bal] '("Show Cleared Balance" . ledger-display-balance)) + (define-key map [menu-bar ldg-recon-menu sep4] '("--")) + (define-key map [menu-bar ldg-recon-menu rna] '("Reconcile New Account" . ledger-reconcile-new-account)) + (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))) (provide 'ldg-reconcile) \ No newline at end of file -- cgit v1.2.3 From d67c42207fa75b0b4715705b577a228eec05729a Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 5 Feb 2013 12:25:19 -0700 Subject: Code cleanup to get rid of some elisp compiler warnings. --- lisp/ldg-occur.el | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index 9cf7f3b1..09cca45b 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -71,7 +71,7 @@ (defun ledger-occur-mode (regex buffer) - (save-excursion + (progn (set-buffer buffer) (setq ledger-occur-mode (if (or ledger-occur-mode @@ -198,10 +198,10 @@ (let ((prev-end (point-min)) (overlays (list))) (when buffer-matches - (mapcar (lambda (line) - (push (list (car line) (cadr line)) overlays) - (setq prev-end (cadr line))) - buffer-matches) + (mapc (lambda (line) + (push (list (car line) (cadr line)) overlays) + (setq prev-end (cadr line))) + buffer-matches) (setq overlays (nreverse overlays))))) (defun ledger-occur-find-xact-extents (pos) @@ -213,11 +213,11 @@ (let ((end-pos pos) (beg-pos pos)) (backward-paragraph) - (next-line) + (forward-line) (beginning-of-line) (setq beg-pos (point)) (forward-paragraph) - (previous-line) + (forward-line -1) (end-of-line) (setq end-pos (1+ (point))) (list beg-pos end-pos)))) @@ -240,8 +240,8 @@ (let ((bounds (ledger-occur-find-xact-extents (match-beginning 0)))) (push bounds lines) (setq curpoint (cadr bounds)))) ;move to the end of the - ;xact, no need to search - ;inside it more + ;xact, no need to search + ;inside it more (goto-char curpoint)) (forward-line 1)) (setq lines (nreverse lines))))) -- 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') 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 e3431c4bffd57c39e96779a8449fe08679857448 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 7 Feb 2013 09:12:44 -0700 Subject: reconcile mode windowing improvements * reconcile mode now places its window at the bottom of the ledger window it was called form and minimizes its height to the size of the recon buffer. * It all specifically informs the user if there are no uncleared items. * When reconcile mode is entered it sets the ledger-occur mode and scrolls the bottom of the visible buffer to the bottom of the ledger window ensuring transactions are visible. --- lisp/ldg-reconcile.el | 191 ++++++++++++++++++++++++++++++-------------------- 1 file changed, 115 insertions(+), 76 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 0cac33c5..22ad5bc1 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -23,12 +23,14 @@ (defvar ledger-buf nil) (defvar ledger-acct nil) +(defcustom ledger-recon-buffer-name "*Reconcile*" + "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" :group 'ledger) -(make-variable-buffer-local 'ledger-fold-on-reconcilex) (defun ledger-display-balance () "Calculate the cleared balance of the account being reconciled" @@ -95,7 +97,7 @@ (forward-line line))) (defun ledger-reconcile-refresh-after-save () - (let ((buf (get-buffer "*Reconcile*"))) + (let ((buf (get-buffer ledger-recon-buffer-name))) (if buf (with-current-buffer buf (ledger-reconcile-refresh) @@ -136,6 +138,9 @@ (defun ledger-reconcile-quit () (interactive) (let ((buf ledger-buf)) + ;Make sure you delete the window before you delete the buffer, + ;otherwise, madness ensues + (delete-window (get-buffer-window (current-buffer))) (kill-buffer (current-buffer)) (if ledger-fold-on-reconcile (ledger-occur-quit-buffer buf)))) @@ -155,107 +160,141 @@ (forward-line 1))) (ledger-reconcile-save)) +(defun ledger-marker-where-xact-is (emacs-xact) + "find the position of the xact in the ledger-buf buffer using + the emacs output from ledger, return a marker to the beginning + of the xact in the buffer" + (let ((buf ledger-buf)) + (with-current-buffer buf ;use the ledger-buf buffer + (cons + (nth 0 item) + (if ledger-clear-whole-entries ;determines whether to + ;clear on the payee line + ;or posting line + (save-excursion + (goto-line (nth 1 item)) + (point-marker)) + (save-excursion + (goto-line (nth 0 xact)) + (point-marker))))))) + (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) (items - (with-temp-buffer - (ledger-exec-ledger buf (current-buffer) "--uncleared" "--real" - "emacs" account) + (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 %-4s %-30s %-30s %15s\n" - (format-time-string "%Y/%m/%d" (nth 2 item)) - (if (nth 3 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 'ledger-font-reconciler-cleared-face - 'where where)) - (set-text-properties beg (1- (point)) - (list 'face 'ledger-font-reconciler-uncleared-face - 'where where)))) - (setq index (1+ index))))) + (read (current-buffer)))))) + (if (> (length items) 0) + (dolist (item items) + (let ((index 1)) + (dolist (xact (nthcdr 5 item)) + (let ((beg (point)) + (where (ledger-marker-where-xact-is item))) + (insert (format "%s %-4s %-30s %-30s %15s\n" + (format-time-string "%Y/%m/%d" (nth 2 item)) + (if (nth 3 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 'ledger-font-reconciler-cleared-face + 'where where)) + (set-text-properties beg (1- (point)) + (list 'face 'ledger-font-reconciler-uncleared-face + 'where where)))) + (setq index (1+ index))))) + (insert (concat "There are no uncleared entries for " account))) (goto-char (point-min)) (set-buffer-modified-p nil) - (toggle-read-only t))) + (toggle-read-only t) + ; this next piece of code ensures that the last of the visible + ; transactions in the ledger buffer is at the bottom of the + ; main window. The key to this is to ensure the window is selected + ; when the buffer point is moved and recentered. If they aren't + ; strange things happen. + + (let + ((recon-window (get-buffer-window (get-buffer ledger-recon-buffer-name)))) + (fit-window-to-buffer recon-window) + (with-current-buffer buf + (select-window (get-buffer-window buf)) + (goto-char (point-max)) + (recenter -1)) + + (select-window recon-window)))) (defun ledger-reconcile (account) (interactive "sAccount to reconcile: ") (let ((buf (current-buffer)) - (rbuf (get-buffer "*Reconcile*"))) + (rbuf (get-buffer ledger-recon-buffer-name))) (if rbuf - (kill-buffer rbuf)) + (progn + (quit-window (get-buffer-window rbuf)) + (kill-buffer rbuf))) (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save) (if ledger-fold-on-reconcile (ledger-occur-mode account buf)) + + ;create the *Reconcile* window directly below the ledger buffer. (with-current-buffer - (pop-to-buffer (get-buffer-create "*Reconcile*")) + (progn + (set-window-buffer + (split-window (get-buffer-window (current-buffer)) nil nil) + (get-buffer-create ledger-recon-buffer-name)) + (get-buffer ledger-recon-buffer-name)) (ledger-reconcile-mode) (set (make-local-variable 'ledger-buf) buf) (set (make-local-variable 'ledger-acct) account) - (ledger-do-reconcile)))) + (ledger-do-reconcile)))) (defvar ledger-reconcile-mode-abbrev-table) (define-derived-mode ledger-reconcile-mode text-mode "Reconcile" - "A mode for reconciling ledger entries." - (let ((map (make-sparse-keymap))) - (define-key map [(control ?m)] 'ledger-reconcile-visit) - (define-key map [return] 'ledger-reconcile-visit) - (define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish) - (define-key map [(control ?x) (control ?s)] 'ledger-reconcile-save) - (define-key map [(control ?l)] 'ledger-reconcile-refresh) - (define-key map [? ] 'ledger-reconcile-toggle) - (define-key map [?a] 'ledger-reconcile-add) - (define-key map [?d] 'ledger-reconcile-delete) - (define-key map [?g] 'ledger-reconcile-new-account) - (define-key map [?n] 'next-line) - (define-key map [?p] 'previous-line) - (define-key map [?s] 'ledger-reconcile-save) - (define-key map [?q] 'ledger-reconcile-quit) - (define-key map [?b] 'ledger-display-balance) - - (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 bal] '("Show Cleared Balance" . ledger-display-balance)) - (define-key map [menu-bar ldg-recon-menu sep4] '("--")) - (define-key map [menu-bar ldg-recon-menu rna] '("Reconcile New Account" . ledger-reconcile-new-account)) - (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)) + "A mode for reconciling ledger entries." + (let ((map (make-sparse-keymap))) + (define-key map [(control ?m)] 'ledger-reconcile-visit) + (define-key map [return] 'ledger-reconcile-visit) + (define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish) + (define-key map [(control ?x) (control ?s)] 'ledger-reconcile-save) + (define-key map [(control ?l)] 'ledger-reconcile-refresh) + (define-key map [? ] 'ledger-reconcile-toggle) + (define-key map [?a] 'ledger-reconcile-add) + (define-key map [?d] 'ledger-reconcile-delete) + (define-key map [?g] 'ledger-reconcile-new-account) + (define-key map [?n] 'next-line) + (define-key map [?p] 'previous-line) + (define-key map [?s] 'ledger-reconcile-save) + (define-key map [?q] 'ledger-reconcile-quit) + (define-key map [?b] 'ledger-display-balance) + + (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 bal] '("Show Cleared Balance" . ledger-display-balance)) + (define-key map [menu-bar ldg-recon-menu sep4] '("--")) + (define-key map [menu-bar ldg-recon-menu rna] '("Reconcile New Account" . ledger-reconcile-new-account)) + (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))) + (use-local-map map))) (provide 'ldg-reconcile) \ No newline at end of file -- cgit v1.2.3 From 869c40c070a1abd8a02f8817a43cfc1488c0b1bc Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 7 Feb 2013 10:16:31 -0700 Subject: Reconcile visit now recanters on the xact selected --- lisp/ldg-reconcile.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 22ad5bc1..2d591de5 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -126,7 +126,8 @@ (let ((where (get-text-property (point) 'where))) (when (is-stdin (car where)) (switch-to-buffer-other-window ledger-buf) - (goto-char (cdr where))))) + (goto-char (cdr where)) + (recenter)))) (defun ledger-reconcile-save () (interactive) -- 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') 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 29f409ce723e65df7cfa28be059627a084297aba Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 7 Feb 2013 22:40:57 -0700 Subject: Added ability to add xact with date only. ledger-add-entry now checks to see if more than the date was given at the prompt. If there is only a date it inserts the dat at the correct place in the ledger and puts the point at the end of the line for entering transaction details --- lisp/ldg-mode.el | 168 ++++++++++++++++++++++++++++--------------------------- 1 file changed, 86 insertions(+), 82 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 226009c6..f71bb58e 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." @@ -193,17 +193,21 @@ Return the difference in the format of a time value." (string-to-number (match-string 2 date)) (string-to-number (match-string 1 date))))) (ledger-find-slot date))) - (save-excursion - (insert - (with-temp-buffer - (setq exit-code - (apply #'ledger-exec-ledger ledger-buf ledger-buf "entry" - (mapcar 'eval args))) - (goto-char (point-min)) - (if (looking-at "Error: ") - (error (buffer-string)) - (buffer-string))) - "\n")))) + (if (> (length args) 1) + (save-excursion + (insert + (with-temp-buffer + (setq exit-code + (apply #'ledger-exec-ledger ledger-buf ledger-buf "entry" + (mapcar 'eval args))) + (goto-char (point-min)) + (if (looking-at "Error: ") + (error (buffer-string)) + (buffer-string))) + "\n")) + (progn + (insert (car args) " \n\n") + (end-of-line -1))))) (defun ledger-current-entry-bounds () (save-excursion -- cgit v1.2.3 From ca554f6b5b407415a006be3550b67536acd312a7 Mon Sep 17 00:00:00 2001 From: Rémi Vanicat Date: Fri, 8 Feb 2013 10:40:48 +0100 Subject: Add € and £ to currency one could use in new ledger mode MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lisp/ldg-post.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 05b9d352..5d5381ae 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -84,7 +84,7 @@ to choose from." (goto-char pos))) (defun ledger-next-amount (&optional end) - (when (re-search-forward "\\( \\|\t\\| \t\\)[ \t]*-?\\([A-Z$]+ *\\)?\\(-?[0-9,]+?\\)\\(.[0-9]+\\)?\\( *[A-Z$]+\\)?\\([ \t]*@@?[^\n;]+?\\)?\\([ \t]+;.+?\\)?$" (marker-position end) t) + (when (re-search-forward "\\( \\|\t\\| \t\\)[ \t]*-?\\([A-Z$€£]+ *\\)?\\(-?[0-9,]+?\\)\\(.[0-9]+\\)?\\( *[A-Z$€£]+\\)?\\([ \t]*@@?[^\n;]+?\\)?\\([ \t]+;.+?\\)?$" (marker-position end) t) (goto-char (match-beginning 0)) (skip-syntax-forward " ") (- (or (match-end 4) -- cgit v1.2.3 From bdf404112e81b74a0cec668222c373150a0bc5ce Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 8 Feb 2013 07:41:42 -0700 Subject: Corrected reentering when entering leg-occur mode --- lisp/ldg-occur.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index 09cca45b..2958c94c 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -89,8 +89,9 @@ (setq ledger-occur-overlay-list (append ledger-occur-overlay-list (ledger-occur-create-folded-overlays buffer-matches))) - (setq ledger-occur-last-match regex)) - (recenter)))) + (setq ledger-occur-last-match regex) + (select-window (get-buffer-window buffer)))) + (recenter))) (defun ledger-occur (regex) "Perform a simple grep in current buffer for the regular -- cgit v1.2.3 From 3b44a9fd2aec421eee2136088edd07efeb330f92 Mon Sep 17 00:00:00 2001 From: Rémi Vanicat Date: Fri, 8 Feb 2013 18:05:29 +0100 Subject: In ledger-reconcile, use a function to get where the transaction is. --- lisp/ldg-reconcile.el | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 2d591de5..04c84e63 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -53,14 +53,18 @@ (equal file "") (equal file "/dev/stdin"))) +(defun ledger-reconcile-get-buffer (where) + (when (is-stdin (car where)) + ledger-buf)) + (defun ledger-reconcile-toggle () (interactive) (let ((where (get-text-property (point) 'where)) (account ledger-acct) (inhibit-read-only t) cleared) - (when (is-stdin (car where)) - (with-current-buffer ledger-buf + (when (ledger-reconcile-get-buffer where) + (with-current-buffer (ledger-reconcile-get-buffer where) (goto-char (cdr where)) (setq cleared (ledger-toggle-current-entry))) ;remove the existing face and add the new face @@ -112,8 +116,8 @@ (defun ledger-reconcile-delete () (interactive) (let ((where (get-text-property (point) 'where))) - (when (is-stdin (car where)) - (with-current-buffer ledger-buf + (when (ledger-reconcile-get-buffer where) + (with-current-buffer (ledger-reconcile-get-buffer where) (goto-char (cdr where)) (ledger-delete-current-entry)) (let ((inhibit-read-only t)) @@ -124,8 +128,8 @@ (defun ledger-reconcile-visit () (interactive) (let ((where (get-text-property (point) 'where))) - (when (is-stdin (car where)) - (switch-to-buffer-other-window ledger-buf) + (when (ledger-reconcile-get-buffer where) + (switch-to-buffer-other-window (ledger-reconcile-get-buffer where)) (goto-char (cdr where)) (recenter)))) @@ -154,8 +158,8 @@ (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 + (ledger-reconcile-get-buffer where)) + (with-current-buffer (ledger-reconcile-get-buffer where) (goto-char (cdr where)) (ledger-toggle-current 'cleared)))) (forward-line 1))) @@ -298,4 +302,4 @@ (use-local-map map))) -(provide 'ldg-reconcile) \ No newline at end of file +(provide 'ldg-reconcile) -- cgit v1.2.3 From 21968b1e126df258842a6a45d2141f2923f7b023 Mon Sep 17 00:00:00 2001 From: Rémi Vanicat Date: Fri, 8 Feb 2013 18:16:57 +0100 Subject: In ledger-reconcile, open file where transaction are, and store it. --- lisp/ldg-reconcile.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 04c84e63..ae8de63f 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -169,10 +169,12 @@ "find the position of the xact in the ledger-buf buffer using the emacs output from ledger, return a marker to the beginning of the xact in the buffer" - (let ((buf ledger-buf)) + (let ((buf (if (is-stdin emacs-xact) + ledger-buf + (find-file-noselect (nth 0 item))))) (with-current-buffer buf ;use the ledger-buf buffer (cons - (nth 0 item) + buf (if ledger-clear-whole-entries ;determines whether to ;clear on the payee line ;or posting line -- cgit v1.2.3 From 0b63dc0f84236b30e771a7c3b9867cfc5a3965be Mon Sep 17 00:00:00 2001 From: Rémi Vanicat Date: Fri, 8 Feb 2013 18:17:55 +0100 Subject: In ledger-reconcile-get-buffer, return the stored buffer --- lisp/ldg-reconcile.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index ae8de63f..2bdd6026 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -54,8 +54,8 @@ (equal file "/dev/stdin"))) (defun ledger-reconcile-get-buffer (where) - (when (is-stdin (car where)) - ledger-buf)) + (when (bufferp (car where)) + (car where))) (defun ledger-reconcile-toggle () (interactive) -- cgit v1.2.3 From e304cdfdbbd081e36925135f90b9ec052e8478ce Mon Sep 17 00:00:00 2001 From: Rémi Vanicat Date: Fri, 8 Feb 2013 18:35:14 +0100 Subject: After reconciling, save all buffer that need to be saved. --- lisp/ldg-reconcile.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 2bdd6026..ee87b1b8 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -22,6 +22,7 @@ ;; Reconcile mode (defvar ledger-buf nil) +(defvar ledger-bufs nil) (defvar ledger-acct nil) (defcustom ledger-recon-buffer-name "*Reconcile*" "Name to use for reconciliation window" @@ -135,8 +136,9 @@ (defun ledger-reconcile-save () (interactive) - (with-current-buffer ledger-buf - (save-buffer)) + (dolist (buf (cons ledger-buf ledger-bufs)) + (with-current-buffer buf + (save-buffer))) (set-buffer-modified-p nil) (ledger-display-balance)) @@ -199,12 +201,14 @@ (unless (looking-at "(") (error (buffer-string))) (read (current-buffer)))))) + (setq ledger-bufs ()) (if (> (length items) 0) (dolist (item items) (let ((index 1)) (dolist (xact (nthcdr 5 item)) (let ((beg (point)) (where (ledger-marker-where-xact-is item))) + (add-to-list 'ledger-bufs (car where)) (insert (format "%s %-4s %-30s %-30s %15s\n" (format-time-string "%Y/%m/%d" (nth 2 item)) (if (nth 3 item) -- cgit v1.2.3 From 8f214f38305d5b0b20ddb5da36bc9e4b8c183e23 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 8 Feb 2013 15:24:00 -0700 Subject: Revert "Merge pull request #147 from vanicat/t/where-are-transaction" This reverts commit 9a411e898acdd52e432ea84914467233e740c67e, reversing changes made to bdf404112e81b74a0cec668222c373150a0bc5ce. --- lisp/ldg-reconcile.el | 36 +++++++++++++----------------------- 1 file changed, 13 insertions(+), 23 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index ee87b1b8..2d591de5 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -22,7 +22,6 @@ ;; Reconcile mode (defvar ledger-buf nil) -(defvar ledger-bufs nil) (defvar ledger-acct nil) (defcustom ledger-recon-buffer-name "*Reconcile*" "Name to use for reconciliation window" @@ -54,18 +53,14 @@ (equal file "") (equal file "/dev/stdin"))) -(defun ledger-reconcile-get-buffer (where) - (when (bufferp (car where)) - (car where))) - (defun ledger-reconcile-toggle () (interactive) (let ((where (get-text-property (point) 'where)) (account ledger-acct) (inhibit-read-only t) cleared) - (when (ledger-reconcile-get-buffer where) - (with-current-buffer (ledger-reconcile-get-buffer where) + (when (is-stdin (car where)) + (with-current-buffer ledger-buf (goto-char (cdr where)) (setq cleared (ledger-toggle-current-entry))) ;remove the existing face and add the new face @@ -117,8 +112,8 @@ (defun ledger-reconcile-delete () (interactive) (let ((where (get-text-property (point) 'where))) - (when (ledger-reconcile-get-buffer where) - (with-current-buffer (ledger-reconcile-get-buffer where) + (when (is-stdin (car where)) + (with-current-buffer ledger-buf (goto-char (cdr where)) (ledger-delete-current-entry)) (let ((inhibit-read-only t)) @@ -129,16 +124,15 @@ (defun ledger-reconcile-visit () (interactive) (let ((where (get-text-property (point) 'where))) - (when (ledger-reconcile-get-buffer where) - (switch-to-buffer-other-window (ledger-reconcile-get-buffer where)) + (when (is-stdin (car where)) + (switch-to-buffer-other-window ledger-buf) (goto-char (cdr where)) (recenter)))) (defun ledger-reconcile-save () (interactive) - (dolist (buf (cons ledger-buf ledger-bufs)) - (with-current-buffer buf - (save-buffer))) + (with-current-buffer ledger-buf + (save-buffer)) (set-buffer-modified-p nil) (ledger-display-balance)) @@ -160,8 +154,8 @@ (let ((where (get-text-property (point) 'where)) (face (get-text-property (point) 'face))) (if (and (eq face 'bold) - (ledger-reconcile-get-buffer where)) - (with-current-buffer (ledger-reconcile-get-buffer where) + (when (is-stdin (car where)))) + (with-current-buffer ledger-buf (goto-char (cdr where)) (ledger-toggle-current 'cleared)))) (forward-line 1))) @@ -171,12 +165,10 @@ "find the position of the xact in the ledger-buf buffer using the emacs output from ledger, return a marker to the beginning of the xact in the buffer" - (let ((buf (if (is-stdin emacs-xact) - ledger-buf - (find-file-noselect (nth 0 item))))) + (let ((buf ledger-buf)) (with-current-buffer buf ;use the ledger-buf buffer (cons - buf + (nth 0 item) (if ledger-clear-whole-entries ;determines whether to ;clear on the payee line ;or posting line @@ -201,14 +193,12 @@ (unless (looking-at "(") (error (buffer-string))) (read (current-buffer)))))) - (setq ledger-bufs ()) (if (> (length items) 0) (dolist (item items) (let ((index 1)) (dolist (xact (nthcdr 5 item)) (let ((beg (point)) (where (ledger-marker-where-xact-is item))) - (add-to-list 'ledger-bufs (car where)) (insert (format "%s %-4s %-30s %-30s %15s\n" (format-time-string "%Y/%m/%d" (nth 2 item)) (if (nth 3 item) @@ -308,4 +298,4 @@ (use-local-map map))) -(provide 'ldg-reconcile) +(provide 'ldg-reconcile) \ No newline at end of file -- cgit v1.2.3 From e3be9686e4780778fe26124e37151009c8f66446 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 8 Feb 2013 17:02:58 -0700 Subject: Added vanicat's multii file extensions. There was a strange interact with some more recent parts of the code that exposed bugs I hadn't seen before. --- lisp/ldg-reconcile.el | 76 ++++++++++++++++++++++++--------------------------- 1 file changed, 36 insertions(+), 40 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 2d591de5..ed974a1e 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -22,6 +22,7 @@ ;; Reconcile mode (defvar ledger-buf nil) +(defvar ledger-bufs nil) (defvar ledger-acct nil) (defcustom ledger-recon-buffer-name "*Reconcile*" "Name to use for reconciliation window" @@ -53,17 +54,27 @@ (equal file "") (equal file "/dev/stdin"))) +(defun ledger-reconcile-get-buffer (where) +; (when (is-stdin (car where)) +; ledger-buf)) + (if (bufferp (car where)) + (car where) + (error "buffer not set"))) + + (defun ledger-reconcile-toggle () (interactive) (let ((where (get-text-property (point) 'where)) (account ledger-acct) (inhibit-read-only t) cleared) - (when (is-stdin (car where)) - (with-current-buffer ledger-buf +; (when (is-stdin (car where)) +; (with-current-buffer ledger-buf + (when (ledger-reconcile-get-buffer where) + (with-current-buffer (ledger-reconcile-get-buffer where) (goto-char (cdr where)) (setq cleared (ledger-toggle-current-entry))) - ;remove the existing face and add the new face + ;remove the existing face and add the new face (remove-text-properties (line-beginning-position) (line-end-position) (list 'face)) @@ -112,8 +123,8 @@ (defun ledger-reconcile-delete () (interactive) (let ((where (get-text-property (point) 'where))) - (when (is-stdin (car where)) - (with-current-buffer ledger-buf + (when (ledger-reconcile-get-buffer where) + (with-current-buffer (ledger-reconcile-get-buffer where) (goto-char (cdr where)) (ledger-delete-current-entry)) (let ((inhibit-read-only t)) @@ -123,16 +134,21 @@ (defun ledger-reconcile-visit () (interactive) - (let ((where (get-text-property (point) 'where))) - (when (is-stdin (car where)) - (switch-to-buffer-other-window ledger-buf) + (let* ((where (get-text-property (point) 'where)) + (target-buffer (ledger-reconcile-get-buffer + where))) + (when target-buffer + (switch-to-buffer-other-window target-buffer) (goto-char (cdr where)) (recenter)))) (defun ledger-reconcile-save () (interactive) - (with-current-buffer ledger-buf - (save-buffer)) +; (with-current-buffer ledger-buf +; (save-buffer)) + (dolist (buf (cons ledger-buf ledger-bufs)) + (with-current-buffer buf + (save-buffer))) (set-buffer-modified-p nil) (ledger-display-balance)) @@ -146,38 +162,19 @@ (if ledger-fold-on-reconcile (ledger-occur-quit-buffer buf)))) -(defun ledger-reconcile-finish () - (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-marker-where-xact-is (emacs-xact) "find the position of the xact in the ledger-buf buffer using - the emacs output from ledger, return a marker to the beginning - of the xact in the buffer" - (let ((buf ledger-buf)) - (with-current-buffer buf ;use the ledger-buf buffer + the emacs output from ledger, return the buffer and a marker + to the beginning of the xact in that buffer" + (let ((buf (if (is-stdin (nth 0 emacs-xact)) + ledger-buf + (find-file-noselect (nth 0 emacs-xact))))) + (with-current-buffer buf (cons - (nth 0 item) - (if ledger-clear-whole-entries ;determines whether to - ;clear on the payee line - ;or posting line - (save-excursion - (goto-line (nth 1 item)) - (point-marker)) - (save-excursion - (goto-line (nth 0 xact)) - (point-marker))))))) + buf + (save-excursion + (goto-line (nth 1 emacs-xact)) + (point-marker)))))) (defun ledger-do-reconcile () "get the uncleared transactions in the account and display them @@ -265,7 +262,6 @@ (let ((map (make-sparse-keymap))) (define-key map [(control ?m)] 'ledger-reconcile-visit) (define-key map [return] 'ledger-reconcile-visit) - (define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish) (define-key map [(control ?x) (control ?s)] 'ledger-reconcile-save) (define-key map [(control ?l)] 'ledger-reconcile-refresh) (define-key map [? ] 'ledger-reconcile-toggle) -- cgit v1.2.3 From 5f67cfbec73863608639a7b8507191236cbac800 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 8 Feb 2013 17:16:12 -0700 Subject: Added ability to have ledger buffer track the xact under point in recon window controllable using ledger-buffer-tracks-reconcile-buffer --- lisp/ldg-reconcile.el | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index ed974a1e..395266e3 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -24,6 +24,7 @@ (defvar ledger-buf nil) (defvar ledger-bufs nil) (defvar ledger-acct nil) + (defcustom ledger-recon-buffer-name "*Reconcile*" "Name to use for reconciliation window" :group 'ledger) @@ -33,6 +34,12 @@ matching the reconcile regex" :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." + :group 'ledger) + (defun ledger-display-balance () "Calculate the cleared balance of the account being reconciled" (interactive) @@ -231,6 +238,22 @@ (select-window recon-window)))) +(defun ledger-reconcile-track-xact () + (if (or (eq this-command 'next-line) + (eq this-command 'previous-line) + (eq this-command 'mouse-set-point)) + (let* ((where (get-text-property (point) 'where)) + (target-buffer (ledger-reconcile-get-buffer + where)) + (cur-buf (current-buffer))) + (when target-buffer + (switch-to-buffer-other-window target-buffer) + (goto-char (cdr where)) + (recenter) + (switch-to-buffer-other-window cur-buf) + )))) + + (defun ledger-reconcile (account) (interactive "sAccount to reconcile: ") (let ((buf (current-buffer)) @@ -240,6 +263,7 @@ (quit-window (get-buffer-window rbuf)) (kill-buffer rbuf))) (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save) + (add-hook 'post-command-hook 'ledger-reconcile-track-xact) (if ledger-fold-on-reconcile (ledger-occur-mode account buf)) -- cgit v1.2.3 From 7fe1506ea1bb0cb971fa7d0d83ef789c7daeee80 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 8 Feb 2013 17:20:56 -0700 Subject: code cleanup --- lisp/ldg-mode.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index f71bb58e..4754e423 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -28,17 +28,16 @@ (defvar ledger-year (ledger-current-year) "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.") - (defcustom ledger-default-acct-transaction-indent " " "Default indentation for account transactions in an entry." :type 'string :group 'ledger) - (defvar ledger-mode-abbrev-table) ;;;###autoload -- cgit v1.2.3 From 73f336ae7c89e6f1b5f38c32fe398f39ad3667b5 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 8 Feb 2013 22:49:39 -0700 Subject: Improved the visit function. Made the window position configurable. Removed after-save hook on quit --- lisp/ldg-reconcile.el | 115 ++++++++++++++++++++++++++------------------------ 1 file changed, 61 insertions(+), 54 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 395266e3..463eb9cf 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -40,6 +40,11 @@ buffer." :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" + :group 'ledger) + (defun ledger-display-balance () "Calculate the cleared balance of the account being reconciled" (interactive) @@ -62,8 +67,6 @@ (equal file "/dev/stdin"))) (defun ledger-reconcile-get-buffer (where) -; (when (is-stdin (car where)) -; ledger-buf)) (if (bufferp (car where)) (car where) (error "buffer not set"))) @@ -139,15 +142,19 @@ (delete-region (point) (1+ (line-end-position))) (set-buffer-modified-p t))))) -(defun ledger-reconcile-visit () - (interactive) - (let* ((where (get-text-property (point) 'where)) - (target-buffer (ledger-reconcile-get-buffer - where))) - (when target-buffer - (switch-to-buffer-other-window target-buffer) - (goto-char (cdr where)) - (recenter)))) +(defun ledger-reconcile-visit (&optional come-back) + (progn + (beginning-of-line) + (let* ((where (get-text-property (1+ (point)) 'where)) + (target-buffer (ledger-reconcile-get-buffer + where)) + (cur-buf (current-buffer))) + (when target-buffer + (switch-to-buffer-other-window target-buffer) + (goto-char (cdr where)) + (recenter) + (if come-back + (switch-to-buffer-other-window cur-buf)))))) (defun ledger-reconcile-save () (interactive) @@ -162,6 +169,9 @@ (defun ledger-reconcile-quit () (interactive) (let ((buf ledger-buf)) + (with-current-buffer ledger-buf + (remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t)) + ;Make sure you delete the window before you delete the buffer, ;otherwise, madness ensues (delete-window (get-buffer-window (current-buffer))) @@ -198,25 +208,28 @@ (error (buffer-string))) (read (current-buffer)))))) (if (> (length items) 0) - (dolist (item items) - (let ((index 1)) - (dolist (xact (nthcdr 5 item)) - (let ((beg (point)) - (where (ledger-marker-where-xact-is item))) - (insert (format "%s %-4s %-30s %-30s %15s\n" - (format-time-string "%Y/%m/%d" (nth 2 item)) - (if (nth 3 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 'ledger-font-reconciler-cleared-face - 'where where)) - (set-text-properties beg (1- (point)) - (list 'face 'ledger-font-reconciler-uncleared-face - 'where where)))) - (setq index (1+ index))))) + (progn + (dolist (item items) + (let ((index 1)) + (dolist (xact (nthcdr 5 item)) + (let ((beg (point)) + (where (ledger-marker-where-xact-is item))) + (insert (format "%s %-4s %-30s %-30s %15s\n" + (format-time-string "%Y/%m/%d" (nth 2 item)) + (if (nth 3 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 'ledger-font-reconciler-cleared-face + 'where where)) + (set-text-properties beg (1- (point)) + (list 'face 'ledger-font-reconciler-uncleared-face + 'where where)))) + (setq index (1+ index))))) + (goto-char (point-max)) + (delete-char -1)) (insert (concat "There are no uncleared entries for " account))) (goto-char (point-min)) (set-buffer-modified-p nil) @@ -236,23 +249,16 @@ (goto-char (point-max)) (recenter -1)) - (select-window recon-window)))) + (select-window recon-window) + (add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t) + (ledger-reconcile-visit t)))) (defun ledger-reconcile-track-xact () - (if (or (eq this-command 'next-line) - (eq this-command 'previous-line) - (eq this-command 'mouse-set-point)) - (let* ((where (get-text-property (point) 'where)) - (target-buffer (ledger-reconcile-get-buffer - where)) - (cur-buf (current-buffer))) - (when target-buffer - (switch-to-buffer-other-window target-buffer) - (goto-char (cdr where)) - (recenter) - (switch-to-buffer-other-window cur-buf) - )))) - + (if (member this-command (list 'next-line + 'previous-line + 'mouse-set-point + 'ledger-reconcile-toggle)) + (ledger-reconcile-visit t))) (defun ledger-reconcile (account) (interactive "sAccount to reconcile: ") @@ -262,18 +268,20 @@ (progn (quit-window (get-buffer-window rbuf)) (kill-buffer rbuf))) - (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save) - (add-hook 'post-command-hook 'ledger-reconcile-track-xact) + (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t) (if ledger-fold-on-reconcile (ledger-occur-mode account buf)) - ;create the *Reconcile* window directly below the ledger buffer. (with-current-buffer - (progn - (set-window-buffer - (split-window (get-buffer-window (current-buffer)) nil nil) - (get-buffer-create ledger-recon-buffer-name)) - (get-buffer ledger-recon-buffer-name)) + (if ledger-reconcile-force-window-bottom + ;create the *Reconcile* window directly below the ledger + ;buffer. + (progn + (set-window-buffer + (split-window (get-buffer-window (current-buffer)) nil nil) + (get-buffer-create ledger-recon-buffer-name)) + (get-buffer ledger-recon-buffer-name)) + (pop-to-buffer (get-buffer-create ledger-recon-buffer-name))) (ledger-reconcile-mode) (set (make-local-variable 'ledger-buf) buf) (set (make-local-variable 'ledger-acct) account) @@ -286,7 +294,6 @@ (let ((map (make-sparse-keymap))) (define-key map [(control ?m)] 'ledger-reconcile-visit) (define-key map [return] 'ledger-reconcile-visit) - (define-key map [(control ?x) (control ?s)] 'ledger-reconcile-save) (define-key map [(control ?l)] 'ledger-reconcile-refresh) (define-key map [? ] 'ledger-reconcile-toggle) (define-key map [?a] 'ledger-reconcile-add) -- cgit v1.2.3 From 73f8c10d8e65de56a5708f6a93da340861bd9646 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 8 Feb 2013 23:42:52 -0700 Subject: More reconcile-visit bug squashing. --- lisp/ldg-reconcile.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 463eb9cf..5314f554 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -32,17 +32,20 @@ (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." + :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" + :type 'boolean :group 'ledger) (defun ledger-display-balance () @@ -146,8 +149,9 @@ (progn (beginning-of-line) (let* ((where (get-text-property (1+ (point)) 'where)) - (target-buffer (ledger-reconcile-get-buffer - where)) + (target-buffer (if where + (ledger-reconcile-get-buffer where) + nil)) (cur-buf (current-buffer))) (when target-buffer (switch-to-buffer-other-window target-buffer) -- cgit v1.2.3 From cf6a23b2fe27e67536bd389737ed0e3379c2ae14 Mon Sep 17 00:00:00 2001 From: Rémi Vanicat Date: Sat, 9 Feb 2013 11:16:52 +0100 Subject: Unconditionally activate the occur stuff in ledger-occur-mode Well, we still deactivate it when regex is nil, but the function should not look at previous value of ledger-occur-mode: - the interactive function (ledger-occur) already do it, we don't need to do it there, - caller that want to deactivate the occur stuff only have to call ledger-occur with a nil regex - the old behavior make ledger-reconcile to turn off occur stuff if it was already turn on, when what we do want is that the occur stuff change to the new account. --- lisp/ldg-occur.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index 2958c94c..5a7c8ed7 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -69,13 +69,14 @@ "A list of currently active overlays to the ledger buffer.") (make-variable-buffer-local 'ledger-occur-overlay-list) - (defun ledger-occur-mode (regex buffer) + "Higlight transaction that match REGEX, hiding others + +When REGEX is nil, unhide everything, and remove higlight" (progn (set-buffer buffer) (setq ledger-occur-mode - (if (or ledger-occur-mode - (null regex) + (if (or (null regex) (zerop (length regex))) nil (concat " Ledger-Folded: " regex))) -- cgit v1.2.3 From d3964b66d556557b16053aa781220d298dc60d3a Mon Sep 17 00:00:00 2001 From: Rémi Vanicat Date: Sat, 9 Feb 2013 11:33:33 +0100 Subject: In ledger-occur, hide nothing if there is no match This could cause error when reconciling transaction that are included. Some message should be shown to explain why nothing happen when interactively call ledger-occur. --- lisp/ldg-occur.el | 39 ++++++++++++++++++++------------------- 1 file changed, 20 insertions(+), 19 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index 5a7c8ed7..e830f339 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -128,31 +128,32 @@ When REGEX is nil, unhide everything, and remove higlight" prompt)) (defun ledger-occur-create-folded-overlays(buffer-matches) - (let ((overlays - (let ((prev-end (point-min)) - (temp (point-max))) - (mapcar (lambda (match) - (progn - (setq temp prev-end) ;need a swap so that the + (if buffer-matches + (let ((overlays + (let ((prev-end (point-min)) + (temp (point-max))) + (mapcar (lambda (match) + (progn + (setq temp prev-end) ;need a swap so that the ;last form in the lambda ;is the (make-overlay) - (setq prev-end (1+ (cadr match))) ;add 1 so + (setq prev-end (1+ (cadr match))) ;add 1 so ;that we skip ;the empty ;line after ;the xact - (make-overlay - temp - (car match) - (current-buffer) t nil))) - buffer-matches)))) - (mapcar (lambda (ovl) - (overlay-put ovl ledger-occur-overlay-property-name t) - (overlay-put ovl 'invisible t) - (overlay-put ovl 'intangible t)) - (push (make-overlay (cadr (car(last buffer-matches))) - (point-max) - (current-buffer) t nil) overlays)))) + (make-overlay + temp + (car match) + (current-buffer) t nil))) + buffer-matches)))) + (mapcar (lambda (ovl) + (overlay-put ovl ledger-occur-overlay-property-name t) + (overlay-put ovl 'invisible t) + (overlay-put ovl 'intangible t)) + (push (make-overlay (cadr (car(last buffer-matches))) + (point-max) + (current-buffer) t nil) overlays))))) (defun ledger-occur-create-xact-overlays (ovl-bounds) -- cgit v1.2.3 From 0f83f779a627964f7f9044afd383b7a9152545b9 Mon Sep 17 00:00:00 2001 From: Rémi Vanicat Date: Sat, 9 Feb 2013 14:42:52 +0100 Subject: On move event, save excursion before calling ledger-reconcile-visit Otherwise, ledger-reconcile-visit might undo last move --- lisp/ldg-reconcile.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 5314f554..e0ba1ea7 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -262,7 +262,8 @@ 'previous-line 'mouse-set-point 'ledger-reconcile-toggle)) - (ledger-reconcile-visit t))) + (save-excursion + (ledger-reconcile-visit t)))) (defun ledger-reconcile (account) (interactive "sAccount to reconcile: ") -- cgit v1.2.3 From 47c3f6d353f37a265659595a4836c7524a62f7c4 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 9 Feb 2013 07:27:47 -0700 Subject: Cleaned up a defcustom that was lacking a type --- lisp/ldg-occur.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index 2958c94c..0f1f4616 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -46,6 +46,7 @@ (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) -- cgit v1.2.3 From 69efea6c543bb128422633239e7618f0d0eda6cf Mon Sep 17 00:00:00 2001 From: Rémi Vanicat Date: Sat, 9 Feb 2013 19:29:04 +0100 Subject: Take care to not delete some random buffer when exiting reconcile --- lisp/ldg-reconcile.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index e0ba1ea7..b475ebb7 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -172,14 +172,15 @@ (defun ledger-reconcile-quit () (interactive) - (let ((buf ledger-buf)) + (let ((buf ledger-buf) + (reconcile-buf (current-buffer))) (with-current-buffer ledger-buf (remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t)) ;Make sure you delete the window before you delete the buffer, ;otherwise, madness ensues - (delete-window (get-buffer-window (current-buffer))) - (kill-buffer (current-buffer)) + (delete-window (get-buffer-window reconcile-buf)) + (kill-buffer (reconcile-buf)) (if ledger-fold-on-reconcile (ledger-occur-quit-buffer buf)))) -- cgit v1.2.3 From 2b55ef7dab335f2ae914912d8e541f6228f57f19 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 9 Feb 2013 17:45:31 -0700 Subject: Added menu entry to customize ledger mode --- lisp/ldg-mode.el | 3 +++ 1 file changed, 3 insertions(+) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 4754e423..83b5e5b4 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -98,6 +98,9 @@ customizable to ease retro-entry.") (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 [cust] '(menu-item "Customize Ledger Mode" (lambda () + (interactive) + (customize-group 'ledger)))) (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)) -- cgit v1.2.3 From 114be62d248723bfae12e383b168f364857d8793 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 9 Feb 2013 17:47:09 -0700 Subject: Correct error that prevented clearing postings if ledger--clear-whole-entires was nil --- lisp/ldg-reconcile.el | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index e0ba1ea7..e5048a8c 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -81,12 +81,10 @@ (account ledger-acct) (inhibit-read-only t) cleared) -; (when (is-stdin (car where)) -; (with-current-buffer ledger-buf (when (ledger-reconcile-get-buffer where) (with-current-buffer (ledger-reconcile-get-buffer where) (goto-char (cdr where)) - (setq cleared (ledger-toggle-current-entry))) + (setq cleared (ledger-toggle-current))) ;remove the existing face and add the new face (remove-text-properties (line-beginning-position) (line-end-position) @@ -146,6 +144,7 @@ (set-buffer-modified-p t))))) (defun ledger-reconcile-visit (&optional come-back) + (interactive) (progn (beginning-of-line) (let* ((where (get-text-property (1+ (point)) 'where)) @@ -162,8 +161,6 @@ (defun ledger-reconcile-save () (interactive) -; (with-current-buffer ledger-buf -; (save-buffer)) (dolist (buf (cons ledger-buf ledger-bufs)) (with-current-buffer buf (save-buffer))) @@ -194,7 +191,9 @@ (cons buf (save-excursion - (goto-line (nth 1 emacs-xact)) + (if ledger-clear-whole-entries + (goto-line (nth 1 emacs-xact)) + (goto-line (nth 0 (nth 5 emacs-xact)))) (point-marker)))))) (defun ledger-do-reconcile () @@ -262,8 +261,9 @@ 'previous-line 'mouse-set-point 'ledger-reconcile-toggle)) - (save-excursion - (ledger-reconcile-visit t)))) + (if ledger-buffer-tracks-reconcile-buffer + (save-excursion + (ledger-reconcile-visit t))))) (defun ledger-reconcile (account) (interactive "sAccount to reconcile: ") -- cgit v1.2.3 From 6fce572806eb39b5ba607bd5336adb6ca3ac2295 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 9 Feb 2013 21:03:58 -0700 Subject: ledger-mode now highlights the xact under point. This can be configured with ledger-highlight-xact-under-point and ledger-font-highlight-face --- lisp/ldg-fonts.el | 5 +++++ lisp/ldg-mode.el | 6 ++++-- lisp/ldg-occur.el | 19 +------------------ lisp/ldg-reconcile.el | 1 + 4 files changed, 11 insertions(+), 20 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el index 6032e361..62192881 100644 --- a/lisp/ldg-fonts.el +++ b/lisp/ldg-fonts.el @@ -31,6 +31,11 @@ "Default face for cleared (*) transactions" :group 'ledger-faces) +(defface ledger-font-highlight-face + `((t :background "#003366" :weight normal )) + "Default face for transaction under point" + :group 'ledger-faces) + (defface ledger-font-pending-face `((t :foreground "yellow" :weight normal )) "Default face for pending (!) transactions" diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 83b5e5b4..a2c87048 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -60,6 +60,9 @@ customizable to ease retro-entry.") 'ledger-complete-at-point) (set (make-local-variable 'pcomplete-termination-string) "") + (add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t) + (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) @@ -114,8 +117,7 @@ customizable to ease retro-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)) - )) + (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." diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index d498b9e4..1afb0e90 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -208,23 +208,6 @@ When REGEX is nil, unhide everything, and remove higlight" buffer-matches) (setq overlays (nreverse overlays))))) -(defun ledger-occur-find-xact-extents (pos) - "return point for beginning of xact and and of xact containing - position. Requires empty line separating xacts" - (interactive "d") - (save-excursion - (goto-char pos) - (let ((end-pos pos) - (beg-pos pos)) - (backward-paragraph) - (forward-line) - (beginning-of-line) - (setq beg-pos (point)) - (forward-paragraph) - (forward-line -1) - (end-of-line) - (setq end-pos (1+ (point))) - (list beg-pos end-pos)))) (defun ledger-occur-find-matches (regex) "Returns a list of 2-number tuples, specifying begnning of the @@ -241,7 +224,7 @@ When REGEX is nil, unhide everything, and remove higlight" ;; if something found (when (setq endpoint (re-search-forward regex nil 'end)) (save-excursion - (let ((bounds (ledger-occur-find-xact-extents (match-beginning 0)))) + (let ((bounds (ledger-find-xact-extents (match-beginning 0)))) (push bounds lines) (setq curpoint (cadr bounds)))) ;move to the end of the ;xact, no need to search diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index e5048a8c..ed3fbcb5 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -156,6 +156,7 @@ (switch-to-buffer-other-window target-buffer) (goto-char (cdr where)) (recenter) + (ledger-highlight-xact-under-point) (if come-back (switch-to-buffer-other-window cur-buf)))))) -- cgit v1.2.3 From 0c8a660d6035d34a82a1cacaa47b93acafc9d47e Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 9 Feb 2013 21:05:08 -0700 Subject: Forgot to stage ldg-xact.el in the last commit --- lisp/ldg-xact.el | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) (limited to 'lisp') diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index 1df7d79a..e7402652 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -22,6 +22,46 @@ ;; A sample entry sorting function, which works if entry dates are of ;; the form YYYY/mm/dd. +(defcustom ledger-highlight-xact-under-point t + "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" + (interactive "d") + (save-excursion + (goto-char pos) + (let ((end-pos pos) + (beg-pos pos)) + (backward-paragraph) + (forward-line) + (beginning-of-line) + (setq beg-pos (point)) + (forward-paragraph) + (forward-line -1) + (end-of-line) + (setq end-pos (1+ (point))) + (list beg-pos end-pos)))) + + +(defun ledger-highlight-xact-under-point () + (if ledger-highlight-xact-under-point + (let ((exts (ledger-find-xact-extents (point))) + (ovl highlight-overlay)) + (if (not highlight-overlay) + (setq ovl + (setq highlight-overlay + (make-overlay (car exts) + (cadr exts) + (current-buffer) t nil))) + (move-overlay ovl (car exts) (cadr exts))) + (overlay-put ovl 'face 'ledger-font-highlight-face) + (overlay-put ovl 'priority 100)))) + (provide 'ldg-xact) \ No newline at end of file -- cgit v1.2.3 From e757b969efd3dba04e2f0fbe21e88f4081f785b2 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 10 Feb 2013 09:47:56 -0700 Subject: fixe minor error in merge from vanicat --- lisp/ldg-reconcile.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index afecf2eb..3c258d13 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -178,7 +178,7 @@ ;Make sure you delete the window before you delete the buffer, ;otherwise, madness ensues (delete-window (get-buffer-window reconcile-buf)) - (kill-buffer (reconcile-buf)) + (kill-buffer reconcile-buf) (if ledger-fold-on-reconcile (ledger-occur-quit-buffer buf)))) -- cgit v1.2.3 From 30c95ea9bba5ebe2e202a3dda3af6431ea21337c Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 10 Feb 2013 10:11:15 -0700 Subject: Changes keybinding for edit amount to C-c C-b Thierry rightly pointed out that C-c C-v was a much older emacs command and I shouldn't stomp on it. --- lisp/ldg-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index a2c87048..26d0ed68 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -73,7 +73,7 @@ customizable to ease retro-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 ?b)] 'ledger-post-edit-amount) (define-key map [(control ?c) (control ?f)] 'ledger-occur) (define-key map [tab] 'pcomplete) (define-key map [(control ?i)] 'pcomplete) -- cgit v1.2.3 From e460316774e9e0f61d447dfde16e92313eb30535 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 10 Feb 2013 20:11:03 -0700 Subject: Fixes bug 885, highlighting was removing bolding Inadvertantly left a :weight in the highlight face that was over ring the base face weight --- lisp/ldg-fonts.el | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el index 62192881..6ddc811c 100644 --- a/lisp/ldg-fonts.el +++ b/lisp/ldg-fonts.el @@ -27,17 +27,17 @@ :group 'ledger-faces) (defface ledger-font-cleared-face - `((t :foreground "grey70" :weight normal )) + `((t :foreground "#657b83" :weight normal )) "Default face for cleared (*) transactions" :group 'ledger-faces) (defface ledger-font-highlight-face - `((t :background "#003366" :weight normal )) + `((t :background "#eee8d5")) "Default face for transaction under point" :group 'ledger-faces) (defface ledger-font-pending-face - `((t :foreground "yellow" :weight normal )) + `((t :foreground "#cb4b16" :weight normal )) "Default face for pending (!) transactions" :group 'ledger-faces) @@ -47,7 +47,7 @@ :group 'ledger-faces) (defface ledger-font-posting-account-face - `((t :foreground "lightblue" )) + `((t :foreground "#268bd2" )) "Face for Ledger accounts" :group 'ledger-faces) @@ -57,22 +57,22 @@ :group 'ledger-faces) (defface ledger-font-comment-face - `((t :foreground "orange" )) + `((t :foreground "#93a1a1" :slant italic)) "Face for Ledger comments" :group 'ledger-faces) (defface ledger-font-reconciler-uncleared-face - `((t :foreground "green" :weight normal )) + `((t :foreground "#dc322f" :weight bold )) "Default face for uncleared transactions in the reconcile window" :group 'ledger-faces) (defface ledger-font-reconciler-cleared-face - `((t :foreground "grey70" :weight normal )) + `((t :foreground "#657b83" :weight normal )) "Default face for cleared (*) transactions in the reconcile window" :group 'ledger-faces) (defface ledger-font-reconciler-pending-face - `((t :foreground "yellow" :weight normal )) + `((t :foreground "#cb4b16" :weight normal )) "Default face for pending (!) transactions in the reconcile window" :group 'ledger-faces) -- cgit v1.2.3 From eef9245eb810820643a5960426265edd5578c656 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 11 Feb 2013 09:11:03 -0700 Subject: Face reorganization and better color theme Moved all face definitions to leg-fonts.el. Change default colors to Solarize color theme http://ethanschoonover.com/solarized --- lisp/ldg-fonts.el | 14 ++++++++++++-- lisp/ldg-occur.el | 10 ---------- 2 files changed, 12 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el index 6ddc811c..d72c9403 100644 --- a/lisp/ldg-fonts.el +++ b/lisp/ldg-fonts.el @@ -22,7 +22,7 @@ (defgroup ledger-faces nil "Ledger mode highlighting" :group 'ledger) (defface ledger-font-uncleared-face - `((t :foreground "green" :weight bold )) + `((t :foreground "#dc322f" :weight bold )) "Default face for Ledger" :group 'ledger-faces) @@ -32,7 +32,7 @@ :group 'ledger-faces) (defface ledger-font-highlight-face - `((t :background "#eee8d5")) + `((t :background "white")) "Default face for transaction under point" :group 'ledger-faces) @@ -56,6 +56,16 @@ "Face for Ledger amounts" :group 'ledger-faces) +(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 + `((t :background "#eee8d5" )) + "Default face for Ledger occur mode shown transactions" + :group 'ledger-faces) + (defface ledger-font-comment-face `((t :foreground "#93a1a1" :slant italic)) "Face for Ledger comments" diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index 1afb0e90..bd5a49b1 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -32,16 +32,6 @@ ;;; Code: -(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 - `((t :background "blue" :weight normal )) - "Default face for Ledger occur mode shown transactions" - :group 'ledger-faces) - (defconst ledger-occur-overlay-property-name 'ledger-occur-custom-buffer-grep) (defcustom ledger-occur-use-face-unfolded t -- cgit v1.2.3 From e245e41d6bfb1ef8799d9174e2bc5c6687880aa8 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 11 Feb 2013 10:50:13 -0700 Subject: Bug 887. Remove folding if the reconcile buffer is killed This ensure adequate cleanup if the reconciliation buffer is killed vice quit from. --- lisp/ldg-reconcile.el | 28 +++++++++++++++++++--------- 1 file changed, 19 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 3c258d13..5f023eb5 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -170,17 +170,25 @@ (defun ledger-reconcile-quit () (interactive) + ;(ledger-reconcile-quit-cleanup) (let ((buf ledger-buf) - (reconcile-buf (current-buffer))) - (with-current-buffer ledger-buf + (recon-buf (get-buffer ledger-recon-buffer-name))) + ;Make sure you delete the window before you delete the buffer, + ;otherwise, madness ensues + (with-current-buffer recon-buf + (delete-window (get-buffer-window recon-buf)) + (kill-buffer recon-buf)) + (set-window-buffer (selected-window) buf))) + +(defun ledger-reconcile-quit-cleanup () + (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)) - - ;Make sure you delete the window before you delete the buffer, - ;otherwise, madness ensues - (delete-window (get-buffer-window reconcile-buf)) - (kill-buffer reconcile-buf) (if ledger-fold-on-reconcile - (ledger-occur-quit-buffer buf)))) + (ledger-occur-quit-buffer buf)))) + (defun ledger-marker-where-xact-is (emacs-xact) "find the position of the xact in the ledger-buf buffer using @@ -330,6 +338,8 @@ (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))) + (use-local-map map) + + (add-hook 'kill-buffer-hook 'ledger-reconcile-quit-cleanup nil t))) (provide 'ldg-reconcile) \ No newline at end of file -- cgit v1.2.3 From e615d8c615c43bf1e04b0a29747f05188fd46fbd Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 11 Feb 2013 11:05:43 -0700 Subject: Bug 883 overlays left in buffer if file reverted. --- lisp/ldg-mode.el | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 26d0ed68..0ff22417 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -38,6 +38,11 @@ customizable to ease retro-entry.") :type 'string :group 'ledger) +(defun ledger-remove-overlays () + (interactive) + "remove overlays formthe buffer, used if the buffer is reverted" + (remove-overlays)) + (defvar ledger-mode-abbrev-table) ;;;###autoload @@ -61,6 +66,7 @@ customizable to ease retro-entry.") (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) (make-variable-buffer-local 'highlight-overlay) (let ((map (current-local-map))) -- cgit v1.2.3 From fa1702d68458e400d57d61b5cbec20ec4027dbb7 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 11 Feb 2013 11:12:50 -0700 Subject: Bug 886 Cannot unclear transaction on last line reconciliation buffer --- lisp/ldg-reconcile.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 5f023eb5..a53f2ade 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -97,6 +97,7 @@ (line-end-position) (list 'face 'ledger-font-reconciler-uncleared-face )))) (forward-line) + (beginning-of-line) (ledger-display-balance))) (defun ledger-reconcile-new-account (account) -- cgit v1.2.3 From d243f00b914ba68380a51696f4ac68e066119a99 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 11 Feb 2013 12:49:51 -0700 Subject: Bug 878 Cannot reconcile two posting with the same account in one xact --- lisp/ldg-reconcile.el | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index a53f2ade..d00abe1a 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -190,8 +190,7 @@ (if ledger-fold-on-reconcile (ledger-occur-quit-buffer buf)))) - -(defun ledger-marker-where-xact-is (emacs-xact) +(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" @@ -204,15 +203,15 @@ (save-excursion (if ledger-clear-whole-entries (goto-line (nth 1 emacs-xact)) - (goto-line (nth 0 (nth 5 emacs-xact)))) - (point-marker)))))) + (goto-line (nth 0 posting))) + (1+ (point-marker))))))) ;Add 1 to make sure the marker is within the transaction (defun ledger-do-reconcile () "get the uncleared transactions in the account and display them in the *Reconcile* buffer" (let* ((buf ledger-buf) (account ledger-acct) - (items + (xacts (with-temp-buffer (ledger-exec-ledger buf (current-buffer) "--uncleared" "--real" "emacs" account) @@ -221,20 +220,20 @@ (unless (looking-at "(") (error (buffer-string))) (read (current-buffer)))))) - (if (> (length items) 0) + (if (> (length xacts) 0) (progn - (dolist (item items) + (dolist (xact xacts) (let ((index 1)) - (dolist (xact (nthcdr 5 item)) + (dolist (posting (nthcdr 5 xact)) (let ((beg (point)) - (where (ledger-marker-where-xact-is item))) + (where (ledger-marker-where-xact-is xact posting))) (insert (format "%s %-4s %-30s %-30s %15s\n" - (format-time-string "%Y/%m/%d" (nth 2 item)) - (if (nth 3 item) - (nth 3 item) + (format-time-string "%Y/%m/%d" (nth 2 xact)) + (if (nth 3 xact) + (nth 3 xact) "") - (nth 4 item) (nth 1 xact) (nth 2 xact))) - (if (nth 3 xact) + (nth 4 xact) (nth 1 posting) (nth 2 posting))) + (if (nth 3 posting) (set-text-properties beg (1- (point)) (list 'face 'ledger-font-reconciler-cleared-face 'where where)) -- cgit v1.2.3 From 36a00113d9fbe8fe18ff3adb4c4be80291f7066d Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 11 Feb 2013 16:26:41 -0700 Subject: Bug 879 cannot reconcile two ledger buffers --- lisp/ldg-reconcile.el | 101 +++++++++++++++++++++++++------------------------- 1 file changed, 51 insertions(+), 50 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index d00abe1a..d59185b1 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -74,7 +74,6 @@ (car where) (error "buffer not set"))) - (defun ledger-reconcile-toggle () (interactive) (let ((where (get-text-property (point) 'where)) @@ -100,15 +99,6 @@ (beginning-of-line) (ledger-display-balance))) -(defun ledger-reconcile-new-account (account) - (interactive "sAccount to reconcile: ") - (set (make-local-variable 'ledger-acct) account) - (let ((buf (current-buffer))) - (if ledger-fold-on-reconcile - (ledger-occur-change-regex account ledger-buf)) - (set-buffer buf) - (ledger-reconcile-refresh))) - (defun ledger-reconcile-refresh () (interactive) (let ((inhibit-read-only t) @@ -152,7 +142,7 @@ (target-buffer (if where (ledger-reconcile-get-buffer where) nil)) - (cur-buf (current-buffer))) + (cur-buf (get-buffer ledger-recon-buffer-name))) (when target-buffer (switch-to-buffer-other-window target-buffer) (goto-char (cdr where)) @@ -171,11 +161,11 @@ (defun ledger-reconcile-quit () (interactive) - ;(ledger-reconcile-quit-cleanup) + (ledger-reconcile-quit-cleanup) (let ((buf ledger-buf) (recon-buf (get-buffer ledger-recon-buffer-name))) - ;Make sure you delete the window before you delete the buffer, - ;otherwise, madness ensues + ;Make sure you delete the window before you delete the buffer, + ;otherwise, madness ensues (with-current-buffer recon-buf (delete-window (get-buffer-window recon-buf)) (kill-buffer recon-buf)) @@ -186,9 +176,9 @@ (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)))) + (remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t) + (if ledger-fold-on-reconcile + (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 @@ -219,11 +209,10 @@ (unless (eobp) (unless (looking-at "(") (error (buffer-string))) - (read (current-buffer)))))) + (read (current-buffer)))))) ;current-buffer is the *temp* created above (if (> (length xacts) 0) (progn (dolist (xact xacts) - (let ((index 1)) (dolist (posting (nthcdr 5 xact)) (let ((beg (point)) (where (ledger-marker-where-xact-is xact posting))) @@ -239,18 +228,17 @@ 'where where)) (set-text-properties beg (1- (point)) (list 'face 'ledger-font-reconciler-uncleared-face - 'where where)))) - (setq index (1+ index))))) + 'where where)))) )) (goto-char (point-max)) - (delete-char -1)) + (delete-char -1)) ;gets rid of the extra line feed at the bottom of the list (insert (concat "There are no uncleared entries for " account))) (goto-char (point-min)) (set-buffer-modified-p nil) (toggle-read-only t) ; this next piece of code ensures that the last of the visible - ; transactions in the ledger buffer is at the bottom of the - ; main window. The key to this is to ensure the window is selected + ; transactions in the ledger buffer is at the bottom of the main + ; window. The key to this is to ensure the window is selected ; when the buffer point is moved and recentered. If they aren't ; strange things happen. @@ -278,32 +266,44 @@ (defun ledger-reconcile (account) (interactive "sAccount to reconcile: ") (let ((buf (current-buffer)) - (rbuf (get-buffer ledger-recon-buffer-name))) - (if rbuf - (progn - (quit-window (get-buffer-window rbuf)) - (kill-buffer rbuf))) - (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t) - (if ledger-fold-on-reconcile - (ledger-occur-mode account buf)) - - (with-current-buffer - (if ledger-reconcile-force-window-bottom - ;create the *Reconcile* window directly below the ledger - ;buffer. - (progn - (set-window-buffer - (split-window (get-buffer-window (current-buffer)) nil nil) - (get-buffer-create ledger-recon-buffer-name)) - (get-buffer ledger-recon-buffer-name)) - (pop-to-buffer (get-buffer-create ledger-recon-buffer-name))) - (ledger-reconcile-mode) - (set (make-local-variable 'ledger-buf) buf) - (set (make-local-variable 'ledger-acct) account) - (ledger-do-reconcile)))) + (rbuf (get-buffer ledger-recon-buffer-name))) ;this means only one *Reconcile* buffer, ever + (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 + (if ledger-fold-on-reconcile + (ledger-occur-change-regex account ledger-buf)) + (set-buffer (get-buffer ledger-recon-buffer-name)) + (ledger-reconcile-refresh)) + + (progn ; no recon-buffer, starting from scratch. + (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t) + (if ledger-fold-on-reconcile + (ledger-occur-mode account buf)) + + (with-current-buffer + (if ledger-reconcile-force-window-bottom + ;create the *Reconcile* window directly below the ledger buffer. + (progn + (set-window-buffer + (split-window (get-buffer-window buf) nil nil) + (get-buffer-create ledger-recon-buffer-name)) + (get-buffer ledger-recon-buffer-name)) + (pop-to-buffer (get-buffer-create ledger-recon-buffer-name))) + (ledger-reconcile-mode) + (set (make-local-variable 'ledger-buf) buf) + (set (make-local-variable 'ledger-acct) account) + (ledger-do-reconcile)))))) (defvar ledger-reconcile-mode-abbrev-table) +(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." (let ((map (make-sparse-keymap))) @@ -313,12 +313,13 @@ (define-key map [? ] 'ledger-reconcile-toggle) (define-key map [?a] 'ledger-reconcile-add) (define-key map [?d] 'ledger-reconcile-delete) - (define-key map [?g] 'ledger-reconcile-new-account) + (define-key map [?g] 'ledger-reconcile); (define-key map [?n] 'next-line) (define-key map [?p] 'previous-line) (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)) @@ -334,10 +335,10 @@ (define-key map [menu-bar ldg-recon-menu sep3] '("--")) (define-key map [menu-bar ldg-recon-menu bal] '("Show Cleared Balance" . ledger-display-balance)) (define-key map [menu-bar ldg-recon-menu sep4] '("--")) - (define-key map [menu-bar ldg-recon-menu rna] '("Reconcile New Account" . ledger-reconcile-new-account)) + (define-key map [menu-bar ldg-recon-menu rna] '("Reconcile New Account" . ledger-reconcile)) (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) (add-hook 'kill-buffer-hook 'ledger-reconcile-quit-cleanup nil t))) -- 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') 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 316055ff86978c29839d0d3058b3a9a7dda047bb Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 12 Feb 2013 10:39:07 -0700 Subject: More code cleanup --- lisp/ldg-state.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-state.el b/lisp/ldg-state.el index ac0511f8..443cb350 100644 --- a/lisp/ldg-state.el +++ b/lisp/ldg-state.el @@ -62,7 +62,7 @@ achieved more certainly by passing the entry to ledger for formatting, but doing so causes inline math expressions to be dropped." (interactive) - (let ((bounds (ledger-current-entry-bounds)) + (let ((bounds (ledger-current-transaction-bounds)) clear cleared) ;; Uncompact the entry, to make it easier to toggle the ;; transaction -- cgit v1.2.3 From 28659c58c3b0531e0f5fb01b298fcb8a8f63991e Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 12 Feb 2013 15:11:36 -0700 Subject: Bug 892 re-enable pending mode and reconcile-finish This should do it, and it should work across multiple files. --- lisp/ldg-mode.el | 2 +- lisp/ldg-reconcile.el | 49 ++++++++++++++++++--------- lisp/ldg-state.el | 93 +++++++++++++++++++++++++++++++-------------------- 3 files changed, 91 insertions(+), 53 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 628b4b8a..95b02fdd 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -75,7 +75,7 @@ customizable to ease retro-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 ?e)] 'ledger-toggle-current-transaction) (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) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 6179428f..61db2472 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -48,6 +48,12 @@ :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. " + :type 'boolean + :group 'ledger) + (defun ledger-display-balance () "Calculate the cleared balance of the account being reconciled" (interactive) @@ -79,22 +85,29 @@ (let ((where (get-text-property (point) 'where)) (account ledger-acct) (inhibit-read-only t) - cleared) + status) (when (ledger-reconcile-get-buffer where) (with-current-buffer (ledger-reconcile-get-buffer where) (goto-char (cdr where)) - (setq cleared (ledger-toggle-current))) + (setq status (ledger-toggle-current (if ledger-reconcile-toggle-to-pending + 'pending + 'cleared)))) ;remove the existing face and add the new face (remove-text-properties (line-beginning-position) (line-end-position) (list 'face)) - (if cleared - (add-text-properties (line-beginning-position) - (line-end-position) - (list 'face 'ledger-font-reconciler-cleared-face )) - (add-text-properties (line-beginning-position) - (line-end-position) - (list 'face 'ledger-font-reconciler-uncleared-face )))) + (cond ((eq status 'pending) + (add-text-properties (line-beginning-position) + (line-end-position) + (list 'face 'ledger-font-reconciler-pending-face ))) + ((eq status 'cleared) + (add-text-properties (line-beginning-position) + (line-end-position) + (list 'face 'ledger-font-reconciler-cleared-face ))) + (t + (add-text-properties (line-beginning-position) + (line-end-position) + (list 'face 'ledger-font-reconciler-uncleared-face ))))) (forward-line) (beginning-of-line) (ledger-display-balance))) @@ -167,9 +180,8 @@ (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 + (if (eq face 'ledger-font-reconciler-pending-face) + (with-current-buffer (ledger-reconcile-get-buffer where) (goto-char (cdr where)) (ledger-toggle-current 'cleared)))) (forward-line 1))) @@ -240,9 +252,13 @@ "") (nth 4 xact) (nth 1 posting) (nth 2 posting))) (if (nth 3 posting) - (set-text-properties beg (1- (point)) - (list 'face 'ledger-font-reconciler-cleared-face - 'where where)) + (if (eq (nth 3 posting) 'pending) + (set-text-properties beg (1- (point)) + (list 'face 'ledger-font-reconciler-pending-face + 'where where)) + (set-text-properties beg (1- (point)) + (list 'face 'ledger-font-reconciler-cleared-face + 'where where))) (set-text-properties beg (1- (point)) (list 'face 'ledger-font-reconciler-uncleared-face 'where where)))) )) @@ -327,6 +343,7 @@ (define-key map [(control ?m)] 'ledger-reconcile-visit) (define-key map [return] 'ledger-reconcile-visit) (define-key map [(control ?l)] 'ledger-reconcile-refresh) + (define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish) (define-key map [? ] 'ledger-reconcile-toggle) (define-key map [?a] 'ledger-reconcile-add) (define-key map [?d] 'ledger-reconcile-delete) @@ -353,6 +370,8 @@ (define-key map [menu-bar ldg-recon-menu bal] '("Show Cleared Balance" . ledger-display-balance)) (define-key map [menu-bar ldg-recon-menu sep4] '("--")) (define-key map [menu-bar ldg-recon-menu rna] '("Reconcile New Account" . ledger-reconcile)) + (define-key map [menu-bar ldg-recon-menu sep5] '("--")) + (define-key map [menu-bar ldg-recon-menu fin] '("Finish" . ledger-reconcile-finish)) (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)) diff --git a/lisp/ldg-state.el b/lisp/ldg-state.el index 443cb350..7c499d3e 100644 --- a/lisp/ldg-state.el +++ b/lisp/ldg-state.el @@ -50,11 +50,26 @@ ((looking-at "\\*\\s-*") 'cleared) (t (ledger-transaction-state))))) -(defun ledger-toggle-current-transaction (&optional style) +(defun ledger-char-from-state (state) + (if state + (if (eq state 'pending) + "!" + "*") + "")) + +(defun ledger-state-from-char (state-char) + (cond ((eql state-char ?\!) + 'pending) + ((eql state-char ?\*) + 'cleared) + (t + nil))) + +(defun ledger-toggle-current-posting (&optional style) "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'). +`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 @@ -63,15 +78,16 @@ formatting, but doing so causes inline math expressions to be dropped." (interactive) (let ((bounds (ledger-current-transaction-bounds)) - clear cleared) + new-status cur-status) ;; Uncompact the entry, to make it easier to toggle the ;; transaction - (save-excursion - (goto-char (car bounds)) - (skip-chars-forward "0-9./= \t") - (setq cleared (and (member (char-after) '(?\* ?\!)) - (char-after))) - (when cleared + (save-excursion ;this excursion unclears the posting + (goto-char (car bounds)) ;beginning of xact + (skip-chars-forward "0-9./= \t") ;skip the date + (setq cur-status (and (member (char-after) '(?\* ?\!)) + (ledger-state-from-char (char-after)))) ;if the next char is !, * store it + ;;if cur-status if !, or * then delete the marker + (when cur-status (let ((here (point))) (skip-chars-forward "*! ") (let ((width (- (point) here))) @@ -82,17 +98,19 @@ dropped." (forward-line) (while (looking-at "[ \t]") (skip-chars-forward " \t") - (insert cleared " ") + (insert (ledger-char-from-state cur-status) " ") (if (search-forward " " (line-end-position) t) (delete-char 2)) - (forward-line)))) - ;; Toggle the individual transaction - (save-excursion + (forward-line)) + (setq new-status nil))) + + ;;this excursion marks the posting pending or cleared + (save-excursion (goto-char (line-beginning-position)) (when (looking-at "[ \t]") (skip-chars-forward " \t") (let ((here (point)) - (cleared (member (char-after) '(?\* ?\!)))) + (cur-status (ledger-state-from-char (char-after)))) (skip-chars-forward "*! ") (let ((width (- (point) here))) (when (> width 0) @@ -101,18 +119,18 @@ dropped." (if (search-forward " " (line-end-position) t) (insert (make-string width ? )))))) (let (inserted) - (if cleared + (if cur-status (if (and style (eq style 'cleared)) (progn (insert "* ") - (setq inserted t))) + (setq inserted 'cleared))) (if (and style (eq style 'pending)) (progn (insert "! ") - (setq inserted t)) + (setq inserted 'pending)) (progn (insert "* ") - (setq inserted t)))) + (setq inserted 'cleared)))) (if (and inserted (re-search-forward "\\(\t\\| [ \t]\\)" (line-end-position) t)) @@ -123,26 +141,25 @@ dropped." (delete-char 2)) ((looking-at " ") (delete-char 1)))) - (setq clear inserted))))) - ;; Clean up the entry so that it displays minimally + (setq new-status inserted))))) + + ;; This excursion cleans up the entry so that it displays minimally (save-excursion (goto-char (car bounds)) (forward-line) (let ((first t) - (state ? ) + (state nil) (hetero nil)) (while (and (not hetero) (looking-at "[ \t]")) (skip-chars-forward " \t") - (let ((cleared (if (member (char-after) '(?\* ?\!)) - (char-after) - ? ))) + (let ((cur-status (ledger-state-from-char (char-after)))) (if first - (setq state cleared + (setq state cur-status first nil) - (if (/= state cleared) + (if (not (eq state cur-status)) (setq hetero t)))) (forward-line)) - (when (and (not hetero) (/= state ? )) + (when (and (not hetero) (not (eq state nil))) (goto-char (car bounds)) (forward-line) (while (looking-at "[ \t]") @@ -158,7 +175,8 @@ dropped." (forward-line)) (goto-char (car bounds)) (skip-chars-forward "0-9./= \t") - (insert state " ") + (insert (ledger-char-from-state state) " ") + (setq new-status state) (if (re-search-forward "\\(\t\\| [ \t]\\)" (line-end-position) t) (cond @@ -168,7 +186,7 @@ dropped." (delete-char 2)) ((looking-at " ") (delete-char 1))))))) - clear)) + new-status)) (defun ledger-toggle-current (&optional style) (interactive) @@ -182,21 +200,22 @@ dropped." (save-excursion (not (eq 'transaction (ledger-thing-at-point))))) (if (looking-at "\\s-+[*!]") - (ledger-toggle-current-transaction nil)) + (ledger-toggle-current-transaction style)) (forward-line) (goto-char (line-beginning-position)))) - (ledger-toggle-current-entry style)) - (ledger-toggle-current-transaction style))) + (ledger-toggle-current-transaction style)) + (ledger-toggle-current-posting style))) -(defun ledger-toggle-current-entry (&optional style) +(defun ledger-toggle-current-transaction (&optional style) (interactive) - (let (clear) + (let (status) (save-excursion (when (or (looking-at "^[0-9]") (re-search-backward "^[0-9]" nil t)) (skip-chars-forward "0-9./=") (delete-horizontal-space) - (if (member (char-after) '(?\* ?\!)) + (if (or (eq (ledger-state-from-char (char-after)) 'pending) + (eq (ledger-state-from-char (char-after)) 'cleared)) (progn (delete-char 1) (if (and style (eq style 'cleared)) @@ -204,7 +223,7 @@ dropped." (if (and style (eq style 'pending)) (insert " ! ") (insert " * ")) - (setq clear t)))) - clear)) + (setq status t)))) + status)) (provide 'ldg-state) -- cgit v1.2.3 From 5eb322c0a29bcf2ddaa30bfaab577f18bb1fd922 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 12 Feb 2013 16:04:02 -0700 Subject: Comment and code cleanup --- lisp/ldg-complete.el | 7 ++++--- lisp/ldg-mode.el | 4 ++-- lisp/ldg-occur.el | 21 ++++++++++----------- lisp/ldg-post.el | 18 ++++++++++-------- lisp/ldg-reconcile.el | 35 ++++++++++++++++++++--------------- lisp/ldg-register.el | 3 +-- lisp/ldg-sort.el | 11 +++++++---- lisp/ldg-state.el | 8 ++++---- 8 files changed, 58 insertions(+), 49 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index b56a85ed..b841bae9 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -64,11 +64,12 @@ (goto-char (point-min)) (while (re-search-forward (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" - "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t) ;matches first line of transaction + "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t) ;; matches first line (unless (and (>= origin (match-beginning 0)) (< origin (match-end 0))) (setq payees-list (cons (match-string-no-properties 3) - payees-list))))) ;add the payee to the list + payees-list))))) ;; add the payee + ;; to the list (pcomplete-uniqify-list (nreverse payees-list)))) (defvar ledger-account-tree nil) @@ -130,7 +131,7 @@ (if (eq (save-excursion (ledger-thing-at-point)) 'transaction) (if (null current-prefix-arg) - (ledger-payees) ; this completes against payee names + (ledger-payees) ;; this completes against payee names (progn (let ((text (buffer-substring (line-beginning-position) (line-end-position)))) diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 95b02fdd..df277ee0 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -132,8 +132,8 @@ 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. 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))))) diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index bd5a49b1..d53be09b 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -125,14 +125,13 @@ When REGEX is nil, unhide everything, and remove higlight" (temp (point-max))) (mapcar (lambda (match) (progn - (setq temp prev-end) ;need a swap so that the - ;last form in the lambda - ;is the (make-overlay) - (setq prev-end (1+ (cadr match))) ;add 1 so - ;that we skip - ;the empty - ;line after - ;the xact + (setq temp prev-end) ;; need a swap so that + ;; the last form in + ;; the lambda is the + ;; (make-overlay) + (setq prev-end (1+ (cadr match))) + ;; add 1 so that we skip the + ;; empty line after the xact (make-overlay temp (car match) @@ -216,9 +215,9 @@ When REGEX is nil, unhide everything, and remove higlight" (save-excursion (let ((bounds (ledger-find-xact-extents (match-beginning 0)))) (push bounds lines) - (setq curpoint (cadr bounds)))) ;move to the end of the - ;xact, no need to search - ;inside it more + (setq curpoint (cadr bounds)))) ;; move to the end of + ;; the xact, no need to + ;; search inside it more (goto-char curpoint)) (forward-line 1)) (setq lines (nreverse lines))))) diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 7b6ac9d5..099db1c2 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -63,8 +63,8 @@ (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 strings -to choose from." + 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) @@ -113,7 +113,8 @@ to choose from." (defun ledger-align-amounts (&optional column) "Align amounts in the current region. -This is done so that the last digit falls in COLUMN, which defaults to 52." + This is done so that the last digit falls in COLUMN, which + defaults to 52." (interactive "p") (if (or (null column) (= column 1)) (setq column ledger-post-amount-alignment-column)) @@ -157,17 +158,18 @@ This is done so that the last digit falls in COLUMN, which defaults to 52." (interactive) (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 there is an amount to edit + (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 there is an amount to edit (if end-of-amount (let ((val (match-string 0))) (goto-char (match-beginning 0)) (delete-region (match-beginning 0) (match-end 0)) (calc) (while (string-match "," val) - (setq val (replace-match "" nil nil val))) ;gets rid of commas - (calc-eval val 'push)) ;edit the amount - (progn ;make sure there are two spaces after the account name and go to calc + (setq val (replace-match "" nil nil val))) ;; gets rid of commas + (calc-eval val 'push)) ;; edit the amount + (progn ;;make sure there are two spaces after the account name and go to calc (if (search-backward " " (- (point) 3) t) (goto-char (line-end-position)) (insert " ")) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 61db2472..25d2e981 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -92,7 +92,7 @@ (setq status (ledger-toggle-current (if ledger-reconcile-toggle-to-pending 'pending 'cleared)))) - ;remove the existing face and add the new face + ;; remove the existing face and add the new face (remove-text-properties (line-beginning-position) (line-end-position) (list 'face)) @@ -193,8 +193,8 @@ (ledger-reconcile-quit-cleanup) (let ((buf ledger-buf) (recon-buf (get-buffer ledger-recon-buffer-name))) - ;Make sure you delete the window before you delete the buffer, - ;otherwise, madness ensues + ;; Make sure you delete the window before you delete the buffer, + ;; otherwise, madness ensues (with-current-buffer recon-buf (delete-window (get-buffer-window recon-buf)) (kill-buffer recon-buf)) @@ -223,7 +223,8 @@ (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 + (1+ (point-marker))))))) ;;Add 1 to make sure the marker is + ;;within the transaction (defun ledger-do-reconcile () "get the uncleared transactions in the account and display them @@ -269,11 +270,11 @@ (set-buffer-modified-p nil) (toggle-read-only t) - ; this next piece of code ensures that the last of the visible - ; transactions in the ledger buffer is at the bottom of the main - ; window. The key to this is to ensure the window is selected - ; when the buffer point is moved and recentered. If they aren't - ; strange things happen. + ;; this next piece of code ensures that the last of the visible + ;; transactions in the ledger buffer is at the bottom of the main + ;; window. The key to this is to ensure the window is selected + ;; when the buffer point is moved and recentered. If they aren't + ;; strange things happen. (let ((recon-window (get-buffer-window (get-buffer ledger-recon-buffer-name)))) @@ -299,20 +300,24 @@ (defun ledger-reconcile (account) (interactive "sAccount to reconcile: ") (let ((buf (current-buffer)) - (rbuf (get-buffer ledger-recon-buffer-name))) ;this means only one *Reconcile* buffer, ever - (if rbuf ; *Reconcile* already exists + (rbuf (get-buffer ledger-recon-buffer-name))) ;; this means + ;; only one + ;; *Reconcile* + ;; buffer, ever + (if rbuf ;; *Reconcile* already exists (with-current-buffer rbuf - (set 'ledger-acct account) ; already buffer local + (set 'ledger-acct account) ;; already buffer local (if (not (eq buf rbuf)) - (progn ; called from some other ledger-mode buffer + (progn ;; called from some other ledger-mode buffer (ledger-reconcile-quit-cleanup) - (set 'ledger-buf buf))) ; should already be buffer-local + (set 'ledger-buf buf))) ;; should already be + ;; buffer-local (if ledger-fold-on-reconcile (ledger-occur-change-regex account ledger-buf)) (set-buffer (get-buffer ledger-recon-buffer-name)) (ledger-reconcile-refresh)) - (progn ; no recon-buffer, starting from scratch. + (progn ;; no recon-buffer, starting from scratch. (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t) (if ledger-fold-on-reconcile (ledger-occur-mode account buf)) diff --git a/lisp/ldg-register.el b/lisp/ldg-register.el index 6e98f20d..bfd8d360 100644 --- a/lisp/ldg-register.el +++ b/lisp/ldg-register.el @@ -69,8 +69,7 @@ (set-text-properties beg (1- (point)) (list 'where where)))) (setq index (1+ index))))) - (goto-char (point-min)) - ) + (goto-char (point-min))) (defun ledger-register-generate (&optional data-buffer &rest args) (let ((buf (or data-buffer (current-buffer)))) diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el index 86e3fa0a..8a1d9573 100644 --- a/lisp/ldg-sort.el +++ b/lisp/ldg-sort.el @@ -33,16 +33,19 @@ (forward-paragraph)) (defun ledger-sort-region (beg end) - (interactive "r") ;load beg and end from point and mark automagically + (interactive "r") ;; load beg and end from point and mark + ;; automagically (let ((new-beg beg) (new-end end)) (save-excursion (save-restriction - (ledger-next-record-function) ;make sure point is at the beginning of a xact + (ledger-next-record-function) ;; make sure point is at the + ;; beginning of a xact (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 + (ledger-next-record-function) ;; make sure end of region is at + ;; the beginning of next record + ;; after the region (setq new-end (point)) (narrow-to-region beg end) (goto-char (point-min)) diff --git a/lisp/ldg-state.el b/lisp/ldg-state.el index 7c499d3e..1ede3312 100644 --- a/lisp/ldg-state.el +++ b/lisp/ldg-state.el @@ -81,11 +81,11 @@ dropped." new-status cur-status) ;; Uncompact the entry, to make it easier to toggle the ;; transaction - (save-excursion ;this excursion unclears the posting - (goto-char (car bounds)) ;beginning of xact - (skip-chars-forward "0-9./= \t") ;skip the date + (save-excursion ;; this excursion unclears the posting + (goto-char (car bounds)) ;; beginning of xact + (skip-chars-forward "0-9./= \t") ;; skip the date (setq cur-status (and (member (char-after) '(?\* ?\!)) - (ledger-state-from-char (char-after)))) ;if the next char is !, * store it + (ledger-state-from-char (char-after)))) ;;if cur-status if !, or * then delete the marker (when cur-status (let ((here (point))) -- cgit v1.2.3 From a13bcd4109711ea756727c6e8a00a262ad220dae Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 12 Feb 2013 16:47:43 -0700 Subject: Bug 882 Calc mode doesn't play nice with decimal comma Added a few lines to transform the amount to decimal period format before pushing it to calc. --- lisp/ldg-post.el | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 099db1c2..8b0e3db6 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -45,6 +45,12 @@ :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 () (let ((origin (point)) (ledger-post-list nil) @@ -166,8 +172,15 @@ (goto-char (match-beginning 0)) (delete-region (match-beginning 0) (match-end 0)) (calc) - (while (string-match "," val) - (setq val (replace-match "" nil nil val))) ;; gets rid of commas + (if ledger-post-use-decimal-comma + (progn + (while (string-match "\\." val) + (setq val (replace-match "" nil nil val))) ;; gets rid of periods + (while (string-match "," val) + (setq val (replace-match "." nil nil val)))) ;; switch to period separator + (progn + (while (string-match "," val) + (setq val (replace-match "" nil nil val))))) ;; gets rid of commas (calc-eval val 'push)) ;; edit the amount (progn ;;make sure there are two spaces after the account name and go to calc (if (search-backward " " (- (point) 3) t) -- cgit v1.2.3 From 24a9e422eb811224d4340905e68867181cb26861 Mon Sep 17 00:00:00 2001 From: Rémi Vanicat Date: Wed, 13 Feb 2013 15:54:01 +0100 Subject: In ledger-do-reconcile, don't act on windows when reconcile hasn't one Ledger-do-reconcile might be called indirectly (in the after-save-hook for example) and one might not want this buffer she has buried to show up again when she is saving another (even related) buffer. --- lisp/ldg-reconcile.el | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 25d2e981..03663b6b 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -276,17 +276,17 @@ ;; when the buffer point is moved and recentered. If they aren't ;; strange things happen. - (let - ((recon-window (get-buffer-window (get-buffer ledger-recon-buffer-name)))) - (fit-window-to-buffer recon-window) - (with-current-buffer buf - (select-window (get-buffer-window buf)) - (goto-char (point-max)) - (recenter -1)) - - (select-window recon-window) - (add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t) - (ledger-reconcile-visit t)))) + (let ((recon-window (get-buffer-window (get-buffer ledger-recon-buffer-name)))) + (when recon-window + (fit-window-to-buffer recon-window) + (with-current-buffer buf + (select-window (get-buffer-window buf)) + (goto-char (point-max)) + (recenter -1)) + + (select-window recon-window) + (ledger-reconcile-visit t)) + (add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t)))) (defun ledger-reconcile-track-xact () (if (member this-command (list 'next-line -- cgit v1.2.3 From 69673748017fdc9cfe99740d80a3184eef7ca163 Mon Sep 17 00:00:00 2001 From: Rémi Vanicat Date: Wed, 13 Feb 2013 17:03:48 +0100 Subject: Ensure that the reconcile buffer is shown when ledger-reconcile is called. --- lisp/ldg-reconcile.el | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 03663b6b..d295fd81 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -297,6 +297,15 @@ (save-excursion (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" + (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) (interactive "sAccount to reconcile: ") (let ((buf (current-buffer)) @@ -315,6 +324,8 @@ (if ledger-fold-on-reconcile (ledger-occur-change-regex account ledger-buf)) (set-buffer (get-buffer ledger-recon-buffer-name)) + (unless (get-buffer-window rbuf) + (ledger-reconcile-open-windows buf rbuf)) (ledger-reconcile-refresh)) (progn ;; no recon-buffer, starting from scratch. @@ -322,19 +333,12 @@ (if ledger-fold-on-reconcile (ledger-occur-mode account buf)) - (with-current-buffer - (if ledger-reconcile-force-window-bottom - ;create the *Reconcile* window directly below the ledger buffer. - (progn - (set-window-buffer - (split-window (get-buffer-window buf) nil nil) - (get-buffer-create ledger-recon-buffer-name)) - (get-buffer ledger-recon-buffer-name)) - (pop-to-buffer (get-buffer-create ledger-recon-buffer-name))) + (with-current-buffer (get-buffer-create ledger-recon-buffer-name) + (ledger-reconcile-open-windows buf (current-buffer)) (ledger-reconcile-mode) (set (make-local-variable 'ledger-buf) buf) (set (make-local-variable 'ledger-acct) account) - (ledger-do-reconcile)))))) + (ledger-do-reconcile)))))) (defvar ledger-reconcile-mode-abbrev-table) -- cgit v1.2.3 From db9ae7dd042ecc49c2390b19a0670029cdb4e5fe Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 13 Feb 2013 09:36:44 -0700 Subject: Fixes workflow for using toggle-pending with clear-whole-transactions --- lisp/ldg-reconcile.el | 5 +++-- lisp/ldg-state.el | 13 +++++++++---- 2 files changed, 12 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 25d2e981..cae27a01 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -83,7 +83,6 @@ (defun ledger-reconcile-toggle () (interactive) (let ((where (get-text-property (point) 'where)) - (account ledger-acct) (inhibit-read-only t) status) (when (ledger-reconcile-get-buffer where) @@ -173,7 +172,9 @@ (ledger-display-balance)) (defun ledger-reconcile-finish () - "Mark all pending transactions as cleared, save the buffers and exit reconcile mode" + "Mark all pending posting or transactions as cleared, depending + on ledger-reconcile-clear-whole-transactions, save the buffers + and exit reconcile mode" (interactive) (save-excursion (goto-char (point-min)) diff --git a/lisp/ldg-state.el b/lisp/ldg-state.el index 1ede3312..fad7d71c 100644 --- a/lisp/ldg-state.el +++ b/lisp/ldg-state.el @@ -219,11 +219,16 @@ dropped." (progn (delete-char 1) (if (and style (eq style 'cleared)) - (insert " *"))) + (progn + (insert " *") + (setq status 'cleared)))) (if (and style (eq style 'pending)) - (insert " ! ") - (insert " * ")) - (setq status t)))) + (progn + (insert " ! ") + (setq status 'pending)) + (progn + (insert " * ") + (setq status 'cleared)))))) status)) (provide 'ldg-state) -- 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') 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 15d838d1f86b41e303e392d78eaac970311594cb Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 13 Feb 2013 13:23:04 -0700 Subject: Bug 893 Ledger reconcile loses alignment An earlier change to multi-file support stored the actual markers to the beginnings of the transaction/postings. When reconcile would insert characters it would invalidate those marker and after many items and been cleared could result in severe misalignment. This change brings back storing the line-numbers as reported by emacs. --- lisp/ldg-reconcile.el | 28 +++++++++++++--------------- lisp/ldg-xact.el | 2 ++ 2 files changed, 15 insertions(+), 15 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 822597f7..63ea522b 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -60,11 +60,11 @@ (let ((buffer ledger-buf) (account ledger-acct)) (with-temp-buffer - (ledger-exec-ledger buffer (current-buffer) "-C" "balance" account) + (ledger-exec-ledger buffer (current-buffer) "balance" "--limit" "cleared or pending" account) (goto-char (1- (point-max))) (goto-char (line-beginning-position)) (delete-horizontal-space) - (message "Cleared balance = %s" + (message "Current pending balance = %s" (buffer-substring-no-properties (point) (line-end-position)))))) @@ -87,7 +87,8 @@ status) (when (ledger-reconcile-get-buffer where) (with-current-buffer (ledger-reconcile-get-buffer where) - (goto-char (cdr where)) + (ledger-goto-line (cdr where)) + (forward-char) (setq status (ledger-toggle-current (if ledger-reconcile-toggle-to-pending 'pending 'cleared)))) @@ -139,7 +140,7 @@ (let ((where (get-text-property (point) 'where))) (when (ledger-reconcile-get-buffer where) (with-current-buffer (ledger-reconcile-get-buffer where) - (goto-char (cdr where)) + (ledger-goto-line (cdr where)) (ledger-delete-current-transaction)) (let ((inhibit-read-only t)) (goto-char (line-beginning-position)) @@ -157,7 +158,8 @@ (cur-buf (get-buffer ledger-recon-buffer-name))) (when target-buffer (switch-to-buffer-other-window target-buffer) - (goto-char (cdr where)) + (ledger-goto-line (cdr where)) + (forward-char) (recenter) (ledger-highlight-xact-under-point) (if come-back @@ -183,7 +185,7 @@ (face (get-text-property (point) 'face))) (if (eq face 'ledger-font-reconciler-pending-face) (with-current-buffer (ledger-reconcile-get-buffer where) - (goto-char (cdr where)) + (ledger-goto-line (cdr where)) (ledger-toggle-current 'cleared)))) (forward-line 1))) (ledger-reconcile-save)) @@ -217,15 +219,11 @@ (let ((buf (if (is-stdin (nth 0 emacs-xact)) ledger-buf (find-file-noselect (nth 0 emacs-xact))))) - (with-current-buffer buf - (cons - buf - (save-excursion - (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 + (cons + buf + (if ledger-clear-whole-transactions + (nth 1 emacs-xact) ;; return line-no of xact + (nth 0 posting))))) ;; return line-no of posting (defun ledger-do-reconcile () "get the uncleared transactions in the account and display them diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index ab2c34f4..4b73b2ea 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -74,5 +74,7 @@ (ledger-context-field-value context-info 'payee) nil)))) +(defsubst ledger-goto-line (line-number) + (goto-char (point-min)) (forward-line (1- line-number))) (provide 'ldg-xact) \ No newline at end of file -- cgit v1.2.3 From d31913871fc2ca3ba26e12bb302df2dd93cdd3da Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 13 Feb 2013 15:53:16 -0700 Subject: Added rudimentary target checking to reconcile. --- doc/ledger3.texi | 12 ++++++- lisp/ldg-commodities.el | 93 +++++++++++++++++++++++++++++++++++++++++++++++++ lisp/ldg-new.el | 2 ++ lisp/ldg-reconcile.el | 56 +++++++++++++++++++++++------ 4 files changed, 152 insertions(+), 11 deletions(-) create mode 100644 lisp/ldg-commodities.el (limited to 'lisp') diff --git a/doc/ledger3.texi b/doc/ledger3.texi index a8f1d4b1..55732ceb 100644 --- a/doc/ledger3.texi +++ b/doc/ledger3.texi @@ -2542,7 +2542,7 @@ all of the uncleared transactions. The reconcile buffer has several functions: @table @code @item SPACE - toggles the cleared status of a transaction, and show cleared balance inthe minibuffer + toggles the cleared status of a transaction, and shows pending balance in the mini-buffer @item RETURN moves the cursor to that transaction in the ledger. @item C-x C-s @@ -2555,6 +2555,8 @@ all of the uncleared transactions. The reconcile buffer has several functions: add entry @item D delete entry + @item t + change target reconciliation amount @item g reconcile new account @item b @@ -2570,6 +2572,14 @@ show all transaction meeting the regex, cleared or not. This behavior can be disabled by setting @code{ledger-fold-on-reconcile} to nil in the emacs customization menus. +When you reconcile an account you nromally know the final balance you +are aiming at. When you enter the reconciliation mode ledger will ask +for a target balance. Enter the amount you are aiming for (the default +commodity can be chaged in the customization window). Each time you +toggle a posting to pending, ledger will calculate the new balance of +the account and display the new balance and the difference to make the +target. + @node Generating Reports, , Reconciling accounts, Using EMACS @subsection Generating Reports diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el new file mode 100644 index 00000000..94d2ddf0 --- /dev/null +++ b/lisp/ldg-commodities.el @@ -0,0 +1,93 @@ +;;; ldg-commodities.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. + + + + +;;; Commentary: +;; Helper functions to deal with commoditized numbers. A commoditized +;; number will be a cons of value and string where the string contains +;; the commodity + +;;; Code: + +(defcustom ledger-reconcile-default-commodity "$" + "the default commodity for use in target calculations in ledger reconcile" + :type 'string + :group 'ledger) + +(defun ledger-string-balance-to-commoditized-amount (str) + (let ((fields (split-string str "[\n\r]"))) ; break any balances + ; with multi commodities + ; into a list + (mapcar '(lambda (str) + (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)))) + fields))) + + +(defun -commodity (c1 c2) + (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) + (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))) + (commodity (cadr c1))) + (if (> (length commodity) 1) + (concat val " " commodity) + (concat commodity " " val)))) + +(defun ledger-read-commodity-string (comm) + (interactive (list (read-from-minibuffer + (concat "Enter commoditized amount (" ledger-reconcile-default-commodity "): ")))) + (let ((parts (split-string comm))) + (if parts + (if (/= (length parts) 2) ;;assume a number was entered and use default commodity + (list (string-to-number (car parts)) + ledger-reconcile-default-commodity) + (let ((valp1 (string-to-number (car parts))) + (valp2 (string-to-number (cadr parts)))) + (cond ((and (= valp1 valp2) (= 0 valp1));; means neither contained a valid number (both = 0) + (list 0 "")) + ((and (/= 0 valp1) (= valp2 0)) + (list valp1 (cadr parts))) + ((and (/= 0 valp2) (= valp1 0)) + (list valp2 (car parts))) + (t + (error "cannot understand commodity")))))))) + +(provide 'ldg-commodities) + +;;; ldg-commodities.el ends here diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index ad21564a..3c56c108 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -46,6 +46,8 @@ (require 'ldg-sort) (require 'ldg-fonts) (require 'ldg-occur) +(require 'ldg-commodities) + (autoload #'ledger-texi-update-test "ldg-texi" nil t) (autoload #'ledger-texi-update-examples "ldg-texi" nil t) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 63ea522b..bb8d97f2 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -24,6 +24,7 @@ (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" @@ -54,19 +55,42 @@ :type 'boolean :group 'ledger) -(defun ledger-display-balance () - "Calculate the cleared balance of the account being reconciled" + +(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" (interactive) (let ((buffer ledger-buf) - (account ledger-acct)) + (account ledger-acct) + (val nil)) (with-temp-buffer - (ledger-exec-ledger buffer (current-buffer) "balance" "--limit" "cleared or pending" account) - (goto-char (1- (point-max))) - (goto-char (line-beginning-position)) - (delete-horizontal-space) - (message "Current pending balance = %s" - (buffer-substring-no-properties (point) - (line-end-position)))))) + (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" + "--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" + (interactive) + (let* ((pending (car (ledger-string-balance-to-commoditized-amount + (car (ledger-reconcile-get-balances))))) + (target-delta (if ledger-target + (-commodity ledger-target pending) + nil))) + + (if target-delta + (message "Pending balance: %s, Difference from target: %s" + (ledger-commodity-to-string pending) + (ledger-commodity-to-string target-delta)) + (message "Pending balance: %s" + (ledger-commodity-to-string pending))))) + + + (defun is-stdin (file) "True if ledger file is standard input" @@ -323,6 +347,8 @@ Spliting the windows of BUF if needed" (if ledger-fold-on-reconcile (ledger-occur-change-regex account ledger-buf)) (set-buffer (get-buffer ledger-recon-buffer-name)) + (setq ledger-target + (call-interactively #'ledger-read-commodity-string)) (unless (get-buffer-window rbuf) (ledger-reconcile-open-windows buf rbuf)) (ledger-reconcile-refresh)) @@ -337,10 +363,18 @@ Spliting the windows of BUF if needed" (ledger-reconcile-mode) (set (make-local-variable 'ledger-buf) buf) (set (make-local-variable 'ledger-acct) account) + (set (make-local-variable 'ledger-target) + (call-interactively #'ledger-read-commodity-string)) (ledger-do-reconcile)))))) (defvar ledger-reconcile-mode-abbrev-table) +(defun ledger-reconcile-change-target () + (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)) @@ -358,6 +392,7 @@ Spliting the windows of BUF if needed" (define-key map [?g] 'ledger-reconcile); (define-key map [?n] 'next-line) (define-key map [?p] 'previous-line) + (define-key map [?t] 'ledger-reconcile-change-target) (define-key map [?s] 'ledger-reconcile-save) (define-key map [?q] 'ledger-reconcile-quit) (define-key map [?b] 'ledger-display-balance) @@ -376,6 +411,7 @@ Spliting the windows of BUF if needed" (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 bal] '("Show Cleared Balance" . ledger-display-balance)) + (define-key map [menu-bar ldg-recon-menu tgt] '("Change Target Balance" . ledger-reconcile-change-target)) (define-key map [menu-bar ldg-recon-menu sep4] '("--")) (define-key map [menu-bar ldg-recon-menu rna] '("Reconcile New Account" . ledger-reconcile)) (define-key map [menu-bar ldg-recon-menu sep5] '("--")) -- cgit v1.2.3 From c031fa4943760cc6ff8af56ce975ac289e04288e Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 13 Feb 2013 20:45:22 -0700 Subject: Added menu entry for complete entry. Refactored leg-complete to get rid of some side effect usage --- lisp/ldg-complete.el | 54 +++++++++++++++++++--------------------------------- lisp/ldg-mode.el | 3 ++- lisp/ldg-xact.el | 15 +++++++++++++++ 3 files changed, 37 insertions(+), 35 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index b841bae9..a0508a98 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -25,21 +25,6 @@ ;; In-place completion support -(defun ledger-thing-at-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)) - 'entry) - (t - (ignore (goto-char here)))))) - (defun ledger-parse-arguments () "Parse whitespace separated arguments in the current region." (let* ((info (save-excursion @@ -57,7 +42,7 @@ args))) (cons (reverse args) (reverse begins))))) -(defun ledger-payees () +(defun ledger-payees-in-buffer () (let ((origin (point)) payees-list) (save-excursion @@ -72,36 +57,36 @@ ;; to the list (pcomplete-uniqify-list (nreverse payees-list)))) -(defvar ledger-account-tree nil) - -(defun ledger-find-accounts () +(defun ledger-find-accounts-in-buffer () + "search through buffer and build tree of accounts. Return tree + structure" (let ((origin (point)) - account-path - elements) + (account-tree (list t)) + (account-elements nil)) (save-excursion - (setq ledger-account-tree (list t)) (goto-char (point-min)) (while (re-search-forward "^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)" nil t) (unless (and (>= origin (match-beginning 0)) (< origin (match-end 0))) - (setq account-path (match-string-no-properties 2)) - (setq elements (split-string account-path ":")) - (let ((root ledger-account-tree)) - (while elements - (let ((entry (assoc (car elements) root))) + (setq account-elements + (split-string + (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 elements) (list t))) + (setq entry (cons (car account-elements) (list t))) (nconc root (list entry)) (setq root (cdr entry)))) - (setq elements (cdr elements))))))))) + (setq account-elements (cdr account-elements))))))) + account-tree)) (defun ledger-accounts () - (ledger-find-accounts) (let* ((current (caar (ledger-parse-arguments))) (elements (and current (split-string current ":"))) - (root ledger-account-tree) + (root (ledger-find-accounts-in-buffer)) (prefix nil)) (while (cdr elements) (let ((entry (assoc (car elements) root))) @@ -131,7 +116,7 @@ (if (eq (save-excursion (ledger-thing-at-point)) 'transaction) (if (null current-prefix-arg) - (ledger-payees) ;; this completes against payee names + (ledger-payees-in-buffer) ;; this completes against payee names (progn (let ((text (buffer-substring (line-beginning-position) (line-end-position)))) @@ -149,7 +134,8 @@ (ledger-accounts))))) (defun ledger-fully-complete-entry () - "Do appropriate completion for the thing at point" + "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) @@ -157,7 +143,7 @@ (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) + (regexp-quote name) ) nil t) ;; "\\(\t\\|\n\\| [ \t]\\)" (forward-line) (while (looking-at "^\\s-+") (setq xacts (cons (buffer-substring-no-properties diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index df277ee0..ea780279 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -120,7 +120,8 @@ customizable to ease retro-entry.") (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)) - (define-key map [add-xact] '(menu-item "Add Transaction" ledger-add-transaction :enable ledger-works)) + (define-key map [cmp-xact] '(menu-item "Complete Transaction" ledger-fully-complete-entry)) + (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)) (define-key map [reconcile] '(menu-item "Hide Xacts" ledger-occur)))) diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index 4b73b2ea..306401af 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -77,4 +77,19 @@ (defsubst ledger-goto-line (line-number) (goto-char (point-min)) (forward-line (1- line-number))) +(defun ledger-thing-at-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)) + 'entry) + (t + (ignore (goto-char here)))))) + (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') 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 30dc7e349db236d842cbe86fbf4972f0dbbbd10a Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 14 Feb 2013 10:05:53 -0700 Subject: Fix to target change function in leg-reconcile Took out the (interactive) statement and it needed to be there. --- lisp/ldg-reconcile.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index bb8d97f2..96a10afb 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -370,6 +370,7 @@ Spliting the windows of BUF if needed" (defvar ledger-reconcile-mode-abbrev-table) (defun ledger-reconcile-change-target () + (interactive) (setq ledger-target (call-interactively #'ledger-read-commodity-string))) ; (setq ledger-target ; (if (and target (> (length target) 0)) -- 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') 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 6eb97a7c38ba236f7cf38f694e2f579b6406bae5 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 14 Feb 2013 13:20:16 -0700 Subject: Added a copy transaction function to ledger-mode --- lisp/ldg-mode.el | 12 +++++++----- lisp/ldg-xact.el | 24 ++++++++++++++++++++++-- 2 files changed, 29 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index ea780279..fc018853 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -71,16 +71,17 @@ customizable to ease retro-entry.") (let ((map (current-local-map))) (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 ?b)] 'ledger-post-edit-amount) (define-key map [(control ?c) (control ?c)] 'ledger-toggle-current) + (define-key map [(control ?c) (control ?d)] 'ledger-delete-current-transaction) (define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-transaction) + (define-key map [(control ?c) (control ?f)] 'ledger-occur) + (define-key map [(control ?c) (control ?k)] 'ledger-copy-transaction) + (define-key map [(control ?c) (control ?m)] 'ledger-set-month) (define-key map [(control ?c) (control ?r)] 'ledger-reconcile) (define-key map [(control ?c) (control ?s)] 'ledger-sort-region) (define-key map [(control ?c) (control ?t)] 'ledger-test-run) - (define-key map [(control ?c) (control ?b)] 'ledger-post-edit-amount) - (define-key map [(control ?c) (control ?f)] 'ledger-occur) + (define-key map [(control ?c) (control ?y)] 'ledger-set-year) (define-key map [tab] 'pcomplete) (define-key map [(control ?i)] 'pcomplete) (define-key map [(control ?c) tab] 'ledger-fully-complete-entry) @@ -114,6 +115,7 @@ customizable to ease retro-entry.") (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 [copy-xact] '(menu-item "Copy Trans at Point" ledger-copy-transaction)) (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 "--")) diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index 306401af..a1c768ca 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -27,8 +27,6 @@ :type 'boolean :group 'ledger) - - (defvar highlight-overlay (list)) (defun ledger-find-xact-extents (pos) @@ -92,4 +90,26 @@ (t (ignore (goto-char here)))))) +(defun ledger-copy-transaction-at-point (date) + (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))) + encoded-date) + (if (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" date) + (setq encoded-date + (encode-time 0 0 0 (string-to-number (match-string 3 date)) + (string-to-number (match-string 2 date)) + (string-to-number (match-string 1 date))))) + (ledger-find-slot encoded-date) + (insert transaction "\n") + (backward-paragraph) + (re-search-forward "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)") + (replace-match date) + (re-search-forward "[1-9][0-9]+\.[0-9]+"))) + + + (provide 'ldg-xact) \ No newline at end of file -- 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') 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 089716fb13911ea6a1c044ed5d435809f9e2fff6 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 14 Feb 2013 19:38:42 -0700 Subject: Bug 894 Changing reconciliation account now repositions point in the Reconcile buffer correctly. --- lisp/ldg-reconcile.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index b632a070..ea8ff06e 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -74,7 +74,7 @@ numbers" ; split arguments like the shell does, so you need to ; specify the individual fields in the command line. "balance" "--limit" "cleared or pending" - "--format" "(\"%(amount)\")" account) + "--format" "(\"%(display_total)\")" account) (setq val (read (buffer-substring-no-properties (point-min) (point-max))))))) (defun ledger-display-balance () @@ -363,7 +363,8 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (call-interactively #'ledger-read-commodity-string)) (unless (get-buffer-window rbuf) (ledger-reconcile-open-windows buf rbuf)) - (ledger-reconcile-refresh)) + (ledger-reconcile-refresh) + (goto-char (point-min))) (progn ;; no recon-buffer, starting from scratch. (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t) -- cgit v1.2.3 From 7f0693bcdc6829aaad100c52fcb16dacd89aed62 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 15 Feb 2013 06:14:33 -0700 Subject: Improved error reporting --- lisp/ldg-commodities.el | 6 ------ lisp/ldg-complete.el | 2 +- lisp/ldg-mode.el | 2 +- lisp/ldg-reconcile.el | 4 ++-- 4 files changed, 4 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index c007816d..ab5c8898 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -19,12 +19,6 @@ ;; 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: ;; Helper functions to deal with commoditized numbers. A commoditized ;; number will be a cons of value and string where the string contains diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index 82046e07..1836eb2c 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -132,7 +132,7 @@ Return tree structure" (line-end-position)) (condition-case err (ledger-add-transaction text t) - ((error) + ((error "ledger-complete-at-point") (insert text)))) (forward-line) (goto-char (line-end-position)) diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 6cab7c9b..6499d803 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -229,7 +229,7 @@ correct chronological place in the buffer." (mapcar 'eval args))) (goto-char (point-min)) (if (looking-at "Error: ") - (error (buffer-string)) + (error (concat "Error in ledger-add-transaction: " (buffer-string)) (buffer-string))) "\n")) (progn diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index ea8ff06e..bb4bec5e 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -107,7 +107,7 @@ numbers" "Return a buffer from WHERE the transaction is." (if (bufferp (car where)) (car where) - (error "Buffer not set"))) + (error "ledger-reconcile-get-buffer: Buffer not set"))) (defun ledger-reconcile-toggle () "Toggle the current transaction, and mark the recon window." @@ -273,7 +273,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (goto-char (point-min)) (unless (eobp) (unless (looking-at "(") - (error (buffer-string))) + (error (concat "ledger-do-reconcile: " (buffer-string))) (read (current-buffer)))))) ;current-buffer is the *temp* created above (if (> (length xacts) 0) (progn -- cgit v1.2.3 From 8116ef478160364cde1b33429ae03c81a536ccbf Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 15 Feb 2013 08:07:41 -0700 Subject: Oops. This adds missing parenthesis to the last commit. --- lisp/ldg-mode.el | 2 +- lisp/ldg-reconcile.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 6499d803..01a1b615 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -229,7 +229,7 @@ correct chronological place in the buffer." (mapcar 'eval args))) (goto-char (point-min)) (if (looking-at "Error: ") - (error (concat "Error in ledger-add-transaction: " (buffer-string)) + (error (concat "Error in ledger-add-transaction: " (buffer-string))) (buffer-string))) "\n")) (progn diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index bb4bec5e..373b3de9 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -273,7 +273,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (goto-char (point-min)) (unless (eobp) (unless (looking-at "(") - (error (concat "ledger-do-reconcile: " (buffer-string))) + (error (concat "ledger-do-reconcile: " (buffer-string)))) (read (current-buffer)))))) ;current-buffer is the *temp* created above (if (> (length xacts) 0) (progn -- cgit v1.2.3 From 9d2b2e3cebacb40abadfe6820a0064bbff088d39 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 15 Feb 2013 08:54:04 -0700 Subject: Fixes Bug 897. toggle now works correctly if there are comment lines in the xact --- lisp/ldg-state.el | 32 ++++++++++++++++++++------------ 1 file changed, 20 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-state.el b/lisp/ldg-state.el index 3e349e4e..6c66ab24 100644 --- a/lisp/ldg-state.el +++ b/lisp/ldg-state.el @@ -73,6 +73,8 @@ 'pending) ((eql state-char ?\*) 'cleared) + ((eql state-char ?\;) + 'comment) (t nil))) @@ -92,7 +94,8 @@ dropped." new-status cur-status) ;; Uncompact the entry, to make it easier to toggle the ;; transaction - (save-excursion ;; this excursion unclears the posting + (save-excursion ;; this excursion checks state of entire + ;; transaction and unclears if marked (goto-char (car bounds)) ;; beginning of xact (skip-chars-forward "0-9./= \t") ;; skip the date (setq cur-status (and (member (char-after) '(?\* ?\!)) @@ -107,15 +110,17 @@ dropped." (if (search-forward " " (line-end-position) t) (insert (make-string width ? )))))) (forward-line) + ;; Shift the cleared/pending status to the postings (while (looking-at "[ \t]") (skip-chars-forward " \t") - (insert (ledger-char-from-state cur-status) " ") - (if (search-forward " " (line-end-position) t) - (delete-char 2)) - (forward-line)) + (when (not (eq (ledger-state-from-char (char-after)) 'comment)) + (insert (ledger-char-from-state cur-status) " ") + (if (search-forward " " (line-end-position) t) + (delete-char 2))) + (forward-line)) (setq new-status nil))) - ;;this excursion marks the posting pending or cleared + ;;this excursion toggles the posting status (save-excursion (goto-char (line-beginning-position)) (when (looking-at "[ \t]") @@ -154,7 +159,9 @@ dropped." (delete-char 1)))) (setq new-status inserted))))) - ;; This excursion cleans up the entry so that it displays minimally + ;; This excursion cleans up the entry so that it displays + ;; minimally. This means that if all posts are cleared, remove + ;; the marks and clear the entire transaction. (save-excursion (goto-char (car bounds)) (forward-line) @@ -164,11 +171,12 @@ dropped." (while (and (not hetero) (looking-at "[ \t]")) (skip-chars-forward " \t") (let ((cur-status (ledger-state-from-char (char-after)))) - (if first - (setq state cur-status - first nil) - (if (not (eq state cur-status)) - (setq hetero t)))) + (if (not (eq cur-status 'comment)) + (if first + (setq state cur-status + first nil) + (if (not (eq state cur-status)) + (setq hetero t))))) (forward-line)) (when (and (not hetero) (not (eq state nil))) (goto-char (car bounds)) -- cgit v1.2.3 From 2a7d1c83dd94b7d3af7e25c9e0ae40349f7c8dcd Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 15 Feb 2013 09:04:34 -0700 Subject: Corrects problem clearing a transaction toggle-current in the payee line will override all posting statuses and clear or unclear the entire transaction. --- lisp/ldg-state.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-state.el b/lisp/ldg-state.el index 6c66ab24..beecb591 100644 --- a/lisp/ldg-state.el +++ b/lisp/ldg-state.el @@ -220,7 +220,7 @@ dropped." (save-excursion (not (eq 'transaction (ledger-thing-at-point))))) (if (looking-at "\\s-+[*!]") - (ledger-toggle-current-transaction style)) + (ledger-toggle-current-posting style)) (forward-line) (goto-char (line-beginning-position)))) (ledger-toggle-current-transaction style)) -- 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') 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 d37a369c12f0f29bc00d87bb7ef75347c6c5dffe Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 15 Feb 2013 12:43:56 -0700 Subject: Changed prompt for reconciliation target. --- lisp/ldg-commodities.el | 7 +++---- lisp/ldg-reconcile.el | 6 +++--- 2 files changed, 6 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index ab5c8898..cf2ee128 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -69,12 +69,11 @@ longer one are after the value." (concat val " " commodity) (concat commodity " " val)))) -(defun ledger-read-commodity-string (comm) +(defun ledger-read-commodity-string (prompt) "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))) + (let ((parts (split-string (read-from-minibuffer + (concat prompt " (" ledger-reconcile-default-commodity "): "))))) (if parts (if (/= (length parts) 2) ;;assume a number was entered and use default commodity (list (string-to-number (car parts)) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 373b3de9..58cb6626 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -360,7 +360,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (ledger-occur-change-regex account ledger-buf)) (set-buffer (get-buffer ledger-recon-buffer-name)) (setq ledger-target - (call-interactively #'ledger-read-commodity-string)) + (ledger-read-commodity-string "Set reconciliation target")) (unless (get-buffer-window rbuf) (ledger-reconcile-open-windows buf rbuf)) (ledger-reconcile-refresh) @@ -377,7 +377,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (set (make-local-variable 'ledger-buf) buf) (set (make-local-variable 'ledger-acct) account) (set (make-local-variable 'ledger-target) - (call-interactively #'ledger-read-commodity-string)) + (ledger-read-commodity-string "Set reconciliation target")) (ledger-do-reconcile)))))) (defvar ledger-reconcile-mode-abbrev-table) @@ -385,7 +385,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (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 (ledger-read-commodity-string "Set reconciliation target"))) (define-derived-mode ledger-reconcile-mode text-mode "Reconcile" "A mode for reconciling ledger entries." -- cgit v1.2.3 From 0357f92f810ad4843ba11e321ad63e804ad0354e Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 16 Feb 2013 08:56:25 -0700 Subject: Make sure ledger-fully-complete-entry copies the rest of the payee line --- lisp/ldg-complete.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index 1836eb2c..3fd1b319 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -146,13 +146,17 @@ Return tree structure" Does not use ledger xact" (interactive) (let ((name (caar (ledger-parse-arguments))) + rest-of-name xacts) (save-excursion (when (eq 'transaction (ledger-thing-at-point)) + ;; Search backward for a matching payee (when (re-search-backward (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" (regexp-quote name) ) nil t) ;; "\\(\t\\|\n\\| [ \t]\\)" - (forward-line) + (setq rest-of-name (buffer-substring-no-properties (match-end 0) (line-end-position))) + ;; Start copying the postings + (forward-line) (while (looking-at "^\\s-+") (setq xacts (cons (buffer-substring-no-properties (line-beginning-position) @@ -162,6 +166,7 @@ Does not use ledger xact" (setq xacts (nreverse xacts))))) (when xacts (save-excursion + (insert rest-of-name) (insert ?\n) (while xacts (insert (car xacts) ?\n) -- 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') 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 21cdc04ab3eaea54c90bf93bd33aedb44cab29fb Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 18 Feb 2013 08:45:24 -0700 Subject: Fixes Bug 900 If the buffer being reconciles was killed with the *Reconcile* buffer still around their were dirty hooks left around that caused bug problems. This fix adds a local kill-buffer hook that calls the ledger-quit routines --- lisp/ldg-reconcile.el | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 20857127..ebaf7949 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -228,23 +228,23 @@ and exit reconcile mode" (defun ledger-reconcile-quit () - "Quite the reconcile window without saving ledger buffer." + "Quit the reconcile window without saving ledger buffer." (interactive) - (ledger-reconcile-quit-cleanup) - (let ((buf ledger-buf) - (recon-buf (get-buffer ledger-recon-buffer-name))) - ;; Make sure you delete the window before you delete the buffer, - ;; otherwise, madness ensues + (let ((recon-buf (get-buffer ledger-recon-buffer-name)) + buf) (with-current-buffer recon-buf + (ledger-reconcile-quit-cleanup) + (set 'buf ledger-buf) + ;; Make sure you delete the window before you delete the buffer, + ;; otherwise, madness ensues (delete-window (get-buffer-window recon-buf)) - (kill-buffer recon-buf)) - (set-window-buffer (selected-window) buf))) + (kill-buffer recon-buf) + (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))) + (let ((buf ledger-buf)) (with-current-buffer buf (remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t) (if ledger-fold-on-reconcile @@ -315,6 +315,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (when recon-window (fit-window-to-buffer recon-window) (with-current-buffer buf + (add-hook 'kill-buffer-hook 'ledger-reconcile-quit nil t) (select-window (get-buffer-window buf)) (goto-char (point-max)) (recenter -1)) @@ -426,9 +427,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (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) - - (add-hook 'kill-buffer-hook 'ledger-reconcile-quit-cleanup nil t))) + (use-local-map map))) (provide 'ldg-reconcile) (provide 'ldg-reconcile) -- cgit v1.2.3 From cf39acfd8ba0ebb542cf32f86944b2b6361cc6db Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 19 Feb 2013 09:30:20 -0700 Subject: Fix another null buffer problem when closing ledger buffers --- lisp/ldg-new.el | 1 + lisp/ldg-reconcile.el | 26 ++++++++++++++------------ 2 files changed, 15 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index ab267747..1e70c432 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -47,6 +47,7 @@ (require 'ldg-fonts) (require 'ldg-occur) (require 'ldg-commodities) +(require 'esh-arg) ;;; Code: diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index ebaf7949..6d7226de 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -232,23 +232,25 @@ and exit reconcile mode" (interactive) (let ((recon-buf (get-buffer ledger-recon-buffer-name)) buf) - (with-current-buffer recon-buf - (ledger-reconcile-quit-cleanup) - (set 'buf ledger-buf) - ;; Make sure you delete the window before you delete the buffer, - ;; otherwise, madness ensues - (delete-window (get-buffer-window recon-buf)) - (kill-buffer recon-buf) - (set-window-buffer (selected-window) buf)))) + (if recon-buf + (with-current-buffer recon-buf + (ledger-reconcile-quit-cleanup) + (set 'buf ledger-buf) + ;; Make sure you delete the window before you delete the buffer, + ;; otherwise, madness ensues + (delete-window (get-buffer-window recon-buf)) + (kill-buffer recon-buf) + (set-window-buffer (selected-window) buf))))) (defun ledger-reconcile-quit-cleanup () "Cleanup all hooks established by reconcile mode." (interactive) (let ((buf ledger-buf)) - (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))))) + (if buf + (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)))))) (defun ledger-marker-where-xact-is (emacs-xact posting) "Find the position of the EMACS-XACT in the `ledger-buf'. -- cgit v1.2.3 From 4ebd17efb391b5236c69f5d7eb3b5852a962fe58 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 19 Feb 2013 16:44:53 -0700 Subject: Better way of splitting the commodity from the value. Should allow no spaces between commodities and values. --- lisp/ldg-commodities.el | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index 04dc23de..1b6b332a 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -37,20 +37,30 @@ This only has effect interfacing to calc mode in edit amount" :type 'boolean :group 'ledger) +(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)) + (re-search-forward "-?[1-9][0-9]*[.,][0-9]*") + (setq val + (string-to-number + (ledger-commodity-string-number-decimalize + (delete-and-extract-region (match-beginning 0) (match-end 0)) :from-user))) + (delete-trailing-whitespace) + (setq comm (buffer-substring (point-min) (point-max))) + (list val comm)))) + + (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 (mapcar '(lambda (str) - (let* ((parts (split-string str)) ;break into number and commodity string - (first (car parts)) - (second (cadr parts))) - (if (string-match "^-*[1-9]+" 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)))) + (ledger-split-commodity-string str)) fields))) -- cgit v1.2.3 From 988a41c3a4e9dbc131bb3e0d2fca18f796468777 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 20 Feb 2013 14:00:46 -0700 Subject: Make ledger-reconcile a little cleaner. The recon buffer is filled before asking for target, so there isn't a blank window showing while asking for target. --- lisp/ldg-reconcile.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 6d7226de..602d918e 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -362,12 +362,12 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (if ledger-fold-on-reconcile (ledger-occur-change-regex account ledger-buf)) (set-buffer (get-buffer ledger-recon-buffer-name)) - (setq ledger-target - (ledger-read-commodity-string "Set reconciliation target")) (unless (get-buffer-window rbuf) (ledger-reconcile-open-windows buf rbuf)) (ledger-reconcile-refresh) - (goto-char (point-min))) + (goto-char (point-min)) + (setq ledger-target + (ledger-read-commodity-string "Set reconciliation target"))) (progn ;; no recon-buffer, starting from scratch. (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t) @@ -379,9 +379,9 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (ledger-reconcile-mode) (set (make-local-variable 'ledger-buf) buf) (set (make-local-variable 'ledger-acct) account) + (ledger-do-reconcile) (set (make-local-variable 'ledger-target) - (ledger-read-commodity-string "Set reconciliation target")) - (ledger-do-reconcile)))))) + (ledger-read-commodity-string "Set reconciliation target"))))))) (defvar ledger-reconcile-mode-abbrev-table) -- cgit v1.2.3 From f54c15bdf575377383923d368f5de2b5e56a7669 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 20 Feb 2013 16:13:27 -0700 Subject: Bug 884. Highlight first line of file --- lisp/ldg-xact.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index 94a58542..f5a38ef6 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -42,7 +42,8 @@ within the transaction." (let ((end-pos pos) (beg-pos pos)) (backward-paragraph) - (forward-line) + (if (/= (point) (point-min)) + (forward-line)) (beginning-of-line) (setq beg-pos (point)) (forward-paragraph) -- cgit v1.2.3 From 8029fd1149a607ee2eed7712194904b6c711d4b4 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 20 Feb 2013 20:46:38 -0700 Subject: Run ledger-highlight-xact-under-point when reconcile quits, so only one xact is highlighted --- lisp/ldg-reconcile.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 602d918e..9ac89915 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -250,7 +250,9 @@ and exit reconcile mode" (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)))))) + (progn + (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'. -- cgit v1.2.3 From a4e76727be273185c7eee5758262d58c5aa4ccdd Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 20 Feb 2013 21:16:05 -0700 Subject: Put in more nil window protection. --- lisp/ldg-occur.el | 3 ++- lisp/ldg-reconcile.el | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index 417a3d2a..c3f04c5d 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -82,7 +82,8 @@ When REGEX is nil, unhide everything, and remove higlight" (append ledger-occur-overlay-list (ledger-occur-create-folded-overlays buffer-matches))) (setq ledger-occur-last-match regex) - (select-window (get-buffer-window buffer)))) + (if (get-buffer-window buffer) + (select-window (get-buffer-window buffer))))) (recenter))) (defun ledger-occur (regex) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 9ac89915..623d7230 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -320,10 +320,10 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (fit-window-to-buffer recon-window) (with-current-buffer buf (add-hook 'kill-buffer-hook 'ledger-reconcile-quit nil t) - (select-window (get-buffer-window buf)) + (if (get-window-for-other-buffer buf) + (select-window (get-buffer-window buf))) (goto-char (point-max)) (recenter -1)) - (select-window recon-window) (ledger-reconcile-visit t)) (add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t)))) -- cgit v1.2.3 From 2fd1574cf2e969c7da7bf346837d859ac6ae90c9 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 21 Feb 2013 06:43:00 -0700 Subject: Prevent point from being at the end of line when ledger-reconcile-toggle is called --- lisp/ldg-reconcile.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 623d7230..e040359d 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -112,6 +112,7 @@ numbers" (defun ledger-reconcile-toggle () "Toggle the current transaction, and mark the recon window." (interactive) + (beginning-of-line) (let ((where (get-text-property (point) 'where)) (inhibit-read-only t) status) -- cgit v1.2.3 From 023e245e9b942968a5c61e494c28de2823b2a222 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 21 Feb 2013 14:35:29 -0700 Subject: Another attempt to deal with decimal-comma --- lisp/ldg-commodities.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index 1b6b332a..c832f375 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -44,13 +44,14 @@ This only has effect interfacing to calc mode in edit amount" (with-temp-buffer (insert str) (goto-char (point-min)) - (re-search-forward "-?[1-9][0-9]*[.,][0-9]*") + (re-search-forward "-?[1-9][0-9]*[.,][0-9]*" nil t) (setq val (string-to-number (ledger-commodity-string-number-decimalize (delete-and-extract-region (match-beginning 0) (match-end 0)) :from-user))) - (delete-trailing-whitespace) - (setq comm (buffer-substring (point-min) (point-max))) + (re-search-forward "[^[:space:]]" nil t) + (setq comm + (delete-and-extract-region (match-beginning 0) (match-end 0))) (list val comm)))) -- cgit v1.2.3 From d638f8300f01600554017c5c5cad674873af9bc8 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 21 Feb 2013 14:59:32 -0700 Subject: bug-905, inadvertently used an aquamacs function. --- lisp/ldg-reconcile.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index e040359d..58f179f4 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -321,7 +321,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (fit-window-to-buffer recon-window) (with-current-buffer buf (add-hook 'kill-buffer-hook 'ledger-reconcile-quit nil t) - (if (get-window-for-other-buffer buf) + (if (get-buffer-window buf) (select-window (get-buffer-window buf))) (goto-char (point-max)) (recenter -1)) -- cgit v1.2.3 From 510a7c4e6c58d296d93941b193729b1d91dbb927 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 21 Feb 2013 15:31:58 -0700 Subject: Position point at beginning of line on posting being reconciled. --- lisp/ldg-reconcile.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 58f179f4..6a9d05fd 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -198,6 +198,7 @@ numbers" (forward-char) (recenter) (ledger-highlight-xact-under-point) + (forward-char -1) (if come-back (switch-to-buffer-other-window cur-buf)))))) -- cgit v1.2.3 From c68bdde19fe13d85b606c6f8e5f24608c0d4810c Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 21 Feb 2013 21:39:30 -0700 Subject: Another buglet in the commodity handler. --- lisp/ldg-commodities.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index c832f375..14cc168f 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -49,6 +49,7 @@ This only has effect interfacing to calc mode in edit amount" (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))) -- cgit v1.2.3 From fd2c6d87a2353b5cc116bcb886a6c18abb308438 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 21 Feb 2013 22:21:13 -0700 Subject: Added ledger-mode-dump-variables to give me some instrumentation on users installs --- lisp/ldg-new.el | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 51 insertions(+) (limited to 'lisp') diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index 1e70c432..64945dfa 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -89,6 +89,57 @@ (delete-char 3) (forward-line 1)))))) +(defun ledger-dump-variable (var) + + (insert (format "%s: %S\n" (symbol-name var) (eval var)))) + +(defun ledger-mode-dump-variables () + (interactive) + (find-file "ledger-mode-dump") + (delete-region (point-min) (point-max)) + (insert "Ledger Mode Configuration Dump\n") + (insert "Date: " (current-time-string) "\n") + (insert "Emacs: " (version) "\n") + (insert "System Configuration: "system-configuration "\n") + (insert "ldg-commodities:\n") + (ledger-dump-variable 'ledger-use-decimal-comma) + (ledger-dump-variable 'ledger-reconcile-default-commodity) + (insert "ldg-exec:\n") + (ledger-dump-variable 'ledger-works) + (ledger-dump-variable 'ledger-binary-path) + (insert "ldg-occur:\n") + (ledger-dump-variable 'ledger-occur-use-face-unfolded) + (ledger-dump-variable 'ledger-occur-mode) + (ledger-dump-variable 'ledger-occur-history) + (ledger-dump-variable 'ledger-occur-last-match) + (insert "ldg-post:\n") + (ledger-dump-variable 'ledger-post-auto-adjust-amounts) + (ledger-dump-variable 'ledger-post-amount-alignment-column) + (ledger-dump-variable 'ledger-post-use-iswitchb) + (ledger-dump-variable 'ledger-post-use-ido) + (insert "ldg-reconcile:\n") + (ledger-dump-variable 'ledger-recon-buffer-name) + (ledger-dump-variable 'ledger-fold-on-reconcile) + (ledger-dump-variable 'ledger-buffer-tracks-reconcile-buffer) + (ledger-dump-variable 'ledger-reconcile-force-window-bottom) + (ledger-dump-variable 'ledger-reconcile-toggle-to-pending) + (insert "ldg-register:\n") + (ledger-dump-variable 'ledger-register-date-format) + (ledger-dump-variable 'ledger-register-line-format) + (insert "ldg-reports:\n") + (ledger-dump-variable 'ledger-reports) +(ledger-dump-variable 'ledger-report-format-specifiers) +(ledger-dump-variable 'ledger-report-buffer-name) +(insert "ldg-state:") +(ledger-dump-variable 'ledger-clear-whole-transactions) +(insert "ldg-xact:\n") +(ledger-dump-variable 'ledger-highlight-xact-under-point) + + +) + + (provide 'ledger) ;;; ldg-new.el ends here + -- cgit v1.2.3 From aa10b6ea5d986a521478a595949afc3838855c63 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 22 Feb 2013 21:00:41 -0700 Subject: Cleanup dump variables --- lisp/ldg-new.el | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index 64945dfa..d3a4bd02 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -90,7 +90,6 @@ (forward-line 1)))))) (defun ledger-dump-variable (var) - (insert (format "%s: %S\n" (symbol-name var) (eval var)))) (defun ledger-mode-dump-variables () @@ -128,15 +127,12 @@ (ledger-dump-variable 'ledger-register-line-format) (insert "ldg-reports:\n") (ledger-dump-variable 'ledger-reports) -(ledger-dump-variable 'ledger-report-format-specifiers) -(ledger-dump-variable 'ledger-report-buffer-name) -(insert "ldg-state:") -(ledger-dump-variable 'ledger-clear-whole-transactions) -(insert "ldg-xact:\n") -(ledger-dump-variable 'ledger-highlight-xact-under-point) - - -) + (ledger-dump-variable 'ledger-report-format-specifiers) + (ledger-dump-variable 'ledger-report-buffer-name) + (insert "ldg-state:") + (ledger-dump-variable 'ledger-clear-whole-transactions) + (insert "ldg-xact:\n") + (ledger-dump-variable 'ledger-highlight-xact-under-point)) (provide 'ledger) -- cgit v1.2.3 From 929175216dc55544c8c5911902014c7727a95fd7 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 22 Feb 2013 21:07:11 -0700 Subject: Initial commit of ldg-auto. --- lisp/ldg-auto.el | 187 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 187 insertions(+) create mode 100644 lisp/ldg-auto.el (limited to 'lisp') diff --git a/lisp/ldg-auto.el b/lisp/ldg-auto.el new file mode 100644 index 00000000..a582b914 --- /dev/null +++ b/lisp/ldg-auto.el @@ -0,0 +1,187 @@ +;;; ldg-auto.el --- Helper code for use with the "ledger" command-line tool + +;; Copyright (C) 2013 Craig Earls (enderw88 at gmail dot com) + +;; 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: +;; +;; This module provides or automatically adding transactions to a +;; ledger buffer on a periodic basis. h Recurrence expressions are +;; inspired by Martin Fowler's "Recurring Events for Calendars", +;; martinfowler.com/apsupp/recurring.pdf + +;; use (fset 'VARNAME (macro args)) to put the macro definition in the +;; function slot of the symbol VARNAME. Then use VARNAME as the +;; function without have to use funcall. + +(defsubst between (val low high) + (and (>= val low) (<= val high))) + +(defun ledger-auto-days-in-month (month year) + "Return number of days in the MONTH, MONTH is form 1 to 12" + (if (between month 1 12) + (if (and (date-leap-year-p year) (= 2 month)) + 29 + (nth (1- month) '(31 28 31 30 31 30 31 31 30 31 30 31))) + (error "Month out of range, MONTH=%S" month))) + +;; Macros to handle date expressions + +(defmacro ledger-auto-day-in-month-macro (count day-of-week) + "Return a form that evaluates DATE that returns true for the COUNT DAY-OF-WEEK. +For example, return true if date is the 3rd Thursday of the +month. Negative COUNT starts from the end of the month. (EQ +COUNT 0) means EVERY day-of-week (eg. every Saturday)" + (if (and (between count -6 6) (between day-of-week 0 6)) + (cond ((zerop count) ;; Return true if day-of-week matches + `(eq (nth 6 (decode-time date)) ,day-of-week)) + ((> count 0) ;; Positive count + (let ((decoded (gensym))) + `(let ((,decoded (decode-time date))) + (if (and (eq (nth 6 ,decoded) ,day-of-week) + (between (nth 3 ,decoded) + ,(* (1- count) 7) + ,(* count 7))) + t + nil)))) + ((< count 0) + (let ((days-in-month (gensym)) + (decoded (gensym))) + `(let* ((,decoded (decode-time date)) + (,days-in-month (ledger-auto-days-in-month + (nth 4 ,decoded) + (nth 5 ,decoded)))) + (if (and (eq (nth 6 ,decoded) ,day-of-week) + (between (nth 3 ,decoded) + (+ ,days-in-month ,(* count 7)) + (+ ,days-in-month ,(* (1+ count) 7)))) + t + nil)))) + (t + (error "COUNT out of range, COUNT=%S" count))) + (error "Invalid argument to ledger-auto-day-in-month-macro %S %S" + count + day-of-week))) + +(defmacro ledger-auto-day-of-month-macro (day) + "Return a form of date that returns true for the DAY of the month. +For example, return true if date is the 23rd of the month." + `(if (eq (nth 3 (decode-time date)) ,day) + t)) + +(defmacro ledger-auto-month-of-year-macro (month) + "Return a form of date that returns true for the MONTH of the year. +For example, return true if date is the 4th month of the year." + `(if (eq (nth 4 (decode-time date)) ,month) + t)) + +(defmacro ledger-auto-every-count-day-macro (day-of-week skip start-date) + "Return a form that is true for every DAY skipping SKIP, starting on START. +For example every second Friday, regardless of month." + (let ((start-day (nth 6 (decode-time (eval start-date))))) + (if (eq start-day day-of-week) ;; good, can proceed + `(if (zerop (mod (- (time-to-days date) ,(time-to-days (eval start-date))) ,(* skip 7))) + t + nil) + (error "START-DATE day of week doesn't match DAY-OF-WEEK")))) + +(defmacro ledger-auto-date-range-macro (month1 day1 month2 day2) + "Return a form of DATE that is true if DATE falls between MONTH1 DAY1 and MONTH2 DAY2." + (let ((decoded (gensym)) + (target-month (gensym)) + (target-day (gensym))) + `(let* ((,decoded (decode-time date)) + (,target-month (nth 4 decoded)) + (,target-day (nth 3 decoded))) + (and (and (> ,target-month ,month1) + (< ,target-month ,month2)) + (and (> ,target-day ,day1) + (< ,target-day ,day2)))))) + +(defun ledger-auto-is-holiday (date) + "Return true if DATE is a holiday.") + +(defun ledger-auto-scan-transactions (auto-file) + (let ((xact-list (list))) + (save-excursion + (find-file auto-file) + (goto-char (point-min)) + (while (re-search-forward "^\\[\\(.*\\)\\] " nil t) + (let ((date-descriptor "") + (transaction nil) + (xact-start (match-end 0))) + (setq date-descriptors + (ledger-auto-read-descriptor-tree + (buffer-substring-no-properties + (match-beginning 0) + (match-end 0)))) + (forward-paragraph) + (setq transaction (list date-descriptors + (buffer-substring-no-properties + xact-start + (point)))) + (setq xact-list (cons transaction xact-list)))) + xact-list))) + +(defun ledger-auto-read-descriptor-tree (descriptor-string) + "Take a date descriptor string and return a function that +returns true if the date meets the requirements" + (with-temp-buffer + (let (pos) + (insert descriptor-string) + (goto-char (point-min)) + (replace-string "[" "(") + (goto-char (point-min)) + (replace-string "]" ")") + (goto-char (point-max)) + (while (re-search-backward + (concat "\\([0-9]+\\|[\*]\\)/" ;; Year slot + "\\([\*EO]\\|[0-9]+\\)/" ;; Month slot + "\\([\*]\\|\\([0-9][0-9]\\)\\|" + "\\([0-5]" + "\\(\\(Su\\)\\|" + "\\(Mo\\)\\|" + "\\(Tu\\)\\|" + "\\(We\\)\\|" + "\\(Th\\)\\|" + "\\(Fr\\)\\|" + "\\(Sa\\)\\)\\)\\)") nil t) ;; Day slot + (goto-char + (match-end 0)) + (insert ?\") + (goto-char (match-beginning 0)) + (insert "\"" ))) + (ledger-auto-traverse-descriptor-tree + (read (buffer-substring (point-min) (point-max))) 0))) + +(defun ledger-auto-traverse-descriptor-tree (tree depth) + (dolist (node tree) + (cond ((eq (type-of node) 'string) + (ledger-auto-parse-date-descriptor node)) + ((eq (type-of node) 'cons) + (ledger-auto-traverse-descriptor-tree node (1+ depth)))))) + + +(defun ledger-auto-parse-date-descriptor (descriptor) + "Parse the date descriptor, return the evaluator" + descriptor) + +(provide 'ldg-auto) + +;;; ldg-auto.el ends here -- cgit v1.2.3 From 47ae01357b8702df78a4dc15280d78302135b13e Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 23 Feb 2013 09:15:16 -0700 Subject: Initial commit of environment handling Reads and parses .ledgerc to an alist --- lisp/ldg-init.el | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) create mode 100644 lisp/ldg-init.el (limited to 'lisp') diff --git a/lisp/ldg-init.el b/lisp/ldg-init.el new file mode 100644 index 00000000..646d91b2 --- /dev/null +++ b/lisp/ldg-init.el @@ -0,0 +1,62 @@ +;;; ldg-init.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: +;; Determine the ledger environment + +(defvar init-file-name "~/.ledgerrc") +(defvar ledger-environment-alist nil) + +(defun ledger-init-parse-initialization (file) + (with-current-buffer file + (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 + (matche (match-end 0))) + (end-of-line) + (setq ledger-environment-alist + (append ledger-environment-alist + (list (cons (let ((flag (buffer-substring (+ 2 matchb) matche))) + (if (string-match "[ \t\n\r]+\\'" flag) + (replace-match "" t t flag) + flag)) + (let ((value (buffer-substring matche (point) ))) + (if (> (length value) 0) + value + t)))))))) + ledger-environment-alist)) + +(defun ledger-init-load-init-file () + (interactive) + (save-excursion + (if (and (file-exists-p init-file-name) + (file-readable-p init-file-name)) + (progn + (find-file init-file-name) + (ledger-init-parse-initialization (file-name-nondirectory init-file-name)) + (kill-buffer (file-name-nondirectory init-file-name)))))) + + + +(provide 'ldg-init) + +;;; ldg-init.el ends here -- cgit v1.2.3 From 4cb2779464073aa8f1ba9d25121e3496fa71168f Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 23 Feb 2013 17:53:55 -0700 Subject: ledger-mode now automatically loads and parses the init file. Currently only pays attention to decimal-comma --- lisp/ldg-commodities.el | 3 +-- lisp/ldg-init.el | 29 ++++++++++++++++++----------- lisp/ldg-mode.el | 2 ++ lisp/ldg-new.el | 11 ++++++----- 4 files changed, 27 insertions(+), 18 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index 14cc168f..7f15ab81 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -36,7 +36,6 @@ This only has effect interfacing to calc mode in edit amount" :type 'boolean :group 'ledger) - (defun ledger-split-commodity-string (str) "Split a commoditized amount into two parts" (let (val @@ -85,7 +84,7 @@ 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 + (if (assoc "decimal-comma" ledger-environment-alist) (cond ((eq direction :from-user) ;; change string to decimal-period (while (string-match "," val) diff --git a/lisp/ldg-init.el b/lisp/ldg-init.el index 646d91b2..ef69de3d 100644 --- a/lisp/ldg-init.el +++ b/lisp/ldg-init.el @@ -22,14 +22,17 @@ ;;; Commentary: ;; Determine the ledger environment -(defvar init-file-name "~/.ledgerrc") +(defcustom init-file-name "~/.ledgerrc" + "Location of the ledger initialization file. nil if you don't have one" + :group 'ledger) + (defvar ledger-environment-alist nil) (defun ledger-init-parse-initialization (file) - (with-current-buffer file - (setq ledger-environment-alist nil) - (goto-char (point-min)) - (while (re-search-forward "^--.+?\\($\\|[ ]\\)" nil t ) + (with-current-buffer file + (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 (matche (match-end 0))) (end-of-line) @@ -43,17 +46,21 @@ (if (> (length value) 0) value t)))))))) - ledger-environment-alist)) + ledger-environment-alist)) (defun ledger-init-load-init-file () (interactive) (save-excursion - (if (and (file-exists-p init-file-name) + (if (get-buffer (file-name-nondirectory init-file-name)) + (ledger-init-parse-initialization (file-name-nondirectory init-file-name)) + (if (and + init-file-name + (file-exists-p init-file-name) (file-readable-p init-file-name)) - (progn - (find-file init-file-name) - (ledger-init-parse-initialization (file-name-nondirectory init-file-name)) - (kill-buffer (file-name-nondirectory init-file-name)))))) + (let + (find-file-noselect init-file-name) + (ledger-init-parse-initialization (file-name-nondirectory init-file-name)) + (kill-buffer (file-name-nondirectory init-file-name))))))) diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 01a1b615..96ce576b 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -76,6 +76,8 @@ (add-hook 'before-revert-hook 'ledger-remove-overlays nil t) (make-variable-buffer-local 'highlight-overlay) + (ledger-init-load-init-file) + (let ((map (current-local-map))) (define-key map [(control ?c) (control ?a)] 'ledger-add-transaction) (define-key map [(control ?c) (control ?b)] 'ledger-post-edit-amount) diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index d3a4bd02..7a2961f7 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -32,22 +32,23 @@ ;;; Commentary: ;; Load up the ledger mode +(require 'esh-arg) +(require 'ldg-commodities) (require 'ldg-complete) (require 'ldg-exec) +(require 'ldg-fonts) +(require 'ldg-init) (require 'ldg-mode) +(require 'ldg-occur) (require 'ldg-post) (require 'ldg-reconcile) (require 'ldg-register) (require 'ldg-report) +(require 'ldg-sort) (require 'ldg-state) (require 'ldg-test) (require 'ldg-texi) (require 'ldg-xact) -(require 'ldg-sort) -(require 'ldg-fonts) -(require 'ldg-occur) -(require 'ldg-commodities) -(require 'esh-arg) ;;; Code: -- cgit v1.2.3 From 260d05c8aeb43e73397fee83312c31e800206263 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 25 Feb 2013 13:19:51 -0700 Subject: Ledger-mode now automatically configures itself for --decimal-comma if that option is set in ~/.ledgerrc --- lisp/ldg-init.el | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-init.el b/lisp/ldg-init.el index ef69de3d..fbb4b838 100644 --- a/lisp/ldg-init.el +++ b/lisp/ldg-init.el @@ -22,7 +22,7 @@ ;;; Commentary: ;; Determine the ledger environment -(defcustom init-file-name "~/.ledgerrc" +(defcustom ledger-init-file-name "~/.ledgerrc" "Location of the ledger initialization file. nil if you don't have one" :group 'ledger) @@ -50,17 +50,17 @@ (defun ledger-init-load-init-file () (interactive) - (save-excursion - (if (get-buffer (file-name-nondirectory init-file-name)) - (ledger-init-parse-initialization (file-name-nondirectory init-file-name)) - (if (and - init-file-name - (file-exists-p init-file-name) - (file-readable-p init-file-name)) - (let - (find-file-noselect init-file-name) - (ledger-init-parse-initialization (file-name-nondirectory init-file-name)) - (kill-buffer (file-name-nondirectory init-file-name))))))) + (let ((init-base-name (file-name-nondirectory ledger-init-file-name))) + (if (get-buffer init-base-name) ;; init file already loaded, parse it and leave it + (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)))))) -- cgit v1.2.3 From 821847b0185f3d69bfbe3af3867556335111b9a2 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 26 Feb 2013 10:42:30 -0700 Subject: Ensure that commodities using decimal period, have comma separators removed for string-to-number. --- lisp/ldg-commodities.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index 7f15ab81..612350b3 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -94,7 +94,9 @@ which must be translated both directions." (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)))) + (error "ledger-commodity-string-number-decimalize: direction not properly specified %S" direction))) + (while (string-match "," val) + (setq val (replace-match "" nil nil val)))) val)) -- 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') 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 1e3c795935dc5c938b78fc367ee19e1a259b0fb3 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 27 Feb 2013 10:07:03 -0700 Subject: Update date regex to handles dashes and slashes --- lisp/ldg-commodities.el | 1 + lisp/ldg-regex.el | 2 ++ lisp/ldg-xact.el | 4 ++-- 3 files changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index 612350b3..6f835221 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -36,6 +36,7 @@ This only has effect interfacing to calc mode in edit amount" :type 'boolean :group 'ledger) + (defun ledger-split-commodity-string (str) "Split a commoditized amount into two parts" (let (val diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el index 680063f7..e81394ef 100644 --- a/lisp/ldg-regex.el +++ b/lisp/ldg-regex.el @@ -24,6 +24,8 @@ (eval-when-compile (require 'cl)) +(defvar ledger-date-regex "\\([0-9]+\\)[/-]\\([0-9]+\\)[/-]\\([0-9]+\\)") + (defmacro ledger-define-regexp (name regex docs &rest args) "Simplify the creation of a Ledger regex and helper functions." (let ((defs diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index f5a38ef6..8db50df2 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -106,7 +106,7 @@ within the transaction." (extents (ledger-find-xact-extents (point))) (transaction (buffer-substring (car extents) (cadr extents))) encoded-date) - (if (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" date) + (if (string-match ledger-date-regex date) (setq encoded-date (encode-time 0 0 0 (string-to-number (match-string 3 date)) (string-to-number (match-string 2 date)) @@ -114,7 +114,7 @@ within the transaction." (ledger-find-slot encoded-date) (insert transaction "\n") (backward-paragraph) - (re-search-forward "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)") + (re-search-forward ledger-date-regex) (replace-match date) (re-search-forward "[1-9][0-9]+\.[0-9]+"))) -- 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') 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 b5548661dcb69ed6c1e1723e52284978835fa1a1 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 27 Feb 2013 17:51:03 -0700 Subject: Fixed data regexs so that dashes are properly handled in dates --- lisp/ldg-state.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-state.el b/lisp/ldg-state.el index beecb591..b2247afe 100644 --- a/lisp/ldg-state.el +++ b/lisp/ldg-state.el @@ -44,7 +44,7 @@ (save-excursion (when (or (looking-at "^[0-9]") (re-search-backward "^[0-9]" nil t)) - (skip-chars-forward "0-9./=") + (skip-chars-forward "0-9./=\\-") (skip-syntax-forward " ") (cond ((looking-at "!\\s-*") 'pending) ((looking-at "\\*\\s-*") 'cleared) @@ -97,7 +97,7 @@ dropped." (save-excursion ;; this excursion checks state of entire ;; transaction and unclears if marked (goto-char (car bounds)) ;; beginning of xact - (skip-chars-forward "0-9./= \t") ;; skip the date + (skip-chars-forward "0-9./=\\- \t") ;; skip the date (setq cur-status (and (member (char-after) '(?\* ?\!)) (ledger-state-from-char (char-after)))) ;;if cur-status if !, or * then delete the marker @@ -193,7 +193,7 @@ dropped." (insert (make-string width ? )))))) (forward-line)) (goto-char (car bounds)) - (skip-chars-forward "0-9./= \t") + (skip-chars-forward "0-9./=\\- \t") (insert (ledger-char-from-state state) " ") (setq new-status state) (if (re-search-forward "\\(\t\\| [ \t]\\)" @@ -233,7 +233,7 @@ dropped." (save-excursion (when (or (looking-at "^[0-9]") (re-search-backward "^[0-9]" nil t)) - (skip-chars-forward "0-9./=") + (skip-chars-forward "0-9./=\\-") (delete-horizontal-space) (if (or (eq (ledger-state-from-char (char-after)) 'pending) (eq (ledger-state-from-char (char-after)) 'cleared)) -- 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') 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 3a0182d8d7a20ac33f78ab7e614881c6fe87a129 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 1 Mar 2013 09:37:33 -0700 Subject: Ensure reconcile balance display can handle empty accounts. Also force balance display at the beginning of reconciliation. --- lisp/ldg-commodities.el | 27 +++++++++++++++++---------- lisp/ldg-reconcile.el | 29 ++++++++++++++++------------- 2 files changed, 33 insertions(+), 23 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index c5500785..a3cc8951 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -38,16 +38,23 @@ (with-temp-buffer (insert str) (goto-char (point-min)) - (re-search-forward "-?[1-9][0-9]*[.,][0-9]*" nil t) - (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)))) + (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)))))) (defun ledger-string-balance-to-commoditized-amount (str) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 6093f9df..f64f1bca 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -63,10 +63,8 @@ reconcile-finish will mark all pending posting cleared." :group 'ledger-reconcile) -(defun ledger-reconcile-get-balances () - "Calculate the cleared and uncleared balance of the account. -Return a list with the account, uncleared and cleared balances as -numbers" +(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) @@ -77,15 +75,17 @@ numbers" ; 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" - "--format" "(\"%(display_total)\")" account) - (setq val (read (buffer-substring-no-properties (point-min) (point-max))))))) + "balance" "--limit" "cleared or pending" "--empty" + "--format" "%(display_total)" account) + (setq val + (ledger-split-commodity-string + (buffer-substring-no-properties (point-min) (point-max))))))) (defun ledger-display-balance () - "Calculate the cleared balance of the account being reconciled." + "Display the cleared-or-pending balnce and calculate the +target-delta of the account being reconciled." (interactive) - (let* ((pending (car (ledger-string-balance-to-commoditized-amount - (car (ledger-reconcile-get-balances))))) + (let* ((pending (ledger-reconcile-get-cleared-or-pending-balance)) (target-delta (if ledger-target (-commodity ledger-target pending) nil))) @@ -156,7 +156,8 @@ numbers" (ledger-do-reconcile) (set-buffer-modified-p t) (goto-char (point-min)) - (forward-line line))) + (forward-line line) + (ledger-display-balance))) (defun ledger-reconcile-refresh-after-save () "Refresh the recon-window after the ledger buffer is saved." @@ -375,7 +376,8 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (ledger-reconcile-refresh) (goto-char (point-min)) (setq ledger-target - (ledger-read-commodity-string "Set reconciliation target"))) + (ledger-read-commodity-string "Set reconciliation target")) + (ledger-display-balance)) (progn ;; no recon-buffer, starting from scratch. (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t) @@ -389,7 +391,8 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (set (make-local-variable 'ledger-acct) account) (ledger-do-reconcile) (set (make-local-variable 'ledger-target) - (ledger-read-commodity-string "Set reconciliation target"))))))) + (ledger-read-commodity-string "Set reconciliation target")) + (ledger-display-balance)))))) (defvar ledger-reconcile-mode-abbrev-table) -- cgit v1.2.3 From 90d67876fc09ceea33798324ac410a8077e62f18 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 1 Mar 2013 23:28:35 -0700 Subject: Have a working tree parser and numerical date constraint --- lisp/ldg-auto.el | 123 ++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 90 insertions(+), 33 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-auto.el b/lisp/ldg-auto.el index a582b914..12832a4e 100644 --- a/lisp/ldg-auto.el +++ b/lisp/ldg-auto.el @@ -34,16 +34,17 @@ (and (>= val low) (<= val high))) (defun ledger-auto-days-in-month (month year) - "Return number of days in the MONTH, MONTH is form 1 to 12" + "Return number of days in the MONTH, MONTH is from 1 to 12. +If year is nil, assume it is not a leap year" (if (between month 1 12) - (if (and (date-leap-year-p year) (= 2 month)) + (if (and year (date-leap-year-p year) (= 2 month)) 29 (nth (1- month) '(31 28 31 30 31 30 31 31 30 31 30 31))) (error "Month out of range, MONTH=%S" month))) ;; Macros to handle date expressions -(defmacro ledger-auto-day-in-month-macro (count day-of-week) +(defmacro ledger-auto-constrain-day-in-month-macro (count day-of-week) "Return a form that evaluates DATE that returns true for the COUNT DAY-OF-WEEK. For example, return true if date is the 3rd Thursday of the month. Negative COUNT starts from the end of the month. (EQ @@ -78,20 +79,33 @@ COUNT 0) means EVERY day-of-week (eg. every Saturday)" (error "Invalid argument to ledger-auto-day-in-month-macro %S %S" count day-of-week))) - -(defmacro ledger-auto-day-of-month-macro (day) - "Return a form of date that returns true for the DAY of the month. -For example, return true if date is the 23rd of the month." - `(if (eq (nth 3 (decode-time date)) ,day) - t)) - -(defmacro ledger-auto-month-of-year-macro (month) - "Return a form of date that returns true for the MONTH of the year. -For example, return true if date is the 4th month of the year." - `(if (eq (nth 4 (decode-time date)) ,month) - t)) - -(defmacro ledger-auto-every-count-day-macro (day-of-week skip start-date) + +(defmacro ledger-auto-constrain-numerical-date-macro (year month day) + "Return a function of date that is only true if all constraints are met. +A nil constraint matches any input, a numerical entry must match that field +of date." + ;; Do bounds checking to make sure the incoming date constraint is sane + (if + (if (eval month) ;; if we have a month + (and (between (eval month) 1 12) ;; make sure it is between 1 + ;; and twelve and the number + ;; of days are ok + (between (eval day) 1 (ledger-auto-days-in-month (eval month) (eval year)))) + (between (eval day) 1 31)) ;; no month specified, assume 31 days. + `#'(lambda (date) + (and ,(if (eval year) + `(if (eq (nth 5 (decode-time date)) ,(eval year)) t) + `t) + ,(if (eval month) + `(if (eq (nth 4 (decode-time date)) ,(eval month)) t) + `t) + ,(if (eval day) + `(if (eq (nth 3 (decode-time date)) ,(eval day)) t)))) + (error "ledger-auto-constraint-numerical-date-macro: date out of range %S %S %S" (eval year) (eval month) (eval day)))) + + + +(defmacro ledger-auto-constrain-every-count-day-macro (day-of-week skip start-date) "Return a form that is true for every DAY skipping SKIP, starting on START. For example every second Friday, regardless of month." (let ((start-day (nth 6 (decode-time (eval start-date))))) @@ -101,7 +115,7 @@ For example every second Friday, regardless of month." nil) (error "START-DATE day of week doesn't match DAY-OF-WEEK")))) -(defmacro ledger-auto-date-range-macro (month1 day1 month2 day2) +(defmacro ledger-auto-constrain-date-range-macro (month1 day1 month2 day2) "Return a form of DATE that is true if DATE falls between MONTH1 DAY1 and MONTH2 DAY2." (let ((decoded (gensym)) (target-month (gensym)) @@ -114,13 +128,15 @@ For example every second Friday, regardless of month." (and (> ,target-day ,day1) (< ,target-day ,day2)))))) + (defun ledger-auto-is-holiday (date) "Return true if DATE is a holiday.") (defun ledger-auto-scan-transactions (auto-file) + (interactive "fFile name: ") (let ((xact-list (list))) - (save-excursion - (find-file auto-file) + (with-current-buffer + (find-file-noselect auto-file) (goto-char (point-min)) (while (re-search-forward "^\\[\\(.*\\)\\] " nil t) (let ((date-descriptor "") @@ -143,16 +159,19 @@ For example every second Friday, regardless of month." "Take a date descriptor string and return a function that returns true if the date meets the requirements" (with-temp-buffer + ;; copy the descriptor string into a temp buffer for manipulation (let (pos) + ;; Replace brackets with parens (insert descriptor-string) (goto-char (point-min)) (replace-string "[" "(") (goto-char (point-min)) (replace-string "]" ")") (goto-char (point-max)) + ;; double quote all the descriptors for string processing later (while (re-search-backward - (concat "\\([0-9]+\\|[\*]\\)/" ;; Year slot - "\\([\*EO]\\|[0-9]+\\)/" ;; Month slot + (concat "\\(20[0-9][0-9]\\|[\*]\\)[/\\-]" ;; Year slot + "\\([\*EO]\\|[0-9]+\\)[/\\-]" ;; Month slot "\\([\*]\\|\\([0-9][0-9]\\)\\|" "\\([0-5]" "\\(\\(Su\\)\\|" @@ -167,20 +186,58 @@ returns true if the date meets the requirements" (insert ?\") (goto-char (match-beginning 0)) (insert "\"" ))) - (ledger-auto-traverse-descriptor-tree - (read (buffer-substring (point-min) (point-max))) 0))) - -(defun ledger-auto-traverse-descriptor-tree (tree depth) - (dolist (node tree) - (cond ((eq (type-of node) 'string) - (ledger-auto-parse-date-descriptor node)) - ((eq (type-of node) 'cons) - (ledger-auto-traverse-descriptor-tree node (1+ depth)))))) - + + ;; 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)))))) + +(defun ledger-transform-auto-tree (tree) + (if (consp tree) + (let (result) + (while (consp tree) + (let ((newcar (car tree))) + (if (consp (car tree)) + (setq newcar (ledger-transform-auto-tree (car tree)))) + (if (consp newcar) + (push newcar result) + (push (ledger-auto-parse-date-descriptor newcar) result)) ) + (setq tree (cdr tree))) + (nconc (nreverse result) tree)))) + +(defun ledger-auto-split-constraints (descriptor-string) + "Return a list with the year, month and day fields split" + (let ((fields (split-string descriptor-string "[/\\-]" t)) + constrain-year constrain-month constrain-day) + (if (string= (car fields) "*") + (setq constrain-year nil) + (setq constrain-year (car fields))) + (if (string= (cadr fields) "*") + (setq constrain-month nil) + (setq constrain-month (cadr fields))) + (if (string= (nth 2 fields) "*") + (setq constrain-day nil) + (setq constrain-day (nth 2 fields))) + (list constrain-year constrain-month constrain-day))) + +(defun ledger-string-to-number-or-nil (str) + (if str + (string-to-number str) + nil)) + +(defun ledger-auto-compile-constraints (constraint-list) + (let ((year-constraint (ledger-string-to-number-or-nil (nth 0 constraint-list))) + (month-constraint (ledger-string-to-number-or-nil (nth 1 constraint-list))) + (day-constraint (ledger-string-to-number-or-nil (nth 2 constraint-list)))) + (ledger-auto-constrain-numerical-date-macro + year-constraint + month-constraint + day-constraint))) (defun ledger-auto-parse-date-descriptor (descriptor) "Parse the date descriptor, return the evaluator" - descriptor) + (ledger-auto-compile-constraints + (ledger-auto-split-constraints descriptor))) (provide 'ldg-auto) -- cgit v1.2.3 From 497d668778e17e08ac91695ba1cb5da50612cd0a Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 1 Mar 2013 23:29:31 -0700 Subject: Clean up the reconcile balance display code --- lisp/ldg-reconcile.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index f64f1bca..33c9f06f 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -156,8 +156,7 @@ target-delta of the account being reconciled." (ledger-do-reconcile) (set-buffer-modified-p t) (goto-char (point-min)) - (forward-line line) - (ledger-display-balance))) + (forward-line line))) (defun ledger-reconcile-refresh-after-save () "Refresh the recon-window after the ledger buffer is saved." -- cgit v1.2.3 From 9a86fe022cb5ef95c675ebc59269a7c7e63d1077 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 2 Mar 2013 13:33:12 -0700 Subject: Add ability to posting the account in a posting using the iedger-default-acct-transaction-indent --- doc/ledger-mode.texi | 5 +++-- lisp/ldg-mode.el | 5 ----- lisp/ldg-post.el | 21 +++++++++++++++++---- 3 files changed, 20 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/doc/ledger-mode.texi b/doc/ledger-mode.texi index 336f5ba8..1d317725 100644 --- a/doc/ledger-mode.texi +++ b/doc/ledger-mode.texi @@ -596,8 +596,6 @@ for Ledger under the data options. Alternately you can choose @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 @@ -678,11 +676,14 @@ Default face for pending (!) transactions in the reconcile window @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-default-acct-transaction-indent +Default indentation for account transactions in an entry. @item ledger-post-use-completion-engine Which completion engine to use, iswitchb, ido, or built-in @item ledger-post-use-ido diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 37c0f69e..00df0e67 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -39,11 +39,6 @@ (defvar ledger-month (ledger-current-month) "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." - :type 'string - :group 'ledger) - (defun ledger-remove-overlays () "Remove all overlays from the ledger buffer." (interactive) diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index de28a8a9..2a736bfc 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -27,6 +27,11 @@ ;;; Code: +(defcustom ledger-default-acct-transaction-indent " " + "Default indentation for account transactions in an entry." + :type 'string + :group 'ledger-post) + (defgroup ledger-post nil "Options for controlling how Ledger-mode deals with postings and completion" :group 'ledger) @@ -119,17 +124,25 @@ PROMPT is a string to prompt with. CHOICES is a list of (match-end 3)) (point)))) (defun ledger-align-amounts (&optional column) - "Align amounts in the current region. + "Align amounts and accounts in the current region. This is done so that the last digit falls in COLUMN, which - defaults to 52." +defaults to 52. ledger-default-acct-transaction-indent positions +the account" (interactive "p") (if (or (null column) (= column 1)) (setq column ledger-post-amount-alignment-column)) (save-excursion + ;; Position the account + (beginning-of-line) + (set-mark (point)) + (delete-horizontal-space) + (insert ledger-default-acct-transaction-indent) + (goto-char (1+ (line-end-position))) (let* ((mark-first (< (mark) (point))) (begin (if mark-first (mark) (point))) (end (if mark-first (point-marker) (mark-marker))) offset) + ;; Position the amount (goto-char begin) (while (setq offset (ledger-next-amount end)) (let ((col (current-column)) @@ -159,10 +172,10 @@ This is done so that the last digit falls in COLUMN, which BEG, END, and LEN control how far it can align." (save-excursion (goto-char beg) - (when (< end (line-end-position)) + (when (<= end (line-end-position)) (goto-char (line-beginning-position)) (if (looking-at ledger-post-line-regexp) - (ledger-post-align-amount))))) + (ledger-align-amounts))))) (defun ledger-post-edit-amount () "Call 'calc-mode' and push the amount in the posting to the top of stack." -- cgit v1.2.3 From c85a91b030f27b8cc22fa71bf0215b846b2be246 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 2 Mar 2013 20:19:43 -0700 Subject: Ad ledger-mode flags to limit sort region for sort buffer --- doc/ledger-mode.texi | 15 +++++++++++++++ lisp/ldg-sort.el | 13 ++++++++++--- 2 files changed, 25 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/doc/ledger-mode.texi b/doc/ledger-mode.texi index 1d317725..f530d587 100644 --- a/doc/ledger-mode.texi +++ b/doc/ledger-mode.texi @@ -303,6 +303,21 @@ transactions like automated transaction, will be moved in the sorting process and may not function correctly afterwards. For this reason there is no key sequence. +You can limit the allowed sort region by using embedded Ledger-mode +markup within your ledger. For exmaple +@smallexample +<<< infomration to not sort >>> + +; Ledger-mode: Start sort + +<<< xacts to sort >>> + +;Ledger-mode: End sort + +<<< information to not sort >>> +@end smallexample + + @node Hiding Transactions, , Sorting Transactions, The Ledger Buffer @section Hiding Transactions diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el index 361eead8..cc036492 100644 --- a/lisp/ldg-sort.el +++ b/lisp/ldg-sort.el @@ -54,8 +54,8 @@ ;; the beginning of next record ;; after the region (setq new-end (point)) - (narrow-to-region beg end) - (goto-char (point-min)) + (narrow-to-region new-beg new-end) + (goto-char new-beg) (let ((inhibit-field-text-motion t)) (sort-subr @@ -66,7 +66,14 @@ (defun ledger-sort-buffer () "Sort the entire buffer." (interactive) - (ledger-sort-region (point-min) (point-max))) + (let ((sort-start (point-min)) + (sort-end (point-max))) + (goto-char (point-min)) + (if (re-search-forward ";.*Ledger-mode:.*Start sort" nil t) + (set 'sort-start (match-end 0))) + (if (re-search-forward ";.*Ledger-mode:.*End sort" nil t) + (set 'sort-end (match-end 0))) + (ledger-sort-region sort-start sort-end))) (provide 'ldg-sort) -- cgit v1.2.3 From 4810da9398809fc090c7f044d3545050a465d2bb Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 2 Mar 2013 20:20:58 -0700 Subject: Remove auto account alignment as it interfered with account completion. --- lisp/ldg-post.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 2a736bfc..7105ef7a 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -133,10 +133,10 @@ the account" (setq column ledger-post-amount-alignment-column)) (save-excursion ;; Position the account - (beginning-of-line) + ;; (beginning-of-line) (set-mark (point)) - (delete-horizontal-space) - (insert ledger-default-acct-transaction-indent) + ;; (delete-horizontal-space) + ;; (insert ledger-default-acct-transaction-indent) (goto-char (1+ (line-end-position))) (let* ((mark-first (< (mark) (point))) (begin (if mark-first (mark) (point))) -- 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') 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 5a48bc39356d98abe1b1afdcdc42f382755f6929 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 5 Mar 2013 21:30:05 -0500 Subject: Removed timeclock.el. This has been parts of the standard Emacs installation for a very long time. No need to repeat it here. --- lisp/timeclock.el | 1362 ----------------------------------------------------- 1 file changed, 1362 deletions(-) delete mode 100644 lisp/timeclock.el (limited to 'lisp') diff --git a/lisp/timeclock.el b/lisp/timeclock.el deleted file mode 100644 index 2cafa8eb..00000000 --- a/lisp/timeclock.el +++ /dev/null @@ -1,1362 +0,0 @@ -;;; timeclock.el --- mode for keeping track of how much you work - -;; Copyright (C) 1999, 2000, 2001, 2003, 2004 Free Software Foundation, Inc. - -;; Author: John Wiegley -;; Created: 25 Mar 1999 -;; Version: 2.6 -;; Keywords: calendar data - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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: - -;; This mode is for keeping track of time intervals. You can use it -;; for whatever purpose you like, but the typical scenario is to keep -;; track of how much time you spend working on certain projects. -;; -;; Use `timeclock-in' when you start on a project, and `timeclock-out' -;; when you're done. Once you've collected some data, you can use -;; `timeclock-workday-remaining' to see how much time is left to be -;; worked today (where `timeclock-workday' specifies the length of the -;; working day), and `timeclock-when-to-leave' to calculate when you're free. - -;; You'll probably want to bind the timeclock commands to some handy -;; keystrokes. At the moment, C-x t is unused: -;; -;; (require 'timeclock) -;; -;; (define-key ctl-x-map "ti" 'timeclock-in) -;; (define-key ctl-x-map "to" 'timeclock-out) -;; (define-key ctl-x-map "tc" 'timeclock-change) -;; (define-key ctl-x-map "tr" 'timeclock-reread-log) -;; (define-key ctl-x-map "tu" 'timeclock-update-modeline) -;; (define-key ctl-x-map "tw" 'timeclock-when-to-leave-string) - -;; If you want Emacs to display the amount of time "left" to your -;; workday in the modeline, you can either set the value of -;; `timeclock-modeline-display' to t using M-x customize, or you -;; can add this code to your .emacs file: -;; -;; (require 'timeclock) -;; (timeclock-modeline-display) -;; -;; To cancel this modeline display at any time, just call -;; `timeclock-modeline-display' again. - -;; You may also want Emacs to ask you before exiting, if you are -;; currently working on a project. This can be done either by setting -;; `timeclock-ask-before-exiting' to t using M-x customize (this is -;; the default), or by adding the following to your .emacs file: -;; -;; (add-hook 'kill-emacs-query-functions 'timeclock-query-out) - -;; NOTE: If you change your .timelog file without using timeclock's -;; functions, or if you change the value of any of timeclock's -;; customizable variables, you should run the command -;; `timeclock-reread-log'. This will recompute any discrepancies in -;; your average working time, and will make sure that the various -;; display functions return the correct value. - -;;; History: - -;;; Code: - -(defgroup timeclock nil - "Keeping track time of the time that gets spent." - :group 'data) - -;;; User Variables: - -(defcustom timeclock-file (convert-standard-filename "~/.timelog") - "*The file used to store timeclock data in." - :type 'file - :group 'timeclock) - -(defcustom timeclock-workday (* 8 60 60) - "*The length of a work period." - :type 'integer - :group 'timeclock) - -(defcustom timeclock-relative t - "*Whether to maken reported time relative to `timeclock-workday'. -For example, if the length of a normal workday is eight hours, and you -work four hours on Monday, then the amount of time \"remaining\" on -Tuesday is twelve hours -- relative to an averaged work period of -eight hours -- or eight hours, non-relative. So relative time takes -into account any discrepancy of time under-worked or over-worked on -previous days. This only affects the timeclock modeline display." - :type 'boolean - :group 'timeclock) - -(defcustom timeclock-get-project-function 'timeclock-ask-for-project - "*The function used to determine the name of the current project. -When clocking in, and no project is specified, this function will be -called to determine what is the current project to be worked on. -If this variable is nil, no questions will be asked." - :type 'function - :group 'timeclock) - -(defcustom timeclock-get-reason-function 'timeclock-ask-for-reason - "*A function used to determine the reason for clocking out. -When clocking out, and no reason is specified, this function will be -called to determine what is the reason. -If this variable is nil, no questions will be asked." - :type 'function - :group 'timeclock) - -(defcustom timeclock-get-workday-function nil - "*A function used to determine the length of today's workday. -The first time that a user clocks in each day, this function will be -called to determine what is the length of the current workday. If -the return value is nil, or equal to `timeclock-workday', nothing special -will be done. If it is a quantity different from `timeclock-workday', -however, a record will be output to the timelog file to note the fact that -that day has a length that is different from the norm." - :type '(choice (const nil) function) - :group 'timeclock) - -(defcustom timeclock-ask-before-exiting t - "*If non-nil, ask if the user wants to clock out before exiting Emacs. -This variable only has effect if set with \\[customize]." - :set (lambda (symbol value) - (if value - (add-hook 'kill-emacs-query-functions 'timeclock-query-out) - (remove-hook 'kill-emacs-query-functions 'timeclock-query-out)) - (setq timeclock-ask-before-exiting value)) - :type 'boolean - :group 'timeclock) - -(defvar timeclock-update-timer nil - "The timer used to update `timeclock-mode-string'.") - -;; For byte-compiler. -(defvar display-time-hook) -(defvar timeclock-modeline-display) - -(defcustom timeclock-use-display-time t - "*If non-nil, use `display-time-hook' for doing modeline updates. -The advantage of this is that one less timer has to be set running -amok in Emacs' process space. The disadvantage is that it requires -you to have `display-time' running. If you don't want to use -`display-time', but still want the modeline to show how much time is -left, set this variable to nil. Changing the value of this variable -while timeclock information is being displayed in the modeline has no -effect. You should call the function `timeclock-modeline-display' with -a positive argument to force an update." - :set (lambda (symbol value) - (let ((currently-displaying - (and (boundp 'timeclock-modeline-display) - timeclock-modeline-display))) - ;; if we're changing to the state that - ;; `timeclock-modeline-display' is already using, don't - ;; bother toggling it. This happens on the initial loading - ;; of timeclock.el. - (if (and currently-displaying - (or (and value - (boundp 'display-time-hook) - (memq 'timeclock-update-modeline - display-time-hook)) - (and (not value) - timeclock-update-timer))) - (setq currently-displaying nil)) - (and currently-displaying - (set-variable 'timeclock-modeline-display nil)) - (setq timeclock-use-display-time value) - (and currently-displaying - (set-variable 'timeclock-modeline-display t)) - timeclock-use-display-time)) - :type 'boolean - :group 'timeclock - :require 'time) - -(defcustom timeclock-first-in-hook nil - "*A hook run for the first \"in\" event each day. -Note that this hook is run before recording any events. Thus the -value of `timeclock-hours-today', `timeclock-last-event' and the -return value of function `timeclock-last-period' are relative previous -to today." - :type 'hook - :group 'timeclock) - -(defcustom timeclock-load-hook nil - "*Hook that gets run after timeclock has been loaded." - :type 'hook - :group 'timeclock) - -(defcustom timeclock-in-hook nil - "*A hook run every time an \"in\" event is recorded." - :type 'hook - :group 'timeclock) - -(defcustom timeclock-day-over-hook nil - "*A hook that is run when the workday has been completed. -This hook is only run if the current time remaining is being displayed -in the modeline. See the variable `timeclock-modeline-display'." - :type 'hook - :group 'timeclock) - -(defcustom timeclock-out-hook nil - "*A hook run every time an \"out\" event is recorded." - :type 'hook - :group 'timeclock) - -(defcustom timeclock-done-hook nil - "*A hook run every time a project is marked as completed." - :type 'hook - :group 'timeclock) - -(defcustom timeclock-event-hook nil - "*A hook run every time any event is recorded." - :type 'hook - :group 'timeclock) - -(defvar timeclock-last-event nil - "A list containing the last event that was recorded. -The format of this list is (CODE TIME PROJECT).") - -(defvar timeclock-last-event-workday nil - "The number of seconds in the workday of `timeclock-last-event'.") - -;;; Internal Variables: - -(defvar timeclock-discrepancy nil - "A variable containing the time discrepancy before the last event. -Normally, timeclock assumes that you intend to work for -`timeclock-workday' seconds every day. Any days in which you work -more or less than this amount is considered either a positive or -a negative discrepancy. If you work in such a manner that the -discrepancy is always brought back to zero, then you will by -definition have worked an average amount equal to `timeclock-workday' -each day.") - -(defvar timeclock-elapsed nil - "A variable containing the time elapsed for complete periods today. -This value is not accurate enough to be useful by itself. Rather, -call `timeclock-workday-elapsed', to determine how much time has been -worked so far today. Also, if `timeclock-relative' is nil, this value -will be the same as `timeclock-discrepancy'.") ; ? gm - -(defvar timeclock-last-period nil - "Integer representing the number of seconds in the last period. -Note that you shouldn't access this value, but instead should use the -function `timeclock-last-period'.") - -(defvar timeclock-mode-string nil - "The timeclock string (optionally) displayed in the modeline. -The time is bracketed by <> if you are clocked in, otherwise by [].") - -(defvar timeclock-day-over nil - "The date of the last day when notified \"day over\" for.") - -;;; User Functions: - -;;;###autoload -(defun timeclock-modeline-display (&optional arg) - "Toggle display of the amount of time left today in the modeline. -If `timeclock-use-display-time' is non-nil (the default), then -the function `display-time-mode' must be active, and the modeline -will be updated whenever the time display is updated. Otherwise, -the timeclock will use its own sixty second timer to do its -updating. With prefix ARG, turn modeline display on if and only -if ARG is positive. Returns the new status of timeclock modeline -display (non-nil means on)." - (interactive "P") - ;; cf display-time-mode. - (setq timeclock-mode-string "") - (or global-mode-string (setq global-mode-string '(""))) - (let ((on-p (if arg - (> (prefix-numeric-value arg) 0) - (not timeclock-modeline-display)))) - (if on-p - (progn - (or (memq 'timeclock-mode-string global-mode-string) - (setq global-mode-string - (append global-mode-string '(timeclock-mode-string)))) - (unless (memq 'timeclock-update-modeline timeclock-event-hook) - (add-hook 'timeclock-event-hook 'timeclock-update-modeline)) - (when timeclock-update-timer - (cancel-timer timeclock-update-timer) - (setq timeclock-update-timer nil)) - (if (boundp 'display-time-hook) - (remove-hook 'display-time-hook 'timeclock-update-modeline)) - (if timeclock-use-display-time - (progn - ;; Update immediately so there is a visible change - ;; on calling this function. - (if display-time-mode (timeclock-update-modeline) - (message "Activate `display-time-mode' to see \ -timeclock information")) - (add-hook 'display-time-hook 'timeclock-update-modeline)) - (setq timeclock-update-timer - (run-at-time nil 60 'timeclock-update-modeline)))) - (setq global-mode-string - (delq 'timeclock-mode-string global-mode-string)) - (remove-hook 'timeclock-event-hook 'timeclock-update-modeline) - (if (boundp 'display-time-hook) - (remove-hook 'display-time-hook - 'timeclock-update-modeline)) - (when timeclock-update-timer - (cancel-timer timeclock-update-timer) - (setq timeclock-update-timer nil))) - (force-mode-line-update) - (setq timeclock-modeline-display on-p))) - -;; This has to be here so that the function definition of -;; `timeclock-modeline-display' is known to the "set" function. -(defcustom timeclock-modeline-display nil - "Toggle modeline display of time remaining. -You must modify via \\[customize] for this variable to have an effect." - :set (lambda (symbol value) - (setq timeclock-modeline-display - (timeclock-modeline-display (or value 0)))) - :type 'boolean - :group 'timeclock - :require 'timeclock) - -(defsubst timeclock-time-to-date (time) - "Convert the TIME value to a textual date string." - (format-time-string "%Y/%m/%d" time)) - -;;;###autoload -(defun timeclock-in (&optional arg project find-project) - "Clock in, recording the current time moment in the timelog. -With a numeric prefix ARG, record the fact that today has only that -many hours in it to be worked. If arg is a non-numeric prefix arg -\(non-nil, but not a number), 0 is assumed (working on a holiday or -weekend). *If not called interactively, ARG should be the number of -_seconds_ worked today*. This feature only has effect the first time -this function is called within a day. - -PROJECT is the project being clocked into. If PROJECT is nil, and -FIND-PROJECT is non-nil -- or the user calls `timeclock-in' -interactively -- call the function `timeclock-get-project-function' to -discover the name of the project." - (interactive - (list (and current-prefix-arg - (if (numberp current-prefix-arg) - (* current-prefix-arg 60 60) - 0)))) - (if (equal (car timeclock-last-event) "i") - (error "You've already clocked in!") - (unless timeclock-last-event - (timeclock-reread-log)) - ;; Either no log file, or day has rolled over. - (unless (and timeclock-last-event - (equal (timeclock-time-to-date - (cadr timeclock-last-event)) - (timeclock-time-to-date (current-time)))) - (let ((workday (or (and (numberp arg) arg) - (and arg 0) - (and timeclock-get-workday-function - (funcall timeclock-get-workday-function)) - timeclock-workday))) - (run-hooks 'timeclock-first-in-hook) - ;; settle the discrepancy for the new day - (setq timeclock-discrepancy - (- (or timeclock-discrepancy 0) workday)) - (if (not (= workday timeclock-workday)) - (timeclock-log "h" (and (numberp arg) - (number-to-string arg)))))) - (timeclock-log "i" (or project - (and timeclock-get-project-function - (or find-project (interactive-p)) - (funcall timeclock-get-project-function)))) - (run-hooks 'timeclock-in-hook))) - -;;;###autoload -(defun timeclock-out (&optional arg reason find-reason) - "Clock out, recording the current time moment in the timelog. -If a prefix ARG is given, the user has completed the project that was -begun during the last time segment. - -REASON is the user's reason for clocking out. If REASON is nil, and -FIND-REASON is non-nil -- or the user calls `timeclock-out' -interactively -- call the function `timeclock-get-reason-function' to -discover the reason." - (interactive "P") - (or timeclock-last-event - (error "You haven't clocked in!")) - (if (equal (downcase (car timeclock-last-event)) "o") - (error "You've already clocked out!") - (timeclock-log - (if arg "O" "o") - (or reason - (and timeclock-get-reason-function - (or find-reason (interactive-p)) - (funcall timeclock-get-reason-function)))) - (run-hooks 'timeclock-out-hook) - (if arg - (run-hooks 'timeclock-done-hook)))) - -;; Should today-only be removed in favour of timeclock-relative? - gm -(defsubst timeclock-workday-remaining (&optional today-only) - "Return the number of seconds until the workday is complete. -The amount returned is relative to the value of `timeclock-workday'. -If TODAY-ONLY is non-nil, the value returned will be relative only to -the time worked today, and not to past time." - (let ((discrep (timeclock-find-discrep))) - (if discrep - (- (if today-only (cadr discrep) - (car discrep))) - 0.0))) - -;;;###autoload -(defun timeclock-status-string (&optional show-seconds today-only) - "Report the overall timeclock status at the present moment. -If SHOW-SECONDS is non-nil, display second resolution. -If TODAY-ONLY is non-nil, the display will be relative only to time -worked today, ignoring the time worked on previous days." - (interactive "P") - (let ((remainder (timeclock-workday-remaining)) ; today-only? - (last-in (equal (car timeclock-last-event) "i")) - status) - (setq status - (format "Currently %s since %s (%s), %s %s, leave at %s" - (if last-in "IN" "OUT") - (if show-seconds - (format-time-string "%-I:%M:%S %p" - (nth 1 timeclock-last-event)) - (format-time-string "%-I:%M %p" - (nth 1 timeclock-last-event))) - (or (nth 2 timeclock-last-event) - (if last-in "**UNKNOWN**" "workday over")) - (timeclock-seconds-to-string remainder show-seconds t) - (if (> remainder 0) - "remaining" "over") - (timeclock-when-to-leave-string show-seconds today-only))) - (if (interactive-p) - (message status) - status))) - -;;;###autoload -(defun timeclock-change (&optional arg project) - "Change to working on a different project. -This clocks out of the current project, then clocks in on a new one. -With a prefix ARG, consider the previous project as finished at the -time of changeover. PROJECT is the name of the last project you were -working on." - (interactive "P") - (timeclock-out arg) - (timeclock-in nil project (interactive-p))) - -;;;###autoload -(defun timeclock-query-out () - "Ask the user whether to clock out. -This is a useful function for adding to `kill-emacs-query-functions'." - (and (equal (car timeclock-last-event) "i") - (y-or-n-p "You're currently clocking time, clock out? ") - (timeclock-out)) - ;; Unconditionally return t for `kill-emacs-query-functions'. - t) - -;;;###autoload -(defun timeclock-reread-log () - "Re-read the timeclock, to account for external changes. -Returns the new value of `timeclock-discrepancy'." - (interactive) - (setq timeclock-discrepancy nil) - (timeclock-find-discrep) - (if (and timeclock-discrepancy timeclock-modeline-display) - (timeclock-update-modeline)) - timeclock-discrepancy) - -(defun timeclock-seconds-to-string (seconds &optional show-seconds - reverse-leader) - "Convert SECONDS into a compact time string. -If SHOW-SECONDS is non-nil, make the resolution of the return string -include the second count. If REVERSE-LEADER is non-nil, it means to -output a \"+\" if the time value is negative, rather than a \"-\". -This is used when negative time values have an inverted meaning (such -as with time remaining, where negative time really means overtime)." - (if show-seconds - (format "%s%d:%02d:%02d" - (if (< seconds 0) (if reverse-leader "+" "-") "") - (truncate (/ (abs seconds) 60 60)) - (% (truncate (/ (abs seconds) 60)) 60) - (% (truncate (abs seconds)) 60)) - (format "%s%d:%02d" - (if (< seconds 0) (if reverse-leader "+" "-") "") - (truncate (/ (abs seconds) 60 60)) - (% (truncate (/ (abs seconds) 60)) 60)))) - -(defsubst timeclock-currently-in-p () - "Return non-nil if the user is currently clocked in." - (equal (car timeclock-last-event) "i")) - -;;;###autoload -(defun timeclock-workday-remaining-string (&optional show-seconds - today-only) - "Return a string representing the amount of time left today. -Display second resolution if SHOW-SECONDS is non-nil. If TODAY-ONLY -is non-nil, the display will be relative only to time worked today. -See `timeclock-relative' for more information about the meaning of -\"relative to today\"." - (interactive) - (let ((string (timeclock-seconds-to-string - (timeclock-workday-remaining today-only) - show-seconds t))) - (if (interactive-p) - (message string) - string))) - -(defsubst timeclock-workday-elapsed () - "Return the number of seconds worked so far today. -If RELATIVE is non-nil, the amount returned will be relative to past -time worked. The default is to return only the time that has elapsed -so far today." - (let ((discrep (timeclock-find-discrep))) - (if discrep - (nth 2 discrep) - 0.0))) - -;;;###autoload -(defun timeclock-workday-elapsed-string (&optional show-seconds) - "Return a string representing the amount of time worked today. -Display seconds resolution if SHOW-SECONDS is non-nil. If RELATIVE is -non-nil, the amount returned will be relative to past time worked." - (interactive) - (let ((string (timeclock-seconds-to-string (timeclock-workday-elapsed) - show-seconds))) - (if (interactive-p) - (message string) - string))) - -(defsubst timeclock-time-to-seconds (time) - "Convert TIME to a floating point number." - (+ (* (car time) 65536.0) - (cadr time) - (/ (or (car (cdr (cdr time))) 0) 1000000.0))) - -(defsubst timeclock-seconds-to-time (seconds) - "Convert SECONDS (a floating point number) to an Emacs time structure." - (list (floor seconds 65536) - (floor (mod seconds 65536)) - (floor (* (- seconds (ffloor seconds)) 1000000)))) - -;; Should today-only be removed in favour of timeclock-relative? - gm -(defsubst timeclock-when-to-leave (&optional today-only) - "Return a time value representing the end of today's workday. -If TODAY-ONLY is non-nil, the value returned will be relative only to -the time worked today, and not to past time." - (timeclock-seconds-to-time - (- (timeclock-time-to-seconds (current-time)) - (let ((discrep (timeclock-find-discrep))) - (if discrep - (if today-only - (cadr discrep) - (car discrep)) - 0.0))))) - -;;;###autoload -(defun timeclock-when-to-leave-string (&optional show-seconds - today-only) - "Return a string representing the end of today's workday. -This string is relative to the value of `timeclock-workday'. If -SHOW-SECONDS is non-nil, the value printed/returned will include -seconds. If TODAY-ONLY is non-nil, the value returned will be -relative only to the time worked today, and not to past time." - ;; Should today-only be removed in favour of timeclock-relative? - gm - (interactive) - (let* ((then (timeclock-when-to-leave today-only)) - (string - (if show-seconds - (format-time-string "%-I:%M:%S %p" then) - (format-time-string "%-I:%M %p" then)))) - (if (interactive-p) - (message string) - string))) - -;;; Internal Functions: - -(defvar timeclock-project-list nil) -(defvar timeclock-last-project nil) - -(defun timeclock-completing-read (prompt alist &optional default) - "A version of `completing-read' that works on both Emacs and XEmacs." - (if (featurep 'xemacs) - (let ((str (completing-read prompt alist))) - (if (or (null str) (= (length str) 0)) - default - str)) - (completing-read prompt alist nil nil nil nil default))) - -(defun timeclock-ask-for-project () - "Ask the user for the project they are clocking into." - (timeclock-completing-read - (format "Clock into which project (default \"%s\"): " - (or timeclock-last-project - (car timeclock-project-list))) - (mapcar 'list timeclock-project-list) - (or timeclock-last-project - (car timeclock-project-list)))) - -(defvar timeclock-reason-list nil) - -(defun timeclock-ask-for-reason () - "Ask the user for the reason they are clocking out." - (timeclock-completing-read "Reason for clocking out: " - (mapcar 'list timeclock-reason-list))) - -(defun timeclock-update-modeline () - "Update the `timeclock-mode-string' displayed in the modeline. -The value of `timeclock-relative' affects the display as described in -that variable's documentation." - (interactive) - (let ((remainder (timeclock-workday-remaining (not timeclock-relative))) - (last-in (equal (car timeclock-last-event) "i"))) - (when (and (< remainder 0) - (not (and timeclock-day-over - (equal timeclock-day-over - (timeclock-time-to-date - (current-time)))))) - (setq timeclock-day-over - (timeclock-time-to-date (current-time))) - (run-hooks 'timeclock-day-over-hook)) - (setq timeclock-mode-string - (propertize - (format " %c%s%c " - (if last-in ?< ?[) - (timeclock-seconds-to-string remainder nil t) - (if last-in ?> ?])) - 'help-echo "timeclock: time remaining")))) - -(put 'timeclock-mode-string 'risky-local-variable t) - -(defun timeclock-log (code &optional project) - "Log the event CODE to the timeclock log, at the time of call. -If PROJECT is a string, it represents the project which the event is -being logged for. Normally only \"in\" events specify a project." - (with-current-buffer (find-file-noselect timeclock-file) - (goto-char (point-max)) - (if (not (bolp)) - (insert "\n")) - (let ((now (current-time))) - (insert code " " - (format-time-string "%Y/%m/%d %H:%M:%S" now) - (or (and project - (stringp project) - (> (length project) 0) - (concat " " project)) - "") - "\n") - (if (equal (downcase code) "o") - (setq timeclock-last-period - (- (timeclock-time-to-seconds now) - (timeclock-time-to-seconds - (cadr timeclock-last-event))) - timeclock-discrepancy - (+ timeclock-discrepancy - timeclock-last-period))) - (setq timeclock-last-event (list code now project))) - (save-buffer) - (run-hooks 'timeclock-event-hook) - (kill-buffer (current-buffer)))) - -(defvar timeclock-moment-regexp - (concat "\\([bhioO]\\)\\s-+" - "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)\\s-+" - "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)[ \t]*" "\\([^\n]*\\)")) - -(defsubst timeclock-read-moment () - "Read the moment under point from the timelog." - (if (looking-at timeclock-moment-regexp) - (let ((code (match-string 1)) - (year (string-to-number (match-string 2))) - (mon (string-to-number (match-string 3))) - (mday (string-to-number (match-string 4))) - (hour (string-to-number (match-string 5))) - (min (string-to-number (match-string 6))) - (sec (string-to-number (match-string 7))) - (project (match-string 8))) - (list code (encode-time sec min hour mday mon year) project)))) - -(defun timeclock-last-period (&optional moment) - "Return the value of the last event period. -If the last event was a clock-in, the period will be open ended, and -growing every second. Otherwise, it is a fixed amount which has been -recorded to disk. If MOMENT is non-nil, use that as the current time. -This is only provided for coherency when used by -`timeclock-discrepancy'." - (if (equal (car timeclock-last-event) "i") - (- (timeclock-time-to-seconds (or moment (current-time))) - (timeclock-time-to-seconds - (cadr timeclock-last-event))) - timeclock-last-period)) - -(defsubst timeclock-entry-length (entry) - (- (timeclock-time-to-seconds (cadr entry)) - (timeclock-time-to-seconds (car entry)))) - -(defsubst timeclock-entry-begin (entry) - (car entry)) - -(defsubst timeclock-entry-end (entry) - (cadr entry)) - -(defsubst timeclock-entry-project (entry) - (nth 2 entry)) - -(defsubst timeclock-entry-comment (entry) - (nth 3 entry)) - - -(defsubst timeclock-entry-list-length (entry-list) - (let ((length 0)) - (while entry-list - (setq length (+ length (timeclock-entry-length (car entry-list)))) - (setq entry-list (cdr entry-list))) - length)) - -(defsubst timeclock-entry-list-begin (entry-list) - (timeclock-entry-begin (car entry-list))) - -(defsubst timeclock-entry-list-end (entry-list) - (timeclock-entry-end (car (last entry-list)))) - -(defsubst timeclock-entry-list-span (entry-list) - (- (timeclock-time-to-seconds (timeclock-entry-list-end entry-list)) - (timeclock-time-to-seconds (timeclock-entry-list-begin entry-list)))) - -(defsubst timeclock-entry-list-break (entry-list) - (- (timeclock-entry-list-span entry-list) - (timeclock-entry-list-length entry-list))) - -(defsubst timeclock-entry-list-projects (entry-list) - (let (projects) - (while entry-list - (let ((project (timeclock-entry-project (car entry-list)))) - (if projects - (add-to-list 'projects project) - (setq projects (list project)))) - (setq entry-list (cdr entry-list))) - projects)) - - -(defsubst timeclock-day-required (day) - (or (car day) timeclock-workday)) - -(defsubst timeclock-day-length (day) - (timeclock-entry-list-length (cdr day))) - -(defsubst timeclock-day-debt (day) - (- (timeclock-day-required day) - (timeclock-day-length day))) - -(defsubst timeclock-day-begin (day) - (timeclock-entry-list-begin (cdr day))) - -(defsubst timeclock-day-end (day) - (timeclock-entry-list-end (cdr day))) - -(defsubst timeclock-day-span (day) - (timeclock-entry-list-span (cdr day))) - -(defsubst timeclock-day-break (day) - (timeclock-entry-list-break (cdr day))) - -(defsubst timeclock-day-projects (day) - (timeclock-entry-list-projects (cdr day))) - -(defmacro timeclock-day-list-template (func) - `(let ((length 0)) - (while day-list - (setq length (+ length (,(eval func) (car day-list)))) - (setq day-list (cdr day-list))) - length)) - -(defun timeclock-day-list-required (day-list) - (timeclock-day-list-template 'timeclock-day-required)) - -(defun timeclock-day-list-length (day-list) - (timeclock-day-list-template 'timeclock-day-length)) - -(defun timeclock-day-list-debt (day-list) - (timeclock-day-list-template 'timeclock-day-debt)) - -(defsubst timeclock-day-list-begin (day-list) - (timeclock-day-begin (car day-list))) - -(defsubst timeclock-day-list-end (day-list) - (timeclock-day-end (car (last day-list)))) - -(defun timeclock-day-list-span (day-list) - (timeclock-day-list-template 'timeclock-day-span)) - -(defun timeclock-day-list-break (day-list) - (timeclock-day-list-template 'timeclock-day-break)) - -(defun timeclock-day-list-projects (day-list) - (let (projects) - (while day-list - (let ((projs (timeclock-day-projects (car day-list)))) - (while projs - (if projects - (add-to-list 'projects (car projs)) - (setq projects (list (car projs)))) - (setq projs (cdr projs)))) - (setq day-list (cdr day-list))) - projects)) - - -(defsubst timeclock-current-debt (&optional log-data) - (nth 0 (or log-data (timeclock-log-data)))) - -(defsubst timeclock-day-alist (&optional log-data) - (nth 1 (or log-data (timeclock-log-data)))) - -(defun timeclock-day-list (&optional log-data) - (let ((alist (timeclock-day-alist log-data)) - day-list) - (while alist - (setq day-list (cons (cdar alist) day-list) - alist (cdr alist))) - day-list)) - -(defsubst timeclock-project-alist (&optional log-data) - (nth 2 (or log-data (timeclock-log-data)))) - - -(defun timeclock-log-data (&optional recent-only filename) - "Return the contents of the timelog file, in a useful format. -If the optional argument RECENT-ONLY is non-nil, only show the contents -from the last point where the time debt (see below) was set. -If the optional argument FILENAME is non-nil, it is used instead of -the file specified by `timeclock-file.' - -A timelog contains data in the form of a single entry per line. -Each entry has the form: - - CODE YYYY/MM/DD HH:MM:SS [COMMENT] - -CODE is one of: b, h, i, o or O. COMMENT is optional when the code is -i, o or O. The meanings of the codes are: - - b Set the current time balance, or \"time debt\". Useful when - archiving old log data, when a debt must be carried forward. - The COMMENT here is the number of seconds of debt. - - h Set the required working time for the given day. This must - be the first entry for that day. The COMMENT in this case is - the number of hours in this workday. Floating point amounts - are allowed. - - i Clock in. The COMMENT in this case should be the name of the - project worked on. - - o Clock out. COMMENT is unnecessary, but can be used to provide - a description of how the period went, for example. - - O Final clock out. Whatever project was being worked on, it is - now finished. Useful for creating summary reports. - -When this function is called, it will return a data structure with the -following format: - - (DEBT ENTRIES-BY-DAY ENTRIES-BY-PROJECT) - -DEBT is a floating point number representing the number of seconds -\"owed\" before any work was done. For a new file (one without a 'b' -entry), this is always zero. - -The two entries lists have similar formats. They are both alists, -where the CAR is the index, and the CDR is a list of time entries. -For ENTRIES-BY-DAY, the CAR is a textual date string, of the form -YYYY/MM/DD. For ENTRIES-BY-PROJECT, it is the name of the project -worked on, or t for the default project. - -The CDR for ENTRIES-BY-DAY is slightly different than for -ENTRIES-BY-PROJECT. It has the following form: - - (DAY-LENGTH TIME-ENTRIES...) - -For ENTRIES-BY-PROJECT, there is no DAY-LENGTH member. It is simply a -list of TIME-ENTRIES. Note that if DAY-LENGTH is nil, it means -whatever is the default should be used. - -A TIME-ENTRY is a recorded time interval. It has the following format -\(although generally one does not have to manipulate these entries -directly; see below): - - (BEGIN-TIME END-TIME PROJECT [COMMENT] [FINAL-P]) - -Anyway, suffice it to say there are a lot of structures. Typically -the user is expected to manipulate to the day(s) or project(s) that he -or she wants, at which point the following helper functions may be -used: - - timeclock-day-required - timeclock-day-length - timeclock-day-debt - timeclock-day-begin - timeclock-day-end - timeclock-day-span - timeclock-day-break - timeclock-day-projects - - timeclock-day-list-required - timeclock-day-list-length - timeclock-day-list-debt - timeclock-day-list-begin - timeclock-day-list-end - timeclock-day-list-span - timeclock-day-list-break - timeclock-day-list-projects - - timeclock-entry-length - timeclock-entry-begin - timeclock-entry-end - timeclock-entry-project - timeclock-entry-comment - - timeclock-entry-list-length - timeclock-entry-list-begin - timeclock-entry-list-end - timeclock-entry-list-span - timeclock-entry-list-break - timeclock-entry-list-projects - -A few comments should make the use of the above functions obvious: - - `required' is the amount of time that must be spent during a day, or - sequence of days, in order to have no debt. - - `length' is the actual amount of time that was spent. - - `debt' is the difference between required time and length. A - negative debt signifies overtime. - - `begin' is the earliest moment at which work began. - - `end' is the final moment work was done. - - `span' is the difference between begin and end. - - `break' is the difference between span and length. - - `project' is the project that was worked on, and `projects' is a - list of all the projects that were worked on during a given period. - - `comment', where it applies, could mean anything. - -There are a few more functions available, for locating day and entry -lists: - - timeclock-day-alist LOG-DATA - timeclock-project-alist LOG-DATA - timeclock-current-debt LOG-DATA - -See the documentation for the given function if more info is needed." - (let* ((log-data (list 0.0 nil nil)) - (now (current-time)) - (todays-date (timeclock-time-to-date now)) - last-date-limited last-date-seconds last-date - (line 0) last beg day entry event) - (with-temp-buffer - (insert-file-contents (or filename timeclock-file)) - (when recent-only - (goto-char (point-max)) - (unless (re-search-backward "^b\\s-+" nil t) - (goto-char (point-min)))) - (while (or (setq event (timeclock-read-moment)) - (and beg (not last) - (setq last t event (list "o" now)))) - (setq line (1+ line)) - (cond ((equal (car event) "b") - (setcar log-data (string-to-number (nth 2 event)))) - ((equal (car event) "h") - (setq last-date-limited (timeclock-time-to-date (cadr event)) - last-date-seconds (* (string-to-number (nth 2 event)) - 3600.0))) - ((equal (car event) "i") - (if beg - (error "Error in format of timelog file, line %d" line) - (setq beg t)) - (setq entry (list (cadr event) nil - (and (> (length (nth 2 event)) 0) - (nth 2 event)))) - (let ((date (timeclock-time-to-date (cadr event)))) - (if (and last-date - (not (equal date last-date))) - (progn - (setcar (cdr log-data) - (cons (cons last-date day) - (cadr log-data))) - (setq day (list (and last-date-limited - last-date-seconds)))) - (unless day - (setq day (list (and last-date-limited - last-date-seconds))))) - (setq last-date date - last-date-limited nil))) - ((equal (downcase (car event)) "o") - (if (not beg) - (error "Error in format of timelog file, line %d" line) - (setq beg nil)) - (setcar (cdr entry) (cadr event)) - (let ((desc (and (> (length (nth 2 event)) 0) - (nth 2 event)))) - (if desc - (nconc entry (list (nth 2 event)))) - (if (equal (car event) "O") - (nconc entry (if desc - (list t) - (list nil t)))) - (nconc day (list entry)) - (setq desc (nth 2 entry)) - (let ((proj (assoc desc (nth 2 log-data)))) - (if (null proj) - (setcar (cddr log-data) - (cons (cons desc (list entry)) - (car (cddr log-data)))) - (nconc (cdr proj) (list entry))))))) - (forward-line)) - (if day - (setcar (cdr log-data) - (cons (cons last-date day) - (cadr log-data)))) - log-data))) - -(defun timeclock-find-discrep () - "Calculate time discrepancies, in seconds. -The result is a three element list, containing the total time -discrepancy, today's discrepancy, and the time worked today." - ;; This is not implemented in terms of the functions above, because - ;; it's a bit wasteful to read all of that data in, just to throw - ;; away more than 90% of the information afterwards. - ;; - ;; If it were implemented using those functions, it would look - ;; something like this: - ;; (let ((days (timeclock-day-alist (timeclock-log-data))) - ;; (total 0.0)) - ;; (while days - ;; (setq total (+ total (- (timeclock-day-length (cdar days)) - ;; (timeclock-day-required (cdar days)))) - ;; days (cdr days))) - ;; total) - (let* ((now (current-time)) - (todays-date (timeclock-time-to-date now)) - (first t) (accum 0) (elapsed 0) - event beg last-date avg - last-date-limited last-date-seconds) - (unless timeclock-discrepancy - (when (file-readable-p timeclock-file) - (setq timeclock-project-list nil - timeclock-last-project nil - timeclock-reason-list nil - timeclock-elapsed 0) - (with-temp-buffer - (insert-file-contents timeclock-file) - (goto-char (point-max)) - (unless (re-search-backward "^b\\s-+" nil t) - (goto-char (point-min))) - (while (setq event (timeclock-read-moment)) - (cond ((equal (car event) "b") - (setq accum (string-to-number (nth 2 event)))) - ((equal (car event) "h") - (setq last-date-limited - (timeclock-time-to-date (cadr event)) - last-date-seconds - (* (string-to-number (nth 2 event)) 3600.0))) - ((equal (car event) "i") - (when (and (nth 2 event) - (> (length (nth 2 event)) 0)) - (add-to-list 'timeclock-project-list (nth 2 event)) - (setq timeclock-last-project (nth 2 event))) - (let ((date (timeclock-time-to-date (cadr event)))) - (if (if last-date - (not (equal date last-date)) - first) - (setq first nil - accum (- accum (if last-date-limited - last-date-seconds - timeclock-workday)))) - (setq last-date date - last-date-limited nil) - (if beg - (error "Error in format of timelog file!") - (setq beg (timeclock-time-to-seconds (cadr event)))))) - ((equal (downcase (car event)) "o") - (if (and (nth 2 event) - (> (length (nth 2 event)) 0)) - (add-to-list 'timeclock-reason-list (nth 2 event))) - (if (not beg) - (error "Error in format of timelog file!") - (setq timeclock-last-period - (- (timeclock-time-to-seconds (cadr event)) beg) - accum (+ timeclock-last-period accum) - beg nil)) - (if (equal last-date todays-date) - (setq timeclock-elapsed - (+ timeclock-last-period timeclock-elapsed))))) - (setq timeclock-last-event event - timeclock-last-event-workday - (if (equal (timeclock-time-to-date now) last-date-limited) - last-date-seconds - timeclock-workday)) - (forward-line)) - (setq timeclock-discrepancy accum)))) - (unless timeclock-last-event-workday - (setq timeclock-last-event-workday timeclock-workday)) - (setq accum (or timeclock-discrepancy 0) - elapsed (or timeclock-elapsed elapsed)) - (if timeclock-last-event - (if (equal (car timeclock-last-event) "i") - (let ((last-period (timeclock-last-period now))) - (setq accum (+ accum last-period) - elapsed (+ elapsed last-period))) - (if (not (equal (timeclock-time-to-date - (cadr timeclock-last-event)) - (timeclock-time-to-date now))) - (setq accum (- accum timeclock-last-event-workday))))) - (list accum (- elapsed timeclock-last-event-workday) - elapsed))) - -;;; A reporting function that uses timeclock-log-data - -(defun timeclock-day-base (&optional time) - "Given a time within a day, return 0:0:0 within that day. -If optional argument TIME is non-nil, use that instead of the current time." - (let ((decoded (decode-time (or time (current-time))))) - (setcar (nthcdr 0 decoded) 0) - (setcar (nthcdr 1 decoded) 0) - (setcar (nthcdr 2 decoded) 0) - (apply 'encode-time decoded))) - -(defun timeclock-geometric-mean (l) - "Compute the geometric mean of the values in the list L." - (let ((total 0) - (count 0)) - (while l - (setq total (+ total (car l)) - count (1+ count) - l (cdr l))) - (if (> count 0) - (/ total count) - 0))) - -(defun timeclock-generate-report (&optional html-p) - "Generate a summary report based on the current timelog file. -By default, the report is in plain text, but if the optional argument -HTML-P is non-nil, HTML markup is added." - (interactive) - (let ((log (timeclock-log-data)) - (today (timeclock-day-base))) - (if html-p (insert "

")) - (insert "Currently ") - (let ((project (nth 2 timeclock-last-event)) - (begin (nth 1 timeclock-last-event)) - done) - (if (timeclock-currently-in-p) - (insert "IN") - (if (or (null project) (= (length project) 0)) - (progn (insert "Done Working Today") - (setq done t)) - (insert "OUT"))) - (unless done - (insert " since " (format-time-string "%Y/%m/%d %-I:%M %p" begin)) - (if html-p - (insert "
\n") - (insert "\n*")) - (if (timeclock-currently-in-p) - (insert "Working on ")) - (if html-p - (insert project "
\n") - (insert project "*\n")) - (let ((proj-data (cdr (assoc project (timeclock-project-alist log)))) - (two-weeks-ago (timeclock-seconds-to-time - (- (timeclock-time-to-seconds today) - (* 2 7 24 60 60)))) - two-week-len today-len) - (while proj-data - (if (not (time-less-p - (timeclock-entry-begin (car proj-data)) today)) - (setq today-len (timeclock-entry-list-length proj-data) - proj-data nil) - (if (and (null two-week-len) - (not (time-less-p - (timeclock-entry-begin (car proj-data)) - two-weeks-ago))) - (setq two-week-len (timeclock-entry-list-length proj-data))) - (setq proj-data (cdr proj-data)))) - (if (null two-week-len) - (setq two-week-len today-len)) - (if html-p (insert "

")) - (if today-len - (insert "\nTime spent on this task today: " - (timeclock-seconds-to-string today-len) - ". In the last two weeks: " - (timeclock-seconds-to-string two-week-len)) - (if two-week-len - (insert "\nTime spent on this task in the last two weeks: " - (timeclock-seconds-to-string two-week-len)))) - (if html-p (insert "
")) - (insert "\n" - (timeclock-seconds-to-string (timeclock-workday-elapsed)) - " worked today, " - (timeclock-seconds-to-string (timeclock-workday-remaining)) - " remaining, done at " - (timeclock-when-to-leave-string) "\n"))) - (if html-p (insert "

")) - (insert "\nThere have been " - (number-to-string - (length (timeclock-day-alist log))) - " days of activity, starting " - (caar (last (timeclock-day-alist log)))) - (if html-p (insert "

")) - (when html-p - (insert "

- -

 - - - - - - - -") - (let* ((day-list (timeclock-day-list)) - (thirty-days-ago (timeclock-seconds-to-time - (- (timeclock-time-to-seconds today) - (* 30 24 60 60)))) - (three-months-ago (timeclock-seconds-to-time - (- (timeclock-time-to-seconds today) - (* 90 24 60 60)))) - (six-months-ago (timeclock-seconds-to-time - (- (timeclock-time-to-seconds today) - (* 180 24 60 60)))) - (one-year-ago (timeclock-seconds-to-time - (- (timeclock-time-to-seconds today) - (* 365 24 60 60)))) - (time-in (vector (list t) (list t) (list t) (list t) (list t))) - (time-out (vector (list t) (list t) (list t) (list t) (list t))) - (breaks (vector (list t) (list t) (list t) (list t) (list t))) - (workday (vector (list t) (list t) (list t) (list t) (list t))) - (lengths (vector '(0 0) thirty-days-ago three-months-ago - six-months-ago one-year-ago))) - ;; collect statistics from complete timelog - (while day-list - (let ((i 0) (l 5)) - (while (< i l) - (unless (time-less-p - (timeclock-day-begin (car day-list)) - (aref lengths i)) - (let ((base (timeclock-time-to-seconds - (timeclock-day-base - (timeclock-day-begin (car day-list)))))) - (nconc (aref time-in i) - (list (- (timeclock-time-to-seconds - (timeclock-day-begin (car day-list))) - base))) - (let ((span (timeclock-day-span (car day-list))) - (len (timeclock-day-length (car day-list))) - (req (timeclock-day-required (car day-list)))) - ;; If the day's actual work length is less than - ;; 70% of its span, then likely the exit time - ;; and break amount are not worthwhile adding to - ;; the statistic - (when (and (> span 0) - (> (/ (float len) (float span)) 0.70)) - (nconc (aref time-out i) - (list (- (timeclock-time-to-seconds - (timeclock-day-end (car day-list))) - base))) - (nconc (aref breaks i) (list (- span len)))) - (if req - (setq len (+ len (- timeclock-workday req)))) - (nconc (aref workday i) (list len))))) - (setq i (1+ i)))) - (setq day-list (cdr day-list))) - ;; average statistics - (let ((i 0) (l 5)) - (while (< i l) - (aset time-in i (timeclock-geometric-mean - (cdr (aref time-in i)))) - (aset time-out i (timeclock-geometric-mean - (cdr (aref time-out i)))) - (aset breaks i (timeclock-geometric-mean - (cdr (aref breaks i)))) - (aset workday i (timeclock-geometric-mean - (cdr (aref workday i)))) - (setq i (1+ i)))) - ;; Output the HTML table - (insert "\n") - (insert "\n") - (let ((i 0) (l 5)) - (while (< i l) - (insert "\n") - (setq i (1+ i)))) - (insert "\n") - - (insert "\n") - (insert "\n") - (let ((i 0) (l 5)) - (while (< i l) - (insert "\n") - (setq i (1+ i)))) - (insert "\n") - - (insert "\n") - (insert "\n") - (let ((i 0) (l 5)) - (while (< i l) - (insert "\n") - (setq i (1+ i)))) - (insert "\n") - - (insert "\n") - (insert "\n") - (let ((i 0) (l 5)) - (while (< i l) - (insert "\n") - (setq i (1+ i)))) - (insert "\n")) - (insert " - - -
StatisticsEntire-30 days-3 mons-6 mons-1 year
Time in" - (timeclock-seconds-to-string (aref time-in i)) - "
Time out" - (timeclock-seconds-to-string (aref time-out i)) - "
Break" - (timeclock-seconds-to-string (aref breaks i)) - "
Workday" - (timeclock-seconds-to-string (aref workday i)) - "
- These are approximate figures
-
"))))) - -;;; A helpful little function - -(defun timeclock-visit-timelog () - "Open the file named by `timeclock-file' in another window." - (interactive) - (find-file-other-window timeclock-file)) - -(provide 'timeclock) - -(run-hooks 'timeclock-load-hook) - -;; make sure we know the list of reasons, projects, and have computed -;; the last event and current discrepancy. -(if (file-readable-p timeclock-file) - (timeclock-reread-log)) - -;;; arch-tag: a0be3377-deb6-44ec-b9a2-a7be28436a40 -;;; timeclock.el ends here -- cgit v1.2.3 From 0744a0ac8fac128255a0baec0343d1092a998cee Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 6 Mar 2013 14:35:34 -0500 Subject: Added menu entries to help set sort region --- doc/ledger-mode.texi | 4 +++- lisp/ldg-mode.el | 2 ++ lisp/ldg-sort.el | 47 +++++++++++++++++++++++++++++++++++++++-------- 3 files changed, 44 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/doc/ledger-mode.texi b/doc/ledger-mode.texi index f530d587..e13610bc 100644 --- a/doc/ledger-mode.texi +++ b/doc/ledger-mode.texi @@ -316,7 +316,9 @@ markup within your ledger. For exmaple <<< information to not sort >>> @end smallexample - +You can use menu entries to insert start and end markers. These +functions will automatically delete old markers and put new new marker +at point. @node Hiding Transactions, , Sorting Transactions, The Ledger Buffer @section Hiding Transactions diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 00df0e67..84ccf62b 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -116,6 +116,8 @@ (interactive) (customize-group 'ledger)))) (define-key map [sep1] '("--")) + (define-key map [sort-end] '(menu-item "Mark Sort End" ledger-sort-insert-end-mark)) + (define-key map [sort-start] '(menu-item "Mark Sort Beginning" ledger-sort-insert-start-mark)) (define-key map [sort-buff] '(menu-item "Sort Buffer" ledger-sort-buffer)) (define-key map [sort-reg] '(menu-item "Sort Region" ledger-sort-region :enable mark-active)) (define-key map [sep2] '(menu-item "--")) diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el index cc036492..33ae2a98 100644 --- a/lisp/ldg-sort.el +++ b/lisp/ldg-sort.el @@ -38,6 +38,36 @@ "Move point to end of transaction." (forward-paragraph)) +(defun ledger-sort-find-start () + (if (re-search-forward ";.*Ledger-mode:.*Start sort" nil t) + (match-end 0))) + +(defun ledger-sort-find-end () + (if (re-search-forward ";.*Ledger-mode:.*End sort" nil t) + (match-end 0))) + +(defun ledger-sort-insert-start-mark () + (interactive) + (let (has-old-marker) + (save-excursion + (goto-char (point-min)) + (setq has-old-marker (ledger-sort-find-start)) + (if has-old-marker + (delete-region (match-beginning 0) (match-end 0)))) + (beginning-of-line) + (insert "\n; Ledger-mode: Start sort\n\n"))) + +(defun ledger-sort-insert-end-mark () + (interactive) + (let (has-old-marker) + (save-excursion + (goto-char (point-min)) + (setq has-old-marker (ledger-sort-find-end)) + (if has-old-marker + (delete-region (match-beginning 0) (match-end 0)))) + (beginning-of-line) + (insert "\n; Ledger-mode: End sort\n\n"))) + (defun ledger-sort-region (beg end) "Sort the region from BEG to END in chronological order." (interactive "r") ;; load beg and end from point and mark @@ -66,14 +96,15 @@ (defun ledger-sort-buffer () "Sort the entire buffer." (interactive) - (let ((sort-start (point-min)) - (sort-end (point-max))) - (goto-char (point-min)) - (if (re-search-forward ";.*Ledger-mode:.*Start sort" nil t) - (set 'sort-start (match-end 0))) - (if (re-search-forward ";.*Ledger-mode:.*End sort" nil t) - (set 'sort-end (match-end 0))) - (ledger-sort-region sort-start sort-end))) + (goto-char (point-min)) + (let ((sort-start (ledger-sort-find-start)) + (sort-end (ledger-sort-find-end))) + (ledger-sort-region (if sort-start + sort-start + (point-min)) + (if sort-end + sort-end + (point-max))))) (provide 'ldg-sort) -- cgit v1.2.3 From 1eba7c6cdf4ac334a5b8580e4f18102db26b8c5f Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 6 Mar 2013 14:36:31 -0500 Subject: Code formatting cleanup. --- lisp/ldg-occur.el | 4 +++- lisp/ldg-reconcile.el | 1 - lisp/ldg-regex.el | 3 ++- 3 files changed, 5 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index 1561d6f8..f14aeeda 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -41,7 +41,9 @@ (make-variable-buffer-local 'ledger-occur-use-face-unfolded) -(defvar ledger-occur-mode nil) ;; name of the minor mode, shown in the mode-line +(defvar ledger-occur-mode nil +"name of the minor mode, shown in the mode-line") + (make-variable-buffer-local 'ledger-occur-mode) (or (assq 'ledger-occur-mode minor-mode-alist) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index e45ab7c3..fd452004 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -443,6 +443,5 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (use-local-map map))) (provide 'ldg-reconcile) -(provide 'ldg-reconcile) ;;; ldg-reconcile.el ends here diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el index e81394ef..97fd6e2c 100644 --- a/lisp/ldg-regex.el +++ b/lisp/ldg-regex.el @@ -24,7 +24,8 @@ (eval-when-compile (require 'cl)) -(defvar ledger-date-regex "\\([0-9]+\\)[/-]\\([0-9]+\\)[/-]\\([0-9]+\\)") +(defvar ledger-date-regex + "\\([0-9]+\\)[/-]\\([0-9]+\\)[/-]\\([0-9]+\\)") (defmacro ledger-define-regexp (name regex docs &rest args) "Simplify the creation of a Ledger regex and helper functions." -- cgit v1.2.3 From 7579ebb34dbd53309b7069c23fc7812a261aea97 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 6 Mar 2013 14:44:22 -0500 Subject: Added missing lisp files to CMakeList.txt --- lisp/CMakeLists.txt | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/CMakeLists.txt b/lisp/CMakeLists.txt index 949171b3..5341f67a 100644 --- a/lisp/CMakeLists.txt +++ b/lisp/CMakeLists.txt @@ -1,19 +1,21 @@ set(EMACS_LISP_SOURCES + ldg-commodities.el ldg-complete.el ldg-exec.el + ldg-fonts.el ldg-mode.el ldg-new.el + ldg-occur.el ldg-post.el ldg-reconcile.el ldg-regex.el ldg-register.el ldg-report.el + ldg-sort.el ldg-state.el ldg-test.el ldg-texi.el - ldg-xact.el - ledger.el - timeclock.el) + ldg-xact.el) # find emacs and complain if not found find_program(EMACS_EXECUTABLE emacs) -- cgit v1.2.3 From 63653f50d5e05d07a65bb906d0afa77f22a6084e Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 6 Mar 2013 15:23:46 -0500 Subject: Correct bug is edit amount. Edit-amount was still looking for decimal-comma --- doc/ledger-mode.texi | 2 +- lisp/ldg-post.el | 11 +---------- 2 files changed, 2 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/doc/ledger-mode.texi b/doc/ledger-mode.texi index e13610bc..001eb054 100644 --- a/doc/ledger-mode.texi +++ b/doc/ledger-mode.texi @@ -323,7 +323,7 @@ at point. @node Hiding Transactions, , Sorting Transactions, The Ledger Buffer @section Hiding Transactions -Often you will want to run Ledger register reports just to look at a +Often you will want to run Ledger register reports just to look at ax specific set of transactions. If you don't need the running total calculation handled by Ledger, Ledger-mode provides a rapid way of narrowing what is displayed in the buffer in a way that is simpler than diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 6cba305b..e794f071 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -186,19 +186,10 @@ BEG, END, and LEN control how far it can align." (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))) + (let ((val (ledger-commodity-string-number-decimalize (match-string 0) :from-user))) (goto-char (match-beginning 0)) (delete-region (match-beginning 0) (match-end 0)) (calc) - (if ledger-use-decimal-comma - (progn - (while (string-match "\\." val) - (setq val (replace-match "" nil nil val))) ;; gets rid of periods - (while (string-match "," val) - (setq val (replace-match "." nil nil val)))) ;; switch to period separator - (progn - (while (string-match "," val) - (setq val (replace-match "" nil nil val))))) ;; gets rid of commas (calc-eval val 'push)) ;; edit the amount (progn ;;make sure there are two spaces after the account name and go to calc (if (search-backward " " (- (point) 3) t) -- 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') 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 27d27ecb6c5be3a9523fd4efc895b6d0b2a6cfb4 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 6 Mar 2013 21:13:06 -0500 Subject: Account auto formatting now works with tab completion --- lisp/ldg-complete.el | 11 ++++++----- lisp/ldg-post.el | 13 +++++++++---- lisp/ldg-reconcile.el | 2 +- lisp/ldg-xact.el | 3 --- 4 files changed, 16 insertions(+), 13 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index 3686d0fd..6607d372 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -145,16 +145,17 @@ Return tree structure" "Completes a transaction if there is another matching payee in the buffer. Does not use ledger xact" (interactive) - (let ((name (caar (ledger-parse-arguments))) - rest-of-name + (let* ((name (caar (ledger-parse-arguments))) + (rest-of-name name) xacts) (save-excursion (when (eq 'transaction (ledger-thing-at-point)) + (delete-region (point) (+ (length name) (point))) ;; Search backward for a matching payee (when (re-search-backward - (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" - (regexp-quote name) ) nil t) ;; "\\(\t\\|\n\\| [ \t]\\)" - (setq rest-of-name (buffer-substring-no-properties (match-end 0) (line-end-position))) + (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.*" + (regexp-quote name) ".*\\)" ) nil t) ;; "\\(\t\\|\n\\| [ \t]\\)" + (setq rest-of-name (match-string 3)) ;; Start copying the postings (forward-line) (while (looking-at "^\\s-+") diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index e794f071..d68d7f16 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -133,10 +133,15 @@ the account" (setq column ledger-post-amount-alignment-column)) (save-excursion ;; Position the account - ;; (beginning-of-line) - (set-mark (point)) - ;; (delete-horizontal-space) - ;; (insert ledger-default-acct-transaction-indent) + (if (not + (and (looking-at "[ \t]+\n") + (looking-back "[ \n]" (- (point) 2)))) + (progn + (beginning-of-line) + (set-mark (point)) + (delete-horizontal-space) + (insert ledger-default-acct-transaction-indent)) + (set-mark (point))) (goto-char (1+ (line-end-position))) (let* ((mark-first (< (mark) (point))) (begin (if mark-first (mark) (point))) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index fd452004..7b3df459 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -397,7 +397,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (defvar ledger-reconcile-mode-abbrev-table) (defun ledger-reconcile-change-target () - "Change the traget amount for the reconciliation process." + "Change the target amount for the reconciliation process." (interactive) (setq ledger-target (ledger-read-commodity-string "Set reconciliation target"))) diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index 8db50df2..ecd87127 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -118,9 +118,6 @@ within the transaction." (replace-match date) (re-search-forward "[1-9][0-9]+\.[0-9]+"))) - - -(provide 'ldg-xact) (provide 'ldg-xact) ;;; ldg-xact.el ends here -- cgit v1.2.3 From b475e569c4c4cb97d32e76de4d85d0810c9cc462 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 7 Mar 2013 15:28:09 -0500 Subject: Made account formatting and auto complete compatible. --- lisp/ldg-new.el | 1 + lisp/ldg-post.el | 38 +++++++++++++----------- lisp/ldg-reconcile.el | 16 +++++------ lisp/ldg-state.el | 80 +++++++++++++++++++++++++++------------------------ 4 files changed, 72 insertions(+), 63 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index 7a2961f7..4cebbba7 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -32,6 +32,7 @@ ;;; Commentary: ;; Load up the ledger mode +(require 'esh-util) (require 'esh-arg) (require 'ldg-commodities) (require 'ldg-complete) diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index d68d7f16..87922dd1 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -36,11 +36,16 @@ "Options for controlling how Ledger-mode deals with postings and completion" :group 'ledger) -(defcustom ledger-post-auto-adjust-amounts nil - "If non-nil, ." +(defcustom ledger-post-auto-adjust-postings nil + "If non-nil, adjust account and amount to columns set below" :type 'boolean :group 'ledger-post) +(defcustom ledger-post-account-alignment-column 4 + "The column Ledger-mode attempts to align accounts to." + :type 'integer + :group 'ledger-post) + (defcustom ledger-post-amount-alignment-column 52 "The column Ledger-mode attempts to align amounts to." :type 'integer @@ -123,25 +128,25 @@ PROMPT is a string to prompt with. CHOICES is a list of (- (or (match-end 4) (match-end 3)) (point)))) -(defun ledger-align-amounts (&optional column) +(defun ledger-post-align-postings (&optional column) "Align amounts and accounts in the current region. This is done so that the last digit falls in COLUMN, which -defaults to 52. ledger-default-acct-transaction-indent positions +defaults to 52. ledger-post-account-column positions the account" (interactive "p") (if (or (null column) (= column 1)) (setq column ledger-post-amount-alignment-column)) (save-excursion ;; Position the account - (if (not - (and (looking-at "[ \t]+\n") - (looking-back "[ \n]" (- (point) 2)))) - (progn + (if (not (and (looking-at "[ \t]+\n") + (looking-back "[ \n]" (- (point) 2)))) + (save-excursion (beginning-of-line) - (set-mark (point)) - (delete-horizontal-space) - (insert ledger-default-acct-transaction-indent)) + (set-mark (point)) + (delete-horizontal-space) + (insert (make-string ledger-post-account-alignment-column ? ))) (set-mark (point))) + (set-mark (point)) (goto-char (1+ (line-end-position))) (let* ((mark-first (< (mark) (point))) (begin (if mark-first (mark) (point))) @@ -153,7 +158,7 @@ the account" (let ((col (current-column)) (target-col (- column offset)) adjust) - (setq adjust (- target-col col)) + (setq adjust (- target-col col)) (if (< col target-col) (insert (make-string (- target-col col) ? )) (move-to-column target-col) @@ -164,13 +169,13 @@ the account" (insert " "))) (forward-line)))))) -(defun ledger-post-align-amount () +(defun ledger-post-align-posting () "Align the amounts in this posting." (interactive) (save-excursion (set-mark (line-beginning-position)) (goto-char (1+ (line-end-position))) - (ledger-align-amounts))) + (ledger-post-align-postings))) (defun ledger-post-maybe-align (beg end len) "Align amounts only if point is in a posting. @@ -180,7 +185,7 @@ BEG, END, and LEN control how far it can align." (when (<= end (line-end-position)) (goto-char (line-beginning-position)) (if (looking-at ledger-post-line-regexp) - (ledger-align-amounts))))) + (ledger-post-align-postings))))) (defun ledger-post-edit-amount () "Call 'calc-mode' and push the amount in the posting to the top of stack." @@ -221,8 +226,7 @@ BEG, END, and LEN control how far it can align." (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-change-functions 'ledger-post-maybe-align t t) (add-hook 'after-save-hook #'(lambda () (setq ledger-post-current-list nil)))) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 7b3df459..6ede6b51 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -70,20 +70,20 @@ reconcile-finish will mark all pending posting cleared." (account ledger-acct) (val nil)) (with-temp-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. (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" "--empty" "--format" "%(display_total)" account) - (setq val + (setq val (ledger-split-commodity-string (buffer-substring-no-properties (point-min) (point-max))))))) (defun ledger-display-balance () - "Display the cleared-or-pending balnce and calculate the -target-delta of the account being reconciled." + "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)) (target-delta (if ledger-target @@ -111,7 +111,7 @@ target-delta of the account being reconciled." "Return a buffer from WHERE the transaction is." (if (bufferp (car where)) (car where) - (error "ledger-reconcile-get-buffer: Buffer not set"))) + (error "Function ledger-reconcile-get-buffer: Buffer not set"))) (defun ledger-reconcile-toggle () "Toggle the current transaction, and mark the recon window." diff --git a/lisp/ldg-state.el b/lisp/ldg-state.el index b2247afe..dd5e42ad 100644 --- a/lisp/ldg-state.el +++ b/lisp/ldg-state.el @@ -122,42 +122,48 @@ dropped." ;;this excursion toggles the posting status (save-excursion - (goto-char (line-beginning-position)) - (when (looking-at "[ \t]") - (skip-chars-forward " \t") - (let ((here (point)) - (cur-status (ledger-state-from-char (char-after)))) - (skip-chars-forward "*! ") - (let ((width (- (point) here))) - (when (> width 0) - (delete-region here (point)) - (save-excursion - (if (search-forward " " (line-end-position) t) - (insert (make-string width ? )))))) - (let (inserted) - (if cur-status - (if (and style (eq style 'cleared)) - (progn - (insert "* ") - (setq inserted 'cleared))) - (if (and style (eq style 'pending)) - (progn - (insert "! ") - (setq inserted 'pending)) - (progn - (insert "* ") - (setq inserted 'cleared)))) - (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)))) - (setq new-status inserted))))) + (let ((has-align-hook (remove-hook + 'after-change-functions + 'ledger-post-maybe-align t))) + + (goto-char (line-beginning-position)) + (when (looking-at "[ \t]") + (skip-chars-forward " \t") + (let ((here (point)) + (cur-status (ledger-state-from-char (char-after)))) + (skip-chars-forward "*! ") + (let ((width (- (point) here))) + (when (> width 0) + (delete-region here (point)) + (save-excursion + (if (search-forward " " (line-end-position) t) + (insert (make-string width ? )))))) + (let (inserted) + (if cur-status + (if (and style (eq style 'cleared)) + (progn + (insert "* ") + (setq inserted 'cleared))) + (if (and style (eq style 'pending)) + (progn + (insert "! ") + (setq inserted 'pending)) + (progn + (insert "* ") + (setq inserted 'cleared)))) + (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)))) + (setq new-status inserted)))) + (if has-align-hook + (add-hook 'after-change-functions 'ledger-post-maybe-align t t)))) ;; This excursion cleans up the entry so that it displays ;; minimally. This means that if all posts are cleared, remove @@ -254,6 +260,4 @@ dropped." (provide 'ldg-state) -(provide 'ldg-state) - ;;; ldg-state.el ends here -- cgit v1.2.3 From 7758100df9152bab243d9531518af76acdbc7287 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 7 Mar 2013 16:08:07 -0500 Subject: Caught another omission in the built list --- lisp/CMakeLists.txt | 1 + lisp/ldg-new.el | 1 + 2 files changed, 2 insertions(+) (limited to 'lisp') diff --git a/lisp/CMakeLists.txt b/lisp/CMakeLists.txt index 5341f67a..32a31001 100644 --- a/lisp/CMakeLists.txt +++ b/lisp/CMakeLists.txt @@ -3,6 +3,7 @@ set(EMACS_LISP_SOURCES ldg-complete.el ldg-exec.el ldg-fonts.el + ldg-init.el ldg-mode.el ldg-new.el ldg-occur.el diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index 4cebbba7..f888fd6c 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -43,6 +43,7 @@ (require 'ldg-occur) (require 'ldg-post) (require 'ldg-reconcile) +(require 'ldg-regex) (require 'ldg-register) (require 'ldg-report) (require 'ldg-sort) -- cgit v1.2.3 From 37ddc5f5888197782e7e3449b3e29a0285d9ad61 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 7 Mar 2013 16:11:55 -0500 Subject: Deprecated ledger.el --- lisp/ledger.el | 1340 -------------------------------------------------------- 1 file changed, 1340 deletions(-) delete mode 100644 lisp/ledger.el (limited to 'lisp') diff --git a/lisp/ledger.el b/lisp/ledger.el deleted file mode 100644 index 4fc21d6a..00000000 --- a/lisp/ledger.el +++ /dev/null @@ -1,1340 +0,0 @@ -;;; ledger.el --- Helper code for use with the "ledger" command-line tool - -;; Copyright (C) 2003-2009 John Wiegley (johnw AT gnu DOT org) - -;; Emacs Lisp Archive Entry -;; Filename: ledger.el -;; Version: 2.6.3 -;; Date: Fri 18-Jul-2008 -;; Keywords: data -;; Author: John Wiegley (johnw AT gnu DOT org) -;; Maintainer: John Wiegley (johnw AT gnu DOT org) -;; Description: Helper code for using my "ledger" command-line tool -;; URL: http://www.newartisans.com/johnw/emacs.html -;; Compatibility: Emacs22 - -;; 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: - -;; To use this module: Load this file, open a ledger data file, and -;; type M-x ledger-mode. Once this is done, you can type: -;; -;; C-c C-a add a new entry, based on previous entries -;; C-c C-e toggle cleared status of an entry -;; C-c C-y set default year for entry mode -;; C-c C-m set default month for entry mode -;; C-c C-r reconcile uncleared entries related to an account -;; C-c C-o C-r run a ledger report -;; C-C C-o C-g goto the ledger report buffer -;; C-c C-o C-e edit the defined ledger reports -;; C-c C-o C-s save a report definition based on the current report -;; C-c C-o C-a rerun a ledger report -;; C-c C-o C-k kill the ledger report buffer -;; -;; In the reconcile buffer, use SPACE to toggle the cleared status of -;; a transaction, C-x C-s to save changes (to the ledger file as -;; well). -;; -;; The ledger reports command asks the user to select a report to run -;; then creates a report buffer containing the results of running the -;; associated command line. Its' behavior is modified by a prefix -;; argument which, when given, causes the generated command line that -;; will be used to create the report to be presented for editing -;; before the report is actually run. Arbitrary unnamed command lines -;; can be run by specifying an empty name for the report. The command -;; line used can later be named and saved for future use as a named -;; report from the generated reports buffer. -;; -;; In a report buffer, the following keys are available: -;; (space) scroll up -;; e edit the defined ledger reports -;; s save a report definition based on the current report -;; q quit the report (return to ledger buffer) -;; r redo the report -;; k kill the report buffer - -(require 'esh-util) -(require 'esh-arg) -(require 'pcomplete) - -(defvar ledger-version "1.3" - "The version of ledger.el currently loaded") - -(defgroup ledger nil - "Interface to the Ledger command-line accounting program." - :group 'data) - -(defcustom ledger-binary-path "ledger" - "Path to the ledger executable." - :type 'file - :group 'ledger) - -(defcustom ledger-clear-whole-entries nil - "If non-nil, clear whole entries, not individual transactions." - :type 'boolean - :group 'ledger) - -(defcustom ledger-reports - '(("bal" "ledger -f %(ledger-file) bal") - ("reg" "ledger -f %(ledger-file) reg") - ("payee" "ledger -f %(ledger-file) reg -- %(payee)") - ("account" "ledger -f %(ledger-file) reg %(account)")) - "Definition of reports to run. - -Each element has the form (NAME CMDLINE). The command line can -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 -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"))) - :group 'ledger) - -(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)) - "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." - :type 'alist - :group 'ledger) - -(defcustom ledger-default-acct-transaction-indent " " - "Default indentation for account transactions in an entry." - :type 'string - :group 'ledger) - -(defvar bold 'bold) -(defvar ledger-font-lock-keywords - '(("\\( \\| \\|^\\)\\(;.*\\)" 2 font-lock-comment-face) - ("^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)" 2 bold) - ;;("^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)" - ;; 2 font-lock-type-face) - ("^\\s-+\\([*]\\s-*\\)?\\(\\([[(]\\)?\\([^*;]\\)+?\\(:\\|\\s-\\)[^]); - ]+?\\([])]\\)?\\)\\( \\| \\|$\\)" - 2 font-lock-keyword-face) - ("^\\([~=].+\\)" 1 font-lock-function-name-face) - ("^\\([A-Za-z]+ .+\\)" 1 font-lock-function-name-face)) - "Expressions to highlight in Ledger mode.") - -(defsubst ledger-current-year () - (format-time-string "%Y")) -(defsubst ledger-current-month () - (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.") -(defvar ledger-month (ledger-current-month) - "Start a ledger session with the current month, but make it -customizable to ease retro-entry.") - -(defun ledger-iterate-entries (callback) - (goto-char (point-min)) - (let* ((now (current-time)) - (current-year (nth 5 (decode-time now)))) - (while (not (eobp)) - (when (looking-at - (concat "\\(Y\\s-+\\([0-9]+\\)\\|" - "\\([0-9]\\{4\\}+\\)?[./]?" - "\\([0-9]+\\)[./]\\([0-9]+\\)\\s-+" - "\\(\\*\\s-+\\)?\\(.+\\)\\)")) - (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))))) - (forward-line)))) - -(defun ledger-time-less-p (t1 t2) - "Say whether time value T1 is less than time value T2." - (or (< (car t1) (car t2)) - (and (= (car t1) (car t2)) - (< (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." - (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) - (catch 'found - (ledger-iterate-entries - (function - (lambda (start date mark desc) - (if (ledger-time-less-p moment date) - (throw 'found t))))))) - -(defun ledger-add-entry (entry-text &optional insert-at-point) - (interactive - (list - (read-string "Entry: " (concat ledger-year "/" ledger-month "/")))) - (let* ((args (with-temp-buffer - (insert entry-text) - (eshell-parse-arguments (point-min) (point-max)))) - (ledger-buf (current-buffer)) - exit-code) - (unless insert-at-point - (let ((date (car args))) - (if (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" date) - (setq date - (encode-time 0 0 0 (string-to-number (match-string 3 date)) - (string-to-number (match-string 2 date)) - (string-to-number (match-string 1 date))))) - (ledger-find-slot date))) - (save-excursion - (insert - (with-temp-buffer - (setq exit-code - (apply #'ledger-run-ledger ledger-buf "entry" - (mapcar 'eval args))) - (goto-char (point-min)) - (if (looking-at "Error: ") - (error (buffer-string)) - (buffer-string))) - "\n")))) - -(defun ledger-current-entry-bounds () - (save-excursion - (when (or (looking-at "^[0-9]") - (re-search-backward "^[0-9]" nil t)) - (let ((beg (point))) - (while (not (eolp)) - (forward-line)) - (cons (copy-marker beg) (point-marker)))))) - -(defun ledger-delete-current-entry () - (interactive) - (let ((bounds (ledger-current-entry-bounds))) - (delete-region (car bounds) (cdr bounds)))) - -(defun ledger-toggle-current-entry (&optional style) - (interactive) - (let (clear) - (save-excursion - (when (or (looking-at "^[0-9]") - (re-search-backward "^[0-9]" nil t)) - (skip-chars-forward "0-9./=") - (delete-horizontal-space) - (if (member (char-after) '(?\* ?\!)) - (progn - (delete-char 1) - (if (and style (eq style 'cleared)) - (insert " *"))) - (if (and style (eq style 'pending)) - (insert " ! ") - (insert " * ")) - (setq clear t)))) - clear)) - -(defun ledger-move-to-next-field () - (re-search-forward "\\( \\|\t\\)" (line-end-position) t)) - -(defun ledger-toggle-state (state &optional style) - (if (not (null state)) - (if (and style (eq style 'cleared)) - 'cleared) - (if (and style (eq style 'pending)) - 'pending - 'cleared))) - -(defun ledger-entry-state () - (save-excursion - (when (or (looking-at "^[0-9]") - (re-search-backward "^[0-9]" nil t)) - (skip-chars-forward "0-9./=") - (skip-syntax-forward " ") - (cond ((looking-at "!\\s-*") 'pending) - ((looking-at "\\*\\s-*") 'cleared) - (t nil))))) - -(defun ledger-transaction-state () - (save-excursion - (goto-char (line-beginning-position)) - (skip-syntax-forward " ") - (cond ((looking-at "!\\s-*") 'pending) - ((looking-at "\\*\\s-*") 'cleared) - (t (ledger-entry-state))))) - -(defun ledger-toggle-current-transaction (&optional style) - "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'). -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 -achieved more certainly by passing the entry to ledger for -formatting, but doing so causes inline math expressions to be -dropped." - (interactive) - (let ((bounds (ledger-current-entry-bounds)) - clear cleared) - ;; Uncompact the entry, to make it easier to toggle the - ;; transaction - (save-excursion - (goto-char (car bounds)) - (skip-chars-forward "0-9./= \t") - (setq cleared (and (member (char-after) '(?\* ?\!)) - (char-after))) - (when cleared - (let ((here (point))) - (skip-chars-forward "*! ") - (let ((width (- (point) here))) - (when (> width 0) - (delete-region here (point)) - (if (search-forward " " (line-end-position) t) - (insert (make-string width ? )))))) - (forward-line) - (while (looking-at "[ \t]") - (skip-chars-forward " \t") - (insert cleared " ") - (if (search-forward " " (line-end-position) t) - (delete-char 2)) - (forward-line)))) - ;; Toggle the individual transaction - (save-excursion - (goto-char (line-beginning-position)) - (when (looking-at "[ \t]") - (skip-chars-forward " \t") - (let ((here (point)) - (cleared (member (char-after) '(?\* ?\!)))) - (skip-chars-forward "*! ") - (let ((width (- (point) here))) - (when (> width 0) - (delete-region here (point)) - (save-excursion - (if (search-forward " " (line-end-position) t) - (insert (make-string width ? )))))) - (let (inserted) - (if cleared - (if (and style (eq style 'cleared)) - (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)))) - (setq clear inserted))))) - ;; Clean up the entry so that it displays minimally - (save-excursion - (goto-char (car bounds)) - (forward-line) - (let ((first t) - (state ? ) - (hetero nil)) - (while (and (not hetero) (looking-at "[ \t]")) - (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)))) - (forward-line)) - (when (and (not hetero) (/= state ? )) - (goto-char (car bounds)) - (forward-line) - (while (looking-at "[ \t]") - (skip-chars-forward " \t") - (let ((here (point))) - (skip-chars-forward "*! ") - (let ((width (- (point) here))) - (when (> width 0) - (delete-region here (point)) - (if (re-search-forward "\\(\t\\| [ \t]\\)" - (line-end-position) t) - (insert (make-string width ? )))))) - (forward-line)) - (goto-char (car bounds)) - (skip-chars-forward "0-9./= \t") - (insert state " ") - (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))))))) - clear)) - -(defun ledger-toggle-current (&optional style) - (interactive) - (if (or ledger-clear-whole-entries - (eq 'entry (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))))) - (if (looking-at "\\s-+[*!]") - (ledger-toggle-current-transaction nil)) - (forward-line) - (goto-char (line-beginning-position)))) - (ledger-toggle-current-entry style)) - (ledger-toggle-current-transaction style))) - -(defvar ledger-mode-abbrev-table) - -;;;###autoload -(define-derived-mode ledger-mode text-mode "Ledger" - "A mode for editing ledger data files. - -\\{ledger-mode-map}" - (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) - (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))) - -;; Reconcile mode - -(defvar ledger-buf nil) -(defvar ledger-acct nil) - -(defun ledger-display-balance () - (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)))))))) - -(defun ledger-reconcile-toggle () - (interactive) - (let ((where (get-text-property (point) 'where)) - (account ledger-acct) - (inhibit-read-only t) - cleared) - (when (or (equal (car where) "") (equal (car where) "/dev/stdin")) - (with-current-buffer ledger-buf - (goto-char (cdr where)) - (setq cleared (ledger-toggle-current 'pending))) - (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))) - -(defun ledger-reconcile-refresh () - (interactive) - (let ((inhibit-read-only t) - (line (count-lines (point-min) (point)))) - (erase-buffer) - (ledger-do-reconcile) - (set-buffer-modified-p t) - (goto-char (point-min)) - (forward-line line))) - -(defun ledger-reconcile-refresh-after-save () - (let ((buf (get-buffer "*Reconcile*"))) - (if buf - (with-current-buffer buf - (ledger-reconcile-refresh) - (set-buffer-modified-p nil))))) - -(defun ledger-reconcile-add () - (interactive) - (with-current-buffer ledger-buf - (call-interactively #'ledger-add-entry)) - (ledger-reconcile-refresh)) - -(defun ledger-reconcile-delete () - (interactive) - (let ((where (get-text-property (point) 'where))) - (when (or (equal (car where) "") (equal (car where) "/dev/stdin")) - (with-current-buffer ledger-buf - (goto-char (cdr where)) - (ledger-delete-current-entry)) - (let ((inhibit-read-only t)) - (goto-char (line-beginning-position)) - (delete-region (point) (1+ (line-end-position))) - (set-buffer-modified-p t))))) - -(defun ledger-reconcile-visit () - (interactive) - (let ((where (get-text-property (point) 'where))) - (when (markerp (cdr where)) - (switch-to-buffer-other-window ledger-buf) - (goto-char (cdr where))))) - -(defun ledger-reconcile-save () - (interactive) - (with-current-buffer ledger-buf - (save-buffer)) - (set-buffer-modified-p nil) - (ledger-display-balance)) - -(defun ledger-reconcile-quit () - (interactive) - (kill-buffer (current-buffer))) - -(defun ledger-reconcile-finish () - (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) - (or (equal (car where) "") - (equal (car where) "/dev/stdin"))) - (with-current-buffer ledger-buf - (goto-char (cdr where)) - (ledger-toggle-current 'cleared)))) - (forward-line 1))) - (ledger-reconcile-save)) - -(defun ledger-do-reconcile () - (let* ((buf ledger-buf) - (account ledger-acct) - (items - (with-temp-buffer - (let ((exit-code - (ledger-run-ledger buf "--uncleared" "--real" - "emacs" account))) - (when (= 0 exit-code) - (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))) - -(defun ledger-reconcile (account) - (interactive "sAccount to reconcile: ") - (let ((buf (current-buffer)) - (rbuf (get-buffer "*Reconcile*"))) - (if rbuf - (kill-buffer rbuf)) - (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save) - (with-current-buffer - (pop-to-buffer (get-buffer-create "*Reconcile*")) - (ledger-reconcile-mode) - (set (make-local-variable 'ledger-buf) buf) - (set (make-local-variable 'ledger-acct) account) - (ledger-do-reconcile)))) - -(defvar ledger-reconcile-mode-abbrev-table) - -(defvar ledger-reconcile-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [(control ?m)] 'ledger-reconcile-visit) - (define-key map [return] 'ledger-reconcile-visit) - (define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish) - (define-key map [(control ?x) (control ?s)] 'ledger-reconcile-save) - (define-key map [(control ?l)] 'ledger-reconcile-refresh) - (define-key map [? ] 'ledger-reconcile-toggle) - (define-key map [?a] 'ledger-reconcile-add) - (define-key map [?d] 'ledger-reconcile-delete) - (define-key map [?n] 'next-line) - (define-key map [?p] 'previous-line) - (define-key map [?s] 'ledger-reconcile-save) - (define-key map [?q] 'ledger-reconcile-quit) - map)) - -(define-derived-mode ledger-reconcile-mode text-mode "Reconcile" - "A mode for reconciling ledger entries. - -\\{ledger-reconcile-mode-map}") - -;; Context sensitivity - -(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]+\\)\\(.*?\\)[ \t]+\\([$]\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$" - (indent account commodity amount nil comment)) - ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$]\\)\\(-?[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)) - ("\\(^[ \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)))))) - -(defun ledger-extract-context-info (line-type pos) - "Get context info for current line. - -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 for 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))) - -(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)))) - -;; Ledger report mode - -(defvar ledger-report-buffer-name "*Ledger Report*") - -(defvar ledger-report-name nil) -(defvar ledger-report-cmd nil) -(defvar ledger-report-name-prompt-history nil) -(defvar ledger-report-cmd-prompt-history nil) -(defvar ledger-original-window-cfg nil) - -(defvar ledger-report-mode-abbrev-table) - -(defvar ledger-report-mode-map - (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) - map)) - -(define-derived-mode ledger-report-mode text-mode "Ledger-Report" - "A mode for viewing ledger reports.") - -(defun ledger-report-read-name () - "Read the name of a ledger report to use, with completion. - -The empty string and unknown names are allowed." - (completing-read "Report name: " - ledger-reports nil nil nil - 'ledger-report-name-prompt-history nil)) - -(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. - -The output buffer will be in `ledger-report-mode', which defines -commands for saving a new named report based on the command line -used to generate the buffer, navigating the buffer, etc." - (interactive - (progn - (when (and (buffer-modified-p) - (y-or-n-p "Buffer modified, save it? ")) - (save-buffer)) - (let ((rname (ledger-report-read-name)) - (edit (not (null current-prefix-arg)))) - (list rname edit)))) - (let ((buf (current-buffer)) - (rbuf (get-buffer ledger-report-buffer-name)) - (wcfg (current-window-configuration))) - (if rbuf - (kill-buffer rbuf)) - (with-current-buffer - (pop-to-buffer (get-buffer-create ledger-report-buffer-name)) - (ledger-report-mode) - (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) - (ledger-do-report (ledger-report-cmd report-name edit)) - (shrink-window-if-larger-than-buffer) - (set-buffer-modified-p nil) - (setq buffer-read-only t) - (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." - (string-equal "" s)) - -(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." - (unless (string-empty-p name) - (car (assoc name ledger-reports)))) - -(defun ledger-reports-add (name cmd) - "Add a new report to `ledger-reports'." - (setq ledger-reports (cons (list name cmd) ledger-reports))) - -(defun ledger-reports-custom-save () - "Save the `ledger-reports' variable using the customize framework." - (customize-save-variable 'ledger-reports ledger-reports)) - -(defun ledger-report-read-command (report-cmd) - "Read the command line to create a report." - (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 - -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)) - -(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 () - "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." - ;; It is intended copmletion 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)))) - -(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." - ;; 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))) - -(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)) - -(defun ledger-report-cmd (report-name edit) - "Get the command line to run the report." - (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-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)) - report-cmd)) - -(defun ledger-do-report (cmd) - "Run a report command line." - (goto-char (point-min)) - (insert (format "Report: %s\n" ledger-report-name) - (format "Command: %s\n" cmd) - (make-string (- (window-width) 1) ?=) - "\n") - (shell-command cmd t nil)) - -(defun ledger-report-goto () - "Goto the ledger report buffer." - (interactive) - (let ((rbuf (get-buffer ledger-report-buffer-name))) - (if (not rbuf) - (error "There is no ledger report buffer")) - (pop-to-buffer rbuf) - (shrink-window-if-larger-than-buffer))) - -(defun ledger-report-redo () - "Redo the report in the current ledger report buffer." - (interactive) - (ledger-report-goto) - (setq buffer-read-only nil) - (erase-buffer) - (ledger-do-report ledger-report-cmd) - (setq buffer-read-only nil)) - -(defun ledger-report-quit () - "Quit the ledger report buffer by burying it." - (interactive) - (ledger-report-goto) - (set-window-configuration ledger-original-window-cfg) - (bury-buffer (get-buffer ledger-report-buffer-name))) - -(defun ledger-report-kill () - "Kill the ledger report buffer." - (interactive) - (ledger-report-quit) - (kill-buffer (get-buffer ledger-report-buffer-name))) - -(defun ledger-report-edit () - "Edit the defined ledger reports." - (interactive) - (customize-variable 'ledger-reports)) - -(defun ledger-report-read-new-name () - "Read the name for a new report from the minibuffer." - (let ((name "")) - (while (string-empty-p name) - (setq name (read-from-minibuffer "Report name: " nil nil nil - 'ledger-report-name-prompt-history))) - name)) - -(defun ledger-report-save () - "Save the current report command line as a named report." - (interactive) - (ledger-report-goto) - (let (existing-name) - (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))) - -;; In-place completion support - -(defun ledger-thing-at-point () - (let ((here (point))) - (goto-char (line-beginning-position)) - (cond ((looking-at "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+") - (goto-char (match-end 0)) - 'entry) - ((looking-at "^\\s-+\\([*!]\\s-+\\)?[[(]?\\(.\\)") - (goto-char (match-beginning 2)) - 'transaction) - ((looking-at "^\\(sun\\|mon\\|tue\\|wed\\|thu\\|fri\\|sat\\)\\s-+") - (goto-char (match-end 0)) - 'entry) - (t - (ignore (goto-char here)))))) - -(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)) - (end (point)) - begins args) - (save-excursion - (goto-char begin) - (when (< (point) end) - (skip-chars-forward " \t\n") - (setq begins (cons (point) begins)) - (setq args (cons (buffer-substring-no-properties - (car begins) end) - args))) - (cons (reverse args) (reverse begins))))) - -(defun ledger-entries () - (let ((origin (point)) - entries-list) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward - (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" - "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t) - (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)))) - -(defvar ledger-account-tree nil) - -(defun ledger-find-accounts () - (let ((origin (point)) account-path elements) - (save-excursion - (setq ledger-account-tree (list t)) - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)" nil t) - (unless (and (>= origin (match-beginning 0)) - (< origin (match-end 0))) - (setq account-path (match-string-no-properties 2)) - (setq elements (split-string account-path ":")) - (let ((root ledger-account-tree)) - (while elements - (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 elements (cdr elements))))))))) - -(defun ledger-accounts () - (ledger-find-accounts) - (let* ((current (caar (ledger-parse-arguments))) - (elements (and current (split-string current ":"))) - (root ledger-account-tree) - (prefix nil)) - (while (cdr elements) - (let ((entry (assoc (car elements) root))) - (if entry - (setq prefix (concat prefix (and prefix ":") - (car elements)) - root (cdr entry)) - (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)))) - (cdr root)) - 'string-lessp)))) - -(defun ledger-complete-at-point () - "Do appropriate completion for the thing at point" - (interactive) - (while (pcomplete-here - (if (eq (save-excursion - (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))))) - -(defun ledger-fully-complete-entry () - "Do appropriate completion for the thing at point" - (interactive) - (let ((name (caar (ledger-parse-arguments))) - xacts) - (save-excursion - (when (eq 'entry (ledger-thing-at-point)) - (when (re-search-backward - (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" - (regexp-quote name) "\\(\t\\|\n\\| [ \t]\\)") nil t) - (forward-line) - (while (looking-at "^\\s-+") - (setq xacts (cons (buffer-substring-no-properties - (line-beginning-position) - (line-end-position)) - xacts)) - (forward-line)) - (setq xacts (nreverse xacts))))) - (when xacts - (save-excursion - (insert ?\n) - (while xacts - (insert (car xacts) ?\n) - (setq xacts (cdr xacts)))) - (forward-line) - (goto-char (line-end-position)) - (if (re-search-backward "\\(\t\\| [ \t]\\)" nil t) - (goto-char (match-end 0)))))) - -;; A sample function for $ users - -(defun ledger-next-amount (&optional 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 " ") - (- (or (match-end 4) - (match-end 3)) (point)))) - -(defun ledger-align-amounts (&optional column) - "Align amounts in the current region. -This is done so that the last digit falls in COLUMN, which defaults to 52." - (interactive "p") - (if (or (null column) (= column 1)) - (setq column 52)) - (save-excursion - (let* ((mark-first (< (mark) (point))) - (begin (if mark-first (mark) (point))) - (end (if mark-first (point-marker) (mark-marker))) - offset) - (goto-char begin) - (while (setq offset (ledger-next-amount end)) - (let ((col (current-column)) - (target-col (- column offset)) - adjust) - (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 " "))) - (forward-line)))))) - -(defalias 'ledger-align-dollars 'ledger-align-amounts) - -;; A sample entry sorting function, which works if entry dates are of -;; the form YYYY/mm/dd. - -(defun ledger-sort () - (interactive) - (save-excursion - (goto-char (point-min)) - (sort-subr - nil - (function - (lambda () - (if (re-search-forward - (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" - "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t) - (goto-char (match-beginning 0)) - (goto-char (point-max))))) - (function - (lambda () - (forward-paragraph)))))) - -;; General helper functions - -(defvar ledger-delete-after nil) - -(defun ledger-run-ledger (buffer &rest args) - "run ledger with supplied arguments" - ;; Let's try again, just in case they moved it while we were sleeping. - (cond - ((null ledger-binary-path) - (error "The variable `ledger-binary-path' has not been set")) - (t - (let ((buf (current-buffer))) - (with-current-buffer buffer - (let ((coding-system-for-write 'utf-8) - (coding-system-for-read 'utf-8)) - (apply #'call-process-region - (append (list (point-min) (point-max) - ledger-binary-path ledger-delete-after - buf nil "-f" "-") - args)))))))) - -(defun ledger-run-ledger-and-delete (buffer &rest args) - (let ((ledger-delete-after t)) - (apply #'ledger-run-ledger buffer args))) - -(defun ledger-set-year (newyear) - "Set ledger's idea of the current year to the prefix argument." - (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." - (interactive "p") - (if (= newmonth 1) - (setq ledger-month (read-string "Month: " (ledger-current-month))) - (setq ledger-month (format "%02d" newmonth)))) - -(defvar ledger-master-file nil) - -(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." - (if ledger-master-file - (expand-file-name ledger-master-file) - (buffer-file-name))) - -(easy-menu-define ledger-menu ledger-mode-map - "Ledger menu" - '("Ledger" - ["New entry" ledger-add-entry t] - ["Toggle cleared status of current entry" ledger-toggle-current-entry t] - ["Set default year for entry" ledger-set-year t] - ["Set default month for entry" ledger-set-month t] - "--" - ["Reconcile uncleared entries for account" ledger-reconcile t] - "--" - "Reports" - ["Run a report" ledger-report t] - ["Go to report buffer" ledger-report-goto t] - ["Edit defined reports" ledger-report-edit t] - ["Save report definition" ledger-report-save t] - ["Re-run ledger report" ledger-report-redo t] - ["Kill report buffer" ledger-report-kill t])) - -(provide 'ledger) - -;;; ledger.el ends here -- cgit v1.2.3 From cdd7f0675c5906e6a70781a09f87dc4f459a518d Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 7 Mar 2013 16:52:51 -0500 Subject: refactored the auto-adjust to make it default --- lisp/ldg-post.el | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 87922dd1..46acad1a 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -31,12 +31,11 @@ "Default indentation for account transactions in an entry." :type 'string :group 'ledger-post) - (defgroup ledger-post nil "Options for controlling how Ledger-mode deals with postings and completion" :group 'ledger) -(defcustom ledger-post-auto-adjust-postings nil +(defcustom ledger-post-auto-adjust-postings t "If non-nil, adjust account and amount to columns set below" :type 'boolean :group 'ledger-post) @@ -138,8 +137,9 @@ the account" (setq column ledger-post-amount-alignment-column)) (save-excursion ;; Position the account - (if (not (and (looking-at "[ \t]+\n") - (looking-back "[ \n]" (- (point) 2)))) + (if (not (or (looking-at "[ \t]*[1-9]") + (and (looking-at "[ \t]+\n") + (looking-back "[ \n]" (- (point) 2))))) (save-excursion (beginning-of-line) (set-mark (point)) @@ -180,12 +180,13 @@ the account" (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)) - (goto-char (line-beginning-position)) - (if (looking-at ledger-post-line-regexp) - (ledger-post-align-postings))))) + (if ledger-post-auto-adjust-postings + (save-excursion + (goto-char beg) + (when (<= end (line-end-position)) + (goto-char (line-beginning-position)) + (if (looking-at ledger-post-line-regexp) + (ledger-post-align-postings)))))) (defun ledger-post-edit-amount () "Call 'calc-mode' and push the amount in the posting to the top of stack." -- cgit v1.2.3 From 8f4b0e89627b082f9c5d4bd2b506661aab732b0b Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 8 Mar 2013 00:08:25 -0500 Subject: Added Ledger error handling. No more lisp backtraces! --- lisp/ldg-exec.el | 83 +++++++++++++++++++++++++++++++-------------------- lisp/ldg-reconcile.el | 53 ++++++++++++++++---------------- 2 files changed, 78 insertions(+), 58 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-exec.el b/lisp/ldg-exec.el index d62fd419..46775914 100644 --- a/lisp/ldg-exec.el +++ b/lisp/ldg-exec.el @@ -40,30 +40,48 @@ :type 'file :group 'ledger-exec) +(defun ledger-exec-handle-error (ledger-output) + "Deal with ledger errors contained in LEDGER-OUTPUT." + (with-current-buffer (get-buffer-create "*Ledger Error*") + (insert-buffer-substring ledger-output) + (make-frame) + (fit-frame) + (view-mode) + (toggle-read-only))) + +(defun ledger-exec-success-p (ledger-output-buffer) + (with-current-buffer ledger-output-buffer + (goto-char (point-min)) + (if (and (> (buffer-size) 1) (looking-at (regexp-quote "While"))) + nil + ledger-output-buffer))) + (defun ledger-exec-ledger (input-buffer &optional output-buffer &rest args) "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))) - (outbuf (or output-buffer - (generate-new-buffer " *ledger-tmp*")))) - (with-current-buffer buf - (let ((coding-system-for-write 'utf-8) - (coding-system-for-read 'utf-8)) - (apply #'call-process-region - (append (list (point-min) (point-max) - ledger-binary-path nil outbuf nil "-f" "-") - args))) - 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)) - (prog1 - (read (current-buffer)) - (kill-buffer (current-buffer))))) + (error "The variable `ledger-binary-path' has not been set") + (let ((buf (or input-buffer (current-buffer))) + (outbuf (or output-buffer + (generate-new-buffer " *ledger-tmp*")))) + (with-current-buffer buf + (let ((coding-system-for-write 'utf-8) + (coding-system-for-read 'utf-8)) + (apply #'call-process-region + (append (list (point-min) (point-max) + ledger-binary-path nil outbuf nil "-f" "-") + args))) + (if (ledger-exec-success-p outbuf) + outbuf + (ledger-exec-handle-error 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)) +;; (prog1 +;; (read (current-buffer)) +;; (kill-buffer (current-buffer))))) (defun ledger-version-greater-p (needed) "Verify the ledger binary is usable for `ledger-mode' (version greater than NEEDED)." @@ -71,17 +89,18 @@ (version-strings '()) (version-number)) (with-temp-buffer - (ledger-exec-ledger buffer (current-buffer) "--version") - (goto-char (point-min)) - (delete-horizontal-space) - (setq version-strings (split-string - (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))))) - t - nil)))) + (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)))))) (defun ledger-check-version () "Verify that ledger works and is modern enough." diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 6ede6b51..9f1a220c 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -74,28 +74,25 @@ reconcile-finish will mark all pending posting cleared." ;; 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. - (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))))))) + (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)))))))) (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)) - (target-delta (if ledger-target - (-commodity ledger-target pending) - nil))) - - (if target-delta - (message "Pending balance: %s, Difference from target: %s" - (ledger-commodity-to-string pending) - (ledger-commodity-to-string target-delta)) - (message "Pending balance: %s" - (ledger-commodity-to-string pending))))) + (let* ((pending (ledger-reconcile-get-cleared-or-pending-balance))) + (if pending + (if ledger-target + (message "Pending balance: %s, Difference from target: %s" + (ledger-commodity-to-string pending) + (ledger-commodity-to-string (-commodity ledger-target pending))) + (message "Pending balance: %s" + (ledger-commodity-to-string pending)))))) @@ -276,16 +273,18 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." "Get the uncleared transactions in the account and display them in the *Reconcile* buffer." (let* ((buf ledger-buf) (account ledger-acct) + (ledger-success nil) (xacts (with-temp-buffer - (ledger-exec-ledger buf (current-buffer) - "--uncleared" "--real" "emacs" account) - (goto-char (point-min)) - (unless (eobp) - (unless (looking-at "(") - (error (concat "ledger-do-reconcile: " (buffer-string)))) - (read (current-buffer)))))) ;current-buffer is the *temp* created above - (if (> (length xacts) 0) + (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 + (if (and ledger-success (> (length xacts) 0)) (progn (dolist (xact xacts) (dolist (posting (nthcdr 5 xact)) @@ -310,7 +309,9 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." 'where where)))) )) (goto-char (point-max)) (delete-char -1)) ;gets rid of the extra line feed at the bottom of the list - (insert (concat "There are no uncleared entries for " account))) + (if ledger-success + (insert (concat "There are no uncleared entries for " account)) + (insert "Ledger has reported a problem. Check *Ledger Error* buffer."))) (goto-char (point-min)) (set-buffer-modified-p nil) (toggle-read-only t) -- cgit v1.2.3 From 404e84cd445d41b3f2fc6cd775babf12864fcefc Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 8 Mar 2013 18:53:02 -0500 Subject: Removed ldg-register.el functionality all contained in ldg-report --- lisp/CMakeLists.txt | 1 - lisp/ldg-new.el | 4 --- lisp/ldg-register.el | 86 ---------------------------------------------------- 3 files changed, 91 deletions(-) delete mode 100644 lisp/ldg-register.el (limited to 'lisp') diff --git a/lisp/CMakeLists.txt b/lisp/CMakeLists.txt index 32a31001..876b3548 100644 --- a/lisp/CMakeLists.txt +++ b/lisp/CMakeLists.txt @@ -10,7 +10,6 @@ set(EMACS_LISP_SOURCES ldg-post.el ldg-reconcile.el ldg-regex.el - ldg-register.el ldg-report.el ldg-sort.el ldg-state.el diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index f888fd6c..a9c70ff4 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -44,7 +44,6 @@ (require 'ldg-post) (require 'ldg-reconcile) (require 'ldg-regex) -(require 'ldg-register) (require 'ldg-report) (require 'ldg-sort) (require 'ldg-state) @@ -125,9 +124,6 @@ (ledger-dump-variable 'ledger-buffer-tracks-reconcile-buffer) (ledger-dump-variable 'ledger-reconcile-force-window-bottom) (ledger-dump-variable 'ledger-reconcile-toggle-to-pending) - (insert "ldg-register:\n") - (ledger-dump-variable 'ledger-register-date-format) - (ledger-dump-variable 'ledger-register-line-format) (insert "ldg-reports:\n") (ledger-dump-variable 'ledger-reports) (ledger-dump-variable 'ledger-report-format-specifiers) diff --git a/lisp/ldg-register.el b/lisp/ldg-register.el deleted file mode 100644 index bfd8d360..00000000 --- a/lisp/ldg-register.el +++ /dev/null @@ -1,86 +0,0 @@ -;;; ldg-register.el --- Helper code for use with the "ledger" command-line tool - -;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) - -;; This file is not part of GNU Emacs. - -;; This is free software; you can redistribute it and/or modify it under -;; the terms of the GNU General Public License as published by the Free -;; Software Foundation; either version 2, or (at your option) any later -;; version. -;; -;; This is distributed in the hope that it will be useful, but WITHOUT -;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -;; for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, -;; MA 02111-1307, USA. - -(require 'ldg-post) -(require 'ldg-state) - -(defgroup ledger-register nil - "" - :group 'ledger) - -(defcustom ledger-register-date-format "%m/%d/%y" - "*The date format used for ledger register reports." - :type 'string - :group 'ledger-register) - -(defcustom ledger-register-line-format "%s %-30.30s %-25.25s %15s\n" - "*The date format used for ledger register reports." - :type 'string - :group 'ledger-register) - -(defface ledger-register-pending-face - '((((background light)) (:weight bold)) - (((background dark)) (:weight bold))) - "Face used to highlight pending entries in a register report." - :group 'ledger-register) - -(defun ledger-register-render (data-buffer posts) - (dolist (post posts) - (let ((index 1)) - (dolist (xact (nthcdr 5 post)) - (let ((beg (point)) - (where - (with-current-buffer data-buffer - (cons - (nth 0 post) - (if ledger-clear-whole-transactions - (save-excursion - (goto-line (nth 1 post)) - (point-marker)) - (save-excursion - (goto-line (nth 0 xact)) - (point-marker))))))) - (insert (format ledger-register-line-format - (format-time-string ledger-register-date-format - (nth 2 post)) - (nth 4 post) (nth 1 xact) (nth 2 xact))) - (if (nth 3 xact) - (set-text-properties beg (1- (point)) - (list 'face 'ledger-register-pending-face - 'where where)) - (set-text-properties beg (1- (point)) - (list 'where where)))) - (setq index (1+ index))))) - (goto-char (point-min))) - -(defun ledger-register-generate (&optional data-buffer &rest args) - (let ((buf (or data-buffer (current-buffer)))) - (with-current-buffer (get-buffer-create "*ledger-register*") - (let ((pos (point)) - (inhibit-read-only t)) - (erase-buffer) - (ledger-register-render buf (apply #'ledger-exec-read buf args)) - (goto-char pos)) - (set-buffer-modified-p nil) - (toggle-read-only t) - (display-buffer (current-buffer) t)))) - -(provide 'ldg-register) -- cgit v1.2.3 From bfe360d4c992caf2e7da09ab058599c0404f1348 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 8 Mar 2013 19:33:16 -0500 Subject: Reconcile date configuration is pulled from ledgerrc --- lisp/ldg-reconcile.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 9f1a220c..802cb3b4 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -285,13 +285,15 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (if (looking-at "(") (read (current-buffer))))))))) ;current-buffer is the *temp* created above (if (and ledger-success (> (length xacts) 0)) - (progn + (let ((date-format (cdr (assoc "date-format" ledger-environment-alist)))) (dolist (xact xacts) (dolist (posting (nthcdr 5 xact)) (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)) + (format-time-string (if date-format + date-format + "%Y/%m/%d") (nth 2 xact)) (if (nth 3 xact) (nth 3 xact) "") -- cgit v1.2.3 From 13b4c5adc000ca17c03a7d412f6e0a12a0f35e74 Mon Sep 17 00:00:00 2001 From: David Keegan Date: Sat, 9 Mar 2013 18:39:30 +0000 Subject: Fixed bug 913 ledger mode C-c C-a and ISO dates. --- lisp/ldg-mode.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 84ccf62b..97662aa3 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -167,8 +167,8 @@ MOMENT is an encoded date" (while (not (eobp)) (when (looking-at (concat "\\(Y\\s-+\\([0-9]+\\)\\|" - "\\([0-9]\\{4\\}+\\)?[./]?" - "\\([0-9]+\\)[./]\\([0-9]+\\)\\s-+" + "\\([0-9]\\{4\\}+\\)?[./-]?" + "\\([0-9]+\\)[./-]\\([0-9]+\\)\\s-+" "\\(\\*\\s-+\\)?\\(.+\\)\\)")) (let ((found (match-string 2))) (if found @@ -215,7 +215,7 @@ correct chronological place in the buffer." exit-code) (unless insert-at-point (let ((date (car args))) - (if (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" date) + (if (string-match "\\([0-9]+\\)[-/]\\([0-9]+\\)[-/]\\([0-9]+\\)" date) (setq date (encode-time 0 0 0 (string-to-number (match-string 3 date)) (string-to-number (match-string 2 date)) -- cgit v1.2.3 From 007836dfce1dcba54f6bbb5f0a5c3f9eb12e21da Mon Sep 17 00:00:00 2001 From: David Keegan Date: Sat, 9 Mar 2013 19:19:40 +0000 Subject: ledger-sort-region did nothing if point was at end of region. --- lisp/ldg-sort.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el index 33ae2a98..01d8edc9 100644 --- a/lisp/ldg-sort.el +++ b/lisp/ldg-sort.el @@ -76,6 +76,7 @@ (new-end end)) (save-excursion (save-restriction + (goto-char beg) (ledger-next-record-function) ;; make sure point is at the ;; beginning of a xact (setq new-beg (point)) -- cgit v1.2.3 From be4a212ff2839adebd908be42cbf46254bf4f754 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 9 Mar 2013 15:04:07 -0700 Subject: Fixed bug where reconcile bombed if you tried to start from a comment --- lisp/ldg-post.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 46acad1a..e23b3135 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -234,7 +234,8 @@ BEG, END, and LEN control how far it can align." (defun ledger-post-read-account-with-prompt (prompt) (let* ((context (ledger-context-at-point)) (default - (if (eq (ledger-context-line-type context) 'acct-transaction) + (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))) -- cgit v1.2.3 From c85f397edc33f895921b7900f938cd9cbb9f0e16 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 13 Mar 2013 10:20:21 -0700 Subject: Cleaned up ledger-reconcile, easier to read, fewer lines of code. --- lisp/ldg-reconcile.el | 49 +++++++++++++++++++++++++------------------------ 1 file changed, 25 insertions(+), 24 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 802cb3b4..9a6c7b67 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -363,6 +363,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." ;; 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 @@ -371,31 +372,31 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (ledger-reconcile-quit-cleanup) (set 'ledger-buf buf))) ;; should already be ;; buffer-local - (if ledger-fold-on-reconcile - (ledger-occur-change-regex account ledger-buf)) - (set-buffer (get-buffer ledger-recon-buffer-name)) + (unless (get-buffer-window rbuf) - (ledger-reconcile-open-windows buf rbuf)) - (ledger-reconcile-refresh) - (goto-char (point-min)) - (setq ledger-target - (ledger-read-commodity-string "Set reconciliation target")) - (ledger-display-balance)) - - (progn ;; no recon-buffer, starting from scratch. - (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t) - (if ledger-fold-on-reconcile - (ledger-occur-mode account buf)) - - (with-current-buffer (get-buffer-create ledger-recon-buffer-name) - (ledger-reconcile-open-windows buf (current-buffer)) - (ledger-reconcile-mode) - (set (make-local-variable 'ledger-buf) buf) - (set (make-local-variable 'ledger-acct) account) - (ledger-do-reconcile) - (set (make-local-variable 'ledger-target) - (ledger-read-commodity-string "Set reconciliation target")) - (ledger-display-balance)))))) + (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)))) + + ;; Fold the ledger buffer + (if ledger-fold-on-reconcile + (ledger-occur-mode account buf)) + + ;; Now, actually run the reconciliation + (with-current-buffer rbuf + (ledger-reconcile-refresh) + (goto-char (point-min)) + (ledger-reconcile-change-target) + (ledger-display-balance)))) (defvar ledger-reconcile-mode-abbrev-table) -- cgit v1.2.3 From 3b5316486abcde380ee0f7d31ec56ab1aa736687 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 13 Mar 2013 10:26:07 -0700 Subject: Removed unused function loedger-occur-change-regex --- lisp/ldg-occur.el | 12 ------------ 1 file changed, 12 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index f14aeeda..8b56d12c 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -19,9 +19,6 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; MA 02111-1307, USA. - - - ;;; Commentary: ;; Provide code folding to ledger mode. Adapted from original loccur ;; mode by Alexey Veretennikov Date: Wed, 13 Mar 2013 10:57:43 -0700 Subject: More reconcile restructuring. --- lisp/ldg-reconcile.el | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 9a6c7b67..37d6f32c 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -318,11 +318,13 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (set-buffer-modified-p nil) (toggle-read-only t) - ;; this next piece of code ensures that the last of the visible - ;; transactions in the ledger buffer is at the bottom of the main - ;; window. The key to this is to ensure the window is selected - ;; when the buffer point is moved and recentered. If they aren't - ;; strange things happen. + (ledger-reconcile-ensure-xacts-visible))) + +(defun ledger-reconcile-ensure-xacts-visible () + "Ensures that the last of the visible transactions in the +ledger buffer is at the bottom of the main window. The key to +this is to ensure the window is selected when the buffer point is +moved and recentered. If they aren't strange things happen." (let ((recon-window (get-buffer-window (get-buffer ledger-recon-buffer-name)))) (when recon-window @@ -335,10 +337,10 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (recenter -1)) (select-window recon-window) (ledger-reconcile-visit t)) - (add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t)))) + (add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t))) (defun ledger-reconcile-track-xact () - "Force the ledger buffer to recenter on the transactionat point in the reconcile buffer." + "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 @@ -388,11 +390,12 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (set (make-local-variable 'ledger-acct) account)))) ;; Fold the ledger buffer - (if ledger-fold-on-reconcile - (ledger-occur-mode account buf)) ;; Now, actually run the reconciliation (with-current-buffer rbuf + (save-excursion + (if ledger-fold-on-reconcile + (ledger-occur-mode account ledger-buf))) (ledger-reconcile-refresh) (goto-char (point-min)) (ledger-reconcile-change-target) -- cgit v1.2.3 From b608ed23e413aaec6024c42c453f8cd9854498d7 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 13 Mar 2013 11:27:51 -0700 Subject: Reconcile skips asking for target if there are no uncleared xacts. --- lisp/ldg-reconcile.el | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 37d6f32c..ec4b7f88 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -145,15 +145,16 @@ And calculate the target-delta of the account being reconciled." (ledger-display-balance))) (defun ledger-reconcile-refresh () - "Force the reconciliation window to refresh." + "Force the reconciliation window to refresh. +Return the number of uncleared xacts found." (interactive) (let ((inhibit-read-only t) (line (count-lines (point-min) (point)))) (erase-buffer) - (ledger-do-reconcile) - (set-buffer-modified-p t) - (goto-char (point-min)) - (forward-line line))) + (prog1 (ledger-do-reconcile) + (set-buffer-modified-p t) + (goto-char (point-min)) + (forward-line line)))) (defun ledger-reconcile-refresh-after-save () "Refresh the recon-window after the ledger buffer is saved." @@ -270,7 +271,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (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." + "Return the number of uncleared transactions in the account and display them in the *Reconcile* buffer." (let* ((buf ledger-buf) (account ledger-acct) (ledger-success nil) @@ -318,7 +319,8 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (set-buffer-modified-p nil) (toggle-read-only t) - (ledger-reconcile-ensure-xacts-visible))) + (ledger-reconcile-ensure-xacts-visible) + (length xacts))) (defun ledger-reconcile-ensure-xacts-visible () "Ensures that the last of the visible transactions in the @@ -396,9 +398,8 @@ moved and recentered. If they aren't strange things happen." (save-excursion (if ledger-fold-on-reconcile (ledger-occur-mode account ledger-buf))) - (ledger-reconcile-refresh) - (goto-char (point-min)) - (ledger-reconcile-change-target) + (if (> (ledger-reconcile-refresh) 0) + (ledger-reconcile-change-target)) (ledger-display-balance)))) (defvar ledger-reconcile-mode-abbrev-table) -- cgit v1.2.3 From f89665ba44ae50f056363d7e2c79a508060e2d18 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 14 Mar 2013 11:37:12 -0700 Subject: Reconcile code cleanup --- lisp/ldg-reconcile.el | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index ec4b7f88..c5e20c64 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -148,13 +148,11 @@ And calculate the target-delta of the account being reconciled." "Force the reconciliation window to refresh. Return the number of uncleared xacts found." (interactive) - (let ((inhibit-read-only t) - (line (count-lines (point-min) (point)))) + (let ((inhibit-read-only t)) (erase-buffer) (prog1 (ledger-do-reconcile) (set-buffer-modified-p t) - (goto-char (point-min)) - (forward-line line)))) + (goto-char (point-min))))) (defun ledger-reconcile-refresh-after-save () "Refresh the recon-window after the ledger buffer is saved." -- cgit v1.2.3 From 4c9b8cb9906ed86d3301c2fe1c8dbdf1498cd2cf Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 14 Mar 2013 11:38:32 -0700 Subject: Auto is now correctly scanning a ledger-auto buffer and returning useable functions --- lisp/ldg-auto.el | 47 ++++++++++++++++++++++++++++------------------- 1 file changed, 28 insertions(+), 19 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-auto.el b/lisp/ldg-auto.el index 12832a4e..33a2cdba 100644 --- a/lisp/ldg-auto.el +++ b/lisp/ldg-auto.el @@ -21,8 +21,8 @@ ;;; Commentary: ;; -;; This module provides or automatically adding transactions to a -;; ledger buffer on a periodic basis. h Recurrence expressions are +;; This module provides for automatically adding transactions to a +;; ledger buffer on a periodic basis. Recurrence expressions are ;; inspired by Martin Fowler's "Recurring Events for Calendars", ;; martinfowler.com/apsupp/recurring.pdf @@ -92,15 +92,14 @@ of date." ;; of days are ok (between (eval day) 1 (ledger-auto-days-in-month (eval month) (eval year)))) (between (eval day) 1 31)) ;; no month specified, assume 31 days. - `#'(lambda (date) - (and ,(if (eval year) - `(if (eq (nth 5 (decode-time date)) ,(eval year)) t) - `t) - ,(if (eval month) - `(if (eq (nth 4 (decode-time date)) ,(eval month)) t) - `t) - ,(if (eval day) - `(if (eq (nth 3 (decode-time date)) ,(eval day)) t)))) + `'(and ,(if (eval year) + `(if (eq (nth 5 (decode-time date)) ,(eval year)) t) + `t) + ,(if (eval month) + `(if (eq (nth 4 (decode-time date)) ,(eval month)) t) + `t) + ,(if (eval day) + `(if (eq (nth 3 (decode-time date)) ,(eval day)) t))) (error "ledger-auto-constraint-numerical-date-macro: date out of range %S %S %S" (eval year) (eval month) (eval day)))) @@ -155,6 +154,15 @@ For example every second Friday, regardless of month." (setq xact-list (cons transaction xact-list)))) xact-list))) +(defun ledger-auto-replace-brackets () + "Replace all brackets with parens" + (goto-char (point-min)) + (while (search-forward "]" nil t) + (replace-match ")" nil t)) + (goto-char (point-min)) + (while (search-forward "[" nil t) + (replace-match "(" nil t))) + (defun ledger-auto-read-descriptor-tree (descriptor-string) "Take a date descriptor string and return a function that returns true if the date meets the requirements" @@ -163,16 +171,14 @@ returns true if the date meets the requirements" (let (pos) ;; Replace brackets with parens (insert descriptor-string) - (goto-char (point-min)) - (replace-string "[" "(") - (goto-char (point-min)) - (replace-string "]" ")") + (ledger-auto-replace-brackets) + (goto-char (point-max)) ;; double quote all the descriptors for string processing later (while (re-search-backward (concat "\\(20[0-9][0-9]\\|[\*]\\)[/\\-]" ;; Year slot - "\\([\*EO]\\|[0-9]+\\)[/\\-]" ;; Month slot - "\\([\*]\\|\\([0-9][0-9]\\)\\|" + "\\([\*EO]\\|[01][0-9]\\)[/\\-]" ;; Month slot + "\\([\*]\\|\\([0-3][0-9]\\)\\|" "\\([0-5]" "\\(\\(Su\\)\\|" "\\(Mo\\)\\|" @@ -193,17 +199,20 @@ returns true if the date meets the requirements" (read (buffer-substring (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." +;; use funcall to use the lambda function spit out here (if (consp tree) (let (result) (while (consp tree) (let ((newcar (car tree))) - (if (consp (car tree)) + (if (consp newcar) (setq newcar (ledger-transform-auto-tree (car tree)))) (if (consp newcar) (push newcar result) (push (ledger-auto-parse-date-descriptor newcar) result)) ) (setq tree (cdr tree))) - (nconc (nreverse result) tree)))) + `(lambda (date) + ,(nconc (list 'or) (nreverse result) tree))))) (defun ledger-auto-split-constraints (descriptor-string) "Return a list with the year, month and day fields split" -- cgit v1.2.3 From 720a73dec30fbab08f5233894b879d1fb26083c8 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 16 Mar 2013 21:52:54 -0700 Subject: Finally got rid of ledger-post-deafult-account-indent string. --- lisp/ldg-post.el | 4 ---- 1 file changed, 4 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index e23b3135..c871df28 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -27,10 +27,6 @@ ;;; Code: -(defcustom ledger-default-acct-transaction-indent " " - "Default indentation for account transactions in an entry." - :type 'string - :group 'ledger-post) (defgroup ledger-post nil "Options for controlling how Ledger-mode deals with postings and completion" :group 'ledger) -- cgit v1.2.3 From c2999a70f237cbdf8f666d80c4468898d94fd6ec Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 16 Mar 2013 21:55:09 -0700 Subject: Starting on forecast handling for the auto mode --- lisp/ldg-auto.el | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) (limited to 'lisp') diff --git a/lisp/ldg-auto.el b/lisp/ldg-auto.el index 33a2cdba..2a1a5b11 100644 --- a/lisp/ldg-auto.el +++ b/lisp/ldg-auto.el @@ -30,6 +30,16 @@ ;; function slot of the symbol VARNAME. Then use VARNAME as the ;; function without have to use funcall. +(defgroup ledger-auto nil + "Support for automatically recommendation transactions." + :group 'ledger) + +(defcustom ledger-auto-look-forward 14 + "Number of days auto look forward to recommend transactions" + :type 'integer + :group 'ledger-auto) + + (defsubst between (val low high) (and (>= val low) (<= val high))) @@ -132,6 +142,9 @@ For example every second Friday, regardless of month." "Return true if DATE is a holiday.") (defun ledger-auto-scan-transactions (auto-file) + "Scans AUTO_FILE and returns a list of transactions with date predicates. +The car of each item is a fuction of date that returns true if +the transaction should be logged for that day." (interactive "fFile name: ") (let ((xact-list (list))) (with-current-buffer @@ -211,6 +224,8 @@ returns true if the date meets the requirements" (push newcar result) (push (ledger-auto-parse-date-descriptor newcar) result)) ) (setq tree (cdr tree))) + + ;; tie up all the clauses in a big or and lambda `(lambda (date) ,(nconc (list 'or) (nreverse result) tree))))) @@ -248,6 +263,26 @@ returns true if the date meets the requirements" (ledger-auto-compile-constraints (ledger-auto-split-constraints descriptor))) + + +;; +;; Test harnesses for use in ielm +;; +(defvar auto-items) + +(defun ledger-auto-test-setup () + (setq auto-items + (ledger-auto-scan-transactions "~/FinanceData/ledger-auto.ledger"))) + + +(defun ledger-auto-test-predict () + (let ((today (current-time)) + test-date) + + (loop for day from 0 to ledger-auto-look-forward by 1 do + (setq test-date (time-add today (days-to-time day))) + (message "date: %S" (decode-time test-date))))) + (provide 'ldg-auto) ;;; ldg-auto.el ends here -- cgit v1.2.3 From b1c2c49709c9f2e9a2c0bb715a2e599094483498 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 17 Mar 2013 19:56:02 -0700 Subject: Fix bug 917 C-Begin C-End don't keep buffer synced --- lisp/ldg-reconcile.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index c5e20c64..a2c13917 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -344,7 +344,9 @@ moved and recentered. If they aren't strange things happen." (if (member this-command (list 'next-line 'previous-line 'mouse-set-point - 'ledger-reconcile-toggle)) + 'ledger-reconcile-toggle + 'end-of-buffer + 'beginning-of-buffer)) (if ledger-buffer-tracks-reconcile-buffer (save-excursion (ledger-reconcile-visit t))))) -- cgit v1.2.3 From 431d7e5b25f7e2997494ace7a0be78492c5d688b Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 17 Mar 2013 20:01:58 -0700 Subject: Fix bug 915 Save in reconcile mode maintains point. --- lisp/ldg-reconcile.el | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index a2c13917..40795ca2 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -205,11 +205,13 @@ Return the number of uncleared xacts found." (defun ledger-reconcile-save () "Save the ledger buffer." (interactive) - (dolist (buf (cons ledger-buf ledger-bufs)) - (with-current-buffer buf - (save-buffer))) - (set-buffer-modified-p nil) - (ledger-display-balance)) + (let ((curpoint (point))) + (dolist (buf (cons ledger-buf ledger-bufs)) + (with-current-buffer buf + (save-buffer))) + (set-buffer-modified-p nil) + (ledger-display-balance) + (goto-char curpoint))) (defun ledger-reconcile-finish () "Mark all pending posting or transactions as cleared. -- 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') 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 8d73979abf87e3910bd040fb4b549b7d4c98a8c2 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 18 Mar 2013 11:13:54 -0700 Subject: Updated ledger-mode-dump-variables --- lisp/ldg-new.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index a9c70ff4..c42e2ef8 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -92,7 +92,8 @@ (forward-line 1)))))) (defun ledger-dump-variable (var) - (insert (format "%s: %S\n" (symbol-name var) (eval var)))) + (if var + (insert (format "%s: %S\n" (symbol-name var) (eval var))))) (defun ledger-mode-dump-variables () (interactive) @@ -103,7 +104,6 @@ (insert "Emacs: " (version) "\n") (insert "System Configuration: "system-configuration "\n") (insert "ldg-commodities:\n") - (ledger-dump-variable 'ledger-use-decimal-comma) (ledger-dump-variable 'ledger-reconcile-default-commodity) (insert "ldg-exec:\n") (ledger-dump-variable 'ledger-works) @@ -114,10 +114,10 @@ (ledger-dump-variable 'ledger-occur-history) (ledger-dump-variable 'ledger-occur-last-match) (insert "ldg-post:\n") - (ledger-dump-variable 'ledger-post-auto-adjust-amounts) + (ledger-dump-variable 'ledger-post-auto-adjust-postings) + (ledger-dump-variable 'ledger-post-account-alignment-column) (ledger-dump-variable 'ledger-post-amount-alignment-column) - (ledger-dump-variable 'ledger-post-use-iswitchb) - (ledger-dump-variable 'ledger-post-use-ido) + (ledger-dump-variable 'ledger-post-use-completion-engine) (insert "ldg-reconcile:\n") (ledger-dump-variable 'ledger-recon-buffer-name) (ledger-dump-variable 'ledger-fold-on-reconcile) -- cgit v1.2.3 From adfd6bafc3e276b1e7266cf03e7ab54ac70f3f90 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 18 Mar 2013 15:01:35 -0700 Subject: Have a working candidate search --- lisp/ldg-auto.el | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-auto.el b/lisp/ldg-auto.el index 2a1a5b11..ffc6ee7d 100644 --- a/lisp/ldg-auto.el +++ b/lisp/ldg-auto.el @@ -264,7 +264,16 @@ returns true if the date meets the requirements" (ledger-auto-split-constraints descriptor))) - +(defun ledger-auto-list-upcoming-xacts (candidate-items early horizon) + "Search CANDIDATE-ITEMS for xacts that occur within the perios today - EARLY to today + HORIZON" + (let ((start-date (time-subtract (current-time) (days-to-time early))) + test-date items) + (loop for day from 0 to (+ early horizon) by 1 do + (setq test-date (time-add start-date (days-to-time day))) + (dolist (candidate candidate-items items) + (if (funcall (car candidate) test-date) + (setq items (append items (list test-date (cdr candidate))))))) + items)) ;; ;; Test harnesses for use in ielm ;; @@ -277,11 +286,15 @@ returns true if the date meets the requirements" (defun ledger-auto-test-predict () (let ((today (current-time)) - test-date) + test-date items) (loop for day from 0 to ledger-auto-look-forward by 1 do (setq test-date (time-add today (days-to-time day))) - (message "date: %S" (decode-time test-date))))) + ;;(message "date: %S" (decode-time test-date)) + (dolist (item auto-items items) + (if (funcall (car item) test-date) + (setq items (append items (list (decode-time test-date) (cdr item))))))) + items)) (provide 'ldg-auto) -- cgit v1.2.3 From 5df242424ab507ca51b7b98c85cde594549510c6 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 18 Mar 2013 15:05:54 -0700 Subject: Bug 916: Added back in old ledger-post-align-amount code for Thierry. --- lisp/ldg-post.el | 49 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index c871df28..d37b2f51 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -173,6 +173,55 @@ the account" (goto-char (1+ (line-end-position))) (ledger-post-align-postings))) +;; +;; This is the orignal ledger align amount code it does not attempt to format accounts +;; + + +(defun ledger-align-amounts (&optional column) + "Align amounts and accounts in the current region. +This is done so that the last digit falls in COLUMN, which +defaults to 52. ledger-default-acct-transaction-indent positions +the account" + (interactive "p") + (if (or (null column) (= column 1)) + (setq column ledger-post-amount-alignment-column)) + (save-excursion + ;; Position the account + ;; (beginning-of-line) + (set-mark (point)) + ;; (delete-horizontal-space) + ;; (insert ledger-default-acct-transaction-indent) + (goto-char (1+ (line-end-position))) + (let* ((mark-first (< (mark) (point))) + (begin (if mark-first (mark) (point))) + (end (if mark-first (point-marker) (mark-marker))) + offset) + ;; Position the amount + (goto-char begin) + (while (setq offset (ledger-next-amount end)) + (let ((col (current-column)) + (target-col (- column offset)) + adjust) + (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 " "))) + (forward-line)))))) + +(defun ledger-post-align-amount () + "Align the amounts in this posting." + (interactive) + (save-excursion + (set-mark (line-beginning-position)) + (goto-char (1+ (line-end-position))) + (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." -- cgit v1.2.3 From 5b7186ee1fd99e547b6a9f062f155a1a8050e9c3 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 18 Mar 2013 15:22:41 -0700 Subject: Ensure the ledger but tracks the reconcile buffer after a save. --- lisp/ldg-reconcile.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 40795ca2..511f8f70 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -209,9 +209,11 @@ Return the number of uncleared xacts found." (dolist (buf (cons ledger-buf ledger-bufs)) (with-current-buffer buf (save-buffer))) - (set-buffer-modified-p nil) - (ledger-display-balance) - (goto-char curpoint))) + (with-current-buffer (get-buffer ledger-recon-buffer-name) + (set-buffer-modified-p nil) + (ledger-display-balance) + (goto-char curpoint) + (ledger-reconcile-visit t)))) (defun ledger-reconcile-finish () "Mark all pending posting or transactions as cleared. -- cgit v1.2.3 From 06579c504d051f9609e7377ae7db4f451bdb44b7 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 19 Mar 2013 09:16:07 -0700 Subject: Check 'auto' package name to 'schedule' --- lisp/ldg-auto.el | 301 ------------------------------------------------------- 1 file changed, 301 deletions(-) delete mode 100644 lisp/ldg-auto.el (limited to 'lisp') diff --git a/lisp/ldg-auto.el b/lisp/ldg-auto.el deleted file mode 100644 index ffc6ee7d..00000000 --- a/lisp/ldg-auto.el +++ /dev/null @@ -1,301 +0,0 @@ -;;; ldg-auto.el --- Helper code for use with the "ledger" command-line tool - -;; Copyright (C) 2013 Craig Earls (enderw88 at gmail dot com) - -;; 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: -;; -;; This module provides for automatically adding transactions to a -;; ledger buffer on a periodic basis. Recurrence expressions are -;; inspired by Martin Fowler's "Recurring Events for Calendars", -;; martinfowler.com/apsupp/recurring.pdf - -;; use (fset 'VARNAME (macro args)) to put the macro definition in the -;; function slot of the symbol VARNAME. Then use VARNAME as the -;; function without have to use funcall. - -(defgroup ledger-auto nil - "Support for automatically recommendation transactions." - :group 'ledger) - -(defcustom ledger-auto-look-forward 14 - "Number of days auto look forward to recommend transactions" - :type 'integer - :group 'ledger-auto) - - -(defsubst between (val low high) - (and (>= val low) (<= val high))) - -(defun ledger-auto-days-in-month (month year) - "Return number of days in the MONTH, MONTH is from 1 to 12. -If year is nil, assume it is not a leap year" - (if (between month 1 12) - (if (and year (date-leap-year-p year) (= 2 month)) - 29 - (nth (1- month) '(31 28 31 30 31 30 31 31 30 31 30 31))) - (error "Month out of range, MONTH=%S" month))) - -;; Macros to handle date expressions - -(defmacro ledger-auto-constrain-day-in-month-macro (count day-of-week) - "Return a form that evaluates DATE that returns true for the COUNT DAY-OF-WEEK. -For example, return true if date is the 3rd Thursday of the -month. Negative COUNT starts from the end of the month. (EQ -COUNT 0) means EVERY day-of-week (eg. every Saturday)" - (if (and (between count -6 6) (between day-of-week 0 6)) - (cond ((zerop count) ;; Return true if day-of-week matches - `(eq (nth 6 (decode-time date)) ,day-of-week)) - ((> count 0) ;; Positive count - (let ((decoded (gensym))) - `(let ((,decoded (decode-time date))) - (if (and (eq (nth 6 ,decoded) ,day-of-week) - (between (nth 3 ,decoded) - ,(* (1- count) 7) - ,(* count 7))) - t - nil)))) - ((< count 0) - (let ((days-in-month (gensym)) - (decoded (gensym))) - `(let* ((,decoded (decode-time date)) - (,days-in-month (ledger-auto-days-in-month - (nth 4 ,decoded) - (nth 5 ,decoded)))) - (if (and (eq (nth 6 ,decoded) ,day-of-week) - (between (nth 3 ,decoded) - (+ ,days-in-month ,(* count 7)) - (+ ,days-in-month ,(* (1+ count) 7)))) - t - nil)))) - (t - (error "COUNT out of range, COUNT=%S" count))) - (error "Invalid argument to ledger-auto-day-in-month-macro %S %S" - count - day-of-week))) - -(defmacro ledger-auto-constrain-numerical-date-macro (year month day) - "Return a function of date that is only true if all constraints are met. -A nil constraint matches any input, a numerical entry must match that field -of date." - ;; Do bounds checking to make sure the incoming date constraint is sane - (if - (if (eval month) ;; if we have a month - (and (between (eval month) 1 12) ;; make sure it is between 1 - ;; and twelve and the number - ;; of days are ok - (between (eval day) 1 (ledger-auto-days-in-month (eval month) (eval year)))) - (between (eval day) 1 31)) ;; no month specified, assume 31 days. - `'(and ,(if (eval year) - `(if (eq (nth 5 (decode-time date)) ,(eval year)) t) - `t) - ,(if (eval month) - `(if (eq (nth 4 (decode-time date)) ,(eval month)) t) - `t) - ,(if (eval day) - `(if (eq (nth 3 (decode-time date)) ,(eval day)) t))) - (error "ledger-auto-constraint-numerical-date-macro: date out of range %S %S %S" (eval year) (eval month) (eval day)))) - - - -(defmacro ledger-auto-constrain-every-count-day-macro (day-of-week skip start-date) - "Return a form that is true for every DAY skipping SKIP, starting on START. -For example every second Friday, regardless of month." - (let ((start-day (nth 6 (decode-time (eval start-date))))) - (if (eq start-day day-of-week) ;; good, can proceed - `(if (zerop (mod (- (time-to-days date) ,(time-to-days (eval start-date))) ,(* skip 7))) - t - nil) - (error "START-DATE day of week doesn't match DAY-OF-WEEK")))) - -(defmacro ledger-auto-constrain-date-range-macro (month1 day1 month2 day2) - "Return a form of DATE that is true if DATE falls between MONTH1 DAY1 and MONTH2 DAY2." - (let ((decoded (gensym)) - (target-month (gensym)) - (target-day (gensym))) - `(let* ((,decoded (decode-time date)) - (,target-month (nth 4 decoded)) - (,target-day (nth 3 decoded))) - (and (and (> ,target-month ,month1) - (< ,target-month ,month2)) - (and (> ,target-day ,day1) - (< ,target-day ,day2)))))) - - -(defun ledger-auto-is-holiday (date) - "Return true if DATE is a holiday.") - -(defun ledger-auto-scan-transactions (auto-file) - "Scans AUTO_FILE and returns a list of transactions with date predicates. -The car of each item is a fuction of date that returns true if -the transaction should be logged for that day." - (interactive "fFile name: ") - (let ((xact-list (list))) - (with-current-buffer - (find-file-noselect auto-file) - (goto-char (point-min)) - (while (re-search-forward "^\\[\\(.*\\)\\] " nil t) - (let ((date-descriptor "") - (transaction nil) - (xact-start (match-end 0))) - (setq date-descriptors - (ledger-auto-read-descriptor-tree - (buffer-substring-no-properties - (match-beginning 0) - (match-end 0)))) - (forward-paragraph) - (setq transaction (list date-descriptors - (buffer-substring-no-properties - xact-start - (point)))) - (setq xact-list (cons transaction xact-list)))) - xact-list))) - -(defun ledger-auto-replace-brackets () - "Replace all brackets with parens" - (goto-char (point-min)) - (while (search-forward "]" nil t) - (replace-match ")" nil t)) - (goto-char (point-min)) - (while (search-forward "[" nil t) - (replace-match "(" nil t))) - -(defun ledger-auto-read-descriptor-tree (descriptor-string) - "Take a date descriptor string and return a function that -returns true if the date meets the requirements" - (with-temp-buffer - ;; copy the descriptor string into a temp buffer for manipulation - (let (pos) - ;; Replace brackets with parens - (insert descriptor-string) - (ledger-auto-replace-brackets) - - (goto-char (point-max)) - ;; double quote all the descriptors for string processing later - (while (re-search-backward - (concat "\\(20[0-9][0-9]\\|[\*]\\)[/\\-]" ;; Year slot - "\\([\*EO]\\|[01][0-9]\\)[/\\-]" ;; Month slot - "\\([\*]\\|\\([0-3][0-9]\\)\\|" - "\\([0-5]" - "\\(\\(Su\\)\\|" - "\\(Mo\\)\\|" - "\\(Tu\\)\\|" - "\\(We\\)\\|" - "\\(Th\\)\\|" - "\\(Fr\\)\\|" - "\\(Sa\\)\\)\\)\\)") nil t) ;; Day slot - (goto-char - (match-end 0)) - (insert ?\") - (goto-char (match-beginning 0)) - (insert "\"" ))) - - ;; 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)))))) - -(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." -;; use funcall to use the lambda function spit out here - (if (consp tree) - (let (result) - (while (consp tree) - (let ((newcar (car tree))) - (if (consp newcar) - (setq newcar (ledger-transform-auto-tree (car tree)))) - (if (consp newcar) - (push newcar result) - (push (ledger-auto-parse-date-descriptor newcar) result)) ) - (setq tree (cdr tree))) - - ;; tie up all the clauses in a big or and lambda - `(lambda (date) - ,(nconc (list 'or) (nreverse result) tree))))) - -(defun ledger-auto-split-constraints (descriptor-string) - "Return a list with the year, month and day fields split" - (let ((fields (split-string descriptor-string "[/\\-]" t)) - constrain-year constrain-month constrain-day) - (if (string= (car fields) "*") - (setq constrain-year nil) - (setq constrain-year (car fields))) - (if (string= (cadr fields) "*") - (setq constrain-month nil) - (setq constrain-month (cadr fields))) - (if (string= (nth 2 fields) "*") - (setq constrain-day nil) - (setq constrain-day (nth 2 fields))) - (list constrain-year constrain-month constrain-day))) - -(defun ledger-string-to-number-or-nil (str) - (if str - (string-to-number str) - nil)) - -(defun ledger-auto-compile-constraints (constraint-list) - (let ((year-constraint (ledger-string-to-number-or-nil (nth 0 constraint-list))) - (month-constraint (ledger-string-to-number-or-nil (nth 1 constraint-list))) - (day-constraint (ledger-string-to-number-or-nil (nth 2 constraint-list)))) - (ledger-auto-constrain-numerical-date-macro - year-constraint - month-constraint - day-constraint))) - -(defun ledger-auto-parse-date-descriptor (descriptor) - "Parse the date descriptor, return the evaluator" - (ledger-auto-compile-constraints - (ledger-auto-split-constraints descriptor))) - - -(defun ledger-auto-list-upcoming-xacts (candidate-items early horizon) - "Search CANDIDATE-ITEMS for xacts that occur within the perios today - EARLY to today + HORIZON" - (let ((start-date (time-subtract (current-time) (days-to-time early))) - test-date items) - (loop for day from 0 to (+ early horizon) by 1 do - (setq test-date (time-add start-date (days-to-time day))) - (dolist (candidate candidate-items items) - (if (funcall (car candidate) test-date) - (setq items (append items (list test-date (cdr candidate))))))) - items)) -;; -;; Test harnesses for use in ielm -;; -(defvar auto-items) - -(defun ledger-auto-test-setup () - (setq auto-items - (ledger-auto-scan-transactions "~/FinanceData/ledger-auto.ledger"))) - - -(defun ledger-auto-test-predict () - (let ((today (current-time)) - test-date items) - - (loop for day from 0 to ledger-auto-look-forward by 1 do - (setq test-date (time-add today (days-to-time day))) - ;;(message "date: %S" (decode-time test-date)) - (dolist (item auto-items items) - (if (funcall (car item) test-date) - (setq items (append items (list (decode-time test-date) (cdr item))))))) - items)) - -(provide 'ldg-auto) - -;;; ldg-auto.el ends here -- cgit v1.2.3 From 17496feda0452bc7add76252534f6239722d3bed Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 19 Mar 2013 09:17:06 -0700 Subject: Initial commit of ldg-schedule.el. Changed name from leg-auto.el and renamed internal functions --- lisp/ldg-schedule.el | 314 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 314 insertions(+) create mode 100644 lisp/ldg-schedule.el (limited to 'lisp') diff --git a/lisp/ldg-schedule.el b/lisp/ldg-schedule.el new file mode 100644 index 00000000..b6b94308 --- /dev/null +++ b/lisp/ldg-schedule.el @@ -0,0 +1,314 @@ +;;; ldg-schedule.el --- Helper code for use with the "ledger" command-line tool + +;; Copyright (C) 2013 Craig Earls (enderw88 at gmail dot com) + +;; 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: +;; +;; This module provides for automatically adding transactions to a +;; ledger buffer on a periodic basis. Recurrence expressions are +;; inspired by Martin Fowler's "Recurring Events for Calendars", +;; martinfowler.com/apsupp/recurring.pdf + +;; use (fset 'VARNAME (macro args)) to put the macro definition in the +;; function slot of the symbol VARNAME. Then use VARNAME as the +;; function without have to use funcall. + +(defgroup ledger-schedule nil + "Support for automatically recommendation transactions." + :group 'ledger) + +(defcustom ledger-schedule-look-forward 14 + "Number of days auto look forward to recommend transactions" + :type 'integer + :group 'ledger-schedule) + +(defcustom ledger-schedule-file "ledger-schedule.ledger" + "File to find scheduled transactions." + :type 'file + :group 'ledger-schedule) +(defsubst between (val low high) + (and (>= val low) (<= val high))) + +(defun ledger-schedule-days-in-month (month year) + "Return number of days in the MONTH, MONTH is from 1 to 12. +If year is nil, assume it is not a leap year" + (if (between month 1 12) + (if (and year (date-leap-year-p year) (= 2 month)) + 29 + (nth (1- month) '(31 28 31 30 31 30 31 31 30 31 30 31))) + (error "Month out of range, MONTH=%S" month))) + +;; Macros to handle date expressions + +(defmacro ledger-schedule-constrain-day-in-month-macro (count day-of-week) + "Return a form that evaluates DATE that returns true for the COUNT DAY-OF-WEEK. +For example, return true if date is the 3rd Thursday of the +month. Negative COUNT starts from the end of the month. (EQ +COUNT 0) means EVERY day-of-week (eg. every Saturday)" + (if (and (between count -6 6) (between day-of-week 0 6)) + (cond ((zerop count) ;; Return true if day-of-week matches + `(eq (nth 6 (decode-time date)) ,day-of-week)) + ((> count 0) ;; Positive count + (let ((decoded (gensym))) + `(let ((,decoded (decode-time date))) + (if (and (eq (nth 6 ,decoded) ,day-of-week) + (between (nth 3 ,decoded) + ,(* (1- count) 7) + ,(* count 7))) + t + nil)))) + ((< count 0) + (let ((days-in-month (gensym)) + (decoded (gensym))) + `(let* ((,decoded (decode-time date)) + (,days-in-month (ledger-schedule-days-in-month + (nth 4 ,decoded) + (nth 5 ,decoded)))) + (if (and (eq (nth 6 ,decoded) ,day-of-week) + (between (nth 3 ,decoded) + (+ ,days-in-month ,(* count 7)) + (+ ,days-in-month ,(* (1+ count) 7)))) + t + nil)))) + (t + (error "COUNT out of range, COUNT=%S" count))) + (error "Invalid argument to ledger-schedule-day-in-month-macro %S %S" + count + day-of-week))) + +(defmacro ledger-schedule-constrain-numerical-date-macro (year month day) + "Return a function of date that is only true if all constraints are met. +A nil constraint matches any input, a numerical entry must match that field +of date." + ;; Do bounds checking to make sure the incoming date constraint is sane + (if + (if (eval month) ;; if we have a month + (and (between (eval month) 1 12) ;; make sure it is between 1 + ;; and twelve and the number + ;; of days are ok + (between (eval day) 1 (ledger-schedule-days-in-month (eval month) (eval year)))) + (between (eval day) 1 31)) ;; no month specified, assume 31 days. + `'(and ,(if (eval year) + `(if (eq (nth 5 (decode-time date)) ,(eval year)) t) + `t) + ,(if (eval month) + `(if (eq (nth 4 (decode-time date)) ,(eval month)) t) + `t) + ,(if (eval day) + `(if (eq (nth 3 (decode-time date)) ,(eval day)) t))) + (error "ledger-schedule-constraint-numerical-date-macro: date out of range %S %S %S" (eval year) (eval month) (eval day)))) + + + +(defmacro ledger-schedule-constrain-every-count-day-macro (day-of-week skip start-date) + "Return a form that is true for every DAY skipping SKIP, starting on START. +For example every second Friday, regardless of month." + (let ((start-day (nth 6 (decode-time (eval start-date))))) + (if (eq start-day day-of-week) ;; good, can proceed + `(if (zerop (mod (- (time-to-days date) ,(time-to-days (eval start-date))) ,(* skip 7))) + t + nil) + (error "START-DATE day of week doesn't match DAY-OF-WEEK")))) + +(defmacro ledger-schedule-constrain-date-range-macro (month1 day1 month2 day2) + "Return a form of DATE that is true if DATE falls between MONTH1 DAY1 and MONTH2 DAY2." + (let ((decoded (gensym)) + (target-month (gensym)) + (target-day (gensym))) + `(let* ((,decoded (decode-time date)) + (,target-month (nth 4 decoded)) + (,target-day (nth 3 decoded))) + (and (and (> ,target-month ,month1) + (< ,target-month ,month2)) + (and (> ,target-day ,day1) + (< ,target-day ,day2)))))) + + +(defun ledger-schedule-is-holiday (date) + "Return true if DATE is a holiday.") + +(defun ledger-schedule-scan-transactions (auto-file) + "Scans AUTO_FILE and returns a list of transactions with date predicates. +The car of each item is a fuction of date that returns true if +the transaction should be logged for that day." + (interactive "fFile name: ") + (let ((xact-list (list))) + (with-current-buffer + (find-file-noselect auto-file) + (goto-char (point-min)) + (while (re-search-forward "^\\[\\(.*\\)\\] " nil t) + (let ((date-descriptor "") + (transaction nil) + (xact-start (match-end 0))) + (setq date-descriptors + (ledger-schedule-read-descriptor-tree + (buffer-substring-no-properties + (match-beginning 0) + (match-end 0)))) + (forward-paragraph) + (setq transaction (list date-descriptors + (buffer-substring-no-properties + xact-start + (point)))) + (setq xact-list (cons transaction xact-list)))) + xact-list))) + +(defun ledger-schedule-replace-brackets () + "Replace all brackets with parens" + (goto-char (point-min)) + (while (search-forward "]" nil t) + (replace-match ")" nil t)) + (goto-char (point-min)) + (while (search-forward "[" nil t) + (replace-match "(" nil t))) + +(defun ledger-schedule-read-descriptor-tree (descriptor-string) + "Take a date descriptor string and return a function that +returns true if the date meets the requirements" + (with-temp-buffer + ;; copy the descriptor string into a temp buffer for manipulation + (let (pos) + ;; Replace brackets with parens + (insert descriptor-string) + (ledger-schedule-replace-brackets) + + (goto-char (point-max)) + ;; double quote all the descriptors for string processing later + (while (re-search-backward + (concat "\\(20[0-9][0-9]\\|[\*]\\)[/\\-]" ;; Year slot + "\\([\*EO]\\|[01][0-9]\\)[/\\-]" ;; Month slot + "\\([\*]\\|\\([0-3][0-9]\\)\\|" + "\\([0-5]" + "\\(\\(Su\\)\\|" + "\\(Mo\\)\\|" + "\\(Tu\\)\\|" + "\\(We\\)\\|" + "\\(Th\\)\\|" + "\\(Fr\\)\\|" + "\\(Sa\\)\\)\\)\\)") nil t) ;; Day slot + (goto-char + (match-end 0)) + (insert ?\") + (goto-char (match-beginning 0)) + (insert "\"" ))) + + ;; 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)))))) + +(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." +;; use funcall to use the lambda function spit out here + (if (consp tree) + (let (result) + (while (consp tree) + (let ((newcar (car tree))) + (if (consp newcar) + (setq newcar (ledger-transform-auto-tree (car tree)))) + (if (consp newcar) + (push newcar result) + (push (ledger-schedule-parse-date-descriptor newcar) result)) ) + (setq tree (cdr tree))) + + ;; tie up all the clauses in a big or and lambda + `(lambda (date) + ,(nconc (list 'or) (nreverse result) tree))))) + +(defun ledger-schedule-split-constraints (descriptor-string) + "Return a list with the year, month and day fields split" + (let ((fields (split-string descriptor-string "[/\\-]" t)) + constrain-year constrain-month constrain-day) + (if (string= (car fields) "*") + (setq constrain-year nil) + (setq constrain-year (car fields))) + (if (string= (cadr fields) "*") + (setq constrain-month nil) + (setq constrain-month (cadr fields))) + (if (string= (nth 2 fields) "*") + (setq constrain-day nil) + (setq constrain-day (nth 2 fields))) + (list constrain-year constrain-month constrain-day))) + +(defun ledger-string-to-number-or-nil (str) + (if str + (string-to-number str) + nil)) + +(defun ledger-schedule-compile-constraints (constraint-list) + (let ((year-constraint (ledger-string-to-number-or-nil (nth 0 constraint-list))) + (month-constraint (ledger-string-to-number-or-nil (nth 1 constraint-list))) + (day-constraint (ledger-string-to-number-or-nil (nth 2 constraint-list)))) + (ledger-schedule-constrain-numerical-date-macro + year-constraint + month-constraint + day-constraint))) + +(defun ledger-schedule-parse-date-descriptor (descriptor) + "Parse the date descriptor, return the evaluator" + (ledger-schedule-compile-constraints + (ledger-schedule-split-constraints descriptor))) + + +(defun ledger-schedule-list-upcoming-xacts (candidate-items early horizon) + "Search CANDIDATE-ITEMS for xacts that occur within the perios today - EARLY to today + HORIZON" + (let ((start-date (time-subtract (current-time) (days-to-time early))) + test-date items) + (loop for day from 0 to (+ early horizon) by 1 do + (setq test-date (time-add start-date (days-to-time day))) + (dolist (candidate candidate-items items) + (if (funcall (car candidate) test-date) + (setq items (append items (list (list test-date (cadr candidate)))))))) + items)) + +(defun ledger-schedule-create-auto-buffer (candidate-items early horizon) + "Format CANDIDATE-ITEMS for display." + (let ((candidates (ledger-schedule-list-upcoming-xacts candidate-items early horizon)) + (auto-buf (get-buffer-create "*Ledger Auto*")) + (date-format (cdr (assoc "date-format" ledger-environment-alist)))) + (with-current-buffer auto-buf + (erase-buffer) + (dolist (candidate candidates) + (insert (format-time-string date-format (car candidate) ) " " (cadr candidate) "/n"))))) +;; +;; Test harnesses for use in ielm +;; +(defvar auto-items) + +(defun ledger-schedule-test-setup () + (setq auto-items + (ledger-schedule-scan-transactions "~/FinanceData/ledger-schedule.ledger"))) + + +(defun ledger-schedule-test-predict () + (let ((today (current-time)) + test-date items) + + (loop for day from 0 to ledger-schedule-look-forward by 1 do + (setq test-date (time-add today (days-to-time day))) + ;;(message "date: %S" (decode-time test-date)) + (dolist (item auto-items items) + (if (funcall (car item) test-date) + (setq items (append items (list (decode-time test-date) (cdr item))))))) + items)) + +(provide 'ldg-schedule) + +;;; ldg-schedule.el ends here -- cgit v1.2.3 From 7c6f9005922dc22b257b4acc9b6639f4c5589638 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 20 Mar 2013 12:23:18 -0700 Subject: Improved configuration dump. Now automatically dumps all customization variables without manually update --- lisp/ldg-new.el | 56 ++++++++++++++++---------------------------------------- 1 file changed, 16 insertions(+), 40 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index c42e2ef8..8ff95cd3 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -91,48 +91,24 @@ (delete-char 3) (forward-line 1)))))) -(defun ledger-dump-variable (var) +(defun ledger-mode-dump-variable (var) (if var - (insert (format "%s: %S\n" (symbol-name var) (eval var))))) - -(defun ledger-mode-dump-variables () - (interactive) - (find-file "ledger-mode-dump") - (delete-region (point-min) (point-max)) - (insert "Ledger Mode Configuration Dump\n") - (insert "Date: " (current-time-string) "\n") - (insert "Emacs: " (version) "\n") - (insert "System Configuration: "system-configuration "\n") - (insert "ldg-commodities:\n") - (ledger-dump-variable 'ledger-reconcile-default-commodity) - (insert "ldg-exec:\n") - (ledger-dump-variable 'ledger-works) - (ledger-dump-variable 'ledger-binary-path) - (insert "ldg-occur:\n") - (ledger-dump-variable 'ledger-occur-use-face-unfolded) - (ledger-dump-variable 'ledger-occur-mode) - (ledger-dump-variable 'ledger-occur-history) - (ledger-dump-variable 'ledger-occur-last-match) - (insert "ldg-post:\n") - (ledger-dump-variable 'ledger-post-auto-adjust-postings) - (ledger-dump-variable 'ledger-post-account-alignment-column) - (ledger-dump-variable 'ledger-post-amount-alignment-column) - (ledger-dump-variable 'ledger-post-use-completion-engine) - (insert "ldg-reconcile:\n") - (ledger-dump-variable 'ledger-recon-buffer-name) - (ledger-dump-variable 'ledger-fold-on-reconcile) - (ledger-dump-variable 'ledger-buffer-tracks-reconcile-buffer) - (ledger-dump-variable 'ledger-reconcile-force-window-bottom) - (ledger-dump-variable 'ledger-reconcile-toggle-to-pending) - (insert "ldg-reports:\n") - (ledger-dump-variable 'ledger-reports) - (ledger-dump-variable 'ledger-report-format-specifiers) - (ledger-dump-variable 'ledger-report-buffer-name) - (insert "ldg-state:") - (ledger-dump-variable 'ledger-clear-whole-transactions) - (insert "ldg-xact:\n") - (ledger-dump-variable 'ledger-highlight-xact-under-point)) + (insert (format " %s: %S\n" (symbol-name var) (eval var))))) +(defun ledger-mode-dump-group (group) + "Dump GROUP customizations to current buffer" + (let ((members (custom-group-members group nil))) + (dolist (member members) + (cond ((eq (cadr member) 'custom-group) + (insert (format "Group %s:\n" (symbol-name (car member)))) + (ledger-mode-dump-group (car member))) + ((eq (cadr member) 'custom-variable) + (ledger-mode-dump-variable (car member))))))) + +(defun ledger-mode-dump-configuration () + "Dump all customizations" + (find-file "ledger-mode-dump") + (ledger-mode-dump-group 'ledger)) (provide 'ledger) -- cgit v1.2.3 From 045c4b19eb626b814a889ec8b5e2e66ecee39cc6 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 20 Mar 2013 22:20:00 -0700 Subject: Added checking for thousands separators in commodity split. --- lisp/ldg-commodities.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index 9291136f..0ed52fc3 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -34,12 +34,14 @@ (defun ledger-split-commodity-string (str) "Split a commoditized amount into two parts" (if (> (length str) 0) - (let (val - comm) + (let (val comm number-regex) (with-temp-buffer (insert str) (goto-char (point-min)) - (cond ((re-search-forward "-?[1-9][0-9]*[.,][0-9]*" nil t) + (if (assoc "decimal-comma" ledger-environment-alist) + (setq number-regex "-?[1-9][0-9.]*[,][0-9]*") + (setq number-regex "-?[1-9][0-9,]*[.][0-9]*")) + (cond ((re-search-forward number-regex nil t) ;; found a decimal number (setq val (string-to-number -- cgit v1.2.3 From 75ba85ff8efc8226261203d7af063c9be3d0c034 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 20 Mar 2013 22:53:09 -0700 Subject: Updated ldg-schedule --- lisp/ldg-schedule.el | 41 ++++++++++++++++++++++++++++++----------- 1 file changed, 30 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-schedule.el b/lisp/ldg-schedule.el index b6b94308..c2e5ea01 100644 --- a/lisp/ldg-schedule.el +++ b/lisp/ldg-schedule.el @@ -32,17 +32,28 @@ (defgroup ledger-schedule nil "Support for automatically recommendation transactions." - :group 'ledger) + :group 'ledger) + +(defcustom ledger-schedule-buffer-name "*Ledger Schedule*" + "Name for the schedule buffer" + :type 'string + :group 'ledger-schedule) + +(defcustom ledger-schedule-look-backward 7 + "Number of days to look back in time for transactions." + :type 'integer + :group 'ledger-schedule) (defcustom ledger-schedule-look-forward 14 "Number of days auto look forward to recommend transactions" :type 'integer :group 'ledger-schedule) -(defcustom ledger-schedule-file "ledger-schedule.ledger" +(defcustom ledger-schedule-file "~/FinanceData/ledger-schedule.ledger" "File to find scheduled transactions." :type 'file :group 'ledger-schedule) + (defsubst between (val low high) (and (>= val low) (<= val high))) @@ -121,7 +132,7 @@ of date." "Return a form that is true for every DAY skipping SKIP, starting on START. For example every second Friday, regardless of month." (let ((start-day (nth 6 (decode-time (eval start-date))))) - (if (eq start-day day-of-week) ;; good, can proceed + (if (eq start-day day-of-week) ;; good, can proceed `(if (zerop (mod (- (time-to-days date) ,(time-to-days (eval start-date))) ,(* skip 7))) t nil) @@ -144,14 +155,14 @@ For example every second Friday, regardless of month." (defun ledger-schedule-is-holiday (date) "Return true if DATE is a holiday.") -(defun ledger-schedule-scan-transactions (auto-file) +(defun ledger-schedule-scan-transactions (schedule-file) "Scans AUTO_FILE and returns a list of transactions with date predicates. The car of each item is a fuction of date that returns true if the transaction should be logged for that day." (interactive "fFile name: ") (let ((xact-list (list))) (with-current-buffer - (find-file-noselect auto-file) + (find-file-noselect schedule-file) (goto-char (point-min)) (while (re-search-forward "^\\[\\(.*\\)\\] " nil t) (let ((date-descriptor "") @@ -268,7 +279,7 @@ returns true if the date meets the requirements" (defun ledger-schedule-list-upcoming-xacts (candidate-items early horizon) - "Search CANDIDATE-ITEMS for xacts that occur within the perios today - EARLY to today + HORIZON" + "Search CANDIDATE-ITEMS for xacts that occur within the period today - EARLY to today + HORIZON" (let ((start-date (time-subtract (current-time) (days-to-time early))) test-date items) (loop for day from 0 to (+ early horizon) by 1 do @@ -278,15 +289,23 @@ returns true if the date meets the requirements" (setq items (append items (list (list test-date (cadr candidate)))))))) items)) -(defun ledger-schedule-create-auto-buffer (candidate-items early horizon) +(defun ledger-schedule-already-entered (candidate buffer) + (let ((target-date (format-time-string date-format (car candidate))) + (target-payee (cadr candidate))) + nil)) + +(defun ledger-schedule-create-auto-buffer (candidate-items early horizon ledger-buf) "Format CANDIDATE-ITEMS for display." (let ((candidates (ledger-schedule-list-upcoming-xacts candidate-items early horizon)) - (auto-buf (get-buffer-create "*Ledger Auto*")) + (schedule-buf (get-buffer-create ledger-schedule-buffer-name)) (date-format (cdr (assoc "date-format" ledger-environment-alist)))) - (with-current-buffer auto-buf + (with-current-buffer schedule-buf (erase-buffer) (dolist (candidate candidates) - (insert (format-time-string date-format (car candidate) ) " " (cadr candidate) "/n"))))) + (if (not (ledger-schedule-already-entered candidate ledger-buf)) + (insert (format-time-string date-format (car candidate) ) " " (cadr candidate) "\n")))))) + + ;; ;; Test harnesses for use in ielm ;; @@ -294,7 +313,7 @@ returns true if the date meets the requirements" (defun ledger-schedule-test-setup () (setq auto-items - (ledger-schedule-scan-transactions "~/FinanceData/ledger-schedule.ledger"))) + (ledger-schedule-scan-transactions ledger-schedule-file))) (defun ledger-schedule-test-predict () -- cgit v1.2.3 From b73e650e5f9dd2f3b2c90f445b878258f1e994d0 Mon Sep 17 00:00:00 2001 From: Rémi Vanicat Date: Thu, 21 Mar 2013 23:28:14 +0100 Subject: Don't fail cleaning after reconcile when some buffer have been killed If buffer in leger-buf has been killed, ledger-reconcile-quit-cleanup will fail with an error. Better to do nothing. --- lisp/ldg-reconcile.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 511f8f70..662ef6c1 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -252,7 +252,7 @@ and exit reconcile mode" "Cleanup all hooks established by reconcile mode." (interactive) (let ((buf ledger-buf)) - (if buf + (if (buffer-live-p buf) (with-current-buffer buf (remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t) (if ledger-fold-on-reconcile -- cgit v1.2.3 From 0d9250dbe49b62e4e340d8ac8fee84b4e9bfa57d Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 22 Mar 2013 20:56:19 -0700 Subject: Fix bug 916 along amount in region --- lisp/ldg-mode.el | 1 + lisp/ldg-post.el | 66 +++++++++----------------------------------------------- lisp/ldg-sort.el | 2 +- 3 files changed, 12 insertions(+), 57 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 97662aa3..be825ddb 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -120,6 +120,7 @@ (define-key map [sort-start] '(menu-item "Mark Sort Beginning" ledger-sort-insert-start-mark)) (define-key map [sort-buff] '(menu-item "Sort Buffer" ledger-sort-buffer)) (define-key map [sort-reg] '(menu-item "Sort Region" ledger-sort-region :enable mark-active)) + (define-key map [align-reg] '(menu-item "Align Region" ledger-post-align-region :enable mark-active)) (define-key map [sep2] '(menu-item "--")) (define-key map [copy-xact] '(menu-item "Copy Trans at Point" ledger-copy-transaction)) (define-key map [toggle-post] '(menu-item "Toggle Current Posting" ledger-toggle-current)) diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index d37b2f51..3313c8e3 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -123,8 +123,8 @@ PROMPT is a string to prompt with. CHOICES is a list of (- (or (match-end 4) (match-end 3)) (point)))) -(defun ledger-post-align-postings (&optional column) - "Align amounts and accounts in the current region. +(defun ledger-post-align-posting (&optional column) + "Align amounts and accounts in the current posting. This is done so that the last digit falls in COLUMN, which defaults to 52. ledger-post-account-column positions the account" @@ -165,62 +165,16 @@ the account" (insert " "))) (forward-line)))))) -(defun ledger-post-align-posting () - "Align the amounts in this posting." - (interactive) - (save-excursion - (set-mark (line-beginning-position)) - (goto-char (1+ (line-end-position))) - (ledger-post-align-postings))) - -;; -;; This is the orignal ledger align amount code it does not attempt to format accounts -;; - -(defun ledger-align-amounts (&optional column) - "Align amounts and accounts in the current region. -This is done so that the last digit falls in COLUMN, which -defaults to 52. ledger-default-acct-transaction-indent positions -the account" - (interactive "p") - (if (or (null column) (= column 1)) - (setq column ledger-post-amount-alignment-column)) +(defun ledger-post-align-region (beg end) + (interactive "r") (save-excursion - ;; Position the account - ;; (beginning-of-line) - (set-mark (point)) - ;; (delete-horizontal-space) - ;; (insert ledger-default-acct-transaction-indent) - (goto-char (1+ (line-end-position))) - (let* ((mark-first (< (mark) (point))) - (begin (if mark-first (mark) (point))) - (end (if mark-first (point-marker) (mark-marker))) - offset) - ;; Position the amount - (goto-char begin) - (while (setq offset (ledger-next-amount end)) - (let ((col (current-column)) - (target-col (- column offset)) - adjust) - (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 " "))) - (forward-line)))))) + (goto-char beg) + (backward-paragraph) ;; make sure we are at the beginning of an xact + (while (< (point) end) + (ledger-post-align-posting) + (forward-line)))) -(defun ledger-post-align-amount () - "Align the amounts in this posting." - (interactive) - (save-excursion - (set-mark (line-beginning-position)) - (goto-char (1+ (line-end-position))) - (ledger-align-amounts))) (defun ledger-post-maybe-align (beg end len) "Align amounts only if point is in a posting. @@ -231,7 +185,7 @@ BEG, END, and LEN control how far it can align." (when (<= end (line-end-position)) (goto-char (line-beginning-position)) (if (looking-at ledger-post-line-regexp) - (ledger-post-align-postings)))))) + (ledger-post-align-posting)))))) (defun ledger-post-edit-amount () "Call 'calc-mode' and push the amount in the posting to the top of stack." diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el index 01d8edc9..3ce429fc 100644 --- a/lisp/ldg-sort.el +++ b/lisp/ldg-sort.el @@ -76,7 +76,7 @@ (new-end end)) (save-excursion (save-restriction - (goto-char beg) + (goto-char beg) (ledger-next-record-function) ;; make sure point is at the ;; beginning of a xact (setq new-beg (point)) -- cgit v1.2.3 From 9284600a54c8b4d37b63d25dd9e16dba664badbe Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 22 Mar 2013 21:23:27 -0700 Subject: Fix bug 915, maintain post in ledger buffer after save during reconciliation. --- lisp/ldg-reconcile.el | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 511f8f70..99958aaa 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -152,15 +152,20 @@ Return the number of uncleared xacts found." (erase-buffer) (prog1 (ledger-do-reconcile) (set-buffer-modified-p t) - (goto-char (point-min))))) + ;;(goto-char (point-min)) + ))) (defun ledger-reconcile-refresh-after-save () "Refresh the recon-window after the ledger buffer is saved." - (let ((buf (get-buffer ledger-recon-buffer-name))) + (let ((curbuf (current-buffer)) + (curpoint (point)) + (buf (get-buffer ledger-recon-buffer-name))) (if buf - (with-current-buffer buf - (ledger-reconcile-refresh) - (set-buffer-modified-p nil))))) + (progn + (with-current-buffer buf + (ledger-reconcile-refresh) + (set-buffer-modified-p nil)) + (select-window (get-buffer-window curbuf)))))) (defun ledger-reconcile-add () "Use ledger xact to add a new transaction." -- cgit v1.2.3 From 8a1d990809f3b1374d57d57783cc1dc2d7f841ea Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 23 Mar 2013 14:22:47 -0700 Subject: Fix Bug 929 consistent naming of buffer narrowing. --- doc/ledger-mode.texi | 20 ++++++++++---------- lisp/ldg-mode.el | 2 +- 2 files changed, 11 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/doc/ledger-mode.texi b/doc/ledger-mode.texi index 001eb054..7b62a735 100644 --- a/doc/ledger-mode.texi +++ b/doc/ledger-mode.texi @@ -128,7 +128,7 @@ Ledger from a convenient command line. * Quick Add:: * Reconciliation:: * Reports:: -* Folding:: +* Narrowing:: @end menu @node Quick Add, Reconciliation, Quick Demo, Quick Demo @@ -177,7 +177,7 @@ reach $0. End the reconciliation by typing @code{C-c C-c}. This saves the demo.ledger buffer and marks the transactions and finally cleared. Type @code{q} to close out the reconciliation buffer. -@node Reports, Folding, Reconciliation, Quick Demo +@node Reports, Narrowing, Reconciliation, Quick Demo @subsection Reports The real power of Ledger is in it reporting capabilities. Reports can @@ -197,8 +197,8 @@ Another built-in report is the balance report. In the report to run, type @code{bal}, and a balance report of all accounts will be shown. -@node Folding, , Reports, Quick Demo -@subsection Folding +@node Narrowing, , Reports, Quick Demo +@subsection Narrowing A ledger file can get very large. It can be helpful to collapse the buffer to display only the transactions you are interested in. Ledger-mode @@ -214,7 +214,7 @@ match the regex. The regex can be on any field, or amount. * Marking Transactions:: * Deleting Transactions:: * Sorting Transactions:: -* Hiding Transactions:: +* Narrowing Transactions:: @end menu @node Adding Transactions, Editing Amounts, The Ledger Buffer, The Ledger Buffer @@ -285,7 +285,7 @@ provides an easy way to delete the transaction under point: @code{C-c C-d}. The advantage to using this method is that the complete transaction operation is in the undo buffer. -@node Sorting Transactions, Hiding Transactions, Deleting Transactions, The Ledger Buffer +@node Sorting Transactions, Narrowing Transactions, Deleting Transactions, The Ledger Buffer @section Sorting Transactions As you operating on the Ledger files, they may become disorganized. For @@ -320,10 +320,10 @@ You can use menu entries to insert start and end markers. These functions will automatically delete old markers and put new new marker at point. -@node Hiding Transactions, , Sorting Transactions, The Ledger Buffer -@section Hiding Transactions +@node Narrowing Transactions, , Sorting Transactions, The Ledger Buffer +@section Narrowing Transactions -Often you will want to run Ledger register reports just to look at ax +Often you will want to run Ledger register reports just to look at a specific set of transactions. If you don't need the running total calculation handled by Ledger, Ledger-mode provides a rapid way of narrowing what is displayed in the buffer in a way that is simpler than @@ -363,7 +363,7 @@ C-f} again. * Starting a Reconciliation:: * Mark Transactions Pending:: * Edit Transactions During Reconciliation:: -* Finalize Reconciliation:: +* Finalize Reconciliation:: * Adding and Deleting Transactions during Reconciliation:: * Changing Reconciliation Account:: * Changing Reconciliation Target:: diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index be825ddb..c8a46d6b 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -135,7 +135,7 @@ (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)) - (define-key map [reconcile] '(menu-item "Hide Xacts" ledger-occur)))) + (define-key map [reconcile] '(menu-item "Narrow to REGEX" ledger-occur)))) (defun ledger-time-less-p (t1 t2) "Say whether time value T1 is less than time value T2." -- cgit v1.2.3 From 059b86b30e2ba65bb4cd7b7d1415831093cefdcc Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 23 Mar 2013 14:28:10 -0700 Subject: Fixed Bug 930 Toggle transaction menu entry incorrect --- lisp/ldg-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index c8a46d6b..8563030d 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -124,7 +124,7 @@ (define-key map [sep2] '(menu-item "--")) (define-key map [copy-xact] '(menu-item "Copy Trans at Point" ledger-copy-transaction)) (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 [toggle-xact] '(menu-item "Toggle Current Transaction" ledger-toggle-current-transaction)) (define-key map [sep4] '(menu-item "--")) (define-key map [edit-amount] '(menu-item "Reconcile Account" ledger-reconcile)) (define-key map [sep6] '(menu-item "--")) -- cgit v1.2.3 From 4cf6ca6e79b891acd65db869fbf8e6b27f61c588 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 23 Mar 2013 14:30:29 -0700 Subject: Bug 931 Menu consistency Delete Transaction --- lisp/ldg-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 8563030d..29f3fc09 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -130,7 +130,7 @@ (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)) + (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 [add-xact] '(menu-item "Add Transaction (ledger xact)" ledger-add-transaction :enable ledger-works)) (define-key map [sep3] '(menu-item "--")) -- cgit v1.2.3 From 99973d0c0c8ac95d2bf73df807df8da1356fe1c9 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 23 Mar 2013 19:54:40 -0700 Subject: Rewrote ledger-post-align-postings to address bugs 923 924 925 926 927 and 928. --- lisp/ldg-mode.el | 20 +++++++--- lisp/ldg-post.el | 111 +++++++++++++++++++++++++++++-------------------------- 2 files changed, 72 insertions(+), 59 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 29f3fc09..c900d3d3 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -41,9 +41,17 @@ (defun ledger-remove-overlays () "Remove all overlays from the ledger buffer." -(interactive) - "remove overlays formthe buffer, used if the buffer is reverted" - (remove-overlays)) + (interactive) + (remove-overlays)) + +(defun ledger-magic-tab () + "Decide what to with with . +Can be pcomplete, or align-posting" + (interactive) + (if (and (> (point) 1) + (looking-back "[:A-Za-z0-9]" 1)) + (pcomplete) + (ledger-post-align-postings))) (defvar ledger-mode-abbrev-table) @@ -70,7 +78,7 @@ (add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t) (add-hook 'before-revert-hook 'ledger-remove-overlays nil t) (make-variable-buffer-local 'highlight-overlay) - + (ledger-init-load-init-file) (let ((map (current-local-map))) @@ -86,8 +94,8 @@ (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 ?y)] 'ledger-set-year) - (define-key map [tab] 'pcomplete) - (define-key map [(control ?i)] 'pcomplete) + (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) (control ?o) (control ?r)] 'ledger-report) diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 3313c8e3..934e70a1 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -116,76 +116,81 @@ PROMPT is a string to prompt with. CHOICES is a list of (goto-char pos))) (defun ledger-next-amount (&optional end) - "Move point to the next amount, as long as it is not past END." + "Move point to the next amount, as long as it is not past END. +Return the width of the amount field as an integer." + (beginning-of-line) (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) (match-end 3)) (point)))) -(defun ledger-post-align-posting (&optional column) - "Align amounts and accounts in the current posting. -This is done so that the last digit falls in COLUMN, which -defaults to 52. ledger-post-account-column positions -the account" - (interactive "p") - (if (or (null column) (= column 1)) - (setq column ledger-post-amount-alignment-column)) +(defun ledger-next-account (&optional end) + "Move point to the beginning of the next account, or status marker (!*), as long as it is not past END. +Return the column of the beginning of the account" + (beginning-of-line) + (if (> (marker-position end) (point)) + (when (re-search-forward "\\(^[ ]+\\)\\([*!;a-zA-Z0-9]+?\\)" (marker-position end) t) + (goto-char (match-beginning 2)) + (current-column)))) + +(defun ledger-post-align-postings () + "Align all accounts and amounts within region, if there is no +region alight the posting on the current line." + (interactive) (save-excursion - ;; Position the account - (if (not (or (looking-at "[ \t]*[1-9]") - (and (looking-at "[ \t]+\n") - (looking-back "[ \n]" (- (point) 2))))) - (save-excursion - (beginning-of-line) - (set-mark (point)) - (delete-horizontal-space) - (insert (make-string ledger-post-account-alignment-column ? ))) - (set-mark (point))) - (set-mark (point)) - (goto-char (1+ (line-end-position))) + ;; If there is no region set + (when (or (not (mark)) + (= (point) (mark))) + (beginning-of-line) + (set-mark (point)) + (goto-char (1+ (line-end-position)))) + (let* ((mark-first (< (mark) (point))) (begin (if mark-first (mark) (point))) (end (if mark-first (point-marker) (mark-marker))) - offset) - ;; Position the amount + acc-col amt-offset) + (goto-char end) + (end-of-line) + (setq end (point-marker)) (goto-char begin) - (while (setq offset (ledger-next-amount end)) - (let ((col (current-column)) - (target-col (- column offset)) - adjust) - (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 " "))) - (forward-line)))))) - - -(defun ledger-post-align-region (beg end) - (interactive "r") - (save-excursion - (goto-char beg) - (backward-paragraph) ;; make sure we are at the beginning of an xact - (while (< (point) end) - (ledger-post-align-posting) - (forward-line)))) - + (beginning-of-line) + (setq begin (point-marker)) + (while (setq acc-col (ledger-next-account end)) + ;; Adjust account position if necessary + (let ((acc-adjust (- ledger-post-account-alignment-column acc-col))) + (if (/= acc-adjust 0) + (if (> acc-adjust 0) + (insert (make-string acc-adjust ? )) ;; Account too far left + (if (looking-back " " (- (point) 3)) + (delete-char acc-adjust) + (skip-chars-forward "^ \t") + (delete-horizontal-space) + (insert " "))))) + (when (setq amt-offset (ledger-next-amount end)) + (let* ((amt-adjust (- ledger-post-amount-alignment-column + amt-offset + (current-column)))) + (if (/= amt-adjust 0) + (if (> amt-adjust 0) + (insert (make-string amt-adjust ? )) + (if (looking-back " ") + (delete-char amt-adjust) + (skip-chars-forward "^ \t") + (delete-horizontal-space) + (insert " ")))))) + (forward-line))))) (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." (if ledger-post-auto-adjust-postings (save-excursion - (goto-char beg) - (when (<= end (line-end-position)) - (goto-char (line-beginning-position)) - (if (looking-at ledger-post-line-regexp) - (ledger-post-align-posting)))))) + (goto-char beg) + (when (<= end (line-end-position)) + (goto-char (line-beginning-position)) + (if (looking-at ledger-post-line-regexp) + (ledger-post-align-postings)))))) (defun ledger-post-edit-amount () "Call 'calc-mode' and push the amount in the posting to the top of stack." -- cgit v1.2.3 From f855d7e745a41f8c91f0d6f593274df794a83589 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 23 Mar 2013 20:09:07 -0700 Subject: Finish bug 929 got rid of all references to folding, use narrowing instead. --- doc/ledger-mode.texi | 6 +++--- lisp/ldg-fonts.el | 2 +- lisp/ldg-occur.el | 14 +++++++------- lisp/ldg-reconcile.el | 8 ++++---- 4 files changed, 15 insertions(+), 15 deletions(-) (limited to 'lisp') diff --git a/doc/ledger-mode.texi b/doc/ledger-mode.texi index def583ca..70a5d97a 100644 --- a/doc/ledger-mode.texi +++ b/doc/ledger-mode.texi @@ -614,7 +614,7 @@ for Ledger under the data options. Alternately you can choose @node Ledger Customization Group, Ledger Reconcile Customization Group, Customization Variables, Customization Variables @subsection Ledger Customization Group @table @code -@item ledger-occur-use-face-unfolded +@item ledger-occur-use-face-shown 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. @@ -631,7 +631,7 @@ 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 +@item ledger-narrow-on-reconcile If non-nil, limit transactions shown in main buffer to those matching the reconcile regex. @item ledger-buffer-tracks-reconcile-buffer @@ -674,7 +674,7 @@ Default face for other transactions Face for Ledger accounts @item ledger-font-posting-amount-face Face for Ledger amounts -@item ledger-occur-folded-face +@item ledger-occur-narrowed-face Default face for Ledger occur mode hidden transactions @item ledger-occur-xact-face Default face for Ledger occur mode shown transactions diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el index d760140c..76bfc03d 100644 --- a/lisp/ldg-fonts.el +++ b/lisp/ldg-fonts.el @@ -62,7 +62,7 @@ "Face for Ledger amounts" :group 'ledger-faces) -(defface ledger-occur-folded-face +(defface ledger-occur-narrowed-face `((t :foreground "grey70" :invisible t )) "Default face for Ledger occur mode hidden transactions" :group 'ledger-faces) diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index 35ca7f3d..28d87b78 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -20,7 +20,7 @@ ;; MA 02111-1307, USA. ;;; Commentary: -;; Provide code folding to ledger mode. Adapted from original loccur +;; Provide buffer narrowing to ledger mode. Adapted from original loccur ;; mode by Alexey Veretennikov ;; @@ -31,11 +31,11 @@ (defconst ledger-occur-overlay-property-name 'ledger-occur-custom-buffer-grep) -(defcustom ledger-occur-use-face-unfolded t +(defcustom ledger-occur-use-face-shown t "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) +(make-variable-buffer-local 'ledger-occur-use-face-shown) (defvar ledger-occur-mode nil @@ -69,7 +69,7 @@ When REGEX is nil, unhide everything, and remove higlight" (if (or (null regex) (zerop (length regex))) nil - (concat " Ledger-Folded: " regex))) + (concat " Ledger-Narrowed: " regex))) (force-mode-line-update) (ledger-occur-remove-overlays) (if ledger-occur-mode @@ -79,7 +79,7 @@ When REGEX is nil, unhide everything, and remove higlight" (ledger-occur-create-xact-overlays ovl-bounds)) (setq ledger-occur-overlay-list (append ledger-occur-overlay-list - (ledger-occur-create-folded-overlays buffer-matches))) + (ledger-occur-create-narrowed-overlays buffer-matches))) (setq ledger-occur-last-match regex) (if (get-buffer-window buffer) (select-window (get-buffer-window buffer))))) @@ -116,7 +116,7 @@ When REGEX is nil, unhide everything, and remove higlight" (current-word)))) prompt)) -(defun ledger-occur-create-folded-overlays(buffer-matches) +(defun ledger-occur-create-narrowed-overlays(buffer-matches) (if buffer-matches (let ((overlays (let ((prev-end (point-min)) @@ -156,7 +156,7 @@ Argument OVL-BOUNDS contains bounds for the transactions to be left visible." ovl-bounds))) (mapcar (lambda (ovl) (overlay-put ovl ledger-occur-overlay-property-name t) - (if ledger-occur-use-face-unfolded + (if ledger-occur-use-face-shown (overlay-put ovl 'face 'ledger-occur-xact-face ))) overlays))) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index c33eef2e..a4960260 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -40,7 +40,7 @@ "Name to use for reconciliation window." :group 'ledger-reconcile) -(defcustom ledger-fold-on-reconcile t +(defcustom ledger-narrow-on-reconcile t "If t, limit transactions shown in main buffer to those matching the reconcile regex." :type 'boolean :group 'ledger-reconcile) @@ -260,7 +260,7 @@ 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-fold-on-reconcile + (if ledger-narrow-on-reconcile (progn (ledger-occur-quit-buffer buf) (ledger-highlight-xact-under-point))))))) @@ -400,12 +400,12 @@ moved and recentered. If they aren't strange things happen." (set (make-local-variable 'ledger-buf) buf) (set (make-local-variable 'ledger-acct) account)))) - ;; Fold the ledger buffer + ;; Narrow the ledger buffer ;; Now, actually run the reconciliation (with-current-buffer rbuf (save-excursion - (if ledger-fold-on-reconcile + (if ledger-narrow-on-reconcile (ledger-occur-mode account ledger-buf))) (if (> (ledger-reconcile-refresh) 0) (ledger-reconcile-change-target)) -- cgit v1.2.3 From 0bcef93e29a67310cef209074f2162415f1cffd3 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 23 Mar 2013 20:22:40 -0700 Subject: Bug 915 maintain point in buffer when saved. --- lisp/ldg-reconcile.el | 31 +++++++++++++++---------------- 1 file changed, 15 insertions(+), 16 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index a4960260..3d73cca9 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -159,13 +159,14 @@ Return the number of uncleared xacts found." "Refresh the recon-window after the ledger buffer is saved." (let ((curbuf (current-buffer)) (curpoint (point)) - (buf (get-buffer ledger-recon-buffer-name))) - (if buf + (recon-buf (get-buffer ledger-recon-buffer-name))) + (if (buffer-live-p recon-buf) (progn - (with-current-buffer buf - (ledger-reconcile-refresh) - (set-buffer-modified-p nil)) - (select-window (get-buffer-window curbuf)))))) + (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." @@ -211,14 +212,14 @@ Return the number of uncleared xacts found." "Save the ledger buffer." (interactive) (let ((curpoint (point))) - (dolist (buf (cons ledger-buf ledger-bufs)) - (with-current-buffer buf - (save-buffer))) - (with-current-buffer (get-buffer ledger-recon-buffer-name) - (set-buffer-modified-p nil) - (ledger-display-balance) - (goto-char curpoint) - (ledger-reconcile-visit t)))) + (dolist (buf (cons ledger-buf ledger-bufs)) + (with-current-buffer buf + (save-buffer))) + (with-current-buffer (get-buffer ledger-recon-buffer-name) + (set-buffer-modified-p nil) + (ledger-display-balance) + (goto-char curpoint) + (ledger-reconcile-visit t)))) (defun ledger-reconcile-finish () "Mark all pending posting or transactions as cleared. @@ -401,8 +402,6 @@ moved and recentered. If they aren't strange things happen." (set (make-local-variable 'ledger-acct) account)))) ;; Narrow the ledger buffer - - ;; Now, actually run the reconciliation (with-current-buffer rbuf (save-excursion (if ledger-narrow-on-reconcile -- cgit v1.2.3 From 53778317cbc70f1714afbb7346d7abc9d3467edd Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 23 Mar 2013 21:51:27 -0700 Subject: More armor plating on ledger-post-align-postings --- lisp/ldg-post.el | 88 +++++++++++++++++++++++++++++--------------------------- 1 file changed, 46 insertions(+), 42 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 934e70a1..906ff315 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -138,48 +138,52 @@ Return the column of the beginning of the account" "Align all accounts and amounts within region, if there is no region alight the posting on the current line." (interactive) - (save-excursion - ;; If there is no region set - (when (or (not (mark)) - (= (point) (mark))) - (beginning-of-line) - (set-mark (point)) - (goto-char (1+ (line-end-position)))) - - (let* ((mark-first (< (mark) (point))) - (begin (if mark-first (mark) (point))) - (end (if mark-first (point-marker) (mark-marker))) - acc-col amt-offset) - (goto-char end) - (end-of-line) - (setq end (point-marker)) - (goto-char begin) - (beginning-of-line) - (setq begin (point-marker)) - (while (setq acc-col (ledger-next-account end)) - ;; Adjust account position if necessary - (let ((acc-adjust (- ledger-post-account-alignment-column acc-col))) - (if (/= acc-adjust 0) - (if (> acc-adjust 0) - (insert (make-string acc-adjust ? )) ;; Account too far left - (if (looking-back " " (- (point) 3)) - (delete-char acc-adjust) - (skip-chars-forward "^ \t") - (delete-horizontal-space) - (insert " "))))) - (when (setq amt-offset (ledger-next-amount end)) - (let* ((amt-adjust (- ledger-post-amount-alignment-column - amt-offset - (current-column)))) - (if (/= amt-adjust 0) - (if (> amt-adjust 0) - (insert (make-string amt-adjust ? )) - (if (looking-back " ") - (delete-char amt-adjust) - (skip-chars-forward "^ \t") - (delete-horizontal-space) - (insert " ")))))) - (forward-line))))) + (let ((region-boundaries-verified nil)) (save-excursion + ;; If there is no region set + (when (or (not (mark)) + (= (point) (mark))) + (beginning-of-line) + (set-mark (point)) + (goto-char (line-end-position)) + (setq region-boundaries-verified t)) + + (let* ((mark-first (< (mark) (point))) + (begin (if mark-first (mark) (point))) + (end (if mark-first (point-marker) (mark-marker))) + acc-col amt-offset) + (if (not region-boundaries-verified) + (progn + (goto-char end) + (end-of-line) + (setq end (point-marker)) + (goto-char begin) + (beginning-of-line) + (setq begin (point-marker))) + (goto-char begin)) + (while (setq acc-col (ledger-next-account end)) + ;; Adjust account position if necessary + (let ((acc-adjust (- ledger-post-account-alignment-column acc-col))) + (if (/= acc-adjust 0) + (if (> acc-adjust 0) + (insert (make-string acc-adjust ? )) ;; Account too far left + (if (looking-back " " (- (point) 3)) + (delete-char acc-adjust) + (skip-chars-forward "^ \t") + (delete-horizontal-space) + (insert " "))))) + (when (setq amt-offset (ledger-next-amount end)) + (let* ((amt-adjust (- ledger-post-amount-alignment-column + amt-offset + (current-column)))) + (if (/= amt-adjust 0) + (if (> amt-adjust 0) + (insert (make-string amt-adjust ? )) + (if (looking-back " ") + (delete-char amt-adjust) + (skip-chars-forward "^ \t") + (delete-horizontal-space) + (insert " ")))))) + (forward-line)))))) (defun ledger-post-maybe-align (beg end len) "Align amounts only if point is in a posting. -- cgit v1.2.3 From 6ff330911dc67fefa0762bbb8aa349cb82cf474e Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 24 Mar 2013 04:46:35 -0700 Subject: Fixed Align Region menu entry --- lisp/ldg-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index c900d3d3..75004072 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -128,7 +128,7 @@ Can be pcomplete, or align-posting" (define-key map [sort-start] '(menu-item "Mark Sort Beginning" ledger-sort-insert-start-mark)) (define-key map [sort-buff] '(menu-item "Sort Buffer" ledger-sort-buffer)) (define-key map [sort-reg] '(menu-item "Sort Region" ledger-sort-region :enable mark-active)) - (define-key map [align-reg] '(menu-item "Align Region" ledger-post-align-region :enable mark-active)) + (define-key map [align-reg] '(menu-item "Align Region" ledger-post-align-postings :enable mark-active)) (define-key map [sep2] '(menu-item "--")) (define-key map [copy-xact] '(menu-item "Copy Trans at Point" ledger-copy-transaction)) (define-key map [toggle-post] '(menu-item "Toggle Current Posting" ledger-toggle-current)) -- cgit v1.2.3 From 5797623fd7bb998f2e5fd9cd71e0dbe4c4f826dd Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 24 Mar 2013 13:57:03 -0400 Subject: Second rewrite of ledger-post-align-postings. Will probably perfect with the NEXT rewrite. --- lisp/ldg-post.el | 95 ++++++++++++++++++++++++++++---------------------------- 1 file changed, 47 insertions(+), 48 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 906ff315..b3fdcb1f 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -119,7 +119,7 @@ PROMPT is a string to prompt with. CHOICES is a list of "Move point to the next amount, as long as it is not past END. Return the width of the amount field as an integer." (beginning-of-line) - (when (re-search-forward "\\( \\|\t\\| \t\\)[ \t]*-?\\([A-Z$€£]+ *\\)?\\(-?[0-9,]+?\\)\\(.[0-9]+\\)?\\( *[A-Z$€£]+\\)?\\([ \t]*@@?[^\n;]+?\\)?\\([ \t]+;.+?\\|[ \t]*\\)?$" (marker-position end) t) + (when (re-search-forward "\\( \\|\t\\| \t\\)[ \t]*-?\\([A-Z$€£_]+ *\\)?\\(-?[0-9,]+?\\)\\(.[0-9]+\\)?\\( *[[:word:]€£_\"]+\\)?\\([ \t]*[@={]@?[^\n;]+?\\)?\\([ \t]+;.+?\\|[ \t]*\\)?$" (marker-position end) t) (goto-char (match-beginning 0)) (skip-syntax-forward " ") (- (or (match-end 4) @@ -130,60 +130,59 @@ Return the width of the amount field as an integer." Return the column of the beginning of the account" (beginning-of-line) (if (> (marker-position end) (point)) - (when (re-search-forward "\\(^[ ]+\\)\\([*!;a-zA-Z0-9]+?\\)" (marker-position end) t) + (when (re-search-forward "\\(^[ ]+\\)\\([\\[(*!;a-zA-Z0-9]+?\\)" (marker-position end) t) (goto-char (match-beginning 2)) (current-column)))) + +(defun end-of-line-or-region (end-region) + "Return a number or marker to the END-REGION or end of line +position, whichever is closer." + (let ((end (if (< end-region (line-end-position)) + end-region + (line-end-position)))) + (if (markerp end-region) + (copy-marker end) + end))) + +(defun ledger-post-adjust (adjust-by) + (if (> adjust-by 0) + (insert (make-string adjust-by ? )) + (if (looking-back " " (- (point) 3)) + (delete-char adjust-by) + (skip-chars-forward "^ \t") + (delete-horizontal-space) + (insert " ")))) + (defun ledger-post-align-postings () "Align all accounts and amounts within region, if there is no region alight the posting on the current line." (interactive) - (let ((region-boundaries-verified nil)) (save-excursion - ;; If there is no region set - (when (or (not (mark)) - (= (point) (mark))) - (beginning-of-line) - (set-mark (point)) - (goto-char (line-end-position)) - (setq region-boundaries-verified t)) - - (let* ((mark-first (< (mark) (point))) - (begin (if mark-first (mark) (point))) - (end (if mark-first (point-marker) (mark-marker))) - acc-col amt-offset) - (if (not region-boundaries-verified) - (progn - (goto-char end) - (end-of-line) - (setq end (point-marker)) - (goto-char begin) - (beginning-of-line) - (setq begin (point-marker))) - (goto-char begin)) - (while (setq acc-col (ledger-next-account end)) - ;; Adjust account position if necessary - (let ((acc-adjust (- ledger-post-account-alignment-column acc-col))) - (if (/= acc-adjust 0) - (if (> acc-adjust 0) - (insert (make-string acc-adjust ? )) ;; Account too far left - (if (looking-back " " (- (point) 3)) - (delete-char acc-adjust) - (skip-chars-forward "^ \t") - (delete-horizontal-space) - (insert " "))))) - (when (setq amt-offset (ledger-next-amount end)) - (let* ((amt-adjust (- ledger-post-amount-alignment-column - amt-offset - (current-column)))) - (if (/= amt-adjust 0) - (if (> amt-adjust 0) - (insert (make-string amt-adjust ? )) - (if (looking-back " ") - (delete-char amt-adjust) - (skip-chars-forward "^ \t") - (delete-horizontal-space) - (insert " ")))))) - (forward-line)))))) + (save-excursion + (let* ((mark-first (< (mark) (point))) + (begin-region (if mark-first (mark) (point))) + (end-region (if mark-first (point-marker) (mark-marker))) + acc-col amt-offset acc-adjust) + ;; Condition point and mark to the beginning and end of lines + (goto-char end-region) + (setq end-region (copy-marker (line-end-position))) + (goto-char begin-region) + (setq begin-region (copy-marker (line-beginning-position))) + (goto-char begin-region) + (while (or (setq acc-col (ledger-next-account (end-of-line-or-region end-region))) + (< (point) (marker-position end-region))) + (when acc-col + (setq acc-adjust (- ledger-post-account-alignment-column acc-col)) + (if (/= acc-adjust 0) + (ledger-post-adjust acc-adjust)) + + (when (setq amt-offset (ledger-next-amount (end-of-line-or-region end-region))) + (let* ((amt-adjust (- ledger-post-amount-alignment-column + amt-offset + (current-column)))) + (if (/= amt-adjust 0) + (ledger-post-adjust amt-adjust))))) + (forward-line))))) (defun ledger-post-maybe-align (beg end len) "Align amounts only if point is in a posting. -- cgit v1.2.3 From 59e8967d06d0895ece75b27aeb6b4dbf518fcf0a Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 24 Mar 2013 14:06:41 -0400 Subject: Fix bug 923 --- lisp/ldg-mode.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 75004072..dafd0740 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -81,6 +81,8 @@ Can be pcomplete, or align-posting" (ledger-init-load-init-file) + (setq indent-line-function 'ledger-post-align-postings) + (let ((map (current-local-map))) (define-key map [(control ?c) (control ?a)] 'ledger-add-transaction) (define-key map [(control ?c) (control ?b)] 'ledger-post-edit-amount) -- cgit v1.2.3 From 9079ae8a69b7fad33b4c227e95e5474e514d1453 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 24 Mar 2013 15:58:21 -0400 Subject: Clean up ldg-post.el --- lisp/ldg-post.el | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index b3fdcb1f..0de2de7d 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -115,22 +115,35 @@ PROMPT is a string to prompt with. CHOICES is a list of (delete-char 1))))))) (goto-char pos))) +(defvar ledger-post-amount-regex + (concat "\\( \\|\t\\| \t\\)[ \t]*-?" + "\\([A-Z$€£_]+ *\\)?" + "\\(-?[0-9,]+?\\)" + "\\(.[0-9]+\\)?" + "\\( *[[:word:]€£_\"]+\\)?" + "\\([ \t]*[@={]@?[^\n;]+?\\)?" + "\\([ \t]+;.+?\\|[ \t]*\\)?$")) + (defun ledger-next-amount (&optional end) "Move point to the next amount, as long as it is not past END. Return the width of the amount field as an integer." (beginning-of-line) - (when (re-search-forward "\\( \\|\t\\| \t\\)[ \t]*-?\\([A-Z$€£_]+ *\\)?\\(-?[0-9,]+?\\)\\(.[0-9]+\\)?\\( *[[:word:]€£_\"]+\\)?\\([ \t]*[@={]@?[^\n;]+?\\)?\\([ \t]+;.+?\\|[ \t]*\\)?$" (marker-position end) t) + (when (re-search-forward ledger-post-amount-regex (marker-position end) t) (goto-char (match-beginning 0)) (skip-syntax-forward " ") (- (or (match-end 4) (match-end 3)) (point)))) +(defvar ledger-post-account-regex + (concat "\\(^[ ]+\\)" + "\\([\\[(*!;a-zA-Z0-9]+?\\)")) + (defun ledger-next-account (&optional end) "Move point to the beginning of the next account, or status marker (!*), as long as it is not past END. Return the column of the beginning of the account" (beginning-of-line) (if (> (marker-position end) (point)) - (when (re-search-forward "\\(^[ ]+\\)\\([\\[(*!;a-zA-Z0-9]+?\\)" (marker-position end) t) + (when (re-search-forward ledger-post-account-regex (marker-position end) t) (goto-char (match-beginning 2)) (current-column)))) -- cgit v1.2.3 From 0d0e996e072072c2b203ff9eef2690d5f8c11c4f Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 24 Mar 2013 17:20:36 -0400 Subject: Improve ledger-split-commodities to handle multi character commodities. --- lisp/ldg-commodities.el | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index 0ed52fc3..7dc0a900 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -32,7 +32,7 @@ :group 'ledger-reconcile) (defun ledger-split-commodity-string (str) - "Split a commoditized amount into two parts" + "Split a commoditized amount into two parts" (if (> (length str) 0) (let (val comm number-regex) (with-temp-buffer @@ -48,18 +48,16 @@ (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))) + (setq comm (nth 0 (split-string (buffer-substring (point-min) (point-max))))) (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))))) + ;; couldn't find a decimal number, look for a single 0, + ;; indicating account with zero balance + (list 0 ledger-reconcile-default-commodity)) + ))) + + ;; nothing found, return 0 (list 0 ledger-reconcile-default-commodity))) - (defun ledger-string-balance-to-commoditized-amount (str) "Return a commoditized amount (val, 'comm') from STR." -- cgit v1.2.3 From 6a753e155eb8b4c1bb6dada200582d293985e0f2 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 24 Mar 2013 17:23:50 -0400 Subject: Fix ledger-split-commodities to handle integer balances --- lisp/ldg-commodities.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index 7dc0a900..e7014604 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -39,8 +39,8 @@ (insert str) (goto-char (point-min)) (if (assoc "decimal-comma" ledger-environment-alist) - (setq number-regex "-?[1-9][0-9.]*[,][0-9]*") - (setq number-regex "-?[1-9][0-9,]*[.][0-9]*")) + (setq number-regex "-?[1-9][0-9.]*[,]?[0-9]*") + (setq number-regex "-?[1-9][0-9,]*[.]?[0-9]*")) (cond ((re-search-forward number-regex nil t) ;; found a decimal number (setq val -- cgit v1.2.3 From e8a2ebb6993eb025d536495caae02852caf291d1 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 24 Mar 2013 18:12:44 -0400 Subject: Insert Effective Date to xact --- lisp/ldg-mode.el | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index dafd0740..434d7448 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -55,6 +55,17 @@ Can be pcomplete, or align-posting" (defvar ledger-mode-abbrev-table) +(defun ledger-insert-effective-date () + (interactive) + (let ((context (car (ledger-context-at-point))) + (date-string (format-time-string (cdr (assoc "date-format" ledger-environment-alist))))) + (cond ((eq 'entry context) + (beginning-of-line) + (insert date-string "=")) + ((eq 'acct-transaction context) + (end-of-line) + (insert " ; [=" date-string "]"))))) + ;;;###autoload (define-derived-mode ledger-mode text-mode "Ledger" "A mode for editing ledger data files." @@ -94,7 +105,7 @@ Can be pcomplete, or align-posting" (define-key map [(control ?c) (control ?m)] 'ledger-set-month) (define-key map [(control ?c) (control ?r)] 'ledger-reconcile) (define-key map [(control ?c) (control ?s)] 'ledger-sort-region) - (define-key map [(control ?c) (control ?t)] 'ledger-test-run) + (define-key map [(control ?c) (control ?t)] 'ledger-insert-effective-date) (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) @@ -126,6 +137,7 @@ Can be pcomplete, or align-posting" (interactive) (customize-group 'ledger)))) (define-key map [sep1] '("--")) + (define-key map [effective-date] '(menu-item "Set effective date" ledger-insert-effective-date)) (define-key map [sort-end] '(menu-item "Mark Sort End" ledger-sort-insert-end-mark)) (define-key map [sort-start] '(menu-item "Mark Sort Beginning" ledger-sort-insert-start-mark)) (define-key map [sort-buff] '(menu-item "Sort Buffer" ledger-sort-buffer)) @@ -136,7 +148,7 @@ Can be pcomplete, or align-posting" (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-transaction)) (define-key map [sep4] '(menu-item "--")) - (define-key map [edit-amount] '(menu-item "Reconcile Account" ledger-reconcile)) + (define-key map [recon-account] '(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 "--")) -- cgit v1.2.3 From 15efb41abacfe81aaa921ec46472bbdffc4b222d Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 24 Mar 2013 23:26:23 -0400 Subject: Make complete play nice with auto alignment --- lisp/ldg-complete.el | 45 +++++++++++++++++++++++++++++++++++++++++++++ lisp/ldg-mode.el | 6 +++--- lisp/ldg-post.el | 8 ++++++-- 3 files changed, 54 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index 6607d372..fa0bf87a 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -177,6 +177,51 @@ Does not use ledger xact" (if (re-search-backward "\\(\t\\| [ \t]\\)" nil t) (goto-char (match-end 0)))))) + +(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 would cycle properly" + (interactive "p") + (if (and interactively + pcomplete-cycle-completions + pcomplete-current-completions + (memq last-command '(ledger-magic-tab + ledger-pcomplete + pcomplete-expand-and-complete + pcomplete-reverse))) + (progn + (delete-backward-char pcomplete-last-completion-length) + (if (eq this-command 'pcomplete-reverse) + (progn + (push (car (last pcomplete-current-completions)) + pcomplete-current-completions) + (setcdr (last pcomplete-current-completions 2) nil)) + (nconc pcomplete-current-completions + (list (car pcomplete-current-completions))) + (setq pcomplete-current-completions + (cdr pcomplete-current-completions))) + (pcomplete-insert-entry pcomplete-last-completion-stub + (car pcomplete-current-completions) + nil pcomplete-last-completion-raw)) + (setq pcomplete-current-completions nil + pcomplete-last-completion-raw nil) + (catch 'pcompleted + (let* ((pcomplete-stub) + pcomplete-seen pcomplete-norm-func + pcomplete-args pcomplete-last pcomplete-index + (pcomplete-autolist pcomplete-autolist) + (pcomplete-suffix-list pcomplete-suffix-list) + (completions (pcomplete-completions)) + (result (pcomplete-do-complete pcomplete-stub completions))) + (and result + (not (eq (car result) 'listed)) + (cdr result) + (pcomplete-insert-entry pcomplete-stub (cdr result) + (memq (car result) + '(sole shortest)) + pcomplete-last-completion-raw)))))) + (provide 'ldg-complete) ;;; ldg-complete.el ends here diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 434d7448..b435ada2 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -44,13 +44,13 @@ (interactive) (remove-overlays)) -(defun ledger-magic-tab () +(defun ledger-magic-tab (&optional interactively) "Decide what to with with . Can be pcomplete, or align-posting" - (interactive) + (interactive "p") (if (and (> (point) 1) (looking-back "[:A-Za-z0-9]" 1)) - (pcomplete) + (ledger-pcomplete interactively) (ledger-post-align-postings))) (defvar ledger-mode-abbrev-table) diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 0de2de7d..bbed297d 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -172,6 +172,9 @@ position, whichever is closer." region alight the posting on the current line." (interactive) (save-excursion + (if (or (not (mark)) + (not (use-region-p))) + (set-mark (point))) (let* ((mark-first (< (mark) (point))) (begin-region (if mark-first (mark) (point))) (end-region (if mark-first (point-marker) (mark-marker))) @@ -180,8 +183,9 @@ region alight the posting on the current line." (goto-char end-region) (setq end-region (copy-marker (line-end-position))) (goto-char begin-region) - (setq begin-region (copy-marker (line-beginning-position))) - (goto-char begin-region) + (goto-char + (setq begin-region + (copy-marker (line-beginning-position)))) (while (or (setq acc-col (ledger-next-account (end-of-line-or-region end-region))) (< (point) (marker-position end-region))) (when acc-col -- cgit v1.2.3 From cc62e6a886d72bbe2a1a3c673df92b912deefd0c Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 25 Mar 2013 00:04:43 -0400 Subject: Code cleanup in ldg-exec and ledger-split-commodity --- lisp/ldg-commodities.el | 45 ++++++++++++++++++++++----------------------- lisp/ldg-exec.el | 9 --------- 2 files changed, 22 insertions(+), 32 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index e7014604..f664c472 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -21,7 +21,7 @@ ;;; Commentary: ;; Helper functions to deal with commoditized numbers. A commoditized -;; number will be a cons of value and string where the string contains +;; number will be a list of value and string where the string contains ;; the commodity ;;; Code: @@ -32,30 +32,29 @@ :group 'ledger-reconcile) (defun ledger-split-commodity-string (str) - "Split a commoditized amount into two parts" + "Split a commoditized amount into two parts" (if (> (length str) 0) - (let (val comm number-regex) + (let ((number-regex (if (assoc "decimal-comma" ledger-environment-alist) + "-?[1-9][0-9.]*[,]?[0-9]*" + "-?[1-9][0-9,]*[.]?[0-9]*"))) (with-temp-buffer (insert str) (goto-char (point-min)) - (if (assoc "decimal-comma" ledger-environment-alist) - (setq number-regex "-?[1-9][0-9.]*[,]?[0-9]*") - (setq number-regex "-?[1-9][0-9,]*[.]?[0-9]*")) (cond ((re-search-forward number-regex 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)) - (setq comm (nth 0 (split-string (buffer-substring (point-min) (point-max))))) - (list val comm)) + ;; found a number in the current locale, return it in + ;; the car. Anything left over is annotation, + ;; the first thing should be the commodity, separated + ;; by whitespace, return it in the cdr. I can't think of any + ;; counterexamples + (list + (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)))))) ((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)) - ))) - + ;; couldn't find a decimal number, look for a single 0, + ;; indicating account with zero balance + (list 0 ledger-reconcile-default-commodity))))) ;; nothing found, return 0 (list 0 ledger-reconcile-default-commodity))) @@ -68,7 +67,6 @@ (ledger-split-commodity-string str)) fields))) - (defun -commodity (c1 c2) "Subtract C2 from C1, ensuring their commodities match." (if (string= (cadr c1) (cadr c2)) @@ -108,7 +106,7 @@ which must be translated both directions." (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." +longer ones are after the value." (let ((val (ledger-commodity-string-number-decimalize (number-to-string (car c1)) :to-user)) (commodity (cadr c1))) @@ -122,12 +120,13 @@ Assumes a space between the value and the commodity." (let ((parts (split-string (read-from-minibuffer (concat prompt " (" ledger-reconcile-default-commodity "): "))))) (if parts - (if (/= (length parts) 2) ;;assume a number was entered and use default commodity + (if (/= (length parts) 2) ;;assume a number was entered and + ;;use default commodity (list (string-to-number (car parts)) ledger-reconcile-default-commodity) (let ((valp1 (string-to-number (car parts))) (valp2 (string-to-number (cadr parts)))) - (cond ((and (= valp1 valp2) (= 0 valp1));; means neither contained a valid number (both = 0) + (cond ((and (= valp1 valp2) (= 0 valp1)) ;; means neither contained a valid number (both = 0) (list 0 "")) ((and (/= 0 valp1) (= valp2 0)) (list valp1 (cadr parts))) diff --git a/lisp/ldg-exec.el b/lisp/ldg-exec.el index 46775914..31621f9f 100644 --- a/lisp/ldg-exec.el +++ b/lisp/ldg-exec.el @@ -74,15 +74,6 @@ outbuf (ledger-exec-handle-error 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)) -;; (prog1 -;; (read (current-buffer)) -;; (kill-buffer (current-buffer))))) - (defun ledger-version-greater-p (needed) "Verify the ledger binary is usable for `ledger-mode' (version greater than NEEDED)." (let ((buffer ledger-buf) -- 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') 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 e5525130c023862a58277c248047c3e1cc80d613 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 25 Mar 2013 13:35:59 -0400 Subject: Improve complete-all and reconcile saving --- lisp/ldg-commodities.el | 3 ++- lisp/ldg-complete.el | 2 +- lisp/ldg-reconcile.el | 3 ++- 3 files changed, 5 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index 0eb435b5..3485d93f 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -32,7 +32,8 @@ :group 'ledger-reconcile) (defun ledger-split-commodity-string (str) - "Split a commoditized amount into two parts" + "Split a commoditized string, STR, into two parts. +Returns a list with (value commodity)." (if (> (length str) 0) (let ((number-regex (if (assoc "decimal-comma" ledger-environment-alist) "-?[1-9][0-9.]*[,]?[0-9]*" diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index a8e73b88..7e37163b 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -155,7 +155,7 @@ Does not use ledger xact" (setq rest-of-name (match-string 3)) ;; Start copying the postings (forward-line) - (while (looking-at "^\\s-+") + (while (looking-at ledger-post-account-regex) (setq xacts (cons (buffer-substring-no-properties (line-beginning-position) (line-end-position)) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index 3d3b7c92..a05a61c0 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -217,7 +217,8 @@ Return the number of uncleared xacts found." (set-buffer-modified-p nil) (ledger-display-balance) (goto-char curpoint) - (ledger-reconcile-visit t)))) + ;; (ledger-reconcile-visit t) + ))) (defun ledger-reconcile-finish () "Mark all pending posting or transactions as cleared. -- cgit v1.2.3 From 862a83e7927ed0d18e5d297801d28f82595bb2a5 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 25 Mar 2013 14:05:29 -0400 Subject: add --collapse to reconcile balance calculation --- lisp/ldg-reconcile.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index a05a61c0..5a6a117a 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -76,7 +76,7 @@ reconcile-finish will mark all pending posting cleared." ;; split arguments like the shell does, so you need to ;; specify the individual fields in the command line. (if (ledger-exec-ledger buffer (current-buffer) - "balance" "--limit" "cleared or pending" "--empty" + "balance" "--limit" "cleared or pending" "--empty" "--collapse" "--format" "%(display_total)" account) (ledger-split-commodity-string (buffer-substring-no-properties (point-min) (point-max))))))) -- cgit v1.2.3 From 48266d110758e54716177e5c87e33103247414a0 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 25 Mar 2013 18:48:28 -0400 Subject: Fix bug 928 Refix slow indent-region behavior. Need to bing ledger-post-align-postings to indent-region-function, not indent-line-function, others it tries to align the entire region once for every line in the region. --- lisp/ldg-mode.el | 2 +- lisp/ldg-post.el | 13 +++++++++---- 2 files changed, 10 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index b435ada2..1d587d63 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -92,7 +92,7 @@ Can be pcomplete, or align-posting" (ledger-init-load-init-file) - (setq indent-line-function 'ledger-post-align-postings) + (setq indent-region-function 'ledger-post-align-postings) (let ((map (current-local-map))) (define-key map [(control ?c) (control ?a)] 'ledger-add-transaction) diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index c831f01a..75efb83c 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -167,17 +167,22 @@ position, whichever is closer." (delete-horizontal-space) (insert " ")))) -(defun ledger-post-align-postings () +(defun ledger-post-align-postings (&optional beg end) "Align all accounts and amounts within region, if there is no -region alight the posting on the current line." +region align the posting on the current line." (interactive) (save-excursion (if (or (not (mark)) (not (use-region-p))) (set-mark (point))) + (let* ((mark-first (< (mark) (point))) - (begin-region (if mark-first (mark) (point))) - (end-region (if mark-first (point-marker) (mark-marker))) + (begin-region (if beg + beg + (if mark-first (mark) (point)))) + (end-region (if end + end + (if mark-first (point-marker) (mark-marker)))) acc-col amt-offset acc-adjust) ;; Condition point and mark to the beginning and end of lines (goto-char end-region) -- cgit v1.2.3 From bc7a885eb711f4a6cf83d8e7701d90f0079e0359 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 25 Mar 2013 21:19:17 -0400 Subject: Speed improvement to align-postings. In some cases align-posting was getting called twice --- lisp/ldg-post.el | 13 +++++++++---- lisp/ldg-state.el | 2 +- 2 files changed, 10 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 75efb83c..5ac97893 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -158,10 +158,10 @@ position, whichever is closer." (copy-marker end) end))) -(defun ledger-post-adjust (adjust-by) +(defsubst ledger-post-adjust (adjust-by) (if (> adjust-by 0) (insert (make-string adjust-by ? )) - (if (looking-back " " (- (point) 3)) + (if (looking-back " " (- (point) 1)) (delete-char adjust-by) (skip-chars-forward "^ \t") (delete-horizontal-space) @@ -176,7 +176,10 @@ region align the posting on the current line." (not (use-region-p))) (set-mark (point))) - (let* ((mark-first (< (mark) (point))) + (let* ((has-align-hook (remove-hook + 'after-change-functions + 'ledger-post-maybe-align t)) + (mark-first (< (mark) (point))) (begin-region (if beg beg (if mark-first (mark) (point)))) @@ -204,7 +207,9 @@ region align the posting on the current line." (current-column)))) (if (/= amt-adjust 0) (ledger-post-adjust amt-adjust))))) - (forward-line))))) + (forward-line)) + (if has-align-hook + (add-hook 'after-change-functions 'ledger-post-maybe-align t t))))) (defun ledger-post-maybe-align (beg end len) "Align amounts only if point is in a posting. diff --git a/lisp/ldg-state.el b/lisp/ldg-state.el index c1027f5c..88891aff 100644 --- a/lisp/ldg-state.el +++ b/lisp/ldg-state.el @@ -163,7 +163,7 @@ dropped." (delete-char 1)))) (setq new-status inserted)))) (if has-align-hook - (add-hook 'after-change-functions 'ledger-post-maybe-align t t)))) + (add-hook 'after-change-functions 'ledger-post-maybe-align t t)))) ;; This excursion cleans up the entry so that it displays ;; minimally. This means that if all posts are cleared, remove -- cgit v1.2.3 From b947bae1a8bf9a9ca326db46d8f5c907bedc3f1c Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 25 Mar 2013 23:50:26 -0400 Subject: Fix align-postings to deal with being at end of buffer --- lisp/ldg-complete.el | 5 ++--- lisp/ldg-post.el | 8 +++++--- 2 files changed, 7 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index 7e37163b..9d524b86 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -127,10 +127,9 @@ Return tree structure" (line-end-position)))) (delete-region (line-beginning-position) (line-end-position)) - (condition-case err + (condition-case nil (ledger-add-transaction text t) - ((error "ledger-complete-at-point") - (insert text)))) + (error nil))) (forward-line) (goto-char (line-end-position)) (search-backward ";" (line-beginning-position) t) diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 5ac97893..702518d3 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -186,7 +186,8 @@ region align the posting on the current line." (end-region (if end end (if mark-first (point-marker) (mark-marker)))) - acc-col amt-offset acc-adjust) + acc-col amt-offset acc-adjust + (lines-left 1)) ;; Condition point and mark to the beginning and end of lines (goto-char end-region) (setq end-region (copy-marker (line-end-position))) @@ -195,7 +196,8 @@ region align the posting on the current line." (setq begin-region (copy-marker (line-beginning-position)))) (while (or (setq acc-col (ledger-next-account (end-of-line-or-region end-region))) - (< (point) (marker-position end-region))) + (and (< (point) (marker-position end-region)) + (> lines-left 0))) (when acc-col (setq acc-adjust (- ledger-post-account-alignment-column acc-col)) (if (/= acc-adjust 0) @@ -207,7 +209,7 @@ region align the posting on the current line." (current-column)))) (if (/= amt-adjust 0) (ledger-post-adjust amt-adjust))))) - (forward-line)) + (setq lines-left (forward-line))) (if has-align-hook (add-hook 'after-change-functions 'ledger-post-maybe-align t t))))) -- cgit v1.2.3 From fec1c179e33225778fa4b69667d5382e7a2b5718 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 26 Mar 2013 00:35:38 -0400 Subject: Do not include xact level comments in account list for auto completion. --- lisp/ldg-complete.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index 9d524b86..65206026 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -77,7 +77,8 @@ Return tree structure" (split-string (match-string-no-properties 2) ":")) (let ((root account-tree)) - (while account-elements + (while (and account-elements + (not (char-equal (string-to-char (car account-elements)) ?\;))) (let ((entry (assoc (car account-elements) root))) (if entry (setq root (cdr entry)) -- cgit v1.2.3 From f1882d0a56f8b5828aaadfe06e5207a9b43d2ef0 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 26 Mar 2013 02:33:05 -0400 Subject: Major speed improvements to ledger-post-align-postings Got rid of markers. Use inhibit-modification-hook to suppress any other buffer stuff happening. Got giant-buffer down to around 3.5 seconds with full modifications. --- lisp/ldg-post.el | 70 +++++++++++++++++++++++++------------------------------ lisp/ldg-state.el | 11 ++++----- 2 files changed, 36 insertions(+), 45 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 702518d3..a39dea65 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -124,11 +124,12 @@ PROMPT is a string to prompt with. CHOICES is a list of "\\([ \t]*[@={]@?[^\n;]+?\\)?" "\\([ \t]+;.+?\\|[ \t]*\\)?$")) -(defun ledger-next-amount (&optional end) +(defsubst ledger-next-amount (&optional end) "Move point to the next amount, as long as it is not past END. -Return the width of the amount field as an integer." - (beginning-of-line) - (when (re-search-forward ledger-post-amount-regex (marker-position end) t) +Return the width of the amount field as an integer and leave +point at beginning of the commodity." + ;;(beginning-of-line) + (when (re-search-forward ledger-post-amount-regex end t) (goto-char (match-beginning 0)) (skip-syntax-forward " ") (- (or (match-end 4) @@ -138,34 +139,29 @@ Return the width of the amount field as an integer." (concat "\\(^[ \t]+\\)" "\\([\\[(*!;a-zA-Z0-9]+?\\)")) -(defun ledger-next-account (&optional end) +(defsubst ledger-next-account (&optional end) "Move point to the beginning of the next account, or status marker (!*), as long as it is not past END. -Return the column of the beginning of the account" - (beginning-of-line) - (if (> (marker-position end) (point)) - (when (re-search-forward ledger-post-account-regex (marker-position end) t) - (goto-char (match-beginning 2)) - (current-column)))) +Return the column of the beginning of the account and leave point +at beginning of account" + ;; (beginning-of-line) + (if (> end (point)) + (when (re-search-forward ledger-post-account-regex end t) + (goto-char (match-beginning 2)) + (current-column)))) -(defun end-of-line-or-region (end-region) - "Return a number or marker to the END-REGION or end of line +(defsubst ledger-post-end-of-line-or-region (end-region) + "Return a number the END-REGION or end of line position, whichever is closer." - (let ((end (if (< end-region (line-end-position)) - end-region - (line-end-position)))) - (if (markerp end-region) - (copy-marker end) - end))) + (let ((eol (line-end-position))) + (if (< end-region eol) + end-region + eol))) (defsubst ledger-post-adjust (adjust-by) (if (> adjust-by 0) (insert (make-string adjust-by ? )) - (if (looking-back " " (- (point) 1)) - (delete-char adjust-by) - (skip-chars-forward "^ \t") - (delete-horizontal-space) - (insert " ")))) + (delete-char adjust-by))) (defun ledger-post-align-postings (&optional beg end) "Align all accounts and amounts within region, if there is no @@ -176,42 +172,40 @@ region align the posting on the current line." (not (use-region-p))) (set-mark (point))) - (let* ((has-align-hook (remove-hook - 'after-change-functions - 'ledger-post-maybe-align t)) + (let* ((inhibit-modification-hooks t) (mark-first (< (mark) (point))) (begin-region (if beg beg (if mark-first (mark) (point)))) (end-region (if end end - (if mark-first (point-marker) (mark-marker)))) + (if mark-first (point) (mark)))) acc-col amt-offset acc-adjust (lines-left 1)) ;; Condition point and mark to the beginning and end of lines (goto-char end-region) - (setq end-region (copy-marker (line-end-position))) + (setq end-region (line-end-position)) (goto-char begin-region) (goto-char - (setq begin-region - (copy-marker (line-beginning-position)))) - (while (or (setq acc-col (ledger-next-account (end-of-line-or-region end-region))) - (and (< (point) (marker-position end-region)) - (> lines-left 0))) + (setq begin-region + (line-beginning-position))) + (while (or (setq acc-col (ledger-next-account (ledger-post-end-of-line-or-region end-region))) + (and (< (point) end-region) + lines-left)) (when acc-col (setq acc-adjust (- ledger-post-account-alignment-column acc-col)) (if (/= acc-adjust 0) (ledger-post-adjust acc-adjust)) - (when (setq amt-offset (ledger-next-amount (end-of-line-or-region end-region))) + (when (setq amt-offset (ledger-next-amount (ledger-post-end-of-line-or-region end-region))) (let* ((amt-adjust (- ledger-post-amount-alignment-column amt-offset (current-column)))) (if (/= amt-adjust 0) (ledger-post-adjust amt-adjust))))) - (setq lines-left (forward-line))) - (if has-align-hook - (add-hook 'after-change-functions 'ledger-post-maybe-align t t))))) + (forward-line) + (setq lines-left (not (eobp)))) + (setq inhibit-modification-hooks nil)))) (defun ledger-post-maybe-align (beg end len) "Align amounts only if point is in a posting. diff --git a/lisp/ldg-state.el b/lisp/ldg-state.el index 88891aff..4f1b3695 100644 --- a/lisp/ldg-state.el +++ b/lisp/ldg-state.el @@ -122,12 +122,10 @@ dropped." ;;this excursion toggles the posting status (save-excursion - (let ((has-align-hook (remove-hook - 'after-change-functions - 'ledger-post-maybe-align t))) + (setq inhibit-modification-hooks t) - (goto-char (line-beginning-position)) - (when (looking-at "[ \t]") + (goto-char (line-beginning-position)) + (when (looking-at "[ \t]") (skip-chars-forward " \t") (let ((here (point)) (cur-status (ledger-state-from-char (char-after)))) @@ -162,8 +160,7 @@ dropped." ((looking-at " ") (delete-char 1)))) (setq new-status inserted)))) - (if has-align-hook - (add-hook 'after-change-functions 'ledger-post-maybe-align t t)))) + (setq inhibit-modification-hooks nil)) ;; This excursion cleans up the entry so that it displays ;; minimally. This means that if all posts are cleared, remove -- cgit v1.2.3 From c8c94e960206f705610b92b6957a2209208c69c5 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 26 Mar 2013 13:55:31 -0400 Subject: Handle quoted commodities in ledger-split-commodity-string --- lisp/ldg-commodities.el | 41 ++++++++++++++++++++++++++--------------- 1 file changed, 26 insertions(+), 15 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index 3485d93f..831d770b 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -41,21 +41,32 @@ Returns a list with (value commodity)." (with-temp-buffer (insert str) (goto-char (point-min)) - (cond ((re-search-forward number-regex nil t) - ;; found a number in the current locale, return it in - ;; the car. Anything left over is annotation, - ;; the first thing should be the commodity, separated - ;; by whitespace, return it in the cdr. I can't think of any - ;; counterexamples - (list - (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-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 - (list 0 ledger-reconcile-default-commodity))))) + (cond + ((re-search-forward "\"\\(.*\\)\"" nil t) + (let ((com (delete-and-extract-region + (match-beginning 1) + (match-end 1)))) + (if (re-search-forward number-regex nil t) + (list + (string-to-number + (ledger-commodity-string-number-decimalize + (delete-and-extract-region (match-beginning 0) (match-end 0)) :from-user)) + com)))) + ((re-search-forward number-regex nil t) + ;; found a number in the current locale, return it in + ;; the car. Anything left over is annotation, + ;; the first thing should be the commodity, separated + ;; by whitespace, return it in the cdr. I can't think of any + ;; counterexamples + (list + (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-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 + (list 0 ledger-reconcile-default-commodity))))) ;; nothing found, return 0 (list 0 ledger-reconcile-default-commodity))) -- cgit v1.2.3 From 5b1778b3ca8202677aeb7096c17452e8445a25c9 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 26 Mar 2013 19:34:37 -0400 Subject: More speed improvements for align-postings. --- lisp/ldg-post.el | 21 ++++++--------------- 1 file changed, 6 insertions(+), 15 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index a39dea65..e0b5f8fa 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -137,27 +137,17 @@ point at beginning of the commodity." (defvar ledger-post-account-regex (concat "\\(^[ \t]+\\)" - "\\([\\[(*!;a-zA-Z0-9]+?\\)")) + "\\([\\[(*!;a-zA-Z0-9]\\)")) (defsubst ledger-next-account (&optional end) "Move point to the beginning of the next account, or status marker (!*), as long as it is not past END. Return the column of the beginning of the account and leave point at beginning of account" - ;; (beginning-of-line) (if (> end (point)) (when (re-search-forward ledger-post-account-regex end t) (goto-char (match-beginning 2)) (current-column)))) - -(defsubst ledger-post-end-of-line-or-region (end-region) - "Return a number the END-REGION or end of line -position, whichever is closer." - (let ((eol (line-end-position))) - (if (< end-region eol) - end-region - eol))) - (defsubst ledger-post-adjust (adjust-by) (if (> adjust-by 0) (insert (make-string adjust-by ? )) @@ -189,15 +179,16 @@ region align the posting on the current line." (goto-char (setq begin-region (line-beginning-position))) - (while (or (setq acc-col (ledger-next-account (ledger-post-end-of-line-or-region end-region))) + + ;; This is the guts of the alignment loop + (while (or (setq acc-col (ledger-next-account (line-end-position))) (and (< (point) end-region) lines-left)) (when acc-col - (setq acc-adjust (- ledger-post-account-alignment-column acc-col)) - (if (/= acc-adjust 0) + (if (/= (setq acc-adjust (- ledger-post-account-alignment-column acc-col)) 0) (ledger-post-adjust acc-adjust)) - (when (setq amt-offset (ledger-next-amount (ledger-post-end-of-line-or-region end-region))) + (when (setq amt-offset (ledger-next-amount (line-end-position))) (let* ((amt-adjust (- ledger-post-amount-alignment-column amt-offset (current-column)))) -- cgit v1.2.3 From 5418e77c638ac34a340ab3ed368f800cb6f02353 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 26 Mar 2013 23:50:14 -0400 Subject: Better end testing for align-postings --- lisp/ldg-post.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index e0b5f8fa..d5646702 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -181,9 +181,9 @@ region align the posting on the current line." (line-beginning-position))) ;; This is the guts of the alignment loop - (while (or (setq acc-col (ledger-next-account (line-end-position))) - (and (< (point) end-region) - lines-left)) + (while (and (or (setq acc-col (ledger-next-account (line-end-position))) + lines-left) + (< (point) end-region)) (when acc-col (if (/= (setq acc-adjust (- ledger-post-account-alignment-column acc-col)) 0) (ledger-post-adjust acc-adjust)) -- cgit v1.2.3 From 15b1d36fa298b0eb743ee4839096899787e11b8d Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 27 Mar 2013 13:54:44 -0400 Subject: Cleaned up entrant macros to only return clauses --- lisp/ldg-schedule.el | 108 +++++++++++++++++++++++++++++++-------------------- 1 file changed, 66 insertions(+), 42 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-schedule.el b/lisp/ldg-schedule.el index effa20b5..c3c77548 100644 --- a/lisp/ldg-schedule.el +++ b/lisp/ldg-schedule.el @@ -79,12 +79,10 @@ COUNT 0) means EVERY day-of-week (eg. every Saturday)" ((> count 0) ;; Positive count (let ((decoded (gensym))) `(let ((,decoded (decode-time date))) - (if (and (eq (nth 6 ,decoded) ,day-of-week) - (between (nth 3 ,decoded) - ,(* (1- count) 7) - ,(* count 7))) - t - nil)))) + (and (eq (nth 6 ,decoded) ,day-of-week) + (between (nth 3 ,decoded) + ,(* (1- count) 7) + ,(* count 7)))))) ((< count 0) (let ((days-in-month (gensym)) (decoded (gensym))) @@ -92,12 +90,10 @@ COUNT 0) means EVERY day-of-week (eg. every Saturday)" (,days-in-month (ledger-schedule-days-in-month (nth 4 ,decoded) (nth 5 ,decoded)))) - (if (and (eq (nth 6 ,decoded) ,day-of-week) - (between (nth 3 ,decoded) - (+ ,days-in-month ,(* count 7)) - (+ ,days-in-month ,(* (1+ count) 7)))) - t - nil)))) + (and (eq (nth 6 ,decoded) ,day-of-week) + (between (nth 3 ,decoded) + (+ ,days-in-month ,(* count 7)) + (+ ,days-in-month ,(* (1+ count) 7))))))) (t (error "COUNT out of range, COUNT=%S" count))) (error "Invalid argument to ledger-schedule-day-in-month-macro %S %S" @@ -117,13 +113,13 @@ of date." (between (eval day) 1 (ledger-schedule-days-in-month (eval month) (eval year)))) (between (eval day) 1 31)) ;; no month specified, assume 31 days. `'(and ,(if (eval year) - `(if (eq (nth 5 (decode-time date)) ,(eval year)) t) - `t) + `(eq (nth 5 (decode-time date)) ,(eval year)) + `t) ,(if (eval month) - `(if (eq (nth 4 (decode-time date)) ,(eval month)) t) + `(eq (nth 4 (decode-time date)) ,(eval month)) `t) ,(if (eval day) - `(if (eq (nth 3 (decode-time date)) ,(eval day)) t))) + `(eq (nth 3 (decode-time date)) ,(eval day)))) (error "ledger-schedule-constraint-numerical-date-macro: date out of range %S %S %S" (eval year) (eval month) (eval day)))) @@ -133,10 +129,8 @@ of date." For example every second Friday, regardless of month." (let ((start-day (nth 6 (decode-time (eval start-date))))) (if (eq start-day day-of-week) ;; good, can proceed - `(if (zerop (mod (- (time-to-days date) ,(time-to-days (eval start-date))) ,(* skip 7))) - t - nil) - (error "START-DATE day of week doesn't match DAY-OF-WEEK")))) + `(zerop (mod (- (time-to-days date) ,(time-to-days (eval start-date))) ,(* skip 7))) + (error "START-DATE day of week doesn't match DAY-OF-WEEK")))) (defmacro ledger-schedule-constrain-date-range-macro (month1 day1 month2 day2) "Return a form of DATE that is true if DATE falls between MONTH1 DAY1 and MONTH2 DAY2." @@ -191,7 +185,7 @@ the transaction should be logged for that day." (replace-match "(" nil t))) (defun ledger-schedule-read-descriptor-tree (descriptor-string) - "Take a date descriptor string and return a function that + "Take a date DESCRIPTOR-STRING and return a function of date that returns true if the date meets the requirements" (with-temp-buffer ;; copy the descriptor string into a temp buffer for manipulation @@ -222,51 +216,76 @@ 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 + (ledger-schedule-transform-auto-tree (read (buffer-substring-no-properties (point-min) (point-max)))))) -(defun ledger-transform-auto-tree (tree) +(defun ledger-schedule-transform-auto-tree (descriptor-string-list) "Takes a lisp list of date descriptor strings, TREE, and returns a string with a lambda function of date." ;; use funcall to use the lambda function spit out here - (if (consp tree) + (if (consp descriptor-string-list) (let (result) - (while (consp tree) - (let ((newcar (car tree))) + (while (consp descriptor-string-list) + (let ((newcar (car descriptor-string-list))) (if (consp newcar) - (setq newcar (ledger-transform-auto-tree (car tree)))) + (setq newcar (ledger-schedule-transform-auto-tree (car descriptor-string-list)))) + ;; newcar may be a cons now, after ledger-schedule-transfrom-auto-tree (if (consp newcar) (push newcar result) + ;; this is where we actually turn the string descriptor into useful lisp (push (ledger-schedule-parse-date-descriptor newcar) result)) ) - (setq tree (cdr tree))) + (setq descriptor-string-list (cdr descriptor-string-list))) - ;; tie up all the clauses in a big or and lambda + ;; tie up all the clauses in a big or and lambda, and return + ;; the lambda function as list to be executed by funcall `(lambda (date) - ,(nconc (list 'or) (nreverse result) tree))))) + ,(nconc (list 'or) (nreverse result) descriptor-string-list))))) (defun ledger-schedule-split-constraints (descriptor-string) "Return a list with the year, month and day fields split" (let ((fields (split-string descriptor-string "[/\\-]" t)) constrain-year constrain-month constrain-day) - (if (string= (car fields) "*") + (if (string= (nth 0 fields) "*") (setq constrain-year nil) - (setq constrain-year (car fields))) - (if (string= (cadr fields) "*") + (setq constrain-year (nth 0 fields))) + + ;;(setq constrain-month (ledger-schedule-classify-month-constraint (nth 1 fields))) + + (if (string= (nth 1 fields) "*") (setq constrain-month nil) - (setq constrain-month (cadr fields))) + (setq constrain-month (nth 1 fields))) + (if (string= (nth 2 fields) "*") (setq constrain-day nil) (setq constrain-day (nth 2 fields))) (list constrain-year constrain-month constrain-day))) -(defun ledger-string-to-number-or-nil (str) +(defun ledger-schedule-string-to-number-or-nil (str) (if str (string-to-number str) nil)) +(defun ledger-schedule-classify-month-constraint (str) + (cond ((string= str "*") + t) + ((/= 0 (string-to-number str)) + (ledger-schedule-constrain-month-numerical (string-to-number str))) + (t + (error "Improperly specified month constraint: " str)))) + +(defun ledger-schedule-constrain-numerical-month (month) + "Return an exprssion of date that is only true if all constraints are met. +A nil constraint matches any input, a numerical entry must match that field +of date." + ;; Do bounds checking to make sure the incoming date constraint is sane + + (if (between (eval month) 1 12) ;; no month specified, assume 31 days. + `(eq (nth 4 (decode-time date)) ,(eval month)) + (error "ledger-schedule-constrain-numerical-month: month out of range %S" (eval month)))) + (defun ledger-schedule-compile-constraints (constraint-list) - (let ((year-constraint (ledger-string-to-number-or-nil (nth 0 constraint-list))) - (month-constraint (ledger-string-to-number-or-nil (nth 1 constraint-list))) - (day-constraint (ledger-string-to-number-or-nil (nth 2 constraint-list)))) + (let ((year-constraint (ledger-schedule-string-to-number-or-nil (nth 0 constraint-list))) + (month-constraint (ledger-schedule-string-to-number-or-nil (nth 1 constraint-list))) + (day-constraint (ledger-schedule-string-to-number-or-nil (nth 2 constraint-list)))) (ledger-schedule-constrain-numerical-date-macro year-constraint month-constraint @@ -303,7 +322,9 @@ returns true if the date meets the requirements" (erase-buffer) (dolist (candidate candidates) (if (not (ledger-schedule-already-entered candidate ledger-buf)) - (insert (format-time-string date-format (car candidate) ) " " (cadr candidate) "\n")))))) + (insert (format-time-string date-format (car candidate) ) " " (cadr candidate) "\n"))) + (ledger-mode)) + (length candidates))) ;; @@ -311,9 +332,12 @@ returns true if the date meets the requirements" ;; (defvar auto-items) -(defun ledger-schedule-test-setup () - (setq auto-items - (ledger-schedule-scan-transactions ledger-schedule-file))) +(defun ledger-schedule-test ( early horizon) + (ledger-schedule-create-auto-buffer + (ledger-schedule-scan-transactions ledger-schedule-file) + early + horizon + (get-buffer "2013.ledger"))) (defun ledger-schedule-test-predict () -- cgit v1.2.3 From ad07d2842737a72a600603c8cd6cde870e477d81 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 27 Mar 2013 16:35:43 -0400 Subject: Bug 936 Fixes ledger-add-transaction. Symptom was no empty line after xact, real problem was not putting ledger output into the temp buffer. --- lisp/ldg-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 1d587d63..c9814918 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -249,7 +249,7 @@ correct chronological place in the buffer." (insert (with-temp-buffer (setq exit-code - (apply #'ledger-exec-ledger ledger-buf ledger-buf "xact" + (apply #'ledger-exec-ledger ledger-buf (current-buffer) "xact" (mapcar 'eval args))) (goto-char (point-min)) (if (looking-at "Error: ") -- cgit v1.2.3 From 4ca0e8916b5a821a4659918a754427799b5b9036 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 27 Mar 2013 15:37:52 -0700 Subject: Fix bug 935, very long account names can get stomped on. This works, but hammers performance --- lisp/ldg-post.el | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index d5646702..f2adc676 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -136,17 +136,16 @@ point at beginning of the commodity." (match-end 3)) (point)))) (defvar ledger-post-account-regex - (concat "\\(^[ \t]+\\)" - "\\([\\[(*!;a-zA-Z0-9]\\)")) + "\\(^[ \t]+\\)\\([\\[(;!*A-Za-z0-9]\\)\\(.+?\\)\\( \\|\n\\)") -(defsubst ledger-next-account (&optional end) +(defun ledger-next-account (&optional end) "Move point to the beginning of the next account, or status marker (!*), as long as it is not past END. Return the column of the beginning of the account and leave point at beginning of account" (if (> end (point)) - (when (re-search-forward ledger-post-account-regex end t) + (when (re-search-forward ledger-post-account-regex (1+ end) t) (goto-char (match-beginning 2)) - (current-column)))) + (list (current-column) (length (match-string-no-properties 3)))))) (defsubst ledger-post-adjust (adjust-by) (if (> adjust-by 0) @@ -185,10 +184,12 @@ region align the posting on the current line." lines-left) (< (point) end-region)) (when acc-col - (if (/= (setq acc-adjust (- ledger-post-account-alignment-column acc-col)) 0) + (if (/= (setq acc-adjust (- ledger-post-account-alignment-column (car acc-col))) 0) (ledger-post-adjust acc-adjust)) - (when (setq amt-offset (ledger-next-amount (line-end-position))) + (when (and + (> ledger-post-amount-alignment-column (+ ledger-post-account-alignment-column (cadr acc-col))) + (setq amt-offset (ledger-next-amount (line-end-position)))) (let* ((amt-adjust (- ledger-post-amount-alignment-column amt-offset (current-column)))) -- cgit v1.2.3 From 7fea9d21fb72e1d66423a928297dd3cc29c7cc78 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 27 Mar 2013 20:02:11 -0700 Subject: Align post speed improvements after adding the long account name handling. --- lisp/ldg-post.el | 49 ++++++++++++++++++++++++++----------------------- lisp/ldg-xact.el | 2 +- 2 files changed, 27 insertions(+), 24 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index f2adc676..91ee623d 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -136,21 +136,17 @@ point at beginning of the commodity." (match-end 3)) (point)))) (defvar ledger-post-account-regex - "\\(^[ \t]+\\)\\([\\[(;!*A-Za-z0-9]\\)\\(.+?\\)\\( \\|\n\\)") + "\\(^[ \t]+\\)\\(.+?\\)\\( \\|\n\\)") (defun ledger-next-account (&optional end) "Move point to the beginning of the next account, or status marker (!*), as long as it is not past END. Return the column of the beginning of the account and leave point at beginning of account" (if (> end (point)) - (when (re-search-forward ledger-post-account-regex (1+ end) t) + (when (re-search-forward ledger-post-account-regex (1+ end) t) + ;; the 1+ is to make sure we can catch the newline (goto-char (match-beginning 2)) - (list (current-column) (length (match-string-no-properties 3)))))) - -(defsubst ledger-post-adjust (adjust-by) - (if (> adjust-by 0) - (insert (make-string adjust-by ? )) - (delete-char adjust-by))) + (current-column)))) (defun ledger-post-align-postings (&optional beg end) "Align all accounts and amounts within region, if there is no @@ -178,24 +174,31 @@ region align the posting on the current line." (goto-char (setq begin-region (line-beginning-position))) - + ;; This is the guts of the alignment loop (while (and (or (setq acc-col (ledger-next-account (line-end-position))) - lines-left) - (< (point) end-region)) + lines-left) + (< (point) end-region)) (when acc-col - (if (/= (setq acc-adjust (- ledger-post-account-alignment-column (car acc-col))) 0) - (ledger-post-adjust acc-adjust)) - - (when (and - (> ledger-post-amount-alignment-column (+ ledger-post-account-alignment-column (cadr acc-col))) - (setq amt-offset (ledger-next-amount (line-end-position)))) - (let* ((amt-adjust (- ledger-post-amount-alignment-column - amt-offset - (current-column)))) - (if (/= amt-adjust 0) - (ledger-post-adjust amt-adjust))))) - (forward-line) + (when (/= (setq acc-adjust (- ledger-post-account-alignment-column acc-col)) 0) + (if (> acc-adjust 0) + (insert (make-string acc-adjust ? )) + (delete-char acc-adjust))) + (when (setq amt-offset (ledger-next-amount (line-end-position))) + (let* ((amt-adjust (- ledger-post-amount-alignment-column + amt-offset + (current-column)))) + (if (/= amt-adjust 0) + (if (> amt-adjust 0) + (insert (make-string amt-adjust ? )) + (let ((curpoint (point))) + (beginning-of-line) + (ledger-next-account (line-end-position)) + (when (> (+ curpoint amt-adjust) + (match-end 2)) + (goto-char curpoint) + (delete-char amt-adjust)))))))) + (forward-line) (setq lines-left (not (eobp)))) (setq inhibit-modification-hooks nil)))) diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index e2180b57..d6ccc2bf 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -21,7 +21,7 @@ ;;; Commentary: -;; Utilites for running ledger synchronously. +;; Utilities for running ledger synchronously. ;;; Code: -- cgit v1.2.3 From 69c0927772f74fd0c45b1250c171e86cc205c76d Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 30 Mar 2013 07:30:40 -0700 Subject: Fix bug 937 maintain sort order of xact on the same actual date. --- lisp/ldg-sort.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el index ecb86371..45b55c47 100644 --- a/lisp/ldg-sort.el +++ b/lisp/ldg-sort.el @@ -64,13 +64,17 @@ (beginning-of-line) (insert "\n; Ledger-mode: End sort\n\n")) +(defun ledger-sort-startkey () + "Return the actual date so the sort-subr doesn't sort onthe entire first line." + (buffer-substring-no-properties (point) (+ 10 (point)))) + (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) (new-end end)) - (save-excursion + (save-excursion (save-restriction (goto-char beg) (ledger-next-record-function) ;; make sure point is at the @@ -88,7 +92,8 @@ (sort-subr nil 'ledger-next-record-function - 'ledger-end-record-function)))))) + 'ledger-end-record-function + 'ledger-sort-startkey)))))) (defun ledger-sort-buffer () "Sort the entire buffer." -- cgit v1.2.3 From 44ae6e0f16fe8677f491487b948eeb5e8cc2998f Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 30 Mar 2013 08:27:16 -0700 Subject: Start integrating schedule into the overall mode --- lisp/ldg-mode.el | 12 ++-- lisp/ldg-new.el | 2 +- lisp/ldg-schedule.el | 153 +++++++++++++++++++++------------------------------ 3 files changed, 71 insertions(+), 96 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index c9814918..e9e233af 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -106,18 +106,20 @@ Can be pcomplete, or align-posting" (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-insert-effective-date) + (define-key map [(control ?c) (control ?u)] 'ledger-schedule-upcoming) (define-key map [(control ?c) (control ?y)] 'ledger-set-year) - (define-key map [tab] 'ledger-magic-tab) + (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) (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 ?g)] 'ledger-report-goto) (define-key map [(control ?c) (control ?o) (control ?k)] 'ledger-report-kill) - + (define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report) + (define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save) + (define-key map [(meta ?p)] 'ledger-post-prev-xact) (define-key map [(meta ?n)] 'ledger-post-next-xact) diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index 8ff95cd3..db16e03e 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -50,7 +50,7 @@ (require 'ldg-test) (require 'ldg-texi) (require 'ldg-xact) - +(require 'ldg-schedule) ;;; Code: diff --git a/lisp/ldg-schedule.el b/lisp/ldg-schedule.el index c3c77548..885c0876 100644 --- a/lisp/ldg-schedule.el +++ b/lisp/ldg-schedule.el @@ -68,7 +68,7 @@ If year is nil, assume it is not a leap year" ;; Macros to handle date expressions -(defmacro ledger-schedule-constrain-day-in-month-macro (count day-of-week) +(defun ledger-schedule-constrain-day-in-month (count day-of-week) "Return a form that evaluates DATE that returns true for the COUNT DAY-OF-WEEK. For example, return true if date is the 3rd Thursday of the month. Negative COUNT starts from the end of the month. (EQ @@ -100,31 +100,7 @@ COUNT 0) means EVERY day-of-week (eg. every Saturday)" count day-of-week))) -(defmacro ledger-schedule-constrain-numerical-date-macro (year month day) - "Return a function of date that is only true if all constraints are met. -A nil constraint matches any input, a numerical entry must match that field -of date." - ;; Do bounds checking to make sure the incoming date constraint is sane - (if - (if (eval month) ;; if we have a month - (and (between (eval month) 1 12) ;; make sure it is between 1 - ;; and twelve and the number - ;; of days are ok - (between (eval day) 1 (ledger-schedule-days-in-month (eval month) (eval year)))) - (between (eval day) 1 31)) ;; no month specified, assume 31 days. - `'(and ,(if (eval year) - `(eq (nth 5 (decode-time date)) ,(eval year)) - `t) - ,(if (eval month) - `(eq (nth 4 (decode-time date)) ,(eval month)) - `t) - ,(if (eval day) - `(eq (nth 3 (decode-time date)) ,(eval day)))) - (error "ledger-schedule-constraint-numerical-date-macro: date out of range %S %S %S" (eval year) (eval month) (eval day)))) - - - -(defmacro ledger-schedule-constrain-every-count-day-macro (day-of-week skip start-date) +(defun ledger-schedule-constrain-every-count-day (day-of-week skip start-date) "Return a form that is true for every DAY skipping SKIP, starting on START. For example every second Friday, regardless of month." (let ((start-day (nth 6 (decode-time (eval start-date))))) @@ -132,7 +108,7 @@ For example every second Friday, regardless of month." `(zerop (mod (- (time-to-days date) ,(time-to-days (eval start-date))) ,(* skip 7))) (error "START-DATE day of week doesn't match DAY-OF-WEEK")))) -(defmacro ledger-schedule-constrain-date-range-macro (month1 day1 month2 day2) +(defun ledger-schedule-constrain-date-range (month1 day1 month2 day2) "Return a form of DATE that is true if DATE falls between MONTH1 DAY1 and MONTH2 DAY2." (let ((decoded (gensym)) (target-month (gensym)) @@ -184,6 +160,19 @@ the transaction should be logged for that day." (while (search-forward "[" nil t) (replace-match "(" nil t))) +(defvar ledger-schedule-descriptor-regex + (concat "\\(20[0-9][0-9]\\|[\*]\\)[/\\-]" ;; Year slot + "\\([\*EO]\\|[01][0-9]\\)[/\\-]" ;; Month slot + "\\([\*]\\|\\([0-3][0-9]\\)\\|" + "\\([0-5]" + "\\(\\(Su\\)\\|" + "\\(Mo\\)\\|" + "\\(Tu\\)\\|" + "\\(We\\)\\|" + "\\(Th\\)\\|" + "\\(Fr\\)\\|" + "\\(Sa\\)\\)\\)\\)")) + (defun ledger-schedule-read-descriptor-tree (descriptor-string) "Take a date DESCRIPTOR-STRING and return a function of date that returns true if the date meets the requirements" @@ -196,18 +185,7 @@ returns true if the date meets the requirements" (goto-char (point-max)) ;; double quote all the descriptors for string processing later - (while (re-search-backward - (concat "\\(20[0-9][0-9]\\|[\*]\\)[/\\-]" ;; Year slot - "\\([\*EO]\\|[01][0-9]\\)[/\\-]" ;; Month slot - "\\([\*]\\|\\([0-3][0-9]\\)\\|" - "\\([0-5]" - "\\(\\(Su\\)\\|" - "\\(Mo\\)\\|" - "\\(Tu\\)\\|" - "\\(We\\)\\|" - "\\(Th\\)\\|" - "\\(Fr\\)\\|" - "\\(Sa\\)\\)\\)\\)") nil t) ;; Day slot + (while (re-search-backward ledger-schedule-descriptor-regex nil t) ;; Day slot (goto-char (match-end 0)) (insert ?\") @@ -232,7 +210,7 @@ returns true if the date meets the requirements" (if (consp newcar) (push newcar result) ;; this is where we actually turn the string descriptor into useful lisp - (push (ledger-schedule-parse-date-descriptor newcar) result)) ) + (push (ledger-schedule-compile-constraints newcar) result)) ) (setq descriptor-string-list (cdr descriptor-string-list))) ;; tie up all the clauses in a big or and lambda, and return @@ -240,62 +218,49 @@ returns true if the date meets the requirements" `(lambda (date) ,(nconc (list 'or) (nreverse result) descriptor-string-list))))) -(defun ledger-schedule-split-constraints (descriptor-string) +(defun ledger-schedule-compile-constraints (descriptor-string) "Return a list with the year, month and day fields split" (let ((fields (split-string descriptor-string "[/\\-]" t)) constrain-year constrain-month constrain-day) - (if (string= (nth 0 fields) "*") - (setq constrain-year nil) - (setq constrain-year (nth 0 fields))) - - ;;(setq constrain-month (ledger-schedule-classify-month-constraint (nth 1 fields))) - - (if (string= (nth 1 fields) "*") - (setq constrain-month nil) - (setq constrain-month (nth 1 fields))) - - (if (string= (nth 2 fields) "*") - (setq constrain-day nil) - (setq constrain-day (nth 2 fields))) - (list constrain-year constrain-month constrain-day))) - -(defun ledger-schedule-string-to-number-or-nil (str) - (if str - (string-to-number str) - nil)) - -(defun ledger-schedule-classify-month-constraint (str) - (cond ((string= str "*") - t) - ((/= 0 (string-to-number str)) - (ledger-schedule-constrain-month-numerical (string-to-number str))) - (t - (error "Improperly specified month constraint: " str)))) - -(defun ledger-schedule-constrain-numerical-month (month) - "Return an exprssion of date that is only true if all constraints are met. -A nil constraint matches any input, a numerical entry must match that field -of date." - ;; Do bounds checking to make sure the incoming date constraint is sane + (setq constrain-year (ledger-schedule-constrain-year (nth 0 fields))) + (setq constrain-month (ledger-schedule-constrain-month (nth 1 fields))) + (setq constrain-day (ledger-schedule-constrain-day (nth 2 fields))) + + (list 'and constrain-year constrain-month constrain-day))) + +(defun ledger-schedule-constrain-year (str) + (let ((year-match t)) + (cond ((string= str "*") + year-match) + ((/= 0 (setq year-match (string-to-number str))) + `(eq (nth 5 (decode-time date)) ,year-match)) + (t + (error "Improperly specified year constraint: " str))))) + +(defun ledger-schedule-constrain-month (str) - (if (between (eval month) 1 12) ;; no month specified, assume 31 days. - `(eq (nth 4 (decode-time date)) ,(eval month)) - (error "ledger-schedule-constrain-numerical-month: month out of range %S" (eval month)))) - -(defun ledger-schedule-compile-constraints (constraint-list) - (let ((year-constraint (ledger-schedule-string-to-number-or-nil (nth 0 constraint-list))) - (month-constraint (ledger-schedule-string-to-number-or-nil (nth 1 constraint-list))) - (day-constraint (ledger-schedule-string-to-number-or-nil (nth 2 constraint-list)))) - (ledger-schedule-constrain-numerical-date-macro - year-constraint - month-constraint - day-constraint))) + (let ((month-match t)) + (cond ((string= str "*") + month-match) ;; always match + ((/= 0 (setq month-match (string-to-number str))) + (if (between month-match 1 12) ;; no month specified, assume 31 days. + `(eq (nth 4 (decode-time date)) ,month-match) + (error "ledger-schedule-constrain-numerical-month: month out of range %S" month-match))) + (t + (error "Improperly specified month constraint: " str))))) + +(defun ledger-schedule-constrain-day (str) + (let ((day-match t)) + (cond ((string= str "*") + t) + ((/= 0 (setq day-match (string-to-number str))) + `(eq (nth 3 (decode-time date)) ,day-match)) + (t + (error "Improperly specified day constraint: " str))))) (defun ledger-schedule-parse-date-descriptor (descriptor) "Parse the date descriptor, return the evaluator" - (ledger-schedule-compile-constraints - (ledger-schedule-split-constraints descriptor))) - + (ledger-schedule-compile-constraints descriptor)) (defun ledger-schedule-list-upcoming-xacts (candidate-items early horizon) "Search CANDIDATE-ITEMS for xacts that occur within the period today - EARLY to today + HORIZON" @@ -346,12 +311,20 @@ of date." (loop for day from 0 to ledger-schedule-look-forward by 1 do (setq test-date (time-add today (days-to-time day))) - ;;(message "date: %S" (decode-time test-date)) (dolist (item auto-items items) (if (funcall (car item) test-date) (setq items (append items (list (decode-time test-date) (cdr item))))))) items)) +(defun ledger-schedule-upcoming () + (interactive) + (ledger-schedule-create-auto-buffer + (ledger-schedule-scan-transactions ledger-schedule-file) + ledger-schedule-look-backward + ledger-schedule-look-forward + (current-buffer))) + + (provide 'ldg-schedule) ;;; ldg-schedule.el ends here -- 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') 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 e3c6ebf97f2f9f7d08f845184c19fccbcf515ce8 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 31 Mar 2013 09:19:10 -0700 Subject: Correct a solarize face --- lisp/ldg-fonts.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el index 76bfc03d..5874b81f 100644 --- a/lisp/ldg-fonts.el +++ b/lisp/ldg-fonts.el @@ -38,7 +38,7 @@ :group 'ledger-faces) (defface ledger-font-highlight-face - `((t :background "white")) + `((t :background "eee8d5")) "Default face for transaction under point" :group 'ledger-faces) -- cgit v1.2.3 From 7bad6186938c7b0d02d9c01050fdcdb3b4cd47f0 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 31 Mar 2013 09:54:28 -0700 Subject: Oops, forgot a # --- lisp/ldg-fonts.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el index 5874b81f..3a7d1e0a 100644 --- a/lisp/ldg-fonts.el +++ b/lisp/ldg-fonts.el @@ -38,7 +38,7 @@ :group 'ledger-faces) (defface ledger-font-highlight-face - `((t :background "eee8d5")) + `((t :background "#eee8d5")) "Default face for transaction under point" :group 'ledger-faces) -- cgit v1.2.3 From c9f91992031967e9f378da1a14b92bc6f9276c90 Mon Sep 17 00:00:00 2001 From: Rémi Vanicat Date: Sun, 31 Mar 2013 21:16:39 +0200 Subject: Use (fit-window-to-buffer) for error reporting. --- lisp/ldg-exec.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/ldg-exec.el b/lisp/ldg-exec.el index 51443ff4..c09b364d 100644 --- a/lisp/ldg-exec.el +++ b/lisp/ldg-exec.el @@ -45,6 +45,7 @@ (with-current-buffer (get-buffer-create "*Ledger Error*") (insert-buffer-substring ledger-output) (make-frame) + (fit-window-to-buffer) (view-mode) (setq buffer-read-only t))) -- cgit v1.2.3 From f015d00fa5b7cb54781569a8ed3835fa5163fae1 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 31 Mar 2013 19:15:10 -0700 Subject: corrected error output --- lisp/ldg-exec.el | 2 -- 1 file changed, 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-exec.el b/lisp/ldg-exec.el index 4a485072..c9bf92ba 100644 --- a/lisp/ldg-exec.el +++ b/lisp/ldg-exec.el @@ -44,8 +44,6 @@ "Deal with ledger errors contained in LEDGER-OUTPUT." (with-current-buffer (get-buffer-create "*Ledger Error*") (insert-buffer-substring ledger-output) - (make-frame) - (fit-frame) (view-mode) (toggle-read-only))) -- 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') 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 4adcad6b2ccae539e2dd237bb78432e0f2fabcac Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 1 Apr 2013 12:37:02 -0700 Subject: Prevent sort-buffer from calling all the after-change hooks --- lisp/ldg-sort.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el index 45b55c47..5119db5d 100644 --- a/lisp/ldg-sort.el +++ b/lisp/ldg-sort.el @@ -74,6 +74,7 @@ ;; automagically (let ((new-beg beg) (new-end end)) + (setq inhibit-modification-hooks t) (save-excursion (save-restriction (goto-char beg) @@ -93,7 +94,8 @@ nil 'ledger-next-record-function 'ledger-end-record-function - 'ledger-sort-startkey)))))) + 'ledger-sort-startkey)))) + (setq inhibit-modification-hooks nil))) (defun ledger-sort-buffer () "Sort the entire buffer." -- cgit v1.2.3 From 024697c4fcd552b6dd806c5be1a916f95393b5be Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 1 Apr 2013 16:32:45 -0700 Subject: Fix Bug 941, ensure two spaces are left between account and amount --- lisp/ldg-post.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 91ee623d..554b8578 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -187,7 +187,8 @@ region align the posting on the current line." (when (setq amt-offset (ledger-next-amount (line-end-position))) (let* ((amt-adjust (- ledger-post-amount-alignment-column amt-offset - (current-column)))) + (current-column) + 2))) (if (/= amt-adjust 0) (if (> amt-adjust 0) (insert (make-string amt-adjust ? )) -- cgit v1.2.3 From 78bedf7c8ea15e369f56fbd317d03deb35343258 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 1 Apr 2013 16:34:30 -0700 Subject: Bring back comments into account completion. --- lisp/ldg-complete.el | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index 65206026..fe27e91d 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -77,10 +77,9 @@ Return tree structure" (split-string (match-string-no-properties 2) ":")) (let ((root account-tree)) - (while (and account-elements - (not (char-equal (string-to-char (car account-elements)) ?\;))) - (let ((entry (assoc (car account-elements) root))) - (if entry + (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)) -- cgit v1.2.3 From eed1d8e53ea3f75f0c6a84ab744f8310a4778981 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 1 Apr 2013 20:48:00 -0700 Subject: ledger-read-commodity-string now calls ledger-split-commodity-string --- lisp/ldg-commodities.el | 28 +++++++++------------------- 1 file changed, 9 insertions(+), 19 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index 842613c6..8755166d 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -127,25 +127,15 @@ longer ones are after the value." (concat commodity " " val)))) (defun ledger-read-commodity-string (prompt) - "Return a commoditizd value (val 'comm') from COMM. -Assumes a space between the value and the commodity." - (let ((parts (split-string (read-from-minibuffer - (concat prompt " (" ledger-reconcile-default-commodity "): "))))) - (if parts - (if (/= (length parts) 2) ;;assume a number was entered and - ;;use default commodity - (list (string-to-number (car parts)) - ledger-reconcile-default-commodity) - (let ((valp1 (string-to-number (car parts))) - (valp2 (string-to-number (cadr parts)))) - (cond ((and (= valp1 valp2) (= 0 valp1)) ;; means neither contained a valid number (both = 0) - (list 0 "")) - ((and (/= 0 valp1) (= valp2 0)) - (list valp1 (cadr parts))) - ((and (/= 0 valp2) (= valp1 0)) - (list valp2 (car parts))) - (t - (error "Cannot understand commodity")))))))) + (let ((str (read-from-minibuffer + (concat prompt " (" ledger-reconcile-default-commodity "): "))) + comm) + (if (> (length str) 0) + (progn + (setq comm (ledger-split-commodity-string str)) + (if (cadr comm) + comm + (list (car comm) ledger-reconcile-default-commodity)))))) (provide 'ldg-commodities) -- cgit v1.2.3 From 86d0fd87c49e20b0f5262e7ae48234986584b750 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 2 Apr 2013 14:20:29 -0700 Subject: Fixes bug 904, failure to highly pending postings. Adds two new faces for pending and cleared posting. --- doc/ledger-mode.texi | 5 +++++ lisp/ldg-fonts.el | 31 ++++++++++++++++++++++--------- lisp/ldg-post.el | 4 ++-- lisp/ldg-regex.el | 24 ++++++++++++++++++++++++ 4 files changed, 53 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/doc/ledger-mode.texi b/doc/ledger-mode.texi index 70a5d97a..34c38dae 100644 --- a/doc/ledger-mode.texi +++ b/doc/ledger-mode.texi @@ -672,6 +672,11 @@ Default face for pending (!) transactions Default face for other transactions @item ledger-font-posting-account-face Face for Ledger accounts +@item ledger-font-posting-account-cleared-face +Face for cleared Ledger accounts +@item ledger-font-posting-account-pending-face +Face for Ledger pending accounts + @item ledger-font-posting-amount-face Face for Ledger amounts @item ledger-occur-narrowed-face diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el index 3a7d1e0a..81196c10 100644 --- a/lisp/ldg-fonts.el +++ b/lisp/ldg-fonts.el @@ -26,6 +26,8 @@ ;;; Code: +(require 'ldg-regex) + (defgroup ledger-faces nil "Ledger mode highlighting" :group 'ledger) (defface ledger-font-uncleared-face `((t :foreground "#dc322f" :weight bold )) @@ -57,6 +59,16 @@ "Face for Ledger accounts" :group 'ledger-faces) +(defface ledger-font-posting-account-cleared-face + `((t :foreground "#657b83" )) + "Face for Ledger accounts" + :group 'ledger-faces) + +(defface ledger-font-posting-account-pending-face + `((t :foreground "#cb4b16" )) + "Face for Ledger accounts" + :group 'ledger-faces) + (defface ledger-font-posting-amount-face `((t :foreground "yellow" )) "Face for Ledger amounts" @@ -99,16 +111,17 @@ (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) - ("^\\s-+\\([*]\\s-*\\)?\\(\\([[(]\\)?[^*: - ]+?:\\([^]); - ]\\|\\s-\\)+?\\([])]\\)?\\)\\( \\| \\|$\\)" + `((,ledger-payee-pending-regex 2 'ledger-font-pending-face) + (,ledger-payee-cleared-regex 2 'ledger-font-cleared-face) + (,ledger-payee-uncleared-regex 2 'ledger-font-uncleared-face) + (,ledger-posting-account-cleared-regex + 2 'ledger-font-posting-account-cleared-face) + (,ledger-posting-account-pending-regex + 2 'ledger-font-posting-account-pending-face) ; works + (,ledger-posting-account-all-regex 2 'ledger-font-posting-account-face) ; works - ("\\( \\| \\|^\\)\\(;.*\\)" 2 'ledger-font-comment-face) ; works - ("^\\([~=].+\\)" 1 ledger-font-other-face) - ("^\\([A-Za-z]+ .+\\)" 1 ledger-font-other-face)) + (,ledger-comment-regex 2 'ledger-font-comment-face) ; works + (,ledger-other-entries-regex 1 ledger-font-other-face)) "Expressions to highlight in Ledger mode.") diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 554b8578..f29d8af8 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -136,14 +136,14 @@ point at beginning of the commodity." (match-end 3)) (point)))) (defvar ledger-post-account-regex - "\\(^[ \t]+\\)\\(.+?\\)\\( \\|\n\\)") + "\\(^[ \t]+\\)\\([!*]?.+?\\)\\( \\|$\\)") (defun ledger-next-account (&optional end) "Move point to the beginning of the next account, or status marker (!*), as long as it is not past END. Return the column of the beginning of the account and leave point at beginning of account" (if (> end (point)) - (when (re-search-forward ledger-post-account-regex (1+ end) t) + (when (re-search-forward ledger-posting-account-all-regex (1+ end) t) ;; the 1+ is to make sure we can catch the newline (goto-char (match-beginning 2)) (current-column)))) diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el index 97fd6e2c..7c92bf15 100644 --- a/lisp/ldg-regex.el +++ b/lisp/ldg-regex.el @@ -24,6 +24,30 @@ (eval-when-compile (require 'cl)) +(defvar ledger-other-entries-regex + "^\\(\\([~=].+\\)\\|\\(^\\([A-Za-z]+ .+\\)\\)\\)") + +(defvar ledger-comment-regex + "\\( \\| \\|^\\)\\(;.*\\)") +(defvar ledger-payee-pending-regex + "^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)") + +(defvar ledger-payee-cleared-regex + "^[0-9]+[-/.=][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)") + +(defvar ledger-payee-uncleared-regex + "^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)") + + +(defvar ledger-posting-account-all-regex + "\\(^[ \t]+\\)\\(.+?\\)\\( \\|$\\)") + +(defvar ledger-posting-account-cleared-regex + "\\(^[ \t]+\\)\\(\\*.+?\\)\\( \\|$\\)") + +(defvar ledger-posting-account-pending-regex + "\\(^[ \t]+\\)\\(!.+?\\)\\( \\|$\\)") + (defvar ledger-date-regex "\\([0-9]+\\)[/-]\\([0-9]+\\)[/-]\\([0-9]+\\)") -- cgit v1.2.3 From 519e57ca1fac01ea057bea8263c6cb06a8ac4e7e Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 2 Apr 2013 23:13:23 -0700 Subject: Consolidated all major regexes into ldg-regex. Only major exception are the regex in ledger context at point. --- lisp/ldg-commodities.el | 8 +++++--- lisp/ldg-complete.el | 5 ++--- lisp/ldg-fonts.el | 44 +++++++++++++++++++++++++++----------------- lisp/ldg-init.el | 4 +++- lisp/ldg-mode.el | 2 +- lisp/ldg-new.el | 2 +- lisp/ldg-post.el | 11 +---------- lisp/ldg-reconcile.el | 14 ++++++++++++-- lisp/ldg-regex.el | 35 ++++++++++++++++++++++++++++++++++- lisp/ldg-sort.el | 5 ++--- lisp/ldg-xact.el | 4 ++-- 11 files changed, 90 insertions(+), 44 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index 8755166d..031bddeb 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -26,6 +26,8 @@ ;;; Code: +(require 'ldg-regex) + (defcustom ledger-reconcile-default-commodity "$" "The default commodity for use in target calculations in ledger reconcile." :type 'string @@ -36,13 +38,13 @@ Returns a list with (value commodity)." (if (> (length str) 0) (let ((number-regex (if (assoc "decimal-comma" ledger-environment-alist) - "-?[1-9][0-9.]*[,]?[0-9]*" - "-?[1-9][0-9,]*[.]?[0-9]*"))) + ledger-amount-decimal-comma-regex + ledger-amount-decimal-period-regex))) (with-temp-buffer (insert str) (goto-char (point-min)) (cond - ((re-search-forward "\"\\(.*\\)\"" nil t) + ((re-search-forward "\"\\(.*\\)\"" nil t) ; look for quoted commodities (let ((com (delete-and-extract-region (match-beginning 1) (match-end 1)))) diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index fe27e91d..3462c0bb 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -52,8 +52,7 @@ (save-excursion (goto-char (point-min)) (while (re-search-forward - (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" - "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t) ;; matches first line + ledger-xact-payee-regex nil t) ;; matches first line (unless (and (>= origin (match-beginning 0)) (< origin (match-end 0))) (setq payees-list (cons (match-string-no-properties 3) @@ -70,7 +69,7 @@ Return tree structure" (save-excursion (goto-char (point-min)) (while (re-search-forward - "^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)" nil t) + ledger-complete-account-regex nil t) (unless (and (>= origin (match-beginning 0)) (< origin (match-end 0))) (setq account-elements diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el index 81196c10..81b5b0bf 100644 --- a/lisp/ldg-fonts.el +++ b/lisp/ldg-fonts.el @@ -29,17 +29,17 @@ (require 'ldg-regex) (defgroup ledger-faces nil "Ledger mode highlighting" :group 'ledger) -(defface ledger-font-uncleared-face +(defface ledger-font-payee-uncleared-face `((t :foreground "#dc322f" :weight bold )) "Default face for Ledger" :group 'ledger-faces) -(defface ledger-font-cleared-face +(defface ledger-font-payee-cleared-face `((t :foreground "#657b83" :weight normal )) "Default face for cleared (*) transactions" :group 'ledger-faces) -(defface ledger-font-highlight-face +(defface ledger-font-xact-highlight-face `((t :background "#eee8d5")) "Default face for transaction under point" :group 'ledger-faces) @@ -50,7 +50,7 @@ :group 'ledger-faces) (defface ledger-font-other-face - `((t :foreground "yellow" )) + `((t :foreground "#657b83" :weight bold)) "Default face for other transactions" :group 'ledger-faces) @@ -70,7 +70,7 @@ :group 'ledger-faces) (defface ledger-font-posting-amount-face - `((t :foreground "yellow" )) + `((t :foreground "#cb4b16" )) "Face for Ledger amounts" :group 'ledger-faces) @@ -111,20 +111,30 @@ (defvar ledger-font-lock-keywords - `((,ledger-payee-pending-regex 2 'ledger-font-pending-face) - (,ledger-payee-cleared-regex 2 'ledger-font-cleared-face) - (,ledger-payee-uncleared-regex 2 'ledger-font-uncleared-face) - (,ledger-posting-account-cleared-regex - 2 'ledger-font-posting-account-cleared-face) - (,ledger-posting-account-pending-regex - 2 'ledger-font-posting-account-pending-face) ; works - (,ledger-posting-account-all-regex - 2 'ledger-font-posting-account-face) ; works - (,ledger-comment-regex 2 'ledger-font-comment-face) ; works - (,ledger-other-entries-regex 1 ledger-font-other-face)) + `( ;; (,ledger-other-entries-regex 1 + ;; ledger-font-other-face) + (,ledger-comment-regex 2 + 'ledger-font-comment-face) + (,ledger-payee-pending-regex 2 + 'ledger-font-payee-pending-face) ; Works + (,ledger-payee-cleared-regex 2 + 'ledger-font-payee-cleared-face) ; Works + (,ledger-payee-uncleared-regex 2 + 'ledger-font-payee-uncleared-face) ; Works + (,ledger-posting-account-cleared-regex 2 + 'ledger-font-posting-account-cleared-face) ; Works + (,ledger-posting-account-pending-regex 2 + 'ledger-font-posting-account-pending-face) ; Works + (,ledger-posting-account-all-regex 2 + 'ledger-font-posting-account-face)) ; Works "Expressions to highlight in Ledger mode.") + - +;; (defvar ledger-font-lock-keywords +;; `( (,ledger-other-entries-regex 1 +;; ledger-font-other-face)) +;; "Expressions to highlight in Ledger mode.") + (provide 'ldg-fonts) ;;; ldg-fonts.el ends here diff --git a/lisp/ldg-init.el b/lisp/ldg-init.el index 8e657323..29839c9e 100644 --- a/lisp/ldg-init.el +++ b/lisp/ldg-init.el @@ -22,6 +22,8 @@ ;;; Commentary: ;; Determine the ledger environment +(require 'ldg-regex) + (defcustom ledger-init-file-name "~/.ledgerrc" "Location of the ledger initialization file. nil if you don't have one" :group 'ledger-exec) @@ -32,7 +34,7 @@ (with-current-buffer file (setq ledger-environment-alist nil) (goto-char (point-min)) - (while (re-search-forward "^--.+?\\($\\|[ ]\\)" nil t ) + (while (re-search-forward ledger-init-string-regex nil t ) (let ((matchb (match-beginning 0)) ;; save the match data, string-match stamp on it (matche (match-end 0))) (end-of-line) diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index c9814918..df9dda87 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -238,7 +238,7 @@ correct chronological place in the buffer." exit-code) (unless insert-at-point (let ((date (car args))) - (if (string-match "\\([0-9]+\\)[-/]\\([0-9]+\\)[-/]\\([0-9]+\\)" date) + (if (string-match ledger-iso-date-regex date) (setq date (encode-time 0 0 0 (string-to-number (match-string 3 date)) (string-to-number (match-string 2 date)) diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index 8ff95cd3..05e18818 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -32,6 +32,7 @@ ;;; Commentary: ;; Load up the ledger mode +(require 'ldg-regex) (require 'esh-util) (require 'esh-arg) (require 'ldg-commodities) @@ -43,7 +44,6 @@ (require 'ldg-occur) (require 'ldg-post) (require 'ldg-reconcile) -(require 'ldg-regex) (require 'ldg-report) (require 'ldg-sort) (require 'ldg-state) diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index f29d8af8..767a263a 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -115,14 +115,7 @@ PROMPT is a string to prompt with. CHOICES is a list of (delete-char 1))))))) (goto-char pos))) -(defvar ledger-post-amount-regex - (concat "\\( \\|\t\\| \t\\)[ \t]*-?" - "\\([A-Z$€£_]+ *\\)?" - "\\(-?[0-9,]+?\\)" - "\\(.[0-9]+\\)?" - "\\( *[[:word:]€£_\"]+\\)?" - "\\([ \t]*[@={]@?[^\n;]+?\\)?" - "\\([ \t]+;.+?\\|[ \t]*\\)?$")) + (defsubst ledger-next-amount (&optional end) "Move point to the next amount, as long as it is not past END. @@ -135,8 +128,6 @@ point at beginning of the commodity." (- (or (match-end 4) (match-end 3)) (point)))) -(defvar ledger-post-account-regex - "\\(^[ \t]+\\)\\([!*]?.+?\\)\\( \\|$\\)") (defun ledger-next-account (&optional end) "Move point to the beginning of the next account, or status marker (!*), as long as it is not past END. diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index bec6d175..ccf733b7 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -62,6 +62,16 @@ reconcile-finish will mark all pending posting cleared." :type 'boolean :group 'ledger-reconcile) +(defcustom ledger-reconcile-default-date-format "%Y/%m/%d" + "Default date format for the reconcile buffer" + :type 'string + :group 'ledger-reconcile) + +(defcustom ledger-reconcile-target-prompt-string "Target amount for reconciliation " + "Default prompt for recon target prompt" + :type 'string + :group 'ledger-reconcile) + (defun ledger-reconcile-get-cleared-or-pending-balance () "Calculate the cleared or pending balance of the account." @@ -299,7 +309,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (insert (format "%s %-4s %-30s %-30s %15s\n" (format-time-string (if date-format date-format - "%Y/%m/%d") (nth 2 xact)) + ledger-reconcile-default-date-format) (nth 2 xact)) (if (nth 3 xact) (nth 3 xact) "") @@ -409,7 +419,7 @@ moved and recentered. If they aren't strange things happen." (defun ledger-reconcile-change-target () "Change the target amount for the reconciliation process." (interactive) - (setq ledger-target (ledger-read-commodity-string "Set reconciliation target"))) + (setq ledger-target (ledger-read-commodity-string ledger-reconcile-target-prompt-string))) (define-derived-mode ledger-reconcile-mode text-mode "Reconcile" "A mode for reconciling ledger entries." diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el index 7c92bf15..24a3ae23 100644 --- a/lisp/ldg-regex.el +++ b/lisp/ldg-regex.el @@ -24,11 +24,23 @@ (eval-when-compile (require 'cl)) +(defvar ledger-amount-decimal-comma-regex + "-?[1-9][0-9.]*[,]?[0-9]*") + +(defvar ledger-amount-decimal-period-regex + "-?[1-9][0-9.]*[.]?[0-9]*") + (defvar ledger-other-entries-regex - "^\\(\\([~=].+\\)\\|\\(^\\([A-Za-z]+ .+\\)\\)\\)") + "\\(^[~=A-Za-z].+\\)+") +;\\|^\\([A-Za-z] .+\\)\\) + +(defvar ledger-xact-payee-regex + (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" + "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)")) (defvar ledger-comment-regex "\\( \\| \\|^\\)\\(;.*\\)") + (defvar ledger-payee-pending-regex "^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)") @@ -38,19 +50,40 @@ (defvar ledger-payee-uncleared-regex "^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)") +(defvar ledger-iso-date-regex + "\\([12][0-9]\\{3\\}\\)[-/]\\([0-9]\\{2\\}\\)[-/]\\([0-9]\\{2\\}\\)") + +(defvar ledger-init-string-regex + "^--.+?\\($\\|[ ]\\)") (defvar ledger-posting-account-all-regex "\\(^[ \t]+\\)\\(.+?\\)\\( \\|$\\)") +(defvar ledger-sort-next-record-regex + (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" + "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)")) + (defvar ledger-posting-account-cleared-regex "\\(^[ \t]+\\)\\(\\*.+?\\)\\( \\|$\\)") +(defvar ledger-complete-account-regex + "^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") + (defvar ledger-posting-account-pending-regex "\\(^[ \t]+\\)\\(!.+?\\)\\( \\|$\\)") (defvar ledger-date-regex "\\([0-9]+\\)[/-]\\([0-9]+\\)[/-]\\([0-9]+\\)") +(defvar ledger-post-amount-regex + (concat "\\( \\|\t\\| \t\\)[ \t]*-?" + "\\([A-Z$€£_]+ *\\)?" + "\\(-?[0-9,]+?\\)" + "\\(.[0-9]+\\)?" + "\\( *[[:word:]€£_\"]+\\)?" + "\\([ \t]*[@={]@?[^\n;]+?\\)?" + "\\([ \t]+;.+?\\|[ \t]*\\)?$")) + (defmacro ledger-define-regexp (name regex docs &rest args) "Simplify the creation of a Ledger regex and helper functions." (let ((defs diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el index 5119db5d..b106173b 100644 --- a/lisp/ldg-sort.el +++ b/lisp/ldg-sort.el @@ -28,9 +28,8 @@ (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) + (if (re-search-forward ledger-sort-next-record-regex + nil t) (goto-char (match-beginning 0)) (goto-char (point-max)))) diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index d6ccc2bf..66d3f46f 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -53,7 +53,7 @@ within the transaction." (defun ledger-highlight-xact-under-point () "Move the highlight overlay to the current transaction." -(if ledger-highlight-xact-under-point + (if ledger-highlight-xact-under-point (let ((exts (ledger-find-xact-extents (point))) (ovl highlight-overlay)) (if (not highlight-overlay) @@ -63,7 +63,7 @@ within the transaction." (cadr exts) (current-buffer) t nil))) (move-overlay ovl (car exts) (cadr exts))) - (overlay-put ovl 'face 'ledger-font-highlight-face) + (overlay-put ovl 'face 'ledger-font-xact-highlight-face) (overlay-put ovl 'priority 100)))) (defun ledger-xact-payee () -- cgit v1.2.3 From 1a52899673f02b87b065c5b29755394581b485c9 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 3 Apr 2013 16:30:36 -0700 Subject: Fix copy-at-point and more regex consolidation and cleanup --- lisp/ldg-complete.el | 6 ++-- lisp/ldg-fonts.el | 12 ++++---- lisp/ldg-mode.el | 53 +++++---------------------------- lisp/ldg-post.el | 4 +-- lisp/ldg-regex.el | 82 +++++++++++++++++++++++++--------------------------- lisp/ldg-sort.el | 4 +-- lisp/ldg-xact.el | 51 +++++++++++++++++++++++++++----- 7 files changed, 103 insertions(+), 109 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index 3462c0bb..0be4f438 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -52,7 +52,7 @@ (save-excursion (goto-char (point-min)) (while (re-search-forward - ledger-xact-payee-regex nil t) ;; matches first line + ledger-payee-any-status-regex nil t) ;; matches first line (unless (and (>= origin (match-beginning 0)) (< origin (match-end 0))) (setq payees-list (cons (match-string-no-properties 3) @@ -69,7 +69,7 @@ Return tree structure" (save-excursion (goto-char (point-min)) (while (re-search-forward - ledger-complete-account-regex nil t) + ledger-account-any-status-regex nil t) (unless (and (>= origin (match-beginning 0)) (< origin (match-end 0))) (setq account-elements @@ -153,7 +153,7 @@ Does not use ledger xact" (setq rest-of-name (match-string 3)) ;; Start copying the postings (forward-line) - (while (looking-at ledger-post-account-regex) + (while (looking-at ledger-complete-account-regex) (setq xacts (cons (buffer-substring-no-properties (line-beginning-position) (line-end-position)) diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el index 81b5b0bf..d83e7f9b 100644 --- a/lisp/ldg-fonts.el +++ b/lisp/ldg-fonts.el @@ -121,12 +121,12 @@ 'ledger-font-payee-cleared-face) ; Works (,ledger-payee-uncleared-regex 2 'ledger-font-payee-uncleared-face) ; Works - (,ledger-posting-account-cleared-regex 2 - 'ledger-font-posting-account-cleared-face) ; Works - (,ledger-posting-account-pending-regex 2 - 'ledger-font-posting-account-pending-face) ; Works - (,ledger-posting-account-all-regex 2 - 'ledger-font-posting-account-face)) ; Works + (,ledger-account-cleared-regex 2 + 'ledger-font-posting-account-cleared-face) ; Works + (,ledger-account-pending-regex 2 + 'ledger-font-posting-account-pending-face) ; Works + (,ledger-account-any-status-regex 2 + 'ledger-font-posting-account-face)) ; Works "Expressions to highlight in Ledger mode.") diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index df9dda87..f1b434e9 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -101,7 +101,7 @@ Can be pcomplete, or align-posting" (define-key map [(control ?c) (control ?d)] 'ledger-delete-current-transaction) (define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-transaction) (define-key map [(control ?c) (control ?f)] 'ledger-occur) - (define-key map [(control ?c) (control ?k)] 'ledger-copy-transaction) + (define-key map [(control ?c) (control ?k)] 'ledger-copy-transaction-at-point) (define-key map [(control ?c) (control ?m)] 'ledger-set-month) (define-key map [(control ?c) (control ?r)] 'ledger-reconcile) (define-key map [(control ?c) (control ?s)] 'ledger-sort-region) @@ -144,7 +144,7 @@ Can be pcomplete, or align-posting" (define-key map [sort-reg] '(menu-item "Sort Region" ledger-sort-region :enable mark-active)) (define-key map [align-reg] '(menu-item "Align Region" ledger-post-align-postings :enable mark-active)) (define-key map [sep2] '(menu-item "--")) - (define-key map [copy-xact] '(menu-item "Copy Trans at Point" ledger-copy-transaction)) + (define-key map [copy-xact] '(menu-item "Copy Trans at Point" ledger-copy-transaction-at-point)) (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-transaction)) (define-key map [sep4] '(menu-item "--")) @@ -172,43 +172,6 @@ Return the difference in the format of a time value." (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 - (lambda (start date mark desc) - (if (ledger-time-less-p moment date) - (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)))) - (while (not (eobp)) - (when (looking-at - (concat "\\(Y\\s-+\\([0-9]+\\)\\|" - "\\([0-9]\\{4\\}+\\)?[./-]?" - "\\([0-9]+\\)[./-]\\([0-9]+\\)\\s-+" - "\\(\\*\\s-+\\)?\\(.+\\)\\)")) - (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))))) - (forward-line)))) (defun ledger-set-year (newyear) "Set ledger's idea of the current year to the prefix argument NEWYEAR." @@ -227,7 +190,7 @@ MOMENT is an encoded date" (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 +there, otherwise call `ledger-xact-find-slot' to insert it at the correct chronological place in the buffer." (interactive (list (read-string "Transaction: " (concat ledger-year "/" ledger-month "/")))) @@ -238,12 +201,12 @@ correct chronological place in the buffer." exit-code) (unless insert-at-point (let ((date (car args))) - (if (string-match ledger-iso-date-regex date) + (if (string-match ledger-iso-date-regexp date) (setq date - (encode-time 0 0 0 (string-to-number (match-string 3 date)) - (string-to-number (match-string 2 date)) - (string-to-number (match-string 1 date))))) - (ledger-find-slot date))) + (encode-time 0 0 0 (string-to-number (match-string 4 date)) + (string-to-number (match-string 3 date)) + (string-to-number (match-string 2 date))))) + (ledger-xact-find-slot date))) (if (> (length args) 1) (save-excursion (insert diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 767a263a..88387fd1 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -122,7 +122,7 @@ PROMPT is a string to prompt with. CHOICES is a list of Return the width of the amount field as an integer and leave point at beginning of the commodity." ;;(beginning-of-line) - (when (re-search-forward ledger-post-amount-regex end t) + (when (re-search-forward ledger-amount-regex end t) (goto-char (match-beginning 0)) (skip-syntax-forward " ") (- (or (match-end 4) @@ -134,7 +134,7 @@ point at beginning of the commodity." Return the column of the beginning of the account and leave point at beginning of account" (if (> end (point)) - (when (re-search-forward ledger-posting-account-all-regex (1+ end) t) + (when (re-search-forward ledger-account-any-status-regex (1+ end) t) ;; the 1+ is to make sure we can catch the newline (goto-char (match-beginning 2)) (current-column)))) diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el index 24a3ae23..95da77e2 100644 --- a/lisp/ldg-regex.el +++ b/lisp/ldg-regex.el @@ -24,58 +24,45 @@ (eval-when-compile (require 'cl)) -(defvar ledger-amount-decimal-comma-regex +(defconst ledger-amount-decimal-comma-regex "-?[1-9][0-9.]*[,]?[0-9]*") -(defvar ledger-amount-decimal-period-regex +(defconst ledger-amount-decimal-period-regex "-?[1-9][0-9.]*[.]?[0-9]*") -(defvar ledger-other-entries-regex +(defconst ledger-other-entries-regex "\\(^[~=A-Za-z].+\\)+") ;\\|^\\([A-Za-z] .+\\)\\) -(defvar ledger-xact-payee-regex - (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" - "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)")) -(defvar ledger-comment-regex +(defconst ledger-comment-regex "\\( \\| \\|^\\)\\(;.*\\)") -(defvar ledger-payee-pending-regex - "^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)") +(defconst ledger-payee-any-status-regex + "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") -(defvar ledger-payee-cleared-regex - "^[0-9]+[-/.=][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)") +(defconst ledger-payee-pending-regex + "^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)") -(defvar ledger-payee-uncleared-regex - "^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)") +(defconst ledger-payee-cleared-regex + "^[0-9]+[-/.=][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)") -(defvar ledger-iso-date-regex - "\\([12][0-9]\\{3\\}\\)[-/]\\([0-9]\\{2\\}\\)[-/]\\([0-9]\\{2\\}\\)") +(defconst ledger-payee-uncleared-regex + "^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)") -(defvar ledger-init-string-regex +(defconst ledger-init-string-regex "^--.+?\\($\\|[ ]\\)") -(defvar ledger-posting-account-all-regex - "\\(^[ \t]+\\)\\(.+?\\)\\( \\|$\\)") +(defconst ledger-account-any-status-regex + "^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") -(defvar ledger-sort-next-record-regex - (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" - "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)")) - -(defvar ledger-posting-account-cleared-regex - "\\(^[ \t]+\\)\\(\\*.+?\\)\\( \\|$\\)") - -(defvar ledger-complete-account-regex - "^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") - -(defvar ledger-posting-account-pending-regex +(defconst ledger-account-pending-regex "\\(^[ \t]+\\)\\(!.+?\\)\\( \\|$\\)") -(defvar ledger-date-regex - "\\([0-9]+\\)[/-]\\([0-9]+\\)[/-]\\([0-9]+\\)") +(defconst ledger-account-cleared-regex + "\\(^[ \t]+\\)\\(\\*.+?\\)\\( \\|$\\)") -(defvar ledger-post-amount-regex +(defconst ledger-amount-regex (concat "\\( \\|\t\\| \t\\)[ \t]*-?" "\\([A-Z$€£_]+ *\\)?" "\\(-?[0-9,]+?\\)" @@ -84,6 +71,7 @@ "\\([ \t]*[@={]@?[^\n;]+?\\)?" "\\([ \t]+;.+?\\|[ \t]*\\)?$")) + (defmacro ledger-define-regexp (name regex docs &rest args) "Simplify the creation of a Ledger regex and helper functions." (let ((defs @@ -179,23 +167,23 @@ (put 'ledger-define-regexp 'lisp-indent-function 1) -(ledger-define-regexp date - (let ((sep '(or ?- (any ?. ?/)))) ; can't do (any ?- ?. ?/) due to bug +(ledger-define-regexp iso-date + ( let ((sep '(or ?- ?/))) (rx (group - (and (? (= 4 num) - (eval sep)) - (and num (? num)) + (and (group (? (= 4 num))) + (eval sep) + (group (and num (? num))) (eval sep) - (and num (? num)))))) + (group (and num (? num))))))) "Match a single date, in its 'written' form.") (ledger-define-regexp full-date (macroexpand - `(rx (and (regexp ,ledger-date-regexp) - (? (and ?= (regexp ,ledger-date-regexp)))))) + `(rx (and (regexp ,ledger-iso-date-regexp) + (? (and ?= (regexp ,ledger-iso-date-regexp)))))) "Match a compound date, of the form ACTUAL=EFFECTIVE" - (actual date) - (effective date)) + (actual iso-date) + (effective iso-date)) (ledger-define-regexp state (rx (group (any ?! ?*))) @@ -292,7 +280,7 @@ (macroexpand `(rx (* (+ blank) (or (and ?\{ (regexp ,ledger-commoditized-amount-regexp) ?\}) - (and ?\[ (regexp ,ledger-date-regexp) ?\]) + (and ?\[ (regexp ,ledger-iso-date-regexp) ?\]) (and ?\( (not (any ?\))) ?\)))))) "") @@ -328,4 +316,12 @@ (amount full-amount) (note end-note)) +(defconst ledger-iterate-regex + (concat "\\(Y\\s-+\\([0-9]+\\)\\|" ;; Catches a Y directive + ledger-iso-date-regexp + "\\([ *!]+\\)" ;; mark + "\\((.*)\\)" ;; code + "\\(.*\\)" ;; desc + "\\)")) + (provide 'ldg-regex) diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el index b106173b..f426a7ef 100644 --- a/lisp/ldg-sort.el +++ b/lisp/ldg-sort.el @@ -28,8 +28,8 @@ (defun ledger-next-record-function () "Move point to next transaction." - (if (re-search-forward ledger-sort-next-record-regex - nil t) + (if (re-search-forward ledger-payee-any-status-regex + nil t) (goto-char (match-beginning 0)) (goto-char (point-max)))) diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index 66d3f46f..31b9818f 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -76,6 +76,41 @@ within the transaction." (ledger-context-field-value context-info 'payee) nil)))) +(defun ledger-xact-find-slot (moment) + "Find the right place in the buffer for a transaction at MOMENT. +MOMENT is an encoded date" + (catch 'found + (ledger-xact-iterate-transactions + (function + (lambda (start date mark desc) + (if (ledger-time-less-p moment date) + (throw 'found t))))))) + +(defun ledger-xact-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)))) + (while (not (eobp)) + (when (looking-at ledger-iterate-regex) + (let ((found-y-p (match-string 2))) + (if found-y-p + (setq current-year (string-to-number found-y-p)) ;; a Y directive was found + (let ((start (match-beginning 0)) + (year (match-string 4)) + (month (string-to-number (match-string 5))) + (day (string-to-number (match-string 6))) + (mark (match-string 7)) + (code (match-string 8)) + (desc (match-string 9))) + (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)))) + (defsubst ledger-goto-line (line-number) "Rapidly move point to line LINE-NUMBER." (goto-char (point-min)) @@ -106,17 +141,17 @@ within the transaction." (extents (ledger-find-xact-extents (point))) (transaction (buffer-substring-no-properties (car extents) (cadr extents))) encoded-date) - (if (string-match ledger-date-regex date) + (if (string-match ledger-iso-date-regexp date) (setq encoded-date - (encode-time 0 0 0 (string-to-number (match-string 3 date)) - (string-to-number (match-string 2 date)) - (string-to-number (match-string 1 date))))) - (ledger-find-slot encoded-date) + (encode-time 0 0 0 (string-to-number (match-string 4 date)) + (string-to-number (match-string 3 date)) + (string-to-number (match-string 2 date))))) + (ledger-xact-find-slot encoded-date) (insert transaction "\n") - (backward-paragraph) - (re-search-forward ledger-date-regex) + (backward-paragraph 2) + (re-search-forward ledger-iso-date-regexp) (replace-match date) - (re-search-forward "[1-9][0-9]+\.[0-9]+"))) + (ledger-next-amount))) (provide 'ldg-xact) -- cgit v1.2.3 From 063b027fbbed83c0ccd9a43dff97204590a07f02 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 4 Apr 2013 12:22:27 -0700 Subject: Fixed bug that caused ledger-mode interfere with other mode that used indent-region --- lisp/ldg-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index f1b434e9..cf0f56e7 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -92,7 +92,7 @@ Can be pcomplete, or align-posting" (ledger-init-load-init-file) - (setq indent-region-function 'ledger-post-align-postings) + (set (make-local-variable 'indent-region-function) 'ledger-post-align-postings) (let ((map (current-local-map))) (define-key map [(control ?c) (control ?a)] 'ledger-add-transaction) -- cgit v1.2.3 From 2547894586b4fffb9782794e42ae62f1631d36ee Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 4 Apr 2013 12:34:16 -0700 Subject: Fix next-account so that status markers can be manually entered into a buffer when auto alignment is on. --- lisp/ldg-post.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 88387fd1..18a70b1a 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -136,13 +136,17 @@ at beginning of account" (if (> end (point)) (when (re-search-forward ledger-account-any-status-regex (1+ end) t) ;; the 1+ is to make sure we can catch the newline - (goto-char (match-beginning 2)) + (if (match-beginning 1) + (goto-char (match-beginning 1)) + (goto-char (match-beginning 2))) (current-column)))) (defun ledger-post-align-postings (&optional beg end) "Align all accounts and amounts within region, if there is no region align the posting on the current line." (interactive) + (assert (eq major-mode 'ledger-mode)) + (save-excursion (if (or (not (mark)) (not (use-region-p))) @@ -245,7 +249,7 @@ BEG, END, and LEN control how far it can align." (defun ledger-post-setup () "Configure `ledger-mode' to auto-align postings." (add-hook 'after-change-functions 'ledger-post-maybe-align t t) - (add-hook 'after-save-hook #'(lambda () (setq ledger-post-current-list nil)))) + (add-hook 'after-save-hook #'(lambda () (setq ledger-post-current-list nil)) t t)) (defun ledger-post-read-account-with-prompt (prompt) -- cgit v1.2.3 From 650361a6d388c98074b9d30f91361ce8cb06a65d Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 4 Apr 2013 12:34:59 -0700 Subject: Fix ledger-complete-entry for stale regex --- lisp/ldg-complete.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index 0be4f438..f01e6e90 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -153,7 +153,7 @@ Does not use ledger xact" (setq rest-of-name (match-string 3)) ;; Start copying the postings (forward-line) - (while (looking-at ledger-complete-account-regex) + (while (looking-at ledger-account-any-status-regex) (setq xacts (cons (buffer-substring-no-properties (line-beginning-position) (line-end-position)) -- cgit v1.2.3 From 2e78e61be7ba6aa73c56c157405e45ed30990b31 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 4 Apr 2013 12:35:20 -0700 Subject: Regex Cleanup --- lisp/ldg-reconcile.el | 3 +-- lisp/ldg-regex.el | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index ccf733b7..ff808485 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -227,8 +227,7 @@ Return the number of uncleared xacts found." (set-buffer-modified-p nil) (ledger-display-balance) (goto-char curpoint) - ;; (ledger-reconcile-visit t) - ))) + (ledger-reconcile-visit t)))) (defun ledger-reconcile-finish () "Mark all pending posting or transactions as cleared. diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el index 95da77e2..1b338012 100644 --- a/lisp/ldg-regex.el +++ b/lisp/ldg-regex.el @@ -54,7 +54,7 @@ "^--.+?\\($\\|[ ]\\)") (defconst ledger-account-any-status-regex - "^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") + "^[ \t]+\\([*!]\\s-+\\)?\\([[(]?.+?\\)\\(\t\\|\n\\| [ \t]\\)") (defconst ledger-account-pending-regex "\\(^[ \t]+\\)\\(!.+?\\)\\( \\|$\\)") -- cgit v1.2.3 From 35febddf3fc9be89dbe93bce85ea4fac6d6a42c9 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 5 Apr 2013 10:50:31 -0700 Subject: Fixed ledger-font-other line. Thanks Thierry! --- lisp/ldg-fonts.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el index d83e7f9b..a76051fb 100644 --- a/lisp/ldg-fonts.el +++ b/lisp/ldg-fonts.el @@ -126,7 +126,9 @@ (,ledger-account-pending-regex 2 'ledger-font-posting-account-pending-face) ; Works (,ledger-account-any-status-regex 2 - 'ledger-font-posting-account-face)) ; Works + 'ledger-font-posting-account-face) ; Works + (,ledger-other-entries-regex 1 + 'ledger-font-other-face)) "Expressions to highlight in Ledger mode.") -- cgit v1.2.3 From a373f9f4e5bef088888adc234783087e71e45a78 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 5 Apr 2013 12:24:54 -0700 Subject: other font cleanup --- lisp/ldg-fonts.el | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el index a76051fb..cb7a81c0 100644 --- a/lisp/ldg-fonts.el +++ b/lisp/ldg-fonts.el @@ -50,7 +50,7 @@ :group 'ledger-faces) (defface ledger-font-other-face - `((t :foreground "#657b83" :weight bold)) + `((t :foreground "#657b83" )) "Default face for other transactions" :group 'ledger-faces) @@ -132,11 +132,6 @@ "Expressions to highlight in Ledger mode.") -;; (defvar ledger-font-lock-keywords -;; `( (,ledger-other-entries-regex 1 -;; ledger-font-other-face)) -;; "Expressions to highlight in Ledger mode.") - (provide 'ldg-fonts) ;;; ldg-fonts.el ends here -- cgit v1.2.3 From 5165b19d077b8b4ea6dfe4a8902cef0c3ea5d0db Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 5 Apr 2013 23:18:24 -0700 Subject: Rewrote align-postings again to improve handling of long account-names. It now leaves exactly 2 space between the commodity and the account if the amount would have stomped on the account. --- lisp/ldg-post.el | 39 ++++++++++++++++++++------------------- 1 file changed, 20 insertions(+), 19 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 18a70b1a..f5c2f0f1 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -160,7 +160,7 @@ region align the posting on the current line." (end-region (if end end (if mark-first (point) (mark)))) - acc-col amt-offset acc-adjust + acct-start-column amt-width acct-adjust acct-end-column (lines-left 1)) ;; Condition point and mark to the beginning and end of lines (goto-char end-region) @@ -171,29 +171,30 @@ region align the posting on the current line." (line-beginning-position))) ;; This is the guts of the alignment loop - (while (and (or (setq acc-col (ledger-next-account (line-end-position))) + (while (and (or (setq acct-start-column (ledger-next-account (line-end-position))) lines-left) (< (point) end-region)) - (when acc-col - (when (/= (setq acc-adjust (- ledger-post-account-alignment-column acc-col)) 0) - (if (> acc-adjust 0) - (insert (make-string acc-adjust ? )) - (delete-char acc-adjust))) - (when (setq amt-offset (ledger-next-amount (line-end-position))) - (let* ((amt-adjust (- ledger-post-amount-alignment-column - amt-offset - (current-column) - 2))) + (when acct-start-column + (setq acct-end-column (save-excursion + (goto-char (match-end 2)) + (current-column))) + (when (/= (setq acct-adjust (- ledger-post-account-alignment-column acct-start-column)) 0) + (setq acct-end-column (+ acct-end-column acct-adjust)) + (if (> acct-adjust 0) + (insert (make-string acct-adjust ? )) + (delete-char acct-adjust))) + (when (setq amt-width (ledger-next-amount (line-end-position))) + (let ((amt-adjust (- (if (> (- ledger-post-amount-alignment-column amt-width) + (+ 2 acct-end-column)) + ledger-post-amount-alignment-column + (+ acct-end-column + 2 amt-width)) + amt-width + (current-column)))) (if (/= amt-adjust 0) (if (> amt-adjust 0) (insert (make-string amt-adjust ? )) - (let ((curpoint (point))) - (beginning-of-line) - (ledger-next-account (line-end-position)) - (when (> (+ curpoint amt-adjust) - (match-end 2)) - (goto-char curpoint) - (delete-char amt-adjust)))))))) + (delete-char amt-adjust)))))) (forward-line) (setq lines-left (not (eobp)))) (setq inhibit-modification-hooks nil)))) -- cgit v1.2.3 From f80fb99039e60869ae8497914baa25ca079e5483 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 6 Apr 2013 07:34:27 -0700 Subject: Code cleanup of align postings --- lisp/ldg-post.el | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index f5c2f0f1..338264f5 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -160,7 +160,7 @@ region align the posting on the current line." (end-region (if end end (if mark-first (point) (mark)))) - acct-start-column amt-width acct-adjust acct-end-column + acct-start-column acct-end-column acct-adjust amt-width (lines-left 1)) ;; Condition point and mark to the beginning and end of lines (goto-char end-region) @@ -179,22 +179,20 @@ region align the posting on the current line." (goto-char (match-end 2)) (current-column))) (when (/= (setq acct-adjust (- ledger-post-account-alignment-column acct-start-column)) 0) - (setq acct-end-column (+ acct-end-column acct-adjust)) + (setq acct-end-column (+ acct-end-column acct-adjust)) ;;adjust the account ending column (if (> acct-adjust 0) (insert (make-string acct-adjust ? )) (delete-char acct-adjust))) (when (setq amt-width (ledger-next-amount (line-end-position))) - (let ((amt-adjust (- (if (> (- ledger-post-amount-alignment-column amt-width) - (+ 2 acct-end-column)) - ledger-post-amount-alignment-column - (+ acct-end-column - 2 amt-width)) - amt-width - (current-column)))) - (if (/= amt-adjust 0) - (if (> amt-adjust 0) - (insert (make-string amt-adjust ? )) - (delete-char amt-adjust)))))) + (if (/= 0 (setq amt-adjust (- (if (> (- ledger-post-amount-alignment-column amt-width) + (+ 2 acct-end-column)) + ledger-post-amount-alignment-column ;;we have room + (+ acct-end-column 2 amt-width)) + amt-width + (current-column)))) + (if (> amt-adjust 0) + (insert (make-string amt-adjust ? )) + (delete-char amt-adjust))))) (forward-line) (setq lines-left (not (eobp)))) (setq inhibit-modification-hooks nil)))) -- 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') 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 From 98f8df5583f16792243aeadee9ed19bd8b3f7897 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 7 Apr 2013 14:48:33 -0700 Subject: Regex consistency and cleanup. --- lisp/ldg-regex.el | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el index 1b338012..226475df 100644 --- a/lisp/ldg-regex.el +++ b/lisp/ldg-regex.el @@ -24,6 +24,15 @@ (eval-when-compile (require 'cl)) +(defconst ledger-amount-regex + (concat "\\( \\|\t\\| \t\\)[ \t]*-?" + "\\([A-Z$€£_]+ *\\)?" + "\\(-?[0-9,]+?\\)" + "\\(.[0-9]+\\)?" + "\\( *[[:word:]€£_\"]+\\)?" + "\\([ \t]*[@={]@?[^\n;]+?\\)?" + "\\([ \t]+;.+?\\|[ \t]*\\)?$")) + (defconst ledger-amount-decimal-comma-regex "-?[1-9][0-9.]*[,]?[0-9]*") @@ -33,8 +42,6 @@ (defconst ledger-other-entries-regex "\\(^[~=A-Za-z].+\\)+") -;\\|^\\([A-Za-z] .+\\)\\) - (defconst ledger-comment-regex "\\( \\| \\|^\\)\\(;.*\\)") @@ -42,13 +49,13 @@ "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") (defconst ledger-payee-pending-regex - "^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)") + "^[0-9]+[-/][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)") (defconst ledger-payee-cleared-regex - "^[0-9]+[-/.=][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)") + "^[0-9]+[-/][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)") (defconst ledger-payee-uncleared-regex - "^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)") + "^[0-9]+[-/][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)") (defconst ledger-init-string-regex "^--.+?\\($\\|[ ]\\)") @@ -62,14 +69,6 @@ (defconst ledger-account-cleared-regex "\\(^[ \t]+\\)\\(\\*.+?\\)\\( \\|$\\)") -(defconst ledger-amount-regex - (concat "\\( \\|\t\\| \t\\)[ \t]*-?" - "\\([A-Z$€£_]+ *\\)?" - "\\(-?[0-9,]+?\\)" - "\\(.[0-9]+\\)?" - "\\( *[[:word:]€£_\"]+\\)?" - "\\([ \t]*[@={]@?[^\n;]+?\\)?" - "\\([ \t]+;.+?\\|[ \t]*\\)?$")) (defmacro ledger-define-regexp (name regex docs &rest args) -- cgit v1.2.3 From 33c046d06876915864de397ed1c3d8d671ffd1db Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 8 Apr 2013 10:35:55 -0700 Subject: Added quick balance check to ledger-mode --- doc/ledger-mode.texi | 8 ++++++++ lisp/ldg-mode.el | 17 ++++++++++++++++ lisp/ldg-reconcile.el | 56 ++++++++++++++++++++++++--------------------------- 3 files changed, 51 insertions(+), 30 deletions(-) (limited to 'lisp') diff --git a/doc/ledger-mode.texi b/doc/ledger-mode.texi index 34c38dae..d7144112 100644 --- a/doc/ledger-mode.texi +++ b/doc/ledger-mode.texi @@ -233,6 +233,14 @@ automatically place any amounts such that their last digit is aligned to the column specified by @code{ledger-post-amount-alignment-column}, which defaults to 52. @xref{Ledger Post Customization Group}. +@node Quick Balance Display +@subsection Quick Balance Display +You will often want to quickly check the balance of an account. The +easiest way it to position point on the account you are interested in, +and type @code{C-C C-P}. The minibuffer will ask you to verify the name +of the account you want, if it is already correct hit return, then the +balance of the account will be displayed in the minibuffer. + @node Editing Amounts, Marking Transactions, Adding Transactions, The Ledger Buffer @section Editing Amounts GNU Calc is a very powerful Reverse Polish Notation calculator built diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 6dea1735..98236980 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -56,6 +56,21 @@ ": ")))) (read-string default-prompt nil 'ledger-minibuffer-history default))) +(defun ledger-display-balance-at-point () + "Display the cleared-or-pending balance. +And calculate the target-delta of the account being reconciled." + (interactive) + + (let* ((account (ledger-read-account-with-prompt "Account balance to show")) + (pending (ledger-reconcile-get-cleared-or-pending-balance (current-buffer) account))) + (when pending + (if ledger-target + (message "Pending balance: %s, Difference from target: %s" + (ledger-commodity-to-string pending) + (ledger-commodity-to-string (-commodity ledger-target pending))) + (message "Pending balance: %s" + (ledger-commodity-to-string pending)))))) + (defun ledger-magic-tab (&optional interactively) "Decide what to with with . Can be pcomplete, or align-posting" @@ -120,6 +135,7 @@ Can be pcomplete, or align-posting" (define-key map [(control ?c) (control ?t)] 'ledger-insert-effective-date) (define-key map [(control ?c) (control ?u)] 'ledger-schedule-upcoming) (define-key map [(control ?c) (control ?y)] 'ledger-set-year) + (define-key map [(control ?c) (control ?p)] 'ledger-display-balance-at-point) (define-key map [tab] 'ledger-magic-tab) (define-key map [(control ?i)] 'ledger-magic-tab) (define-key map [(control ?c) tab] 'ledger-fully-complete-xact) @@ -163,6 +179,7 @@ Can be pcomplete, or align-posting" (define-key map [toggle-xact] '(menu-item "Toggle Current Transaction" ledger-toggle-current-transaction)) (define-key map [sep4] '(menu-item "--")) (define-key map [recon-account] '(menu-item "Reconcile Account" ledger-reconcile)) + (define-key map [check-balance] '(menu-item "Check Balance" ledger-display-balance-at-point)) (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 "--")) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index e5a5a8e7..ca4d0004 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -73,29 +73,28 @@ reconcile-finish will mark all pending posting cleared." :group 'ledger-reconcile) -(defun ledger-reconcile-get-cleared-or-pending-balance () +(defun ledger-reconcile-get-cleared-or-pending-balance (buffer account) "Calculate the cleared or pending balance of the account." - (interactive) + ;; 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 - ;; split arguments like the shell does, so you need to - ;; specify the individual fields in the command line. - (if (ledger-exec-ledger buffer (current-buffer) - "balance" "--limit" "cleared or pending" "--empty" "--collapse" - "--format" "%(display_total)" account) - (ledger-split-commodity-string - (buffer-substring-no-properties (point-min) (point-max))))))) + + (with-temp-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. + (if (ledger-exec-ledger buffer (current-buffer) + "balance" "--limit" "cleared or pending" "--empty" "--collapse" + "--format" "%(display_total)" account) + (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))) + (let* ((pending (ledger-reconcile-get-cleared-or-pending-balance ledger-buf ledger-acct))) (when pending (if ledger-target (message "Pending balance: %s, Difference from target: %s" @@ -103,9 +102,6 @@ And calculate the target-delta of the account being reconciled." (ledger-commodity-to-string (-commodity ledger-target pending))) (message "Pending balance: %s" (ledger-commodity-to-string pending)))))) - - - (defun is-stdin (file) "True if ledger FILE is standard input." @@ -169,7 +165,7 @@ Return the number of uncleared xacts found." (let ((curbuf (current-buffer)) (curpoint (point)) (recon-buf (get-buffer ledger-recon-buffer-name))) - (when (buffer-live-p recon-buf) + (when (buffer-live-p recon-buf) (with-current-buffer recon-buf (ledger-reconcile-refresh) (set-buffer-modified-p nil)) @@ -223,7 +219,7 @@ Return the number of uncleared xacts found." (dolist (buf (cons ledger-buf ledger-bufs)) (with-current-buffer buf (save-buffer))) - (with-current-buffer (get-buffer ledger-recon-buffer-name) + (with-current-buffer (get-buffer ledger-recon-buffer-name) (set-buffer-modified-p nil) (ledger-display-balance) (goto-char curpoint) @@ -293,7 +289,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (xacts (with-temp-buffer (when (ledger-exec-ledger buf (current-buffer) - "--uncleared" "--real" "emacs" account) + "--uncleared" "--real" "emacs" account) (setq ledger-success t) (goto-char (point-min)) (unless (eobp) @@ -326,7 +322,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." 'where where)))) )) (goto-char (point-max)) (delete-char -1)) ;gets rid of the extra line feed at the bottom of the list - (if ledger-success + (if ledger-success (insert (concat "There are no uncleared entries for " account)) (insert "Ledger has reported a problem. Check *Ledger Error* buffer."))) (goto-char (point-min)) @@ -341,7 +337,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." ledger buffer is at the bottom of the main window. The key to this is to ensure the window is selected when the buffer point is moved and recentered. If they aren't strange things happen." - + (let ((recon-window (get-buffer-window (get-buffer ledger-recon-buffer-name)))) (when recon-window (fit-window-to-buffer recon-window) @@ -379,7 +375,7 @@ moved and recentered. If they aren't strange things happen." (interactive) (let ((account (ledger-read-account-with-prompt "Account to reconcile")) (buf (current-buffer)) - (rbuf (get-buffer ledger-recon-buffer-name))) + (rbuf (get-buffer ledger-recon-buffer-name))) ;; this means only one *Reconcile* buffer, ever Set up the ;; reconcile buffer (if rbuf ;; *Reconcile* already exists @@ -389,21 +385,21 @@ moved and recentered. If they aren't strange things happen." ;; 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))) ;; no recon-buffer, starting from scratch. (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t) - - (with-current-buffer (setq rbuf + + (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 (save-excursion @@ -437,7 +433,7 @@ moved and recentered. If they aren't strange things happen." (define-key map [?s] 'ledger-reconcile-save) (define-key map [?q] 'ledger-reconcile-quit) (define-key map [?b] 'ledger-display-balance) - + (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)) @@ -458,7 +454,7 @@ moved and recentered. If they aren't strange things happen." (define-key map [menu-bar ldg-recon-menu fin] '("Finish" . ledger-reconcile-finish)) (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))) (provide 'ldg-reconcile) -- cgit v1.2.3 From 3adab52660d8b7aacf13669140d7a9414fb9a0a9 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 8 Apr 2013 10:45:04 -0700 Subject: Improve quick display. --- lisp/ldg-mode.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 98236980..85cec39f 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -65,10 +65,12 @@ And calculate the target-delta of the account being reconciled." (pending (ledger-reconcile-get-cleared-or-pending-balance (current-buffer) account))) (when pending (if ledger-target - (message "Pending balance: %s, Difference from target: %s" + (message "%s balance: %s, Difference from target: %s" + account (ledger-commodity-to-string pending) (ledger-commodity-to-string (-commodity ledger-target pending))) - (message "Pending balance: %s" + (message "%s balance: %s" + account (ledger-commodity-to-string pending)))))) (defun ledger-magic-tab (&optional interactively) -- cgit v1.2.3 From 76145828fd8b0ca6ec19b5f192bbd5829d0fa263 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 8 Apr 2013 11:40:10 -0700 Subject: Make quick balance showed "cleared" results --- lisp/ldg-mode.el | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 85cec39f..57fba674 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -62,16 +62,12 @@ And calculate the target-delta of the account being reconciled." (interactive) (let* ((account (ledger-read-account-with-prompt "Account balance to show")) - (pending (ledger-reconcile-get-cleared-or-pending-balance (current-buffer) account))) - (when pending - (if ledger-target - (message "%s balance: %s, Difference from target: %s" - account - (ledger-commodity-to-string pending) - (ledger-commodity-to-string (-commodity ledger-target pending))) - (message "%s balance: %s" - account - (ledger-commodity-to-string pending)))))) + (buffer (current-buffer)) + (balance (with-temp-buffer + (ledger-exec-ledger buffer (current-buffer) "cleared" account) + (buffer-substring-no-properties (point-min) (1- (point-max)))))) + (when balance + (message balance)))) (defun ledger-magic-tab (&optional interactively) "Decide what to with with . -- cgit v1.2.3 From dde09ef1a10580393ed44d07f7aab779219b8dcf Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 9 Apr 2013 21:22:11 -0700 Subject: Regex cleanup in ldg-context --- lisp/ldg-context.el | 53 +++++++++++++++++++++++++++++++++-------------------- 1 file changed, 33 insertions(+), 20 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-context.el b/lisp/ldg-context.el index 8861a30e..80e2d544 100644 --- a/lisp/ldg-context.el +++ b/lisp/ldg-context.el @@ -29,27 +29,40 @@ (require 'cl)) +(defconst indent-string "\\(^[ \t]+\\)") +(defconst status-string "\\([*! ]?\\)") +(defconst account-string "[\\[(]?\\(.*?\\)[])]?") +(defconst amount-string "\\s-\\s-[ \t]+\\(-?[0-9]+\\.[0-9]*\\)") +(defconst comment-string "[ \t]*;[ \t]*\\(.*?\\)") +(defconst nil-string "[ \t]+") +(defconst commodity-string "\\(.*\\)") +(defconst date-string "^\\(\\([0-9]\\{4\\}[/-]\\)?[01]?[0-9][/-][0123]?[0-9]\\)") +(defconst code-string "\\((\\(.*\\))\\)?") +(defconst payee-string "\\(.*\\)") + +(defmacro single-line-config (&rest elements) +"Take list of ELEMENTS and return regex and element list for use in context-at-point" + (let (regex-string) + `'(,(concat (dolist (e elements regex-string) + (setq regex-string + (concat regex-string + (eval + (intern + (concat (symbol-name e) "-string")))))) "[ \t]*$") + ,(append elements)))) + + (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)))))) + `((xact (,(single-line-config date nil status nil nil code payee comment) + ,(single-line-config date nil status nil nil code payee))) + (acct-transaction (,(single-line-config indent comment) + ,(single-line-config indent status account commodity amount nil comment) + ,(single-line-config indent status account commodity amount) + ,(single-line-config indent status account amount nil commodity comment) + ,(single-line-config indent status account amount nil commodity) + ,(single-line-config indent status account amount) + ,(single-line-config indent status account comment) + ,(single-line-config indent status account))))) (defun ledger-extract-context-info (line-type pos) "Get context info for current line with LINE-TYPE. -- cgit v1.2.3 From 1286bdeda07792696bb9dfc462488744920695e2 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 10 Apr 2013 06:33:46 -0700 Subject: even better context regex generation --- lisp/ldg-context.el | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-context.el b/lisp/ldg-context.el index 80e2d544..2915133c 100644 --- a/lisp/ldg-context.el +++ b/lisp/ldg-context.el @@ -28,7 +28,8 @@ (eval-when-compile (require 'cl)) - +;; *-string constants are assembled in the single-line-config macro to +;; form the regex and list of elements (defconst indent-string "\\(^[ \t]+\\)") (defconst status-string "\\([*! ]?\\)") (defconst account-string "[\\[(]?\\(.*?\\)[])]?") @@ -49,20 +50,20 @@ (eval (intern (concat (symbol-name e) "-string")))))) "[ \t]*$") - ,(append elements)))) + ,elements))) (defconst ledger-line-config - `((xact (,(single-line-config date nil status nil nil code payee comment) - ,(single-line-config date nil status nil nil code payee))) - (acct-transaction (,(single-line-config indent comment) - ,(single-line-config indent status account commodity amount nil comment) - ,(single-line-config indent status account commodity amount) - ,(single-line-config indent status account amount nil commodity comment) - ,(single-line-config indent status account amount nil commodity) - ,(single-line-config indent status account amount) - ,(single-line-config indent status account comment) - ,(single-line-config indent status account))))) + (list (list 'xact (list (single-line-config date nil status nil nil code payee comment) + (single-line-config date nil status nil nil code payee))) + (list 'acct-transaction (list (single-line-config indent comment) + (single-line-config indent status account commodity amount nil comment) + (single-line-config indent status account commodity amount) + (single-line-config indent status account amount nil commodity comment) + (single-line-config indent status account amount nil commodity) + (single-line-config indent status account amount) + (single-line-config indent status account comment) + (single-line-config indent status account))))) (defun ledger-extract-context-info (line-type pos) "Get context info for current line with LINE-TYPE. -- cgit v1.2.3 From 345f4a977e289d8eedd6e63bfa91236d30de5444 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 10 Apr 2013 13:48:52 -0700 Subject: Refactoring and style. --- lisp/ldg-context.el | 13 ++++++-- lisp/ldg-init.el | 41 +++++++++++++------------- lisp/ldg-mode.el | 85 +++++++---------------------------------------------- lisp/ldg-new.el | 27 ----------------- lisp/ldg-occur.el | 36 ++++++++--------------- lisp/ldg-post.el | 26 ++++++++-------- lisp/ldg-sort.el | 3 +- lisp/ldg-state.el | 63 +++++++++++++++------------------------ lisp/ldg-test.el | 27 +++++++++++++++++ lisp/ldg-xact.el | 68 +++++++++++++++++++++++++++++++++++------- 10 files changed, 178 insertions(+), 211 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-context.el b/lisp/ldg-context.el index 2915133c..4b6aa26c 100644 --- a/lisp/ldg-context.el +++ b/lisp/ldg-context.el @@ -41,6 +41,15 @@ (defconst code-string "\\((\\(.*\\))\\)?") (defconst payee-string "\\(.*\\)") +(defmacro line-regex (&rest elements) + (let (regex-string) + (concat (dolist (e elements regex-string) + (setq regex-string + (concat regex-string + (eval + (intern + (concat (symbol-name e) "-string")))))) "[ \t]*$"))) + (defmacro single-line-config (&rest elements) "Take list of ELEMENTS and return regex and element list for use in context-at-point" (let (regex-string) @@ -96,8 +105,8 @@ where the \"users\" point was." 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)) + (cond ((looking-at "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+") + (goto-char (match-end 0)) 'transaction) ((looking-at "^\\s-+\\([*!]\\s-+\\)?[[(]?\\(.\\)") (goto-char (match-beginning 2)) diff --git a/lisp/ldg-init.el b/lisp/ldg-init.el index 29839c9e..f283c77c 100644 --- a/lisp/ldg-init.el +++ b/lisp/ldg-init.el @@ -30,25 +30,25 @@ (defvar ledger-environment-alist nil) -(defun ledger-init-parse-initialization (file) - (with-current-buffer file - (setq ledger-environment-alist nil) - (goto-char (point-min)) - (while (re-search-forward ledger-init-string-regex nil t ) - (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-no-properties (+ 2 matchb) matche))) - (if (string-match "[ \t\n\r]+\\'" flag) - (replace-match "" t t flag) - flag)) - (let ((value (buffer-substring-no-properties matche (point) ))) - (if (> (length value) 0) - value - t)))))))) - ledger-environment-alist)) +(defun ledger-init-parse-initialization (buffer) + (with-current-buffer buffer + (let (environment-alist) + (goto-char (point-min)) + (while (re-search-forward ledger-init-string-regex nil t ) + (let ((matchb (match-beginning 0)) ;; save the match data, string-match stamp on it + (matche (match-end 0))) + (end-of-line) + (setq environment-alist + (append environment-alist + (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-no-properties matche (point) ))) + (if (> (length value) 0) + value + t)))))))) + environment-alist))) (defun ledger-init-load-init-file () (interactive) @@ -59,7 +59,8 @@ (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) + (setq ledger-environment-alist + (ledger-init-parse-initialization init-base-name)) (kill-buffer init-base-name))))) (provide 'ldg-init) diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 57fba674..4bc195ed 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -41,26 +41,24 @@ (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))) + (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))) + (read-string (concat prompt + (if default + (concat " (" default "): ") + ": ")) + nil 'ledger-minibuffer-history default)) (defun ledger-display-balance-at-point () "Display the cleared-or-pending balance. And calculate the target-delta of the account being reconciled." (interactive) - (let* ((account (ledger-read-account-with-prompt "Account balance to show")) (buffer (current-buffer)) (balance (with-temp-buffer @@ -134,7 +132,7 @@ Can be pcomplete, or align-posting" (define-key map [(control ?c) (control ?u)] 'ledger-schedule-upcoming) (define-key map [(control ?c) (control ?y)] 'ledger-set-year) (define-key map [(control ?c) (control ?p)] 'ledger-display-balance-at-point) - (define-key map [tab] 'ledger-magic-tab) + (define-key map [tab] 'ledger-magic-tab) (define-key map [(control ?i)] 'ledger-magic-tab) (define-key map [(control ?c) tab] 'ledger-fully-complete-xact) (define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-xact) @@ -188,18 +186,7 @@ Can be pcomplete, or align-posting" (define-key map [reconcile] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works)) (define-key map [reconcile] '(menu-item "Narrow to REGEX" ledger-occur)))) -(defun ledger-time-less-p (t1 t2) - "Say whether time value T1 is less than time value T2." - (or (< (car t1) (car t2)) - (and (= (car t1) (car t2)) - (< (nth 1 t1) (nth 1 t2))))) -(defun ledger-time-subtract (t1 t2) - "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-set-year (newyear) @@ -216,57 +203,7 @@ 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-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-xact-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 - (insert transaction-text) - (eshell-parse-arguments (point-min) (point-max)))) - (ledger-buf (current-buffer)) - exit-code) - (unless insert-at-point - (let ((date (car args))) - (if (string-match ledger-iso-date-regexp date) - (setq date - (encode-time 0 0 0 (string-to-number (match-string 4 date)) - (string-to-number (match-string 3 date)) - (string-to-number (match-string 2 date))))) - (ledger-xact-find-slot date))) - (if (> (length args) 1) - (save-excursion - (insert - (with-temp-buffer - (setq exit-code - (apply #'ledger-exec-ledger ledger-buf (current-buffer) "xact" - (mapcar 'eval args))) - (goto-char (point-min)) - (if (looking-at "Error: ") - (error (concat "Error in ledger-add-transaction: " (buffer-string))) - (buffer-string))) - "\n")) - (progn - (insert (car args) " \n\n") - (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)) - (let ((beg (point))) - (while (not (eolp)) - (forward-line)) - (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) diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index 7c13c80e..bed99ac0 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -65,33 +65,6 @@ (defconst ledger-version "3.0" "The version of ledger.el currently loaded.") -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun ledger-create-test () - "Create a regression test." - (interactive) - (save-restriction - (org-narrow-to-subtree) - (save-excursion - (let (text beg) - (goto-char (point-min)) - (forward-line 1) - (setq beg (point)) - (search-forward ":PROPERTIES:") - (goto-char (line-beginning-position)) - (setq text (buffer-substring-no-properties beg (point))) - (goto-char (point-min)) - (re-search-forward ":ID:\\s-+\\([^-]+\\)") - (find-file-other-window - (format "~/src/ledger/test/regress/%s.test" (match-string 1))) - (sit-for 0) - (insert text) - (goto-char (point-min)) - (while (not (eobp)) - (goto-char (line-beginning-position)) - (delete-char 3) - (forward-line 1)))))) - (defun ledger-mode-dump-variable (var) (if var (insert (format " %s: %S\n" (symbol-name var) (eval var))))) diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index 1e1308d0..96c364d6 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -96,8 +96,8 @@ When REGEX is nil, unhide everything, and remove higlight" (interactive (if ledger-occur-mode (list nil) - (list (read-string (concat "Regexp<" (ledger-occur-prompt) - ">: ") nil 'ledger-occur-history (ledger-occur-prompt))))) + (list (read-string (concat "Regexp<" (ledger-occur-prompt) ">: ") + nil 'ledger-occur-history (ledger-occur-prompt))))) (ledger-occur-mode regex (current-buffer))) (defun ledger-occur-prompt () @@ -121,21 +121,12 @@ When REGEX is nil, unhide everything, and remove higlight" (defun ledger-occur-create-narrowed-overlays(buffer-matches) (if buffer-matches (let ((overlays - (let ((prev-end (point-min)) - (temp (point-max))) + (let ((prev-end (point-min))) (mapcar (lambda (match) - (progn - (setq temp prev-end) ;; need a swap so that - ;; the last form in - ;; the lambda is the - ;; (make-overlay) - (setq prev-end (1+ (cadr match))) - ;; add 1 so that we skip the - ;; empty line after the xact - (make-overlay - temp - (car match) - (current-buffer) t nil))) + (prog1 + (make-overlay prev-end (car match) + (current-buffer) t nil) + (setq prev-end (1+ (cadr match))))) buffer-matches)))) (mapcar (lambda (ovl) (overlay-put ovl ledger-occur-overlay-property-name t) @@ -151,10 +142,9 @@ When REGEX is nil, unhide everything, and remove higlight" Argument OVL-BOUNDS contains bounds for the transactions to be left visible." (let ((overlays (mapcar (lambda (bnd) - (make-overlay - (car bnd) - (cadr bnd) - (current-buffer) t nil)) + (make-overlay (car bnd) + (cadr bnd) + (current-buffer) t nil)) ovl-bounds))) (mapcar (lambda (ovl) (overlay-put ovl ledger-occur-overlay-property-name t) @@ -196,9 +186,9 @@ Used for coordinating `ledger-occur' with other buffers, like reconcile." (save-excursion (goto-char (point-min)) ;; Set initial values for variables - (let ((curpoint nil) - (endpoint nil) - (lines (list))) + (let (curpoint + endpoint + (lines (list))) ;; Search loop (while (not (eobp)) (setq curpoint (point)) diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 4f80b425..37722fbc 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -69,23 +69,23 @@ (declare-function iswitchb-read-buffer "iswitchb" (prompt &optional default require-match start matches-set)) + (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 - strings to choose from." - (cond - ((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))) - ((eq ledger-post-use-completion-engine :ido) - (ido-completing-read prompt choices)) - (t - (completing-read prompt choices)))) +PROMPT is a string to prompt with. CHOICES is a list of strings +to choose from." + (cond ((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))) + ((eq ledger-post-use-completion-engine :ido) + (ido-completing-read prompt choices)) + (t + (completing-read prompt choices)))) (defvar ledger-post-current-list nil) diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el index f426a7ef..a50cd1cc 100644 --- a/lisp/ldg-sort.el +++ b/lisp/ldg-sort.el @@ -28,8 +28,7 @@ (defun ledger-next-record-function () "Move point to next transaction." - (if (re-search-forward ledger-payee-any-status-regex - nil t) + (if (re-search-forward ledger-payee-any-status-regex nil t) (goto-char (match-beginning 0)) (goto-char (point-max)))) diff --git a/lisp/ldg-state.el b/lisp/ldg-state.el index 6c585f30..58777631 100644 --- a/lisp/ldg-state.el +++ b/lisp/ldg-state.el @@ -30,15 +30,6 @@ :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) - (if (and style (eq style 'pending)) - 'pending - 'cleared))) - (defun ledger-transaction-state () "Return the state of the transaction at point." (save-excursion @@ -69,14 +60,10 @@ (defun ledger-state-from-char (state-char) "Get state from STATE-CHAR." - (cond ((eql state-char ?\!) - 'pending) - ((eql state-char ?\*) - 'cleared) - ((eql state-char ?\;) - 'comment) - (t - nil))) + (cond ((eql state-char ?\!) 'pending) + ((eql state-char ?\*) 'cleared) + ((eql state-char ?\;) 'comment) + (t nil))) (defun ledger-toggle-current-posting (&optional style) "Toggle the cleared status of the transaction under point. @@ -90,7 +77,7 @@ 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)) + (let ((bounds (ledger-find-xact-extents (point))) new-status cur-status) ;; Uncompact the xact, to make it easier to toggle the ;; transaction @@ -232,27 +219,25 @@ dropped." (defun ledger-toggle-current-transaction (&optional style) "Toggle the transaction at point using optional STYLE." (interactive) - (let (status) - (save-excursion - (when (or (looking-at "^[0-9]") - (re-search-backward "^[0-9]" nil t)) - (skip-chars-forward "0-9./=\\-") - (delete-horizontal-space) - (if (or (eq (ledger-state-from-char (char-after)) 'pending) - (eq (ledger-state-from-char (char-after)) 'cleared)) - (progn - (delete-char 1) - (when (and style (eq style 'cleared)) - (insert " *") - (setq status 'cleared))) - (if (and style (eq style 'pending)) - (progn - (insert " ! ") - (setq status 'pending)) - (progn - (insert " * ") - (setq status 'cleared)))))) - status)) + (save-excursion + (when (or (looking-at "^[0-9]") + (re-search-backward "^[0-9]" nil t)) + (skip-chars-forward "0-9./=\\-") + (delete-horizontal-space) + (if (or (eq (ledger-state-from-char (char-after)) 'pending) + (eq (ledger-state-from-char (char-after)) 'cleared)) + (progn + (delete-char 1) + (when (and style (eq style 'cleared)) + (insert " *") + 'cleared)) + (if (and style (eq style 'pending)) + (progn + (insert " ! ") + 'pending) + (progn + (insert " * ") + 'cleared)))))) (provide 'ldg-state) diff --git a/lisp/ldg-test.el b/lisp/ldg-test.el index dbba9546..0c571caa 100644 --- a/lisp/ldg-test.el +++ b/lisp/ldg-test.el @@ -33,6 +33,33 @@ :type 'file :group 'ledger-test) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ledger-create-test () + "Create a regression test." + (interactive) + (save-restriction + (org-narrow-to-subtree) + (save-excursion + (let (text beg) + (goto-char (point-min)) + (forward-line 1) + (setq beg (point)) + (search-forward ":PROPERTIES:") + (goto-char (line-beginning-position)) + (setq text (buffer-substring-no-properties beg (point))) + (goto-char (point-min)) + (re-search-forward ":ID:\\s-+\\([^-]+\\)") + (find-file-other-window + (format "~/src/ledger/test/regress/%s.test" (match-string 1))) + (sit-for 0) + (insert text) + (goto-char (point-min)) + (while (not (eobp)) + (goto-char (line-beginning-position)) + (delete-char 3) + (forward-line 1)))))) + (defun ledger-test-org-narrow-to-entry () (outline-back-to-heading) (narrow-to-region (point) (progn (outline-next-heading) (point))) diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index b66bba04..bf50dbe2 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -39,17 +39,14 @@ within the transaction." (interactive "d") (save-excursion (goto-char pos) - (let ((end-pos pos) - (beg-pos pos)) - (backward-paragraph) - (if (/= (point) (point-min)) - (forward-line)) - (setq beg-pos (line-beginning-position)) - (forward-paragraph) - (forward-line -1) - (setq end-pos (1+ (line-end-position))) - (list beg-pos end-pos)))) - + (list (progn + (backward-paragraph) + (if (/= (point) (point-min)) + (forward-line)) + (line-beginning-position)) + (progn + (forward-paragraph) + (line-beginning-position))))) (defun ledger-highlight-xact-under-point () "Move the highlight overlay to the current transaction." @@ -76,6 +73,12 @@ within the transaction." (ledger-context-field-value context-info 'payee) nil)))) +(defun ledger-time-less-p (t1 t2) + "Say whether time value T1 is less than time value T2." + (or (< (car t1) (car t2)) + (and (= (car t1) (car t2)) + (< (nth 1 t1) (nth 1 t2))))) + (defun ledger-xact-find-slot (moment) "Find the right place in the buffer for a transaction at MOMENT. MOMENT is an encoded date" @@ -138,6 +141,49 @@ MOMENT is an encoded date" (replace-match date) (ledger-next-amount))) +(defun ledger-delete-current-transaction (pos) + "Delete the transaction surrounging point." + (interactive "d") + (let ((bounds (ledger-find-xact-extents pos))) + (delete-region (car bounds) (cadr bounds)))) + +(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-xact-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 + (insert transaction-text) + (eshell-parse-arguments (point-min) (point-max)))) + (ledger-buf (current-buffer)) + exit-code) + (unless insert-at-point + (let ((date (car args))) + (if (string-match ledger-iso-date-regexp date) + (setq date + (encode-time 0 0 0 (string-to-number (match-string 4 date)) + (string-to-number (match-string 3 date)) + (string-to-number (match-string 2 date))))) + (ledger-xact-find-slot date))) + (if (> (length args) 1) + (save-excursion + (insert + (with-temp-buffer + (setq exit-code + (apply #'ledger-exec-ledger ledger-buf (current-buffer) "xact" + (mapcar 'eval args))) + (goto-char (point-min)) + (if (looking-at "Error: ") + (error (concat "Error in ledger-add-transaction: " (buffer-string))) + (buffer-string))) + "\n")) + (progn + (insert (car args) " \n\n") + (end-of-line -1))))) + + (provide 'ldg-xact) ;;; ldg-xact.el ends here -- cgit v1.2.3 From 9b5289c3e9c0d6a123f15a8a65def046bb823779 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 10 Apr 2013 15:01:42 -0700 Subject: More regex finetuning in context --- lisp/ldg-context.el | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-context.el b/lisp/ldg-context.el index 4b6aa26c..510a4cfa 100644 --- a/lisp/ldg-context.el +++ b/lisp/ldg-context.el @@ -32,11 +32,11 @@ ;; form the regex and list of elements (defconst indent-string "\\(^[ \t]+\\)") (defconst status-string "\\([*! ]?\\)") -(defconst account-string "[\\[(]?\\(.*?\\)[])]?") -(defconst amount-string "\\s-\\s-[ \t]+\\(-?[0-9]+\\.[0-9]*\\)") +(defconst account-string "[\\[(]?\\(.*?\\)[])]?[ \t]\\{2\\}") +(defconst amount-string "[ \t]?\\(-?[0-9]+\\.[0-9]*\\)") (defconst comment-string "[ \t]*;[ \t]*\\(.*?\\)") (defconst nil-string "[ \t]+") -(defconst commodity-string "\\(.*\\)") +(defconst commodity-string "\\(.+?\\)") (defconst date-string "^\\(\\([0-9]\\{4\\}[/-]\\)?[01]?[0-9][/-][0123]?[0-9]\\)") (defconst code-string "\\((\\(.*\\))\\)?") (defconst payee-string "\\(.*\\)") @@ -50,7 +50,7 @@ (intern (concat (symbol-name e) "-string")))))) "[ \t]*$"))) -(defmacro single-line-config (&rest elements) +(defmacro single-line-config2 (&rest elements) "Take list of ELEMENTS and return regex and element list for use in context-at-point" (let (regex-string) `'(,(concat (dolist (e elements regex-string) @@ -61,6 +61,10 @@ (concat (symbol-name e) "-string")))))) "[ \t]*$") ,elements))) +(defmacro single-line-config (&rest elements) + "Take list of ELEMENTS and return regex and element list for use in context-at-point" + `'(,(eval `(line-regex ,@elements)) + ,elements)) (defconst ledger-line-config (list (list 'xact (list (single-line-config date nil status nil nil code payee comment) -- cgit v1.2.3 From 15e84cbb18ff2e0423e20c3a620631c3ce97956c Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 10 Apr 2013 15:48:39 -0700 Subject: More regex fine tuning --- lisp/ldg-context.el | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-context.el b/lisp/ldg-context.el index 510a4cfa..ccaa39f2 100644 --- a/lisp/ldg-context.el +++ b/lisp/ldg-context.el @@ -32,10 +32,10 @@ ;; form the regex and list of elements (defconst indent-string "\\(^[ \t]+\\)") (defconst status-string "\\([*! ]?\\)") -(defconst account-string "[\\[(]?\\(.*?\\)[])]?[ \t]\\{2\\}") +(defconst account-string "[\\[(]?\\(.*?\\)[])]?") (defconst amount-string "[ \t]?\\(-?[0-9]+\\.[0-9]*\\)") (defconst comment-string "[ \t]*;[ \t]*\\(.*?\\)") -(defconst nil-string "[ \t]+") +(defconst nil-string "\\([ \t]+\\)") (defconst commodity-string "\\(.+?\\)") (defconst date-string "^\\(\\([0-9]\\{4\\}[/-]\\)?[01]?[0-9][/-][0123]?[0-9]\\)") (defconst code-string "\\((\\(.*\\))\\)?") @@ -70,12 +70,12 @@ (list (list 'xact (list (single-line-config date nil status nil nil code payee comment) (single-line-config date nil status nil nil code payee))) (list 'acct-transaction (list (single-line-config indent comment) - (single-line-config indent status account commodity amount nil comment) - (single-line-config indent status account commodity amount) - (single-line-config indent status account amount nil commodity comment) - (single-line-config indent status account amount nil commodity) - (single-line-config indent status account amount) - (single-line-config indent status account comment) + (single-line-config indent status account nil commodity amount nil comment) + (single-line-config indent status account nil commodity amount) + (single-line-config indent status account nil amount nil commodity comment) + (single-line-config indent status account nil amount nil commodity) + (single-line-config indent status account nil amount) + (single-line-config indent status account nil comment) (single-line-config indent status account))))) (defun ledger-extract-context-info (line-type pos) -- cgit v1.2.3