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/tablelist5.2 TWAPI = /home/peter/src/packages/twapi TKDND = /home/peter/src/packages/tkdnd/lib/tkdnd1.0 # Tools NAGELFAR = nagelfar @@ -58,10 +59,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 @@ -87,10 +90,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 #---------------------------------------------------------------- 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 @@ -236,10 +238,11 @@ $entryW xview end } } snit::widget DirCompareTree { + hulltype ttk::frame component tree component hsb component vsb option -leftdirvariable -default "" -configuremethod SetDirOption @@ -246,57 +249,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 \ + -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" + #puts "Theme [tablelist::getCurrentTheme]" + #puts "Style [ttk::style configure .]" + + # 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]] + # FIXA: arrow images + set img(left) [image create photo mapleft -width 10 -height 8] + set img(right) [image create photo mapright -width 10 -height 8] 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 +342,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 +358,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 +484,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 +506,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 +521,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 +618,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 +650,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 +666,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 +748,38 @@ } 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 "" ""] - } 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 \ + "" "" \ + "" \ + "" ""] + } else { + 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"} { + $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 +787,35 @@ $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] + ttk::frame $w + if 1 { + ttk::button $w.bl -image $img(left) -style Toolbutton \ + -command [mymethod CopyFile $row right] + ttk::button $w.br -image $img(right) -style Toolbutton \ + -command [mymethod CopyFile $row left] + } elseif 1 { + ttk::button $w.bl -text "<" -style Toolbutton \ + -command [mymethod CopyFile $row right] + ttk::button $w.br -text ">" -style Toolbutton \ + -command [mymethod CopyFile $row left] + } else { + ttk::label $w.bl -text "<" + bind $w.bl [mymethod CopyFile $row right] + ttk::label $w.br -text ">" + bind $w.br [mymethod CopyFile $row left] + } + pack $w.bl $w.br -side left -fill y + pack $w.bl -padx {0 1} } # Compare two directories. method CompareDirs {dir1 dir2 node} { global Pref 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