projman/lib/tree.tcl
2018-03-15 16:22:57 +03:00

390 lines
14 KiB
Tcl

#####################################################
# 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
}
}
proc SortTree {nbNode} {
global fontNormal imgDir
if {$nbNode eq "files"} {
set tree .frmBody.frmCat.noteBook.ffiles.frmTreeFiles.treeFiles
} elseif {$nbNode eq "projects"} {
set tree .frmBody.frmCat.noteBook.fprojects.frmTree.tree
}
SortTreeNodes $tree [$tree selection get]
}
proc SortTreeNodes {tree rootNode} {
global fontNormal imgDir
foreach i [lsort [$tree nodes $rootNode]] {
#puts "$i [$tree itemcget $i -data]"
set nodeData [$tree itemcget $i -data]
set nodeText [$tree itemcget $i -text]
set nodeImage [$tree itemcget $i -image]
set subNodeList [$tree nodes $i]
if {$subNodeList ne "" } {
foreach j $subNodeList {
lappend nodes($j) [$tree itemcget $j -data]
lappend nodes($j) [$tree itemcget $j -text]
lappend nodes($j) [$tree itemcget $j -image]
#puts "--$nodes($i)"
}
}
$tree delete $i
$tree insert end $rootNode $i -text "$nodeText" -font $fontNormal \
-data $nodeData -open 0\
-image $nodeImage
#-image [Bitmap::get [file join $imgDir folder.gif]]
if {[info exists nodes]} {
foreach g [array names nodes] {
#puts ">$rootNode >> $nodes($g)"
#puts ">>> [lindex $nodes($g) 0] : [lindex $nodes($g) 1] : [lindex $nodes($g) 2]"
#puts "$tree insert end $i $g -text [lindex $nodes($g) 1] -font $fontNormal \
#-data [lindex $nodes($g) 0] -open 0\
#-image [lindex $nodes($g) 2]"
$tree insert end $i $g -text [lindex $nodes($g) 1] -font $fontNormal \
-data [lindex $nodes($g) 0] -open 0\
-image [lindex $nodes($g) 2]
#SortTreeNodes $tree $g
}
unset nodes
}
}
#puts $nodeList
}