(defgroup reveal nil
"Reveal hidden text on the fly."
:group 'editing)
(defcustom reveal-around-mark t
"Reveal text around the mark, if active."
:type 'boolean
:group 'reveal)
(defvar reveal-open-spots nil
"List of spots in the buffer which are open.
Each element has the form (WINDOW . OVERLAY).")
(make-variable-buffer-local 'reveal-open-spots)
(defvar reveal-last-tick nil)
(make-variable-buffer-local 'reveal-last-tick)
(defun reveal-post-command ()
(with-local-quit
(condition-case err
(let ((old-ols
(delq nil
(mapcar
(lambda (x)
(cond
((eq (car x) (selected-window)) (cdr x))
((not (and (window-live-p (car x))
(eq (window-buffer (car x)) (current-buffer))))
(setcar x (selected-window))
(cdr x))))
reveal-open-spots))))
(setq old-ols (reveal-open-new-overlays old-ols))
(reveal-close-old-overlays old-ols))
(error (message "Reveal: %s" err)))))
(defun reveal-open-new-overlays (old-ols)
(let ((repeat t))
(while repeat
(setq repeat nil)
(dolist (ol (nconc (when (and reveal-around-mark mark-active)
(overlays-at (mark)))
(overlays-at (point))))
(setq old-ols (delq ol old-ols))
(when (overlay-start ol) (let ((inv (overlay-get ol 'invisible)) open)
(when (and inv
(and (consp buffer-invisibility-spec)
(cdr (assq inv buffer-invisibility-spec)))
(or (setq open
(or (overlay-get ol 'reveal-toggle-invisible)
(and (symbolp inv)
(get inv 'reveal-toggle-invisible))
(overlay-get ol 'isearch-open-invisible-temporary)))
(overlay-get ol 'isearch-open-invisible)
(and (consp buffer-invisibility-spec)
(cdr (assq inv buffer-invisibility-spec))))
(overlay-put ol 'reveal-invisible inv))
(push (cons (selected-window) ol) reveal-open-spots)
(if (null open)
(overlay-put ol 'invisible nil)
(setq repeat t)
(condition-case err
(funcall open ol nil)
(error (message "!!Reveal-show (funcall %s %s nil): %s !!"
open ol err)
(setq repeat nil)
(overlay-put ol 'invisible nil))))))))))
old-ols)
(defun reveal-close-old-overlays (old-ols)
(if (not (eq reveal-last-tick
(setq reveal-last-tick (buffer-modified-tick))))
nil
(dolist (ol old-ols)
(if (and (overlay-start ol) (>= (point) (save-excursion
(goto-char (overlay-start ol))
(line-beginning-position 1)))
(<= (point) (save-excursion
(goto-char (overlay-end ol))
(line-beginning-position 2)))
(eq (current-buffer) (overlay-buffer ol)))
nil
(let* ((inv (overlay-get ol 'reveal-invisible))
(open (or (overlay-get ol 'reveal-toggle-invisible)
(get inv 'reveal-toggle-invisible)
(overlay-get ol 'isearch-open-invisible-temporary))))
(if (and (overlay-start ol) open)
(condition-case err
(funcall open ol t)
(error (message "!!Reveal-hide (funcall %s %s t): %s !!"
open ol err)))
(overlay-put ol 'invisible inv))
(overlay-put ol 'reveal-invisible nil)
(setq reveal-open-spots
(delq (rassoc ol reveal-open-spots)
reveal-open-spots)))))))
(defvar reveal-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [remap move-beginning-of-line] 'beginning-of-line)
(define-key map [remap move-end-of-line] 'end-of-line)
map))
(define-minor-mode reveal-mode
"Toggle Reveal mode on or off.
Reveal mode renders invisible text around point visible again.
Interactively, with no prefix argument, toggle the mode.
With universal prefix ARG (or if ARG is nil) turn mode on.
With zero or negative ARG turn mode off."
:group 'reveal
:lighter (global-reveal-mode nil " Reveal")
:keymap reveal-mode-map
(if reveal-mode
(progn
(set (make-local-variable 'search-invisible) t)
(add-hook 'post-command-hook 'reveal-post-command nil t))
(kill-local-variable 'search-invisible)
(remove-hook 'post-command-hook 'reveal-post-command t)))
(define-minor-mode global-reveal-mode
"Toggle Reveal mode in all buffers on or off.
Reveal mode renders invisible text around point visible again.
Interactively, with no prefix argument, toggle the mode.
With universal prefix ARG (or if ARG is nil) turn mode on.
With zero or negative ARG turn mode off."
:global t :group 'reveal
(setq-default reveal-mode global-reveal-mode)
(if global-reveal-mode
(progn
(setq search-invisible t)
(add-hook 'post-command-hook 'reveal-post-command))
(setq search-invisible 'open) (remove-hook 'post-command-hook 'reveal-post-command)))
(provide 'reveal)