GJS 2012/5/6 The browser widget is a file browser that lists files and directories. Upon double clicking a directory the widget will change to that directory.
Methods
- browse dir dir is appended to the current directory, then then the directory is changed.
- goto dir Changes the current directory to dir.
- ListFile type name Private method called to list a file.
- BindSelect Private method called when an item in the browser is selected.
- BindDClick Private method called when an item in the browser is double clicked.
- location Returns the current directory.
- get Returns the current selection.
Options (Also supports standard ttk::treeview options)
- -images is a dict defining the images to be displayed for items in the browser.
- -list is a list of elements to be shown in the browser
- current list "."
- up list ".."
- hidden list hidden files and directories
- directory, directories, folder, or folders list directories
- drive, drives, volume, or volumes list volumes
- file, or files list files
- all shortcut to list everything, default
- -bindselect
package provide tkoo::browser 0.1.2
package require tkoo
tkoo::class ::tkoo::browser {
superclass tkoo::ttk_treeview
variable widCmd pathname options exists location
constructor {wid args} {
#check to see if the class already exists
my Exists $wid
#defaults
set pathname $wid
set location [pwd]
#create the widget
if {![winfo exists $wid]} {
ttk::treeview $wid
}
#options
#use in list of pairs, list type and image
#-images [list drive driveimage directory dirimage file fileimage]
#use dict
my Opt add -images images Images [list] {
#needs error checking
}
#what items to list should be a list of the following, or all
#current directory drives files up hidden
#defaults to all
my Opt add -list list List [list current directory drives files up hidden] {
my variable widCmd pathname options exists location images
set list [list]
foreach v $value {
switch -exact -- $v {
current - up - hidden {lappend list $v}
directory - directories - folder - folders {lappend list directory}
drive - drives - volume - volumes {lappend list drives}
file - files {lappend list files}
all {set list [list current directory drives files up hidden]}
default {error [msgcat::mc "bad type \"$v\" for \"-list\": must be a list containing current, directory, drives, files, hidden, or up"]}
}
}
set options(-list,val) [lsort -dictionary -unique $list]
}
#command to perform on a treeview selection
my Opt add -bindselect bindSelect BindSelect "" {}
#bindings
bind $wid <Double-1> [namespace code [list my BindDClick]]
bind $wid <<TreeviewSelect>> [namespace code [list my BindSelect]]
#default code
next $wid {*}$args
#configure the widget
my configure {*}$args
}
#method for browsing
method browse {dir args} {
global tcl_platform
if {($dir eq ".." && $tcl_platform(platform) eq "windows" && [lindex [split $location /] 1] eq "") || ($dir eq ".." && $location eq "Volumes")} {
#list volumes here
if {"drives" in [my Opt get -list]} {
my goto "<*volumes*>"
}
} else {
#set the current location
set location [file normalize [file join $location $dir]]
my goto $location
}
}
#method to goto a directory
method goto {dir args} {
#delete all chidren
my delete [my children {}]
if {$dir eq "<*volumes*>"} {
set location "Volumes"
foreach f [lsort -dictionary [file volumes]] {
my ListFile volume $f
}
} else {
#get options
set list [my Opt get -list]
#store directory
set location $dir
#list up directory
if {"current" in $list} {my ListFile directory .}
if {"up" in $list} {my ListFile directory ..}
#list directories
if {"directory" in $list} {
set dList [list]
if {"hidden" in $list} {
#find hidden directories
lappend dList {*}[glob -directory $location -tails -types [list d hidden] -nocomplain -- *]
}
#find the rest of the directories
lappend dList {*}[glob -directory $location -tails -types [list d] -nocomplain -- *]
foreach f [lsort -dictionary -unique $dList] {
my ListFile directory $f
}
}
#list files here
if {"files" in $list} {
set fList [list]
if {"hidden" in $list} {
#find hidden files
lappend fList {*}[glob -directory $location -tails -types [list f hidden] -nocomplain -- *]
}
#find the rest of the files
lappend fList {*}[glob -directory $location -tails -types [list f] -nocomplain -- *]
foreach f [lsort -dictionary -unique $fList] {
my ListFile file $f
}
}
}
#scroll to top
my see {}
}
#method to list a file
method ListFile {type name} {
set a [list]
set imgs [my Opt get -images]
switch -exact -- $type {
file {
if {[dict exists $imgs file]} {
set img [dict get [my Opt get -images] file]
lappend a -image $img
}
}
directory -
folder {
if {[dict exists $imgs directory]} {
set img [dict get [my Opt get -images] directory]
lappend a -image $img
}
}
volume -
drive {
if {[dict exists $imgs drive]} {
set img [dict get [my Opt get -images] drive]
lappend a -image $img
}
}
default {return}
}
if {[string length $name]} {
my insert {} end -text $name {*}$a
}
}
#methods for bindings
method BindSelect {args} {
set cmd [my Opt get -bindselect]
if {![string length $cmd]} {return}
catch {apply [list {} $cmd]}
}
method BindDClick {args} {
set select [my selection]
if {[llength $select] != 1} {return}
set txt [my item [my selection] -text]
set f [file join $location $txt]
if {[file isdirectory $f]} {
my browse $txt
}
}
#method to return current location
method location {} {return $location}
#method to return current selection
method get {args} {
set nodes [my selection]
set ret [list]
foreach n $nodes {
set f [my item $n -text]
set f [file join $location $f]
lappend ret $n $f
}
return $ret
}
}
