;; Anonymous/theme.jl

;; Copyright (C) 2000 Pedro Lopes (paol@teleweb.pt)

;; This theme 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.
;;
;; It 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.


;; configuration options

;; main options
(defgroup Anonymous "Anonymous Theme"
  :group appearance)

(defcustom anon:title-font 
  (get-font "-b&h-lucida-bold-r-normal-*-*-120-*-*-p-*-iso8859-1")
  "Font for window titles."
  :group (appearance Anonymous)
  :type font)

(defcustom anon:frame-bevel nil
  "Beveled window frame inside."
  :group (appearance Anonymous)
  :type boolean)

(defcustom anon:use-icons t
  "Use application icon for titlebar menu button."
  :group (appearance Anonymous)
  :type boolean)

(defcustom anon:texture-clear 3
  "Clear space around groove texture in titlebar."
  :group (appearance Anonymous)
  :type number
  :range (0 . 1000))

(defcustom anon:btn-unfocused-color (get-color "#C0C0C0")
  "Inactive button color."
  :group (appearance Anonymous)
  :type color)

(defcustom anon:btn-focused-color (get-color "#ACCADC")
  "Active button color."
  :group (appearance Anonymous)
  :type color)

(defcustom anon:btn-highlight-color (get-color "#CEEDFF")
  "Highlighted button color."
  :group (appearance Anonymous)
  :type color)

(defcustom anon:btn-selected-color (get-color "#EEFAFF")
  "Selected button color."
  :group (appearance Anonymous)
  :type color)

;; button options - left side
(defgroup Left-Buttons "Left Titlebar Buttons"
  :group (appearance Anonymous))
  
(defcustom anon:left-buttons `((close ,t) (\(none\) ,nil) (\(none\) ,nil) (\(none\) ,nil) (\(none\) ,nil))
  "Left Titlebar Buttons (from left to right)"
  :group (appearance Anonymous Left-Buttons)
  :type (v-and (v-and (choice \(none\) close menu maximize minimize shade sticky)
		     (boolean "Show in transients"))
	       (v-and (choice \(none\) close menu maximize minimize shade sticky)
		     (boolean "Show in transients"))
	       (v-and (choice \(none\) close menu maximize minimize shade sticky)
		     (boolean "Show in transients"))
	       (v-and (choice \(none\) close menu maximize minimize shade sticky)
		     (boolean "Show in transients"))
	       (v-and (choice \(none\) close menu maximize minimize shade sticky)
		     (boolean "Show in transients"))))
  
;; button options - right side
(defgroup Right-Buttons "Right Titlebar Buttons"
  :group (appearance Anonymous))

(defcustom anon:right-buttons `((maximize ,nil) (minimize ,nil) (sticky ,nil) (\(none\) ,nil) (\(none\) ,nil))
  "Right Titlebar Buttons (from right to left)"
  :group (appearance Anonymous Right-Buttons)
  :type (v-and (v-and (choice \(none\) close menu maximize minimize shade sticky)
		     (boolean "Show in transients"))
	       (v-and (choice \(none\) close menu maximize minimize shade sticky)
		     (boolean "Show in transients"))
	       (v-and (choice \(none\) close menu maximize minimize shade sticky)
		     (boolean "Show in transients"))
	       (v-and (choice \(none\) close menu maximize minimize shade sticky)
		     (boolean "Show in transients"))
	       (v-and (choice \(none\) close menu maximize minimize shade sticky)
		     (boolean "Show in transients"))))


;; new frame part classes

(def-frame-class sticky-button ()
  (bind-keys sticky-button-keymap "Button1-Off" 'toggle-window-sticky))

(def-frame-class shade-button ()
  (bind-keys shade-button-keymap "Button1-Off" 'toggle-window-shaded))


;;

(let*
  ( ;; *** fonts & colors ********************************************

    (title-font	(lambda () anon:title-font))

    (bg-color	(get-color "#C0C0C0"))
    (dark-color	(get-color "#8E8E8E"))

    (last-line-color (lambda ()
		       (if anon:frame-bevel dark-color bg-color)))

    (btn-color	(lambda ()
		  (list
		    anon:btn-unfocused-color
		    anon:btn-focused-color
		    anon:btn-highlight-color
		    anon:btn-selected-color)))
    
    (text-color	(list
		  (get-color "#808080")
		  (get-color "#000000")))
    
    ;; *** textures **************************************************

    ;; button backgrounds (16x16)
    (bg-btn		btn-color)

    (default-icon	(make-image "default_icon.png"))
    (bg-btn-icon	(lambda (w)
			  (let ((icon (window-icon-image w)))
			    (if (eq icon nil) default-icon icon))))

    ;; button foregrounds (12x12)
    (fg-btn-menu	(list 	(make-image "btn_menu.png")
				nil
				nil
				nil))

    (fg-btn-close	(list 	(make-image "btn_close.png")
				nil
				nil
				nil))

    (fg-btn-min		(list 	(make-image "btn_min.png")
	    			nil
				nil
	    			nil))

    (fg-btn-max		(list 	(make-image "btn_max.png")
	    			nil
				nil
	    			nil))
    (fg-btn-unmax	(list 	(make-image "btn_unmax.png")
	    			nil
				nil
	    			nil))
    (fg-btn-max-unmax	(lambda (w)
			  (if (window-maximized-p w)
			      fg-btn-unmax
			    fg-btn-max)))

    (fg-btn-shade	(list 	(make-image "btn_shade.png")
	    			nil
				nil
	    			nil))
    (fg-btn-unshade	(list 	(make-image "btn_unshade.png")
	    			nil
				nil
	    			nil))
    (fg-btn-shd-unshd	(lambda (w)
			  (if (window-get w 'shaded)
			      fg-btn-unshade
			    fg-btn-shade)))

    (fg-btn-stick	(list 	(make-image "btn_stick.png")
	    			nil
				nil
	    			nil))
    (fg-btn-unstick	(list 	(make-image "btn_unstick.png")
	    			nil
				nil
	    			nil))
    (fg-btn-stk-unstk	(lambda (w)
			  (if (window-get w 'sticky)
			      fg-btn-unstick
			    fg-btn-stick)))

    ;; titlebar
    (title-tex
      (let ((tex-img (make-image "title_texture.png")))
        (image-put tex-img 'tiled t)
        (list bg-color tex-img)))

    (title-tex-end-l	(list bg-color
			      (make-image "title_texture_end_l.png")))
			      
    (title-tex-end-r	(list bg-color
			      (make-image "title_texture_end_r.png")))

    ;; edges (4 pixel wide)
    (textures-top-edge		(make-image "top.png"))

    (textures-bottom-bev	(make-image "bottom_bevel.png"))
    (textures-bottom-nobev	(make-image "bottom.png"))
    (textures-bottom-edge	(lambda ()
				  (if anon:frame-bevel
				      textures-bottom-bev
				    textures-bottom-nobev)))
    
    (textures-left-bev		(make-image "left_bevel.png"))
    (textures-left-nobev	(make-image "left.png"))
    (textures-left-edge		(lambda ()
				  (if anon:frame-bevel
				      textures-left-bev
				    textures-left-nobev)))

    (textures-right-bev		(make-image "right_bevel.png"))
    (textures-right-nobev	(make-image "right.png"))
    (textures-right-edge	(lambda ()
				  (if anon:frame-bevel
				      textures-right-bev
				    textures-right-nobev)))

    ;; top corners (16x22, 4 pixel wide)
    (textures-tl-corner		(make-image "top_left.png"))

    (textures-tr-corner		(make-image "top_right.png"))

    ;; bottom corners (16x16, 4 pixel wide)
    (textures-bl-bev		(make-image "bottom_left_bevel.png"))
    (textures-bl-nobev		(make-image "bottom_left.png"))
    (textures-bl-corner		(lambda ()
				  (if anon:frame-bevel
				      textures-bl-bev
				    textures-bl-nobev)))

    (textures-br-bev		(make-image "bottom_right_bevel.png"))
    (textures-br-nobev		(make-image "bottom_right.png"))
    (textures-br-corner		(lambda ()
				  (if anon:frame-bevel
				      textures-br-bev
				    textures-br-nobev)))

    ;; edges for windowshade titlebar
    (title-tex-left	(make-image "title_left.png"))

    (title-tex-right	(make-image "title_right.png"))

    (title-tex-bottom	(make-image "bottom.png"))


    ;; *** dimensions ************************************************

    (tex-norm-left	nil)
    (tex-norm-right	nil)
    (tex-trans-left	nil)
    (tex-trans-right	nil)

    (texture-pos-left
      (lambda (w)
	(if (or (eq (window-type w) 'transient)
		(eq (window-type w) 'shaped-transient))
	    (+ anon:texture-clear tex-trans-left)
	  (+ anon:texture-clear tex-norm-left))))
    
    (texture-pos-right
      (lambda (w)
	(if (or (eq (window-type w) 'transient)
		(eq (window-type w) 'shaped-transient))
	    (+ anon:texture-clear tex-trans-right)
	  (+ anon:texture-clear tex-norm-right))))

    (texture-width
      (lambda (w)
	(let* ((title-width   (+ (text-width (window-name w) anon:title-font)
				 (* 2 anon:texture-clear)))
	       ;; free space after drawing buttons and window title
	       (freespace     (- (car (window-dimensions w))
				 (texture-pos-left w)
				 (texture-pos-right w)
				 title-width)))
	  (max (quotient freespace 2) 0))))

    (hide-texture-p
      (lambda (w) (<= (texture-width w) 0)))

    ;; *** normal frame **********************************************

    (normal-frame `(
	;; top border
	((class		. top-border)
	 (background	. ,textures-top-edge)
         (left-edge	. 12)
         (right-edge	. 12)
         (top-edge	. -22)
         (height	. 4))
	;; bottom border
	((class		. bottom-border)
	 (background	. ,textures-bottom-edge)
         (left-edge	. 12)
         (right-edge	. 12)
         (bottom-edge	. -4)
         (height	. 4))
	;; right border
	((class		. right-border)
	 (background	. ,textures-right-edge)
         (right-edge	. -4)
         (width		. 4)
         (top-edge	. -1)
         (bottom-edge	. 12))
	;; left border
	((class		. left-border)
	 (background	. ,textures-left-edge)
         (left-edge	. -4)
         (width		. 4)
         (top-edge	. -1)
         (bottom-edge	. 12))
	;; top-left corner
	((class		. top-left-corner)
	 (background	. ,textures-tl-corner)
         (left-edge	. -4)
         (width		. 16)
         (top-edge	. -22)
         (height	. 22))
	;; top-right corner
	((class		. top-right-corner)
	 (background	. ,textures-tr-corner)
         (right-edge	. -4)
         (width		. 16)
         (top-edge	. -22)
         (height	. 22))
	;; bottom-left corner
	((class		. bottom-left-corner)
	 (background	. ,textures-bl-corner)
         (left-edge	. -4)
         (width		. 16)
         (bottom-edge	. -4)
         (height	. 16))
	;; bottom-right corner
	((class		. bottom-right-corner)
	 (background	. ,textures-br-corner)
         (right-edge	. -4)
         (width		. 16)
         (bottom-edge	. -4)
         (height	. 16))
	;; title bar
	((class		. title)		; background
	 (background	. ,bg-color)
	 (left-edge	. 0)
	 (right-edge	. 0)
	 (top-edge	. -18)
	 (height	. 17))
	((class		. title)		; left bg texture
	 (background	. ,title-tex)
	 (left-edge	. ,texture-pos-left)
	 (width		. ,texture-width)
	 (top-edge	. -16)
	 (height	. 11))
	((class		. title)
	 (background	. ,title-tex-end-l)
	 (left-edge	. ,texture-pos-left)
	 (width		. 1)
	 (top-edge	. -16)
	 (height	. 11)
	 (hidden	. ,hide-texture-p))
	((class		. title)
	 (background	. ,title-tex-end-r)
	 (left-edge	. ,(lambda (w) (+ (texture-pos-left w) (texture-width w))))
	 (width		. 1)
	 (top-edge	. -16)
	 (height	. 11)
	 (hidden	. ,hide-texture-p))
	((class		. title)		; right bg texture
	 (background	. ,title-tex)
	 (right-edge	. ,texture-pos-right)
	 (width		. ,texture-width)
	 (top-edge	. -16)
	 (height	. 11))
	((class		. title)
	 (background	. ,title-tex-end-r)
	 (right-edge	. ,texture-pos-right)
	 (width		. 1)
	 (top-edge	. -16)
	 (height	. 11)
	 (hidden	. ,hide-texture-p))
	((class		. title)
	 (background	. ,title-tex-end-l)
	 (right-edge	. ,(lambda (w) (+ (texture-pos-right w) (texture-width w))))
	 (width		. 1)
	 (top-edge	. -16)
	 (height	. 11)
	 (hidden	. ,hide-texture-p))
	((class		. title)		; title
	 (foreground	. ,text-color)
	 (background	. ,bg-color)
	 (font		. ,title-font)
	 (text		. ,window-name)
	 (x-justify	. center)
	 (y-justify	. center)
	 (left-edge	. ,(lambda (w) (+ (texture-pos-left w) (texture-width w) 1)))
	 (right-edge	. ,(lambda (w) (+ (texture-pos-right w) (texture-width w) 1)))
	 (top-edge	. -19)
	 (height	. 18))
	((class		. title)		; lower bevel
	 (background	. ,last-line-color)
	 (left-edge	. 0)
	 (right-edge	. 0)
	 (top-edge	. -1)
	 (height	. 1))))


    ;; *** shaped & windowshade frame ********************************

    (shaped-frame `(
	;; title bar
	((class		. title)		; background
	 (background	. ,bg-color)
	 (left-edge	. 0)
	 (right-edge	. 0)
	 (top-edge	. -18)
	 (height	. 17))
	((class		. title)		; left bg texture
	 (background	. ,title-tex)
	 (left-edge	. ,texture-pos-left)
	 (width		. ,texture-width)
	 (top-edge	. -16)
	 (height	. 11))
	((class		. title)
	 (background	. ,title-tex-end-l)
	 (left-edge	. ,texture-pos-left)
	 (width		. 1)
	 (top-edge	. -16)
	 (height	. 11)
	 (hidden	. ,hide-texture-p))
	((class		. title)
	 (background	. ,title-tex-end-r)
	 (left-edge	. ,(lambda (w) (+ (texture-pos-left w) (texture-width w))))
	 (width		. 1)
	 (top-edge	. -16)
	 (height	. 11)
	 (hidden	. ,hide-texture-p))
	((class		. title)		; right bg texture
	 (background	. ,title-tex)
	 (right-edge	. ,texture-pos-right)
	 (width		. ,texture-width)
	 (top-edge	. -16)
	 (height	. 11))
	((class		. title)
	 (background	. ,title-tex-end-r)
	 (right-edge	. ,texture-pos-right)
	 (width		. 1)
	 (top-edge	. -16)
	 (height	. 11)
	 (hidden	. ,hide-texture-p))
	((class		. title)
	 (background	. ,title-tex-end-l)
	 (right-edge	. ,(lambda (w) (+ (texture-pos-right w) (texture-width w))))
	 (width		. 1)
	 (top-edge	. -16)
	 (height	. 11)
	 (hidden	. ,hide-texture-p))
	((class		. title)		; title
	 (foreground	. ,text-color)
	 (background	. ,bg-color)
	 (font		. ,title-font)
	 (text		. ,window-name)
	 (x-justify	. center)
	 (y-justify	. center)
	 (left-edge	. ,(lambda (w) (+ (texture-pos-left w) (texture-width w) 1)))
	 (right-edge	. ,(lambda (w) (+ (texture-pos-right w) (texture-width w) 1)))
	 (top-edge	. -19)
	 (height	. 18))
	((class		. title)		; top border
	 (background	. ,textures-top-edge)
	 (left-edge	. 0)
	 (right-edge	. 0)
	 (top-edge	. -22)
	 (height	. 4))
	((class		. title)		; bottom border
	 (background	. ,title-tex-bottom)
	 (left-edge	. 0)
	 (right-edge	. 0)
	 (top-edge	. -3)
	 (height	. 4))
	((class		. title)		; right border
	 (background	. ,title-tex-right)
	 (right-edge	. -4)
	 (width		. 4)
	 (top-edge	. -22)
	 (height	. 23))
	((class		. title)		; left border
	 (background	. ,title-tex-left)
	 (left-edge	. -4)
	 (width		. 4)
	 (top-edge	. -22)
	 (height	. 23))))


    ;; *** buttons ***************************************************

    (close-button
      `((class		. close-button)
	(background	. ,bg-btn)
	(top-edge	. -19)
	(foreground	. ,fg-btn-close)
	(width		. 16)
	(height		. 16)
	(removable	. t)))
    (menu-button-icon
      `((class		. menu-button)
	(background	. ,bg-btn-icon)
	(top-edge	. -19)
	(width		. 16)
	(height		. 16)
	(removable	. t)))
    (menu-button-noicon
      `((class		. menu-button)
	(background	. ,bg-btn)
	(top-edge	. -19)
	(foreground	. ,fg-btn-menu)
	(width		. 16)
	(height		. 16)
	(removable	. t)))
    (min-button
      `((class		. iconify-button)
	(background	. ,bg-btn)
	(top-edge	. -19)
	(foreground	. ,fg-btn-min)
	(width		. 16)
	(height		. 16)
	(removable	. t)))
    (max-button
      `((class		. maximize-button)
	(background	. ,bg-btn)
	(top-edge	. -19)
	(foreground	. ,fg-btn-max-unmax)
	(width		. 16)
	(height		. 16)
	(removable	. t)))
    (shade-button
      `((class		. shade-button)
	(background	. ,bg-btn)
	(top-edge	. -19)
	(foreground	. ,fg-btn-shd-unshd)
	(width		. 16)
	(height		. 16)
	(removable	. t)))
    (sticky-button
      `((class		. sticky-button)
	(background	. ,bg-btn)
	(top-edge	. -19)
	(foreground	. ,fg-btn-stk-unstk)
	(width		. 16)
	(height		. 16)
	(removable	. t)))


    ;; *** function to build the complete frames *********************

    (normal-frame-full		nil)
    (shaped-frame-full		nil)
    (trans-frame-full		nil)
    (shaped-trans-frame-full	nil)

    (create-frames
      (lambda ()
	(let* ( ; mapping from button names to definitions
		(button-alist
		  `((close	. ,close-button)
		    (menu	. ,(if anon:use-icons menu-button-icon menu-button-noicon))
		    (minimize	. ,min-button)
		    (maximize	. ,max-button)
		    (shade	. ,shade-button)
		    (sticky	. ,sticky-button)
		    (\(none\)	. ,nil)))
	
		; turns one cons cell (btn-name . show-in-transients) into a button 
		; definition, adding the button position
		(make-button
		  (lambda (is-trans btn edge pos)
		    (let ((btn-def	(cdr (assq (car btn) button-alist)))
			  (btn-in-trans (last btn)))
		      (if (or (null btn-def) (and is-trans (not btn-in-trans)))
			  nil
			(cons (cons edge pos) btn-def)))))

		; turns the list of cons cells (btn-name . show-in-transients) into 
		; a list of button definitions, adding the button positions
		(make-button-list
		  (lambda (is-trans btn-list edge pos-start pos-inc)
		    (let loop ((rest btn-list) (pos pos-start) (result ()))
			 (if (null rest)
			     result
			   (let ((new-btn (make-button is-trans (car rest) edge pos)))
			     (if (null new-btn)
				 (loop (cdr rest) pos result)
			       (loop (cdr rest) (+ pos pos-inc) (append (list new-btn) result))))))))

		(normal-buttons-l
		  (make-button-list nil anon:left-buttons  'left-edge  0 18))
		(normal-buttons-r
		  (make-button-list nil anon:right-buttons 'right-edge 0 18))

		(trans-buttons-l
		  (make-button-list t anon:left-buttons  'left-edge  0 18))
		(trans-buttons-r
		  (make-button-list t anon:right-buttons 'right-edge 0 18))
	      )

	(setq tex-norm-left  (- (* 18 (length normal-buttons-l)) 2))
	(setq tex-norm-right (- (* 18 (length normal-buttons-r)) 2))

	(setq tex-trans-left  (- (* 18 (length trans-buttons-l)) 2))
	(setq tex-trans-right (- (* 18 (length trans-buttons-r)) 2))

	(setq normal-frame-full
	  (append normal-frame normal-buttons-l normal-buttons-r))
	(setq shaped-frame-full
	  (append shaped-frame normal-buttons-l normal-buttons-r))
	(setq trans-frame-full
	  (append normal-frame trans-buttons-l trans-buttons-r))
	(setq shaped-trans-frame-full
	  (append shaped-frame trans-buttons-l trans-buttons-r)))))

    ;; *** redrawing functions ***************************************

    (redraw-one-frame
      (lambda (w)
	(if (eq (window-get w 'current-frame-style) 'Anonymous)
	    (rebuild-frame w))))

    (redraw-all-frames
      (lambda ()
	(rebuild-frames-with-style 'Anonymous)))

    (recreate-all-frames
      (lambda ()
        (create-frames)
      	(reframe-windows-with-style 'Anonymous)))

  )


  ;; create the full frames

  (create-frames)
  
  ;; frame style function now returns nil for unknow styles

  (add-frame-style 'Anonymous
    (lambda (w type)
      (case type
	((default)		normal-frame-full)
	((transient)		trans-frame-full)
	((shaped)		shaped-frame-full)
	((shaped-transient)	shaped-trans-frame-full))))

  ;; make sure frames are redrawn/recreated when necessary

  (call-after-property-changed 'WM_NAME		redraw-one-frame)
  ;; redraw on WM_HINTS to catch icon changes (at least it works for gnomecc...)
  (call-after-property-changed 'WM_HINTS	redraw-one-frame)
  (call-after-state-changed '(sticky)		redraw-one-frame)

  (custom-set-property 'anon:title-font		 ':after-set redraw-all-frames)
  (custom-set-property 'anon:frame-bevel	 ':after-set redraw-all-frames)
  (custom-set-property 'anon:texture-clear	 ':after-set redraw-all-frames)
  (custom-set-property 'anon:btn-unfocused-color ':after-set redraw-all-frames)
  (custom-set-property 'anon:btn-focused-color	 ':after-set redraw-all-frames)
  (custom-set-property 'anon:btn-highlight-color ':after-set redraw-all-frames)
  (custom-set-property 'anon:btn-selected-color	 ':after-set redraw-all-frames)

  (custom-set-property 'anon:use-icons		':after-set recreate-all-frames)
  (custom-set-property 'anon:left-buttons	':after-set recreate-all-frames)
  (custom-set-property 'anon:right-buttons	':after-set recreate-all-frames)
)