# tkfbox.tcl --##	Implements the "TK" standard file selection dialog box. This#	dialog box is used on the Unix platforms whenever the tk_strictMotif#	flag is not set.##	The "TK" standard file selection dialog box is similar to the#	file selection dialog box on Win95(TM). The user can navigate#	the directories by clicking on the folder icons or by#	selectinf the "Directory" option menu. The user can select#	files by clicking on the file icons or by entering a filename#	in the "Filename:" entry.## SCCS: @(#) tkfbox.tcl 1.12 97/07/22 15:19:55## Copyright (c) 1994-1996 Sun Microsystems, Inc.## See the file "license.terms" for information on usage and redistribution# of this file, and for a DISCLAIMER OF ALL WARRANTIES.##----------------------------------------------------------------------##		      I C O N   L I S T## This is a pseudo-widget that implements the icon list inside the # tkFDialog dialog box.##----------------------------------------------------------------------# tkIconList --##	Creates an IconList widget.#proc tkIconList {w args} {    upvar #0 $w data    tkIconList_Config $w $args    tkIconList_Create $w}# tkIconList_Config --##	Configure the widget variables of IconList, according to the command#	line arguments.#proc tkIconList_Config {w argList} {    upvar #0 $w data    # 1: the configuration specs    #    set specs {	{-browsecmd "" "" ""}	{-command "" "" ""}    }    # 2: parse the arguments    #    tclParseConfigSpec $w $specs "" $argList}# tkIconList_Create --##	Creates an IconList widget by assembling a canvas widget and a#	scrollbar widget. Sets all the bindings necessary for the IconList's#	operations.#proc tkIconList_Create {w} {    upvar #0 $w data    frame $w    set data(sbar)   [scrollbar $w.sbar -orient horizontal \	-highlightthickness 0 -takefocus 0]    set data(canvas) [canvas $w.canvas -bd 2 -relief sunken \	-width 400 -height 120 -takefocus 1]    pack $data(sbar) -side bottom -fill x -padx 2    pack $data(canvas) -expand yes -fill both    $data(sbar) config -command "$data(canvas) xview"    $data(canvas) config -xscrollcommand "$data(sbar) set"    # Initializes the max icon/text width and height and other variables    #    set data(maxIW) 1    set data(maxIH) 1    set data(maxTW) 1    set data(maxTH) 1    set data(numItems) 0    set data(curItem)  {}    set data(noScroll) 1    # Creates the event bindings.    #    bind $data(canvas) <Configure> "tkIconList_Arrange $w"    bind $data(canvas) <1>         "tkIconList_Btn1 $w %x %y"    bind $data(canvas) <B1-Motion> "tkIconList_Motion1 $w %x %y"    bind $data(canvas) <Double-1>  "tkIconList_Double1 $w %x %y"    bind $data(canvas) <ButtonRelease-1> "tkCancelRepeat"    bind $data(canvas) <B1-Leave>  "tkIconList_Leave1 $w %x %y"    bind $data(canvas) <B1-Enter>  "tkCancelRepeat"    bind $data(canvas) <Up>        "tkIconList_UpDown $w -1"    bind $data(canvas) <Down>      "tkIconList_UpDown $w  1"    bind $data(canvas) <Left>      "tkIconList_LeftRight $w -1"    bind $data(canvas) <Right>     "tkIconList_LeftRight $w  1"    bind $data(canvas) <Return>    "tkIconList_ReturnKey $w"    bind $data(canvas) <KeyPress>  "tkIconList_KeyPress $w %A"    bind $data(canvas) <Control-KeyPress> ";"    bind $data(canvas) <Alt-KeyPress>  ";"    bind $data(canvas) <FocusIn>   "tkIconList_FocusIn $w"    return $w}# tkIconList_AutoScan --## This procedure is invoked when the mouse leaves an entry window# with button 1 down.  It scrolls the window up, down, left, or# right, depending on where the mouse left the window, and reschedules# itself as an "after" command so that the window continues to scroll until# the mouse moves back into the window or the mouse button is released.## Arguments:# w -		The IconList window.#proc tkIconList_AutoScan {w} {    upvar #0 $w data    global tkPriv    if {![winfo exists $w]} return    set x $tkPriv(x)    set y $tkPriv(y)    if $data(noScroll) {	return    }    if {$x >= [winfo width $data(canvas)]} {	$data(canvas) xview scroll 1 units    } elseif {$x < 0} {	$data(canvas) xview scroll -1 units    } elseif {$y >= [winfo height $data(canvas)]} {	# do nothing    } elseif {$y < 0} {	# do nothing    } else {	return    }    tkIconList_Motion1 $w $x $y    set tkPriv(afterId) [after 50 tkIconList_AutoScan $w]}# Deletes all the items inside the canvas subwidget and reset the IconList's# state.#proc tkIconList_DeleteAll {w} {    upvar #0 $w data    upvar #0 $w:itemList itemList    $data(canvas) delete all    catch {unset data(selected)}    catch {unset data(rect)}    catch {unset data(list)}    catch {unset itemList}    set data(maxIW) 1    set data(maxIH) 1    set data(maxTW) 1    set data(maxTH) 1    set data(numItems) 0    set data(curItem)  {}    set data(noScroll) 1    $data(sbar) set 0.0 1.0    $data(canvas) xview moveto 0}# Adds an icon into the IconList with the designated image and text#proc tkIconList_Add {w image text} {    upvar #0 $w data    upvar #0 $w:itemList itemList    upvar #0 $w:textList textList    set iTag [$data(canvas) create image 0 0 -image $image -anchor nw]    set tTag [$data(canvas) create text  0 0 -text  $text  -anchor nw \	-font $data(font)]    set rTag [$data(canvas) create rect  0 0 0 0 -fill "" -outline ""]        set b [$data(canvas) bbox $iTag]    set iW [expr [lindex $b 2]-[lindex $b 0]]    set iH [expr [lindex $b 3]-[lindex $b 1]]    if {$data(maxIW) < $iW} {	set data(maxIW) $iW    }    if {$data(maxIH) < $iH} {	set data(maxIH) $iH    }        set b [$data(canvas) bbox $tTag]    set tW [expr [lindex $b 2]-[lindex $b 0]]    set tH [expr [lindex $b 3]-[lindex $b 1]]    if {$data(maxTW) < $tW} {	set data(maxTW) $tW    }    if {$data(maxTH) < $tH} {	set data(maxTH) $tH    }        lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW $tH $data(numItems)]    set itemList($rTag) [list $iTag $tTag $text $data(numItems)]    set textList($data(numItems)) [string tolower $text]    incr data(numItems)}# Places the icons in a column-major arrangement.#proc tkIconList_Arrange {w} {    upvar #0 $w data    if ![info exists data(list)] {	if {[info exists data(canvas)] && [winfo exists $data(canvas)]} {	    set data(noScroll) 1	    $data(sbar) config -command ""	}	return    }    set W [winfo width  $data(canvas)]    set H [winfo height $data(canvas)]    set pad [expr [$data(canvas) cget -highlightthickness] + \	[$data(canvas) cget -bd]]    if {$pad < 2} {	set pad 2    }    incr W -[expr $pad*2]    incr H -[expr $pad*2]    set dx [expr $data(maxIW) + $data(maxTW) + 8]    if {$data(maxTH) > $data(maxIH)} {	set dy $data(maxTH)    } else {	set dy $data(maxIH)    }    incr dy 2    set shift [expr $data(maxIW) + 4]    set x [expr $pad * 2]    set y [expr $pad * 1]    set usedColumn 0    foreach sublist $data(list) {	set usedColumn 1	set iTag [lindex $sublist 0]	set tTag [lindex $sublist 1]	set rTag [lindex $sublist 2]	set iW   [lindex $sublist 3]	set iH   [lindex $sublist 4]	set tW   [lindex $sublist 5]	set tH   [lindex $sublist 6]	set i_dy [expr ($dy - $iH)/2]	set t_dy [expr ($dy - $tH)/2]	$data(canvas) coords $iTag $x                 [expr $y + $i_dy]	$data(canvas) coords $tTag [expr $x + $shift] [expr $y + $t_dy]	$data(canvas) coords $tTag [expr $x + $shift] [expr $y + $t_dy]	$data(canvas) coords $rTag $x $y [expr $x+$dx] [expr $y+$dy]	incr y $dy	if {[expr $y + $dy] > $H} {	    set y [expr $pad * 1]	    incr x $dx	    set usedColumn 0	}    }    if {$usedColumn} {	set sW [expr $x + $dx]    } else {	set sW $x    }    if {$sW < $W} {	$data(canvas) config -scrollregion "$pad $pad $sW $H"	$data(sbar) config -command ""	$data(canvas) xview moveto 0	set data(noScroll) 1    } else {	$data(canvas) config -scrollregion "$pad $pad $sW $H"	$data(sbar) config -command "$data(canvas) xview"	set data(noScroll) 0    }    set data(itemsPerColumn) [expr ($H-$pad)/$dy]    if {$data(itemsPerColumn) < 1} {	set data(itemsPerColumn) 1    }    if {$data(curItem) != {}} {	tkIconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 0    }}# Gets called when the user invokes the IconList (usually by double-clicking# or pressing the Return key).#proc tkIconList_Invoke {w} {    upvar #0 $w data    if {[string compare $data(-command) ""] && [info exists data(selected)]} {	eval $data(-command) [list $data(selected)]    }}# tkIconList_See --##	If the item is not (completely) visible, scroll the canvas so that#	it becomes visible.proc tkIconList_See {w rTag} {    upvar #0 $w data    upvar #0 $w:itemList itemList    if $data(noScroll) {	return    }    set sRegion [$data(canvas) cget -scrollregion]    if ![string compare $sRegion {}] {	return    }    if ![info exists itemList($rTag)] {	return    }    set bbox [$data(canvas) bbox $rTag]    set pad [expr [$data(canvas) cget -highlightthickness] + \	[$data(canvas) cget -bd]]    set x1 [lindex $bbox 0]    set x2 [lindex $bbox 2]    incr x1 -[expr $pad * 2]    incr x2 -[expr $pad * 1]    set cW [expr [winfo width $data(canvas)] - $pad*2]    set scrollW [expr [lindex $sRegion 2]-[lindex $sRegion 0]+1]    set dispX [expr int([lindex [$data(canvas) xview] 0]*$scrollW)]    set oldDispX $dispX    # check if out of the right edge    #    if {[expr $x2 - $dispX] >= $cW} {	set dispX [expr $x2 - $cW]    }    # check if out of the left edge    #    if {[expr $x1 - $dispX] < 0} {	set dispX $x1    }    if {$oldDispX != $dispX} {	set fraction [expr double($dispX)/double($scrollW)]	$data(canvas) xview moveto $fraction    }}proc tkIconList_SelectAtXY {w x y} {    upvar #0 $w data    tkIconList_Select $w [$data(canvas) find closest \	[$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]}proc tkIconList_Select {w rTag {callBrowse 1}} {    upvar #0 $w data    upvar #0 $w:itemList itemList    if ![info exists itemList($rTag)] {	return    }    set iTag   [lindex $itemList($rTag) 0]    set tTag   [lindex $itemList($rTag) 1]    set text   [lindex $itemList($rTag) 2]    set serial [lindex $itemList($rTag) 3]    if ![info exists data(rect)] {        set data(rect) [$data(canvas) create rect 0 0 0 0 \	    -fill #a0a0ff -outline #a0a0ff]    }    $data(canvas) lower $data(rect)    set bbox [$data(canvas) bbox $tTag]    eval $data(canvas) coords $data(rect) $bbox    set data(curItem) $serial    set data(selected) $text        if {$callBrowse} {	if [string compare $data(-browsecmd) ""] {	    eval $data(-browsecmd) [list $text]	}    }}proc tkIconList_Unselect {w} {    upvar #0 $w data    if [info exists data(rect)] {	$data(canvas) delete $data(rect)	unset data(rect)    }    if [info exists data(selected)] {	unset data(selected)    }    set data(curItem)  {}}# Returns the selected item#proc tkIconList_Get {w} {    upvar #0 $w data    if [info exists data(selected)] {	return $data(selected)    } else {	return ""    }}proc tkIconList_Btn1 {w x y} {    upvar #0 $w data    focus $data(canvas)    tkIconList_SelectAtXY $w $x $y}# Gets called on button-1 motions#proc tkIconList_Motion1 {w x y} {    global tkPriv    set tkPriv(x) $x    set tkPriv(y) $y    tkIconList_SelectAtXY $w $x $y}proc tkIconList_Double1 {w x y} {    upvar #0 $w data    if {$data(curItem) != {}} {	tkIconList_Invoke $w    }}proc tkIconList_ReturnKey {w} {    tkIconList_Invoke $w}proc tkIconList_Leave1 {w x y} {    global tkPriv    set tkPriv(x) $x    set tkPriv(y) $y    tkIconList_AutoScan $w}proc tkIconList_FocusIn {w} {    upvar #0 $w data    if ![info exists data(list)] {	return    }    if {$data(curItem) == {}} {	set rTag [lindex [lindex $data(list) 0] 2]	tkIconList_Select $w $rTag    }}# tkIconList_UpDown --## Moves the active element up or down by one element