#!../tree_wish -f
# -*-Tcl-*-
#
# dirtree - tcl tree demo application: directory tree browser
# 
# This is an older demo that is based only on the C++ tree widget and
# doesn't use [incr Tcl] or any external tcl libraries.
# It demonstrates how you can have windows as (parts of) tree nodes
#
# Author: Allan Brighton (abrighto@eso.org) 


lappend auto_path ../library 
source util.tcl

#set_default_resources
#option readfile Xdefaults

# usage error message
set dirtree(usage) {
 usage: dirtree ?dir? ?options...?
    	
 Option              Arg Type      Description
 -----------------------------------------------------------------------
 -lookahead          none          display directories with subdirs in bold face
 -bitmapcolor        Tk color      color of directory bitmaps
 -bitmapselectcolor  Tk color      color of directory bitmaps when selected
 -linecolor          Tk color      color of tree lines
 -colormodel         keyword       set to "color" or "monochrome"
 -font               fontname      font used to display tree nodes
 -boldfont           fontname      bold font used to display tree nodes
}
    


# Create the main window and initialize the tree to 
# the given dir.
#
# If width and height are specified, they are used for the
# size of the canvas window.

proc MakeWindow {dir} {
    global dirtree 
    set frame .frame
    set canvas $frame.canvas
    set tree $canvas.tree
    set menubar .menubar
    
    wm minsize . 10 10
    
    frame $frame
    MakeMenuBar $canvas $tree $menubar $dir
    pack $frame -side top -expand yes -fill both 
    MakeCanvas $frame $canvas

    # declare the tree
    tree $tree  
    
    # add root dir
    AddDir $canvas $tree "" $dir [dir_tail $dir]
    ListDirs $canvas $tree $dir
    SetBindings $canvas $tree
}


# return the last component of the directory name
# (/ is a special case)

proc dir_tail {dir} {
    if {$dir == "/"} {return $dir}
   return [file tail $dir]
}

    
 
# make the tree window's menu bar
#
# Args:
#
# canvas -  the canvas containing the tree
# tree   -  the tree widget
# menubar - the name to use for the menubar frame
# dir     - the initial directory

proc MakeMenuBar {canvas tree menubar dir} {
    global dirtree argv0 argv
    frame $menubar -relief raised -bd 2
    pack $menubar -side top -fill x -ipady 1m
   
    # menu items
    
    # file menu
    menubutton $menubar.file -text "File" -menu $menubar.file.m
    menu $menubar.file.m -tearoff 0
    pack $menubar.file -side left
    $menubar.file.m add command -label "New Window" -command "exec $argv0 $argv &"
    $menubar.file.m add separator
    $menubar.file.m add command -label "Exit" -command {exit 0}
    
    # view menu
    pack [menubutton $menubar.view -text "View" -menu $menubar.view.m] \
	-side left
    #pack $menubar.view -side left -padx 1m -ipadx 1m
    menu $menubar.view.m -post "UpdateViewMenu $canvas $tree $menubar.view.m" -tearoff 0
    $menubar.view.m add command -label "Open File List" \
	-command "ShowFiles $canvas $tree"
    $menubar.view.m add command -label "Show Subdirs" \
	-command "ToggleChildren $canvas $tree"
    $menubar.view.m add command -label "Add Parent" \
	-command "ToggleParent $canvas $tree"
    $menubar.view.m add command -label "Hide Dir" \
	-command "HideNode $canvas $tree"
    $menubar.view.m add separator
    $menubar.view.m add command -label "Vertical Layout" \
	-command "ToggleLayout $canvas $tree"
    
    # directory text entry item for setting a new root of the tree
    frame $menubar.dirframe
    label $menubar.dirlabel -text "Dir:"
    entry $menubar.direntry -width 60 -relief sunken -textvariable dirtree(direntry)
    set dirtree(direntry) $dir 
    wm iconname . [dir_tail $dir]
    pack $menubar.dirframe -side right -padx 1m -ipadx 1m
    pack $menubar.dirlabel $menubar.direntry -side left -in $menubar.dirframe

    bind $menubar.direntry <Return> "SetNewRoot $canvas $tree \$dirtree(direntry)"
}


# This procedure is called each time the View menu is displayed
# to update the menu to reflect the current selection
# (This must be kept up to date with the above procedure that creates the menu)

proc UpdateViewMenu {canvas tree menu} {
    
    if {[set path [GetPath $canvas]] == ""} {
	$menu entryconfig 0 -state disabled
	$menu entryconfig 1 -state disabled
	$menu entryconfig 2 -state disabled
	$menu entryconfig 3 -state disabled
    } else {
	if [llength [$canvas find withtag $path:list]] {
	    $menu entryconfig 0 -label "Close File List" -state normal
	} else {
	    $menu entryconfig 0 -label "Open File List"  -state normal
	}
	
	if [$tree isleaf $path] {
	    $menu entryconfig 1 -label "Show Subdirs"  -state normal
	} else {
	    $menu entryconfig 1 -label "Hide Subdirs" -state normal
	}
	
	if [$tree isroot $path] {
	    $menu entryconfig 2 -label "Add Parent Dir" -state normal
	    $menu entryconfig 3 -state disabled
	} else {
	    $menu entryconfig 2 -label "Begin Tree Here" -state normal
	    $menu entryconfig 3 -state normal
	}
    }
    if {[$tree cget -layout] == "horizontal"} {
	$menu entryconfig 5 -label "Vertical Layout"
    } else {
	$menu entryconfig 5 -label "Horizontal Layout"
    }
}


# set the bindings for the tree canvas

proc SetBindings {canvas tree} {
    $canvas bind text <1> "focus %W; SelectNode $canvas"
    $canvas bind text <2> "focus %W; SelectNode $canvas; ShowFiles $canvas $tree"
    $canvas bind text <Double-Button-1> "ToggleChildren $canvas $tree"
    $canvas bind bitmap <1> "SelectBitmap $canvas $tree"
    $canvas bind bitmap <Double-Button-1> "ToggleParent $canvas $tree"
   
    bind $canvas <ButtonPress-2> "$canvas scan mark %x %y"
    bind $canvas <B2-Motion> "$canvas scan dragto %x %y"
    bind $canvas <Left> "SelectNext $canvas $tree %K"
    bind $canvas <Right> "SelectNext $canvas $tree %K"
    bind $canvas <Down> "SelectNext $canvas $tree %K"
    bind $canvas <Up> "SelectNext $canvas $tree %K"
    bind $canvas <Return> "ToggleChildren $canvas $tree"
    
    # Cut key on Sun keyboard removes node
    bind $canvas <L10> "HideNode $canvas $tree"
    bind $canvas <Control-d> "HideNode $canvas $tree"
}


# set the bindings for a file list in the tree canvas

proc SetFileListBindings {canvas tree frame list scroll dir} {
    global dirtree
    bind $frame <ButtonPress-1> "ResizeList $canvas $tree $frame $list %x %y $dir first"
    bind $frame <Button1-Motion> "ResizeList $canvas $tree $frame $list %x %y $dir"
    bind $frame <ButtonRelease-1> "ResizeList $canvas $tree $frame $list %x %y $dir last"
    
    bind $list <1>  "set dirtree(list) %W; set dirtree(dir) $dir; [bind Listbox <1>]"
    bind $list <Double-Button-1> ChooseFile
    
    # set/clear the resize cursor
    bind $list <Any-Enter> "$frame config -cursor {}"
    bind $list <Any-Leave> "$frame config -cursor bottom_right_corner"
    bind $scroll <Any-Enter> "$frame config -cursor {}"
    bind $scroll <Any-Leave> "$frame config -cursor bottom_right_corner"
}


# Erase the tree and make dir the new root 

proc SetNewRoot {canvas tree dir} {
    # get the normalized pathname
    set path [exec /bin/csh -cf "if ( -d ${dir}/ ) cd $dir; pwd"]
    
    if {"$path" == "" || ![file isdirectory $path]} {return}
    
    $tree prune ""
    AddDir $canvas $tree "" $path [dir_tail $path]
    ListDirs $canvas $tree $path
    
    # update the dir entry
    global dirtree
    set dirtree(direntry) $path
    set dirtree(list) ""
    wm iconname . [dir_tail $dir]
}



# select the current node's label

proc SelectNode {canvas} {
    $canvas select from current 0
    $canvas select to current [string length [$canvas itemcget current -text]]
    DeSelectBitmap $canvas
}


# select the current node's parent, child or sibling
# depending on the value of direction (Left, Right, Up or Down)

proc SelectNext {canvas tree direction} {
    set id [$canvas select item]
    set path [lindex [$canvas gettags $id] 0]
    
    # for vertical trees its different...
    if {[$tree cget -layout] == "vertical"} {
	case $direction in {
	    Left	{set direction Up}
	    Right	{set direction Down}
	    Up	{set direction Left}
	    Down	{set direction Right}
	}
    }
    
    case $direction in {
        Left	{
        	    set node [$tree parent $path]
         	    if {"$node" == ""} {
         	        ToggleParent $canvas $tree
         	        set node [$tree parent $path]
        	    }
       	}
        Right	{
        	    set node [$tree child $path]
        	    if {"$node" == ""} {
			ListDirs $canvas $tree $path
        	        set node [$tree child $path]
			$tree draw
        	    }
                }
        Down	{
        	    set node [$tree sibling $path]
        	    if {"$node" == ""} {
        	        set node [$tree child [$tree parent $path]]
        	    }
        	}
        Up	{
        	    set next [$tree child [$tree parent $path]]
		    while {"$next" != ""} {
		        set node $next
		        set next [$tree sibling $next]
		        if {"$next" == "$path"} {
		            break;
		        }
		    }
                }
        default {return}
    }
    if {"$node" != ""} {
        set next [$canvas find withtag $node:text]
        $canvas select from $next 0
        $canvas select to $next [string length [$canvas itemcget $next -text]]
    }
}


# de-select all node labels

proc DeSelectNode {canvas} {
    $canvas select clear
}


# return the pathname (dir) for the item currently selected (bitmap or text)

proc GetPath {canvas} {
    set id [$canvas select item]
    if {"$id" == ""} {
        return [lindex [$canvas gettags selected] 0]
    }
    return [lindex [$canvas gettags $id] 0]
}

  
# Return the current filename (from the list, with dirname) 
# if one is selected

proc GetFilename {} {
    global dirtree
    set dir $dirtree(dir)
    set list $dirtree(list)
    if {"$dir" == "" || "$list" == ""} {return ""}
    
    set sel [$list curselection]
    if {![llength $sel]} {return ""}
    return $dir/[$list get [lindex $sel 0]]
}
    
  


# If the current selection is a leaf, add its subnodes, otherwise
# remove them

proc ToggleChildren {canvas tree} {
    set path [GetPath $canvas]
    if [$tree isleaf $path] {
	 ListDirs $canvas $tree $path
	 $tree draw
    } else {
	$tree prune $path
    }
}



# highlight the node's bitmap

proc SelectBitmap {canvas tree} {
    global dirtree
    catch {focus {}}
    set path [lindex [$canvas gettags current] 0]
    DeSelectNode $canvas
    DeSelectBitmap $canvas
    $canvas itemconfig current -background $dirtree(bitmapSelectColor) \
	-tags "[$canvas gettags current] selected" 
}



# stop highlighting the node's bitmap

proc DeSelectBitmap {canvas} {
    $canvas itemconfig selected -background [$canvas cget -background]
    $canvas dtag selected
}



# If the selected node is the root of the tree, add its parent and siblings
# to the tree, otherwise make the selected node the new root of the tree.

proc ToggleParent {canvas tree} {
    global dirtree
    set path [GetPath $canvas]
    DeSelectBitmap $canvas
    if [$tree isroot $path] {
       set dir [file dirname $path]
       if {$dir != $path} {
	    AddDir $canvas $tree "" $dir [dir_tail $dir]
	    set dirtree(direntry) $dir
    	    wm iconname . [dir_tail $dir]
	    set tail [file tail $path]
	    foreach i [dir lsdirs $dir] {
		if {$i == $tail} {
		     $tree movelink $path $dir
		} else {
		    AddDir $canvas $tree $dir $dir/$i "$i"
		}
	    }
	   $tree draw
       }
    } else {
	$tree root $path
	 set dirtree(direntry) $path
         wm iconname . [dir_tail $path]
    }
}


# remove the selected node and its subnodes from the display

proc HideNode {canvas tree} {
    set path [GetPath $canvas]
    if {"$path" != "" && ![$tree isroot $path]} {
        $tree rmlink $path
    }
}


# Toggle the layout of the tree between vertical and horizontal

proc ToggleLayout {canvas tree} {
    if {[$tree cget -layout] == "horizontal"} {
        $tree config -layout vertical
    } else {
        $tree config -layout horizontal
    }
    
    # change the layout of the nodes so that the bitmap is on top for
    # vertical trees and at left for horizontal trees
    foreach i [$canvas find withtag text] {
        set dir [lindex [$canvas gettags $i] 0]
        LayoutNode $canvas $tree $dir
        $tree nodeconfig $dir
    }
}


# layout the components of the given node depending on whether
# the tree is vertical or horizontal

proc LayoutNode {canvas tree dir} {
    set text $dir:text
    set bitmap $dir:bitmap
    set list [$canvas find withtag $dir:list]
    
    if {[$tree cget -layout] == "horizontal"} {
        scan [$canvas bbox $text] "%d %d %d %d" x1 y1 x2 y2
	$canvas itemconfig $bitmap -anchor se
	$canvas coords $bitmap $x1 $y2
	if {"$list" != ""} {
	    scan  [$canvas bbox $text $bitmap] "%d %d %d %d" x1 y1 x2 y2
	    $canvas itemconfig $list -anchor nw
	    $canvas coords $list $x1 $y2
	}
    } else {
        scan [$canvas bbox $bitmap] "%d %d %d %d" x1 y1 x2 y2
	$canvas itemconfig $text -anchor n
	$canvas coords $text [expr "$x1+($x2-$x1)/2"] $y2
	if {"$list" != ""} {
	    scan  [$canvas bbox $text $bitmap] "%d %d %d %d" x1 y1 x2 y2
	    $canvas itemconfig $list -anchor n
	    $canvas coords $list [expr "$x1+($x2-$x1)/2"] $y2
	}
    }
}


# display the directory tree for $dir in canvas $c


# add the dirs under $dir to the tree
 
proc ListDirs {canvas tree dir} {
    
    foreach i [dir lsdirs $dir] {
  	AddDir $canvas $tree $dir $dir/$i "$i"
    }
}


# This proc is called when the user double-clicks on a filename 
# in one of the listboxes listing the files in a directory.

proc ChooseFile {} {
    set file [GetFilename]
    if {"$file" == ""} {return}
    puts "got $file"
}


# add a node to the tree (if not already there)
#
# Args: 
#  canvas  - tree's canvas
#  tree    - the tree
#  parent  - pathname of parent dir 
#  dir     - pathname of new dir being added
#  text    - text for tree node label (last component of dir)

proc AddDir {canvas tree parent dir text} {
    global dirtree
    
    # don't add the node if its already there
    if [llength [$canvas find withtag $dir]] {
        return
    }
    
    # make it more obvious, which directories have subdirs
    # by making them bold and the others normal
    # (looking ahead can drag the performance down)
    set font $dirtree(font)
    catch {
	if {$dirtree(lookAhead) && [llength [dir lsdirs $dir]]} {
	    set font $dirtree(boldfont)
	}
    }

    # display links with different bitmap
    if {"[file type $dir]" == "link"} {
	set bitmap "@$dirtree(bitmaps)/link.xbm"
    } else {
	set bitmap "@$dirtree(bitmaps)/dir.xbm"
    }
       
    $canvas create bitmap 0 0 -bitmap $bitmap \
	-tags "$dir bitmap $dir:bitmap" \
        -foreground $dirtree(bitmapColor)
    $canvas create text 0 0 -text "$text" -font $font -tags "$dir text $dir:text"
    set line [$canvas create line 0 0 0 0 -tag "line" \
		  -width 1 -capstyle round -fill $dirtree(lineColor)]
    LayoutNode $canvas $tree $dir
    $tree addlink $parent $dir $line -border 2
}


# return true if one of the patterns in $dirtree(invisible) matches
# the given filename

proc IgnoreFile {file} {
    global dirtree
    foreach i $dirtree(ignore) {
	if {[string match $i $file]} {
	    return "1"
	}
    }
    return "0"
}


# make the list frame for displaying the files in dir

proc MakeListFrame {canvas tree frame dir} {
    global dirtree 
    set bg [$canvas cget -bg]
    
    # make the list frame and set up resizing 
    frame $frame -borderwidth 3 -cursor bottom_right_corner
    set list $frame.list
    set scroll $frame.scroll
    scrollbar $scroll -relief sunken -command "$list yview" -width 10
    listbox $list -yscrollcommand "$scroll set" -relief sunken	\
	-bg $bg -selectmode single
    pack $scroll -side right -fill y 
    pack $list -side left -expand yes -fill both
    
    # fill the list with the files in the selected dir
    # (with the uninteresting files filtered out)
    set n 0
    foreach i [lsort [dir lsfiles $dir]] {
	if [IgnoreFile $i] {
	    continue
	}
	incr n
	$list insert end $i
    }
    
    # insert the list frame in the canvas
    $canvas create window 0 0 -tags "$dir $dir:list list" -window $frame -width 3c -height 2c
    LayoutNode $canvas $tree $dir
    $canvas itemconfig $dir:bitmap -bitmap "@$dirtree(bitmaps)/open_dir.xbm"
    $tree nodeconfig $dir -remove "destroy $frame" 
    SetFileListBindings $canvas $tree $frame $list $scroll $dir
}


# remove the list frame for displaying the files in dir

proc RemoveListFrame {canvas tree frame dir} {
    global dirtree 
    $canvas delete $dir:list
    destroy $frame

    # display links with different bitmap
    if {"[file type $dir]" == "link"} {
	set bitmap "@$dirtree(bitmaps)/link.xbm"
    } else {
	set bitmap "@$dirtree(bitmaps)/dir.xbm"
    }
    $canvas itemconfig $dir:bitmap -bitmap $bitmap
    $tree nodeconfig $dir -remove "" -border 2
    set dirtree(list) ""
    set dirtree(dir) ""
}



# generates a unique name for a widget from the given
# directory name by replacing the '.'s with '_'s

proc UniqueName {canvas dir} {
    global dirtree
    if {![catch {set path $dirtree($canvas.$dir)}]} {
	return $path
    }
    if {[catch {incr dirtree(listboxcnt)}]} {
	set dirtree(listboxcnt) 0
    } 
    set dirtree($canvas.$dir) $canvas.list$dirtree(listboxcnt)
    return $dirtree($canvas.$dir)
}



# Display the file names in the selected directory in
# a scrolling list beneath the node

proc ShowFiles {canvas tree} {
    set dir [GetPath $canvas]
    set frame [UniqueName $canvas $dir]
    
    # create the frame and list if not already there
    if {![llength [$canvas find withtag $dir:list]]} {
        MakeListFrame $canvas $tree $frame $dir
    } else {
        RemoveListFrame $canvas $tree $frame $dir
    }
}


# event proc called when a list is resized

proc ResizeList {canvas tree frame list x y dir {when any}} {
    global dirtree
    
    case "$when" {
	"first" {
	    set dirtree(tlx) $x
	    set dirtree(tly) $y
	} 
	"last" {
	    $tree nodeconfig $dir
	}
	default {
	    set w [$canvas itemcget $dir:list -width]
	    set h [$canvas itemcget $dir:list -height]
	    set nw [expr $w+($x-$dirtree(tlx))]
	    set nh [expr $h+($y-$dirtree(tly))]
	    $canvas itemconfig $dir:list -width $nw -height $nh
	    set dirtree(tlx) $x
	    set dirtree(tly) $y
	}
    }
}


# local initialization

proc DirtreeInit {} {
    global dirtree
    
    # these 2 variables are used to keep track of the current open file list and dir
    set dirtree(dir) ""
    set dirtree(list) ""
    
    # List of files to ignore (should be an option ?)
    set dirtree(ignore) ".* *% *~ core *.BAK #* *.o"


    # directory containing bitmap files
    set dirtree(bitmaps) ../bitmaps

    # create a dir object to use for listing files and dirs
    Dir dir
}


# parse the command line options
#
# Usage: dirtree ?dir? ?option arg option arg?
#

proc ParseOptions {argv} {
    global dirtree
    
    # set initial values
    set dirtree(lookAhead) ""
    set dirtree(cwd) ""
    set dirtree(bitmapColor) ""
    set dirtree(bitmapSelectColor) ""
    set dirtree(lineColor) ""
    set dirtree(font) -Adobe-Helvetica-Medium-R-Normal--*-120-*
    set dirtree(boldfont) -Adobe-Helvetica-Bold-R-Normal--*-120-*
    
    # parse options
    set n [llength $argv]
    for {set i 0} {$i < $n} {incr i} {
	set opt [lindex $argv $i]
	if {"[string index $opt 0]" == "-" && "$opt" != "-lookahead"} {
	    set arg [lindex $argv [incr i]]
	}
	case $opt in {
	    -lookahead		{set dirtree(lookAhead) 1}
	    -colormodel		{tk colormodel . $arg; puts stderr "color = [tk colormodel .]"}
	    -bitmapcolor	{set dirtree(bitmapColor) $arg}
	    -bitmapselectcolor	{set dirtree(bitmapSelectColor) $arg}
	    -linecolor		{set dirtree(lineColor) $arg}
	    -font		{set dirtree(font) $arg}
	    -boldfont		{set dirtree(boldfont) $arg}
	    default		{if [file isdirectory $opt] {
	     			      set dirtree(cwd) $opt
	     			 } else { 
	     			      puts stderr $dirtree(usage)
	     			      exit 1
	     			 }}
	}
    }
    
    # set any values that were not explicitly set as options
    if {"$dirtree(lookAhead)" == ""} {
        set dirtree(lookAhead) 0
    }
            
    if {"$dirtree(cwd)" == ""} {
        set dirtree(cwd) [file dirname [exec pwd]]
    }
    
    if {"$dirtree(bitmapColor)" == ""} {
        set dirtree(bitmapColor) red
    }
    
    if {"$dirtree(bitmapSelectColor)" == ""} {
	canvas .tmp
        set dirtree(bitmapSelectColor) [.tmp cget -selectbackground]
	destroy .tmp
    }
    
    if {"$dirtree(lineColor)" == ""} {
        set dirtree(lineColor) black
    }

    # set some resources
    option add *Listbox*font "-Adobe-Helvetica-Medium-R-Normal--*-100-*"

}


# ---------------------------------------------------------------------------
# main 

wm title . "DirTree"
wm geometry . 600x400

# local initialization
DirtreeInit

# parse the command line options
ParseOptions $argv

# create the main window
MakeWindow $dirtree(cwd)

