diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ldg-mode.el | 47 | ||||
| -rw-r--r-- | lisp/ldg-new.el | 1 | ||||
| -rw-r--r-- | lisp/ldg-reconcile.el | 40 | ||||
| -rw-r--r-- | lisp/ldg-report.el | 66 |
4 files changed, 150 insertions, 4 deletions
diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 4d13d7d2..04c6ee1b 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." @@ -74,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 @@ -93,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: ") 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) 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: ") diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index 5a668847..f9c6afca 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 () @@ -227,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)) @@ -234,7 +260,43 @@ the default." (format "Command: %s\n" cmd) (make-string (- (window-width) 1) ?=) "\n") - (shell-command cmd t nil)) + (let ((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)) + (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* ((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-or-marker) prop + (find-file-other-window file) + (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." @@ -446,3 +508,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) |