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

Improved ledger-report visit source capabilities

Browse source
This commit is contained in:
Craig Earls 2013-02-14 09:49:00 -07:00
parent c031fa4943
commit 1074dec8ad
1 changed files with 48 additions and 43 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

91
lisp/ldg-report.el
View file

@ -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 lrq] '("Quit" . ledger-report-quit))
(define-key map [menu-bar ldg-rep s2] '("--")) (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 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 lru] '("Scroll Up" . scroll-up))
(define-key map [menu-bar ldg-rep s1] '("--")) (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 lrk] '("Kill Report" . ledger-report-kill))
@ -240,20 +241,19 @@ the default."
(ledger-read-string-with-default "Account" default))) (ledger-read-string-with-default "Account" default)))
(defun ledger-report-expand-format-specifiers (report-cmd) (defun ledger-report-expand-format-specifiers (report-cmd)
(let ((expanded-cmd report-cmd)) (save-match-data
(while (string-match "%(\\([^)]*\\))" expanded-cmd) (let ((expanded-cmd report-cmd))
(let* ((specifier (match-string 1 expanded-cmd)) (set-match-data (list 0 0))
(f (cdr (assoc specifier ledger-report-format-specifiers)))) (while (string-match "%(\\([^)]*\\))" expanded-cmd (match-end 0))
(if f (let* ((specifier (match-string 1 expanded-cmd))
(setq expanded-cmd (replace-match (f (cdr (assoc specifier ledger-report-format-specifiers))))
(save-match-data (if f
(with-current-buffer ledger-buf (setq expanded-cmd (replace-match
(shell-quote-argument (funcall f)))) (save-match-data
t t expanded-cmd)) (with-current-buffer ledger-buf
(progn (shell-quote-argument (funcall f))))
(set-window-configuration ledger-original-window-cfg) t t expanded-cmd)))))
(error "Invalid ledger report format specifier '%s'" specifier))))) expanded-cmd)))
expanded-cmd))
(defun ledger-report-cmd (report-name edit) (defun ledger-report-cmd (report-name edit)
"Get the command line to run the report." "Get the command line to run the report."
@ -280,45 +280,50 @@ the default."
"\n\n") "\n\n")
(let ((data-pos (point)) (let ((data-pos (point))
(register-report (string-match " reg\\(ister\\)? " cmd)) (register-report (string-match " reg\\(ister\\)? " cmd))
files-in-report) files-in-report)
(shell-command (shell-command
(if register-report ;; subtotal doe not produce identifiable transactions, so don't
(concat cmd " --prepend-format='%(filename):%(beg_line):'") ;; prepend location information for them
(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 (when register-report
(goto-char data-pos) (goto-char data-pos)
(while (re-search-forward "^\\([^:]+\\)?:\\([0-9]+\\)?:" nil t) (while (re-search-forward "^\\(/[^:]+\\)?:\\([0-9]+\\)?:" nil t)
(let ((file (match-string 1)) (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)) (delete-region (match-beginning 0) (match-end 0))
(set-text-properties (line-beginning-position) (line-end-position) (set-text-properties (line-beginning-position) (line-end-position)
(list 'ledger-source (cons file (save-window-excursion (list 'ledger-source (cons file (save-window-excursion
(save-excursion (save-excursion
(find-file file) (find-file file)
(widen) (widen)
(goto-char (point-min)) (ledger-goto-line line)
(forward-line (1- line)) (point-marker))))))
(point-marker)))))) (end-of-line))))
(end-of-line))))
(goto-char data-pos))) (goto-char data-pos)))
(defun ledger-report-visit-source () (defun ledger-report-visit-source ()
(interactive) (interactive)
(let ((prop (get-text-property (point) 'ledger-source))) (let* ((prop (get-text-property (point) 'ledger-source))
(destructuring-bind (file . line-or-marker) prop (file (if prop (car prop)))
(find-file-other-window file) (line-or-marker (if prop (cdr prop))))
(widen) (if (and file line-or-marker)
(if (markerp line-or-marker) (progn
(goto-char line-or-marker) (find-file-other-window file)
(goto-char (point-min)) (widen)
(forward-line (1- line-or-marker)) (if (markerp line-or-marker)
(re-search-backward "^[0-9]+") (goto-char line-or-marker)
(beginning-of-line) (goto-char (point-min))
(let ((start-of-txn (point))) (forward-line (1- line-or-marker))
(forward-paragraph) (re-search-backward "^[0-9]+")
(narrow-to-region start-of-txn (point)) (beginning-of-line)
(backward-paragraph)))))) (let ((start-of-txn (point)))
(forward-paragraph)
(narrow-to-region start-of-txn (point))
(backward-paragraph)))))))
(defun ledger-report-goto () (defun ledger-report-goto ()
"Goto the ledger report buffer." "Goto the ledger report buffer."