1
#| theme.jl for Arlo's new theme design
3
Copyright (C) 2001 Eazel, Inc.
5
This program is free software; you can redistribute it and/or
6
modify it under the terms of the GNU General Public License as
7
published by the Free Software Foundation; either version 2 of the
8
License, or (at your option) any later version.
10
This program is distributed in the hope that it will be useful,
11
but WITHOUT ANY WARRANTY; without even the implied warranty of
12
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13
General Public License for more details.
15
You should have received a copy of the GNU General Public License
16
along with this program; if not, write to the Free Software
17
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19
$Id: theme.jl,v 1.7 2001/05/01 19:44:46 jsh Exp $
21
Authors: John Harper <jsh@eazel.com>
24
(require 'rep.data.tables) ;need hash tables for icon cache
25
(require 'sawfish.wm.util.recolor-image)
27
(defgroup Crux "Crux Theme"
30
(defcustom Crux:normal-color nil
31
"Accent color for focused windows (if unset uses the GTK+ selection color)."
32
:type (optional color)
33
:group (appearance Crux)
35
:after-set (lambda () (color-changed)))
37
(defcustom Crux:show-window-icons nil
38
"Display the window's icon in its menu button."
40
:group (appearance Crux)
41
:after-set (lambda () (rebuild-all)))
43
(defvar Crux:button-themes '((default
45
. (iconify-button maximize-button shade-button)))
47
((close-button) . (maximize-button shade-button)))
49
((close-button maximize-button iconify-button)))
52
. (iconify-button maximize-button close-button))
55
((iconify-button) . (close-button))
56
((iconify-button) . (close-button)))))
59
(defcustom Crux:button-theme 'default
60
"Display title buttons to mimic: \\w"
61
;; XXX it would be better if the choices were extracted from
62
;; XXX the above alist somehow
63
:type (choice (default "Default")
64
(platinum "Mac OS Platinum")
66
(windows "MS Windows")
68
:group (appearance Crux)
69
:after-set (lambda () (reframe-all)))
71
;; maps WINDOW -> BUTTON-LIST
72
(define button-table (make-weak-table eq-hash eq))
78
(define top-left-border
79
(list (make-image "inactive:top-left-border.png")
80
(make-image "active:top-left-border.png")))
83
(define top-right-border
84
(list (make-image "inactive:top-right-border.png")
85
(make-image "active:top-right-border.png")))
88
(define top-center-left-border
89
(list (set-image-border
90
(make-image "inactive:top-center-left-border.png") 0 13 0 0)
92
(make-image "active:top-center-left-border.png") 0 13 0 0)))
95
(define top-center-right-border
96
(list (make-image "inactive:top-center-right-border.png")
97
(make-image "active:top-center-right-border.png")))
100
(define top-center-left
101
(list (make-image "inactive:top-center-left.png")
102
(make-image "active:top-center-left.png")))
105
(define top-center-mid
106
(list (make-image "inactive:top-center-mid.png")
107
(make-image "active:top-center-mid.png")))
110
(define top-center-right
111
(list (make-image "inactive:top-center-right.png")
112
(make-image "active:top-center-right.png")))
115
(define left-top-border
116
(list (make-image "inactive:left-top-border.png")
117
(make-image "active:left-top-border.png")))
118
(define left-top-border-shaped
119
(list (make-image "inactive:left-top-border-shaped.png")
120
(make-image "active:left-top-border-shaped.png")))
124
(list (make-image "inactive:left-border.png")
125
(make-image "active:left-border.png")))
128
(define right-top-border
129
(list (make-image "inactive:right-top-border.png")
130
(make-image "active:right-top-border.png")))
131
(define right-top-border-shaped
132
(list (make-image "inactive:right-top-border-shaped.png")
133
(make-image "active:right-top-border-shaped.png")))
137
(list (make-image "inactive:right-border.png")
138
(make-image "active:right-border.png")))
141
(define bottom-left-corner
142
(list (make-image "inactive:bottom-left-corner.png")
143
(make-image "active:bottom-left-corner.png")))
146
(define bottom-left-border
147
(list (set-image-border (make-image "inactive:bottom-left-border.png") 0 30 0 0)
148
(set-image-border (make-image "active:bottom-left-border.png") 0 30 0 0)))
151
(define bottom-right-border
152
(list (make-image "inactive:bottom-right-border.png")
153
(make-image "active:bottom-right-border.png")))
156
(define bottom-right-corner
157
(list (make-image "inactive:bottom-right-corner.png")
158
(make-image "active:bottom-right-corner.png")))
161
(define button-background
162
`((inactive . ,(make-image "inactive:button.png"))
163
(focused . ,(make-image "active:button.png"))
164
(inactive-highlighted . ,(make-image "inactive:button-hilight.png"))
165
(highlighted . ,(make-image "active:button-hilight.png"))
166
(inactive-clicked . ,(make-image "inactive:button-pressed.png"))
167
(clicked . ,(make-image "active:button-pressed.png"))))
169
`((inactive . ,(make-image "inactive:menu-button.png"))
170
(focused . ,(make-image "active:menu-button.png"))
171
(inactive-highlighted . ,(make-image "inactive:menu-button-hilight.png"))
172
(highlighted . ,(make-image "active:menu-button-hilight.png"))
173
(inactive-clicked . ,(make-image "inactive:menu-button-pressed.png"))
174
(clicked . ,(make-image "active:menu-button-pressed.png"))))
176
(let ((make-button-fg
177
(lambda (inactive active)
178
`((inactive . ,inactive)
180
(inactive-highlighted . ,active)
181
(highlighted . ,active)
182
(inactive-clicked . ,active)
183
(clicked . ,active)))))
186
(make-button-fg (make-image "inactive:minimize-button.png")
187
(make-image "active:minimize-button.png")))
189
(make-button-fg (make-image "inactive:maximize-button.png")
190
(make-image "active:maximize-button.png")))
192
(make-button-fg (make-image "inactive:close-button.png")
193
(make-image "active:close-button.png")))
195
(make-button-fg (make-image "inactive:shade-button.png")
196
(make-image "active:shade-button.png"))))
199
;; geometry computations
201
(define (title-left-width w)
202
(let ((buttons (table-ref button-table w)))
203
(max 0 (min (- (car (window-dimensions w))
204
(* (length (cdr buttons)) 18))
205
(+ (text-width (window-name w)) 52
206
(* (length (car buttons)) 18))))))
208
(define (top-border-left-width w)
209
(let ((buttons (table-ref button-table w)))
210
(max 0 (min (- (car (window-dimensions w)) (* (length (cdr buttons)) 18))
211
(+ (title-left-width w) -43)))))
213
(define (bottom-border-left-width w)
214
(max 0 (min (car (window-dimensions w))
215
(+ (title-left-width w)
216
(quotient (cdr (window-dimensions w)) 2)))))
218
(define (vertical-justification)
219
;; `center' justification adjusted for the 3-pixel top-border
220
(max 0 (- (/ (- 22 (font-height default-font)) 2) 3)))
222
(define (horizontal-justification w)
223
(+ (* (length (car (table-ref button-table w))) 18) 2))
226
;; recolouring images
228
(define (foreground-color)
229
(if (colorp Crux:normal-color)
232
(if (colorp (nth 3 gtkrc-background))
233
(nth 3 gtkrc-background)
234
(get-color "steelblue"))))
236
;; Recolor all images that need recolouring. Precalculates the lookup
238
(define (recolor-all)
239
;; Use the SELECTED state of the background colors as the
240
;; midpoint of the gradient for recolouring images. (This is
241
;; usually a bright, contrasting colour, and thus is the
242
;; best choice. It works particularly well with the Eazel-Foo
244
(let ((recolorer (make-image-recolorer (foreground-color)
245
#:zero-channel blue-channel
246
#:index-channel green-channel)))
247
(mapc (lambda (x) (mapc recolorer (cdr x)))
248
(list top-left-border
249
top-center-left-border
253
left-top-border-shaped
258
(recolorer (cdr x))) menu-button)))
263
(define icon-table (make-weak-table eq-hash eq))
265
(define (window-icon w)
266
(when Crux:show-window-icons
267
(or (table-ref icon-table w)
268
(let ((icon (window-icon-image w)))
270
(let ((scaled (scale-image icon 12 12)))
271
(table-set icon-table w scaled)
277
(define common-frame-parts
278
`(((background . ,top-left-border)
281
(class . top-left-corner))
283
((background . ,top-center-left-border)
286
(width . ,top-border-left-width)
287
(class . top-border))
288
((background . ,top-center-right-border)
289
(left-edge . ,(lambda (w) (+ (top-border-left-width w) 11)))
292
(class . top-border))
294
((background . ,top-center-left)
296
(width . ,(lambda (w) (+ (title-left-width w) 2 -48)))
298
(text . ,window-name)
299
(foreground . ("grey95" "white"))
300
(x-justify . ,horizontal-justification)
301
(y-justify . ,vertical-justification)
303
((background . ,top-center-mid)
304
(left-edge . ,(lambda (w) (max 0 (- (title-left-width w) 48))))
307
((background . ,top-center-right)
308
(left-edge . ,title-left-width)
313
((background . ,top-right-border)
316
(class . top-right-corner))))
319
`(,@common-frame-parts
321
((background . ,left-top-border)
324
(class . top-left-corner))
325
((background . ,right-top-border)
328
(class . top-right-corner))
330
((background . ,left-border)
334
(class . left-border))
336
((background . ,bottom-left-corner)
339
(class . bottom-left-corner))
341
((background . ,right-border)
345
(class . right-border))
347
((background . ,bottom-right-corner)
350
(class . bottom-right-corner))
352
((background . ,bottom-left-border)
354
(width . ,bottom-border-left-width)
356
(class . bottom-border))
357
((background . ,bottom-right-border)
358
(left-edge . ,bottom-border-left-width)
361
(class . bottom-border))))
364
`(,@common-frame-parts
366
((background . ,left-top-border-shaped)
369
(class . top-left-corner))
370
((background . ,right-top-border-shaped)
373
(class . top-right-corner))))
379
`((iconify-button . ,minimize-fg)
380
(maximize-button . ,maximize-fg)
381
(close-button . ,close-fg)
382
(menu-button . ,window-icon)
383
(shade-button . ,shade-fg)))
385
(define (button-theme type)
386
(let ((style (cdr (or (assq Crux:button-theme Crux:button-themes)
387
(assq 'default Crux:button-themes)))))
388
(if (eq type 'transient)
392
(define (make-buttons spec background edge)
394
(define (make-button class fg point)
395
`((background . ,background)
403
(do ((rest spec (cdr rest))
404
(point -1 (+ point 18))
405
(out '() (cons (make-button (car rest)
406
(cdr (assq (car rest) button-map))
413
(define (rebuild-all)
414
(rebuild-frames-with-style 'Crux))
416
(define (reframe-all)
417
(reframe-windows-with-style 'Crux))
419
(define (color-changed)
423
(define (make-frame w frame buttons)
424
(table-set button-table w buttons)
426
(make-buttons (car buttons) menu-button 'left-edge)
427
(make-buttons (reverse (cdr buttons)) button-background 'right-edge)))
429
(define (get-frame w type)
432
(make-frame w normal-frame (button-theme 'normal)))
434
(make-frame w normal-frame (button-theme 'transient)))
436
(make-frame w shaped-frame (button-theme 'normal)))
438
(make-frame w shaped-frame (button-theme 'transient)))))
443
(define initialize-gtkrc
448
;; recolour everything when the GTK theme changes
449
(gtkrc-call-after-changed color-changed)
452
;; setup the initial colours
455
;; register the theme
456
(add-frame-style 'Crux get-frame)
458
;; recalibrate frames when the window-name changes
459
(call-after-property-changed 'WM_NAME rebuild-frame)
added
removed
themes/Crux/theme.jl
