view release on metacpan or  search on metacpan

demos/biglist.tcl  view on Meta::CPAN

}

proc DemoBigList::NewWindow {T I} {
    variable Priv

    # Check the list of unused windows
    if {[llength $Priv(freeWindows)]} {
	set w [lindex $Priv(freeWindows) 0]
	set Priv(freeWindows) [lrange $Priv(freeWindows) 1 end]
	if {$::clip} {
	    set f $w
	    set w [lindex [winfo children $f] 0]
	}

	if {$Priv(noise)} { dbwin "reuse window $w" }

    # No unused windows exist. Create a new one.
    } else {
	set id [incr Priv(nextWindowId)]
	if {$::clip} {
	    set f [frame $T.clip$id -background blue]
	    set w [frame $f.frame$id -background $Priv(bg)]
	} else {
	    set w [frame $T.frame$id -background $Priv(bg)]
	}
	# Name: label + entry
	label $w.label1 -text "Name:" -anchor w -background $Priv(bg)
	$::entryCmd $w.entry1 -width 24

	# Threat Level: label + menubutton
	label $w.label2 -text "Threat Level:" -anchor w -background $Priv(bg)
	if {$::tile} {
	    ttk::combobox $w.mb2 -values {Severe High Elevated Guarded Low} \
		-state readonly -width [string length "Elevated"]
	} else {
	    menubutton $w.mb2 -indicatoron yes -menu $w.mb2.m \
		-width [string length Elevated] -relief raised
	    menu $w.mb2.m -tearoff no
	    foreach label {Severe High Elevated Guarded Low} {
		$w.mb2.m add radiobutton -label $label \
		    -value $label \
		    -command [list $w.mb2 configure -text $label]
	    }
	}

	# Button
	set message \
	    "After abducting and probing these people over the last\n\
	    50 years, the only thing we've learned for certain is that\n\
	    one in ten just doesn't seem to mind."
	if {$::thisPlatform ne "windows"} {
	    set message [string map {\n ""} $message]
	}
	$::buttonCmd $w.b3 -text "Anal Probe Wizard..." -command [list tk_messageBox \
	    -parent . -message $message -title "Anal Probe 2.0"]

	grid $w.label1 -row 0 -column 0 -sticky w -padx {0 8}
	grid $w.entry1 -row 0 -column 1 -sticky w -pady 4
	grid $w.label2 -row 1 -column 0 -sticky w -padx {0 8}
	grid $w.mb2 -row 1 -column 1 -sticky w -pady 4
	grid $w.b3 -row 3 -column 0 -columnspan 2 -sticky we -pady {0 4}

	AddBindTag $w DemoBigListChildWindow
	AddBindTag $w TagIdentify

	if {$Priv(noise)} { dbwin "create window $w" }
    }

    # Tie the widgets to the global variables for this citizen
    $w.entry1 configure -textvariable ::DemoBigList::Priv(name,$I)
    $w.mb2 configure -textvariable ::DemoBigList::Priv(threat,$I)
    if {!$::tile} {
	foreach label {Severe High Elevated Guarded Low} {
	    $w.mb2.m entryconfigure $label -variable ::DemoBigList::Priv(threat,$I)
	}
    }
    if {$::clip} { return $f }
    return $w
}

proc DemoBigList::FreeWindow {T w} {
    variable Priv

    # Add the window to our list of free windows. DemoClear will actually
    # delete the window when the demo changes.
    lappend Priv(freeWindows) $w
    if {$Priv(noise)} { dbwin "free window $w" }
    return
}

proc DemoBigList::Button1 {w x y} {
    variable ::TreeCtrl::Priv
    focus $w
    $w identify -array id $x $y
    set Priv(buttonMode) ""
    if {$id(where) eq "header"} {
	TreeCtrl::ButtonPress1 $w $x $y
    } elseif {$id(where) eq "item"} {
	set item $id(item)
	# click a button
	if {$id(element) eq ""} {
	    TreeCtrl::ButtonPress1 $w $x $y
	    return
	}
	if {[$w item tag expr $item !info]} {
	    $w item toggle $item
	}
    }
    return
}

proc DemoBigList::Motion {w x y} {
    variable Priv
    $w identify -array id $x $y
    if {$id(where) eq "item"} {
	set item $id(item)
	if {[$w item tag expr $item !info]} {
	    if {$item ne $Priv(prev)} {
		$w configure -cursor hand2
		set Priv(prev) $item
	    }