diff options
| -rw-r--r-- | lisp/ldg-fonts.el | 5 | ||||
| -rw-r--r-- | lisp/ldg-mode.el | 9 | ||||
| -rw-r--r-- | lisp/ldg-occur.el | 19 | ||||
| -rw-r--r-- | lisp/ldg-reconcile.el | 17 | ||||
| -rw-r--r-- | lisp/ldg-xact.el | 40 |
5 files changed, 62 insertions, 28 deletions
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 4754e423..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) @@ -98,6 +101,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)) @@ -111,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 b475ebb7..afecf2eb 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)) @@ -157,13 +156,12 @@ (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)))))) (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))) @@ -195,7 +193,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 () @@ -263,8 +263,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: ") 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 |