#! /usr/bin/tclsh
package require sqlite3
package require Tk
package require {ycl db sqlite util}
[yclprefix] proc alias dbget [yclprefix]::db::sqlite::util::get
package require {ycl gryp session}
proc .init {_ args} {
$_ .vars gryp info lastfocus settings \
tree text top workdir
dict size $args
foreach {opt val} $args {
switch $opt {
gryp - top {
set $opt $val
}
default {
error [list {unknown option} $opt]
}
}
}
set history_pause 0
set lastfocus {}
set nohistory 0
sqlite3 [$_ .namespace]::db
$_ .eval [list $_ .routine db]
$_ dbsetup
$_ .routine gryp $gryp
[[yclprefix] gryp session .new [$_ .namespace]::session] .init gryp $gryp
$_ .eval [list $_ .routine session]
set message $top.message
message $top.message
pack $message -fill both -expand yes
pack forget $message
set left [frame $top.left]
set right [frame $top.right]
pack $left -side left -fill both -expand yes
pack $right -side right -fill both -expand yes
set text [text $top.text]
pack configure $text -in $right
set tree $top.tree
ttk::treeview $tree -selectmode extended
set script [list ::apply [list {_ tree rowid level parent value} {
if {$parent eq $rowid} {
set current {}
} else {
set current $parent
}
$tree insert $current end -id $rowid -text [list $rowid $value]
#$tree tag bind $item <Double-Button-1> [list $_ edit $rowid]
#$tree tag bind $item <Return> [list $_ edit $rowid]
} [namespace current]] $_ $tree]
$_ db transaction {
$_ session tree walk {} $script
}
$_ session subscribe delete [list $_ session_delete]
$_ session subscribe insert [list $_ session_insert]
$_ session subscribe focus [list $_ session_focus]
$_ session subscribe open [list $_ session_open]
bind $tree <Configure> [list $_ setup]
bind $tree <BackSpace> [list $_ session history previous]
bind $tree <<TreeviewOpen>> [list $_ node_opened]
bind $tree <Shift-BackSpace> [list $_ session history next]
bind $tree <<TreeviewSelect>> [list $_ selected]
pack configure $tree -in $left
pack $tree -fill both -expand yes
return
}
.my .method .init
proc dbsetup _ {
}
.my .method dbsetup
proc node_opened _ {
$_ .vars tree
set item [$tree focus]
$_ session event $item open
}
.my .method node_opened
proc item_activate _ {
$_ .vars tree
set focus [$tree focus]
#$_ session activate
return
}
.my .method item_activate
proc selected _ {
$_ .vars lastfocus text tree
set focus [$tree focus]
set lastfocus2 $lastfocus
set lastfocus $focus
if {$focus eq $lastfocus2} {
$_ session event $focus edit
} else {
$_ session focus $focus
}
return
}
.my .method selected
proc session_delete {_ parent item value} {
$_ .vars tree
$tree delete [list $item]
}
.my .method session_delete
proc session_insert {_ parent item value} {
$_ .vars tree
set item [$tree insert $parent end -id $item -text [list $item $value]]
return
}
.my .method session_insert
proc session_open {_ item} {
$_ .vars
set datatype [$_ session node last {} attributes $item datatype]
switch $datatype {
directory {
set file [$_ getdirectory]
$_ session write $item $file
}
default {
}
}
return
}
.my .method session_open
proc session_focus {_ item} {
$tree focus $item
$tree see $item
return
}
.my .method session_focus
proc session_focus {_ item} {
$_ .vars text tree
set focus [$tree focus]
if {$focus ne $item} {
$tree focus $item
$tree selection set $item
$tree see $item
}
$text delete 1.0 end
$text insert 1.0 [$tree item $item -text]
return
}
.my .method session_focus
proc setup _ {
$_ .vars tree workdir
bind $tree <Configure> {}
}
.my .method setup
proc getdirectory _ {
set file [tk_chooseDirectory -title \
{choose existing work directory}]
return $file
}
.my .method getdirectory