;;; mydock.jl -- a simple dock for sawfish
;;
;;
;; This code is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation; either version 1, or (at your
;; option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;
;; This module is loosely based on code by Mario Domenech Goulart
;;
;; sawdock.jl provides some functions to manipulate windows (dockapps) in
;; a way to emulate a Windowmaker-like dock.
;;
;; Write things like thise into your .sawfishrc:
;;
;; (require 'mydock)
;; (mydock-add-to-dock '(0 . -1) nil "pager")
;; (mydock-add-to-dock '(0 . 0) "sunclock" "sunclock / clock")
;; (mydock-add-to-dock '(0 . 58) "wmbubble" "wmbubble")
;; (mydock-add-to-dock '(58 . 58) "wmacpimon" "wmacpimon")
;;
;; (it's position, exec-name, title).  mydock will start exec-name if it
;; evaluates to true and otherwise wait for windows with the given title
;; being mapped.
;;



(require 'rep.io.timers)
(require 'rep.data.tables)
(require 'sawfish.wm.util.x)

(defvar mydock-dockapps (make-table string-hash equal))

(defvar dock-window-list ())

(defvar stacking-function raise-window)

(defvar sawdock-background-color "green"
  "Dock background color")

(defun mydock-get-frame ()
		 `(((background . ,sawdock-background-color)
	    (height . 0)
	    (left-edge . 0)
	    (right-edge . 0)
	    (top-edge . 0)
	    (class . top-border))
	   
	   ((background . ,sawdock-background-color)
	    (width . 0)
	    (left-edge . 0)
	    (top-edge . 0)
	    (bottom-edge . 0)
	    (class . left-border))
	   
	   ((background . ,sawdock-background-color)
	    (width . 0)
	    (right-edge . 0)
	    (top-edge . 0)
	    (bottom-edge . 0)
	    (class . right-border))
	   
	   ((background . ,sawdock-background-color)
	    (height . 0)
	    (left-edge . 0)
	    (right-edge . 0)
	    (bottom-edge . 0)
	    (class . bottom-border))))

(defun mydock-frame-dockapp (win)
;   (window-put win 'frame-style 'mydock)
   (set-window-frame win (mydock-get-frame)))

(define (fix-negative-coordinate coo max)
	(if (< coo 0) (- max (+ 1 coo)) coo))

(define (fix-negative-positions win pos)
	(cons
		(fix-negative-coordinate 
			(car pos) 
			(- (screen-width) (car (window-dimensions win))))
		(fix-negative-coordinate 
			(cdr pos) 
			(- (screen-height) (cdr (window-dimensions win))))))

(define (mark-window-as-mydock win)
	(mark-window-as-dock win)
	(window-put win 'avoid ())
	(window-put win 'never-focus t)
)

(defun mydock-dock-one-window (win pos)
  "Place a single dockapp into the dock."
	(let 
		(
			(newpos (fix-negative-positions win pos)))
  	(if (windowp win)
			(progn 
				(setq dock-window-list (cons win dock-window-list))
				(mark-window-as-mydock win)
				(mydock-frame-dockapp win nil)
				(move-window-to win (car newpos) (cdr newpos))))))


(defun swallow-as-required (win)
	(when (table-ref mydock-dockapps (window-name win))
		(mydock-dock-one-window
			win
			(car (table-ref mydock-dockapps (window-name win))))
		(raise-window win)))


(defun mydock-add-to-dock (pos command title)
	(table-set mydock-dockapps title (cons pos command)))

(defun mydock-evaluate-command (command)
	(cond
		((stringp command)
			(system (concat command "&")))
		((listp command)
		 	(eval command))))

(defun swallow-or-start (pos command title)
	(if (get-window-by-name title)
		(swallow-as-required (get-window-by-name title))
		(mydock-evaluate-command command)))

(defun start-swallow ()
	(table-walk (lambda (key val) 
								(swallow-or-start (car val) (cdr val) key))
	mydock-dockapps))

(define (toggle-top)
	(if (member (car (stacking-order)) dock-window-list)
		(setq stacking-function lower-window)
		(setq stacking-function raise-window))
	(mapc stacking-function dock-window-list)
)

(add-hook 'map-notify-hook swallow-as-required)

(add-hook 'after-initialization-hook start-swallow)

(bind-keys global-keymap "Select" 
 '(toggle-top)
)