diff options
Diffstat (limited to 'lisp/ledger-occur.el')
| -rw-r--r-- | lisp/ledger-occur.el | 100 |
1 files changed, 50 insertions, 50 deletions
diff --git a/lisp/ledger-occur.el b/lisp/ledger-occur.el index 33d3a56c..24ded4ca 100644 --- a/lisp/ledger-occur.el +++ b/lisp/ledger-occur.el @@ -1,6 +1,6 @@ ;;; ledger-mode.el --- Helper code for use with the "ledger" command-line tool -;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) +;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org) ;; This file is not part of GNU Emacs. @@ -16,8 +16,8 @@ ;; ;; 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., 59 Temple Place - Suite 330, Boston, -;; MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +;; MA 02110-1301 USA. ;;; Commentary: ;; Provide buffer narrowing to ledger mode. Adapted from original loccur @@ -39,7 +39,7 @@ (defvar ledger-occur-mode nil - "name of the minor mode, shown in the mode-line") + "name of the minor mode, shown in the mode-line") (make-variable-buffer-local 'ledger-occur-mode) @@ -65,19 +65,19 @@ When REGEX is nil, unhide everything, and remove higlight" (set-buffer buffer) (setq ledger-occur-mode - (if (or (null regex) - (zerop (length regex))) - nil - (concat " Ledger-Narrowed: " regex))) + (if (or (null regex) + (zerop (length regex))) + nil + (concat " Ledger-Narrowed: " regex))) (force-mode-line-update) (ledger-occur-remove-overlays) (when ledger-occur-mode - (ledger-occur-create-overlays - (ledger-occur-compress-matches - (ledger-occur-find-matches regex))) - (setq ledger-occur-last-match regex) - (if (get-buffer-window buffer) - (select-window (get-buffer-window buffer)))) + (ledger-occur-create-overlays + (ledger-occur-compress-matches + (ledger-occur-find-matches regex))) + (setq ledger-occur-last-match regex) + (if (get-buffer-window buffer) + (select-window (get-buffer-window buffer)))) (recenter)) (defun ledger-occur (regex) @@ -90,7 +90,7 @@ When REGEX is nil, unhide everything, and remove higlight" (if ledger-occur-mode (list nil) (list (read-string (concat "Regexp<" (ledger-occur-prompt) ">: ") - nil 'ledger-occur-history (ledger-occur-prompt))))) + nil 'ledger-occur-history (ledger-occur-prompt))))) (ledger-occur-mode regex (current-buffer))) (defun ledger-occur-prompt () @@ -108,32 +108,32 @@ When REGEX is nil, unhide everything, and remove higlight" (if (= (line-number-at-pos pos1) (line-number-at-pos pos2)) (buffer-substring-no-properties pos1 pos2))) - (current-word)))) + (current-word)))) prompt)) (defun ledger-occur-make-visible-overlay (beg end) - (let ((ovl (make-overlay beg end (current-buffer)))) - (overlay-put ovl ledger-occur-overlay-property-name t) - (overlay-put ovl 'face 'ledger-occur-xact-face))) + (let ((ovl (make-overlay beg end (current-buffer)))) + (overlay-put ovl ledger-occur-overlay-property-name t) + (overlay-put ovl 'face 'ledger-occur-xact-face))) (defun ledger-occur-make-invisible-overlay (beg end) - (let ((ovl (make-overlay beg end (current-buffer)))) - (overlay-put ovl ledger-occur-overlay-property-name t) - (overlay-put ovl 'invisible t))) + (let ((ovl (make-overlay beg end (current-buffer)))) + (overlay-put ovl ledger-occur-overlay-property-name t) + (overlay-put ovl 'invisible t))) (defun ledger-occur-create-overlays (ovl-bounds) "Create the overlays for the visible transactions. Argument OVL-BOUNDS contains bounds for the transactions to be left visible." - (let* ((beg (caar ovl-bounds)) - (end (cadar ovl-bounds))) - (ledger-occur-make-invisible-overlay (point-min) (1- beg)) - (dolist (visible (cdr ovl-bounds)) - (ledger-occur-make-visible-overlay beg end) - (ledger-occur-make-invisible-overlay (1+ end) (1- (car visible))) - (setq beg (car visible)) - (setq end (cadr visible))) - (ledger-occur-make-invisible-overlay (1+ end) (point-max)))) + (let* ((beg (caar ovl-bounds)) + (end (cadar ovl-bounds))) + (ledger-occur-make-invisible-overlay (point-min) (1- beg)) + (dolist (visible (cdr ovl-bounds)) + (ledger-occur-make-visible-overlay beg end) + (ledger-occur-make-invisible-overlay (1+ end) (1- (car visible))) + (setq beg (car visible)) + (setq end (cadr visible))) + (ledger-occur-make-invisible-overlay (1+ end) (point-max)))) (defun ledger-occur-quit-buffer (buffer) "Quits hidings transaction in the given BUFFER. @@ -148,7 +148,7 @@ Used for coordinating `ledger-occur' with other buffers, like reconcile." "Remove the transaction hiding overlays." (interactive) (remove-overlays (point-min) - (point-max) ledger-occur-overlay-property-name t) + (point-max) ledger-occur-overlay-property-name t) (setq ledger-occur-overlay-list nil)) (defun ledger-occur-find-matches (regex) @@ -157,35 +157,35 @@ Used for coordinating `ledger-occur' with other buffers, like reconcile." (goto-char (point-min)) ;; Set initial values for variables (let (curpoint - endpoint - (lines (list))) + endpoint + (lines (list))) ;; Search loop (while (not (eobp)) (setq curpoint (point)) ;; if something found (when (setq endpoint (re-search-forward regex nil 'end)) (save-excursion - (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 inside it more + (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 inside it more (goto-char curpoint)) (forward-line 1)) (setq lines (nreverse lines))))) (defun ledger-occur-compress-matches (buffer-matches) - "identify sequential xacts to reduce number of overlays required" - (let ((points (list)) - (current-beginning (caar buffer-matches)) - (current-end (cadar buffer-matches))) - (dolist (match (cdr buffer-matches)) - (if (< (- (car match) current-end) 2) - (setq current-end (cadr match)) - (push (list current-beginning current-end) points) - (setq current-beginning (car match)) - (setq current-end (cadr match)))) - (nreverse (push (list current-beginning current-end) points)))) + "identify sequential xacts to reduce number of overlays required" + (let ((points (list)) + (current-beginning (caar buffer-matches)) + (current-end (cadar buffer-matches))) + (dolist (match (cdr buffer-matches)) + (if (< (- (car match) current-end) 2) + (setq current-end (cadr match)) + (push (list current-beginning current-end) points) + (setq current-beginning (car match)) + (setq current-end (cadr match)))) + (nreverse (push (list current-beginning current-end) points)))) (provide 'ledger-occur) |