#| sawfish.wm.ext.vpf -- Focus & pointer restoration
  under viewport change.
  Changed: 17 Jan 2009
 |#
;;; 
(define-structure sawfish.wm.ext.vpf
    (export)

    (open rep
          rep.system
	  sawfish.wm
          sawfish.wm.viewport
	  sawfish.wm.commands
	  )
  
  (defvar vpf-list '()
    "List of saved focus.
Each element is of the form '((x . y) focus pointer).
'(x . y) indicates the viewport.
'(Quoted for the sake of emacs-sawfish-mode.)
focus is the window with focus, nil if the root window.
pointer is the coordinate of the pointer.")
  
  (define (vpf-move-viewport xx yy)
    "Move viewport relative to the current one.
The previous focus is restored."
    (let (
	  (cur (screen-viewport))
	  (myList vpf-list)
	  nextEl 
	  x y ;; absolute one
	  cw
	  )
      ;; first, save the current viewport focus
      (setq nextEl (list cur (input-focus) (query-pointer)))

      (while myList
	(if (equal cur (caar myList))
	    ;; previous setting found. Rewrite it
	    (progn
	      (rplaca myList nextEl)
	      (setq nextEl nil)
	      (setq myList nil)
	      )
	;; else
	(setq myList (cdr myList))
	))
      ;; not found. Save it.
      (when nextEl
	(setq vpf-list (cons nextEl vpf-list)))

      ;; now restore the previous setting
      (setq myList vpf-list)

      (setq x (+ xx (car cur)))
      (setq y (+ yy (cdr cur)))
      (setq cur (cons x y))

      (setq cw (input-focus))

      (if (and cw
	       (window-sticky-p/viewport cw)
	       (eq cw (query-pointer-window))
	       )
	  ;; sticky window is treated specially.
	  ;; they continue to be focused, and put at the top.
	  (progn
	    (move-viewport xx yy)
	    (set-input-focus cw)
	    (raise-window cw)
	    )
	;; not sticky; usual behavior
	(while myList
	  (if (equal cur (caar myList))
	      ;;found, regain it
	      (progn
		(move-viewport xx yy)
		(setq cur (nth 2 (car myList)))
		(warp-cursor (car cur) (cdr cur))
		(when (windowp (nth 1 (car myList)))
		  (set-input-focus (nth 1 (car myList)))
		  )
		(setq myList nil)
		(setq cur nil)
		)
	    ;; else
	    (setq myList (cdr myList))))
	(when cur
	  ;; no matches
	  (move-viewport xx yy)
	  )
	)
    )
  )

  (define (vpf-right)
    "Move the viewport one screen to the right."
    (vpf-move-viewport 1 0))

  (define (vpf-left)
    "Move the viewport one screen to the left."
    (vpf-move-viewport -1 0))

  (define (vpf-down)
    "Move the viewport one screen down."
    (vpf-move-viewport 0 1))

  (define (vpf-up)
    "Move the viewport one screen up."
    (vpf-move-viewport 0 -1))

  (define-command 'vpf-right vpf-right )
  (define-command 'vpf-left vpf-left )
  (define-command 'vpf-up vpf-up )
  (define-command 'vpf-down vpf-down )
  
)