# 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

#	selecting the "Directory" option menu. The user can select

#	files by clicking on the file icons or by entering a filename

#	in the "Filename:" entry.

#

# RCS: @(#) $Id: tkfbox.tcl,v 1.38.2.9 2005/11/22 11:00:38 dkf Exp $

#

# Copyright (c) 1994-1998 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 

# ::tk::dialog::file:: dialog box.

#

#----------------------------------------------------------------------

# ::tk::IconList --

#

#	Creates an IconList widget.

#

proc ::tk::IconList {w args} {

    IconList_Config $w $args

    IconList_Create $w

}

proc ::tk::IconList_Index {w i} {

    upvar #0 ::tk::$w data

    upvar #0 ::tk::$w:itemList itemList

    if {![info exists data(list)]} {set data(list) {}}

    switch -regexp -- $i {

	"^-?[0-9]+$" {

	    if { $i < 0 } {

		set i 0

	    }

	    if { $i >= [llength $data(list)] } {

		set i [expr {[llength $data(list)] - 1}]

	    }

	    return $i

	}

	"^active$" {

	    return $data(index,active)

	}

	"^anchor$" {

	    return $data(index,anchor)

	}

	"^end$" {

	    return [llength $data(list)]

	}

	"@-?[0-9]+,-?[0-9]+" {

	    foreach {x y} [scan $i "@%d,%d"] {

		break

	    }

	    set item [$data(canvas) find closest $x $y]

	    return [lindex [$data(canvas) itemcget $item -tags] 1]

	}

    }

}

proc ::tk::IconList_Selection {w op args} {

    upvar ::tk::$w data

    switch -exact -- $op {

	"anchor" {

	    if { [llength $args] == 1 } {

		set data(index,anchor) [tk::IconList_Index $w [lindex $args 0]]

	    } else {

		return $data(index,anchor)

	    }

	}

	"clear" {

	    if { [llength $args] == 2 } {

		foreach {first last} $args {

		    break

		}

	    } elseif { [llength $args] == 1 } {

		set first [set last [lindex $args 0]]

	    } else {

		error "wrong # args: should be [lindex [info level 0] 0] path\

			clear first ?last?"

	    }

	    set first [IconList_Index $w $first]

	    set last [IconList_Index $w $last]

	    if { $first > $last } {

		set tmp $first

		set first $last

		set last $tmp

	    }

	    set ind 0

	    foreach item $data(selection) {

		if { $item >= $first } {

		    set first $ind

		    break

		}

	    }

	    set ind [expr {[llength $data(selection)] - 1}]

	    for {} {$ind >= 0} {incr ind -1} {

		set item [lindex $data(selection) $ind]

		if { $item <= $last } {

		    set last $ind

		    break

		}

	    }

	    if { $first > $last } {

		return

	    }

	    set data(selection) [lreplace $data(selection) $first $last]

	    event generate $w <<ListboxSelect>>

	    IconList_DrawSelection $w

	}

	"includes" {

	    set index [lsearch -exact $data(selection) [lindex $args 0]]

	    return [expr {$index != -1}]

	}

	"set" {

	    if { [llength $args] == 2 } {

		foreach {first last} $args {

		    break

		}

	    } elseif { [llength $args] == 1 } {

		set last [set first [lindex $args 0]]

	    } else {

		error "wrong # args: should be [lindex [info level 0] 0] path\

			set first ?last?"

	    }

	    set first [IconList_Index $w $first]

	    set last [IconList_Index $w $last]

	    if { $first > $last } {

		set tmp $first

		set first $last

		set last $tmp

	    }

	    for {set i $first} {$i <= $last} {incr i} {

		lappend data(selection) $i

	    }

	    set data(selection) [lsort -integer -unique $data(selection)]

	    event generate $w <<ListboxSelect>>

	    IconList_DrawSelection $w

	}

    }

}

proc ::tk::IconList_Curselection {w} {

    upvar ::tk::$w data

    return $data(selection)

}

proc ::tk::IconList_DrawSelection {w} {

    upvar ::tk::$w data

    upvar ::tk::$w:itemList itemList

    $data(canvas) delete selection

    foreach item $data(selection) {

	set rTag [lindex [lindex $data(list) $item] 2]

	foreach {iTag tTag text serial} $itemList($rTag) {

	    break

	}

	set bbox [$data(canvas) bbox $tTag]

        $data(canvas) create rect $bbox -fill \#a0a0ff -outline \#a0a0ff \

		-tags selection

    }

    $data(canvas) lower selection

    return

}

proc ::tk::IconList_Get {w item} {

    upvar ::tk::$w data

    upvar ::tk::$w:itemList itemList

    set rTag [lindex [lindex $data(list) $item] 2]

    foreach {iTag tTag text serial} $itemList($rTag) {

	break

    }

    return $text

}

# ::tk::IconList_Config --

#

#	Configure the widget variables of IconList, according to the command

#	line arguments.

#

proc ::tk::IconList_Config {w argList} {

    # 1: the configuration specs

    #

    set specs {

	{-command "" "" ""}

	{-multiple "" "" "0"}

    }

    # 2: parse the arguments

    #

    tclParseConfigSpec ::tk::$w $specs "" $argList

}

# ::tk::IconList_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 ::tk::IconList_Create {w} {

    upvar ::tk::$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 [list $data(canvas) xview]

    $data(canvas) config -xscrollcommand [list $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

    set data(selection) {}

    set data(index,anchor) ""

    set fg [option get $data(canvas) foreground Foreground]

    if {$fg eq ""} {

	set data(fill) black

    } else {

	set data(fill) $fg

    }

    # Creates the event bindings.

    #

    bind $data(canvas) <Configure>	[list tk::IconList_Arrange $w]

    bind $data(canvas) <1>		[list tk::IconList_Btn1 $w %x %y]

    bind $data(canvas) <B1-Motion>	[list tk::IconList_Motion1 $w %x %y]

    bind $data(canvas) <B1-Leave>	[list tk::IconList_Leave1 $w %x %y]

    bind $data(canvas) <Control-1>	[list tk::IconList_CtrlBtn1 $w %x %y]

    bind $data(canvas) <Shift-1>	[list tk::IconList_ShiftBtn1 $w %x %y]

    bind $data(canvas) <B1-Enter>	[list tk::CancelRepeat]

    bind $data(canvas) <ButtonRelease-1> [list tk::CancelRepeat]

    bind $data(canvas) <Double-ButtonRelease-1> \

	    [list tk::IconList_Double1 $w %x %y]

    bind $data(canvas) <Up>		[list tk::IconList_UpDown $w -1]

    bind $data(canvas) <Down>		[list tk::IconList_UpDown $w  1]

    bind $data(canvas) <Left>		[list tk::IconList_LeftRight $w -1]

    bind $data(canvas) <Right>		[list tk::IconList_LeftRight $w  1]

    bind $data(canvas) <Return>		[list tk::IconList_ReturnKey $w]

    bind $data(canvas) <KeyPress>	[list tk::IconList_KeyPress $w %A]

    bind $data(canvas) <Control-KeyPress> ";"

    bind $data(canvas) <Alt-KeyPress>	";"

    bind $data(canvas) <FocusIn>	[list tk::IconList_FocusIn $w]

    bind $data(canvas) <FocusOut>	[list tk::IconList_FocusOut $w]

    return $w

}

# ::tk::IconList_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 ::tk::IconList_AutoScan {w} {

    upvar ::tk::$w data

    variable ::tk::Priv

    if {![winfo exists $w]} return

    set x $Priv(x)

    set y $Priv(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

    }

    IconList_Motion1 $w $x $y

    set Priv(afterId) [after 50 [list tk::IconList_AutoScan $w]]

}

# Deletes all the items inside the canvas subwidget and reset the IconList's

# state.

#

proc ::tk::IconList_DeleteAll {w} {

    upvar ::tk::$w data

    upvar ::tk::$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

    set data(selection) {}

    set data(index,anchor) ""

    $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 ::tk::IconList_Add {w image items} {

    upvar ::tk::$w data

    upvar ::tk::$w:itemList itemList

    upvar ::tk::$w:textList textList

    foreach text $items {

	set iTag [$data(canvas) create image 0 0 -image $image -anchor nw \

		-tags [list icon $data(numItems) item$data(numItems)]]

	set tTag [$data(canvas) create text  0 0 -text  $text  -anchor nw \

		-font $data(font) -fill $data(fill) \

		-tags [list text $data(numItems) item$data(numItems)]]

	set rTag [$data(canvas) create rect  0 0 0 0 -fill "" -outline "" \

		-tags [list rect $data(numItems) item$data(numItems)]]

	foreach {x1 y1 x2 y2} [$data(canvas) bbox $iTag] {

	    break

	}

	set iW [expr {$x2 - $x1}]

	set iH [expr {$y2 - $y1}]

	if {$data(maxIW) < $iW} {

	    set data(maxIW) $iW

	}

	if {$data(maxIH) < $iH} {

	    set data(maxIH) $iH

	}

	foreach {x1 y1 x2 y2} [$data(canvas) bbox $tTag] {

	    break

	}

	set tW [expr {$x2 - $x1}]

	set tH [expr {$y2 - $y1}]

	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 ::tk::IconList_Arrange {w} {

    upvar ::tk::$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}] ; # Why * 1 ?

    set usedColumn 0

    foreach sublist $data(list) {

	set usedColumn 1

	foreach {iTag tTag rTag iW iH tW tH} $sublist {

	    break

	}

	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 $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]

	incr y $dy

	if {($y + $dy) > $H} {

	    set y [expr {$pad * 1}] ; # *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 [list $pad $pad $sW $H]

	$data(sbar) config -command ""

	$data(canvas) xview moveto 0

	set data(noScroll) 1

    } else {

	$data(canvas) config -scrollregion [list $pad $pad $sW $H]

	$data(sbar) config -command [list $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) != ""} {

	IconList_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 ::tk::IconList_Invoke {w} {

    upvar ::tk::$w data

    if {$data(-command) != "" && [llength $data(selection)]} {

	uplevel #0 $data(-command)

    }

}

# ::tk::IconList_See --

#

#	If the item is not (completely) visible, scroll the canvas so that

#	it becomes visible.

proc ::tk::IconList_See {w rTag} {

    upvar ::tk::$w data

    upvar ::tk::$w:itemList itemList

    if {$data(noScroll)} {

	return

    }

    set sRegion [$data(canvas) cget -scrollregion]

    if {[string equal $sRegion {}]} {

	return

    }

    if { $rTag < 0 || $rTag >= [llength $data(list)] } {

	return

    }

    set bbox [$data(canvas) bbox item$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}] ; # *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 {($x2 - $dispX) >= $cW} {

	set dispX [expr {$x2 - $cW}]

    }

    # check if out of the left edge

    #

    if {($x1 - $dispX) < 0} {

	set dispX $x1

    }