blt-demo 2.5.3+dfsg-4 / usr / share / blt2.5 / demos / treeview1.tcl

#!/usr/bin/wish8.6

package require BLT
# --------------------------------------------------------------------------
# Starting with Tcl 8.x, the BLT commands are stored in their own 
# namespace called "blt".  The idea is to prevent name clashes with
# Tcl commands and variables from other packages, such as a "table"
# command in two different packages.  
#
# You can access the BLT commands in a couple of ways.  You can prefix
# all the BLT commands with the namespace qualifier "blt::"
#  
#    blt::graph .g
#    blt::table . .g -resize both
# 
# or you can import all the command into the global namespace.
#
#    namespace import blt::*
#    graph .g
#    table . .g -resize both
#
# --------------------------------------------------------------------------
if { $tcl_version >= 8.0 } {
    namespace import blt::*
    namespace import -force blt::tile::*
}
source scripts/demo.tcl

proc SortColumn { column } {
    set old [.t sort cget -column] 
    set decreasing 0
    if { "$old" == "$column" } {
	set decreasing [.t sort cget -decreasing]
	set decreasing [expr !$decreasing]
    }
    .t sort configure -decreasing $decreasing -column $column -mode integer
    if { ![.t cget -flat] } {
	.t configure -flat yes
    }
    .t sort auto yes

    blt::busy hold .t
    update
    blt::busy release .t
}

proc FormatSize { size } {
   set string ""
   while { $size > 0 } {
       set rem [expr $size % 1000]
       set size [expr $size / 1000]
       if { $size > 0 } {
           set rem [format "%03d" $rem]
       } 
       if { $string != "" } {
           set string "$rem,$string"
       } else {
           set string "$rem"
       }
   } 
   return $string
}

array set modes {
   0	---
   1    --x
   2    -w-
   3    -wx
   4    r-- 
   5    r-x
   6    rw-
   7    rwx
}

proc FormatMode { mode } {
   global modes

   set mode [format %o [expr $mode & 07777]]
   set owner $modes([string index $mode 0])
   set group $modes([string index $mode 1])
   set world $modes([string index $mode 2])

   return "${owner}${group}${world}"
}

proc Find { tree parent dir } {
    global count 
    set saved [pwd]

    cd $dir
    foreach f [glob -nocomplain *] {
	set name [file tail $f]
	if { [catch { file stat $f info }] != 0 } {
	    set node [$tree insert $parent -label $name]
	} else {
	    if { $info(type) == "file" } {
		set info(type) [list @blt::tv::normalOpenFolder $name]
	    } else {
		set info(type) ""
	    }
	    set info(mtime) [clock format $info(mtime) -format "%b %d, %Y"]
	    set info(atime) [clock format $info(atime) -format "%b %d, %Y"]
	    set info(ctime) [clock format $info(ctime) -format "%b %d, %Y"]
            set info(size)  [FormatSize $info(size)]
	    set info(mode)  [FormatMode $info(mode)]
	    set node [$tree insert $parent -label $name -data [array get info]]
	}
	incr count
	if { [file type $f] == "directory" } {
	    Find $tree $node $f
	}
    }
    cd $saved
}


proc GetAbsolutePath { dir } {
    set saved [pwd]
    cd $dir
    set path [pwd] 
    cd $saved
    return $path
}

option add *TreeView.focusOutSelectForeground white
option add *TreeView.focusOutSelectBackground grey80

#option add *TreeView.Button.activeBackground pink
option add *TreeView.Button.activeForeground red2
option add *TreeView.Button.background grey95
option add *TreeView.Column.background grey90
option add *TreeView.CheckBoxStyle.activeBackground white
if 0 {
option add *TreeView.Column.titleFont { Helvetica 12 bold }
option add *TreeView.text.font { Helvetica 12 }
option add *TreeView.CheckBoxStyle.font { Courier 10 }
option add *TreeView.ComboBoxStyle.font { Helvetica 20 }
option add *TreeView.TextBoxStyle.font { Times 34 }
}

set top [GetAbsolutePath ..]
#set top [GetAbsolutePath /home/gah]
set trim "$top"

set tree [tree create]    
treeview .t \
    -width 0 \
    -yscrollcommand { .vs set } \
    -xscrollcommand { .hs set } \
    -selectmode single \
    -tree $tree

.t column configure #0 -title "" 
#file
.t column insert 0 mtime atime gid 
.t column insert end nlink mode type ctime uid ino size dev
.t column configure uid -background red -relief raised 
.t column configure mtime -hide no -bg green -relief raised
.t column configure size gid nlink uid ino dev -justify left -edit yes
.t column configure size type -justify left -edit yes
.t column configure #0 -hide no -edit no -icon blt::tv::normalOpenFolder
focus .t

scrollbar .vs -orient vertical -command { .t yview }
scrollbar .hs -orient horizontal -command { .t xview }

table . \
    0,0 .t  -fill both \
    0,1 .vs -fill y \
    1,0 .hs -fill x
table configure . c1 r1 -resize none

set count 0
Find $tree root $top
puts "$count entries"

if {[catch {
   tree op find $tree -top root -glob -name *.c -addtag "c_files"
   tree op find $tree -top root -glob -name *.h -addtag "header_files"
   tree op find $tree -top root -glob -name *.tcl -addtag "tcl_files"
} xrc]} {
  tclLog "Wize 'op' subcmd unavailable"
  $tree find -top root -glob -name *.c -addtag "c_files"
  $tree find -top root -glob -name *.h -addtag "header_files"
  $tree find -top root -glob -name *.tcl -addtag "tcl_files"
}

.t entry configure "c_files" -foreground green4
.t entry configure "header_files" -foreground cyan4
.t entry configure "tcl_files" -foreground red4

.t column bind all <ButtonRelease-3> {
    %W configure -flat no
}

foreach column [.t column names] {
    .t column configure $column -command [list SortColumn $column]
}

# Create a second treeview that shares the same tree.
if 0 {
toplevel .top
treeview .top.t2 -tree $tree -yscrollcommand { .top.sbar set }
scrollbar .top.sbar -command { .top.t2 yview }
pack .top.t2 -side left -expand yes -fill both
pack .top.sbar -side right -fill y
}

#.t configure -bg #ffffed
.t style create checkbox check \
    -onvalue 30 -offvalue "50" \
    -showvalue yes 

.t style create combobox combo \
    -icon blt::tv::normalOpenFolder
catch {.t style conf combo -choices {500 510 520}}

.t column configure uid -style combo
.t column configure gid -style check 
.t bind ComboBoxStyle <ButtonPress-1> {
  puts "BBB: [%W column current], [%W nearest %x %y]"
}
catch {console show}