390 lines
14 KiB
Tcl
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
|
|
}
|
|
|