sawfish-themes 0.13 / usr / share / sawfish / themes / Greene2.0 / theme.jl

#| theme.jl for Greene2.0 sawfish theme


   This was hacked together from Eazel Inc's Crux theme  (which is very cool, 
   I suggest you try it.)  Basicly I use images from Greene (1.0) with the 
   geometry management of Crux.

   Copyright 2001 Doug Johnson (doug@centibyte.org) under the GPL.

|#


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

(defgroup Greene2.0 "Greene Theme 2.0"
  :group appearance)

(defcustom Greene2.0:normal-color nil
  "Accent color for focused windows (if unset uses the GTK+ selection color)."
  :type (optional color)
  :group (appearance Greene2.0)
  :user-level novice
  :after-set (lambda () (color-changed)))

(defcustom Greene2.0:unfocused-color nil
  "Color for unfocused windows (if unset uses gray)."
  :type (optional color)
  :group (appearance Greene2.0)
  :user-level novice
  :after-set (lambda () (color-changed)))

(defcustom Greene2.0:show-window-icons nil
  "Display the window's icon in its menu button."
  :type boolean
  :group (appearance Greene2.0)
  :after-set (lambda () (rebuild-all)))

(defcustom Greene2.0:button-theme 'none
  "Display title buttons to mimic: \\w"
  :type (choice (platinum "MacOS Platinum")
		(macos-x "MacOS X")
		(windows "MS Windows")
		(next "NeXTSTEP")
		(none "None"))
  :group (appearance Greene2.0)
  :after-set (lambda () (reframe-all)))

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


;; images

(define ne-self-contained 
  (list (make-image "active:ne-self-contained.png")
		  (make-image "active:ne-self-contained.png")))

(define nw-self-contained 
  (list (make-image "active:nw-self-contained.png")
		  (make-image "active:nw-self-contained.png")))


(define top-center-left
  (list (make-image "active:n.png")
	(make-image "active:n.png")))

(define top-center-mid
  (list (make-image "active:ne.png")
	(make-image "active:ne.png")))

(define corner-nw
  (list (make-image "active:nw.png")
		  (make-image "active:nw.png")))

(define corner-sw
  (list (make-image "active:sw.png")
		  (make-image "active:sw.png")))



;; 48*x19
;;(define top-center-right
;;  (list (make-image "active:ne.png")
;;	(make-image "active:ne.png")))

(define menu-button
  `((inactive . ,(make-image "inactive:menu-button.png"))
    (focused . ,(make-image "active:menu-button.png"))
    (inactive-highlighted . ,(make-image "inactive:menu-button-hilight.png"))
    (highlighted . ,(make-image "active:menu-button-hilight.png"))
    (inactive-clicked . ,(make-image "inactive:menu-button-pressed.png"))
    (clicked . ,(make-image "active:menu-button-pressed.png"))))
(define button-background
  `((inactive . ,(make-image "inactive:button.png"))
    (focused . ,(make-image "active:button.png"))
    (inactive-highlighted . ,(make-image "inactive:button-hilight.png"))
    (highlighted . ,(make-image "active:button-hilight.png"))
    (inactive-clicked . ,(make-image "inactive:button-pressed.png"))
    (clicked . ,(make-image "active:button-pressed.png"))))

;; 12x12
(define minimize-fg
  `((inactive . ,(make-image "inactive:minimize-button.png"))
    (focused . ,(make-image "active:minimize-button.png"))))
(define maximize-fg
  `((inactive . ,(make-image "inactive:maximize-button.png"))
    (focused . ,(make-image "active:maximize-button.png"))))
(define close-fg
  `((inactive . ,(make-image "inactive:close-button.png"))
    (focused . ,(make-image "active:close-button.png"))))
(define shade-fg
  `((inactive . ,(make-image "inactive:shade-button.png"))
    (focused . ,(make-image "active:shade-button.png"))))


;; geometry computations

(define (title-left-width w)
  (let ((buttons (table-ref button-table w)))
    (max 0 (min (- (car (window-dimensions w))
		   (* (length (cdr buttons)) 18))
		(+ (text-width (window-name w)) 52
		   (* (length (car buttons)) 18))))))

(define (top-border-left-width w)
  (let ((buttons (table-ref button-table w)))
    (max 0 (min (- (car (window-dimensions w)) (* (length (cdr buttons)) 18))
		(+ (title-left-width w) -43)))))

;;(define (bottom-border-left-width w)
;;  (max 0 (min (car (window-dimensions w))
;;	      (+ (title-left-width w)
;;		 (quotient (cdr (window-dimensions w)) 2)))))

(define (vertical-justification)
  ;; `center' justification adjusted for the 3-pixel top-border
  (max 0 (- (/ (- 22 (font-height default-font)) 2) 3)))

(define (horizontal-justification w)
  (+ (* (length (car (table-ref button-table w))) 18) 2))


;; recolouring images

(define (foreground-color)
  (if (colorp Greene2.0:normal-color)
      Greene2.0:normal-color
    (initialize-gtkrc)
    (if (colorp (nth 3 gtkrc-background))
	(nth 3 gtkrc-background)
      (get-color "steelblue"))))

;; now we have a unfocused color too.
;; later, maybe make it a lighter/darker version of foreground?
(define (unfocused-color)
  (if (colorp Greene2.0:unfocused-color)
      Greene2.0:unfocused-color
	 (get-color "gray")))

;; Recolor all images that need recolouring. Precalculates the lookup
;; tables first.
(define (recolor-all)
  ;; Use the SELECTED state of the background colors as the
  ;; midpoint of the gradient for recolouring images. (This is
  ;; usually a bright, contrasting colour, and thus is the
  ;; best choice. It works particularly well with the Eazel-Foo
  ;; themes)
  (let ((recolorer (make-image-recolorer (foreground-color)
					 #:zero-channel red-channel
					 #:index-channel green-channel)))
    (mapc (lambda (x) (mapc recolorer (cdr x)))
	  (list 
;;top-left-border
;;		top-center-left-border
		top-center-left
		top-center-mid
		corner-sw
		corner-nw
		nw-self-contained
		ne-self-contained
		))
    (mapc (lambda (x)
				(recolorer (cdr x))) menu-button))
  
  ;; and now the inactive border...
  (let ((recolorer (make-image-recolorer (unfocused-color)
													  #:zero-channel red-channel
													  #:index-channel green-channel)))
	 (recolorer (car top-center-left))
	 (recolorer (car top-center-mid))
	 (recolorer (car corner-sw))
	 (recolorer (car corner-nw))
	 (recolorer (car nw-self-contained))
	 (recolorer (car ne-self-contained))
;;	 (mapc (lambda (x) (mapc recolorer (car x)))
;;			 (list 
;;			  ;;top-left-border
;;			  ;;		top-center-left-border
;;			  top-center-left
;;			  top-center-mid
;;			  corner-sw
;;			  corner-nw
;;			  ))
;;  (mapc (lambda (x)
;;				(recolorer (cdr x))) menu-button))
	 ))


;; window icons

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

(define (window-icon w)
  (when Greene2.0:show-window-icons
    (or (table-ref icon-table w)
	(let ((icon (window-icon-image w)))
	  (when icon	    (let ((scaled (scale-image icon 12 12)))
	      (table-set icon-table w scaled)
	      scaled))))))


;; frames

(define common-frame-parts
  `(
	 ;;((background . ,top-left-border)
    ;; (left-edge . -5)
     ;;(top-edge . -22)
     ;;(class . top-left-corner))

;;    ((background . ,top-center-left-border)
;;     (left-edge . 11)
;;     (top-edge . -22)
;;     (width . ,top-border-left-width)
;;     (class . top-border))
;;    ((background . ,top-center-right-border)
;;     (left-edge . ,(lambda (w) (+ (top-border-left-width w) 11)))
;;     (right-edge . 10)
;;     (top-edge . -22)
;;     (class . top-border))

    ((background . ,top-center-left)
     (left-edge . 0)
     (width . ,(lambda (w) (+ (title-left-width w) 2 -48)))
     (top-edge . -16)
     (text . ,window-name)
     (foreground . ("grey95" "white"))
     (x-justify . ,horizontal-justification)
     (y-justify . ,vertical-justification)
     (class . title))
;;    ((background . ,top-center-right)
;;     (left-edge . ,title-left-width)
;;     (right-edge . -1)
;;     (top-edge . -19)
;;     (class . title))

;;    ((background . ,top-right-border)
;;     (right-edge . -6)
;;     (top-edge . -22)
;;     (class . top-right-corner))
))

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


    ((background . ,top-center-mid)
     (left-edge . ,(lambda (w) (max 0 (- (title-left-width w) 46)))) ;; was 48
     (top-edge . -16)
     (class . title))

	 ;; top black line
	 ((background . "black")
     (left-edge . ,(lambda (w) (+ (top-border-left-width w) 12)))
     (right-edge . -1)
     (top-edge . -1)
	  (height . 1)
	  (class . title))

	 ((top-edge . -16)
	  (left-edge . -16)
	  (background . ,corner-nw)
	  (class . title))

	 ((class . title)
          (top-edge . -1)
          (left-edge . -16)
          (background . ,corner-sw))
	 
;;    ((background . "#002900770016")
;;       (left-edge . ,top-center-right)
;;       (right-edge . -1)
;;       (top-edge . -3)
;;       (height . 10)
;;       (class . title))
	 
	 
	 
	 
	 ((width . 1)
	       (right-edge . -1)
			 (top-edge . 0)
			 (bottom-edge . 0)
			 (background . "#002900770016")
			 (class . right-border))

	 ((bottom-edge . -1)
	       (left-edge . -1)
          (height . 1)
          (right-edge . -1)
          (background . "#00360077001f")
          (class . bottom-border))
	 
	 ((top-edge . 15)
          (left-edge . -1)
			 (width . 1)
          (bottom-edge . 0)
          (background . "#002900770016")
          (class . left-border))
))

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

	 ((background . ,ne-self-contained)
			 (left-edge . ,(lambda (w) (max 0 (- (title-left-width w) 46))))
			 (top-edge . -16)
			 (class . title))

	 ((background . ,nw-self-contained)
			 (left-edge . -8)
			 (top-edge . -16)
			 (class . title))

	 

;;    ((background . ,left-top-border-shaped)
;;     (left-edge . -5)
;;     (top-edge . -19)
;;     (class . top-left-corner))
;;    ((background . ,right-top-border-shaped)
;;     (right-edge . -6)
;;     (top-edge . -19)
;;     (class . top-right-corner))
))


;; packing buttons

(define button-map
  `((iconify-button . ,minimize-fg)
    (maximize-button . ,maximize-fg)
    (close-button . ,close-fg)
    (menu-button . ,window-icon)
    (shade-button . ,shade-fg)))

(define (button-theme type)
  (case Greene2.0:button-theme
    ((platinum)
     '((close-button) . (maximize-button shade-button)))
    ((macos-x)
     '((close-button maximize-button iconify-button) . ()))
    ((windows)
     (if (eq type 'transient)
	 '((menu-button) . (close-button))
       '((menu-button) . (iconify-button maximize-button close-button))))
    ((next)
     '((iconify-button) . (close-button)))
	 ((none) '())
	 ))

(define (make-buttons spec background edge)

  (define (make-button class fg point)
    `((background . ,background)
      (foreground . ,fg)
      (x-justify . 2)
      (y-justify . 2)
      (,edge . ,point)
      (top-edge . -19)
      (class . ,class)))

  (do ((rest spec (cdr rest))
       (point -1 (+ point 18))
       (out '() (cons (make-button (car rest)
				   (cdr (assq (car rest) button-map))
				   point) out)))
      ((null rest) out)))


;; misc stuff

(define (rebuild-all)
  (rebuild-frames-with-style 'Greene2.0))

(define (reframe-all)
  (reframe-windows-with-style 'Greene2.0))

(define (color-changed)
  (recolor-all)
  (reframe-all))

(define (make-frame w frame buttons)
  (table-set button-table w buttons)
  (append frame
	  (make-buttons (car buttons) menu-button 'left-edge)
	  (make-buttons (reverse (cdr buttons)) button-background 'right-edge)))

(define (get-frame w type)
  (case type
    ((default)
	  (make-frame w normal-frame (button-theme 'normal)))
    ((transient)
     (make-frame w normal-frame (button-theme 'transient)))
    ((shaped)
     (make-frame w shaped-frame (button-theme 'normal)))
    ((shaped-transient)
     (make-frame w shaped-frame (button-theme 'transient)))))


;; initialization

(define initialize-gtkrc
  (let ((done nil))
    (lambda ()
      (unless done
	(require 'gtkrc)
	;; recolour everything when the GTK theme changes
	(gtkrc-call-after-changed color-changed)
	(setq done t)))))

;; setup the initial colours
(recolor-all)

;; register the theme
;; (add-frame-style 'Greene2.0-get-frame)
(add-frame-style 'Greene2.0 get-frame)

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