(provide 'workspace-grid)
(require 'sawfish.wm.workspace)

;; ================================================================
;; Workspace Grid

;; Provides a virtual desktop "grid" abstraction, using workspaces.

;; In effect, this emulates viewports with workspaces
;; ================================================================


;; ================================================================
;; Custom Variables

;; These have been replaced with values read from the pager

; (defcustom num-workspace-rows 1
;   "Number of rows (or columns) in the workspace switcher"
;   :group workspace
;   :type number
;   :range (1 . nil))

; (defcustom workspace-switcher-orientation 'horizontal
;   "Orientation of panel with workspace switcher"
;     :type (choice horizontal vertical)
;     :group workspace)


;; ================================================================
;; Commands

;; Move current workspace commands
(defun view-workspace-down ()
  "View the workspace below the current workspace"
  (interactive)
  (if (pager-horizontal-p)
      (view-workspace-next-row 1)
    (view-workspace-next-column 1)))

(defun view-workspace-up ()
  "View the workspace above the current workspace"
  (interactive)
  (if (pager-horizontal-p)
      (view-workspace-next-row -1)
    (view-workspace-next-column -1)))

(defun view-workspace-left ()
  "View the workspace to the left of the current workspace"
  (interactive)
  (if (pager-horizontal-p)
      (view-workspace-next-column -1)
    (view-workspace-next-row -1)))

(defun view-workspace-right ()
  "View the workspace to the right of the current workspace"
  (interactive)
  (if (pager-horizontal-p)
      (view-workspace-next-column 1)
    (view-workspace-next-row 1)))


;; "Send-window" commands
(defmacro make-send-to-command (name direction distance)
  `(defun ,name (window)
     "Send window to the workspace below the current workspace"
     (interactive "%W")
     (let ((new-workspace
	    (,(intern (concat "get-workspace-" direction))
	     current-workspace
	     ,distance)))

       (when new-workspace
	 (send-to-next-workspace window
				 (- new-workspace current-workspace)
				 nil
				 t)))))

(make-send-to-command send-to-workspace-down "down" 1)
(make-send-to-command send-to-workspace-up "down" -1)
(make-send-to-command send-to-workspace-right "right" 1)
(make-send-to-command send-to-workspace-left "right" -1)


;; ================================================================
;; Private Procedures

;; The workspace-switcher makes a desktop grid by splitting a sequence of
;; workspaces into rows and columns.

;; With a horizontal panel, workspaces line up as
;;    1 2 3
;;    4 5 6
;; but with a vertical panel, they line up as
;;    1 4
;;    2 5
;;    3 6

;; I take convention that a "row" is a sequence of consecutive workspaces
;; (horizontal for a horizontal panel, vertical for a vertical panel), and a
;; "column" is the opposite (vertical on a horizontal panel, horizontal on a
;; vertical panel).  This way, I can just think about what the coordinate code
;; is supposed to do on horizontal panels, and then translate it to "up",
;; "down", "left", "right", etc. later.

;; A `coordinates' object consists of the pair (column . row).

(defun num-workspaces ()
  (let ((limits (workspace-limits)))
    (- (cdr limits) (car limits) -1)))

(defun pager-horizontal-p ()
  (= (aref (caddr (get-x-property 'root '_NET_DESKTOP_LAYOUT))
	   0)
     0))

(defun num-workspace-rows ()
  ;; Property is of the form (CARDINAL 32 [orientation x y])
  ;; Orientation horizontal=0, vert=1
  ;; x is always sideways
  ;; y is always vertical
  ;; x or y are optional (can be zero)
  (let* ((layout-property (get-x-property 'root '_NET_DESKTOP_LAYOUT))
	 (vertical-p (= (aref (caddr layout-property) 0) 1))
    	 (layout (cons (aref (caddr layout-property) 1)
		       (aref (caddr layout-property) 2))))

    (when (not vertical-p)      ; the "not" is to workaround a bug
      (setq layout (cons (cdr layout) (car layout))))
    ;; layout is now in (column . row) form
    
    (if (= 0 (cdr layout))
	(let ((total (num-workspacs)))
	  (+ (quotient total (car layout))
	     (if (= (remainder total (car layout) 0))
		 0
	       1)))
      (cdr layout))))

(defun num-workspaces-per-row ()
  (quotient (num-workspaces)
	    (num-workspace-rows)))

;; Existance
(defun workspace-exists-p (workspace)
  (let ((limits (workspace-limits)))
    (and (<= workspace (cdr limits))
	 (>= workspace (car limits)))))

(defun coordinates-exist-p (coords)
  (and (>= (car coords) 0)
       (< (car coords) (num-workspaces-per-row))
       (>= (cdr coords) 0)
       (< (cdr coords) (num-workspace-rows))))

;; Addition (not used)
(defun coordinates-add (coords1 coords2)
  (cons (+ (car coords1) (car coords2))
	(+ (cdr coords1) (cdr coords2))))

;; Coordinate Mapping
(defun workspace->coordinates (workspace)
  "Returns zero-based (column . row) coordinates of `workspace' in pager."
  (let ((normalized-workspace-index (- workspace (car (workspace-limits))))
	(row-size (num-workspaces-per-row)))
    (cons (modulo normalized-workspace-index row-size)
	  (quotient normalized-workspace-index row-size))))

(defun coordinates->workspace (coordinates)
  "Returns the workspace at `coordinates', or nil if coordinates are invalid"
  (when (coordinates-exist-p coordinates)
    (+ (car (workspace-limits))		;min real workspace
       (car coordinates)		;column
       (* (cdr coordinates)		;row
	  (num-workspaces-per-row)))))


;; Get workspace in user-coordinate directions
(defun get-workspace-down (workspace distance)
  (let ((coords (workspace->coordinates workspace)))
    (coordinates->workspace
     (if (pager-horizontal-p)
	 (cons (car coords)
	       (+ distance (cdr coords)))
       (cons (+ distance (car coords))
	     (cdr coords))))))
       
(defun get-workspace-right (workspace distance)
  (let ((coords (workspace->coordinates workspace)))
    (coordinates->workspace
     (if (pager-horizontal-p)
	 (cons (+ distance (car coords))
	       (cdr coords))
       (cons (car coords)
	     (+ distance (cdr coords)))))))


;; Set current workspace using pager-space coordinates
(defun view-workspace-next-row (distance)
  "Move the current workspace `distance' rows downward"
  (let ((new-workspace
	 (+ current-workspace (* distance (num-workspaces-per-row)))))

    (when (workspace-exists-p new-workspace)
      (select-workspace new-workspace))))
(defun view-workspace-next-column (distance)
  "Move the current workspace `distance' columns to the right"
  (let ((coords (workspace->coordinates current-workspace)))
    (setq coords
	  (cons (+ distance (car coords))
		(cdr coords)))

    (when (coordinates-exist-p coords)
      (select-workspace (coordinates->workspace coords)))))


