tree.tcl 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971
  1. ###########################################################
  2. # Name: tree.tcl
  3. # Author: Daniele Bonini (posta@elettronica.lol)
  4. # Date: 08/10/2024
  5. # Desc: Tree namespace of RadXIDE.
  6. #
  7. # Tree namespace and most of the code
  8. # here presented and distributed contains excerpts
  9. # from [alited](https://github.com/aplsimple/alited
  10. # by Alex Plotnikov and contributors to the project.
  11. # The original code of these excerpts could be
  12. # borrowed from other sources which the author
  13. # and the contributors to this RadXIDE have no
  14. # knowledge about.
  15. #
  16. # License: MIT. Copyrights 5 Mode (Last implementation and adaptations.)
  17. # Copyright (c) 2021-2023 Alex Plotnikov https://aplsimple.github.io (original scaffolding and excerpts.)
  18. #
  19. ###########################################################
  20. namespace eval tree {
  21. # ________________________ addFile _________________________ #
  22. proc addFile {{ID ""}} {
  23. # Adds a new item to the tree.
  24. # ID - an item's ID where the new file will be added (for the file tree).
  25. namespace upvar ::radxide dan dan
  26. set tree $dan(TREEVIEW)
  27. lassign [$tree item $ID -values] -> fname isfile
  28. set destfolder $fname
  29. if {!$isfile} {
  30. #tk_messageBox -title $dan(TITLE) -icon error -message $destfolder
  31. ::radxide::filelib::createFile $destfolder
  32. # Refreshing TreeView
  33. ::radxide::tree::create
  34. }
  35. }
  36. # ________________________ addFolder _________________________ #
  37. proc addFolder {{ID ""}} {
  38. # Adds a new item to the tree.
  39. # ID - an item's ID where the new folder will be added (for the file tree).
  40. namespace upvar ::radxide dan dan
  41. set tree $dan(TREEVIEW)
  42. lassign [$tree item $ID -values] -> fname isfile
  43. set parentfolder $fname
  44. if {!$isfile} {
  45. #tk_messageBox -title $dan(TITLE) -icon error -message $parentfolder
  46. ::radxide::filelib::createFolder $parentfolder
  47. # Refreshing TreeView
  48. ::radxide::tree::create
  49. }
  50. }
  51. # ________________________ addTags _________________________ #
  52. proc addTags {tree} {
  53. # Creates tags for the tree.
  54. # tree - the tree's path
  55. namespace upvar ::radxide dan dan
  56. #lassign [::hl_tcl::addingColors {} -AddTags] - - fgbr - - fgred - - - fgtodo
  57. $tree tag configure tagNorm -foreground $dan(FG)
  58. $tree tag configure tagSel -foreground $dan(fgred)
  59. $tree tag configure tagBold -foreground $dan(fgbold)
  60. $tree tag configure tagTODO -foreground $dan(fgtodo)
  61. $tree tag configure tagBranch -foreground $dan(fgbranch)
  62. }
  63. # ________________________ AddToDirContents _________________________ #
  64. proc addToDirContent {lev isfile fname iroot} {
  65. # Adds an item to a list of directory's contents.
  66. # lev - level in the directory hierarchy
  67. # isfile - a flag "file" (if yes) or "directory" (if no)
  68. # fname - a file name to be added
  69. # iroot - index of the directory's parent or -1
  70. namespace upvar ::radxide dan dan _dirtree _dirtree
  71. set dllen [llength $_dirtree]
  72. if {$dllen < $dan(MAXFILES)} {
  73. lappend _dirtree [list $lev $isfile $fname 0 $iroot]
  74. if {$iroot>-1} {
  75. lassign [lindex $_dirtree $iroot] lev isfile fname fcount sroot
  76. set _dirtree [lreplace $_dirtree $iroot $iroot \
  77. [list $lev $isfile $fname [incr fcount] $sroot]]
  78. }
  79. }
  80. return $dllen
  81. }
  82. # ________________________ buttonPress _________________________ #
  83. proc buttonPress {but x y X Y} {
  84. # Handles a mouse clicking the tree.
  85. # but - mouse button
  86. # x - x-coordinate to identify an item
  87. # y - y-coordinate to identify an item
  88. # X - x-coordinate of the click
  89. # Y - x-coordinate of the click
  90. namespace upvar ::radxide dan dan menu menu
  91. set tree $dan(TREEVIEW)
  92. set ID [$tree identify item $x $y]
  93. set region [$tree identify region $x $y]
  94. #set al(movID) [set al(movWin) {}]
  95. if {![$tree exists $ID] || $region ni {tree cell}} {
  96. return ;# only tree items are processed
  97. }
  98. #tk_messageBox -title $dan(TITLE) -icon error -message $but
  99. switch $but {
  100. {3} {
  101. if {[llength [$tree selection]]<2} {
  102. $tree selection set $ID
  103. }
  104. showPopupMenu $ID $X $Y
  105. }
  106. {1} {
  107. #::radxide::tree::openFile $ID
  108. lassign [$tree item $ID -values] -> fname isfile
  109. if {$isfile} {
  110. $menu(FILE) entryconfigure $menu(ADD_FILE_ENTRY_IDX) -state disabled
  111. } else {
  112. $menu(FILE) entryconfigure $menu(ADD_FILE_ENTRY_IDX) -state normal
  113. }
  114. }
  115. }
  116. }
  117. # ________________________ buttonRelease _________________________ #
  118. proc buttonRelease {but s x y X Y} {
  119. # Handles a mouse button releasing on the tree, at moving an item.
  120. # but - mouse button
  121. # s - state (ctrl/alt/shift)
  122. # x - x-coordinate to identify an item
  123. # y - y-coordinate to identify an item
  124. # X - x-coordinate of the click
  125. # Y - x-coordinate of the click
  126. namespace upvar ::radxide dan dan
  127. set tree $dan(TREEVIEW)
  128. set ID [$tree identify item $x $y]
  129. #DestroyMoveWindow no
  130. #set msec [clock milliseconds]
  131. #set ctrl [expr {$s & 0b100}]
  132. #if {([info exists al(_MSEC)] && [expr {($msec-$al(_MSEC))<400}]) || $ctrl} {
  133. # SelectUnits $wtree $ctrl
  134. # set al(movWin) {}
  135. # return
  136. #}
  137. #if {[$tree exists $ID] && [info exists al(movID)] && \
  138. #$al(movID) ne {} && $ID ne {} && $al(movID) ne $ID && \
  139. #[$wtree identify region $x $y] eq {tree}} {
  140. # if {$al(TREE,isunits)} {
  141. # alited::unit::MoveUnits $wtree move $al(movID) $ID
  142. # } else {
  143. # alited::file::MoveFiles $wtree move $al(movID) $ID
  144. # }
  145. #}
  146. #DestroyMoveWindow yes
  147. }
  148. # ________________________ clearTree _________________________ #
  149. proc clearTree {TreeView item} {
  150. # Removes recursively an item and its children from the tree.
  151. # TreeView - the tree widget's path
  152. # item - ID of the item to be deleted.
  153. foreach child [$TreeView children $item] {
  154. clearTree $TreeView $child
  155. }
  156. if {$item ne {}} {$TreeView delete $item}
  157. }
  158. # ________________________ create _________________________ #
  159. proc create {} {
  160. # Creates a tree of files, at need.
  161. namespace upvar ::radxide dan dan menu menu
  162. set tree $dan(TREEVIEW)
  163. # for file tree: get its current "open branch" flags
  164. # in order to check them in createFilesTree
  165. set dan(SAVED_FILE_TREE) [list]
  166. foreach item [getTree] {
  167. lassign $item - - ID - values
  168. lassign $values -> fname isfile
  169. if {[string is false -strict $isfile]} {
  170. lappend dan(SAVED_FILE_TREE) [list $fname [$tree item $ID -open]]
  171. }
  172. }
  173. #set TID [alited::bar::CurrentTabID]
  174. delete $tree {}
  175. addTags $tree
  176. bind $tree "<ButtonPress>" {after idle {::radxide::tree::buttonPress %b %x %y %X %Y}}
  177. #bind $tree "<ButtonRelease>" {after idle {::radxide::tree::buttonRelease %b %s %x %y %X %Y}}
  178. bind $tree "<Double-Button-1>" {after idle {::radxide::tree::dblClick %b %x %y %X %Y}}
  179. #bind $tree "<Motion>" {after idle {::radxide::tree::ButtonMotion %b %s %x %y %X %Y}}
  180. #bind $tree "<ButtonRelease>" {alited::tree::DestroyMoveWindow no}
  181. #bind $tree "<Leave>" {alited::tree::DestroyMoveWindow yes}
  182. #bind $tree "<F2>" {alited::file::RenameFileInTree 0 -}
  183. #bind $tree "<Insert>" {alited::tree::AddItem}
  184. #bind $tree "<Delete>" {alited::tree::DelItem {} {}}
  185. createFileTree $tree
  186. unset dan(SAVED_FILE_TREE)
  187. $menu(FILE) entryconfigure $menu(ADD_FILE_ENTRY_IDX) -state disabled
  188. }
  189. # ________________________ createFileTree _________________________ #
  190. proc createFileTree {tree} {
  191. # Creates a file tree.
  192. # wtree - the tree's path
  193. namespace upvar ::radxide dan dan project project icons icons
  194. #set al(TREE,files) yes
  195. #[$obPav BtTswitch] configure -image alimg_gulls
  196. #baltip::tip [$obPav BtTswitch] $al(MC,swfiles)
  197. #baltip::tip [$obPav BtTAddT] $al(MC,filesadd)\nInsert
  198. #baltip::tip [$obPav BtTDelT] $al(MC,filesdel)\nDelete
  199. #baltip::tip [$obPav BtTUp] $al(MC,moveupF)
  200. #baltip::tip [$obPav BtTDown] $al(MC,movedownF)
  201. #$tree heading #0 -text ":: [file tail $al(prjroot)] ::"
  202. #$tree heading #1 -text $al(MC,files)
  203. bind $tree <Return> {::radxide::tree::openFile}
  204. set selID ""
  205. #if {[catch {set selfile [alited::bar::FileName]}]} {
  206. # set selfile {} ;# at closing by Ctrl+W with file tree open: no current file
  207. #}
  208. set parent {}
  209. set fc 0
  210. set fname $project(ROOT)
  211. set title [file tail $fname]
  212. set isfile no
  213. set itemID 0
  214. set isopen yes
  215. set imgopt $icons(PROJECT-ICONI)
  216. $tree insert $parent end -id $itemID -text "$title" \
  217. -values [list $fc $fname $isfile $itemID] -open $isopen -image $imgopt
  218. set dan(_dirignore) [list]
  219. catch { ;# there might be an incorrect list -> catch it
  220. foreach d $dan(prjdirignore) {
  221. lappend dan(_dirignore) [string toupper [string trim $d \"]]
  222. }
  223. }
  224. foreach item [getDirectoryContent $project(ROOT)] {
  225. lassign $item lev isfile fname fcount iroot
  226. #if {([string first $project(ROOT)/Private $fname] eq -1) && ([string first $project(ROOT)/Public $fname] eq -1)} {
  227. # continue
  228. #}
  229. set itemID [newItemID [incr iit]]
  230. #if {$selfile eq $fname} {set selID $itemID}
  231. set title [file tail $fname]
  232. if {$iroot<0} {
  233. set parent 0 ;#{}
  234. } else {
  235. set parent [newItemID [incr iroot]]
  236. }
  237. #if {$parent eq 0 && ((!$isfile && ($title ne "Private") && ($title ne "Public")) || ($isfile))} {
  238. # continue
  239. #}
  240. set isopen no
  241. if {$isfile} {
  242. if {$parent eq 0} {
  243. continue
  244. }
  245. if {[isHtml $fname]} {
  246. set imgopt $icons(HTML-ICONI)
  247. } elseif {[isCss $fname]} {
  248. set imgopt $icons(CSS-ICONI)
  249. } elseif {[isJs $fname]} {
  250. set imgopt $icons(JS-ICONI)
  251. } elseif {[isPhp $fname]} {
  252. set imgopt $icons(PHP-ICONI)
  253. } elseif {[isTxt $fname]} {
  254. set imgopt $icons(TXT-ICONI)
  255. } elseif {[isImage $fname]} {
  256. set imgopt $icons(IMG-ICONI)
  257. } else {
  258. set imgopt $icons(GENERIC-FILE-ICONI)
  259. }
  260. } else {
  261. if {$title eq "Private"} {
  262. set imgopt $icons(PRIVATEF-ICONI)
  263. } elseif {$title eq "Public"} {
  264. set imgopt $icons(PUBLICF-ICONI)
  265. } else {
  266. if {$parent eq 0} {
  267. continue
  268. }
  269. set imgopt $icons(FOLDER-ICONI)
  270. }
  271. # get the directory's flag of expanded branch (in the file tree)
  272. set idx [lsearch -index 0 -exact $dan(SAVED_FILE_TREE) $fname]
  273. if {$idx>-1} {
  274. set isopen [lindex $dan(SAVED_FILE_TREE) $idx 1]
  275. }
  276. }
  277. if {$fcount} {set fc $fcount} {set fc {}}
  278. $tree insert $parent end -id $itemID -text "$title" \
  279. -values [list $fc $fname $isfile $itemID] -open $isopen -image $imgopt
  280. $tree tag add tagNorm $itemID
  281. if {!$isfile} {
  282. $tree tag add tagBranch $itemID
  283. }
  284. }
  285. if {$selID ne {}} {
  286. $tree see $selID
  287. $tree selection set $selID
  288. }
  289. }
  290. # ________________________ delete _________________________ #
  291. proc deleteFile {ID} {
  292. # Removes a file.
  293. # ID - ID of the item to be deleted.
  294. namespace upvar ::radxide dan dan
  295. set tree $dan(TREEVIEW)
  296. if {$ID eq {}} {
  297. if {[set ID [$tree selection]] eq {}} return
  298. }
  299. lassign [$tree item $ID -values] -> fname isfile
  300. if {$isfile} {
  301. set answer [tk_messageBox -title $dan(TITLE) -message "Really delete the selected file?" \
  302. -icon question -type yesno -detail "Selected: \"$fname\""]
  303. if {$answer eq yes} {
  304. ::radxide::filelib::delFile $fname
  305. ::radxide::tree::create
  306. }
  307. }
  308. }
  309. # ________________________ delete _________________________ #
  310. proc delete {tree item} {
  311. # Removes recursively an item and its children from the tree.
  312. # tree - the tree widget's path
  313. # item - ID of the item to be deleted.
  314. foreach child [$tree children $item] {
  315. delete $tree $child
  316. }
  317. if {$item ne {}} {$tree delete $item}
  318. }
  319. # ________________________ dblClick _________________________ #
  320. proc dblClick {but x y X Y} {
  321. # Handles a mouse clicking the tree.
  322. # but - mouse button
  323. # x - x-coordinate to identify an item
  324. # y - y-coordinate to identify an item
  325. # X - x-coordinate of the click
  326. # Y - x-coordinate of the click
  327. namespace upvar ::radxide dan dan
  328. set tree $dan(TREEVIEW)
  329. set ID [$tree identify item $x $y]
  330. set region [$tree identify region $x $y]
  331. #set al(movID) [set al(movWin) {}]
  332. if {![$tree exists $ID] || $region ni {tree cell}} {
  333. return ;# only tree items are processed
  334. }
  335. #tk_messageBox -title $dan(TITLE) -icon error -message DoubleClick: ($but)
  336. switch $but {
  337. {3} {
  338. }
  339. {1} {
  340. #set al(movID) $ID
  341. #set al(movWin) .tritem_move
  342. #set msec [clock milliseconds]
  343. #if {[info exists al(_MSEC)] && [expr {($msec-$al(_MSEC))<400}]} {
  344. ::radxide::tree::openFile $ID
  345. #}
  346. #set al(_MSEC) $msec
  347. }
  348. }
  349. }
  350. # ________________________ dirContent _________________________ #
  351. proc dirContent {dirname {lev 0} {iroot -1} {globs "*"}} {
  352. # Reads a directory's contents.
  353. # dirname - a dirtectory's name
  354. # lev - level in the directory hierarchy
  355. # iroot - index of the directory's parent or -1
  356. # globs - list of globs to filter files.
  357. namespace upvar ::radxide dan dan _dirtree _dirtree
  358. incr lev
  359. # firstly directories:
  360. if {[catch {set dcont [lsort -dictionary [glob -type d [file join $dirname *]]]}]} {
  361. set dcont [list]
  362. }
  363. # firstly directories:
  364. # 1. skip the ignored ones
  365. for {set i [llength $dcont]} {$i} {} {
  366. incr i -1
  367. if {[ignoredDir [lindex $dcont $i]] || (($lev eq 1) && (([file tail [lindex $dcont $i]] ne "Private") && ([file tail [lindex $dcont $i]] ne "Public")))} {
  368. set dcont [lreplace $dcont $i $i]
  369. }
  370. }
  371. # 2. put the directories to the beginning of the file list
  372. set i 0
  373. foreach fname $dcont {
  374. set start [expr [string length $fname]-2]
  375. set last [expr [string length $fname]-1]
  376. set d [string range $fname $start $last]
  377. if {$d ne " y"} {
  378. if {[file isdirectory $fname]} {
  379. set dcont [lreplace $dcont $i $i [list $fname "y"]]
  380. set nroot [addToDirContent $lev 0 $fname $iroot]
  381. if {[llength $_dirtree] < $dan(MAXFILES)} {
  382. dirContent $fname $lev $nroot $globs
  383. } else {
  384. break
  385. }
  386. } else {
  387. set dcont [lreplace $dcont $i $i [list $fname]]
  388. }
  389. incr i
  390. }
  391. }
  392. # then files
  393. # hidden files
  394. if {[catch {set dcont [lsort -dictionary [glob -types {f hidden} [file join $dirname *]]]}]} {
  395. set dcont [list]
  396. }
  397. for {set i [llength $dcont]} {$i} {} {
  398. incr i -1
  399. if {[ignoredDir [lindex $dcont $i]] && (!(([file tail [lindex $dcont $i]] ne ".") && ([file tail [lindex $dcont $i]] ne "..")))} {
  400. set dcont [lreplace $dcont $i $i]
  401. }
  402. }
  403. if {[llength $_dirtree] < $dan(MAXFILES)} {
  404. foreach fname $dcont {
  405. set fname [string map {"\"" "\'"} $fname]
  406. set start [expr [string length $fname]-2]
  407. set last [expr [string length $fname]-1]
  408. set d [string range $fname $start $last]
  409. #lassign $fname fname d
  410. if {$d ne " y"} {
  411. #tk_messageBox -title $dan(TITLE) -icon error -message $fname
  412. foreach gl [split $globs ","] {
  413. if {[string match $gl $fname]} {
  414. addToDirContent $lev 1 $fname $iroot
  415. break
  416. }
  417. }
  418. }
  419. }
  420. }
  421. # generic files
  422. if {[catch {set dcont [lsort -dictionary [glob -type f [file join $dirname *]]]}]} {
  423. set dcont [list]
  424. }
  425. for {set i [llength $dcont]} {$i} {} {
  426. incr i -1
  427. if {[ignoredDir [lindex $dcont $i]] && (!(([file tail [lindex $dcont $i]] ne ".") && ([file tail [lindex $dcont $i]] ne "..")))} {
  428. set dcont [lreplace $dcont $i $i]
  429. }
  430. }
  431. if {[llength $_dirtree] < $dan(MAXFILES)} {
  432. foreach fname $dcont {
  433. set fname [string map {"\"" "\'"} $fname]
  434. set start [expr [string length $fname]-2]
  435. set last [expr [string length $fname]-1]
  436. set d [string range $fname $start $last]
  437. #lassign $fname fname d
  438. if {$d ne " y"} {
  439. #tk_messageBox -title $dan(TITLE) -icon error -message $fname
  440. foreach gl [split $globs ","] {
  441. if {[string match $gl $fname]} {
  442. addToDirContent $lev 1 $fname $iroot
  443. break
  444. }
  445. }
  446. }
  447. }
  448. }
  449. }
  450. # ________________________ getDirectoryContent _________________________ #
  451. proc getDirectoryContent {dirname} {
  452. # Gets a directory's content.
  453. # dirname - the directory's name
  454. # Returns a list containing the directory's content.
  455. namespace upvar ::radxide dan dan _dirtree _dirtree
  456. # set _dirtree [set dan(_dirignore) [list]]
  457. set _dirtree [list]
  458. # catch { ;# there might be an incorrect list -> catch it
  459. # foreach d $dan(prjdirignore) {
  460. # lappend dan(_dirignore) [string toupper [string trim $d \"]]
  461. # }
  462. # }
  463. # lappend dan(_dirignore) [string toupper [file tail [::radxide::Tclexe]]]
  464. dirContent $dirname
  465. return $_dirtree
  466. }
  467. # ________________________ getTree _________________________ #
  468. proc getTree {{parent {}}} {
  469. # Gets a tree or its branch.
  470. # parent - ID of the branch
  471. # Tree - name of the tree widget
  472. namespace upvar ::radxide dan dan
  473. set tree $dan(TREEVIEW)
  474. set mytree [list]
  475. set levp -1
  476. procTreeItems $tree {
  477. set item "%item"
  478. set lev %level
  479. if {$levp>-1 || $item eq $parent} {
  480. if {$lev<=$levp} {return -code break} ;# all of branch fetched
  481. if {$item eq $parent} {set levp $lev}
  482. }
  483. catch {
  484. if {$parent eq {} || $levp>-1} {
  485. lappend mytree [list $lev %children $item {%text} {%values}]
  486. }
  487. }
  488. }
  489. return $mytree
  490. }
  491. # ________________________ ignoredDir _________________________ #
  492. proc ignoredDir {dir} {
  493. # Checks if a directory is in the list of the ignored ones.
  494. # dir - the directory's name
  495. namespace upvar ::radxide dan dan
  496. set dir [string toupper [file tail $dir]]
  497. return [expr {[lsearch -exact $dan(_dirignore) $dir]>-1}]
  498. }
  499. # ________________________ isHtml _________________________ #
  500. proc isHtml {fname} {
  501. # Checks if a file is of Html.
  502. # fname - file name
  503. if {[string tolower [file extension $fname]] in $radxide::dan(HtmlExts)} {
  504. return yes
  505. }
  506. return no
  507. }
  508. # ________________________ isCss _________________________ #
  509. proc isCss {fname} {
  510. # Checks if a file is of Css.
  511. # fname - file name
  512. if {[string tolower [file extension $fname]] in $radxide::dan(CssExts)} {
  513. return yes
  514. }
  515. return no
  516. }
  517. # ________________________ isBin _________________________ #
  518. proc isBin {fname} {
  519. # Checks if a file is of isBin.
  520. # fname - file name
  521. if {[string tolower [file extension $fname]] in $radxide::dan(BinExts)} {
  522. return yes
  523. }
  524. return no
  525. }
  526. # ________________________ isImage _________________________ #
  527. proc isImage {fname} {
  528. # Checks if a file is of Image.
  529. # fname - file name
  530. if {[string tolower [file extension $fname]] in $radxide::dan(ImgExts)} {
  531. return yes
  532. }
  533. return no
  534. }
  535. # ________________________ isJs _________________________ #
  536. proc isJs {fname} {
  537. # Checks if a file is of JS.
  538. # fname - file name
  539. if {[string tolower [file extension $fname]] in $radxide::dan(JsExts)} {
  540. return yes
  541. }
  542. return no
  543. }
  544. # ________________________ isOfficeFile _________________________ #
  545. proc isOfficeFile {fname} {
  546. # Checks if a file is of isOfficeFile.
  547. # fname - file name
  548. if {[string tolower [file extension $fname]] in $radxide::dan(OfficeExts)} {
  549. return yes
  550. }
  551. return no
  552. }
  553. # ________________________ isPhp _________________________ #
  554. proc isPhp {fname} {
  555. # Checks if a file is of PHP.
  556. # fname - file name
  557. if {[string tolower [file extension $fname]] in $radxide::dan(PhpExts)} {
  558. return yes
  559. }
  560. return no
  561. }
  562. # ________________________ isTxt _________________________ #
  563. proc isTxt {fname} {
  564. # Checks if a file is of Txt.
  565. # fname - file name
  566. if {[string tolower [file extension $fname]] in $radxide::dan(TxtExts)} {
  567. return yes
  568. }
  569. return no
  570. }
  571. # ________________________ newItemID _________________________ #
  572. proc newItemID {iit} {
  573. # Gets a new ID for the tree item.
  574. # iit - index of the new item.
  575. return "al$iit"
  576. }
  577. # ________________________ openFile _________________________ #
  578. proc openFile {{ID ""}} {
  579. # Opens file at clicking a file tree's item.
  580. # ID - ID of file tree
  581. namespace upvar ::radxide dan dan menu menu project project
  582. set tree $dan(TREEVIEW)
  583. #tk_messageBox -title $dan(TITLE) -icon error -message $ID
  584. if {$ID eq {}} {
  585. if {[set ID [$tree selection]] eq {}} return
  586. }
  587. lassign [$tree item $ID -values] -> fname isfile
  588. if {![file exists $fname]} {
  589. tk_messageBox -title $dan(TITLE) -icon error -message "File doesn't exist!"
  590. return
  591. } else {
  592. if {[file size $fname] > $dan(MAXFILESIZE)} {
  593. tk_messageBox -title $dan(TITLE) -icon error -message "File exceed MAXFILESIZE=$dan(MAXFILESIZE)"
  594. return
  595. }
  596. if {$isfile && (![isBin $fname]) && (![isOfficeFile $fname]) && (![isImage $fname])} {
  597. $dan(TEXT) config -state normal
  598. $dan(TEXT) delete 1.0 end
  599. $dan(TEXT) insert 1.0 [::radxide::filelib::openFile $fname]
  600. ::radxide::win::fillGutter $dan(TEXT) $dan(GUTTEXT) 5 1 "#FFFFFF" "#222223"
  601. # Update menu
  602. $menu(FILE) entryconfigure $menu(SAVE_ENTRY_IDX) -state normal
  603. $menu(FILE) entryconfigure $menu(SAVE_AS_ENTRY_IDX) -state normal
  604. $menu(FILE) entryconfigure $menu(CLOSE_ENTRY_IDX) -state normal
  605. $menu(EDIT) entryconfigure $menu(UNDO_ENTRY_IDX) -state normal
  606. $menu(EDIT) entryconfigure $menu(REDO_ENTRY_IDX) -state normal
  607. $menu(EDIT) entryconfigure $menu(COPY_ENTRY_IDX) -state normal
  608. $menu(EDIT) entryconfigure $menu(PASTE_ENTRY_IDX) -state normal
  609. $menu(EDIT) entryconfigure $menu(CUT_ENTRY_IDX) -state normal
  610. $menu(EDIT) entryconfigure $menu(INDENT_ENTRY_IDX) -state normal
  611. $menu(EDIT) entryconfigure $menu(UNINDENT_ENTRY_IDX) -state normal
  612. $menu(EDIT) entryconfigure $menu(FIND_ENTRY_IDX) -state normal
  613. $menu(EDIT) entryconfigure $menu(GOTO_ENTRY_IDX) -state normal
  614. set project(CUR_FILE_PATH) $fname
  615. $dan(TEXT) edit reset
  616. focus $dan(TEXT)
  617. ::tk::TextSetCursor $dan(TEXT) @0,0
  618. ::radxide::main::updateAppTitle
  619. # after idle {alited::bar::BAR draw; alited::tree::UpdateFileTree}
  620. } else {
  621. tk_messageBox -title $dan(TITLE) -icon error -message "File is binary or a folder!"
  622. return
  623. }
  624. }
  625. }
  626. # ________________________ procTreeItems _________________________ #
  627. proc procTreeItems {tree aproc {lev 0} {branch {}}} {
  628. # Scans all items of the tree.
  629. # tree - the tree's path
  630. # aproc - a procedure to run at scanning
  631. # lev - level of the tree
  632. # branch - ID of the branch to be scanned
  633. # The 'aproc' argument can include wildcards to be replaced
  634. # appropriate data:
  635. # %level - current tree level
  636. # %children - children of a current item
  637. # %item - ID of a current item
  638. # %text - text of a current item
  639. # %values - values of a current item
  640. set children [$tree children $branch]
  641. if {$lev} {
  642. set proc [string map [list \
  643. %level $lev \
  644. %children [llength $children] \
  645. %item $branch \
  646. %text [$tree item $branch -text] \
  647. %values [$tree item $branch -values]] \
  648. $aproc]
  649. uplevel [expr {$lev+1}] "$proc"
  650. }
  651. incr lev
  652. foreach child $children {
  653. procTreeItems $tree $aproc $lev $child
  654. }
  655. }
  656. # ________________________ refreshTree _________________________ #
  657. proc refreshTree {{tree ""} {headers ""} {clearsel no}} {
  658. namespace upvar ::radxide dan dan
  659. if {$tree eq ""} {
  660. set tree $dan(TREEVIEW)
  661. }
  662. if {[set selID [$tree selection]] eq {}} return
  663. #tk_messageBox -title $dan(TITLE) -icon error -message $selID
  664. ::radxide::tree::create
  665. $tree selection set [list $selID]
  666. }
  667. # ________________________ renameFile _________________________ #
  668. proc renameFile {{ID ""}} {
  669. namespace upvar ::radxide dan dan
  670. set tree $dan(TREEVIEW)
  671. set args {}
  672. set name2 ""
  673. if {$ID eq {}} {
  674. if {[set ID [$tree selection]] eq {}} return
  675. }
  676. lassign [$tree item $ID -values] -> fname isfile
  677. # lassign [::radxide::win::input {} "Rename file" [list \
  678. # ent "{} {} {-w 32}" "{$fname}"] \
  679. # -head "File name:" res name2]
  680. set args "-buttons {butOK OK ::radxide::win::renameFileOK butCANCEL CANCEL ::radxide::win::renameFileCancel}"
  681. catch {lassign [::radxide::win::input "RenameFile" {} "Rename file" [list \
  682. ent "{} {} {-w 64}" "{$fname}"] \
  683. -head "File name:" {*}$args] res}
  684. }
  685. # ________________________ renameFolder _________________________ #
  686. proc renameFolder {{ID ""}} {
  687. namespace upvar ::radxide dan dan
  688. set tree $dan(TREEVIEW)
  689. set args {}
  690. set name2 ""
  691. if {$ID eq {}} {
  692. if {[set ID [$tree selection]] eq {}} return
  693. }
  694. lassign [$tree item $ID -values] -> fname isfile
  695. # lassign [::radxide::win::input {} "Rename file" [list \
  696. # ent "{} {} {-w 32}" "{$fname}"] \
  697. # -head "File name:" res name2]
  698. set args "-buttons {butOK OK ::radxide::win::renameFolderOK butCANCEL CANCEL ::radxide::win::renameFolderCancel}"
  699. catch {lassign [::radxide::win::input "RenameFolder" {} "Rename folder" [list \
  700. ent "{} {} {-w 64}" "{$fname}"] \
  701. -head "Folder name:" {*}$args] res}
  702. }
  703. # ________________________ showPopupMenu _________________________ #
  704. proc showPopupMenu {ID X Y} {
  705. # Creates and opens a popup menu at right clicking the tree.
  706. # ID - ID of clicked item
  707. # X - x-coordinate of the click
  708. # Y - y-coordinate of the click
  709. namespace upvar ::radxide dan dan project project
  710. #::baltip sleep 1000
  711. set tree $dan(TREEVIEW)
  712. set popm $tree.popup
  713. catch {destroy $popm}
  714. menu $popm -tearoff 0 -cursor ""
  715. set header [lindex [split "" \n] 0]
  716. lassign [$tree item $ID -values] -> fname isfile
  717. set m1 "Refresh project"
  718. set m2 "Add file"
  719. set m2f "Add folder"
  720. set m3 "Rename file"
  721. set m4 "Delete file"
  722. set m3f "Rename folder"
  723. set m4f "Delete folder"
  724. set m5 "Open file"
  725. set m6 "Open dir"
  726. $popm add command -label $m1 -command { ::radxide::tree::refreshTree }
  727. if {$ID ne 0} {
  728. $popm add separator
  729. if {$isfile} {
  730. $popm add command -label $m2 -command "::radxide::tree::addFile $ID" -state disabled
  731. } else {
  732. $popm add command -label $m2 -command "::radxide::tree::addFile $ID" -state normal
  733. }
  734. if {$isfile} {
  735. $popm add command -label $m3 -command "::radxide::tree::renameFile $ID"
  736. $popm add command -label $m4 -command "::radxide::tree::deleteFile $ID"
  737. } else {
  738. $popm add command -label $m2f -command "::radxide::tree::addFolder $ID"
  739. if {($fname eq "$project(ROOT)/Public") || ($fname eq "$project(ROOT)/Private")} {
  740. $popm add command -label $m3f -command "::radxide::tree::renameFolder $ID" -state disabled
  741. $popm add command -label $m4f -command "::radxide::tree::delFolder $ID" -state disabled
  742. } else {
  743. $popm add command -label $m3f -command "::radxide::tree::renameFolder $ID" -state normal
  744. $popm add command -label $m4f -command "::radxide::tree::delFolder $ID" -state disabled
  745. }
  746. }
  747. $popm add separator
  748. if {$isfile} {
  749. $popm add command -label $m5 -command "::radxide::tree::openFile $ID" -state normal
  750. } else {
  751. $popm add command -label $m5 -command { ::radxide::tree::openFile $ID } -state disabled
  752. }
  753. }
  754. set addsel {}
  755. if {[llength [$tree selection]]>1} {
  756. if {[$tree tag has tagSel $ID]} {
  757. # the added tagSel tag should be overrided
  758. $tree tag remove tagSel $ID
  759. set addsel "; $tree tag add tagSel $ID"
  760. }
  761. }
  762. bind $popm <FocusIn> "$tree tag add tagBold $ID"
  763. bind $popm <FocusOut> "catch {$tree tag remove tagBold $ID; $addsel}"
  764. #$obPav themePopup $popm
  765. tk_popup $popm $X $Y
  766. }
  767. #_______________________
  768. }
  769. # _________________________________ EOF _________________________________ #