Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -18,10 +18,11 @@ WCB = /home/peter/src/packages/wcb3.0 PDF4TCL = /home/peter/src/pdf4tcl/pkg SNIT = /home/peter/tcl/tcllib/modules/snit STRUCT = /home/peter/tcl/tcllib/modules/struct CMDLINE = /home/peter/tcl/tcllib/modules/cmdline +TABLELIST = /home/peter/src/packages/tablelist/tablelist TWAPI = /home/peter/src/packages/twapi TKDND = /home/peter/src/packages/tkdnd/lib/tkdnd1.0 # Tools NAGELFAR = nagelfar @@ -36,10 +37,12 @@ # Setup symbolic links from the VFS to the real files #---------------------------------------------------------------- eskil.vfs/src/eskil.tcl: @cd eskil.vfs/src ; for i in $(SRCFILES); do ln -fs ../../$$i ; done +eskil.vfs/src/images: + @cd eskil.vfs/src ; ln -fs ../../src/images eskil.vfs/examples: cd eskil.vfs ; ln -s ../examples eskil.vfs/doc: cd eskil.vfs ; ln -s ../doc eskil.vfs/plugins: @@ -58,10 +61,12 @@ cd eskil.vfs/lib ; ln -s $(DIFFUTIL) diffutil eskil.vfs/lib/pdf4tcl: cd eskil.vfs/lib ; ln -s $(PDF4TCL) pdf4tcl eskil.vfs/lib/tkdnd: cd eskil.vfs/lib ; ln -s $(TKDND) tkdnd +eskil.vfs/lib/tablelist: + cd eskil.vfs/lib ; ln -s $(TABLELIST) tablelist eskil.vfs/lib/snit: cd eskil.vfs/lib ; mkdir snit cd eskil.vfs/lib/snit ; ln -s $(SNIT)/pkgIndex.tcl cd eskil.vfs/lib/snit ; ln -s $(SNIT)/snit.tcl cd eskil.vfs/lib/snit ; ln -s $(SNIT)/snit2.tcl @@ -74,10 +79,11 @@ cd eskil.vfs/lib/struct ; ln -s $(STRUCT)/list.tcl eskil.vfs/lib/cmdline: cd eskil.vfs/lib ; ln -s $(CMDLINE) cmdline links: eskil.vfs/src/eskil.tcl \ + eskil.vfs/src/images \ eskil.vfs/examples\ eskil.vfs/doc\ eskil.vfs/plugins\ eskil.vfs/COPYING\ eskil.vfs/lib/griffin\ @@ -87,10 +93,11 @@ eskil.vfs/lib/pdf4tcl\ eskil.vfs/lib/snit\ eskil.vfs/lib/struct\ eskil.vfs/lib/cmdline\ eskil.vfs/lib/tkdnd\ + eskil.vfs/lib/tablelist\ eskil.vfs/lib/wcb setup: links #---------------------------------------------------------------- ADDED examples/dir1/link Index: examples/dir1/link ================================================================== --- /dev/null +++ examples/dir1/link @@ -0,0 +1,1 @@ +casechange ADDED examples/dir2/link Index: examples/dir2/link ================================================================== --- /dev/null +++ examples/dir2/link @@ -0,0 +1,1 @@ +casechange Index: src/dirdiff.tcl ================================================================== --- src/dirdiff.tcl +++ src/dirdiff.tcl @@ -1,9 +1,9 @@ #---------------------------------------------------------------------- # Eskil, Directory diff section # -# Copyright (c) 1998-2007, Peter Spjuth (peter.spjuth@gmail.com) +# Copyright (c) 1998-2010, Peter Spjuth (peter.spjuth@gmail.com) # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. @@ -19,10 +19,12 @@ # Boston, MA 02111-1307, USA. # #---------------------------------------------------------------------- # $Revision$ #---------------------------------------------------------------------- + +package require tablelist_tile # Compare file names proc FStrCmp {s1 s2} { # Equality is based on platform's standard # Order is dictionary order @@ -52,23 +54,34 @@ # Compare two files or dirs # Return true if equal proc CompareFiles {file1 file2} { global Pref - if {[catch {file stat $file1 stat1}]} { + if {[catch {file lstat $file1 stat1}]} { return 0 } - if {[catch {file stat $file2 stat2}]} { + if {[catch {file lstat $file2 stat2}]} { return 0 } # Same type? set isdir1 [FileIsDirectory $file1] set isdir2 [FileIsDirectory $file2] if {$isdir1 != $isdir2} { return 0 } + # Handle links + if {$stat1(type) eq "link" && $stat2(type) eq "link"} { + set l1 [file link $file1] + set l2 [file link $file2] + # Equal links are considered equal, otherwise check contents + if {$l1 eq $l2} { + return 1 + } + file stat $file1 stat1 + file stat $file2 stat2 + } # If contents is not checked, same size is enough to be equal if {$stat1(size) == $stat2(size) && $Pref(dir,comparelevel) == 0} { return 1 } set ignorekey $Pref(dir,ignorekey) @@ -236,10 +249,11 @@ $entryW xview end } } snit::widget DirCompareTree { + hulltype ttk::frame component tree component hsb component vsb option -leftdirvariable -default "" -configuremethod SetDirOption @@ -246,57 +260,72 @@ option -rightdirvariable -default "" -configuremethod SetDirOption option -statusvar -default "" variable AfterId "" variable PauseBgProcessing 0 + variable ScheduledRestart 0 variable IdleQueue {} variable IdleQueueArr variable leftMark "" variable rightMark "" variable leftDir "" variable rightDir "" + variable img constructor {args} { - install tree using ttk::treeview $win.tree -height 20 \ - -columns {type status leftfull leftname leftsize leftdate rightfull rightname rightsize rightdate} \ - -displaycolumns {leftsize leftdate rightsize rightdate} -# Experiment to show less. FIXA -# -displaycolumns {leftname leftsize leftdate rightname rightsize rightdate} + variable color + install tree using tablelist::tablelist $win.tree -height 20 \ + -movablecolumns no -setgrid no -showseparators yes \ + -expandcommand [mymethod expandCmd] \ + -collapsecommand [mymethod collapseCmd] \ + -fullseparators yes -selectmode none \ + -columns {0 "Structure" 0 Size 0 Date 0 Copy 0 Size 0 Date} install vsb using scrollbar $win.vsb -orient vertical \ -command "$tree yview" install hsb using scrollbar $win.hsb -orient horizontal \ -command "$tree xview" + # Use demo images from Tablelist + set dir $::eskil(thisDir)/../lib/tablelist/demos + set img(clsd) [image create photo -file [file join $dir clsdFolder.gif]] + set img(open) [image create photo -file [file join $dir openFolder.gif]] + set img(file) [image create photo -file [file join $dir file.gif]] + # Local images + set dir $::eskil(thisDir)/images + set img(link) [image create photo -file [file join $dir link.gif]] + set img(left) [image create photo -file [file join $dir arrow_left.gif]] + set img(right) [image create photo -file [file join $dir arrow_right.gif]] + set AfterId "" set IdleQueue {} - $tree configure -yscroll "$vsb set" -xscroll "$hsb set" - - $tree heading \#0 -text "Structure" - $tree heading leftname -text "Name" - $tree heading leftsize -text "Size" - $tree heading leftdate -text "Date" - $tree heading rightname -text "Name" - $tree heading rightsize -text "Size" - $tree heading rightdate -text "Date" - - $tree column leftsize -stretch 0 -width 70 -anchor e - $tree column rightsize -stretch 0 -width 70 -anchor e - $tree column leftdate -stretch 0 -width 120 - $tree column rightdate -stretch 0 -width 120 - - $tree tag configure unknown -foreground grey - $tree tag configure empty -foreground grey - $tree tag configure equal -foreground {} - $tree tag configure new -foreground green - $tree tag configure old -foreground blue - $tree tag configure change -foreground red - - bind $tree <> "[mymethod UpdateDirNode] \[%W focus\]" - bind $tree "[mymethod ContextMenu] %x %y %X %Y" - bind $tree "[mymethod DoubleClick] %x %y" - bind $tree [mymethod KeyReturn] + $tree configure -yscrollcommand "$vsb set" -xscrollcommand "$hsb set" + + $tree columnconfigure 0 -name structure + $tree columnconfigure 1 -name leftsize -align right + $tree columnconfigure 2 -name leftdate + $tree columnconfigure 3 -name command + $tree columnconfigure 4 -name rightsize -align right + $tree columnconfigure 5 -name rightdate + + destroy [$tree separatorpath 1] [$tree separatorpath 4] + + set color(unknown) grey + set color(empty) grey + set color(equal) {} + set color(new) green + set color(old) blue + set color(change) red + + #-expandcommand expandCmd + #bind $tree <> "[mymethod UpdateDirNode] \[%W focus\]" + set bodyTag [$tree bodytag] + bind $bodyTag <> [bind TablelistBody ] + bind $bodyTag <> +[bind TablelistBody ] + bind $bodyTag <> "+[mymethod ContextMenu] %W %x %y %X %Y" + bind $bodyTag "[mymethod DoubleClick] %W %x %y" + bind $bodyTag [mymethod KeyReturn] grid $tree $vsb -sticky nsew grid $hsb -sticky nsew grid columnconfigure $win 0 -weight 1 grid rowconfigure $win 0 -weight 1 @@ -324,11 +353,14 @@ if {![info exists right]} return if {![file isdirectory $right]} return set leftDir $left set rightDir $right - after idle [mymethod ReStart] + if {!$ScheduledRestart} { + set ScheduledRestart 1 + after idle [mymethod ReStart] + } } method newTopDir {newLeft newRight} { if {$newLeft ne "" && [file isdirectory $newLeft]} { upvar \#0 $options(-leftdirvariable) left set left $newLeft @@ -337,81 +369,95 @@ if {$newRight ne "" && [file isdirectory $newRight]} { upvar \#0 $options(-rightdirvariable) right set right $newRight set rightDir $right } - after idle [mymethod ReStart] + if {!$ScheduledRestart} { + set ScheduledRestart 1 + after idle [mymethod ReStart] + } } method ReStart {} { # Delete all idle processing if {$AfterId ne ""} { after cancel $AfterId } set AfterId "" set IdleQueue {} + set ScheduledRestart 0 array unset IdleQueueArr # Fill in clean root data - $tree delete [$tree children {}] - $tree set {} type directory - $self SetNodeStatus {} empty - $tree set {} leftfull $leftDir - $tree set {} leftname [file tail $leftDir] - $tree set {} rightfull $rightDir - $tree set {} rightname [file tail $rightDir] - - $self UpdateDirNode {} + $tree delete 0 end + set topIndex [$tree insertchild root end {}] + set d1 [file tail $leftDir] + set d2 [file tail $rightDir] + if {$d1 eq $d2} { + $tree cellconfigure $topIndex,structure -text $d1 + } else { + $tree cellconfigure $topIndex,structure -text "$d1 vs $d2" + } + $tree cellconfigure $topIndex,structure -image $img(open) + $tree rowattrib $topIndex type directory + $self SetNodeStatus $topIndex empty + $tree rowattrib $topIndex leftfull $leftDir + $tree rowattrib $topIndex rightfull $rightDir + + $self UpdateDirNode $topIndex + } + + method expandCmd {tbl row} { + if {[$tree childcount $row] != 0} { + $tree cellconfigure $row,0 -image $img(open) + } + } + + method collapseCmd {tbl row} { + $tree cellconfigure $row,0 -image $img(clsd) } # Format a time stamp for display proc FormatDate {date} { clock format $date -format "%Y-%m-%d %H:%M:%S" } # Remove all equal nodes from tree method PruneEqual {} { - set todo [$tree children {}] + set todo [$tree childkeys root] while {[llength $todo] > 0} { set todoNow $todo set todo {} foreach node $todoNow { - set status [$tree set $node status] + set status [$tree rowattrib $node status] if {$status eq "equal"} { $tree delete $node } else { - lappend todo {*}[$tree children $node] + lappend todo {*}[$tree childkeys $node] } } } } # Open or close all directories in the tree view method OpenAll {{state 1}} { - set todo [$tree children {}] - while {[llength $todo] > 0} { - set todoNow $todo - set todo {} - foreach node $todoNow { - set children [$tree children $node] - if {[llength $children] > 0} { - $tree item $node -open $state - lappend todo {*}$children - } - } + if {$state} { + $tree expandall + } else { + $tree collapseall } } # Copy a file from one directory to the other method CopyFile {node from} { global dirdiff Pref - set lf [$tree set $node leftfull] - set rf [$tree set $node rightfull] + set lf [$tree rowattrib $node leftfull] + set rf [$tree rowattrib $node rightfull] set parent [$tree parent $node] - set lp [$tree set $parent leftfull] - set rp [$tree set $parent rightfull] + set lp [$tree rowattrib $parent leftfull] + set rp [$tree rowattrib $parent rightfull] if {$from eq "left"} { set src $lf if {$rf ne ""} { set dst $rf @@ -449,16 +495,17 @@ } } } # React on double-click - method DoubleClick {x y} { - set node [$tree identify row $x $y] + method DoubleClick {W x y} { + foreach {W x y} [tablelist::convEventFields $W $x $y] break + set node [$tree index @$x,$y] - set lf [$tree set $node leftfull] - set rf [$tree set $node rightfull] - set type [$tree set $node type] + set lf [$tree rowattrib $node leftfull] + set rf [$tree rowattrib $node rightfull] + set type [$tree rowattrib $node type] # On a file that exists on both sides, start a file diff if {$type eq "file" && $lf ne "" && $rf ne ""} { set PauseBgProcessing 1 newDiff $lf $rf @@ -470,13 +517,13 @@ # React on Return key method KeyReturn {} { set node [$tree focus] if {$node eq ""} return - set lf [$tree set $node leftfull] - set rf [$tree set $node rightfull] - set type [$tree set $node type] + set lf [$tree rowattrib $node leftfull] + set rf [$tree rowattrib $node rightfull] + set type [$tree rowattrib $node type] # On a file that exists on both sides, start a file diff if {$type eq "file" && $lf ne "" && $rf ne ""} { set PauseBgProcessing 1 newDiff $lf $rf @@ -485,30 +532,30 @@ return -code break } } # Bring up a context menu on a file. - method ContextMenu {x y X Y} { - #global dirdiff Pref - - set node [$tree identify row $x $y] - set col [$tree identify column $x $y] - set colname [$tree column $col -id] - - set lf [$tree set $node leftfull] - set rf [$tree set $node rightfull] - set type [$tree set $node type] + method ContextMenu {W x y X Y} { + foreach {W x y} [tablelist::convEventFields $W $x $y] break + + set node [$tree index @$x,$y] + set col [$tree columnindex @$x,$y] + set colname [$tree columncget $col -name] + + set lf [$tree rowattrib $node leftfull] + set rf [$tree rowattrib $node rightfull] + set type [$tree rowattrib $node type] set oneside [expr {($lf ne "") ^ ($rf ne "")}] set m $win.popup destroy $m menu $m - if {$col eq "#0"} { + if {$colname eq "structure"} { $m add command -label "Prune equal" -command [mymethod PruneEqual] $m add command -label "Expand all" -command [mymethod OpenAll] - $m add command -label "Collaps all" -command [mymethod OpenAll 0] + $m add command -label "Collapse all" -command [mymethod OpenAll 0] } if {$type eq "file" && $lf ne "" && $rf ne ""} { # Files, both exist $m add command -label "Compare Files" -command [list \ @@ -582,11 +629,11 @@ while {[llength $IdleQueue] > 0} { set node [lindex $IdleQueue 0] set IdleQueue [lrange $IdleQueue 1 end] unset IdleQueueArr($node) - if {[$tree set $node type] ne "directory"} { + if {[$tree rowattrib $node type] ne "directory"} { set sts [catch {$self UpdateFileNode $node} err] } else { set sts [catch {$self UpdateDirNode $node} err] } if {$sts} { @@ -614,12 +661,12 @@ return } } if {[llength $IdleQueue] > 0} { - set leftfull [$tree set $node leftfull] - set rightfull [$tree set $node rightfull] + set leftfull [$tree rowattrib $node leftfull] + set rightfull [$tree rowattrib $node rightfull] if {$leftfull ne ""} { set statusvar $leftfull } else { set statusvar $rightfull } @@ -630,72 +677,65 @@ set AfterId "" } } method SetNodeStatus {node status} { - $tree set $node status $status - $tree item $node -tags $status + variable color + $tree rowattrib $node status $status + $tree rowconfigure $node -foreground $color($status) \ + -selectforeground $color($status) #puts "Set [$tree item $node -text] to $status" # Loop through children to update parent - set parent [$tree parent $node] - if {$parent eq ""} { return } + set parent [$tree parentkey $node] + if {$parent eq "" || $parent eq "root"} { return } # If this is only present on one side, there is no need to update - set lf [$tree set $parent leftfull] - set rf [$tree set $parent rightfull] + set lf [$tree rowattrib $parent leftfull] + set rf [$tree rowattrib $parent rightfull] if {$lf eq "" || $rf eq ""} { return } set pstatus equal - foreach child [$tree children $parent] { - set status [$tree set $child status] + foreach child [$tree childkeys $parent] { + set status [$tree rowattrib $child status] switch $status { unknown { set pstatus unknown - break } new - old - change { set pstatus change + break } } } - #puts "Setting parent [$tree set $parent leftname] to $pstatus" $self SetNodeStatus $parent $pstatus } method UpdateDirNode {node} { - if {[$tree set $node type] ne "directory"} { + if {[$tree rowattrib $node type] ne "directory"} { return } - if {[$tree set $node status] ne "empty"} { + if {[$tree rowattrib $node status] ne "empty"} { #puts "Dir [$tree set $node leftfull] already done" return } - $tree delete [$tree children $node] + $tree delete [$tree childkeys $node] - set leftfull [$tree set $node leftfull] - set rightfull [$tree set $node rightfull] + set leftfull [$tree rowattrib $node leftfull] + set rightfull [$tree rowattrib $node rightfull] $self CompareDirs $leftfull $rightfull $node } method UpdateFileNode {node} { - set leftfull [$tree set $node leftfull] - set rightfull [$tree set $node rightfull] + set leftfull [$tree rowattrib $node leftfull] + set rightfull [$tree rowattrib $node rightfull] set equal [CompareFiles $leftfull $rightfull] if {$equal} { $self SetNodeStatus $node equal } else { $self SetNodeStatus $node change } - - #$self CompareDirs $leftfull $rightfull $node - - #$self SetNodeStatus $node unknown - #$tree set $node leftfull - #$tree set $node leftname - #$tree set $node rightfull - #$tree set $node rightname } # List files under a directory node # Returns status for the new node method ListFiles {df1 df2 node} { @@ -719,37 +759,42 @@ } else { set size2 $stat2(size) set time2 [FormatDate $stat2(mtime)] } if {$type eq "directory"} { - # If a directory is present in only one side, make sure it shows - # up in that side's listing - set showleft "" - set showright "" - if {$df1 eq ""} { - set showright $name/ - } elseif {$df2 eq ""} { - set showleft $name/ - } - set values [list $type unknown \ - $df1 $showleft "" "" \ - $df2 $showright "" ""] + set values [list $name \ + "" "" \ + "" \ + "" ""] } else { - set name1 [file tail $df1] - set name2 [file tail $df2] - set values [list $type unknown \ - $df1 $name1 $size1 $time1 \ - $df2 $name2 $size2 $time2] - } - set id [$tree insert $node end -text $name \ - -values $values] + set values [list $name \ + $size1 $time1 \ + "" \ + $size2 $time2] + } + set id [$tree insertchild $node end $values] + $tree rowattrib $id type $type + $tree rowattrib $id status unknown + $tree rowattrib $id leftfull $df1 + $tree rowattrib $id rightfull $df2 + if {$type ne "directory"} { + if {$type eq "link"} { + $tree cellconfigure $id,structure -image $img(link) + } else { + $tree cellconfigure $id,structure -image $img(file) + $tree cellconfigure $id,command -window [mymethod addCmdCol] + } + } + if {$type eq "directory"} { ## Make it so that this node is openable - $tree insert $id 0 -text dummy ;# a dummy - $tree item $id -text $name/ + $tree collapse $id + #$tree insertchild $id end dummy ;# a dummy + $tree cellconfigure $id,structure -text $name/ $self SetNodeStatus $id empty $self AddNodeToIdle $id + $tree cellconfigure $id,structure -image $img(clsd) } elseif {$size1 == $size2 && \ $time1 == $time2} { $self SetNodeStatus $id equal } elseif {$size1 == ""} { $self SetNodeStatus $id new @@ -757,11 +802,33 @@ $self SetNodeStatus $id old } else { $self SetNodeStatus $id unknown $self AddNodeToIdle $id } - return [$tree set $id status] + return [$tree rowattrib $id status] + } + + method addCmdCol {tbl row col w} { + set status [$tree rowattrib $row status] + set type [$tree rowattrib $row type] + set lf [$tree rowattrib $row leftfull] + set rf [$tree rowattrib $row rightfull] + set bg [$tbl cget -background] + ttk::style configure Apa.TFrame -background $bg + ttk::style configure Apa.Toolbutton -background $bg + ttk::frame $w -style Apa.TFrame + ttk::button $w.bl -image $img(left) -style Apa.Toolbutton \ + -command [mymethod CopyFile $row right] + ttk::button $w.br -image $img(right) -style Apa.Toolbutton \ + -command [mymethod CopyFile $row left] + pack $w.bl $w.br -side left -fill y + if {$lf eq ""} { + $w.br configure -state disabled + } + if {$rf eq ""} { + $w.bl configure -state disabled + } } # Compare two directories. method CompareDirs {dir1 dir2 node} { global Pref @@ -854,10 +921,18 @@ constructor {args} { eskilRegisterToplevel $win wm title $win "Eskil Dir" wm protocol $win WM_DELETE_WINDOW [list cleanupAndExit $win] + set dir $::eskil(thisDir)/images + set img(open) [image create photo -file [file join $dir folderopen1.gif]] + set img(up) [image create photo -file [file join $dir arrow_up.gif]] + set h [image height $img(up)] + set w [image width $img(up)] + set img(upup) [image create photo -height $h -width [expr {2 * $w}]] + $img(upup) copy $img(up) -to 0 0 [expr {2 * $w - 1}] [expr {$h - 1}] + install tree using DirCompareTree $win.dc \ -leftdirvariable ::dirdiff(leftDir) \ -rightdirvariable ::dirdiff(rightDir) \ -statusvar [myvar statusVar] @@ -926,35 +1001,35 @@ -command {EskilRereadSource} $win.m.md add separator $win.m.md add command -label "Redraw Window" -command {makeDirDiffWin 1} } - ttk::button $win.bu -text "Up Both" -command [mymethod UpDir] \ + ttk::button $win.bu -image $img(upup) -command [mymethod UpDir] \ -underline 0 bind $win "$win.bu invoke" #catch {font delete myfont} #font create myfont -family $Pref(fontfamily) -size $Pref(fontsize) - ttk::entryX $win.e1 -textvariable dirdiff(leftDir) - ttk::button $win.bu1 -text "Up" -command [mymethod UpDir 1] - ttk::button $win.bb1 -text "Browse" \ + ttk::entryX $win.e1 -textvariable dirdiff(leftDir) -width 30 + ttk::button $win.bu1 -image $img(up) -command [mymethod UpDir 1] + ttk::button $win.bb1 -image $img(open) \ -command "[list BrowseDir dirdiff(leftDir) $win.e1] [mymethod DoDirCompare]" - $win.e1 xview end - ttk::entryX $win.e2 -textvariable dirdiff(rightDir) - ttk::button $win.bu2 -text "Up" -command [mymethod UpDir 2] - ttk::button $win.bb2 -text "Browse" \ + after 50 [list after idle [list $win.e1 xview end]] + ttk::entryX $win.e2 -textvariable dirdiff(rightDir) -width 30 + ttk::button $win.bu2 -image $img(up) -command [mymethod UpDir 2] + ttk::button $win.bb2 -image $img(open) \ -command "[list BrowseDir dirdiff(rightDir) $win.e2] [mymethod DoDirCompare]" - $win.e2 xview end + after 50 [list after idle [list $win.e2 xview end]] bind $win.e1 [mymethod DoDirCompare] bind $win.e2 [mymethod DoDirCompare] ttk::label $win.sl -anchor w -textvariable [myvar statusVar] - pack $win.bb1 $win.bu1 -in $win.fe1 -side right -pady 1 -ipadx 10 + pack $win.bb1 $win.bu1 -in $win.fe1 -side left -pady 1 -ipadx 10 pack $win.bu1 -padx 6 pack $win.e1 -in $win.fe1 -side left -fill x -expand 1 pack $win.bb2 $win.bu2 -in $win.fe2 -side right -pady 1 -ipadx 10 pack $win.bu2 -padx 6 pack $win.e2 -in $win.fe2 -side left -fill x -expand 1 Index: src/eskil.syntax ================================================================== --- src/eskil.syntax +++ src/eskil.syntax @@ -24,10 +24,11 @@ ##nagelfar syntax twapi::get_window_coordinates x ##nagelfar syntax twapi::get_window_at_location x x ##nagelfar syntax twapi::set_focus x ##nagelfar syntax twapi::send_keys x ##nagelfar syntax twapi::get_window_coordinates x +##nagelfar syntax tablelist::convEventFields x x x # Operators ##nagelfar syntax + x* ##nagelfar syntax - x x* ##nagelfar syntax * x* @@ -100,15 +101,15 @@ ##nagelfar syntax DirCompareTree dc=_obj,DirCompareTree p* ##nagelfar option DirCompareTree -leftdirvariable -rightdirvariable -statusvar ##nagelfar return DirCompareTree _obj,DirCompareTree ##nagelfar subcmd+ _obj,DirCompareTree text newLine -##nagelfar implicitvar snit::widget::DirCompareTree self\ _obj,DirCompareTree hull win self tree hsb vsb options AfterId PauseBgProcessing IdleQueue IdleQueueArr leftMark rightMark leftDir rightDir +##nagelfar implicitvar snit::widget::DirCompareTree self\ _obj,DirCompareTree hull win self tree hsb vsb options AfterId PauseBgProcessing IdleQueue IdleQueueArr leftMark rightMark leftDir rightDir ScheduledRestart img # This is the annotation needed for this object definition ##nagelfar syntax ttk::entryX dc=_obj,ttk::entryX p* ##nagelfar option ttk::entryX -width -textvariable -style ##nagelfar return ttk::entryX _obj,ttk::entryX ##nagelfar subcmd+ _obj,ttk::entryX text newLine ##nagelfar implicitvar snit::widgetadaptor::ttk::entryX self\ _obj,ttk::entryX hull win self options Index: src/eskil.tcl ================================================================== --- src/eskil.tcl +++ src/eskil.tcl @@ -35,11 +35,11 @@ set ::eskil(argc) $::argc set ::argv {} set ::argc 0 set ::eskil(debug) 0 -set ::eskil(diffver) "Version 2.5+ 2011-04-30" +set ::eskil(diffver) "Version 2.5+ 2011-05-06" set ::eskil(thisScript) [file join [pwd] [info script]] namespace import tcl::mathop::+ namespace import tcl::mathop::- namespace import tcl::mathop::* @@ -1919,11 +1919,11 @@ proc FileIsDirectory {file {kitcheck 0}} { # Skip directories if {[file isdirectory $file]} {return 1} # This detects .kit but how to detect starpacks? - if {[file extension $file] eq ".kit" | $kitcheck} { + if {[file extension $file] eq ".kit" || $kitcheck} { if {![catch {package require vfs::mk4}]} { if {![catch {vfs::mk4::Mount $file $file -readonly}]} { # Check for contents to ensure it is a kit if {[llength [glob -nocomplain $file/*]] == 0} { vfs::unmount $file ADDED src/images/arrow_left.gif Index: src/images/arrow_left.gif ================================================================== --- /dev/null +++ src/images/arrow_left.gif cannot compute difference between binary files ADDED src/images/arrow_right.gif Index: src/images/arrow_right.gif ================================================================== --- /dev/null +++ src/images/arrow_right.gif cannot compute difference between binary files ADDED src/images/arrow_up.gif Index: src/images/arrow_up.gif ================================================================== --- /dev/null +++ src/images/arrow_up.gif cannot compute difference between binary files ADDED src/images/folderopen1.gif Index: src/images/folderopen1.gif ================================================================== --- /dev/null +++ src/images/folderopen1.gif cannot compute difference between binary files ADDED src/images/link.gif Index: src/images/link.gif ================================================================== --- /dev/null +++ src/images/link.gif cannot compute difference between binary files ADDED tablelist.txt Index: tablelist.txt ================================================================== --- /dev/null +++ tablelist.txt @@ -0,0 +1,133 @@ +Some notes about transitioning code from ttk::treeview to tablelist. +O: is old code with treeview. +N: is new code with tablelist. +N2: transforms hidden columns into row attributes + +N: Using tablelist +package require tablelist_tile + +O: Creation +ttk::treeview $win.tree -height 20 \ + -columns {type status leftfull leftname leftsize leftdate rightfull rightname rightsize rightdate} \ + -displaycolumns {leftsize leftdate rightsize rightdate} +N: Creation +tablelist::tablelist $win.tree -height 20 \ + -movablecolumns no -setgrid no -showseparators yes \ + -columns {0 "Structure" 0 "" 0 "" 0 "" 0 Name 0 Size 0 Date 0 "" 0 Name 0 Size 0 Date} +N2: Only visible columns kept +tablelist::tablelist $win.tree -height 20 \ + -movablecolumns no -setgrid no -showseparators yes \ + -columns {0 "Structure" 0 Name 0 Size 0 Date 0 Name 0 Size 0 Date} + +O: Scroll +$tree configure -yscroll "$vsb set" -xscroll "$hsb set" +N: Scroll +$tree configure -yscrollcommand "$vsb set" -xscrollcommand "$hsb set" + +O: treeview's heading is set in -columns in tablelist +$tree heading \#0 -text "Structure" +$tree heading leftname -text "Name" +$tree column leftsize -stretch 0 -width 70 -anchor e +N: tablelist gives logical names to columns like this +$tree columnconfigure 0 -name structure +$tree columnconfigure 1 -name type -hide 1 +$tree columnconfigure 4 -name leftname -hide 1 +$tree columnconfigure 5 -name leftsize -align right +N2: No hidden columns +$tree columnconfigure 1 -name leftname -hide 0 + +O: Bindings +bind $tree "[mymethod ContextMenu] %x %y %X %Y" +bind $tree "[mymethod DoubleClick] %x %y" +bind $tree [mymethod KeyReturn] +N: +set bodyTag [$tree bodytag] +bind $bodyTag <> [bind TablelistBody ] +bind $bodyTag <> +[bind TablelistBody ] +bind $bodyTag <> "+[mymethod ContextMenu] %W %x %y %X %Y" +bind $bodyTag "[mymethod DoubleClick] %W %x %y" +bind $bodyTag [mymethod KeyReturn] + +O: Clear tree +$tree delete [$tree children {}] +N: +$tree delete 0 end + +O: Configure/Create root node +$tree set {} type directory +N: +set topIndex [$tree insertchild root end {}] +$tree cellconfigure $topIndex,type -text directory + +O: Node's Children +set todo [$tree children {}] +lappend todo {*}[$tree children $node] +N: +set todo [$tree childkeys root] +lappend todo {*}[$tree childkeys $node] + +O: Getting cell info +set status [$tree set $node status] +N: +set status [$tree cellcget $node,status -text] +N2: Hidden is now row attribute +set status [$tree rowattrib $node status] + +O: +A loop to open/collapse all +N: +$tree expandall +$tree collapseall + +O: Handle coords in a binding +method DoubleClick {x y} { + set node [$tree identify row $x $y] + set col [$tree identify column $x $y] + set colname [$tree column $col -id] +} +N: +method DoubleClick {W x y} { + foreach {W x y} [tablelist::convEventFields $W $x $y] break + set node [$tree index @$x,$y] + set col [$tree columnindex @$x,$y] + set colname [$tree columncget $col -name] +} + +O: Identifying tree column +if {$col eq "#0"} +N: +if {$colname eq "structure"} + +O: Set cell valuex +$tree set $node status $status +N: +$tree cellconfigure $node,status -text $status +N2: +$tree rowattrib $node status $status + +O: Set row property +$tree item $node -tags $status +N: +$tree rowconfigure $node -foreground $color($status) \ + -selectforeground $color($status) + +O: Get parent, identify root +set parent [$tree parent $node] +if {$parent eq ""} { return } +N: +set parent [$tree parentkey $node] +if {$parent eq "" || $parent eq "root"} { return } + +O: Creating node +set id [$tree insert $node end -text $name \ + -values $values] +N: For tablelist $name is part of $values +set id [$tree insertchild $node end $values] +N2: Also fill in rowattribs +$tree rowattrib $id type $type +$tree rowattrib $id status unknown + +O: Tree column name is a row attribute in treeview +$tree item $id -text $name/ +N: +$tree cellconfigure $id,structure -text $name/