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

Improved the visit function. Made the window position configurable. Removed after-save hook on quit

Browse source
This commit is contained in:
Craig Earls 2013-02-08 22:49:39 -07:00
parent 7fe1506ea1
commit 73f336ae7c
1 changed files with 61 additions and 54 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

115
lisp/ldg-reconcile.el
View file

@ -40,6 +40,11 @@
buffer." buffer."
:group 'ledger) :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 () (defun ledger-display-balance ()
"Calculate the cleared balance of the account being reconciled" "Calculate the cleared balance of the account being reconciled"
(interactive) (interactive)
@ -62,8 +67,6 @@
(equal file "/dev/stdin"))) (equal file "/dev/stdin")))
(defun ledger-reconcile-get-buffer (where) (defun ledger-reconcile-get-buffer (where)
; (when (is-stdin (car where))
; ledger-buf))
(if (bufferp (car where)) (if (bufferp (car where))
(car where) (car where)
(error "buffer not set"))) (error "buffer not set")))
@ -139,15 +142,19 @@
(delete-region (point) (1+ (line-end-position))) (delete-region (point) (1+ (line-end-position)))
(set-buffer-modified-p t))))) (set-buffer-modified-p t)))))
(defun ledger-reconcile-visit () (defun ledger-reconcile-visit (&optional come-back)
(interactive) (progn
(let* ((where (get-text-property (point) 'where)) (beginning-of-line)
(target-buffer (ledger-reconcile-get-buffer (let* ((where (get-text-property (1+ (point)) 'where))
where))) (target-buffer (ledger-reconcile-get-buffer
(when target-buffer where))
(switch-to-buffer-other-window target-buffer) (cur-buf (current-buffer)))
(goto-char (cdr where)) (when target-buffer
(recenter)))) (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 () (defun ledger-reconcile-save ()
(interactive) (interactive)
@ -162,6 +169,9 @@
(defun ledger-reconcile-quit () (defun ledger-reconcile-quit ()
(interactive) (interactive)
(let ((buf ledger-buf)) (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, ;Make sure you delete the window before you delete the buffer,
;otherwise, madness ensues ;otherwise, madness ensues
(delete-window (get-buffer-window (current-buffer))) (delete-window (get-buffer-window (current-buffer)))
@ -198,25 +208,28 @@
(error (buffer-string))) (error (buffer-string)))
(read (current-buffer)))))) (read (current-buffer))))))
(if (> (length items) 0) (if (> (length items) 0)
(dolist (item items) (progn
(let ((index 1)) (dolist (item items)
(dolist (xact (nthcdr 5 item)) (let ((index 1))
(let ((beg (point)) (dolist (xact (nthcdr 5 item))
(where (ledger-marker-where-xact-is item))) (let ((beg (point))
(insert (format "%s %-4s %-30s %-30s %15s\n" (where (ledger-marker-where-xact-is item)))
(format-time-string "%Y/%m/%d" (nth 2 item)) (insert (format "%s %-4s %-30s %-30s %15s\n"
(if (nth 3 item) (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) (nth 4 item) (nth 1 xact) (nth 2 xact)))
(set-text-properties beg (1- (point)) (if (nth 3 xact)
(list 'face 'ledger-font-reconciler-cleared-face (set-text-properties beg (1- (point))
'where where)) (list 'face 'ledger-font-reconciler-cleared-face
(set-text-properties beg (1- (point)) 'where where))
(list 'face 'ledger-font-reconciler-uncleared-face (set-text-properties beg (1- (point))
'where where)))) (list 'face 'ledger-font-reconciler-uncleared-face
(setq index (1+ index))))) 'where where))))
(setq index (1+ index)))))
(goto-char (point-max))
(delete-char -1))
(insert (concat "There are no uncleared entries for " account))) (insert (concat "There are no uncleared entries for " account)))
(goto-char (point-min)) (goto-char (point-min))
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
@ -236,23 +249,16 @@
(goto-char (point-max)) (goto-char (point-max))
(recenter -1)) (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 () (defun ledger-reconcile-track-xact ()
(if (or (eq this-command 'next-line) (if (member this-command (list 'next-line
(eq this-command 'previous-line) 'previous-line
(eq this-command 'mouse-set-point)) 'mouse-set-point
(let* ((where (get-text-property (point) 'where)) 'ledger-reconcile-toggle))
(target-buffer (ledger-reconcile-get-buffer (ledger-reconcile-visit t)))
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) (defun ledger-reconcile (account)
(interactive "sAccount to reconcile: ") (interactive "sAccount to reconcile: ")
@ -262,18 +268,20 @@
(progn (progn
(quit-window (get-buffer-window rbuf)) (quit-window (get-buffer-window rbuf))
(kill-buffer rbuf))) (kill-buffer rbuf)))
(add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save) (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t)
(add-hook 'post-command-hook 'ledger-reconcile-track-xact)
(if ledger-fold-on-reconcile (if ledger-fold-on-reconcile
(ledger-occur-mode account buf)) (ledger-occur-mode account buf))
;create the *Reconcile* window directly below the ledger buffer.
(with-current-buffer (with-current-buffer
(progn (if ledger-reconcile-force-window-bottom
(set-window-buffer ;create the *Reconcile* window directly below the ledger
(split-window (get-buffer-window (current-buffer)) nil nil) ;buffer.
(get-buffer-create ledger-recon-buffer-name)) (progn
(get-buffer ledger-recon-buffer-name)) (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) (ledger-reconcile-mode)
(set (make-local-variable 'ledger-buf) buf) (set (make-local-variable 'ledger-buf) buf)
(set (make-local-variable 'ledger-acct) account) (set (make-local-variable 'ledger-acct) account)
@ -286,7 +294,6 @@
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(define-key map [(control ?m)] 'ledger-reconcile-visit) (define-key map [(control ?m)] 'ledger-reconcile-visit)
(define-key map [return] '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 [(control ?l)] 'ledger-reconcile-refresh)
(define-key map [? ] 'ledger-reconcile-toggle) (define-key map [? ] 'ledger-reconcile-toggle)
(define-key map [?a] 'ledger-reconcile-add) (define-key map [?a] 'ledger-reconcile-add)