# property.tcl
#
# Property sheets.  This uses a table-driven scheme to define and
# display property sheets.  Loosely based on the exmh preferences stuff.
#
proc PropName {item} {lindex $item 0}
proc PropType {item} {lindex $item 1}
proc PropDefault {item} {lindex $item 2}
proc PropLabel {item} {lindex $item 3}
proc PropHelp {item} {lindex $item 4}

proc Property_Add {name text props} {
    global prop

    # Set up the table that drives the UI layout
    if ![info exists prop(sheets)] {
	set prop(sheets) {}
    }
    set ix [lsearch $prop(sheets) $name]
    if {$ix < 0} {
	lappend prop(sheets) $name
    }
    set prop($name,props) $props
    set prop($name,text) $text
}

proc Property_Display {win command} {
    global prop
    upvar #0 Prop$win sheet
    set dialog $win.property

    set key [lindex $command 0]
    if ![info exists prop($key,props)] {
	tk_messageBox -type ok -message "No properties for $key" -icon error
	return
    }

    if [winfo exists $win.property] {
	if {$sheet(_complete) == 0} {
	    PropCancel $win
	    return ""	;# Unsafe to do anything but return
	}
	eval destroy [winfo children $dialog]
	wm deiconify $dialog
	raise $dialog
    } else {
	set f [toplevel $dialog -class Property -bd 4 -relief ridge]
	wm title $f "$key Properties"
	wm geometry $f +[winfo pointerx $win]+[winfo pointery $win]
	wm protocol $f WM_DELETE_WINDOW [list PropCancel $win]
    }
    set sheet(_complete) -1
    message $dialog.msg -text $prop($key,text) -aspect 500
    pack $dialog.msg -side top -fill x
    set body [frame $dialog.body -bd 4]
    set but [frame $dialog.but -bd 4]
    button $but.ok -text OK -command [list PropOk $win] -default true
    button $but.help -text Help -command [list PropShowHelp $win $key]
#    button $but.preview -text Preview -command [list PropPreview $win]
    button $but.cancel -text Cancel -command [list PropCancel $win]
    pack $but.ok $but.help $but.cancel -side left -padx 20
    pack $dialog.msg $dialog.body $dialog.but -side top -fill x
    pack $dialog.but -fill none

    # Pick off positional values from the existing command.

    set N [llength $command]
    set n 1
    foreach realarg [lrange $command $n end] item $prop($key,props) {
	set pname [PropName $item]
	if {[string match -* $pname]} {
	    break ;# Into named options
	}
	PropertyItem $win $n $body $item $realarg
	incr n
	if {$n > $N} {
	    break
	}
    }
    Stderr "n $n command $command"
    array set options [lrange $command $n end]

    # Pick off -option values

    foreach item $prop($key,props) {
	set pname [PropName $item]
	if ![string match -* $pname] {
	    continue
	}
	if [info exists options($pname)] {
	    PropertyItem $win [incr n] $body $item $options($pname)
	} else {
	    PropertyItem $win [incr n] $body $item [PropDefault $item]
	}
    }

    vwait Prop$win\(_complete)
    if {$sheet(_complete) > 0} {
	set command $key
	foreach item $prop($key,props) {
	    set pname [PropName $item]
	    set value $sheet(var,$pname)
	    if {[info exists sheet(prefix,$pname)]} {
		set value $sheet(prefix,$pname)$value
	    }
	    if {[info exists sheet(suffix,$pname)]} {
		append value $sheet(suffix,$pname)
	    }
	    if ![string match -* $pname] {
		lappend command $value
	    } else {
		if {[string compare $value [PropDefault $item]] != 0} {
		    lappend command $pname $value
		}
	    }
	}
    }
    return $command	;# Either orignal or a new one
}

proc PropertyItem {win n f item value} {

    # The property sheet interface is tied to this variable
    set varName Prop$win\(var,[PropName $item])
    upvar #0 $varName var
    set var $value

    label $f.l$n -text [PropLabel $item]  -anchor w
    set sticky w
    switch -glob -- [PropType $item] {
	enum* {
	    set it [frame $f.f$n]
	    foreach radio [lrange [PropType $item] 1 end] {
		radiobutton $f.f$n.r$radio -text $radio -variable $varName \
		    -value $radio
		pack $f.f$n.r$radio -side left -padx 2
	    }
	}
	boolean {
	    set it [checkbutton $f.bool$n -text On -variable $varName \
		    -command [list PropBooleanFixup $f.bool$n $varName]]
	    PropBooleanFixup $f.bool$n $varName
	}
	regexp {
	    set it [frame $f.f$n]
	    checkbutton $f.f$n.not -text Not \
		-variable Prop$win\(prefix,[PropName $item]) \
		-onvalue ! -offvalue {}
	    entry $f.f$n.text -textvariable $varName
	    pack $f.f$n.not -side left
	    pack $f.f$n.text -side top -fill x
	}
	mibleaf {
	    set it [button $f.b$n -textvariable $varName -command \
		    [list Mib_Select $varName leaf]]
	    set sticky we
	}
	mibname {
	    set it [button $f.b$n -textvariable $varName -command \
		    [list Mib_Select $varName]]
	    set sticky we
	}
	text -
	default {
	    set it [entry $f.text$n -textvariable $varName]
	    set sticky we
	}
    }
    grid $f.l$n $it
    grid $f.l$n -sticky we
    grid $it -sticky $sticky
}

proc PropBooleanFixup { check varName } {
    upvar #0 $varName var
    if {$var} {
	$check config -text On
    } else {
	$check config -text Off
    }
}

proc PropCancel {win} {
    upvar #0 Prop$win sheet
    set sheet(_complete) -1
    destroy $win.property
    catch {destroy $win.prophelp}
}
proc PropOk {win} {
    upvar #0 Prop$win sheet
    set sheet(_complete) 1
    destroy $win.property
    catch {destroy $win.prophelp}
}
proc PropShowHelp {win key} {
    global prop
    set dialog $win.prophelp
    if [winfo exists $dialog] {
	eval destroy [winfo children $dialog]
	wm deiconify $dialog
	raise $dialog
    } else {
	toplevel $dialog -class Property -bd 10
    }
    message $dialog.message -text "Help for $key" -aspect 1000 \
	-font {helvetica 18 bold}
    set t [text $dialog.t -width 60 -height 20 -wrap none\
	-yscrollcommand "$dialog.sy set"\
	-xscrollcommand "$dialog.sx set"]
    scrollbar $dialog.sx -orient horiz -command "$t xview"
    scrollbar $dialog.sy -orient vert -command "$t yview"
    grid $dialog.message -
    grid $t $dialog.sy		-sticky news
    grid $dialog.sx x		-sticky we
    grid columnconfigure $dialog 0 -weight 1
    grid rowconfigure $dialog 1 -weight 1

    $t tag configure heading -font {helvetica 14 bold}
    $t tag configure body -lmargin1 1c -lmargin2 1c
    foreach item $prop($key,props) {
	$t insert insert [PropLabel $item]\n heading
	$t insert insert "Type: [PropType $item]\n" body
	$t insert insert "Default: [PropDefault $item]\n" body
	$t insert insert "\n[PropHelp $item]\n\n" body
    }
}

