set rcsId {$Id: confint.tcl,v 2.2 2000/11/01 12:02:41 jfontain Exp $}


# minimalist composite widget configuration interface for widget testing and HTML live documentation with configuration applet

class configurationInterface {}

proc configurationInterface::configurationInterface {this parentPath args} composite {[new frame $parentPath] $args} {
    composite::manage $this [new frame $parentPath] top [new frame $parentPath -background black -height 1] separator
    pack $composite::($this,top,path) -fill both -expand 1
    pack $composite::($this,separator,path) -fill x
    composite::manage $this\
        [new listbox $composite::($this,top,path) -font {Helvetica -11 bold} -height 0 -selectmode single] names\
        [new frame $composite::($this,top,path) -background white -highlightbackground black -highlightthickness 1] container
    lappend composite::($this,tips) [new widgetTip -path $composite::($this,names,path) -text {select component(class)}]
    pack $composite::($this,names,path) -padx 2 -pady 2 -side left -anchor nw
    pack $composite::($this,container,path) -padx 2 -pady 2 -fill both -expand 1
    composite::manage $this [new scroller $parentPath -height 100] scroller
    pack $composite::($this,scroller,path) -pady 2 -fill both -expand 1
    lappend composite::($this,tips) [new widgetTip -path $composite::($this,scroller,path) -text {enter component options}]

    composite::complete $this
}

proc configurationInterface::~configurationInterface {this} {
    eval delete $composite::($this,tips)
}

proc configurationInterface::options {this} {}

proc configurationInterface::manage {this widget} {
    if {[info exists ($this,managed)]} {
        error "a widget \"$widget\" of class [classof $widget] is managed already"
    }
    set ($this,managed) $widget
    # build a list of widget names with parenthesized class (this represents the composite widget itself)
    set list this([string trimleft [classof $widget] :])
    foreach name [composite::componentNames $widget] {
        lappend list $name\([string trimleft [classof $composite::($widget,$name)] :]\)
    }
    set path $composite::($this,names,path)
    eval $path insert 0 $list
    $path selection set 0
    bind $path <ButtonRelease-1> "configurationInterface::update $this"
    bind $path <KeyRelease-space> "configurationInterface::update $this"
    update $this
}

proc configurationInterface::update {this} {
    set selection [$composite::($this,names,path) curselection]
    if {[llength $selection]==0} {
        return
    }
    scan [lindex [$composite::($this,names,path) get $selection] 0] {%[^(]} name                  ;# ignore parenthesized class name
    set managed $($this,managed)
    if {[string equal $name this]} {
        updateOptionEntries $this $managed
    } else {
        updateOptionEntries $this $composite::($managed,$name)
        ::update idletasks                                                                        ;# highlight component for a while
        flashHighlight $this $composite::($managed,$name,path)
    }
}

proc configurationInterface::updateOptionEntries {this widget {columns 2}} {
    if {[info exists ($this,entriesPath)]} {
        scroller::display $composite::($this,scroller) {}
        destroy $($this,entriesPath)
    }
    set ($this,entriesPath) [set frame [frame $composite::($this,scroller,path).entries]]
    set columns [expr {2*$columns}]
    set column 0
    set row 0
    foreach description [widget::configure $widget] {
        if {[llength $description]<2} {
            continue                                                                                     ;# skip abbreviated options
        }
        set option [string trimleft [lindex $description 0] -]
        set label [label $frame.${column}_$row -font {Helvetica -11} -text $option:]
        grid $label -column $column -row $row -sticky e
        incr column
        set entry [entry $frame.${column}_$row -width 12 -font {Helvetica -11 bold}]
        $entry insert 0 [widget::cget $widget -$option]
        bind $entry <Return> "
            $entry configure -background red
            ::update idletasks
            widget::configure $widget -$option \[$entry get\]
            $entry configure -background [$entry cget -background]
        "
        bind $entry <KP_Enter> [bind $entry <Return>]
        grid $entry -column $column -row $row -sticky ew
        if {[incr column]>=$columns} {
            set column 0
            incr row
        }
    }
    for {set column 1} {$column<$columns} {incr column 2} {                                   ;# make entries grow with parent frame
        grid columnconfigure $frame $column -weight 1
    }
    scroller::display $composite::($this,scroller) $frame
}

proc configurationInterface::flashHighlight {this path} {
    global highlightEvent

    if {[winfo exists .highlight]} {
        after cancel $highlightEvent
        destroy .highlight
    }
    toplevel .highlight -background {} -highlightthickness 1\
        -highlightbackground red -width [expr {[winfo width $path]+2}] -height [expr {[winfo height $path]+2}]
    wm overrideredirect .highlight 1
    wm geometry .highlight +[expr {[winfo rootx $path]-1}]+[expr {[winfo rooty $path]-1}]
    set highlightEvent [after 2000 {catch {destroy .highlight}}]
}

proc configurationInterface::container {this} {
    return $composite::($this,container,path)
}
