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

Merge pull request #152 from vanicat/t/occur-bugs

Browse source 
T/occur bugs
This commit is contained in:
Craig Earls 2013-02-09 06:38:08 -08:00
commit f89d6c4419
1 changed files with 24 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

46
lisp/ldg-occur.el
View file

@ -70,13 +70,14 @@
"A list of currently active overlays to the ledger buffer.") "A list of currently active overlays to the ledger buffer.")
(make-variable-buffer-local 'ledger-occur-overlay-list) (make-variable-buffer-local 'ledger-occur-overlay-list)
(defun ledger-occur-mode (regex buffer) (defun ledger-occur-mode (regex buffer)
"Higlight transaction that match REGEX, hiding others
When REGEX is nil, unhide everything, and remove higlight"
(progn (progn
(set-buffer buffer) (set-buffer buffer)
(setq ledger-occur-mode (setq ledger-occur-mode
(if (or ledger-occur-mode (if (or (null regex)
(null regex)
(zerop (length regex))) (zerop (length regex)))
nil nil
(concat " Ledger-Folded: " regex))) (concat " Ledger-Folded: " regex)))
@ -128,31 +129,32 @@
prompt)) prompt))
(defun ledger-occur-create-folded-overlays(buffer-matches) (defun ledger-occur-create-folded-overlays(buffer-matches)
(let ((overlays (if buffer-matches
(let ((prev-end (point-min)) (let ((overlays
(temp (point-max))) (let ((prev-end (point-min))
(mapcar (lambda (match) (temp (point-max)))
(progn (mapcar (lambda (match)
(setq temp prev-end) ;need a swap so that the (progn
(setq temp prev-end) ;need a swap so that the
;last form in the lambda ;last form in the lambda
;is the (make-overlay) ;is the (make-overlay)
(setq prev-end (1+ (cadr match))) ;add 1 so (setq prev-end (1+ (cadr match))) ;add 1 so
;that we skip ;that we skip
;the empty ;the empty
;line after ;line after
;the xact ;the xact
(make-overlay (make-overlay
temp temp
(car match) (car match)
(current-buffer) t nil))) (current-buffer) t nil)))
buffer-matches)))) buffer-matches))))
(mapcar (lambda (ovl) (mapcar (lambda (ovl)
(overlay-put ovl ledger-occur-overlay-property-name t) (overlay-put ovl ledger-occur-overlay-property-name t)
(overlay-put ovl 'invisible t) (overlay-put ovl 'invisible t)
(overlay-put ovl 'intangible t)) (overlay-put ovl 'intangible t))
(push (make-overlay (cadr (car(last buffer-matches))) (push (make-overlay (cadr (car(last buffer-matches)))
(point-max) (point-max)
(current-buffer) t nil) overlays)))) (current-buffer) t nil) overlays)))))
(defun ledger-occur-create-xact-overlays (ovl-bounds) (defun ledger-occur-create-xact-overlays (ovl-bounds)