;;
;;  Put this file in ~/.sawfish/lisp/dtm-infinite-desktop.jl
;;
;;  Then, in your ~/.sawfishrc, put the command:
;;       (require 'dtm-infinite-desktop)
;;
;;  Use the Customize->Sawfish->Workspaces->Infinite Desktop
;;   configurator to enable and configure the option.  Edge
;;   flipping should be disabled.
;;

(require 'sawmill-defaults)
(require 'sawfish.wm.custom)
(require 'sawfish.wm.commands.move-cursor)
(require 'sawfish.wm.util.flippers)
(require 'sawfish.wm.ext.edge-flip)

;;
;; Remove our hooks if they're already installed -
;; allows us to be imported multiple times safely.
;;
(defun dtm.infinite-desktop.remove (a l)
  (cond ((not l) nil)
	((eq a (car l)) (dtm.infinite-desktop.remove a (cdr l)))
	(t (cons (car l) (dtm.infinite-desktop.remove a (cdr l))))))

(if
    (boundp 'dtm.infinite-desktop.enter-flipper-hook)
    (setq enter-flipper-hook (dtm.infinite-desktop.remove dtm.infinite-desktop.enter-flipper-hook enter-flipper-hook)))

(defgroup infinite-desktop "Infinite Desktop"
  :group workspace)

(defcustom dtm.infinite-desktop-p 1
  "Simulate an infinite desktop (Conflicts with normal edge-flipping)."
  :group (workspace infinite-desktop)
  :after-set (lambda () (dtm.infinite-desktop.infinite-desktop))
  :type boolean)

(defcustom dtm.infinite-desktop.move-distance 64
  "Amount to move the workspace."
  :group (workspace infinite-desktop)
  :type number
  :range (1 . nil))

(defcustom dtm.infinite-desktop.move-cursor-distance 32
  "Amount to move the cursor after moving the workspace."
  :group (workspace infinite-desktop)
  :type number
  :range (1 . nil))

(defcustom dtm.infinite-desktop.stop-at-workspace-borders nil
  "Stop scrolling at workspace borders (Fixes warp-to-window bugs)."
  :group (workspace infinite-desktop)
  :type boolean )

(defun dtm.infinite-desktop.move-right ()
  (let ((dist dtm.infinite-desktop.move-distance)
	(cdist dtm.infinite-desktop.move-cursor-distance)
	(maxx (* (screen-width) (1- (car viewport-dimensions)))))
    (if
	(and dtm.infinite-desktop.stop-at-workspace-borders
	     (> (+ dist viewport-x-offset) maxx))
	(setq dist (- maxx viewport-x-offset)))
    (set-viewport (+ viewport-x-offset dist) viewport-y-offset)
    (move-cursor (- (min dist cdist)) 0)))

(defun dtm.infinite-desktop.move-left ()
  (let ((dist (- dtm.infinite-desktop.move-distance))
	(cdist (- dtm.infinite-desktop.move-cursor-distance))
	(minx 0))
    (if
	(and dtm.infinite-desktop.stop-at-workspace-borders
	     (< (+ viewport-x-offset dist) minx))
	(setq dist (- minx viewport-x-offset)))
    (set-viewport (+ viewport-x-offset dist) viewport-y-offset)
    (move-cursor (max dist dtm.infinite-desktop.move-cursor-distance) 0)))

(defun dtm.infinite-desktop.move-top ()
  (let ((dist (- dtm.infinite-desktop.move-distance))
	(cdist (- dtm.infinite-desktop.move-cursor-distance))
	(miny 0))
    (if
	(and dtm.infinite-desktop.stop-at-workspace-borders
	     (< (+ viewport-y-offset dist) miny))
	(setq dist (- miny viewport-y-offset)))
    (set-viewport viewport-x-offset (+ viewport-y-offset dist))
    (move-cursor 0 (max dist dtm.infinite-desktop.move-cursor-distance))))

(defun dtm.infinite-desktop.move-bottom ()
  (let ((dist dtm.infinite-desktop.move-distance)
	(cdist dtm.infinite-desktop.move-cursor-distance)
	(maxy (* (screen-height) (1- (cdr viewport-dimensions)))))
    (if
	(and dtm.infinite-desktop.stop-at-workspace-borders
	     (> (+ dist viewport-y-offset) maxy))
	(setq dist (- maxy viewport-y-offset)))
    (set-viewport viewport-x-offset (+ viewport-y-offset dist))
    (move-cursor 0 (- (min dist cdist)))))

(defun dtm.infinite-desktop.enter-flipper-hook (w)
  (if dtm.infinite-desktop-p
      (cond ((eq w 'right) (dtm.infinite-desktop.move-right))
	    ((eq w 'left) (dtm.infinite-desktop.move-left))
	    ((eq w 'bottom) (dtm.infinite-desktop.move-bottom))
	    ((eq w 'top) (dtm.infinite-desktop.move-top))
	    (t (display-message "move-unknown"))
	    )
    )
  )

(defun dtm.infinite-desktop.infinite-desktop ()
  (if dtm.infinite-desktop-p
      (enable-flippers)))

(add-hook 'enter-flipper-hook dtm.infinite-desktop.enter-flipper-hook)

(provide 'infinitedesktop)