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

All navigation functions moved to ledger-navigate.

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

6
lisp/ledger-fontify.el
View file

@ -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))

5
lisp/ledger-mode.el
View file

@ -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'.")

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

2
lisp/ledger-occur.el
View file

@ -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

2
lisp/ledger-post.el
View file

@ -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)

8
lisp/ledger-reconcile.el
View file

@ -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)

2
lisp/ledger-report.el
View file

@ -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))

64
lisp/ledger-sort.el
View file

@ -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-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-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-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-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))

2
lisp/ledger-state.el
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
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

42
lisp/ledger-xact.el
View file

@ -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