diff options
| -rw-r--r-- | lisp/ledger-fontify.el | 6 | ||||
| -rw-r--r-- | lisp/ledger-mode.el | 5 | ||||
| -rw-r--r-- | lisp/ledger-navigate.el | 92 | ||||
| -rw-r--r-- | lisp/ledger-occur.el | 2 | ||||
| -rw-r--r-- | lisp/ledger-post.el | 2 | ||||
| -rw-r--r-- | lisp/ledger-reconcile.el | 8 | ||||
| -rw-r--r-- | lisp/ledger-report.el | 2 | ||||
| -rw-r--r-- | lisp/ledger-sort.el | 70 | ||||
| -rw-r--r-- | lisp/ledger-state.el | 2 | ||||
| -rw-r--r-- | lisp/ledger-xact.el | 42 |
10 files changed, 146 insertions, 85 deletions
diff --git a/lisp/ledger-fontify.el b/lisp/ledger-fontify.el index a820065d..8059055d 100644 --- a/lisp/ledger-fontify.el +++ b/lisp/ledger-fontify.el @@ -50,13 +50,13 @@ (ledger-fontify-xact-at (point))) ((looking-at ledger-directive-start-regex) (ledger-fontify-directive-at (point)))) - (ledger-next-record-function)))) + (ledger-navigate-next-xact-or-directive)))) (defun ledger-fontify-xact-at (position) (interactive "d") (save-excursion (goto-char position) - (let ((extents (ledger-find-xact-extents position)) + (let ((extents (ledger-navigate-find-xact-extents position)) (state (ledger-transaction-state))) ;; (message (concat "ledger-fontify-xact-at: " ;; (int-to-string position) @@ -121,7 +121,7 @@ 'ledger-font-comment-face))) (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)) (cond ((looking-at "=") (setq face 'ledger-font-auto-xact-face)) diff --git a/lisp/ledger-mode.el b/lisp/ledger-mode.el index e7771f40..3b00bb94 100644 --- a/lisp/ledger-mode.el +++ b/lisp/ledger-mode.el @@ -37,6 +37,7 @@ (require 'ledger-fonts) (require 'ledger-fontify) (require 'ledger-init) +(require 'ledger-navigate) (require 'ledger-occur) (require 'ledger-post) (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 ?s)] 'ledger-report-save) - (define-key map [(meta ?p)] 'ledger-prev-record-function) - (define-key map [(meta ?n)] 'ledger-next-record-function) + (define-key map [(meta ?p)] 'ledger-navigate-prev-xact) + (define-key map [(meta ?n)] 'ledger-navigate-next-xact-or-directive) map) "Keymap for `ledger-mode'.") diff --git a/lisp/ledger-navigate.el b/lisp/ledger-navigate.el new file mode 100644 index 00000000..949654e4 --- /dev/null +++ b/lisp/ledger-navigate.el @@ -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 diff --git a/lisp/ledger-occur.el b/lisp/ledger-occur.el index 9287ed13..0851307e 100644 --- a/lisp/ledger-occur.el +++ b/lisp/ledger-occur.el @@ -164,7 +164,7 @@ Used for coordinating `ledger-occur' with other buffers, like reconcile." ;; if something found (when (setq endpoint (re-search-forward regex nil 'end)) (save-excursion - (let ((bounds (ledger-find-xact-extents (match-beginning 0)))) + (let ((bounds (ledger-navigate-find-xact-extents (match-beginning 0)))) (push bounds lines) (setq curpoint (cadr bounds)))) ;; move to the end of ;; the xact, no need to diff --git a/lisp/ledger-post.el b/lisp/ledger-post.el index 87e998cf..f0b7b8c1 100644 --- a/lisp/ledger-post.el +++ b/lisp/ledger-post.el @@ -96,7 +96,7 @@ at beginning of account" (defun ledger-post-align-xact (pos) (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)))) (defun ledger-post-align-postings (&optional beg end) diff --git a/lisp/ledger-reconcile.el b/lisp/ledger-reconcile.el index 48d54eb0..f660fd0e 100644 --- a/lisp/ledger-reconcile.el +++ b/lisp/ledger-reconcile.el @@ -157,7 +157,7 @@ And calculate the target-delta of the account being reconciled." status) (when (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) (setq status (ledger-toggle-current (if ledger-reconcile-toggle-to-pending 'pending @@ -220,7 +220,7 @@ Return the number of uncleared xacts found." (let ((where (get-text-property (point) 'where))) (when (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))) (let ((inhibit-read-only t)) (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)))) (when target-buffer (switch-to-buffer-other-window target-buffer) - (ledger-goto-line (cdr where)) + (ledger-navigate-to-line (cdr where)) (forward-char) (recenter) (ledger-highlight-xact-under-point) @@ -273,7 +273,7 @@ and exit reconcile mode" (face (get-text-property (point) 'face))) (if (eq face 'ledger-font-reconciler-pending-face) (with-current-buffer (ledger-reconcile-get-buffer where) - (ledger-goto-line (cdr where)) + (ledger-navigate-to-line (cdr where)) (ledger-toggle-current 'cleared)))) (forward-line 1))) (ledger-reconcile-save) diff --git a/lisp/ledger-report.el b/lisp/ledger-report.el index ae45d36d..f61576e3 100644 --- a/lisp/ledger-report.el +++ b/lisp/ledger-report.el @@ -325,7 +325,7 @@ Optional EDIT the command." (save-excursion (find-file file) (widen) - (ledger-goto-line line) + (ledger-navigate-to-line line) (point-marker)))))) (add-text-properties (line-beginning-position) (line-end-position) (list 'face 'ledger-font-report-clickable-face)) diff --git a/lisp/ledger-sort.el b/lisp/ledger-sort.el index 41f8af3c..1ac125a9 100644 --- a/lisp/ledger-sort.el +++ b/lisp/ledger-sort.el @@ -26,36 +26,36 @@ ;;; Code: -(defun ledger-next-record-function () - "Move point to next transaction." - ;; 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-prev-record-function () - "Move point to beginning of previous xact." - (ledger-beginning-record-function) - (re-search-backward ledger-xact-start-regex nil t)) - -(defun ledger-beginning-record-function () - "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-end-record-function () - "Move point to end of xact." - (interactive) - (ledger-next-record-function) - (backward-char) - (end-of-line) - (point)) +;; (defun ledger-next-record-function () +;; "Move point to next transaction." +;; ;; 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-prev-record-function () +;; "Move point to beginning of previous xact." +;; (ledger-beginning-record-function) +;; (re-search-backward ledger-xact-start-regex nil t)) + +;; (defun ledger-beginning-record-function () +;; "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-end-record-function () +;; "Move point to end of xact." +;; (interactive) +;; (ledger-navigate-next-xact) +;; (backward-char) +;; (end-of-line) +;; (point)) (defun ledger-sort-find-start () (if (re-search-forward ";.*Ledger-mode:.*Start sort" nil t) @@ -94,7 +94,7 @@ (let ((new-beg beg) (new-end end) point-delta - (bounds (ledger-find-xact-extents (point))) + (bounds (ledger-navigate-find-xact-extents (point))) target-xact) (setq point-delta (- (point) (car bounds))) @@ -104,10 +104,10 @@ (save-restriction (goto-char beg) ;; make sure point is at the beginning of a xact - (ledger-next-record-function) + (ledger-navigate-next-xact-or-directive) (setq new-beg (point)) (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 ;; after the region (setq new-end (point)) @@ -117,8 +117,8 @@ (let ((inhibit-field-text-motion t)) (sort-subr nil - 'ledger-next-record-function - 'ledger-end-record-function + 'ledger-navigate-next-xact-or-directive + 'ledger-navigate-end-of-xact 'ledger-sort-startkey)))) (goto-char (point-min)) diff --git a/lisp/ledger-state.el b/lisp/ledger-state.el index 4705e604..8822570d 100644 --- a/lisp/ledger-state.el +++ b/lisp/ledger-state.el @@ -85,7 +85,7 @@ achieved more certainly by passing the xact to ledger for formatting, but doing so causes inline math expressions to be dropped." (interactive) - (let ((bounds (ledger-find-xact-extents (point))) + (let ((bounds (ledger-navigate-find-xact-extents (point))) new-status cur-status) ;; Uncompact the xact, to make it easier to toggle the ;; transaction diff --git a/lisp/ledger-xact.el b/lisp/ledger-xact.el index f38bec74..522f8d99 100644 --- a/lisp/ledger-xact.el +++ b/lisp/ledger-xact.el @@ -39,19 +39,10 @@ (defvar ledger-xact-highlight-overlay (list)) (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 () "Move the highlight overlay to the current transaction." (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)) (if (not ledger-xact-highlight-overlay) (setq ovl @@ -91,7 +82,7 @@ MOMENT is an encoded date" (if (ledger-time-less-p moment date) (throw 'found t)))))) (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) (if (eobp) (insert "\n") @@ -122,11 +113,6 @@ MOMENT is an encoded date" mark desc))))) (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 () (let ((sep (if ledger-use-iso-dates "-" @@ -138,7 +124,7 @@ MOMENT is an encoded date" (interactive (list (ledger-read-date "Copy to date: "))) (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))) encoded-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))))) (ledger-xact-find-slot encoded-date) (insert transaction "\n") - (ledger-beginning-record-function) + (ledger-navigate-beginning-of-xact) (re-search-forward ledger-iso-date-regexp) (replace-match date) (ledger-next-amount) @@ -158,7 +144,7 @@ MOMENT is an encoded date" (defun ledger-delete-current-transaction (pos) "Delete the transaction surrounging point." (interactive "d") - (let ((bounds (ledger-find-xact-extents pos))) + (let ((bounds (ledger-navigate-find-xact-extents pos))) (delete-region (car bounds) (cadr bounds)))) (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") (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) ;;; ledger-xact.el ends here |