#
# Preferences chapter
#
# See also pref.exmh.tcl, on which this is based
#
source colormodel.tcl

proc Pref_Init { userDefaults appDefaults } {
	global pref

	set pref(uid) 0	;# for a unique identifier for widgets
	set pref(userDefaults) $userDefaults
	set pref(appDefaults) $appDefaults

	PrefReadFile $appDefaults startup
	if [file exists $userDefaults] {
	    PrefReadFile $userDefaults user
	}
}

proc PrefVar { item } { lindex $item 0 }
proc PrefXres { item } { lindex $item 1 }
proc PrefDefault { item } { lindex $item 2 }
proc PrefComment { item } { lindex $item 3 }
proc PrefHelp { item } { lindex $item 4 }

proc Pref_Add { prefs } {
	global pref
	append pref(items) $prefs
	foreach item $prefs {
		set varName [PrefVar $item]
		set xresName [PrefXres $item]
		set value [PrefValue $varName $xresName]
		if {$value == {}} {
			# Set variables that are still not set
			set default [PrefDefault $item]
			if {[llength $default] > 1} {
				if {[lindex $default 0] == "CHOICE"} {
					PrefValueSet $varName [lindex $default 1]
				} else {
					PrefValueSet $varName $default
				}
			} else {
				# Is it a boolean?
				if {$default == "OFF"} {
					PrefValueSet $varName 0
				} elseif {$default == "ON"} {
					PrefValueSet $varName 1
				} else {
					# This is a string or numeric
					PrefValueSet $varName $default
				}
			}
		}
	}
}

proc PrefValue { varName xres } {
	upvar #0 $varName var
	if [info exists var] {
		return $var
	}
	set var [option get . $xres {}]
}
proc PrefValueSet { varName value } {
	upvar #0 $varName var
	set var $value
}

proc Pref_Dialog {} {
	global pref
	if [catch {toplevel .pref}] {
		raise .pref
	} else {
		wm title .pref "Preferences"
		set buttons [frame .pref.but]
		pack .pref.but -side top -fill x
		button $buttons.quit -text Dismiss \
			-command {PrefDismiss}
		button $buttons.save -text Save \
			-command {PrefSave}
		button $buttons.reset -text Reset \
			-command {PrefReset ; PrefDismiss}
		label $buttons.label \
			 -text "Click labels for info on each item"
		pack $buttons.label -side left -fill x
		pack $buttons.quit $buttons.save $buttons.reset -side right

		frame .pref.b -borderwidth 2 -relief raised
		pack .pref.b -fill both
		set body [frame .pref.b.b -bd 10]
		pack .pref.b.b -fill both

		set maxWidth 0
		foreach item $pref(items) {
			set len [string length [PrefComment $item]]
			if {$len > $maxWidth} {
				set maxWidth $len
			}
		}
		foreach item $pref(items) {
			PrefDialogItem $body $item $maxWidth
		}
	}
}
proc PrefDialogItem { frame item width } {
	global pref
	incr pref(uid)
	set f [frame $frame.p$pref(uid) -borderwidth 2]
	pack $f -fill x
	label $f.label -text [PrefComment $item] -width $width
	bind $f.label <1> \
		[list PrefItemHelp %X %Y [PrefHelp $item]]
	pack $f.label -side left
	set default [PrefDefault $item]
	if {([llength $default] > 1) && 
		 ([lindex $default 0] == "CHOICE")} {
		foreach choice [lreplace $default 0 0] {
			incr pref(uid)
			radiobutton $f.c$pref(uid) -text $choice \
				-variable [PrefVar $item] \
				-value $choice
			pack $f.c$pref(uid) -side left
		}
	} else {
		if {$default == "OFF" || $default == "ON"} {
			# This is a boolean
			set varName [PrefVar $item]
			checkbutton $f.check -text "On" -variable $varName
			pack $f.check -side left
		} else {
			# This is a string or numeric
			entry $f.entry -width 10 -relief sunken
			pack $f.entry -side left -fill x -expand true
			set pref(entry,[PrefVar $item]) $f.entry
			set varName [PrefVar $item]
			$f.entry insert 0 [uplevel #0 [list set $varName]]
			bind $f.entry <Return> "PrefEntrySet %W $varName"
		}
	}
}
proc PrefEntrySet { entry varName } {
	PrefValueSet $varName [$entry get]
}
proc PrefItemHelp { x y text } {
	catch {destroy .prefitemhelp}
	if {$text == {}} {
		return
	}
	set self [toplevel .prefitemhelp -class Itemhelp]
	wm title $self "Item help" 
	wm geometry $self +[expr $x+10]+[expr $y+10]
	wm transient $self .pref
	message $self.msg -text $text -aspect 1500
	pack $self.msg
	bind $self.msg <1> {PrefNukeItemHelp .prefitemhelp}
	.pref.but.label configure -text \
		"Click on popup or another label"
}
proc PrefNukeItemHelp { t } {
	.pref.but.label configure -text \
		"Click labels for info on each item"
	destroy $t
}

proc PrefSave {} {
	global pref
	if [catch {
		set old [open $pref(userDefaults) r]
		set oldValues [split [read $old] \n]
		close $old
	}] {
		set oldValues {}
	}
	if [catch {open $pref(userDefaults).new w} out] {
		.pref.but.label configure -text \
		"Cannot save in $pref(userDefaults).new: $out"
		return
	}
	foreach line $oldValues {
		if {$line == \
				"!!! Lines below here automatically added"} {
			break
		} else {
			puts $out $line
		}
	}
	puts $out "!!! Lines below here automatically added"
	puts $out "!!! [exec date]"
	puts $out "!!! Do not edit below here"
	foreach item $preferences {
		set varName [PrefVar $item]
		set xresName [PrefXres $item]
		if [info exists pref(entry,$varName)] {
			PrefEntrySet $pref(entry,$varName) $varName
		}
		set value [PrefValue $varName $xresName]
		puts $out [format "%s	%s" *${xresName}: $value]
	}
	close $out
	set new [glob $pref(userDefaults).new]
	set old [file root $new]
	if [catch {exec mv $new $old} err] {
		Status "Cannot install $new: $err"
		return
	}
	PrefDismiss
}
proc PrefReset {} {
	global pref
	# Re-read user defaults
	option clear
	PrefReadFile $pref(appDefaults) startup
	PrefReadFile $pref(userDefaults) user
	# Clear variables
	set items $pref(items)
	set pref(items) {}
	foreach item $items {
		uplevel #0 [list unset [PrefVar $item]]
	}
	# Restore values
	Pref_Add $items
}
proc PrefReadFile { basename level } {
	if [catch {option readfile $basename $level} err] {
		Status "Error in $basename: $err"
	}
	if {[tk colormodel .] == "color"} {
		if [file exists $basename-color] {
			if [catch {option readfile $basename-color $level} err] {
				Status "Error in $basename-color: $err"
			}
		}
	} else {
		if [file exists $basename-mono] {
			if [catch {option readfile $basename-mono $level} err] {
				Status "Error in $basename-mono: $err"
			}
		}
	}
}

proc PrefDismiss {} {
	destroy .pref
	catch {destroy .prefitemhelp}
}
