ledger-navigate.el (7139B)
1 ;;; ledger-navigate.el --- Provide navigation services through the ledger buffer. -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2014-2015 Craig Earls (enderw88 AT gmail DOT com) 4 5 ;; This file is not part of GNU Emacs. 6 7 ;; This is free software; you can redistribute it and/or modify it under 8 ;; the terms of the GNU General Public License as published by the Free 9 ;; Software Foundation; either version 2, or (at your option) any later 10 ;; version. 11 ;; 12 ;; This is distributed in the hope that it will be useful, but WITHOUT 13 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 14 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 15 ;; for more details. 16 ;; 17 ;; You should have received a copy of the GNU General Public License 18 ;; along with GNU Emacs; see the file COPYING. If not, write to the 19 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, 20 ;; MA 02110-1301 USA. 21 22 23 ;;; Commentary: 24 ;; 25 26 ;;; Code: 27 28 (require 'ledger-regex) 29 (require 'ledger-context) 30 31 (defun ledger-navigate-next-xact () 32 "Move point to beginning of next xact." 33 ;; make sure we actually move to the next xact, even if we are the 34 ;; beginning of one now. 35 (if (looking-at ledger-payee-any-status-regex) 36 (forward-line)) 37 (if (re-search-forward ledger-payee-any-status-regex nil t) 38 (goto-char (match-beginning 0)) 39 (goto-char (point-max)))) 40 41 (defun ledger-navigate-start-xact-or-directive-p () 42 "Return t if at the beginning line of an xact or directive. 43 44 Assumes point is at the beginning of a line." 45 (not (looking-at "[ \t]\\|\\(^$\\)"))) 46 47 (defun ledger-navigate-next-xact-or-directive () 48 "Move to the beginning of the next xact or directive." 49 (interactive) 50 (beginning-of-line) 51 (if (ledger-navigate-start-xact-or-directive-p) ; if we are the start of an xact, move forward to the next xact 52 (progn 53 (forward-line) 54 (unless (ledger-navigate-start-xact-or-directive-p) ; we have moved forward and are not at another xact, recurse forward 55 (ledger-navigate-next-xact-or-directive))) 56 (while (not (or (eobp) ; we didn't start off at the beginning of an xact 57 (ledger-navigate-start-xact-or-directive-p))) 58 (forward-line)))) 59 60 (defun ledger-navigate-prev-xact-or-directive () 61 "Move point to beginning of previous xact." 62 (interactive) 63 (let ((context (car (ledger-context-at-point)))) 64 (when (equal context 'acct-transaction) 65 (ledger-navigate-beginning-of-xact)) 66 (beginning-of-line) 67 (re-search-backward "^[[:graph:]]" nil t))) 68 69 (defun ledger-navigate-beginning-of-xact () 70 "Move point to the beginning of the current xact." 71 (interactive) 72 ;; need to start at the beginning of a line in case we are in the first line of an xact already. 73 (beginning-of-line) 74 (let ((sreg (concat "^[=~[:digit:]]"))) 75 (unless (looking-at sreg) 76 (re-search-backward sreg nil t) 77 (beginning-of-line))) 78 (point)) 79 80 (defun ledger-navigate-end-of-xact () 81 "Move point to end of xact." 82 (interactive) 83 (ledger-navigate-next-xact-or-directive) 84 (re-search-backward ".$") 85 (end-of-line) 86 (point)) 87 88 (defun ledger-navigate-to-line (line-number) 89 "Rapidly move point to line LINE-NUMBER." 90 (goto-char (point-min)) 91 (forward-line (1- line-number))) 92 93 (defun ledger-navigate-find-xact-extents (pos) 94 "Return list containing point for beginning and end of xact containing POS. 95 Requires empty line separating xacts." 96 (interactive "d") 97 (save-excursion 98 (goto-char pos) 99 (list (ledger-navigate-beginning-of-xact) 100 (ledger-navigate-end-of-xact)))) 101 102 (defun ledger-navigate-skip-lines-backwards (re) 103 "Move backwards if necessary until the line beginning does not match RE." 104 (beginning-of-line) 105 (while (and (looking-at-p re) 106 (zerop (forward-line -1))))) 107 108 (defun ledger-navigate-skip-lines-forwards (re) 109 "Move forwards if necessary until the line beginning does not match RE." 110 (beginning-of-line) 111 (while (and (looking-at-p re) 112 (zerop (forward-line 1))))) 113 114 (defun ledger-navigate-find-directive-extents (pos) 115 "Return the extents of the directive at POS." 116 (goto-char pos) 117 (let ((begin (progn (ledger-navigate-skip-lines-backwards "[ \t]\\|end[[:blank:]]+\\(?:comment\\|test\\)") 118 (point))) 119 (end (progn (forward-line 1) 120 (ledger-navigate-skip-lines-forwards "[ \t]") 121 (1- (point)))) 122 (comment-re " *;")) 123 ;; handle block comments here 124 (goto-char begin) 125 (cond 126 ((looking-at comment-re) 127 (ledger-navigate-skip-lines-backwards comment-re) 128 ;; We are either at the beginning of the buffer, or we found 129 ;; a line outside the comment, or both. If we are outside 130 ;; the comment then we need to move forward a line. 131 (unless (looking-at comment-re) 132 (forward-line 1) 133 (beginning-of-line)) 134 (setq begin (point)) 135 (goto-char pos) 136 (ledger-navigate-skip-lines-forwards comment-re) 137 (setq end (point))) 138 ((looking-at "\\(?:comment\\|test\\)\\>") 139 (setq end (or (save-match-data 140 (re-search-forward "^end[[:blank:]]+\\(?:comment\\|test\\)\\_>")) 141 (point-max))))) 142 (list begin end))) 143 144 (defun ledger-navigate-block-comment (pos) 145 "Move past the block comment at POS, and return its extents." 146 (interactive "d") 147 (goto-char pos) 148 (let ((begin (progn (beginning-of-line) 149 (point))) 150 (end (progn (end-of-line) 151 (point))) 152 (comment-re " *;")) 153 ;; handle block comments here 154 (beginning-of-line) 155 (when (looking-at comment-re) 156 (ledger-navigate-skip-lines-backwards comment-re) 157 (setq begin (point)) 158 (goto-char pos) 159 (beginning-of-line) 160 (ledger-navigate-skip-lines-forwards comment-re) 161 (setq end (point))) 162 (list begin end))) 163 164 165 (defun ledger-navigate-find-element-extents (pos) 166 "Return list containing beginning and end of the entity surrounding POS." 167 (interactive "d") 168 (save-excursion 169 (goto-char pos) 170 (beginning-of-line) 171 (ledger-navigate-skip-lines-backwards "[ \t]\\|end[[:blank:]]+\\(?:comment\\|test\\)\\_>") 172 (if (looking-at "[=~0-9\\[]") 173 (ledger-navigate-find-xact-extents pos) 174 (ledger-navigate-find-directive-extents pos)))) 175 176 (defun ledger-navigate-next-uncleared () 177 "Move point to the next uncleared transaction." 178 (interactive) 179 (when (looking-at ledger-payee-uncleared-regex) 180 (forward-line)) 181 (if (re-search-forward ledger-payee-uncleared-regex nil t) 182 (progn (beginning-of-line) 183 (point)) 184 (user-error "No next uncleared transactions"))) 185 186 (defun ledger-navigate-previous-uncleared () 187 "Move point to the previous uncleared transaction." 188 (interactive) 189 (when (equal (car (ledger-context-at-point)) 'acct-transaction) 190 (ledger-navigate-beginning-of-xact)) 191 (if (re-search-backward ledger-payee-uncleared-regex nil t) 192 (progn (beginning-of-line) 193 (point)) 194 (user-error "No previous uncleared transactions"))) 195 196 197 (provide 'ledger-navigate) 198 199 ;;; ledger-navigate.el ends here