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

Don't bomb out if the occur reggae has no matches.

Browse source
This commit is contained in:
Craig Earls 2014-12-03 20:40:12 -07:00
parent f238d993fb
commit 6853aa6726
1 changed files with 35 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

67
lisp/ledger-occur.el
View file

@ -38,21 +38,18 @@
(make-variable-buffer-local 'ledger-occur-use-face-shown) (make-variable-buffer-local 'ledger-occur-use-face-shown)
(defvar ledger-occur-mode nil (defvar ledger-occur-mode-name 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) (make-variable-buffer-local 'ledger-occur-mode-name)
(or (assq 'ledger-occur-mode minor-mode-alist) (or (assq 'ledger-occur-mode-name minor-mode-alist)
(nconc minor-mode-alist (nconc minor-mode-alist
(list '(ledger-occur-mode ledger-occur-mode)))) (list '(ledger-occur-mode-name ledger-occur-mode-name))))
(defvar ledger-occur-history nil (defvar ledger-occur-history nil
"History of previously searched expressions for the prompt.") "History of previously searched expressions for the prompt.")
(defvar ledger-occur-last-match nil
"Last match found.")
(make-variable-buffer-local 'ledger-occur-last-match)
(defun ledger-occur-remove-all-overlays () (defun ledger-occur-remove-all-overlays ()
"Remove all overlays from the ledger buffer." "Remove all overlays from the ledger buffer."
@ -64,22 +61,26 @@
When REGEX is nil, unhide everything, and remove higlight" When REGEX is nil, unhide everything, and remove higlight"
(set-buffer buffer) (set-buffer buffer)
(setq ledger-occur-mode (let (matches)
(if (or (null regex) (if (or (not regex)
(zerop (length regex))) (zerop (length regex))) ; empty regex, or already have narrowed, clear narrowing
nil (progn
(concat " Ledger-Narrowed: " regex))) (setq ledger-occur-mode-name nil)
(force-mode-line-update) (ledger-occur-remove-overlays))
(ledger-occur-remove-overlays) (if (not (setq matches (ledger-occur-compress-matches (ledger-occur-find-matches regex))))
(when ledger-occur-mode (progn ; regex couldn't be found
(ledger-occur-create-overlays (message "No matches found for '%s'" regex)
(ledger-occur-compress-matches (setq ledger-occur-mode-name nil)
(ledger-occur-find-matches regex))) (ledger-occur-remove-overlays))
(setq ledger-occur-last-match regex) (setq ledger-occur-mode-name
(if (get-buffer-window buffer) (concat " Ledger-Narrowed: " regex))
(select-window (get-buffer-window buffer)))) (ledger-occur-create-overlays matches)
(if (get-buffer-window buffer)
(select-window (get-buffer-window buffer))))))
(force-mode-line-update)
(recenter)) (recenter))
(defun ledger-occur (regex) (defun ledger-occur (regex)
"Perform a simple grep in current buffer for the regular expression REGEX. "Perform a simple grep in current buffer for the regular expression REGEX.
@ -87,7 +88,7 @@ When REGEX is nil, unhide everything, and remove higlight"
those containing the regular expression REGEX. A second call those containing the regular expression REGEX. A second call
of the function unhides lines again" of the function unhides lines again"
(interactive (interactive
(if ledger-occur-mode (if ledger-occur-mode-name
(list nil) (list nil)
(list (read-string (concat "Regexp<" (ledger-occur-prompt) ">: ") (list (read-string (concat "Regexp<" (ledger-occur-prompt) ">: ")
nil 'ledger-occur-history (ledger-occur-prompt))))) nil 'ledger-occur-history (ledger-occur-prompt)))))
@ -127,6 +128,7 @@ When REGEX is nil, unhide everything, and remove higlight"
Argument OVL-BOUNDS contains bounds for the transactions to be left visible." Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
(let* ((beg (caar ovl-bounds)) (let* ((beg (caar ovl-bounds))
(end (cadar ovl-bounds))) (end (cadar ovl-bounds)))
(ledger-occur-remove-overlays)
(ledger-occur-make-invisible-overlay (point-min) (1- beg)) (ledger-occur-make-invisible-overlay (point-min) (1- beg))
(dolist (visible (cdr ovl-bounds)) (dolist (visible (cdr ovl-bounds))
(ledger-occur-make-visible-overlay beg end) (ledger-occur-make-visible-overlay beg end)
@ -168,16 +170,17 @@ Used for coordinating `ledger-occur' with other buffers, like reconcile."
(defun ledger-occur-compress-matches (buffer-matches) (defun ledger-occur-compress-matches (buffer-matches)
"identify sequential xacts to reduce number of overlays required" "identify sequential xacts to reduce number of overlays required"
(let ((points (list)) (if buffer-matches
(current-beginning (caar buffer-matches)) (let ((points (list))
(current-end (cadar buffer-matches))) (current-beginning (caar buffer-matches))
(dolist (match (cdr buffer-matches)) (current-end (cadar buffer-matches)))
(if (< (- (car match) current-end) 2) (dolist (match (cdr buffer-matches))
(setq current-end (cadr match)) (if (< (- (car match) current-end) 2)
(push (list current-beginning current-end) points) (setq current-end (cadr match))
(setq current-beginning (car match)) (push (list current-beginning current-end) points)
(setq current-end (cadr match)))) (setq current-beginning (car match))
(nreverse (push (list current-beginning current-end) points)))) (setq current-end (cadr match))))
(nreverse (push (list current-beginning current-end) points)))))
(provide 'ledger-occur) (provide 'ledger-occur)