1
#| nokogiri-shell.jl -- shell displaying custom groups
3
$Id: shell.jl,v 1.21 2001/09/08 06:55:05 jsh Exp $
5
Copyright (C) 2000 John Harper <john@dcs.warwick.ac.uk>
7
This file is part of sawfish.
9
sawfish is free software; you can redistribute it and/or modify it
10
under the terms of the GNU General Public License as published by
11
the Free Software Foundation; either version 2, or (at your option)
14
sawfish is distributed in the hope that it will be useful, but
15
WITHOUT ANY WARRANTY; without even the implied warranty of
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17
GNU General Public License for more details.
19
You should have received a copy of the GNU General Public License
20
along with sawfish; see the file COPYING. If not, write to
21
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24
(define-structure sawfish.ui.shell
26
(export initialize-shell
45
(defvar *nokogiri-buttons* nil)
47
(defvar *nokogiri-flatten-groups* nil)
48
(defvar *nokogiri-single-level* nil)
51
(define group-tree-widget)
52
(define slot-box-widget)
54
(define active-slots '())
58
(define revert-widget)
59
(define cancel-widget)
61
(define (initialize-shell #!optional socket-id)
62
(let ((vbox (gtk-vbox-new nil box-spacing))
63
(hbox (gtk-hbutton-box-new))
64
(s-scroller (and (not socket-id) (gtk-scrolled-window-new)))
67
(setq main-window (if socket-id
68
(gtk-plug-new socket-id)
69
(gtk-window-new 'toplevel)))
72
(gtk-window-set-default-size main-window 400 300)
73
(setq root-container main-window))
74
(gtk-window-set-policy main-window nil t nil)
75
(gtk-window-set-default-size main-window 550 400)
76
(setq root-container (gtk-frame-new))
77
(gtk-frame-set-shadow-type root-container 'out)
78
(gtk-container-add main-window root-container))
80
(setq slot-box-widget (gtk-vbox-new nil box-spacing))
82
(gtk-container-border-width vbox box-border)
83
(gtk-container-border-width slot-box-widget box-border)
85
(gtk-scrolled-window-set-policy s-scroller 'automatic 'automatic)
86
(gtk-scrolled-window-add-with-viewport s-scroller slot-box-widget))
88
(let ((group (get-group top-group)))
90
(if (and (not *nokogiri-flatten-groups*)
91
(not *nokogiri-single-level*)
92
(group-sub-groups group))
93
(let ((paned (gtk-hpaned-new))
94
(g-scroller (gtk-scrolled-window-new)))
95
(setq group-tree-widget (make-group-tree (get-group top-group)))
96
(gtk-container-border-width group-tree-widget box-border)
97
(gtk-scrolled-window-set-policy g-scroller 'automatic 'automatic)
98
(gtk-container-add vbox paned)
99
(gtk-paned-add1 paned g-scroller)
100
(gtk-paned-add2 paned (or s-scroller slot-box-widget))
101
(gtk-paned-set-position paned 150)
102
(gtk-scrolled-window-add-with-viewport g-scroller
104
(gtk-container-add vbox (or s-scroller slot-box-widget))))
107
(setq ok-widget (stock-button 'ok))
108
(setq apply-widget (stock-button 'apply))
109
(setq revert-widget (stock-button 'revert))
110
(setq cancel-widget (stock-button 'cancel))
111
(gtk-window-set-title main-window (_ "Sawfish configurator"))
112
(gtk-widget-set-name main-window (_ "Sawfish configurator"))
113
(gtk-window-set-wmclass main-window "main" "Nokogiri"))
115
(gtk-signal-connect main-window "delete_event"
116
(if (not socket-id) on-quit capplet-delete-event))
119
(gtk-button-box-set-layout hbox 'end)
120
(gtk-box-pack-end vbox hbox)
121
(gtk-signal-connect ok-widget "clicked" on-ok)
122
(gtk-signal-connect apply-widget "clicked" on-apply)
123
(gtk-signal-connect cancel-widget "clicked" on-cancel)
124
(gtk-signal-connect revert-widget "clicked" on-revert)
125
(gtk-container-add hbox apply-widget)
126
(gtk-container-add hbox revert-widget)
127
(gtk-container-add hbox ok-widget)
128
(gtk-container-add hbox cancel-widget))
130
(gtk-container-add root-container vbox)
131
(gtk-widget-show-all main-window)
135
(setq *nokogiri-apply-immediately* nil)
136
(set-input-handler standard-input capplet-input)
137
(add-hook '*nokogiri-slot-changed-hook* capplet-state-changed))
139
(if group-tree-widget
141
(gtk-tree-select-item group-tree-widget 0)
142
(mapc gtk-tree-item-expand
143
(gtk-container-children group-tree-widget)))
144
(select-group (get-group top-group)))))
146
(define (destroy-shell)
148
(gtk-widget-destroy main-window)
149
(setq main-window nil)
150
(setq group-tree-widget nil)
151
(setq slot-box-widget nil)
153
(setq apply-widget nil)
154
(setq revert-widget nil)
155
(setq cancel-widget nil)))
159
(throw 'nokogiri-exit t))
170
(revert-slot-changes)
174
(revert-slot-changes)
177
(define (set-button-states)
178
(define (show-hide w state)
179
((if state gtk-widget-show gtk-widget-hide) w))
181
(show-hide apply-widget (eq *nokogiri-buttons* 'apply/revert/cancel/ok))
182
(gtk-widget-set-sensitive apply-widget (changes-to-apply-p)))
184
(show-hide revert-widget (memq *nokogiri-buttons*
186
apply/revert/cancel/ok)))
187
(gtk-widget-set-sensitive revert-widget (changes-to-revert-p)))
189
(gtk-widget-set-sensitive ok-widget (or (eq *nokogiri-buttons* 'ok)
191
(changes-to-revert-p))))
193
(show-hide cancel-widget (memq *nokogiri-buttons*
195
apply/revert/cancel/ok)))))
197
;;; displaying custom groups
199
(define (get-slots group)
201
(filter slot-is-appropriate-p (group-slots group)))
203
(define (display-flattened group)
205
(define (iter book group slots)
207
(let ((layout (layout-slots (group-layout group) slots)))
208
(setq active-slots (nconc active-slots slots))
209
(if (not *nokogiri-single-level*)
210
(gtk-notebook-append-page
211
book layout (gtk-label-new (_ (group-real-name group))))
212
(gtk-box-pack-start book layout))
213
(when (gtk-container-p layout)
214
(gtk-container-border-width layout box-border))))
217
(let ((slots (get-slots sub)))
218
(when (or slots (group-sub-groups group))
219
(iter book sub slots))))
220
(get-sub-groups group)))
222
(let ((notebook (if (not *nokogiri-single-level*)
223
(let ((x (gtk-notebook-new)))
224
(gtk-notebook-set-scrollable x 1)
225
(gtk-notebook-popup-enable x)
227
(gtk-vbox-new nil 0))))
228
(iter notebook group (get-slots group))
229
(gtk-widget-show notebook)
230
(gtk-container-add slot-box-widget notebook)))
232
(define (display-unflattened group)
233
(let* ((slots (get-slots group)))
235
slot-box-widget (layout-slots (group-layout group) slots))
236
(setq active-slots (nconc active-slots slots))))
238
(define (add-group-widgets group)
239
(if (and *nokogiri-flatten-groups* (group-sub-groups group))
240
(display-flattened group)
241
(display-unflattened group))
242
(update-all-dependences))
244
(define (remove-group-widgets group)
246
(let ((w (slot-gtk-widget s)))
247
(when (gtk-widget-parent w)
248
(gtk-container-remove (gtk-widget-parent w) w))
249
(set-slot-layout s nil))) active-slots)
250
(setq active-slots '())
252
(gtk-container-remove slot-box-widget w))
253
(gtk-container-children slot-box-widget)))
255
(define (run-shell #!optional socket-id)
257
(initialize-shell socket-id)
258
(catch 'nokogiri-exit
261
(add-hook '*nokogiri-slot-changed-hook* set-button-states t)
262
(add-hook '*nokogiri-group-selected-hook* add-group-widgets)
263
(add-hook '*nokogiri-group-deselected-hook* remove-group-widgets)
265
(define-config-item 'nokogiri-buttons
269
(setq *nokogiri-apply-immediately*
270
(memq *nokogiri-buttons*
271
'(ok revert/cancel/ok)))))
273
;;; capplet interfacing
275
;; called when there's input available on stdin
276
(define (capplet-input)
277
(let ((tem (read-line standard-input)))
280
(cond ((string-match "apply" tem) (on-apply))
281
((string-match "revert" tem) (on-revert))
282
((string-match "ok" tem) (on-ok))
283
((string-match "cancel" tem) (on-cancel)))
284
(write standard-output ?\001)
285
(flush-file standard-output))
288
(define (capplet-delete-event)
289
(gtk-widget-hide main-window)
290
(make-timer on-quit 10)
291
;; return t so no destroy - if the timer fires we'll destroy then
294
(define (capplet-state-changed)
295
(write standard-output ?c)
296
(flush-file standard-output))
298
(define (capplet-no-group)
299
(write standard-output ?g)
300
(flush-file standard-output)))
added
removed
lisp/sawfish/ui/shell.jl
