; -*- sawfish-mode -*-
; vim:ft=lisp
;; crunchy/corner.jl -- packing windows to corners of screen

;; version 0.2.0

;; Copyright (C) 2001, 2002, 2003, 2004 Andreas BÜsching <crunchy@tzi.de>

;; this 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 2, or (at your option)
;; any later version.

;; this 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 sawfish; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;; Installation (e.g.):
;; - copy this file to ~/.sawfish/lisp/crunchy 
;;   (this path without crunchy need to be in your load-path)
;; - add (require 'crunchy.corner) to your ~/.sawfishrc

(define-structure crunchy.corner
    (export
     )
    (open
     rep
     rep.system
     rep.io.files
     sawfish.wm.commands
     sawfish.wm.ext.match-window
     sawfish.wm.custom
     sawfish.wm.frames
     sawfish.wm.windows
     sawfish.wm.workspace
     sawfish.wm.viewport
     sawfish.wm.focus
     sawfish.wm.misc
     sawfish.wm.util.rects
     sawfish.wm.state.maximize
     sawfish.wm.state.iconify
     sawfish.wm.util.stacking
     ) 

  (defun move-to-top-right (w offset)
  (let* ((xoff (car offset))
	  (yoff (cdr offset))
	  (wwidth (car (window-frame-dimensions w)))
	  (x (- (screen-width) xoff wwidth))
	  (y yoff))
    (move-window-to w x y)))

  (defun move-to-top-left (w offset)
   (let* ((xoff (car offset))
	  (yoff (cdr offset))
	  (x xoff)
	  (y yoff))
    (move-window-to w x y)))

  (defun move-to-bottom-right (w offset)
   (let* ((xoff (car offset))
	  (yoff (cdr offset))
	  (wwidth (car (window-frame-dimensions w)))
	  (wheight (cdr (window-frame-dimensions w)))
	  (x (- (screen-width) xoff wwidth))
	  (y (- (screen-height) yoff wheight)))
    (move-window-to w x y)))
  
  (defun move-to-bottom-left (w offset)
   (let* ((xoff (car offset))
	  (yoff (cdr offset))
	  (wheight (cdr (window-frame-dimensions w)))
	  (x xoff)
	  (y (- (screen-height) yoff wheight)))
    (move-window-to w x y)))
  
  (defun move-to-middle-left (w offset)
   (let* ((xoff (car offset))
	  (yoff (cdr offset))
	  (x xoff)
	  (wheight (cdr (window-frame-dimensions w)))
	  (y yoff))
    (move-window-to w x (+ (/ (- (screen-height) wheight) 2) y))))

  (defun move-to-middle-right (w offset)
   (let* ((xoff (car offset))
	  (yoff (cdr offset))
	  (x xoff)
	  (wheight (cdr (window-frame-dimensions w)))
	  (wwidth (car (window-frame-dimensions w)))
	  (y yoff))
    (move-window-to w (- (screen-width) (+ wwidth x)) (+ (/ (- (screen-height) wheight) 2) y))))

  (defun move-to-middle-top (w offset)
   (let* ((xoff (car offset))
	  (yoff (cdr offset))
	  (x xoff)
	  (wwidth (car (window-frame-dimensions w)))
	  (y yoff))
    (move-window-to w (+ (/ (- (screen-width) wwidth) 2) x) y)))
  
  (defun move-to-middle-bottom (w offset)
   (let* ((xoff (car offset))
	  (yoff (cdr offset))
	  (x xoff)
	  (wwidth (car (window-frame-dimensions w)))
	  (y yoff))
    (move-window-to w (+ (/ (- (screen-width) wwidth) 2) x) (- (screen-height) y))))

  (defun add-to-hooks (function)
    (add-hook 'after-move-hook function t)
    (add-hook 'after-resize-hook function t))
    
  (define-match-window-property 'corner 'placement
    `(pair (choice top-left top-right bottom-left bottom-right
		   middle-right middle-left middle-top middle-bottom)
	   (pair (pair number number) (boolean "hold position"))))

  (define-match-window-setter 'corner
   (lambda (w prop value)
    (declare (unused prop))
    (let ((corner (car value))
	  (offset (cadr value))
	  (hold (cddr value)))
     (when (eq corner 'top-right)
       (progn
	 (move-to-top-right w offset)
	 (when hold
	   (add-to-hooks (lambda (win) 
			   (when (equal win w)
			     (move-to-top-right win offset)))))))
     (when (eq corner 'top-left)
       (progn
	 (move-to-top-left w offset)
	 (when hold
	   (add-to-hooks (lambda (win) 
			    (when (equal win w)
			      (move-to-top-left win offset)))))))

     (when (eq corner 'bottom-right)
       (progn
	 (move-to-bottom-right w offset)
	 (when hold
	   (add-to-hooks (lambda (win) 
			   (when (equal win w)
			     (move-to-bottom-right win offset)))))))
     (when (eq corner 'bottom-left)
       (progn
	 (move-to-bottom-left w offset)
	 (when hold
	   (add-to-hooks (lambda (win) 
			   (when (equal win w)
			     (move-to-bottom-left 
			      win offset)))))))
     (when (eq corner 'middle-left)
       (progn
	 (move-to-middle-left w offset)
	 (when hold
	   (add-to-hooks (lambda (win) 
			   (when (equal win w)
			     (move-to-middle-left 
			      win offset)))))))
     (when (eq corner 'middle-right)
       (progn
	 (move-to-middle-right w offset)
	 (when hold
	   (add-to-hooks (lambda (win) 
			   (when (equal win w)
			     (move-to-middle-right 
			      win offset)))))))
     (when (eq corner 'middle-top)
       (progn
	 (move-to-middle-top w offset)
	 (when hold
	   (add-to-hooks (lambda (win) 
		       (when (equal win w)
			 (move-to-middle-top win offset)))))))
     (when (eq corner 'middle-bottom)
       (progn
	 (move-to-middle-bottom w offset)
	 (when hold
	   (add-to-hooks (lambda (win) 
			   (when (equal win w)
			     (move-to-middle-bottom 
			      win offset)))))))
     (window-put w 'placed t)
    )))
)