proc GUI_Init_Phase_1 {} {
    # Create the Main Window Frame
    frame .mainwindow
    # Create the Window List
    QListBox::create .windowlist totop -background $::dynamic::theme_windowlist_background -selectbackground $::dynamic::theme_windowlist_selectbackground -selectforeground $::dynamic::theme_windowlist_selectforeground -foreground $::dynamic::theme_windowlist_foreground -width $::dynamic::theme_windowlist_width -font $::dynamic::theme_windowlist_font
    QListBox::addcolor .windowlist normal 0 $::dynamic::theme_windowlist_foreground $::dynamic::theme_windowlist_background
    QListBox::addcolor .windowlist active 1000 $::dynamic::theme_windowlist_activeforeground $::dynamic::theme_windowlist_activebackground
}

proc GUI_Init_Phase_2 {} {
    # Execute in a global context so it's easier to access config variables.
    uplevel "#0" {
	# Create the Button Bar and Menu Bar Frames
	frame .buttonbar -border 1 -relief sunken
	frame .menubar
	
	# Pack the frames vertically tiled
	pack .buttonbar -fill x
	pack .windowlist -side left -fill y
	pack .mainwindow -expand 1 -fill both
	
	# Create and Configure RAW Window
	frame .raw
	scrollbar .raw.text_vscroll -command ".raw.text yview"
	text .raw.text -height 0 -width 0 -wrap word -yscroll ".raw.text_vscroll set"
	pack .raw.text_vscroll -side right -fill y
	pack .raw.text -fill both -expand 1
	place .raw -in .mainwindow -relwidth 1.0 -relheight 1.0
	.raw.text configure -font "-adobe-courier-medium-r-normal--0-0-75-75-m-0-iso8859-1"
	
	# Set up the Button bar
	button .buttonbar.close -text "Close" -command {closewindow [currentwindow]}
	button .buttonbar.condis
	condis "Start a New Server" "source $env(HOME)/.quirc/newserver.tcl"

	button .buttonbar.menu -text "Menu" -relief raised

        .buttonbar.menu configure -command {tk_popup .menumaintext [expr [winfo rootx .buttonbar.menu]+20] [expr [winfo rooty .buttonbar.menu]+10]}

	#bind .buttonbar.menu <Button-1> {tk_popup .menumaintext %X %Y}

	pack .buttonbar.close .buttonbar.condis .buttonbar.menu -side left
	
	# Configure the colors for the buttons
	.buttonbar configure -background $::dynamic::theme_buttonbar_background
	
	.buttonbar.condis configure -activebackground $::dynamic::theme_button_condis_activebackground
	.buttonbar.condis configure -background $::dynamic::theme_button_condis_background
	.buttonbar.condis configure -activeforeground $::dynamic::theme_button_condis_activeforeground
	.buttonbar.condis configure -foreground $::dynamic::theme_button_condis_foreground
	
	.buttonbar.close configure -activebackground $::dynamic::theme_button_close_activebackground
	.buttonbar.close configure -background $::dynamic::theme_button_close_background
	.buttonbar.close configure -activeforeground $::dynamic::theme_button_close_activeforeground
	.buttonbar.close configure -foreground $::dynamic::theme_button_close_foreground
	
	.buttonbar.menu configure -activebackground $::dynamic::theme_button_menu_activebackground
	.buttonbar.menu configure -background $::dynamic::theme_button_menu_background
	.buttonbar.menu configure -activeforeground $::dynamic::theme_button_menu_activeforeground
	.buttonbar.menu configure -foreground $::dynamic::theme_button_menu_foreground
	
	# Set up the virtual events
	event add <<Enter>> <Return> <KP_Enter>
	event add <<Shift-Enter>> <Shift-Return> <Shift-KP_Enter>
	event add <<Alt-Enter>> <Alt-Return> <Alt-KP_Enter>
	event add <<Control-Enter>> <Control-Return> <Control-KP_Enter>
	event add <<Action-1>> <Button-1> <B1-Motion>

	# Set up the Windowlist popup menu
# 	bind .windowlist <Button-3> "tk_popup .menuwindowlist %X %Y"

#     if { $type=="channel" } {
# 	bind $pathname.nicks <Button-3> "
# 	    if { \[llength \[$pathname.nicks curselection]]<2 } {
# 		$pathname.nicks selection clear 0 end
# 		$pathname.nicks selection set @%x,%y
# 	    } else {
# 		$pathname.nicks selection set @%x,%y
# 	    }
# 	    tk_popup .menuchannelnicks$serverindex %X %Y
# 	"
#     }
#     if { $type=="main" } {
# 	proc ::tk_menuSetFocus(.menumaintext) {args} {}
# 	proc ::tk_menuSetFocus(.menumainentry) {args} {}
# 	if { ![winfo exists .menumaintext] } {
# 	    menu .menumaintext
# 	}
# 	if { ![winfo exists .menumainentry] } {
# 	    menu .menumainentry
# 	}
#     }


	# Set the starting geometry for the toplevel window
	wm geometry . $::dynamic::default_geometry
    }
}

proc Init_Window { pathname name index type serverindex } {
    # This procedure is run when a new window is created.  It handles all the
    # generic Tk configuration that needs to be done for that window.
    if { [title $pathname]=="" } {
	title $pathname "QuIRC v[version] - What do you think?"
    }
    if { $type=="status" || $type=="main" } {
	QListBox::insert .windowlist $index $name
    } else {
	QListBox::insert .windowlist $index "$::dynamic::theme_windowlist_indent$name"
    }
    frame $pathname
    if { $type=="channel" } {
	listbox $pathname.nicks -selectmode extended -exportselection no
	$pathname.nicks configure -background $::dynamic::theme_nicklist_background -foreground $::dynamic::theme_nicklist_foreground -font $::dynamic::theme_nicklist_font
	$pathname.nicks configure -width $::dynamic::theme_nicklist_width
	if { $::dynamic::nicklist_scrollbar } {
	    $pathname.nicks configure -yscrollcommand "$pathname.nicks_yscroll set"
	    scrollbar $pathname.nicks_yscroll -command "$pathname.nicks yview"
	}
	if { $::dynamic::nicklist_side == "right" } {
	    if { $::dynamic::nicklist_scrollbar } {
		pack $pathname.nicks_yscroll -side $::dynamic::nicklist_side -fill y
	    }
	    pack $pathname.nicks -side $::dynamic::nicklist_side -fill y
	} else {
	    pack $pathname.nicks -side $::dynamic::nicklist_side -fill y
	    if { $::dynamic::nicklist_scrollbar } {
		pack $pathname.nicks_yscroll -side $::dynamic::nicklist_side -fill y
	    }
	}
    }
    scrollbar $pathname.text_vscroll -command "$pathname.text yview"
    text $pathname.text -height 0 -width 0 -wrap word -yscroll "$pathname.text_vscroll set" -state disabled
    entry $pathname.entry
    pack $pathname.entry -fill x -side bottom
    pack $pathname.text_vscroll -side right -fill y
    pack $pathname.text -fill both -expand 1
    configtags $pathname.text [set ::dynamic::theme_${type}_font_normal] [set ::dynamic::theme_${type}_font_bold]
    $pathname.text configure -font [set ::dynamic::theme_${type}_font_normal]
    $pathname.text configure -state normal
    for { set n 0 } { $n < $::dynamic::blank_lines_before_text } { incr n } {
	$pathname.text insert end \n
    }
    $pathname.text configure -state disabled
    $pathname.text yview moveto 1
    place $pathname -in .mainwindow -relwidth 1.0 -relheight 1.0
    $pathname.text configure -foreground $::dynamic::theme_color([set ::dynamic::theme_${type}_foreground])
    $pathname.text configure -background $::dynamic::theme_color([set ::dynamic::theme_${type}_background])
    $pathname.text configure -selectbackground [set ::dynamic::theme_${type}_selectbackground]
    $pathname.text configure -selectforeground [set ::dynamic::theme_${type}_selectforeground]
    $pathname.text configure -selectborderwidth [set ::dynamic::theme_${type}_selectborderwidth]
    $pathname.entry configure -foreground [set ::dynamic::theme_${type}_entry_foreground]
    $pathname.entry configure -background [set ::dynamic::theme_${type}_entry_background]
    $pathname.entry configure -font [set ::dynamic::theme_${type}_entry_font]
    $pathname.entry configure -insertbackground [set ::dynamic::theme_${type}_entry_insertbackground]
					   
    bind $pathname.entry <<Shift-Enter>> "$pathname.entry insert insert \\n"
    bind $pathname.entry <<Enter>> "parseentry $pathname"
    bind $pathname.entry <Control-c> "$pathname.entry insert insert \"\\x03\""
    bind $pathname.entry <Control-l> "$pathname.entry insert insert \"\\x02\""
    bind $pathname.entry <Control-u> "$pathname.entry insert insert \"\\x1f\""
    bind $pathname.entry <Control-underscore> "$pathname.entry insert insert \"\\x1f\""
    bind $pathname.entry <KeyPress> "if {\"%K\"!=\"Shift_L\"&&\"%K\"!=\"Shift_R\"&&\"%K\"!=\"Prior\"&&\"%K\"!=\"Next\"} \"$pathname.text see end\""
    bind $pathname.entry <KeyPress-Tab> "n_complete; break"
    bind $pathname.entry <KeyPress-Escape> "dcc_abort; break"
    bind $pathname.text <Button-2> "focus $pathname.entry; event generate $pathname.entry <KeyPress-Insert>"

    if { $type!="status"&&$type!="main" } {
	bind $pathname.entry <<Control-Enter>> "
	    foreach line \[split \[$pathname.entry get] \"\\n\"] {
		if {\$line!=\"\"} { say \"\$line\" }
	    }
	    $pathname.entry delete 0 end
	"
	bind $pathname.entry <<Alt-Enter>> "
	    foreach line \[split \[$pathname.entry get] \"\\n\"] {
		if {\$line!=\"\"} { say \"\[string trim \$line]\" }
	    }
	    $pathname.entry delete 0 end
	"
    }

    # Set up the popup menus
    bind $pathname.text <Button-3> "tk_popup .menu${type}text$serverindex %X %Y"
    bind $pathname.entry <Button-3> "tk_popup .menu${type}entry$serverindex %X %Y"
    if { $type=="channel" } {
	bind $pathname.nicks <Button-3> "
	    if { \[llength \[$pathname.nicks curselection]]<2 } {
		$pathname.nicks selection clear 0 end
		$pathname.nicks selection set @%x,%y
	    } else {
		$pathname.nicks selection set @%x,%y
	    }
	    tk_popup .menuchannelnicks$serverindex %X %Y
	"
    }
    if { $type=="main" } {
	proc ::tk_menuSetFocus(.menumaintext) {args} {}
	proc ::tk_menuSetFocus(.menumainentry) {args} {}
	if { ![winfo exists .menumaintext] } {
	    menu .menumaintext
	}
	if { ![winfo exists .menumainentry] } {
	    menu .menumainentry
	}
    }
    if { $type=="status" } {
	proc ::tk_menuSetFocus(.menustatustext$serverindex) {args} {}
	proc ::tk_menuSetFocus(.menustatusentry$serverindex) {args} {}
	proc ::tk_menuSetFocus(.menuquerytext$serverindex) {args} {}
	proc ::tk_menuSetFocus(.menuqueryentry$serverindex) {args} {}
	proc ::tk_menuSetFocus(.menuchattext$serverindex) {args} {}
	proc ::tk_menuSetFocus(.menuchatentry$serverindex) {args} {}
	proc ::tk_menuSetFocus(.menufilestext$serverindex) {args} {}
	proc ::tk_menuSetFocus(.menufilesentry$serverindex) {args} {}
	proc ::tk_menuSetFocus(.menuchanneltext$serverindex) {args} {}
	proc ::tk_menuSetFocus(.menuchannelentry$serverindex) {args} {}
	proc ::tk_menuSetFocus(.menuchannelnicks$serverindex) {args} {}
	menu .menustatustext$serverindex
	menu .menustatusentry$serverindex
	menu .menuquerytext$serverindex
	menu .menuqueryentry$serverindex
	menu .menuchattext$serverindex
	menu .menuchatentry$serverindex
        menu .menufilestext$serverindex
        menu .menufilesentry$serverindex
	menu .menuchanneltext$serverindex
	menu .menuchannelentry$serverindex
	menu .menuchannelnicks$serverindex
    }

    # Make timestamp invisible initially
    if { [info tclversion]>=8.3 } {
	if { !$::dynamic::timestamp } {
	    $pathname.text tag configure timestamp -elide 1
	}
    }

    #URL tag stuff
    
    $pathname.text tag configure URL -underline 1
    $pathname.text tag bind URL <Button-1> "after 1 openurl $pathname.text"
    $pathname.text tag bind URL <Enter> "$pathname.text configure -cursor hand2"
    $pathname.text tag bind URL <Leave> "$pathname.text configure -cursor xterm"


    # Report that main window is completed for use in bgerror
    if { $type=="main" } {
	bind .main <Destroy> {set ::internal::done_main_window 0}
	set ::internal::done_main_window 1
    }
}

proc QColorChooser { command } {
    # Command will be passed a number between 0 and 15 if a color is picked.
    # If the window is just closed, command will not be called.
    toplevel .colorchooser
    wm title .colorchooser "Color"
    for { set n 0 } { $n < 16 } { incr n } {
	label .colorchooser.label$n -text "   " -background $::dynamic::theme_color($n) -relief raised
	bind .colorchooser.label$n <Button-1> "destroy .colorchooser; $command $n"
    }
    for { set y 0 } { $y < 4 } { incr y } {
	for { set x 0 } { $x < 4 } { incr x } {
	    grid .colorchooser.label[expr $y*4+$x] -column [expr $x+1] -row [expr $y+1]
	}
    }
}

namespace eval QEntryBox {
    proc create { title message script {width 300} } {
	while { [winfo exists [set wn .ranwin[expr int(rand()*1000000)]]] } {}
	toplevel $wn
	wm title $wn $title
	pack [message $wn.message -text $message -width $width]
	pack [entry $wn.entry]
	set script [parseformat $script [list [list g "\[$wn.entry get]"]]
	set script "\{$script; destroy $wn\}"
	bind $wn <<Enter>> "eval $script"
	bind $wn <KeyPress-Escape> "destroy $wn"
	pack [button $wn.buttonok -text "OK" -default active -command "eval $script"] -side left
	pack [button $wn.buttoncancel -text "Cancel" -command "destroy $wn"] -side right
	focus $wn.entry
	return $wn
    }
}

namespace eval QPasswordBox {
    proc create { title message script {width 300} } {
	while { [winfo exists [set wn .ranwin[expr int(rand()*1000000)]]] } {}
	toplevel $wn
	wm title $wn $title
	pack [message $wn.message -text $message -width $width]
	pack [entry $wn.entry -show *]
	set script [parseformat $script [list [list g "\[$wn.entry get]"]]
	set script "\{$script; destroy $wn\}"
	bind $wn <<Enter>> "eval $script"
	bind $wn <KeyPress-Escape> "destroy $wn"
	pack [button $wn.buttonok -text "OK" -default active -command "eval $script"] -side left
	pack [button $wn.buttoncancel -text "Cancel" -command "destroy $wn"] -side right
	focus $wn.entry
	return $wn
    }
}

namespace eval QListBox {
    set tagindex 0
    array set colors {}
    array set priorities {}
    array set selected {}
    
    proc killtags { windowname first } {
	foreach tagtype [$windowname tag names $first] {
	    if { $tagtype != "selected" } {
		$windowname tag delete $tagtype
	    }
	}
    }
    proc create { windowname command args } {
	set background black
	set foreground white
	set selectbackground red
	set selectforeground black
        set font "helvetica"
        set width 100
        set ::QListBox::priorities($windowname) {}
        set ::QListBox::selected($windowname) -1
	for { set n 0 } { $n < [llength $args] } { incr n } {
	    switch -- [lindex $args $n] {
		-background {
		    incr n
		    set background [lindex $args $n]
		}
		-foreground {
		    incr n
		    set foreground [lindex $args $n]
		}
		-selectbackground {
		    incr n
		    set selectbackground [lindex $args $n]
		}
		-selectforeground {
		    incr n
		    set selectforeground [lindex $args $n]
		}
		-font {
		    incr n
		    set font [lindex $args $n]
		}
		-width {
		    incr n
		    set width [lindex $args $n]
		}
		default {
		    puts "ERROR!!!"
		}
	    }
	}
	frame $windowname -width $width
        grid propagate $windowname 0
        # No Scrollbars
	grid [text $windowname.t -state disabled -exportselection no -background $background -foreground $foreground -selectbackground $background -selectforeground $foreground -selectborderwidth 0 -font $font -wrap none -width 0 -height 0 -cursor left_ptr] -column 1 -row 1 -sticky nesw
        # Scrollbars
	#grid [text $windowname.t -state disabled -exportselection no -background $background -foreground $foreground -selectbackground $background -selectforeground $foreground -selectborderwidth 0 -font $font -yscroll "$windowname.y set" -xscroll "$windowname.x set" -wrap none -width 0 -height 0 -cursor left_ptr] -column 1 -row 1 -sticky nesw
	#grid [scrollbar $windowname.y -command "$windowname.t yview"] -column 2 -row 1 -sticky nesw
	#grid [scrollbar $windowname.x -orient horizontal -command "$windowname.t xview"] -column 1 -row 2 -sticky new
	grid columnconfigure $windowname 1 -weight 1
	grid rowconfigure $windowname 1 -weight 1
	$windowname.t tag configure selected -background $selectbackground -foreground $selectforeground
	bind $windowname.t <B1-Motion> "$windowname.t tag remove selected 0.0 end; $windowname.t tag add selected \"@%x,%y linestart\" \"@%x,%y lineend\"; $command \[expr \[lindex \[split \[$windowname.t tag ranges selected] \".\"] 0]-1]; break;"
	bind $windowname.t <1> "$windowname.t tag remove selected 0.0 end; $windowname.t tag add selected \"@%x,%y linestart\" \"@%x,%y lineend\"; $command \[expr \[lindex \[split \[$windowname.t tag ranges selected] \".\"] 0]-1]; break;"
	$windowname configure -width $width
	return $windowname
    }
    proc insert { windowname index item } {
        incr index
        $windowname.t configure -state normal
        $windowname.t insert end "\n"
	$windowname.t insert $index.0 "$item\n"
	$windowname.t delete "end - 2 c" end
	$windowname.t configure -state disabled
	set ::QListBox::priorities($windowname) [linsert $::QListBox::priorities($windowname) [expr $index - 1] 0]
        #$windowname.t tag remove selected 0.0 end
	#$windowname.t tag add selected $index.0 $index.end
    }
    proc delete { windowname index } {
	incr index
	$windowname.t configure -state normal
        $windowname.t insert end "\n"
	$windowname.t delete $index.0 [expr $index+1].0
	$windowname.t delete "end - 2 c" end
        $windowname.t configure -state disabled
	set ::QListBox::priorities($windowname) [lreplace $::QListBox::priorities($windowname) [expr $index - 1] [expr $index - 1]]
    }
    proc addcolor { windowname name priority args } {
        if { [llength $args] != 1 && [llength $args] != 2 } {
            error "Usage: QListBox::addcolor <name> <priority> <foreground> \[<background>\]"
	}
        set ::QListBox::colors($name) [list $priority $args]
    }
    proc colorize { windowname index name } {
        # If we're working with the selected window, return.  We don't want to
	# return when we're killing the color though.
        if { $::QListBox::selected($windowname) == $index &&
             $name != "normal" } { return }

        if { [array names ::QListBox::colors -exact $name] == "" } {
	    error "The $name color was not previously added with addcolor."
        }

	incr index
	if { $index>=[lindex [split [$windowname.t index end] "."] 0] || $index<1} {
	    error "Illegal window index given to colorize"
	}

        # Extract the colors and priority
	set priority [lindex $::QListBox::colors($name) 0]
	set cols [lindex $::QListBox::colors($name) 1]

        # Grab the priority from the priority list for this window.
        set prilist $::QListBox::priorities($windowname)
	set oldpriority [lindex $prilist [expr $index - 1]]

        # Only if the new priority is greater than or equal to the old priority
        # or if the new priority is to cancel the coloring do we not return.
        if { $oldpriority > $priority && $priority != 0 } { return }

        set ::QListBox::priorities($windowname) [lreplace $prilist [expr $index - 1] [expr $index - 1] $priority]

	killtags $windowname.t $index.0
	if { [llength $cols] > 1 } {
	    $windowname.t tag configure $::QListBox::tagindex -foreground [lindex $cols 0] -background [lindex $cols 1]
	} else {
	    $windowname.t tag configure $::QListBox::tagindex -foreground [lindex $cols 0]
	}
	$windowname.t tag add $::QListBox::tagindex $index.0 $index.end
	$windowname.t tag raise selected
	incr ::QListBox::tagindex
    }
    proc select { windowname index } {
        set ::QListBox::selected($windowname) $index
        incr index
        $windowname.t tag remove selected 0.0 end
        if { [$windowname.t get $index.0 $index.[string length $::dynamic::theme_windowlist_indent]]!=$::dynamic::theme_windowlist_indent } {
	    $windowname.t tag add selected $index.0 $index.end
	} else {
	    $windowname.t tag add selected $index.[string length $::dynamic::theme_windowlist_indent] $index.end
	}
    }
}

#bind . <1> { destroy .f.y }
#bind . <Control-1> { grid [scrollbar .f.y] -column 2 -row 1 -sticky nesw }
#bind . <2> { destroy .f.x }
#bind . <Control-2> { grid [scrollbar .f.x -orient horizontal] -column 1 -row 2 -sticky new }


# The following is modified version of D. Richard Hipp's tree widget.

# Copyright (C) 1997,1998 D. Richard Hipp
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Library General Public License for more details.
# 
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA  02111-1307, USA.
#
# Author contact information:
#   drh@acm.org
#   http://www.hwaci.com/drh/
#
# $Revision: 1.31 $
#
option add *highlightThickness 0

switch $tcl_platform(platform) {
  unix {
    set Tree(font) \
      -adobe-helvetica-medium-r-normal-*-11-80-100-100-p-56-iso8859-1
  }
  windows {
    set Tree(font) \
      -adobe-helvetica-medium-r-normal-*-14-100-100-100-p-76-iso8859-1
  }
}

#
# Create a new tree widget.  $args become the configuration arguments to
# the canvas widget from which the tree is constructed.
#
proc Tree:create {w args} {
  global Tree
  eval canvas $w -bg white $args
  bind $w <Destroy> "Tree:delitem $w /"
  Tree:dfltconfig $w /
  Tree:buildwhenidle $w
  set Tree($w:selection) {}
  set Tree($w:selidx) {}
}

# Initialize a element of the tree.
# Internal use only
#
proc Tree:dfltconfig {w v} {
  global Tree
  set Tree($w:$v:children) {}
  set Tree($w:$v:open) 0
  set Tree($w:$v:icon) {}
  set Tree($w:$v:tags) {}
}

#
# Pass configuration options to the tree widget
#
proc Tree:config {w args} {
  eval $w config $args
}

#
# Insert a new element $v into the tree $w.
#
proc Tree:newitem {w v args} {
  global Tree
  set dir [file dirname $v]
  set n [file tail $v]
  if {![info exists Tree($w:$dir:open)]} {
    Tree:newitem $w $dir $args
    # error "parent item \"$dir\" is missing"
  }
  set i [lsearch -exact $Tree($w:$dir:children) $n]
  if {$i>=0} {
    error "item \"$v\" already exists"
  }
  lappend Tree($w:$dir:children) $n
  set Tree($w:$dir:children) [lsort $Tree($w:$dir:children)]
  Tree:dfltconfig $w $v
  foreach {op arg} $args {
    switch -exact -- $op {
      -image {set Tree($w:$v:icon) $arg}
      -tags {set Tree($w:$v:tags) $arg}
    }
  }
  Tree:buildwhenidle $w
}

#
# Delete element $v from the tree $w.  If $v is /, then the widget is
# deleted.
#
proc Tree:delitem {w v} {
  global Tree
  if {![info exists Tree($w:$v:open)]} return
  if {[string compare $v /]==0} {
    # delete the whole widget
    catch {destroy $w}
    foreach t [array names Tree $w:*] {
      unset Tree($t)
    }
    return
  }
  foreach c $Tree($w:$v:children) {
    catch {Tree:delitem $w $v/$c}
  }
  unset Tree($w:$v:open)
  unset Tree($w:$v:children)
  unset Tree($w:$v:icon)
  set dir [file dirname $v]
  set n [file tail $v]
  set i [lsearch -exact $Tree($w:$dir:children) $n]
  if {$i>=0} {
    set Tree($w:$dir:children) [lreplace $Tree($w:$dir:children) $i $i]
  }
  Tree:buildwhenidle $w
}

#
# Change the selection to the indicated item
#
proc Tree:setselection {w v} {
  global Tree
  set Tree($w:selection) $v
  Tree:drawselection $w
}

# 
# Retrieve the current selection
#
proc Tree:getselection w {
  global Tree
  return $Tree($w:selection)
}

#
# Bitmaps used to show which parts of the tree can be opened.
#
set maskdata "#define solid_width 9\n#define solid_height 9"
append maskdata {
  static unsigned char solid_bits[] = {
   0xff, 0x01, 0xff, 0x01, 0xff, 0x01, 0xff, 0x01, 0xff, 0x01, 0xff, 0x01,
   0xff, 0x01, 0xff, 0x01, 0xff, 0x01
  };
}
set data "#define open_width 9\n#define open_height 9"
append data {
  static unsigned char open_bits[] = {
   0xff, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x7d, 0x01, 0x01, 0x01,
   0x01, 0x01, 0x01, 0x01, 0xff, 0x01
  };
}
image create bitmap Tree:openbm -data $data -maskdata $maskdata \
  -foreground black -background white
set data "#define closed_width 9\n#define closed_height 9"
append data {
  static unsigned char closed_bits[] = {
   0xff, 0x01, 0x01, 0x01, 0x11, 0x01, 0x11, 0x01, 0x7d, 0x01, 0x11, 0x01,
   0x11, 0x01, 0x01, 0x01, 0xff, 0x01
  };
}
image create bitmap Tree:closedbm -data $data -maskdata $maskdata \
  -foreground black -background white

# Internal use only.
# Draw the tree on the canvas
proc Tree:build w {
  global Tree
  $w delete all
  catch {unset Tree($w:buildpending)}
  set Tree($w:y) 30
  Tree:buildlayer $w / 10
  $w config -scrollregion [$w bbox all]
  Tree:drawselection $w
}

# Internal use only.
# Build a single layer of the tree on the canvas.  Indent by $in pixels
proc Tree:buildlayer {w v in} {
  global Tree
  if {$v=="/"} {
    set vx {}
  } else {
    set vx $v
  }
  set start [expr $Tree($w:y)-10]
  foreach c $Tree($w:$v:children) {
    set y $Tree($w:y)
    incr Tree($w:y) 17
    $w create line $in $y [expr $in+10] $y -fill gray50 
    set icon $Tree($w:$vx/$c:icon)
    set taglist x
    foreach tag $Tree($w:$vx/$c:tags) {
      lappend taglist $tag
    }
    set x [expr $in+12]
    if {[string length $icon]>0} {
      set k [$w create image $x $y -image $icon -anchor w -tags $taglist]
      incr x 20
      set Tree($w:tag:$k) $vx/$c
    }
    set j [$w create text $x $y -text $c -font $Tree(font) \
	   -anchor w -tags $taglist]
    set Tree($w:tag:$j) $vx/$c
    set Tree($w:$vx/$c:tag) $j
    if {[string length $Tree($w:$vx/$c:children)]} {
      if {$Tree($w:$vx/$c:open)} {
	set j [$w create image $in $y -image Tree:openbm]
	$w bind $j <1> "set Tree([escape $w:$vx/$c:open]) 0; Tree:build $w"
	Tree:buildlayer $w $vx/$c [expr $in+18]
      } else {
	set j [$w create image $in $y -image Tree:closedbm]
	$w bind $j <1> "set Tree([escape $w:$vx/$c:open]) 1; Tree:build $w"
      }
    }
  }
  if { [llength $Tree($w:$v:children)] } {
    set j [$w create line $in $start $in [expr $y+1] -fill gray50 ]
    $w lower $j
  }
}

# Open a branch of a tree
#
proc Tree:open {w v} {
  global Tree
  if {[info exists Tree($w:$v:open)] && $Tree($w:$v:open)==0
      && [info exists Tree($w:$v:children)] 
      && [string length $Tree($w:$v:children)]>0} {
    set Tree($w:$v:open) 1
    Tree:build $w
  }
}

proc Tree:close {w v} {
  global Tree
  if {[info exists Tree($w:$v:open)] && $Tree($w:$v:open)==1} {
    set Tree($w:$v:open) 0
    Tree:build $w
  }
}

# Internal use only.
# Draw the selection highlight
proc Tree:drawselection w {
  global Tree
  if {[string length $Tree($w:selidx)]} {
    $w delete $Tree($w:selidx)
  }
  set v $Tree($w:selection)
  if {[string length $v]==0} return
  if {![info exists Tree($w:$v:tag)]} return
  set bbox [$w bbox $Tree($w:$v:tag)]
  if {[llength $bbox]==4} {
    set i [eval $w create rectangle $bbox -fill skyblue -outline {{}}]
    set Tree($w:selidx) $i
    $w lower $i
  } else {
    set Tree($w:selidx) {}
  }
}

# Internal use only
# Call Tree:build then next time we're idle
proc Tree:buildwhenidle w {
  global Tree
  if {![info exists Tree($w:buildpending)]} {
    set Tree($w:buildpending) 1
    after idle "Tree:build $w"
  }
}

#
# Return the full pathname of the label for widget $w that is located
# at real coordinates $x, $y
#
proc Tree:labelat {w x y} {
  set x [$w canvasx $x]
  set y [$w canvasy $y]
  global Tree
  foreach m [$w find overlapping $x $y $x $y] {
    if {[info exists Tree($w:tag:$m)]} {
      return $Tree($w:tag:$m)
    }
  }
  return ""
}
