##################################################### # 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 # #################################################### proc GetAllDirs {treeFiles} { global projDir workDir fontNormal imgDir module env set rList "" set rootDir $env(HOME) if {[catch {cd $rootDir}] != 0} { return "" } set rootNode [$treeFiles insert end root $rootDir -text "$rootDir" -font $fontNormal \ -data "dir_root" -open 1\ -image [Bitmap::get [file join $imgDir folder.gif]]] GetFiles $treeFiles $rootNode [file join $rootDir] $treeFiles configure -redraw 1 } proc GetFilesSubdir {tree node dir} { global fontNormal projDir workDir activeProject imgDir global backUpFileShow dotFileShow set rList "" puts "$tree $node $dir" if {[catch {cd $dir}] != 0} { return "" } if {$dotFileShow eq "Yes"} { foreach file [lsort [glob -nocomplain .*]] { if {$file != "." || $file != ".."} { lappend rList [list [file join $dir $file]] set fileName [file join $dir $file] GetFile $tree $fileName $parent } } } foreach file [lsort [glob -nocomplain *]] { lappend rList [list [file join $dir $file]] set fileName [file join $dir $file] GetFile $tree $fileName $parent } $tree itemconfigure $node -open 1 } ## GETTING FILES FROM PROJECT DIR AND INSERT INTO TREE WIDGET ## proc GetFile {tree fileName parent} { global fontNormal backUpFileShow dotFileShow imgDir set img [GetImage $fileName] set dot "_" regsub -all {\.|/|\\} $fileName "_" subNode puts $subNode if {[$tree exists $subNode] != 1} { $tree insert end $parent $subNode -text [file tail $fileName] \ -data $fileName -open 1\ -image [Bitmap::get [file join $imgDir $img.gif]]\ -font $fontNormal } } proc GetFiles {tree parent dir} { global fontNormal backUpFileShow dotFileShow imgDir set rList "" puts "$dir $parent $tree" if {[catch {cd $dir}] != 0} { return "" } if {$dotFileShow eq "Yes"} { foreach file [lsort [glob -nocomplain .*]] { if {$file != "." || $file != ".."} { lappend rList [list [file join $dir $file]] set fileName [file join $dir $file] GetFile $tree $fileName $parent } } } foreach file [lsort [glob -nocomplain *]] { lappend rList [list [file join $dir $file]] set fileName [file join $dir $file] GetFile $tree $fileName $parent } $tree configure -redraw 1 } ## GETTING PROJECT NAMES FROM DIR AND PUTS INTO proc GetProj {tree} { global projDir workDir fontNormal imgDir module set rList "" #set tree .frmBody.frmCat.noteBook.fprojects.frmTree.tree 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 "$tree $projList($prjName) - $prjName - $string" $tree insert end root $prjName -text "$projName" -font $fontNormal \ -data "prj_$prjName" -open 0\ -image [Bitmap::get [file join $imgDir folder.gif]] #puts "GetFiles $tree $prjName $string" GetFiles $tree $prjName $string #$tree itemconfigure $prjName -open 1 } } } $tree configure -redraw 1 } ## SHOW PUP-UP MENUS ## proc PopupMenuFileTree {treeFiles x y} { if {[$treeFiles selection get] != ""} { set node [$treeFiles selection get] $treeFiles selection set $node } else { return } if {[info exists fileList($node)] != 1} { tk_popup .popupFile $x $y } } proc PopupMenuTree {x y} { global tree fontNormal fontBold imgDir activeProject if {[$tree selection get] != ""} { set node [$tree selection get] $tree selection set $node } else { return } #$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 set tree [GetTreeForNode $node] $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 set tree [GetTreeForNode $node] $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 noteBook fontNormal projDir workDir activeProject fileList noteBook findString imgDir fontBold $tree selection get $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 if {[file exists [file join $workDir $activeProject.tags]] == 1} { GetTagList [file join $workDir $activeProject.tags] ;# geting tag list } return } elseif {[file isdirectory $item] == 1} { if {[$noteBook index $node] == -1} { return } } elseif {[file isfile $item] == 1 } { LabelUpdate .frmStatus.frmHelp.lblHelp [FileAttr $item] if {[$noteBook index $node] != -1} { PageRaise $tree $node if {[file exists $item] == 1} { } } } elseif {[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 noteBook $tree selection set $node set item [$tree itemcget $node -data] if {[$tree itemcget $node -open ] == 1} { puts " $item $tree itemcget $node -open" $tree closetree $node } elseif {[$tree itemcget $node -open ] == 0} { puts " $item $tree itemcget $node -open" $tree opentree $node } $tree opentree $node if {[string range $item 0 2] == "prj"} { # node is project set activeProject [string range $item 4 end] .frmStatus.frmActive.lblActive configure -text [$tree itemcget $node -text] -font $fontBold #GetFilesSubdir $tree $node $item } elseif {[file isdirectory $item] ==1} { # node is directory GetFiles $tree $node $item puts "GetFiles $tree $node $item" } elseif {[string range $item 0 2] == "prc"} { # node is procedure (class, function, etc) $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 } elseif {[file isfile $item] == 1} { #puts [$noteBook index $node] if {[$noteBook index $node] != -1} { puts "File тута $node" puts "fileList($node) $fileList($node)" } else { EditFile $tree $node $item } } else { return } } ## 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 } } proc FileNotePageRaise {nb s} { global workingTree if {$nb eq "files"} { set workingTree .frmBody.frmCat.noteBook.ffiles.frmTreeFiles.treeFiles } elseif {$nb eq "projects"} { set workingTree .frmBody.frmCat.noteBook.fprojects.frmTree.tree } else { puts "Error node" return } }