sawfish-themes 0.13 / usr / share / sawfish / themes / Klarth / theme.jl

#| Klarth sawfish theme

Copyright (C) 2001-2002 Kenny Graunke

This program 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 of the
License, 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.

$Id: theme.jl,v 2.0 2002/11/30 20:15:46 kenny Exp $

Authors: Kenny Graunke <kenny@whitecape.org>

|#

(require 'gradient)
(require 'rep.data.tables)		;need hash tables for icon cache
(require 'sawfish.wm.util.recolor-image)
(require 'sawfish.wm.util.gtkrc)

(defgroup Klarth "Klarth Theme"
          :group appearance)

(defvar Klarth:button-themes
  '((default
      ((close-button) . (maximize-button iconify-button)))
    (platinum
     ((close-button) . (maximize-button shade-button)))
    (macos-x
     ((close-button iconify-button maximize-button)))
    (windows
     ((menu-button) . (iconify-button maximize-button close-button)))
    (next
     ((iconify-button) . (close-button)))))

(defcustom Klarth:button-theme 'default
           "Display title buttons to mimic: \\w"
  ;; XXX it would be better if the choices were extracted from
  ;; XXX the above alist somehow
           :type (choice (default "Default")
                         (platinum "Mac OS 8/9")
                         (macos-x "Mac OS X")
                         (windows "MS Windows")
                         (next "NeXTSTEP"))
           :group (appearance Klarth)
           :after-set (lambda () (reframe-all)))
;; FIXME: Why is this a lambda? Can't it just be reframe-all?
;; ...because reframe-all is defined below. no other reason. :-)
;; I suppose I could fix this, if I really wanted to

;; maps WINDOW -> BUTTON-LIST
(define button-table (make-weak-table eq-hash eq))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;; Klarth Image & Color Functions

;;;; Colors

;; klarth-modify-color : color Int -> color
(define (klarth-modify-color color change)
  (define (modify-single rgorb ch)
    (max 0 (min 65535 (round (* rgorb ch)))))
  (let* ((rgb (color-rgb color))
         (r (nth 0 rgb))
         (g (nth 1 rgb))
         (b (nth 2 rgb)))
    (get-color-rgb (modify-single r change)
                   (modify-single g change)
                   (modify-single b change))))

;; klarth-bw-contrast-color-name : color -> string
(define (klarth-bw-contrast-color-name base focused)
  (define rgb (color-rgb base))
  (define (comparison n) (> (nth n rgb) 42767))
  (if (and (comparison 0) (comparison 1) (comparison 2))
      (if focused "black" "grey35") (if focused "white" "grey75")))

;; klarth-bw-contrast-color-list : color color -> (list "unfoc-col" "foc-col")
(define (klarth-bw-contrast-color-list foc-base unfoc-base)
  (list (klarth-bw-contrast-color-name unfoc-base ())
        (klarth-bw-contrast-color-name foc-base t)))

;; klarth-gtk-bg-color : symbol -> color
(define (klarth-gtk-bg-color state)
  (define (if-color num default)
    (if (colorp (nth num gtkrc-background))
        (nth num gtkrc-background)
        (get-color default)))
  (cond
   ((eq state 'selected) (if-color 3 "steelblue"))
   ((eq state 'normal) (if-color 0 "#dddddd"))))

(define klarth-hilight-color (klarth-gtk-bg-color 'selected))
(define klarth-hilight-light-color
  (klarth-modify-color klarth-hilight-color 125/100))
(define klarth-hilight-dark-color
  (klarth-modify-color klarth-hilight-color 55/100))
(define klarth-unfocused-color (klarth-gtk-bg-color 'normal))
(define klarth-unfocused-dark-color
  (klarth-modify-color klarth-unfocused-color 13/100))

;; klarth-black : boolean -> color
(define (klarth-black focused)
  (get-color (if focused "black" "grey35")))

;; klarth-black-list : boolean -> (list "unfoc" "foc")
(define (klarth-black-list focused)
  (list "grey35" "black"))

;;;; Images

;; klarth-image-height : image -> Int:0-Inf
(define (klarth-image-height img)
  (cdr (image-dimensions img)))

;; klarth-image-width : image -> Int:0-Inf
(define (klarth-image-width img)
  (car (image-dimensions img)))

;; klarth-make-transparent-sized-image : Int Int -> image
(define transparent-image (make-image "transparent-image.png"))
(define (klarth-make-transparent-sized-image width height)
  (scale-image transparent-image width height))

;; klarth-bevel-image : image Int:1-inf boolean Int:0-100 boolean -> image
;(define (klarth-bevel-image img size out opacity crisp)
;  (define tmp (copy-image img))
;  (case crisp
;    (() (define (beveller img opacity step)
;	  (bevel-image img step out opacity)
;	  (unless (< step 1) (beveller img opacity (- step 1))))
;        (beveller tmp (/ opacity size) size))
;    (t  (bevel-image tmp size out opacity)))
;  (set-image-border tmp size size size size)
;  tmp)
(define (klarth-bevel-image img size out opacity)
  (klarth-increase-image-border (bevel-image (copy-image img) size out opacity)
				size size size size))

;; klarth-composite-images : image image x y -> image
;; Composites the second image on top of the first one starting at (x,y)
;; (the origin being at the upper left corner of the first image), returns it
(define (klarth-composite-images bottom top x y)
  (define tmp (copy-image bottom))
  (composite-images tmp top x y)
  tmp)

;; klarth-greyscale-image : image -> image
;; Returns a greyscale version of an image.
(define (klarth-greyscale-image img)
  (define tmp (copy-image img))
  (image-map (lambda (pixval)
               (let* ((r (nth 0 pixval))
                      (g (nth 1 pixval))
                      (b (nth 2 pixval))
                      (a (nth 3 pixval))
                      (avg (/ (+ r g b) 3)))
                 (list avg avg avg a)))
             tmp)
  tmp)

;; klarth-draw-gradient : image symbol color color -> image
(define (klarth-draw-gradient img direction primary secondary)
  (define tmp (copy-image img))
  (case direction
    ('horizontal (draw-horizontal-gradient tmp primary secondary))
    ('vertical (draw-vertical-gradient tmp primary secondary))
    ('diagonal (draw-diagonal-gradient tmp primary secondary)))
  tmp)

;; A klarth-gradient-descriptor is:
;; 1. a color, or
;; 2. (list direction primary secondary)
;; where direction is a symbol, and primary and secondary are colors.

;; klarth-new-filled-image : Int:0-Inf Int:0-Inf klarth-gradient-descriptor
;; -> image
(define (klarth-new-filled-image width height colors)
    (if (consp colors)
	(klarth-draw-gradient (make-sized-image width height)
			      (nth 0 colors)
			      (nth 1 colors)
			      (nth 2 colors))
        (make-sized-image width height colors)))

;; klarth-scale-image-to-height : image Int:0-Inf -> image
;; Returns the image scaled to the height but preserving the same aspect ratio.
(define (klarth-scale-image-to-height img height)
  (define original-height (klarth-image-height img))
  (define original-width (klarth-image-width img))
  (define ratio (divide original-width original-height))
  (scale-image img (round (* ratio height)) height))

(define klarth-generic-window-icon (make-image "gnome-tasklist.png"))

;; klarth-window-icon: window -> image
;; Returns a scaled version of the window icon or a generic image if the window
;; doesn't have an icon.
(define (klarth-window-icon w)
  (define wicon (if (window-icon-image w)
                    (window-icon-image w)
                    klarth-generic-window-icon))
  (klarth-scale-image-to-height wicon klarth-icon-size))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;; Klarth Geometry Computations

;; klarth-window-width : window -> Int:0-Inf
(define (klarth-window-width w)
  (car (window-dimensions w)))

;; klarth-window-height : window -> Int:0-Inf
(define (klarth-window-height w)
  (cdr (window-dimensions w)))

;; klarth-window-with-decorations-width : window -> Int:0-Inf
(define (klarth-window-with-decorations-width w)
  (+ (klarth-window-width w) (if (klarth-window-resizable-p w)
				 11
			         0)))

;; klarth-absolute-left-edge : window -> Int
(define (klarth-absolute-left-edge w)
  (if (klarth-window-resizable-p w) -5 -1))

;; klarth-absolute-right-edge : window -> Int
(define (klarth-absolute-right-edge w)
  (if (klarth-window-resizable-p w) -6 -2))

;; klarth-titlebar-center : window -> Int
(define (klarth-titlebar-center w)
  (/ (klarth-window-width w) 2))

;; klarth-left-colored-hangdown-endpoint : window -> Int
(define (klarth-left-colored-hangdown-endpoint w)
  (/ (klarth-window-height w) 2))

(define klarth-font-height (font-height default-font))

(define klarth-icon-size klarth-font-height)

;; Do not set this below 1, or else the icon will get whacked off on top
(define klarth-titlearea-padding 1)

(define klarth-titlearea-bevel-size 1)

(define klarth-titlearea-height
  (+ klarth-font-height (* 2 klarth-titlearea-padding)
     (* 2 klarth-titlearea-bevel-size)))

(define klarth-titlearea-top-edge (- -1 klarth-titlearea-height))

(define klarth-titlebar-height (+ 2 klarth-titlearea-height))

;; klarth-titlebar-width : window -> Int
(define (klarth-titlebar-width w) (+ 5 6 (klarth-window-width w)))

(define klarth-titlebar-top-edge (* -1 klarth-titlebar-height))

;; klarth-left-buttonbox-width : window -> Int
(define (klarth-left-buttonbox-width w)
  (let ((nbuttons (length (car (table-ref button-table w)))))
    (+ 1 (* nbuttons klarth-titlearea-height) nbuttons)))

;; klarth-right-buttonbox-width : window -> Int
(define (klarth-right-buttonbox-width w)
  (let ((nbuttons (length (cdr (table-ref button-table w)))))
    (+ 1 (* nbuttons klarth-titlearea-height) nbuttons)))

;; klarth-titlearea-width : window -> Int
(define (klarth-titlearea-width w)
  ;(- (+ 5 (klarth-window-width w) 6)
  (- (klarth-window-with-decorations-width w)
     (klarth-left-buttonbox-width w)
     (klarth-right-buttonbox-width w)))

;; klarth-titlearea-left-edge : window -> Int
(define (klarth-titlearea-left-edge w)
  (+ (klarth-absolute-left-edge w)
     (klarth-left-buttonbox-width w)))

;; klarth-titlearea-right-edge : window -> Int
(define (klarth-titlearea-right-edge w)
  (+ (klarth-absolute-right-edge w) 1
     (klarth-right-buttonbox-width w)))

;; klarth-titlearea-center : window -> Int
(define (klarth-titlearea-center w)
  (+ (klarth-titlearea-left-edge w) (/ (klarth-titlearea-width w) 2)))

;; klarth-icon-left-edge : window -> Int
(define (klarth-icon-left-edge w)
  (max (+ klarth-titlearea-padding klarth-titlearea-bevel-size
	  (klarth-titlearea-left-edge w))
       (- (klarth-titlearea-center w)
	  (/ (+ (text-width (window-name w))
		(klarth-image-width (klarth-window-icon w))
		(klarth-em 1/2)) 2))))
;  (define C (klarth-titlebar-center w))
;  (define s (text-width " "))
;  (define i (klarth-image-width (klarth-window-icon w)))
;  (define tx (text-width (window-name w)))
;  (define pure-centered (- C (/ tx 2) s (/ i 2)))

;; klarth-titletext-left-edge : window -> Int
(define (klarth-titletext-left-edge w)
  (+ (klarth-icon-left-edge w)
     (klarth-image-width (klarth-window-icon w))
     (klarth-em 1/2)))
;(define (klarth-titletext-left-edge w)
;  (- (klarth-titlearea-center w)
;     (/ (text-width (window-name w)) 2)))
;(define (klarth-titletext-left-edge w)
;  (let* ((icon-width (klarth-image-width (klarth-window-icon w))))
;    (max (+ (klarth-titlearea-left-edge w)
;	    klarth-titlearea-bevel-size klarth-titlearea-padding
;	    icon-width klarth-titlearea-padding)
;	 (+ (klarth-titlearea-center w)
;	    (/ (+ (* -1 (text-width (window-name w)))
;		  icon-width (klarth-em 1/2)) 2)))))

;; klarth-titletext-left-edge : window -> Int
;(define (klarth-titletext-left-edge w)
;  (let ((space-width (text-width " "))
;	(icon-width (klarth-image-width (klarth-window-icon w))))
;    (max (+ klarth-titlearea-padding klarth-titlearea-bevel-size
;	    (klarth-titlearea-left-edge w) icon-width space-width)
;	 (+ (- (klarth-titlebar-center w)
;	       (/ (text-width (window-name w)) 2))
;	    space-width (/ icon-width 2)))))

;; klarth-titletext-x-justify : window -> Int
(define (klarth-titletext-x-justify w)
  (- (klarth-titletext-left-edge w) (klarth-titlearea-left-edge w)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;; Klarth Utility Functions

;; klarth-window-maximized-both-p : window -> boolean
(define (klarth-window-maximized-both-p w)
  (and (window-maximized-horizontally-p w) (window-maximized-vertically-p w)))

;; klarth-window-resizable-p : window -> boolean
(define (klarth-window-resizable-p w)
  (let* ((size-hints (window-size-hints w))
	 (max-width-item (assoc 'max-width size-hints))
	 (min-width-item (assoc 'min-width size-hints)))
    (not (and max-width-item min-width-item
	      (= (cdr max-width-item) (cdr min-width-item))))))

;; klarth-increase-image-border : image num num num num -> image
(define (klarth-increase-image-border img a b c d)
  (let ((ib (image-border img))
        (addto (lambda (n lst val) (+ (nth n lst) val))))
    (set-image-border img (addto 0 ib a) (addto 1 ib b)
                      (addto 2 ib c) (addto 3 ib d))))

;; klarth-em : number -> number
(define (klarth-em n)
  (round (* n klarth-font-height)))

;; klarth-round-to-lower-multiple-of : number number -> number
(define (klarth-round-to-lower-multiple-of n by)
  (* (truncate (divide n by)) by))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;; Klarth Renderers, Choppers, Etc.

;; klarth-render-titlearea-bgpart : boolean
;; -> (list image image image image) or (list image image)
;; remember: background . (NORMAL FOCUSED HIGHLIGHTED CLICKED)
(define (klarth-render-titlearea-bgpart extra)
  (define (renderer out primod secmod)
    (klarth-bevel-image
     (klarth-new-filled-image klarth-titlearea-height klarth-titlearea-height
			    (list 'vertical
				  (klarth-modify-color
				   klarth-hilight-color primod)
				  (klarth-modify-color
				   klarth-hilight-color secmod)))
     klarth-titlearea-bevel-size out 45))
  (list
   (klarth-new-filled-image klarth-titlearea-height klarth-titlearea-height
			     klarth-unfocused-color)
   (klarth-increase-image-border (renderer t 129/100 51/100) 1 1 1 1) ; FIXME 
   (if extra (renderer t  159/100 81/100))
   (if extra (renderer () 51/100 129/100))))

;; klarth-render-resizer-bgpart : symbol symbol
(define (klarth-render-resizer-bgpart position gtk-col)
  (case position
    ((left)   (define b-width 5)   (define b-height 100)
              (define f-width 3)   (define f-height 100)
	      (define x 1)         (define y 0)
	      (define direction 'horizontal))
    ((right)  (define b-width 6)   (define b-height 100)
              (define f-width 3)   (define f-height 100)
	      (define x 1)         (define y 0)
	      (define direction 'horizontal))
    ((bottom) (define b-width 100) (define b-height 6)
              (define f-width 100) (define f-height 3)
	      (define x 0)         (define y 1)
	      (define direction 'vertical)))
  (define (renderer focused)
    (define titlearea-img
      (klarth-new-filled-image f-width f-height
			       (if focused
				   (list direction
					 (klarth-modify-color
					  (klarth-gtk-bg-color gtk-col)
					  109/100)
					 (klarth-modify-color
					  (klarth-gtk-bg-color gtk-col)
					  51/100))
				 (klarth-gtk-bg-color 'normal))))
    
    (klarth-composite-images (make-sized-image b-width b-height
					       (klarth-black focused))
			     (if focused
				 (klarth-bevel-image titlearea-img 1 t 35)
			         titlearea-img)
			     x y))
  (list (renderer ()) (klarth-increase-image-border (renderer t) 2 2 2 2)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;; The Messy Stuff

;; bgparts & such

;; Titlebar/area stuff...

;; klarth-titlearea-height x klarth-titlearea-height
(define full-titlearea-bgpart
  (klarth-render-titlearea-bgpart ()))
;; note: this does NOT include the black line...that is another part
;; klarth-titlearea-height x 2
(define (top-resizer-bgpart)
  (define (chopper fnc)
    (klarth-increase-image-border (crop-image (fnc full-titlearea-bgpart)
					      0 0 klarth-titlearea-height 2)
				  2 2 0 0))
  (list (chopper car) (chopper cadr)))
;; klarth-titlearea-height x klarth-titlearea-height
(define button-background-bgpart
  (klarth-render-titlearea-bgpart t))

;; <resized-to-match-height> x klarth-titlearea-height - 4
;; klarth-render-window-icon-bgpart : window -> image
(define (klarth-render-window-icon-bgpart w)
  (define wicon (klarth-window-icon w))
  ;; car, cdr.
  (define (renderer fnc wicon)
    ;; The window icon may be wider than klarth-titlearea-height, so we have
    ;; to crop conservatively and then scale/tile that to the proper size.
    ;; We scale because theoretically this should all be the same gradient
    ;; piece and the scaling function in sawfish is nowhere near as stupid as
    ;; the tiling one.
    
    (define bap-size (+ klarth-titlearea-bevel-size klarth-titlearea-padding))
    (klarth-composite-images
     (scale-image (crop-image (fnc full-titlearea-bgpart) bap-size bap-size
			      1 klarth-icon-size) ;; 1 is fairly arbitrary
		  (klarth-image-width wicon) klarth-icon-size)
     wicon 0 0))
  (list (renderer car (klarth-greyscale-image wicon)) (renderer cadr wicon)))

(define hole-image (make-image "hole.png"))
;; [somewhat] available-width (see below) x klarth-icon-size
;; klarth-render-titlearea-holes-bgpart : window fnc -> bgpart
(define (klarth-render-titlearea-holes-bgpart w)
  (define available-width
    (klarth-round-to-lower-multiple-of (- (klarth-icon-left-edge w)
					  (klarth-em 1/2)
					  (klarth-titlearea-left-edge w)) 4))
  (define (renderer fnc)
    (define bap-size (+ klarth-titlearea-bevel-size klarth-titlearea-padding))
    ;; FIXME: Y'know, I think we mangle an image here. Need to wrap tile-image.
    (define titlearea-cropped-img
      (scale-image (crop-image (fnc full-titlearea-bgpart) bap-size bap-size
                               1 klarth-icon-size) ;; 1 is fairly arbitrary
                   available-width klarth-icon-size))
    (klarth-composite-images
     titlearea-cropped-img
     (tile-image (make-sized-image available-width klarth-icon-size)
                 hole-image)
     0 0))
  (if (> available-width 0) (list (renderer car) (renderer cadr)) ()))

;; 5x100
(define left-plain-resizer-bgpart
  (klarth-render-resizer-bgpart 'left 'normal))
(define left-colored-resizer-bgpart
  (klarth-render-resizer-bgpart 'left 'selected))

;; 6x100
(define right-resizer-bgpart
  (klarth-render-resizer-bgpart 'right 'normal))

;; 100x6
(define bottom-resizer-bgpart
  (klarth-render-resizer-bgpart 'bottom 'normal))

;; 27x27
(define bottom-left-corner-bgpart 
  (list (make-image "inactive:bottom-left-corner.png")
	(make-image "active:bottom-left-corner.png")))

;; 28x27
(define bottom-right-corner-bgpart 
  (list (make-image "inactive:bottom-right-corner.png")
	(make-image "active:bottom-right-corner.png")))

;; 3x4
(define left-colored-hangdown-tip-bgpart 
  (list (make-image "inactive:left-colored-hangdown-tip.png")
	(make-image "active:left-colored-hangdown-tip.png")))

;; 10x10
(define (make-button-bgpart filename)
  (list (make-image filename) (make-image filename)))

(define close-bgpart      (make-button-bgpart "close-button.png"))
(define minimize-bgpart   (make-button-bgpart "minimize-button.png"))
(define maximize-bgpart   (make-button-bgpart "maximize-button.png"))
(define unmaximize-bgpart (make-button-bgpart "unmaximize-button.png"))
(define unmaximize-horiz-bgpart
  (make-button-bgpart "unmaximize-horiz-button.png"))
(define unmaximize-vert-bgpart
  (make-button-bgpart "unmaximize-vert-button.png"))
(define shade-bgpart      (make-button-bgpart "shade-button.png"))
(define unshade-bgpart    (make-button-bgpart "unshade-button.png"))
(define menu-bgpart       (make-button-bgpart "menu-button.png"))

;; Recolor all images that need recolouring. Precalculates the lookup
;; tables first. (Whatever that means.)

(define (recolor-bgparts)
  (define (make-recolorer color)
    (make-image-recolorer color
			  #:zero-channel blue-channel
			  #:index-channel green-channel))
  (define (helper color fnc loi)
    (mapc (lambda (x) ((make-recolorer color) (fnc x))) loi))
  (let ((loi (list bottom-left-corner-bgpart
			bottom-right-corner-bgpart
			left-colored-hangdown-tip-bgpart)))
    (helper (klarth-gtk-bg-color 'normal) car loi)
    (helper (klarth-gtk-bg-color 'selected) cadr loi))
  (let ((loi (list close-bgpart
		   minimize-bgpart 
		   maximize-bgpart
		   unmaximize-bgpart
		   unmaximize-horiz-bgpart
		   unmaximize-vert-bgpart
		   shade-bgpart
		   unshade-bgpart
		   menu-bgpart)))
    (helper
     (get-color (klarth-bw-contrast-color-name klarth-unfocused-color
					       ()))
     car loi)
    (helper
     (get-color (klarth-bw-contrast-color-name klarth-hilight-color
					       t))
     cadr loi)))

;; window icons

(define icon-table (make-weak-table eq-hash eq))

;; holes
(define hole-parts
  `(
    ((background . ,(lambda (w) (klarth-render-titlearea-holes-bgpart w)))
     (left-edge . ,(lambda (w)
		     (+ (klarth-titlearea-left-edge w)
			klarth-titlearea-bevel-size klarth-titlearea-padding)))
     (top-edge . ,(+ klarth-titlearea-top-edge
		     klarth-titlearea-bevel-size klarth-titlearea-padding))
     ;(width . ,(lambda (w) (- (klarth-icon-left-edge w) (klarth-titlearea-left-edge w) (klarth-em 1/2))))
     (class . title))

    ((background . ,(lambda (w) (klarth-render-titlearea-holes-bgpart w)))
     (right-edge . ,(lambda (w)
		     (+ (klarth-titlearea-right-edge w)
			klarth-titlearea-bevel-size klarth-titlearea-padding)))
     (top-edge . ,(+ klarth-titlearea-top-edge
		     klarth-titlearea-bevel-size klarth-titlearea-padding))
     ;(width . ,(lambda (w) (- (klarth-icon-left-edge w) (klarth-titlearea-left-edge w) (klarth-em 1/2))))
     (class . title))
    ))

;; frames
(define common-frame-parts
  `(
    ((background . ,klarth-black-list)
     (left-edge . ,klarth-absolute-left-edge)
     (top-edge . ,klarth-titlebar-top-edge)
     (right-edge . ,(lambda (w) (+ (klarth-absolute-right-edge w) 1)))
     (height . ,klarth-titlebar-height)
     (class . title))
    
    ((background . ,klarth-black-list)
     (top-edge . ,(+ klarth-titlebar-top-edge 1))
     (right-edge . ,klarth-absolute-right-edge)
     (height . ,klarth-titlebar-height)
     (width . 1)
     (class . title))

    ((background . ,full-titlearea-bgpart)
     (foreground . ,(klarth-bw-contrast-color-list klarth-hilight-color
						   klarth-unfocused-color))
     (left-edge . ,klarth-titlearea-left-edge)
     (right-edge . ,klarth-titlearea-right-edge)
     (top-edge . ,klarth-titlearea-top-edge) 
     (text . ,window-name)
     (x-justify . ,klarth-titletext-x-justify)
     (y-justify . ,(+ klarth-titlearea-bevel-size klarth-titlearea-padding))
     (class . title))

    ,@hole-parts

    ((background . ,klarth-render-window-icon-bgpart)
     (left-edge . ,klarth-icon-left-edge)
     (top-edge . ,(+ klarth-titlearea-top-edge
		     klarth-titlearea-bevel-size klarth-titlearea-padding))
     (class . title))
    ))

(define normal-frame
    `(,@common-frame-parts
      
      ((background . ,klarth-black-list)
       (left-edge . ,klarth-titlearea-left-edge)
       (right-edge . ,klarth-titlearea-right-edge)
       (top-edge . ,klarth-titlebar-top-edge) 
       (class . top-border))

      ((background . ,top-resizer-bgpart)
       (left-edge . ,klarth-titlearea-left-edge)
       (right-edge . ,klarth-titlearea-right-edge)
       (top-edge . ,klarth-titlearea-top-edge) 
       (class . top-border))

      ((background . ,left-plain-resizer-bgpart)
       (left-edge . -5)
       (top-edge . ,klarth-left-colored-hangdown-endpoint)
       (bottom-edge . 17)
       (class . left-border))      

      ((background . ,left-colored-resizer-bgpart)
       (left-edge . -5)
       (top-edge . 0)
       (height . ,klarth-left-colored-hangdown-endpoint)
       (class . left-border))

      ((background . ,left-colored-hangdown-tip-bgpart)
       (left-edge . -4)
       (top-edge . ,(lambda (w)
		      (- (klarth-left-colored-hangdown-endpoint w) 1)))
       (class . left-border))      
      
      ((background . ,bottom-resizer-bgpart)
       (left-edge . 18)
       (right-edge . 18)
       (bottom-edge . -6)
       (class . bottom-border))
      
      ((background . ,right-resizer-bgpart)
       (right-edge . -6)
       (top-edge . 0)
       (bottom-edge . 17)
       (class . right-border))
      
      ((background . ,bottom-left-corner-bgpart)
       (bottom-edge . -6)
       (left-edge . -5)
       (class . bottom-left-corner))
      
      ((background . ,bottom-right-corner-bgpart)
       (bottom-edge . -6)
       (right-edge . -6)
       (class . bottom-right-corner))
      ))

(define shaped-frame
    `(,@common-frame-parts

      ((background . ,klarth-black-list)
       (left-edge . ,(lambda (w) (+ 2 (klarth-absolute-left-edge w))))
       (right-edge . ,(lambda (w) (klarth-absolute-right-edge w)))
       (top-edge . 0)
       (height . 1)
       (class . title))
      ))

(define non-resizable-frame
  `(,@common-frame-parts

    ((background . ,klarth-black-list)
     (top-edge . 0)
     (bottom-edge . 0)
     (left-edge . -1)
     (width . 1)
     (class . title))
    
    ((background . ,klarth-black-list)
     (top-edge . 0)
     (bottom-edge . 0)
     (right-edge . -1)
     (width . 1)
     (class . title))

    ((background . ,klarth-black-list)
     (top-edge . ,(+ klarth-titlebar-top-edge 1))
     (bottom-edge . 0)
     (right-edge . -2)
     (width . 1)
     (class . title))

    ((background . ,klarth-black-list)
     (bottom-edge . -1)
     (left-edge . -1)
     (right-edge . -2)
     (height . 1)
     (class . title))

    ((background . ,klarth-black-list)
     (bottom-edge . -2)
     (left-edge . 2)
     (right-edge . -2)
     (height . 1)
     (class . title))
    ))

;; packing buttons

(define button-map
  `((iconify-button . ,minimize-bgpart)
;    (maximize-button . ,(lambda (w) (if (window-maximized-p w)
;					unmaximize-bgpart maximize-bgpart)))
    (maximize-button . ,(lambda (w)
			  (cond
			   ((klarth-window-maximized-both-p w)
			    unmaximize-bgpart)
			   ((window-maximized-horizontally-p w)
			    unmaximize-horiz-bgpart)
			   ((window-maximized-vertically-p w)
			    unmaximize-vert-bgpart)
			   (t maximize-bgpart))))
    (close-button . ,close-bgpart)
    (menu-button . ,menu-bgpart)
;; This works, but requires window-get to not be gaol'ed - arggh
;    (shade-button . ,(lambda (w)
;		       (if (window-get w 'shaded) shade-bgpart unshade-bgpart)))
    (shade-button . ,shade-bgpart)
    ))

;; klarth-remove-unnecessary-buttons : (something like vvv) -> 
;; '((close-button) maximize-button iconify-button)
(define (klarth-remove-unnecessary-buttons dual-buttons w)
  ;; FIXME: can't let* lambda here, since it won't be able to call itself
  (define (helper buttons)
    ;; this is just a '(foo bar), so it's empty or a symbol (button name).
    (cond
     ((null buttons) ())
     ((not (eq (car buttons) 'maximize-button))
      (cons (car buttons) (helper (cdr buttons))))
     ((klarth-window-resizable-p w)
      (cons 'maximize-button (helper (cdr buttons))))
     (t (helper (cdr buttons)))))
  (cons (helper (car dual-buttons)) (helper (cdr dual-buttons))))
  
(define (button-theme w)
  (klarth-remove-unnecessary-buttons
   (car (cdr (or (assq Klarth:button-theme Klarth:button-themes)
		 (assq 'default Klarth:button-themes)))) w))

(define (make-buttons spec colored edge resizable)
  
  (define (make-button class fg point)
    `((background . ,button-background-bgpart)
	(foreground . ,fg)
	(x-justify . center)
	(y-justify . center)
	(,edge . ,point)
	(top-edge . ,klarth-titlearea-top-edge) 
	(class . ,class)))
  
  (do ((rest spec (cdr rest))
       (point (+ 1 (if resizable -5 -1))
	      (+ point (+ klarth-titlearea-height 1)))
       (out '() (if (or (not (eq (car rest) 'maximize-button)) resizable)
		    (cons (make-button (car rest)
				       (cdr (assq (car rest) button-map))
				       point)
			  out)
		    out)))
    ((null rest) out)))


;; misc stuff

(define (rebuild-all)
  (rebuild-frames-with-style 'Klarth))

(define (reframe-all)
  (reframe-windows-with-style 'Klarth))

(define (color-changed)
  (recolor-bgparts (klarth-gtk-bg-color 'selected)
		  (klarth-gtk-bg-color 'normal))
  (rebuild-all))

(define (make-frame w frame buttons)
  (let ((resizable (klarth-window-resizable-p w)))
    (table-set button-table w buttons)
    (append frame
	    (make-buttons (car buttons) t 'left-edge resizable)
	    (make-buttons (reverse (cdr buttons)) () 'right-edge resizable))))

(define (get-frame w type)  
  (make-frame w (if (or (eq type 'default) (eq type 'transient))
		    (if (klarth-window-resizable-p w)
			normal-frame
		        non-resizable-frame)
		  shaped-frame)
	      (button-theme w)))

;; initialization

(gtkrc-call-after-changed color-changed)

;; setup the initial colours
(recolor-bgparts (klarth-gtk-bg-color 'selected) (klarth-gtk-bg-color 'normal))

;; register the theme
(add-frame-style 'Klarth get-frame)

;; recalibrate frames when the window-name changes
(call-after-property-changed 'WM_NAME rebuild-frame)