All navigation functions moved to ledger-navigate.

Reduce several overlapping functions.
This commit is contained in:
Craig Earls 2014-09-13 18:20:03 -07:00
parent 84dc532b06
commit 7846e7c17a
10 changed files with 143 additions and 82 deletions

View file

@ -50,13 +50,13 @@
(ledger-fontify-xact-at (point))) (ledger-fontify-xact-at (point)))
((looking-at ledger-directive-start-regex) ((looking-at ledger-directive-start-regex)
(ledger-fontify-directive-at (point)))) (ledger-fontify-directive-at (point))))
(ledger-next-record-function)))) (ledger-navigate-next-xact-or-directive))))
(defun ledger-fontify-xact-at (position) (defun ledger-fontify-xact-at (position)
(interactive "d") (interactive "d")
(save-excursion (save-excursion
(goto-char position) (goto-char position)
(let ((extents (ledger-find-xact-extents position)) (let ((extents (ledger-navigate-find-xact-extents position))
(state (ledger-transaction-state))) (state (ledger-transaction-state)))
;; (message (concat "ledger-fontify-xact-at: " ;; (message (concat "ledger-fontify-xact-at: "
;; (int-to-string position) ;; (int-to-string position)
@ -121,7 +121,7 @@
'ledger-font-comment-face))) 'ledger-font-comment-face)))
(defun ledger-fontify-directive-at (position) (defun ledger-fontify-directive-at (position)
(let ((extents (ledger-find-xact-extents position)) (let ((extents (ledger-navigate-find-xact-extents position))
(face 'ledger-font-default-face)) (face 'ledger-font-default-face))
(cond ((looking-at "=") (cond ((looking-at "=")
(setq face 'ledger-font-auto-xact-face)) (setq face 'ledger-font-auto-xact-face))

View file

@ -37,6 +37,7 @@
(require 'ledger-fonts) (require 'ledger-fonts)
(require 'ledger-fontify) (require 'ledger-fontify)
(require 'ledger-init) (require 'ledger-init)
(require 'ledger-navigate)
(require 'ledger-occur) (require 'ledger-occur)
(require 'ledger-post) (require 'ledger-post)
(require 'ledger-reconcile) (require 'ledger-reconcile)
@ -261,8 +262,8 @@ With a prefix argument, remove the effective date. "
(define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report) (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 [(control ?c) (control ?o) (control ?s)] 'ledger-report-save)
(define-key map [(meta ?p)] 'ledger-prev-record-function) (define-key map [(meta ?p)] 'ledger-navigate-prev-xact)
(define-key map [(meta ?n)] 'ledger-next-record-function) (define-key map [(meta ?n)] 'ledger-navigate-next-xact-or-directive)
map) map)
"Keymap for `ledger-mode'.") "Keymap for `ledger-mode'.")

92
lisp/ledger-navigate.el Normal file
View file

@ -0,0 +1,92 @@
;;; ledger-navigate.el --- Provide navigation services through the ledger buffer.
;; Copyright (C) 2014-2015 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., 51 Franklin Street, Fifth Floor, Boston,
;; MA 02110-1301 USA.
;;; Commentary:
;;
(provide 'ledger-navigate)
;; (defun ledger-navigate-next-xact-or-directive ()
;; "Move point to beginning of next xact."
;; ;; make sure we actually move to the next xact, even if we are the
;; ;; beginning of one now.
;; (if (looking-at ledger-payee-any-status-regex)
;; (forward-line))
;; (if (re-search-forward ledger-payee-any-status-regex nil t)
;; (goto-char (match-beginning 0))
;; (goto-char (point-max))))
(defun ledger-navigate-start-xact-or-directive-p ()
"return t if at the beginning of an empty line or line
beginning with whitespace"
(not (looking-at "[ \t]\\|\\(^$\\)")))
(defun ledger-navigate-next-xact-or-directive ()
"move to the beginning of the next xact or directive"
(interactive)
(beginning-of-line)
(if (ledger-navigate-start-xact-or-directive-p) ; if we are the start of an xact, move forward to the next xact
(progn
(forward-line)
(if (not (ledger-navigate-start-xact-or-directive-p)) ; we have moved forward and are not at another xact, recurse forward
(ledger-navigate-next-xact-or-directive)))
(while (not (or (eobp) ; we didn't start off at the beginning of an xact
(ledger-navigate-start-xact-or-directive-p)))
(forward-line))))
(defun ledger-navigate-prev-xact ()
"Move point to beginning of previous xact."
(ledger-navigate-beginning-of-xact)
(re-search-backward ledger-xact-start-regex nil t))
(defun ledger-navigate-beginning-of-xact ()
"Move point to the beginning of the current xact"
(interactive)
(unless (looking-at ledger-xact-start-regex)
(re-search-backward ledger-xact-start-regex nil t)
(beginning-of-line))
(point))
(defun ledger-navigate-end-of-xact ()
"Move point to end of xact."
(interactive)
(ledger-navigate-next-xact-or-directive)
(backward-char)
(end-of-line)
(point))
(defun ledger-navigate-to-line (line-number)
"Rapidly move point to line LINE-NUMBER."
(goto-char (point-min))
(forward-line (1- line-number)))
(defun ledger-navigate-find-xact-extents (pos)
"Return list containing point for beginning and end of xact containing POS.
Requires empty line separating xacts."
(interactive "d")
(save-excursion
(goto-char pos)
(list (ledger-navigate-beginning-of-xact)
(ledger-navigate-end-of-xact))))
;;; ledger-navigate.el ends here

View file

@ -164,7 +164,7 @@ Used for coordinating `ledger-occur' with other buffers, like reconcile."
;; if something found ;; if something found
(when (setq endpoint (re-search-forward regex nil 'end)) (when (setq endpoint (re-search-forward regex nil 'end))
(save-excursion (save-excursion
(let ((bounds (ledger-find-xact-extents (match-beginning 0)))) (let ((bounds (ledger-navigate-find-xact-extents (match-beginning 0))))
(push bounds lines) (push bounds lines)
(setq curpoint (cadr bounds)))) ;; move to the end of (setq curpoint (cadr bounds)))) ;; move to the end of
;; the xact, no need to ;; the xact, no need to

View file

@ -96,7 +96,7 @@ at beginning of account"
(defun ledger-post-align-xact (pos) (defun ledger-post-align-xact (pos)
(interactive "d") (interactive "d")
(let ((bounds (ledger-find-xact-extents pos))) (let ((bounds (ledger-navigate-find-xact-extents pos)))
(ledger-post-align-postings (car bounds) (cadr bounds)))) (ledger-post-align-postings (car bounds) (cadr bounds))))
(defun ledger-post-align-postings (&optional beg end) (defun ledger-post-align-postings (&optional beg end)

View file

@ -157,7 +157,7 @@ And calculate the target-delta of the account being reconciled."
status) status)
(when (ledger-reconcile-get-buffer where) (when (ledger-reconcile-get-buffer where)
(with-current-buffer (ledger-reconcile-get-buffer where) (with-current-buffer (ledger-reconcile-get-buffer where)
(ledger-goto-line (cdr where)) (ledger-navigate-to-line (cdr where))
(forward-char) (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 'pending
@ -220,7 +220,7 @@ Return the number of uncleared xacts found."
(let ((where (get-text-property (point) 'where))) (let ((where (get-text-property (point) 'where)))
(when (ledger-reconcile-get-buffer where) (when (ledger-reconcile-get-buffer where)
(with-current-buffer (ledger-reconcile-get-buffer where) (with-current-buffer (ledger-reconcile-get-buffer where)
(ledger-goto-line (cdr where)) (ledger-navigate-to-line (cdr where))
(ledger-delete-current-transaction (point))) (ledger-delete-current-transaction (point)))
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(goto-char (line-beginning-position)) (goto-char (line-beginning-position))
@ -240,7 +240,7 @@ Return the number of uncleared xacts found."
(cur-win (get-buffer-window (get-buffer ledger-recon-buffer-name)))) (cur-win (get-buffer-window (get-buffer ledger-recon-buffer-name))))
(when target-buffer (when target-buffer
(switch-to-buffer-other-window target-buffer) (switch-to-buffer-other-window target-buffer)
(ledger-goto-line (cdr where)) (ledger-navigate-to-line (cdr where))
(forward-char) (forward-char)
(recenter) (recenter)
(ledger-highlight-xact-under-point) (ledger-highlight-xact-under-point)
@ -273,7 +273,7 @@ and exit reconcile mode"
(face (get-text-property (point) 'face))) (face (get-text-property (point) 'face)))
(if (eq face 'ledger-font-reconciler-pending-face) (if (eq face 'ledger-font-reconciler-pending-face)
(with-current-buffer (ledger-reconcile-get-buffer where) (with-current-buffer (ledger-reconcile-get-buffer where)
(ledger-goto-line (cdr where)) (ledger-navigate-to-line (cdr where))
(ledger-toggle-current 'cleared)))) (ledger-toggle-current 'cleared))))
(forward-line 1))) (forward-line 1)))
(ledger-reconcile-save) (ledger-reconcile-save)

View file

@ -325,7 +325,7 @@ Optional EDIT the command."
(save-excursion (save-excursion
(find-file file) (find-file file)
(widen) (widen)
(ledger-goto-line line) (ledger-navigate-to-line line)
(point-marker)))))) (point-marker))))))
(add-text-properties (line-beginning-position) (line-end-position) (add-text-properties (line-beginning-position) (line-end-position)
(list 'face 'ledger-font-report-clickable-face)) (list 'face 'ledger-font-report-clickable-face))

View file

@ -26,36 +26,36 @@
;;; Code: ;;; Code:
(defun ledger-next-record-function () ;; (defun ledger-next-record-function ()
"Move point to next transaction." ;; "Move point to next transaction."
;; make sure we actually move to the next xact, even if we are the ;; ;; make sure we actually move to the next xact, even if we are the
;; beginning of one now. ;; ;; beginning of one now.
(if (looking-at ledger-payee-any-status-regex) ;; (if (looking-at ledger-payee-any-status-regex)
(forward-line)) ;; (forward-line))
(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 (match-beginning 0))
(goto-char (point-max)))) ;; (goto-char (point-max))))
(defun ledger-prev-record-function () ;; (defun ledger-prev-record-function ()
"Move point to beginning of previous xact." ;; "Move point to beginning of previous xact."
(ledger-beginning-record-function) ;; (ledger-beginning-record-function)
(re-search-backward ledger-xact-start-regex nil t)) ;; (re-search-backward ledger-xact-start-regex nil t))
(defun ledger-beginning-record-function () ;; (defun ledger-beginning-record-function ()
"Move point to the beginning of the current xact" ;; "Move point to the beginning of the current xact"
(interactive) ;; (interactive)
(unless (looking-at ledger-xact-start-regex) ;; (unless (looking-at ledger-xact-start-regex)
(re-search-backward ledger-xact-start-regex nil t) ;; (re-search-backward ledger-xact-start-regex nil t)
(beginning-of-line)) ;; (beginning-of-line))
(point)) ;; (point))
(defun ledger-end-record-function () ;; (defun ledger-end-record-function ()
"Move point to end of xact." ;; "Move point to end of xact."
(interactive) ;; (interactive)
(ledger-next-record-function) ;; (ledger-navigate-next-xact)
(backward-char) ;; (backward-char)
(end-of-line) ;; (end-of-line)
(point)) ;; (point))
(defun ledger-sort-find-start () (defun ledger-sort-find-start ()
(if (re-search-forward ";.*Ledger-mode:.*Start sort" nil t) (if (re-search-forward ";.*Ledger-mode:.*Start sort" nil t)
@ -94,7 +94,7 @@
(let ((new-beg beg) (let ((new-beg beg)
(new-end end) (new-end end)
point-delta point-delta
(bounds (ledger-find-xact-extents (point))) (bounds (ledger-navigate-find-xact-extents (point)))
target-xact) target-xact)
(setq point-delta (- (point) (car bounds))) (setq point-delta (- (point) (car bounds)))
@ -104,10 +104,10 @@
(save-restriction (save-restriction
(goto-char beg) (goto-char beg)
;; make sure point is at the beginning of a xact ;; make sure point is at the beginning of a xact
(ledger-next-record-function) (ledger-navigate-next-xact-or-directive)
(setq new-beg (point)) (setq new-beg (point))
(goto-char end) (goto-char end)
(ledger-next-record-function) (ledger-navigate-next-xact-or-directive)
;; make sure end of region is at the beginning of next record ;; make sure end of region is at the beginning of next record
;; after the region ;; after the region
(setq new-end (point)) (setq new-end (point))
@ -117,8 +117,8 @@
(let ((inhibit-field-text-motion t)) (let ((inhibit-field-text-motion t))
(sort-subr (sort-subr
nil nil
'ledger-next-record-function 'ledger-navigate-next-xact-or-directive
'ledger-end-record-function 'ledger-navigate-end-of-xact
'ledger-sort-startkey)))) 'ledger-sort-startkey))))
(goto-char (point-min)) (goto-char (point-min))

View file

@ -85,7 +85,7 @@ achieved more certainly by passing the xact to ledger for
formatting, but doing so causes inline math expressions to be formatting, but doing so causes inline math expressions to be
dropped." dropped."
(interactive) (interactive)
(let ((bounds (ledger-find-xact-extents (point))) (let ((bounds (ledger-navigate-find-xact-extents (point)))
new-status cur-status) new-status cur-status)
;; Uncompact the xact, to make it easier to toggle the ;; Uncompact the xact, to make it easier to toggle the
;; transaction ;; transaction

View file

@ -39,19 +39,10 @@
(defvar ledger-xact-highlight-overlay (list)) (defvar ledger-xact-highlight-overlay (list))
(make-variable-buffer-local 'ledger-xact-highlight-overlay) (make-variable-buffer-local 'ledger-xact-highlight-overlay)
(defun ledger-find-xact-extents (pos)
"Return list containing point for beginning and end of xact containing POS.
Requires empty line separating xacts."
(interactive "d")
(save-excursion
(goto-char pos)
(list (ledger-beginning-record-function)
(ledger-end-record-function))))
(defun ledger-highlight-xact-under-point () (defun ledger-highlight-xact-under-point ()
"Move the highlight overlay to the current transaction." "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))) (let ((exts (ledger-navigate-find-xact-extents (point)))
(ovl ledger-xact-highlight-overlay)) (ovl ledger-xact-highlight-overlay))
(if (not ledger-xact-highlight-overlay) (if (not ledger-xact-highlight-overlay)
(setq ovl (setq ovl
@ -91,7 +82,7 @@ MOMENT is an encoded date"
(if (ledger-time-less-p moment date) (if (ledger-time-less-p moment date)
(throw 'found t)))))) (throw 'found t))))))
(when (and (eobp) last-xact-start) (when (and (eobp) last-xact-start)
(let ((end (cadr (ledger-find-xact-extents last-xact-start)))) (let ((end (cadr (ledger-navigate-find-xact-extents last-xact-start))))
(goto-char end) (goto-char end)
(if (eobp) (if (eobp)
(insert "\n") (insert "\n")
@ -122,11 +113,6 @@ MOMENT is an encoded date"
mark desc))))) mark desc)))))
(forward-line)))) (forward-line))))
(defun ledger-goto-line (line-number)
"Rapidly move point to line LINE-NUMBER."
(goto-char (point-min))
(forward-line (1- line-number)))
(defun ledger-year-and-month () (defun ledger-year-and-month ()
(let ((sep (if ledger-use-iso-dates (let ((sep (if ledger-use-iso-dates
"-" "-"
@ -138,7 +124,7 @@ MOMENT is an encoded date"
(interactive (list (interactive (list
(ledger-read-date "Copy to date: "))) (ledger-read-date "Copy to date: ")))
(let* ((here (point)) (let* ((here (point))
(extents (ledger-find-xact-extents (point))) (extents (ledger-navigate-find-xact-extents (point)))
(transaction (buffer-substring-no-properties (car extents) (cadr extents))) (transaction (buffer-substring-no-properties (car extents) (cadr extents)))
encoded-date) encoded-date)
(if (string-match ledger-iso-date-regexp date) (if (string-match ledger-iso-date-regexp date)
@ -148,7 +134,7 @@ MOMENT is an encoded date"
(string-to-number (match-string 2 date))))) (string-to-number (match-string 2 date)))))
(ledger-xact-find-slot encoded-date) (ledger-xact-find-slot encoded-date)
(insert transaction "\n") (insert transaction "\n")
(ledger-beginning-record-function) (ledger-navigate-beginning-of-xact)
(re-search-forward ledger-iso-date-regexp) (re-search-forward ledger-iso-date-regexp)
(replace-match date) (replace-match date)
(ledger-next-amount) (ledger-next-amount)
@ -158,7 +144,7 @@ MOMENT is an encoded date"
(defun ledger-delete-current-transaction (pos) (defun ledger-delete-current-transaction (pos)
"Delete the transaction surrounging point." "Delete the transaction surrounging point."
(interactive "d") (interactive "d")
(let ((bounds (ledger-find-xact-extents pos))) (let ((bounds (ledger-navigate-find-xact-extents pos)))
(delete-region (car bounds) (cadr bounds)))) (delete-region (car bounds) (cadr bounds))))
(defun ledger-add-transaction (transaction-text &optional insert-at-point) (defun ledger-add-transaction (transaction-text &optional insert-at-point)
@ -200,24 +186,6 @@ correct chronological place in the buffer."
(insert (car args) " \n\n") (insert (car args) " \n\n")
(end-of-line -1))))) (end-of-line -1)))))
(defun ledger-xact-start-xact-or-directive-p ()
"return t if at the beginning of an empty line or line
beginning with whitespace"
(not (looking-at "[ \t]\\|\\(^$\\)")))
(defun ledger-xact-next-xact-or-directive ()
"move to the beginning of the next xact or directive"
(interactive)
(beginning-of-line)
(if (ledger-xact-start-xact-or-directive-p) ; if we are the start of an xact, move forward to the next xact
(progn
(forward-line)
(if (not (ledger-xact-start-xact-or-directive-p)) ; we have moved forward and are not at another xact, recurse forward
(ledger-xact-next-xact-or-directive)))
(while (not (or (eobp) ; we didn't start off at the beginning of an xact
(ledger-xact-start-xact-or-directive-p)))
(forward-line))))
(provide 'ledger-xact) (provide 'ledger-xact)
;;; ledger-xact.el ends here ;;; ledger-xact.el ends here