Update tk to version 8.5.13
[msysgit.git] / mingw / lib / tk8.5 / demos / ixset
blobf9c46eb42ddce7693d9fffd4f791fc12783110cc
1 #!/bin/sh
2 # the next line restarts using wish \
3 exec wish85 "$0" ${1+"$@"}
5 # ixset --
6 # A nice interface to "xset" to change X server settings
8 # History :
9 # 91/11/23 : pda@masi.ibp.fr, jt@ratp.fr : design
10 # 92/08/01 : pda@masi.ibp.fr : cleaning
12 package require Tcl 8.4
13 package require Tk
16 # Button actions
19 proc quit {} {
20 destroy .
23 proc ok {} {
24 writesettings
25 quit
28 proc cancel {} {
29 readsettings
30 dispsettings
31 .buttons.apply configure -state disabled
32 .buttons.cancel configure -state disabled
35 proc apply {} {
36 writesettings
37 .buttons.apply configure -state disabled
38 .buttons.cancel configure -state disabled
42 # Read current settings
45 proc readsettings {} {
46 global kbdrep ; set kbdrep "on"
47 global kbdcli ; set kbdcli 0
48 global bellvol ; set bellvol 100
49 global bellpit ; set bellpit 440
50 global belldur ; set belldur 100
51 global mouseacc ; set mouseacc "3/1"
52 global mousethr ; set mousethr 4
53 global screenbla ; set screenbla "blank"
54 global screentim ; set screentim 600
55 global screencyc ; set screencyc 600
57 set xfd [open "|xset q" r]
58 while {[gets $xfd line] > -1} {
59 switch -- [lindex $line 0] {
60 auto {
61 set rpt [lindex $line 1]
62 if {$rpt eq "repeat:"} {
63 set kbdrep [lindex $line 2]
64 set kbdcli [lindex $line 6]
67 bell {
68 set bellvol [lindex $line 2]
69 set bellpit [lindex $line 5]
70 set belldur [lindex $line 8]
72 acceleration: {
73 set mouseacc [lindex $line 1]
74 set mousethr [lindex $line 3]
76 prefer {
77 set bla [lindex $line 2]
78 set screenbla [expr {$bla eq "yes" ? "blank" : "noblank"}]
80 timeout: {
81 set screentim [lindex $line 1]
82 set screencyc [lindex $line 3]
86 close $xfd
88 # puts stdout [format "Key REPEAT = %s\n" $kbdrep]
89 # puts stdout [format "Key CLICK = %s\n" $kbdcli]
90 # puts stdout [format "Bell VOLUME = %s\n" $bellvol]
91 # puts stdout [format "Bell PITCH = %s\n" $bellpit]
92 # puts stdout [format "Bell DURATION = %s\n" $belldur]
93 # puts stdout [format "Mouse ACCELERATION = %s\n" $mouseacc]
94 # puts stdout [format "Mouse THRESHOLD = %s\n" $mousethr]
95 # puts stdout [format "Screen BLANCK = %s\n" $screenbla]
96 # puts stdout [format "Screen TIMEOUT = %s\n" $screentim]
97 # puts stdout [format "Screen CYCLE = %s\n" $screencyc]
102 # Write settings into the X server
105 proc writesettings {} {
106 global kbdrep kbdcli bellvol bellpit belldur
107 global mouseacc mousethr screenbla screentim screencyc
109 set bellvol [.bell.vol get]
110 set bellpit [.bell.val.pit.entry get]
111 set belldur [.bell.val.dur.entry get]
113 if {$kbdrep eq "on"} {
114 set kbdcli [.kbd.val.cli get]
115 } else {
116 set kbdcli "off"
119 set mouseacc [.mouse.hor.acc.entry get]
120 set mousethr [.mouse.hor.thr.entry get]
122 set screentim [.screen.tim.entry get]
123 set screencyc [.screen.cyc.entry get]
125 exec xset \
126 b $bellvol $bellpit $belldur \
127 c $kbdcli \
128 r $kbdrep \
129 m $mouseacc $mousethr \
130 s $screentim $screencyc \
131 s $screenbla
136 # Sends all settings to the window
139 proc dispsettings {} {
140 global kbdrep kbdcli bellvol bellpit belldur
141 global mouseacc mousethr screenbla screentim screencyc
143 .bell.vol set $bellvol
144 .bell.val.pit.entry delete 0 end
145 .bell.val.pit.entry insert 0 $bellpit
146 .bell.val.dur.entry delete 0 end
147 .bell.val.dur.entry insert 0 $belldur
149 .kbd.val.onoff [expr {$kbdrep eq "on" ? "select" : "deselect"}]
150 .kbd.val.cli set $kbdcli
152 .mouse.hor.acc.entry delete 0 end
153 .mouse.hor.acc.entry insert 0 $mouseacc
154 .mouse.hor.thr.entry delete 0 end
155 .mouse.hor.thr.entry insert 0 $mousethr
157 .screen.blank [expr {$screenbla eq "blank" ? "select" : "deselect"}]
158 .screen.pat [expr {$screenbla ne "blank" ? "select" : "deselect"}]
159 .screen.tim.entry delete 0 end
160 .screen.tim.entry insert 0 $screentim
161 .screen.cyc.entry delete 0 end
162 .screen.cyc.entry insert 0 $screencyc
167 # Create all windows, and pack them
170 proc labelentry {path text length {range {}}} {
171 frame $path
172 label $path.label -text $text
173 if {[llength $range]} {
174 spinbox $path.entry -width $length -relief sunken \
175 -from [lindex $range 0] -to [lindex $range 1]
176 } else {
177 entry $path.entry -width $length -relief sunken
179 pack $path.label -side left
180 pack $path.entry -side right -expand y -fill x
183 proc createwindows {} {
185 # Buttons
188 frame .buttons
189 button .buttons.ok -default active -command ok -text "Ok"
190 button .buttons.apply -default normal -command apply -text "Apply" \
191 -state disabled
192 button .buttons.cancel -default normal -command cancel -text "Cancel" \
193 -state disabled
194 button .buttons.quit -default normal -command quit -text "Quit"
196 pack .buttons.ok .buttons.apply .buttons.cancel .buttons.quit \
197 -side left -expand yes -pady 5
199 bind . <Return> {.buttons.ok flash; .buttons.ok invoke}
200 bind . <Escape> {.buttons.quit flash; .buttons.quit invoke}
201 bind . <1> {
202 if {![string match .buttons* %W]} {
203 .buttons.apply configure -state normal
204 .buttons.cancel configure -state normal
207 bind . <Key> {
208 if {![string match .buttons* %W]} {
209 switch -glob %K {
210 Return - Escape - Tab - *Shift* {}
211 default {
212 .buttons.apply configure -state normal
213 .buttons.cancel configure -state normal
220 # Bell settings
223 labelframe .bell -text "Bell Settings" -padx 1.5m -pady 1.5m
224 scale .bell.vol \
225 -from 0 -to 100 -length 200 -tickinterval 20 \
226 -label "Volume (%)" -orient horizontal
228 frame .bell.val
229 labelentry .bell.val.pit "Pitch (Hz)" 6 {25 20000}
230 labelentry .bell.val.dur "Duration (ms)" 6 {1 10000}
231 pack .bell.val.pit -side left -padx 5
232 pack .bell.val.dur -side right -padx 5
233 pack .bell.vol .bell.val -side top -expand yes
236 # Keyboard settings
239 labelframe .kbd -text "Keyboard Repeat Settings" -padx 1.5m -pady 1.5m
241 frame .kbd.val
242 checkbutton .kbd.val.onoff \
243 -text "On" \
244 -onvalue "on" -offvalue "off" -variable kbdrep \
245 -relief flat
246 scale .kbd.val.cli \
247 -from 0 -to 100 -length 200 -tickinterval 20 \
248 -label "Click Volume (%)" -orient horizontal
249 pack .kbd.val.onoff -side left -fill x -expand yes -padx {0 1m}
250 pack .kbd.val.cli -side left -expand yes -fill x -padx {1m 0}
252 pack .kbd.val -side top -expand yes -pady 2 -fill x
255 # Mouse settings
258 labelframe .mouse -text "Mouse Settings" -padx 1.5m -pady 1.5m
260 frame .mouse.hor
261 labelentry .mouse.hor.acc "Acceleration" 5
262 labelentry .mouse.hor.thr "Threshold (pixels)" 3 {1 2000}
264 pack .mouse.hor.acc -side left -padx {0 1m}
265 pack .mouse.hor.thr -side right -padx {1m 0}
267 pack .mouse.hor -side top -expand yes
270 # Screen Saver settings
273 labelframe .screen -text "Screen-saver Settings" -padx 1.5m -pady 1.5m
275 radiobutton .screen.blank \
276 -variable screenblank -text "Blank" -relief flat \
277 -value "blank" -variable screenbla -anchor w
278 radiobutton .screen.pat \
279 -variable screenblank -text "Pattern" -relief flat \
280 -value "noblank" -variable screenbla -anchor w
281 labelentry .screen.tim "Timeout (s)" 5 {1 100000}
282 labelentry .screen.cyc "Cycle (s)" 5 {1 100000}
284 grid .screen.blank .screen.tim -sticky e
285 grid .screen.pat .screen.cyc -sticky e
286 grid configure .screen.blank .screen.pat -sticky ew
289 # Main window
292 pack .buttons -side top -fill both
293 pack .bell .kbd .mouse .screen -side top -fill both -expand yes \
294 -padx 1m -pady 1m
297 # Let the user resize our window
299 wm minsize . 10 10
302 ##############################################################################
303 # Main program
306 # Listen what "xset" tells us...
309 readsettings
312 # Create all windows
315 createwindows
318 # Write xset parameters
321 dispsettings
324 # Now, wait for user actions...
327 # Local Variables:
328 # mode: tcl
329 # End: