;; BWM (Bat-Window Manager) by Matt Chisholm http://www.theory.org/~matt/sawfish/
;; July 11 2001
;; 

(let*

  (
    (font (get-font "-sharefont-comicscartoon-normal-r-normal-*-*-180-*-*-p-*-iso8859-1"))

    ;; Update window title pixel length
    (title-width
      (lambda (w)
        (let
          ((w-width (car (window-dimensions w))))
          (max 0 (min (- w-width 100) (text-width (window-name w) font
;;           (get-font
;;             "-sharefont-comicscartoon-normal-r-normal-*-*-180-*-*-p-*-iso8859-1")
          ))))))
        ;; Batman images
        (topleft (list 
         (make-image  "b-topleft-i.png")
         (make-image "b-topleft-a.png")))
        (top (list 
         (make-image  "b-top-i.png")
         (make-image "b-top-a.png")))
        (topright (list 
         (make-image  "b-topright-i.png")
         (make-image "b-topright-a.png")))
        (right (list 
         (make-image  "b-right-i.png")
         (make-image "b-right-a.png")))
        (bottomright (list 
         (make-image  "b-bottomright-i.png")
         (make-image "b-bottomright-a.png")))
        (bottom (list 
         (make-image  "b-bottom-i.png")
         (make-image "b-bottom-a.png")))
        (bottomleft (list 
         (make-image  "b-bottomleft-i.png")
         (make-image "b-bottomleft-a.png")))
        (left (list 
         (make-image  "b-left-i.png")
         (make-image "b-left-a.png")))
        (button (list 
         (make-image "b-button-i.png")
         (make-image "b-button-a.png")
         (make-image "b-button-h.png")))
        (bubble (list 
         (make-image  "b-bubble-i.png")
         (make-image "b-bubble-a.png")))
        (hand (list 
         (make-image  "b-hand-i.png")
         (make-image "b-hand-a.png")))
        (topright-s (list 
         (make-image  "b-topright-i-s.png")
         (make-image "b-topright-a-s.png")))
        (top-s (list 
         (make-image  "b-top-i-s.png")
         (make-image "b-top-a-s.png")))
        (topleft-s (list 
         (make-image  "b-topleft-i-s.png")
         (make-image "b-topleft-a-s.png")))
        (emblem (list 
         (make-image  "b-emblem-i.png")
         (make-image "b-emblem-a.png")
         (make-image "b-emblem-h.png")))

	;; Robin images
        (r-topleft (list 
         (make-image  "r-topleft-i.png")
         (make-image "r-topleft-a.png")))
        (r-top (list 
         (make-image  "r-top-i.png")
         (make-image "r-top-a.png")))
        (r-topright (list 
         (make-image  "r-topright-i.png")
         (make-image "r-topright-a.png")))
        (r-right (list 
         (make-image  "r-right-i.png")
         (make-image "r-right-a.png")))
        (r-bottomright (list 
         (make-image  "r-bottom-i.png")
         (make-image "r-bottom-a.png")))
        (r-button (list 
         (make-image "r-button-i.png")
         (make-image "r-button-a.png")
         (make-image "r-button-h.png")))
	(r-bubble (let ((tilei (make-image "r-bubble-i.png"))
			(tilea (make-image "r-bubble-a.png")))
			(image-put tilei `tiled t)
			(image-put tilea `tiled t)
		    	(list tilei tilea)))
        (r-bubble-r (list 
         (make-image  "r-bubble-i-r.png")
         (make-image "r-bubble-a-r.png")))
        (r-bubble-l (list 
         (make-image  "r-bubble-i-l.png")
         (make-image "r-bubble-a-l.png")))
        (r-hand (list 
         (make-image  "r-hand-i.png")
         (make-image "r-hand-a.png")))
        (r-topright-s (list 
         (make-image  "r-topright-i-s.png")
         (make-image "r-topright-a-s.png")))
        (r-top-s (list 
         (make-image  "r-top-i-s.png")
         (make-image "r-top-a-s.png")))
        (r-topleft-s (list 
         (make-image  "r-topleft-i-s.png")
         (make-image "r-topleft-a-s.png")))
        (r-emblem (list 
         (make-image  "r-emblem-i.png")
         (make-image "r-emblem-a.png")
         (make-image "r-emblem-h.png")))
	(blackdot (list
	 (make-image "blackdot.png")
	 (make-image "blackdot.png")))

       ;;Batman frames
       (frame `(
         ((top-edge . -58)
          (left-edge . -23)
          (background . ,topleft)
          (class . top-left-corner))
         ((bottom-edge . -44)
          (left-edge . -23)
          (background . ,bottomleft)
          (class . bottom-left-corner))
         ((right-edge . -40)
          (background . ,bottomright)
          (bottom-edge . -35)
          (class . bottom-right-corner))
         ((left-edge . 25)
          (right-edge . 46)
          (top-edge . -18)
          (background . ,top)
          (class . top-border))
         ((top-edge . 16)
          (bottom-edge . 31)
          (left-edge . -23)
          (background . ,left)
          (class . left-border))
         ((left-edge . 16)
          (right-edge . 36)
          (bottom-edge . -34)
          (background . ,bottom)
          (class . bottom-border))
         ((top-edge . 40)
          (right-edge . -38)
          (bottom-edge . 37)
          (background . ,right)
          (class . right-border))
         ((left-edge . 18)
	  (font . ,font)
          (top-edge . -54)
          (width . ,(lambda (w) (floor (+ (title-width w) (/ (title-width w) 4) ))))
          (y-justify . center)
          (x-justify . center)
          (text . ,window-name)
          (background . ,bubble)
          (class . title))
         ((left-edge . 60)
          (top-edge . -5)
          (background . ,hand)
          (class . title))
         ((right-edge . 20)
          (top-edge . -40)
          (background . ,button)
          (class . close-button))
         ((top-edge . -19)
          (background . ,topright)
          (right-edge . -53)
          (class . top-right-corner))
         ((background . ,button)
          (top-edge . -40)
          (right-edge . 20)
          (class . close-button))
         ((top-edge . -6)
          (left-edge . 0)
          (background . ,emblem)
          (class . menu-button))))

        (shaped-frame `(
         ((left-edge . -23)
          (top-edge . -58)
          (background . ,topleft-s)
          (class . top-left-corner))
         ((class . title)
          (left-edge . 25)
          (top-edge . -18)
          (right-edge . 46)
          (background . ,top-s))
         ((width . ,(lambda (w) (floor (+ (title-width w) (/ (title-width w) 4) ))))
          (left-edge . 18)
          (top-edge . -54)
	  (font . ,font)
          (y-justify . center)
          (x-justify . center)
          (text . ,window-name)
          (background . ,bubble)
          (class . title))
         ((right-edge . 20)
          (top-edge . -40)
          (background . ,button)
          (class . close-button))
         ((right-edge . -53)
          (top-edge . -19)
          (background . ,topright-s)
          (class . top-right-corner))
         ((background . ,button)
          (top-edge . -40)
          (right-edge . 20)
          (class . close-button))
         ((top-edge . -6)
          (left-edge . 0)
          (background . ,emblem)
          (class . menu-button))))

       ;; Robin frames
       (transient-frame `(
         ((class . top-border)
          (left-edge . 46)
          (top-edge . -18)
          (right-edge . 32)
          (background . ,r-top))
         ((top-edge . -19)
          (left-edge . -41)
          (background . ,r-topleft)
          (class . top-left-corner))
         ((right-edge . -23)
          (background . ,r-bottomright)
          (bottom-edge . -44)
          (class . bottom-right-corner))
         ((top-edge . 17)
          (right-edge . -23)
          (bottom-edge . 47)
          (background . ,r-right)
          (class . right-border))
	 ((class . title)
	  (top-edge . -54)
          (right-edge . 18)
	  (background . ,r-bubble-r))
	 ((class . title)
	  (top-edge . -54)
          (right-edge . ,(lambda (w) (+ (title-width w) 50 )))
	  (background . ,r-bubble-l))
         ((right-edge . 50)
	  (font . ,font)
          (top-edge . -54)
          (width . ,(lambda (w) (title-width w) ))
          (y-justify . center)
          (x-justify . center)
          (text . ,window-name)
          (background . ,r-bubble)
          (class . title))
         ((right-edge . 60)
          (top-edge . -5)
          (background . ,r-hand)
          (class . title))
         ((top-edge . -56)
          (background . ,r-topright)
          (right-edge . -23)
          (class . top-right-corner))
         ((background . ,r-button)
          (top-edge . -40)
          (left-edge . 20)
          (class . close-button))
         ((top-edge . -4)
          (right-edge . -2)
          (background . ,r-emblem)
          (class . menu-button))
	 ((class . bottom-left-corner)
	  (bottom-edge . -2)
          (left-edge . -2)
          (background . ,blackdot))
	 ((class . bottom-border)
	  (bottom-edge . -2)
          (left-edge . -2)
	  (right-edge . 40)
          (background . ,blackdot))
	 ((class . left-border)
	  (bottom-edge . -2)
          (left-edge . -2)
	  (top-edge . 40)
          (background . ,blackdot))))

       (shaped-transient-frame `(
         ((class . title)
          (left-edge . 46)
          (top-edge . -18)
          (right-edge . 32)
          (background . ,r-top-s))
         ((top-edge . -19)
          (left-edge . -41)
          (background . ,r-topleft-s)
          (class . top-left-corner))
	 ((class . title)
	  (top-edge . -54)
          (right-edge . 18)
	  (background . ,r-bubble-r))
	 ((class . title)
	  (top-edge . -54)
          (right-edge . ,(lambda (w) (+ (title-width w) 50 )))
	  (background . ,r-bubble-l))
         ((right-edge . 50)
	  (font . ,font)
          (top-edge . -54)
          (width . ,(lambda (w) (title-width w) ))
          (y-justify . center)
          (x-justify . center)
          (text . ,window-name)
          (background . ,r-bubble)
          (class . title))
         ((top-edge . -56)
          (background . ,r-topright-s)
          (right-edge . -23)
          (class . top-right-corner))
         ((background . ,r-button)
          (top-edge . -40)
          (left-edge . 20)
          (class . close-button))
         ((top-edge . -4)
          (right-edge . -2)
          (background . ,r-emblem)
          (class . menu-button))))
    )

  (add-frame-style 'BWM
                   (lambda (w type)
                     (case type
                       ((default) frame)
                       ((transient) transient-frame)
                       ((shaped) shaped-frame)
                       ((shaped-transient) shaped-transient-frame))))

  (call-after-property-changed
   'WM_NAME (lambda ()
              (rebuild-frames-with-style 'BWM))))
