##################################################### # Tcl/Tk Project Manager # Distributed under GNU Public License # Author: Sergey Kalinin s.v.kalinin28@gmail.com # Copyright (c) "https://nuk-svk.ru", 2018 # Git repo: https://bitbucket.org/svk28/projman #################################################### # # Procedure for operation wwith Tree widget # #################################################### namespace eval FileTree { variable count variable dblclick } proc FileTree::create {nb} { global editor global treeFiles set frmTreeFiles [ScrolledWindow $nb.frmTreeFiles -bg $editor(bg)] set treeFiles [ Tree $frmTreeFiles.treeFiles \ -relief sunken -borderwidth 1 -width 5 -highlightthickness 0\ -redraw 0 -dropenabled 1 -dragenabled 1 -dragevent 3 \ -background $editor(bg) -selectbackground $editor(selectbg) -selectforeground white\ -droptypes { TREE_NODE {copy {} move {} link {}} LISTBOX_ITEM {copy {} move {} link {}} } -opencmd {FileTree::select tree 1 $treeFiles} \ -closecmd {FileTree::select tree 1 $treeFiles} ] puts $treeFiles $frmTreeFiles setwidget $treeFiles pack $frmTreeFiles -side top -fill both -expand true $treeFiles bindText "TreeOneClick $treeFiles [$treeFiles selection get]" $treeFiles bindImage "TreeOneClick $treeFiles [$treeFiles selection get]" $treeFiles bindImage "TreeDoubleClick $treeFiles [$treeFiles selection get]" $treeFiles bindText "TreeDoubleClick $treeFiles [$treeFiles selection get]" $treeFiles bindText {$treeFiles selection add $treeFiles [$treeFiles selection get]} FileTree::GetAllDirs $treeFiles } proc FileTree::init { treeFile } { global tcl_platform variable count set count 0 if { $tcl_platform(platform) == "unix" } { set rootdir [glob "~"] } else { set rootdir "c:\\" } $treeFile insert end root home -text $rootdir -data $rootdir -open 1 \ -image [Bitmap::get openfold] getdir $treeFile home $rootdir FileTree::select tree 1 $treeFile home $treeFile configure -redraw 1 # ScrollView set w .top toplevel $w wm withdraw $w wm protocol $w WM_DELETE_WINDOW { # don't kill me } wm resizable $w 0 0 wm title $w "Drag rectangle to scroll directory tree" wm transient $w . ScrollView $w.sv -window $treeFile -fill white -relief sunken -bd 1 \ -width 300 -height 300 pack $w.sv -fill both -expand yes } proc FileTree::getdir { treeFile node path } { variable count set lentries [glob -nocomplain [file join $path "*"]] set lfiles {} foreach f $lentries { set tail [file tail $f] if { [file isdirectory $f] } { $treeFile insert end $node n:$count \ -text $tail \ -image [Bitmap::get folder] \ -drawcross allways \ -data $f incr count } else { lappend lfiles $tail } } $treeFile itemconfigure $node -drawcross auto -data $lfiles } proc FileTree::moddir { idx treeFile node } { if { $idx && [$treeFile itemcget $node -drawcross] == "allways" } { getdir $treeFile $node [$treeFile itemcget $node -data] if { [llength [$treeFile nodes $node]] } { $treeFile itemconfigure $node -image [Bitmap::get openfold] } else { $treeFile itemconfigure $node -image [Bitmap::get folder] } } else { $treeFile itemconfigure $node -image [Bitmap::get [lindex {folder openfold} $idx]] } } proc FileTree::select { where num treeFile node } { variable dblclick set dblclick 1 if { $num == 1 } { if { $where == "tree" && [lsearch [$treeFile selection get] $node] != -1 } { unset dblclick #after 500 "DemoTree::edit tree $treeFile $list $node" return } if { $where == "tree" } { select_node $treeFile $node } else { #$list selection set $node } } elseif { $where == "list" && [$treeFile exists $node] } { set parent [$treeFile parent $node] while { $parent != "root" } { $treeFile itemconfigure $parent -open 1 set parent [$treeFile parent $parent] } select_node $treeFile $node } } proc FileTree::select_node { treeFile node } { $treeFile selection set $node update #eval $list delete [$list item 0 end] set dir [$treeFile itemcget $node -data] if { [$treeFile itemcget $node -drawcross] == "allways" } { getdir $treeFile $node $dir set dir [$treeFile itemcget $node -data] } set num 0 foreach f $dir { if {[$treeFile exists $node:file:$num] !=1} { $treeFile insert end $node $node:file:$num -text [file tail $f] -data $f \ -image [Bitmap::get file] incr num } } } proc FileTree::edit { where treeFile node } { variable dblclick if { [info exists dblclick] } { return } if { $where == "tree" && [lsearch [$treeFile selection get] $node] != -1 } { set res [$treeFile edit $node [$treeFile itemcget $node -text]] if { $res != "" } { $treeFile itemconfigure $node -text $res $treeFile selection set $node } return } } proc FileTree::expand { treeFile but } { if { [set cur [$treeFile selection get]] != "" } { if { $but == 0 } { $treeFile opentree $cur } else { $treeFile closetree $cur } } } proc FileTree::GetAllDirs {treeFiles} { global projDir workDir fontNormal imgDir module env set rList "" set rootDir $env(HOME) if {[catch {cd $rootDir}] != 0} { return "" } $treeFiles insert end root $rootDir -text "$rootDir" -font $fontNormal \ -data "dir_root" -open 0\ -image [Bitmap::get [file join $imgDir folder.gif]] GetFiles [file join $rootDir] root $treeFiles #set dir $string $treeFiles configure -redraw 1 } ## GETTING FILES FROM SUBDIR ## proc GetFilesSubdir {tree node dir} { global fontNormal projDir workDir activeProject imgDir count global backUpFileShow dotFileShow set count 1 set rList "" if {[catch {cd $dir}] != 0} { return "" } if {$dotFileShow eq "Yes"} { foreach file [lsort [glob -nocomplain .*]] { if {$file == "." || $file == ".."} { puts $file } else { lappend rList [list [file join $dir $file]] set fileName [file join $file] set img [GetImage $fileName] set dot "_" regsub -all {\.} $fileName "_" subNode set subNode "$activeProject$dot$node$dot$subNode$dot$count" if {[$tree exists $subNode] == 1} {return} if {$backUpFileShow == "Yes"} { $tree insert end $node $subNode -text $fileName \ -data [file join $dir $fileName] -open 1\ -image [Bitmap::get [file join $imgDir $img.gif]]\ -font $fontNormal } if {$backUpFileShow == "No"} { if {[file isdirectory $fileName] == 1} { $tree insert end $node $subNode -text $fileName \ -data [file join $dir $fileName] -open 1\ -image [Bitmap::get [file join $imgDir $img.gif]]\ -font $fontNormal } else { if {[string index $fileName end] != "~"} { $tree insert end $node $subNode -text $fileName \ -data [file join $dir $fileName] -open 1\ -image [Bitmap::get [file join $imgDir $img.gif]]\ -font $fontNormal } } } } incr count } } foreach file [lsort [glob -nocomplain *]] { lappend rList [list [file join $dir $file]] set fileName [file join $file] set img [GetImage $fileName] set dot "_" regsub -all {\.} $fileName "_" subNode set subNode "$activeProject$dot$node$dot$subNode$dot$count" if {[$tree exists $subNode] == 1} {return} if {$backUpFileShow == "Yes"} { $tree insert end $node $subNode -text $fileName \ -data [file join $dir $fileName] -open 1\ -image [Bitmap::get [file join $imgDir $img.gif]]\ -font $fontNormal } if {$backUpFileShow == "No"} { if {[file isdirectory $fileName] == 1} { $tree insert end $node $subNode -text $fileName \ -data [file join $dir $fileName] -open 1\ -image [Bitmap::get [file join $imgDir $img.gif]]\ -font $fontNormal } else { if {[string index $fileName end] != "~"} { $tree insert end $node $subNode -text $fileName \ -data [file join $dir $fileName] -open 1\ -image [Bitmap::get [file join $imgDir $img.gif]]\ -font $fontNormal } } } incr count } $tree itemconfigure $node -open 1 } ## GETTING FILES FROM PROJECT DIR AND INSERT INTO TREE WIDGET ## proc GetFiles {dir project tree} { global fontNormal backUpFileShow dotFileShow imgDir set rList "" set count 1 if {[catch {cd $dir}] != 0} { return "" } if {$dotFileShow eq "Yes"} { foreach file [lsort [glob -nocomplain .*]] { if {$file == "." || $file == ".."} { puts $file } else { lappend rList [list [file join $dir $file]] set fileName [file join $file] set img [GetImage $fileName] set dot "_" regsub -all {\.} $fileName "_" subNode set subNode "$project$dot$subNode$dot$count" if {$backUpFileShow == "Yes"} { $tree insert end $project $subNode -text $fileName \ -data [file join $dir $fileName] -open 1\ -image [Bitmap::get [file join $imgDir $img.gif]]\ -font $fontNormal } if {$backUpFileShow == "No"} { if {[string index $fileName end] != "~"} { $tree insert end $project $subNode -text $fileName \ -data [file join $dir $fileName] -open 1\ -image [Bitmap::get [file join $imgDir $img.gif]]\ -font $fontNormal } } } incr count } } foreach file [lsort [glob -nocomplain *]] { lappend rList [list [file join $dir $file]] set fileName [file join $file] set img [GetImage $fileName] set dot "_" regsub -all {\.} $fileName "_" subNode set subNode "$project$dot$subNode$dot$count" if {$backUpFileShow == "Yes"} { $tree insert end $project $subNode -text $fileName \ -data [file join $dir $fileName] -open 1\ -image [Bitmap::get [file join $imgDir $img.gif]]\ -font $fontNormal } if {$backUpFileShow == "No"} { if {[string index $fileName end] != "~"} { $tree insert end $project $subNode -text $fileName \ -data [file join $dir $fileName] -open 1\ -image [Bitmap::get [file join $imgDir $img.gif]]\ -font $fontNormal } } incr count } $tree configure -redraw 1 } ## GETTING PROJECT NAMES FROM DIR AND PUTS INTO proc GetProj {tree} { global projDir workDir fontNormal imgDir module set rList "" if {[catch {cd $workDir}] != 0} { return "" } foreach proj [lsort [glob -nocomplain *.proj]] { lappend rList [list [file join $workDir $proj]] set projFile [open [file join $workDir $proj] r] set prjName [file rootname $proj] while {[gets $projFile line]>=0} { scan $line "%s" keyWord set string [string range $line [string first "\"" $line] [string last "\"" $line]] set string [string trim $string "\""] if {$keyWord == "ProjectName"} { regsub -all " " $string "_" project set projName "$string" } if {$keyWord == "ProjectDirName"} { set projList($prjName) [file dirname $string] puts "$projList($prjName) - $string" $tree insert end root $prjName -text "$projName" -font $fontNormal \ -data "prj_$prjName" -open 0\ -image [Bitmap::get [file join $imgDir folder.gif]] GetFiles [file join $string] $prjName $tree set dir $string } } } $tree configure -redraw 1 } ## SHOW PUP-UP MENUS ## proc PopupMenuTree {x y} { global tree fontNormal fontBold imgDir activeProject set node [$tree selection get] if {$node ==""} { set answer [tk_messageBox\ -message "[::msgcat::mc "Not found active project"]"\ -type ok -icon warning] case $answer { ok {return 0} } } $tree selection set $node set item [$tree itemcget $node -data] if {[string range $item 0 2] == "prj"} { set activeProject [string range $item 4 end] .frmStatus.frmActive.lblActive configure -text [$tree itemcget $node -text] -font $fontBold tk_popup .popupProj $x $y return } if {[info exists fileList($node)] != 1} { # set fileList($node) $item tk_popup .popupFile $x $y } } ## OPEN TREE PROCEDURE proc TreeOpen {node} { global fontNormal tree projDir workDir activeProject fileList noteBook findString imgDir fontBold $tree selection set $node set item [$tree itemcget $node -data] if {[string range $item 0 2] == "prj"} { set activeProject [string range $item 4 end] puts $activeProject .frmStatus.frmActive.lblActive configure -text [$tree itemcget $node -text] -font $fontBold $tree itemconfigure $node -image [Bitmap::get [file join $imgDir openfold.gif]] if {[file exists [file join $workDir $activeProject.tags]] == 1} { GetTagList [file join $workDir $activeProject.tags] ;# geting tag list } else { DoModule ctags } } if {[info exists fileList($node)] != 1} { set fileList($node) $item if {[file isdirectory $item] == 1} { $tree itemconfigure $node -image [Bitmap::get [file join $imgDir openfold.gif]] } } } ## CLOSE TREE PROCEDURE ## proc TreeClose {node} { global fontNormal tree projDir workDir activeProject fileList noteBook findString imgDir fontBold $tree selection set $node set item [$tree itemcget $node -data] if {[string range $item 0 2] == "prj"} { $tree itemconfigure $node -image [Bitmap::get [file join $imgDir folder.gif]] } if {[info exists fileList($node)] != 1} { if {[file isdirectory $item] == 1} { $tree itemconfigure $node -image [Bitmap::get [file join $imgDir folder.gif]] } } } ## TREE ONE CLICK PROCEDURE ## proc TreeOneClick {tree node} { global fontNormal projDir workDir activeProject fileList noteBook findString imgDir fontBold #puts [$tree selection get] puts [$tree selection set $node] #puts "$tree >>> $node" set item [$tree itemcget $node -data] if {[string range $item 0 2] == "prj"} { set activeProject [string range $item 4 end] puts $activeProject .frmStatus.frmActive.lblActive configure -text [$tree itemcget $node -text] -font $fontBold if {[file exists [file join $workDir $activeProject.tags]] == 1} { GetTagList [file join $workDir $activeProject.tags] ;# geting tag list } return } if {[info exists fileList($node)] != 1} { if {[file isdirectory $item] == 1} { return } else { if {[file exists $item] == 1} { LabelUpdate .frmStatus.frmHelp.lblHelp [FileAttr $item] } } } else { PageRaise $tree $node } if {[string range $item 0 2] == "prc"} { set parent [$tree parent $node] set file [$tree itemcget $parent -data] set fileExt [string range [file extension $file] 1 end] if {[info exists fileList($parent)] == 0} { EditFile $parent $file } PageRaise $tree $parent $tree selection set $node set text "$noteBook.f$parent.text" set index1 [expr [string first "_" $item]+1] set index2 [expr [string last "_" $item]11] if {$fileExt == "java" || $fileExt == "ja"} { set findString "class [string range $item $index1 $index2] " } elseif {$fileExt == "perl" || $fileExt == "pl"} { set findString "sub [string range $item $index1 $index2]" } elseif {$fileExt == "ml" || $fileExt == "mli"} { set findString "let [string range $item $index1 $index2]" } elseif {$fileExt == "php" || $fileExt == "phtml"} { set findString "function [string range $item $index1 $index2]" puts $findString #return } elseif {$fileExt == "rb"} { set findString "class [string range $item $index1 $index2]" } else { set findString "proc [string range $item $index1 $index2] " } FindProc $text $findString $node focus -force $text } } ## TREE DOUBLE CLICK PROCEDURE ## proc TreeDoubleClick {tree node} { global fontNormal projDir workDir activeProject fileList noteBook findString imgDir fontBold $tree selection set $node set item [$tree itemcget $node -data] puts $item if {[$tree itemcget $node -open] == 1} { $tree itemconfigure $node -open 0 } elseif {[$tree itemcget $node -open] == 0} { $tree itemconfigure $node -open 1 } if {[string range $item 0 2] == "prj"} { set activeProject [string range $item 4 end] .frmStatus.frmActive.lblActive configure -text [$tree itemcget $node -text] -font $fontBold GetTagList [file join $workDir $activeProject.tags] ;# geting tag list } if {[info exists fileList($node)] != 1} { if {[file isdirectory $item] == 1} { GetFilesSubdir $tree $node $item } else { if {[file exists $item] == 1} { EditFile $tree $node $item LabelUpdate .frmStatus.frmFile.lblFile "[file size $item] b." } } } if {[string range $item 0 2] == "prc"} { $tree selection set $node set parent [$tree parent $node] if {[info exists fileList($parent)] != 1} { set file [$tree itemcget $parent -data] EditFile $parent $file $noteBook raise $parent } else { $noteBook raise $parent } set text "$noteBook.f$parent.text" set index1 [expr [string first "_" $item]+1] set index2 [expr [string last "_" $item]11] set findString "proc [string range $item $index1 $index2] " FindProc $text $findString $node focus -force $text } } ## UPDATE TREE ## proc UpdateTree {} { global tree $tree delete [$tree nodes root] GetProj $tree } proc GetTreeForNode {node} { if {[.frmBody.frmCat.noteBook.ffiles.frmTreeFiles.treeFiles exists $node] ==1} { return .frmBody.frmCat.noteBook.ffiles.frmTreeFiles.treeFiles } elseif {[.frmBody.frmCat.noteBook.fprojects.frmTree.tree exists $node] ==1} { return .frmBody.frmCat.noteBook.fprojects.frmTree.tree } }