;; group.jl - Make windows 
;;
;; Author : Yann Hodique <Yann.Hodique@lifl.fr>
;;
;; Modified by Scott Scriven <sawfish@toykeeper.net>
;; (mostly hook updates)

(defvar tab-groups nil)

(defvar tab-refresh-lock t)
(defvar tab-move-lock t)

(defun tab-group-position (group)
  "Position descriptor"
  (nth 0 group))

(defun tab-group-dimensions (group)
  "Dimensions descriptor"
  (nth 1 group))

(defun tab-group-window-list (group)
  "Group's windows"
  (nth 2 group))

(defun tab-build-group (pos dim wlist)
  "Build a group from its components"
  (cons pos (cons dim (cons wlist nil)))
)

(defun tab-move-resize-frame-window-to (win x y w h)
  "move and resize according to *frame* dimensions"
  (let* ((dim1 (window-dimensions win))
         (dim2 (window-frame-dimensions win))
         (dw (- (car dim2) (car dim1)))
         (dh (- (cdr dim2) (cdr dim1))))
    (move-resize-window-to win x y (- w dw) (- h dh)))
  )

(defun tab-make-new-group (win)
  "Return a new group containing only win"
  (let* ((pos (window-position win))
        (dim (window-frame-dimensions win))
        (group (tab-build-group pos dim (list win))))
    (setq tab-groups (append tab-groups (cons group nil)))
    group)
  )

(defun tab-find-window (win)
  "Return a group containing win"
  (let loop ((gr tab-groups))
       (cond
        ((null gr)
         (tab-make-new-group win)
         )
        ((member win (tab-group-window-list (car gr)))
         (car gr))
        (t 
         (loop (cdr gr)))))
  )
  
(defun tab-window-group-index (win)
  "Return the index of the group containing win"  
  (let loop ((index 0))
       (cond 
        ((eq index (length tab-groups))
         (tab-make-new-group win)
         index)
        ((member win (tab-group-window-list (nth index tab-groups)))
         index)
        (t
         (loop (+ index 1))))))

(defun tab-rank (elem list)
  (if (eq elem (car list))
      0
    (+ 1 (tab-rank elem (cdr list)))))

(defun tab-delete-window-from-group (win index)
  "Remove a window from a group at given index"
  (let* ((old (nth index tab-groups))
         (l (remove win (tab-group-window-list old))))
    (if (null l)
        (setq tab-groups (delete old tab-groups))
      (rplaca (nthcdr index tab-groups)
              (tab-build-group (tab-group-position old) (tab-group-dimensions old) l))
      (tab-refresh-group (car l) 'frame)
      )))

(defun tab-delete-window-from-tab-groups (w)
  "Find window's group and remove it"
  (tab-delete-window-from-group w (tab-window-group-index w)))

(defun tab-put-window-in-group (win index)
  "Put window in group at given index"
  (let* ((group (nth index tab-groups))
         (dim (tab-group-dimensions group))
         (pos (tab-group-position group)))
    (rplaca (nthcdr index tab-groups)
            (tab-build-group (tab-group-position group) 
                         (tab-group-dimensions group) 
                         (append (tab-group-window-list group) (list win))))    
    (tab-move-resize-frame-window-to win (car pos) (cdr pos) (car dim) (cdr dim))
    (rebuild-frame win)
    ))

(defun tab-refresh-group (win prop)
  "Refresh the entire group containing win according to prop
prop can be one of the symbols : frame, move, resize, shade, unshade"
  (if tab-refresh-lock
      (progn
        (setq tab-refresh-lock nil)
        (let* ((index (tab-window-group-index win))
               (wins (tab-group-window-list (nth index tab-groups))))
          (cond
           ((eq prop 'frame)
            (mapcar (lambda (w)
                      (rebuild-frame w)) wins)
            )
           ((or (eq prop 'move) (eq prop 'resize))
            (let ((dim (window-frame-dimensions win))
                  (pos (window-position win)))
              (mapcar (lambda (w)
                        (tab-move-resize-frame-window-to w (car pos) (cdr pos) (car dim) (cdr dim))
                        (rebuild-frame w)) wins)
              (rplaca (nthcdr index tab-groups)
                      (tab-build-group pos dim wins)
                      )))
           ((eq prop 'stick)
            (mapcar (lambda (w)
                      (toggle-window-sticky w)) wins)
            )
           ((eq prop 'shade)
            (mapcar (lambda (w)
                      (shade-window w)
                      (rebuild-frame w)) wins)
            )
           ((eq prop 'unshade)
            (mapcar (lambda (w)
                      (unshade-window w)
                      (rebuild-frame w)) wins)
            )
           ))
        (setq tab-refresh-lock t)
        )
    ))

;; Entry points
(defun tab-group-window (w win)
  "Put active window in pointer-selected group"
  (interactive)
  (let* (
         ;(w (input-focus))
         ;(win (select-window))
         (index (tab-window-group-index win))
         (index2 (tab-window-group-index w)))
    (tab-refresh-group win 'move) ;ugly hack, don't know why it's needed, but new groups are listed with pos (0,0)
    (tab-put-window-in-group w index)
    (tab-delete-window-from-group w index2)
    (tab-refresh-group w 'move)
    ))

(defun tab-release-window ()
  "Release active window from its group"
  (interactive)
  (let ((w (input-focus)))
    (tab-delete-window-from-tab-groups w)
    (tab-make-new-group w)))

(defun tab-group-offset (win n)
  "Return the window at position (pos+n) in window's group"
  (let* ((gr (tab-group-window-list (tab-find-window win)))
         (size (length gr))
         (r (tab-rank win gr)))
    (nth (modulo (+ r n) size) gr))
  )

(defun tab-same-group-p (w1 w2)
  "Predicate : true <=> w1 and w2 are grouped together"
  (member w1 (tab-group-window-list (tab-find-window w2)))
  )

(defun tab-raise-left-window ()
  "Raise left window in current group"
  (interactive)
  (let ((win (tab-group-offset (input-focus) -1)))
    (raise-window win)
    (set-input-focus win))
  )

(defun tab-raise-right-window ()
  "Raise right window in current group"
  (interactive)
  (let ((win (tab-group-offset (input-focus) 1)))
    (raise-window win)
    (set-input-focus win))
  )

(defun map-other-grouped-windows (win func)
  ""
  (mapcar func
          (delete-if
           (lambda (w) (eq w win))
           (tab-group-window-list (tab-find-window win))))  
  )

;(add-hook 'sticky-hook (lambda (win args) (tab-refresh-group win 'stick)))
(add-hook 'window-state-change-hook 
	  (lambda (win args) 
	    (if (= 'sticky args)
	      (tab-refresh-group win 'stick)
	      )
	    ))
(add-hook 'after-move-hook (lambda (win args) (tab-refresh-group win 'move)))
(add-hook 'while-moving-hook (lambda (win) (tab-refresh-group win 'move)))
(add-hook 'after-resize-hook (lambda (win args) (tab-refresh-group win 'resize)))
(add-hook 'while-resizing-hook (lambda (win) (tab-refresh-group win 'resize)))
(add-hook 'window-maximized-hook (lambda (win args) (tab-refresh-group win 'resize)))
(add-hook 'window-unmaximized-hook (lambda (win args) (tab-refresh-group win 'resize)))
(add-hook 'shade-window-hook (lambda (win) (tab-refresh-group win 'shade)))
(add-hook 'unshade-window-hook (lambda (win) (tab-refresh-group win 'unshade)))
(add-hook 'destroy-notify-hook tab-delete-window-from-tab-groups)
;; (add-hook 'add-to-workspace-hook (lambda (win lws) 
;;                                    (if tab-move-lock
;;                                        (progn
;;                                          (setq tab-move-lock nil)
;;                                          (mapcar (lambda (w) (copy-window-to-workspace w lws))
;;                                                  (delete-if
;;                                                   (lambda (w) (eq w win))
;;                                                   (tab-group-window-list (tab-find-window win))))
;;                                          (setq tab-move-lock t)
;;                                        ))))
;; (add-hook 'remove-from-workspace-hook (lambda (win lws) 
;;                                    (if tab-move-lock
;;                                        (progn
;;                                          (setq tab-move-lock nil)
;;                                          (mapcar (lambda (w) (window-remove-from-workspace w lws))
;;                                                  (delete-if
;;                                                   (lambda (w) (eq w win))
;;                                                   (tab-group-window-list (tab-find-window win))))
;;                                          (setq tab-move-lock t)
;;                                        ))))
(provide 'tabgroup)