let bundled tcl compile with recent tools

[micropolis] / src / tk / library / demos / ixset

#!/usr/local/bin/wish -f

#
# A nice interface to "xset" to change X server settings
#
# History :
#   91/11/23 : pda@masi.ibp.fr, jt@ratp.fr : design
#   92/08/01 : pda@masi.ibp.fr : cleaning
#

#
# Button actions
#

proc quit {} {
    destroy .
}

proc ok {} {
    writesettings
    quit
}

proc cancel {} {
    readsettings
    dispsettings
}

# apply is just "writesettings"


#
# Read current settings
#

proc readsettings {} {
    global kbdrep ;	set kbdrep	"on"
    global kbdcli ;	set kbdcli	0
    global bellvol ;	set bellvol	100
    global bellpit ;	set bellpit	440
    global belldur ;	set belldur	100
    global mouseacc ;	set mouseacc	"3/1"
    global mousethr ;	set mousethr	4
    global screenbla ;	set screenbla	"blank"
    global screentim ;	set screentim	600
    global screencyc ;	set screencyc	600

    set xfd [open "|xset q" r]
    while {[gets $xfd line] > -1} {
	set kw [lindex $line 0]

	case $kw in {
	    {auto}
		{
		    set rpt [lindex $line 1]
		    if {[expr "{$rpt} == {repeat:}"]} then {
			set kbdrep [lindex $line 2]
			set kbdcli [lindex $line 6]
		    }
		}
	    {bell}
		{
		    set bellvol [lindex $line 2]
		    set bellpit [lindex $line 5]
		    set belldur [lindex $line 8]
		}
	    {acceleration:}
		{
		    set mouseacc [lindex $line 1]
		    set mousethr [lindex $line 3]
		}
	    {prefer}
		{
		    set bla [lindex $line 2]
		    set screenbla [expr "{$bla} == {yes} ? {blank} : {noblank}"]
		}
	    {timeout:}
		{
		    set screentim [lindex $line 1]
		    set screencyc [lindex $line 3]
		}
	}
    }
    close $xfd

    # puts stdout [format "Key REPEAT = %s\n" $kbdrep]
    # puts stdout [format "Key CLICK  = %s\n" $kbdcli]
    # puts stdout [format "Bell VOLUME = %s\n" $bellvol]
    # puts stdout [format "Bell PITCH = %s\n" $bellpit]
    # puts stdout [format "Bell DURATION = %s\n" $belldur]
    # puts stdout [format "Mouse ACCELERATION = %s\n" $mouseacc]
    # puts stdout [format "Mouse THRESHOLD = %s\n" $mousethr]
    # puts stdout [format "Screen BLANCK = %s\n" $screenbla]
    # puts stdout [format "Screen TIMEOUT = %s\n" $screentim]
    # puts stdout [format "Screen CYCLE = %s\n" $screencyc]
}


#
# Write settings into the X server
#

proc writesettings {} {
    global kbdrep kbdcli  bellvol bellpit belldur
    global mouseacc mousethr  screenbla screentim screencyc

    set bellvol		[.bell.vol get]
    set bellpit		[.bell.val.pit.entry get]
    set belldur		[.bell.val.dur.entry get]

    if {[expr "{$kbdrep} == {on}"]} then {
	set kbdcli	[.kbd.val.cli get]
    } else {
	set kbdcli	"off"
    }

    set mouseacc	[.mouse.hor.acc.entry get]
    set mousethr	[.mouse.hor.thr.entry get]

    set screentim	[.screen.val.le.tim.entry get]
    set screencyc	[.screen.val.le.cyc.entry get]

    exec xset \
	b $bellvol $bellpit $belldur \
	c $kbdcli \
	r $kbdrep \
	m $mouseacc $mousethr \
	s $screentim $screencyc \
	s $screenbla
}


#
# Sends all settings to the window
#

proc dispsettings {} {
    global kbdrep kbdcli  bellvol bellpit belldur
    global mouseacc mousethr  screenbla screentim screencyc

    .bell.vol set $bellvol
    .bell.val.pit.entry delete 0 end
    .bell.val.pit.entry insert 0 $bellpit
    .bell.val.dur.entry delete 0 end
    .bell.val.dur.entry insert 0 $belldur

    .kbd.val.onoff [expr "{$kbdrep} == {on} ? {select} : {deselect}"]
    .kbd.val.cli set $kbdcli

    .mouse.hor.acc.entry delete 0 end
    .mouse.hor.acc.entry insert 0 $mouseacc
    .mouse.hor.thr.entry delete 0 end
    .mouse.hor.thr.entry insert 0 $mousethr

    .screen.val.rb.blank [expr "{$screenbla}=={blank} ? {select} : {deselect}"]
    .screen.val.rb.pat   [expr "{$screenbla}!={blank} ? {select} : {deselect}"]
    .screen.val.le.tim.entry delete 0 end
    .screen.val.le.tim.entry insert 0 $screentim
    .screen.val.le.cyc.entry delete 0 end
    .screen.val.le.cyc.entry insert 0 $screencyc
}


#
# Create all windows, and pack them
#

proc labelentry {path text length} {
    frame $path
    label $path.label -text $text
    entry $path.entry -width $length -relief sunken
    pack append $path $path.label {left expand} $path.entry {right expand}
}

proc createwindows {} {
    #
    # Buttons
    #

    frame .buttons
    button .buttons.ok		-command "ok"			-text "Ok"
    button .buttons.apply	-command "writesettings"	-text "Apply"
    button .buttons.cancel	-command "cancel"		-text "Cancel"
    button .buttons.quit	-command "quit"			-text "Quit"

    pack append .buttons \
	    .buttons.ok		{left expand pady 10} \
	    .buttons.apply	{left expand pady 10} \
	    .buttons.cancel	{left expand pady 10} \
	    .buttons.quit	{left expand pady 10}

    #
    # Bell settings
    #

    frame .bell -relief raised -borderwidth 2
    label .bell.label	-text "Bell Settings"
    scale .bell.vol \
	    -from 0 -to 100 -length 200 -tickinterval 20 \
	    -label "Volume (%)" -orient horizontal \
	    -bg Bisque1 -activeforeground Gray

    frame .bell.val
    labelentry .bell.val.pit "Pitch (Hz)"    6
    labelentry .bell.val.dur "Duration (ms)" 6
    pack append .bell.val \
	    .bell.val.pit	{left padx 10} \
	    .bell.val.dur	{right padx 10}

    pack append .bell \
	    .bell.label		{top expand} \
	    .bell.vol		{top expand} \
	    .bell.val		{top expand}

    #
    # Keyboard settings
    #

    frame .kbd -relief raised -borderwidth 2

    label .kbd.label -text "Keyboard Repeat Settings"

    frame .kbd.val
    checkbutton .kbd.val.onoff \
	    -text "On" \
	    -onvalue "on" -offvalue "off" -variable kbdrep \
	    -relief flat \
	    -activebackground Bisque1
    scale .kbd.val.cli \
	    -from 0 -to 100 -length 200 -tickinterval 20 \
	    -label "Click Volume (%)" -orient horizontal \
	    -bg Bisque1 -activeforeground Gray
    pack append .kbd.val \
	    .kbd.val.onoff	{left expand fill} \
	    .kbd.val.cli	{left expand}

    pack append .kbd \
	    .kbd.label		{top expand} \
	    .kbd.val		{top expand pady 4 fillx}

    #
    # Mouse settings
    #

    frame .mouse -relief raised -borderwidth 2

    label .mouse.label -text "Mouse Settings"
    frame .mouse.hor
    labelentry .mouse.hor.acc "Acceleration" 3
    labelentry .mouse.hor.thr "Threshold (pixels)" 3

    pack append .mouse.hor \
	    .mouse.hor.acc	{left} \
	    .mouse.hor.thr	{right}

    pack append .mouse \
	    .mouse.label	{top} \
	    .mouse.hor		{top expand}

    #
    # Screen Saver settings
    #

    frame .screen -relief raised -borderwidth 2

    label .screen.label -text "Screen-saver Settings"
    frame .screen.val

    frame .screen.val.rb
    radiobutton .screen.val.rb.blank \
	    -variable screenblank -text "Blank" -relief flat \
	    -value "blank" -variable screenbla \
	    -activebackground Bisque1
    radiobutton .screen.val.rb.pat \
	    -variable screenblank -text "Pattern" -relief flat \
	    -value "noblank" -variable screenbla \
	    -activebackground Bisque1
    pack append .screen.val.rb \
	    .screen.val.rb.blank	{top pady 4 frame w} \
	    .screen.val.rb.pat	{top pady 4 frame w}
    frame .screen.val.le
    labelentry .screen.val.le.tim "Timeout (s)" 5
    labelentry .screen.val.le.cyc "Cycle (s)" 5
    pack append .screen.val.le \
	    .screen.val.le.tim	{top pady 4 frame e} \
	    .screen.val.le.cyc	{top pady 4 frame e}

    pack append .screen.val \
	    .screen.val.rb	{left} \
	    .screen.val.le	{left}

    pack append .screen \
	    .screen.label	{top} \
	    .screen.val		{top expand}

    #
    # Main window
    #

    pack append . \
	    .buttons	{top fill} \
	    .bell	{top fill pady 10 expand} \
	    .kbd	{top fill pady 10 expand} \
	    .mouse	{top fill pady 10 expand} \
	    .screen	{top fill pady 10 expand}

    #
    # Let the user resize our window
    #
    wm minsize . 10 10
}

##############################################################################
# Main program

#
# Listen what "xset" tells us...
#

readsettings

#
# Create all windows
#

createwindows

#
# Write xset parameters
#

dispsettings

#
# Now, wait for user actions...
#