projman/lib/tree.tcl
Sergey Kalinin 830bcfeb2f Fixed AddToProj procedure for file browser tree
Disable OpComplite procedure
2018-02-22 15:45:46 +03:00

600 lines
21 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
#
####################################################
namespace eval FileTree {
variable count
variable dblclick
}
proc FileTree::create {nb} {
global editor
global treeFiles
set frmTreeFiles [ScrolledWindow $nb.frmTreeFiles -bg $editor(bg) -background $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}
]
$frmTreeFiles setwidget $treeFiles
pack $frmTreeFiles -side top -fill both -expand true
$treeFiles bindText <ButtonPress-1> "TreeOneClick $treeFiles [$treeFiles selection get]"
$treeFiles bindImage <ButtonPress-1> "TreeOneClick $treeFiles [$treeFiles selection get]"
$treeFiles bindImage <Double-ButtonPress-1> "TreeDoubleClick $treeFiles [$treeFiles selection get]"
$treeFiles bindText <Double-ButtonPress-1> "TreeDoubleClick $treeFiles [$treeFiles selection get]"
$treeFiles bindText <Shift-Button-1> {$treeFiles selection add $treeFiles [$treeFiles selection get]}
# Added menu
GetMenuFileTree [menu .popMenuFileTree -bg $editor(bg) -fg $editor(fg)] ;# pop-up edit menu
bind $frmTreeFiles.treeFiles.c <Button-3> {catch [PopupMenuFileTree $treeFiles %X %Y]}
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 ""
}
set rootNode [$treeFiles insert end root $rootDir -text "$rootDir" -font $fontNormal \
-data "dir_root" -open 1\
-image [Bitmap::get [file join $imgDir folder.gif]]]
# $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] $rootNode $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 PopupMenuFileTree {treeFiles x y} {
#global fontNormal fontBold imgDir activeProject
#set node [$treeFiles selection get]
if {[$treeFiles selection get] != ""} {
set node [$treeFiles selection get]
$treeFiles selection set $node
} else {
return
}
#set item [$treeFiles itemcget $node -data]
if {[info exists fileList($node)] != 1} {
# set fileList($node) $item
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 fontNormal projDir workDir activeProject fileList noteBook findString imgDir fontBold
$tree selection get
$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
#puts "$tree $node"
$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
}
}
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
}
}