;; virtual-pan.gwm --- Autopanning or pan on click for "virtual.gwm"
;;
;; Author: Anders Holst  (aho@sans.kth.se)  
;; Copyright (C) 1995  Anders Holst
;; Version: virtual-1.0
;; Last change: 24/11 1996
;;
;; This file is copyrighted under the same terms as the rest of GWM
;; (see the X Inc license for details). There is no warranty that it
;; works. 
;;
;; --------------------------------------------------------------------- 
;;
;; This file defines "pan-lists" to put around the edges of the
;; screen. These can be used either for autopanning on the virtual
;; screen (ie. the real window moves when the mouse enters a
;; pan-list), or "pan on click" (ie. panning occurs when the user
;; clicks on the list). Which mode to use is controlled by the
;; variable 'pan-on-click'.
;;
;; When "panning on click", the length to pan is the same as the
;; horizontal and vertical step lengths in "virtual.gwm". When
;; "autopanning", the step length is controlled by 'pan-x-step' and
;; 'pan-y-step'.
;;
;; The pan lists are installed with '(install-pan-lists)' and removed
;; with '(remove-pan-lists)'.
;; 

(declare-screen-dependent
  show-pan-lists
  pan-on-click
  pan-x-step
  pan-y-step
  pan-delay
  pan-warp-step
  pan-warp-wrapped
  pan-corner-width
)

;;
;;    USER CUSTOMIZABLE VARIABLES
;;    ---------------------------  
;;    Adjust these in your own profile
;;
(for screen (list-of-screens)
     (defaults-to 
       show-pan-lists t               ; Enable pan lists
       pan-on-click t                 ; Pan on click (i.e. when you click
          ; in an edge or corner of the screen), or on enter (i.e. autopan, 
          ; pan as soon as the cursor reaches the edge of the screen).
       pan-x-step (/ screen-width 4)  ; How much to pan (when autopanning)
       pan-y-step (/ screen-height 4) ;  - " -
       pan-delay ()                   ; Time in milliseconds before autopanning
       pan-warp-step 4                ; Movement of cursor from edge on autopan
       pan-warp-wrapped ()            ; Move cursor to opposite edge on autopan
       pan-corner-width 30            ; Diagonal pan when this close to corner
       )
)

(defun pan-top-window ()
  (with (l (list-of-windows 'stacking-order)
         len (length l)
         i (- len 1))
    (tag ret
      (while (> i -1)
        (with (win (# i l))
          (if (and (not (= (# 'float win) 'up))
                   (not (= wob win)))
              (exit ret win))
          (: i (- i 1)))))))

(setq pan-fsm
  (fsm-make 
   (state-make
    (on visibility-fully-obscured
	(if (boundp 'raise-window-orig)
            (raise-window-orig (pan-top-window))
          (raise-window (pan-top-window))))
    (on visibility-partially-obscured
        (if (boundp 'raise-window-orig)
            (raise-window-orig (pan-top-window))
          (raise-window (pan-top-window))))
    (on enter-window
        (if (not pan-on-click)
            (with (etime (if pan-delay (elapsed-time))
                   xpos (current-event-x)
                   ypos (current-event-y)
                   xdir (if (< xpos pan-corner-width) 1
                            (> xpos (- screen-width pan-corner-width 1)) -1
                            0)
                   ydir (if (< ypos pan-corner-width) 1
                            (> ypos (- screen-height pan-corner-width 1)) -1
                            0)
                   mpos ())
               (if (or (not pan-delay)
                       (progn
                         (while (< (- (elapsed-time) etime) pan-delay) (process-events))
                         (setq mpos (current-mouse-position))
                         (= window (wob-at-coords (# 0 mpos) (# 1 mpos)))))
                   (progn
                     (virtual-move-windows (* pan-x-step xdir)
                                           (* pan-y-step ydir))
                     (if pan-warp-wrapped
                         (warp-pointer (* (- pan-x-step pan-warp-step) xdir)
                                       (* (- pan-y-step pan-warp-step) ydir))
                       (warp-pointer (* pan-warp-step xdir)
                                     (* pan-warp-step ydir))))))))
    (on (button any any)
        (if pan-on-click
            (with (xpos (current-event-x)
                   ypos (current-event-y)
                   xdir (if (< xpos pan-corner-width) 1
                            (> xpos (- screen-width pan-corner-width 1)) -1
                            0)
                   ydir (if (< ypos pan-corner-width) 1
                            (> ypos (- screen-height pan-corner-width 1)) -1
                            0))
               (virtual-move-windows (* virtual-horizontal-step xdir)
                                     (* virtual-vertical-step ydir)))))
    )))

(setq no-fsm
  (fsm-make
   (state-make
    ())))

(defun make-pan-list (x y xs ys)
  (with (fsm pan-fsm
         background black
         borderwidth 0
         inner-borderwidth 0
         opening '(lambda () ())
         closing '(lambda () ())
         property (+ '(float up) property)  ; Tell others that it is topmost
         describe-window '(lambda () (list (window-make () () () () ())
                                           (window-make () () () () ())))
         direction vertical
         reenter-on-opening ())
      (place-menu
       'panlist
       (with (fsm no-fsm
              menu-min-width xs
              menu-max-width menu-min-width
              bar-min-width ys
              bar-max-width bar-min-width)
         (menu-make (bar-make ())))
       x y)))

;; On eg. DEC-stations the pointer does not seem able to reach the last 
;; pixel to the right or down. Check this to decide how broad the panlist
;; has to be.
(defun check-buggy-screen ()
  (with (pos (current-mouse-position)
         corner ())
    (warp-pointer screen-width screen-height root-window)
    (: corner (current-mouse-position))
    (warp-pointer (# 0 pos) (# 1 pos) root-window)
    (or (not (= (# 0 corner) (- screen-width 1)))
        (not (= (# 1 corner) (- screen-height 1))))))

(defun remove-pan-lists ()
  (for wob (list-of-windows)
       (if (= window-name 'panlist)
           (delete-window wob))))

(defun install-pan-lists ()
  (remove-pan-lists)
  (process-events)
  (if (check-buggy-screen)
      (progn
        (make-pan-list 0 0 1 screen-height)
        (make-pan-list 1 0 (- screen-width 3) 1)
        (make-pan-list (- screen-width 2) 0 2 screen-height)
        (make-pan-list 1 (- screen-height 2) (- screen-width 3) 2))
      (progn
        (make-pan-list 0 0 1 screen-height)
        (make-pan-list 1 0 (- screen-width 2) 1)
        (make-pan-list (- screen-width 1) 0 1 screen-height)
        (make-pan-list 1 (- screen-height 1) (- screen-width 2) 1))))

(defun toggle-pan-lists ()
  (setq show-pan-lists (not show-pan-lists))
  (if show-pan-lists
      (install-pan-lists)
    (remove-pan-lists)))