;;; show-old-window-pos.el --- Show old window position briefly after it changes.

;; Copyright (C) 2008 David De La Harpe Golden

;; Author: David De La Harpe Golden <address@hidden>
;; Version: 3
;; Keywords: scrolling

;; show-old-window-pos.el is free software; you can redistribute it 
;; and/or modify it under the terms of the GNU General Public License 
;; as published by the Free Software Foundation; either version 3 of 
;; the License, or (at your option) any later version.

;; show-old-window-pos.el is distributed in the hope that it will be 
;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty
;; of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This package provides fringe marks that show where in the buffer 
;; the window used to be showing for a couple of  seconds when the 
;; window position changes through scrolling etc.

;; This is done via timers, and is on a "best effort" basis only.

;;; Code:

(defgroup show-old-window-pos nil
  "Indicate (in the fringe) the old window position for a bit when scrolling."
  :version "23.1"
  :group 'windows)

(defface show-old-window-pos-fringe 
  '((t (:foreground "darkcyan")))
  "Face for old window position fringe mark."
  :group 'show-old-window-pos
  :version "23.1")

(defcustom show-old-window-pos-linger-time 2
  "How long the fringe marks showing old window position should be visible for."
  :type 'integer
  :group 'show-old-window-pos
  :version "23.1")


(defcustom show-old-window-pos-each-time-commands
  '(scroll-up scroll-down scroll-other-window scroll-other-window-down)
  "What commands should always show the immediately preceding old window position.
Typically, one would want only commands that cause large scrolls 
or other window changes listed here."
  :type '(repeat symbol)
  :group 'show-old-window-pos
  :version "23.1")

(defvar show-old-window-pos-overlays (make-hash-table :weakness 'key))

(defun show-old-window-pos-overlays-ensure-hash-table ()
  (unless (hash-table-p show-old-window-pos-overlays)
    (setq show-old-window-pos-overlays (make-hash-table :weakness 'key))))

(defun show-old-window-pos-add-overlay (window)
  (show-old-window-pos-overlays-ensure-hash-table)
  (let ((overlay (make-overlay 
		  (window-start window) 
		  (- (window-end window) 1) 
		  (window-buffer window))))
    (overlay-put overlay 'window window)
    (puthash window overlay show-old-window-pos-overlays)))

(defun show-old-window-pos-overlays-showhide ()
  (show-old-window-pos-overlays-ensure-hash-table)
  (mapcar (lambda (visible-frame)
	    (mapcar 
	     (lambda (window)
	       (let ((old-pos-overlay
		      (gethash window show-old-window-pos-overlays)))
		 (unless old-pos-overlay
		   (show-old-window-pos-add-overlay window))
		 (if (equal (window-start window) 
			    (overlay-start old-pos-overlay))
		     (overlay-put old-pos-overlay 'before-string nil)
		   (overlay-put 
		    old-pos-overlay 'before-string 
		    (concat
		     (propertize "[" 'display 
				 (list 'left-fringe 'top-left-angle 
				       'show-old-window-pos-fringe))
		     (propertize "[" 'display 
				 (list 'right-fringe 'top-right-angle 
				       'show-old-window-pos-fringe)))))
		 (if (equal (- (window-end window) 1) 
			    (overlay-end old-pos-overlay))
		     (overlay-put old-pos-overlay 'after-string nil)
		   (overlay-put 
		    old-pos-overlay 'after-string 
		    (concat
		     (propertize "]" 'display 
				 (list 'left-fringe 'bottom-left-angle 
				       'show-old-window-pos-fringe))
		     (propertize "]" 'display 
				 (list 'right-fringe 
				       'bottom-right-angle
				       'show-old-window-pos-fringe)))))))
	     (window-list visible-frame)))
	  (visible-frame-list)))

(defun show-old-window-pos-overlays-update-pos ()
  (show-old-window-pos-overlays-ensure-hash-table)
  (mapcar (lambda (visible-frame) 
	    (mapcar (lambda (window) 
		      (let ((old-pos-overlay 
			     (gethash window show-old-window-pos-overlays)))
			(if old-pos-overlay
			    (move-overlay old-pos-overlay
					  (window-start window)
					  (- (window-end window) 1)
					  (window-buffer window))
			  (show-old-window-pos-add-overlay window))))
		    (window-list visible-frame)))
	  (visible-frame-list))
  (show-old-window-pos-overlays-showhide)
  (redisplay))

	     
(defun show-old-window-pos-maybe-reset-old-pos ()
  "Pre-command-hook that resets the old window pos before certain commands."
  (when (memq this-command show-old-window-pos-each-time-commands)
    (show-old-window-pos-overlays-update-pos)))


(define-minor-mode show-old-window-pos-mode
  "Toggle show-old-window-pos-mode.

In show-old-window-pos-mode, if the fringes are present, fringe
marks will show the position the old window was showing in its
buffer for `show-old-window-pos-linger-time' seconds when the 
window changes position."

  :global t
  :group 'show-old-window-pos
  :init-value nil
  :link '(emacs-commentary-link "show-old-window-pos.el")
  (if show-old-window-pos-mode
      (progn
	(add-hook 'pre-command-hook 'show-old-window-pos-maybe-reset-old-pos)
	(run-with-idle-timer 0 t 'show-old-window-pos-overlays-showhide)
	(run-with-idle-timer show-old-window-pos-linger-time
			     t 'show-old-window-pos-overlays-update-pos))
    (cancel-function-timers 'show-old-window-pos-overlays-showhide)
    (cancel-function-timers 'show-old-window-pos-overlays-update-pos)
    (remove-hook 'pre-command-hook 'show-old-window-pos-maybe-reset-old-pos)
    ;; Explicitly delete overlays.
    (maphash (lambda (key val)
	       (if (overlayp val)
		   (delete-overlay val)))
	     show-old-window-pos-overlays)
    (setq show-old-window-pos-overlays nil)))

(provide 'show-old-window-pos)

;;; show-old-window-pos.el ends here