New version of ProjMan
This commit is contained in:
svkalinin
433
lib/tree.tcl
433
lib/tree.tcl
@@ -1,389 +1,86 @@
|
||||
#####################################################
|
||||
# Tcl/Tk Project Manager
|
||||
#!/usr/bin/wish
|
||||
######################################################
|
||||
# ProjMan 2
|
||||
# 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
|
||||
####################################################
|
||||
# Author: Sergey Kalinin svk@nuk-svk.ru
|
||||
# Copyright (c) "", 2022, https://nuk-svk.ru
|
||||
######################################################
|
||||
#
|
||||
# Procedure for operation wwith Tree widget
|
||||
# Tree widget working module
|
||||
#
|
||||
####################################################
|
||||
######################################################
|
||||
|
||||
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
|
||||
|
||||
namespace eval Tree {
|
||||
proc InsertItem {tree parent item type text} {
|
||||
# set img [GetImage $fileName]
|
||||
set dot "_"
|
||||
puts "$tree $parent $item $type $text"
|
||||
switch $type {
|
||||
file {
|
||||
regsub -all {\.|/|\\|\s} $item "_" subNode
|
||||
puts $subNode
|
||||
set image imgFile
|
||||
}
|
||||
directory {
|
||||
regsub -all {\.|/|\\|\s} $item "_" subNode
|
||||
puts $subNode
|
||||
set image folder
|
||||
}
|
||||
}
|
||||
}
|
||||
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
|
||||
}
|
||||
append id $type "::" $subNode
|
||||
puts $id
|
||||
if ![$tree exists $id] {
|
||||
$tree insert $parent end -id "$id" -text $text -values "$item" -image $image
|
||||
}
|
||||
return "$id"
|
||||
}
|
||||
|
||||
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
|
||||
proc DoublePressItem {tree} {
|
||||
set id [$tree selection]
|
||||
$tree tag remove selected
|
||||
$tree item $id -tags selected
|
||||
|
||||
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"
|
||||
set values [$tree item $id -values]
|
||||
set key [lindex [split $id "::"] 0]
|
||||
if {$values eq "" || $key eq ""} {return}
|
||||
|
||||
puts "$key $tree $values"
|
||||
switch $key {
|
||||
directory {
|
||||
FileOper::ReadFolder $values
|
||||
}
|
||||
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
|
||||
|
||||
file {
|
||||
FileOper::Edit $values
|
||||
# $tree item $id -open false
|
||||
}
|
||||
}
|
||||
}
|
||||
$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} {
|
||||
proc PressItem {tree} {
|
||||
set id [$tree selection]
|
||||
$tree tag remove selected
|
||||
$tree item $id -tags selected
|
||||
|
||||
set values [$tree item $id -values]
|
||||
set key [lindex [split $id "::"] 0]
|
||||
if {$values eq "" || $key eq ""} {return}
|
||||
|
||||
puts "$key $tree $values"
|
||||
switch $key {
|
||||
directory {
|
||||
FileOper::ReadFolder $values
|
||||
# $tree item $id -open false
|
||||
}
|
||||
file {
|
||||
FileOper::Edit $values
|
||||
}
|
||||
}
|
||||
} 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
|
||||
proc GetItemID {tree item} {
|
||||
if [$tree exists $item] {
|
||||
return [$tree item $item -values]
|
||||
}
|
||||
}
|
||||
#puts $nodeList
|
||||
}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user