TkTwig - GUI frontend to Twig
Directions to find it at Stu
#! /bin/sh
# \
exec tclsh "$0" ${1+"$@"}
# TkTwig
#
# Stuart Cassoff
#
# May 2008
# October 2008
# Version 0.1
#
# November 2008
# Version 0.2, 0.3, 0.4
#
#
package require Tcl 8.5-
#
#
namespace eval tktwig {}
#
#-------------------------------------------------------------------
# Info
#-------------------------------------------------------------------
#
#
#
proc tktwig::readme {} {
return {
GUI frontend to Twig
<Double-Button-1> run
<Button-1> select
<Button-3> select, popup menu
<Control-[Qq]> exit
Menus do things
Basic Twigging
--------------
* Twig->New
* Type in page#
* Query (adjust lines to taste)
* Adjust blocks if necessary
* View (does not compute checksum - careful!)
* Examine (not a button - use your eyes and brain)
* Run (careful!)
* Acquire
* Keep
* Bundle->(Save|Save as...)
}
}
###
#
#
#
proc tktwig::usage {} {
variable cfg
append usage $cfg(title) \n usage: " "
append usage [string tolower $cfg(name)] " " {[-b bundleFile] [-z configFile]}
return $usage
}
###
#
#
#
proc tktwig::about {} {
variable cfg
lappend vd $cfg(title)
lappend vd $cfg(author)
lappend vd {} {Fall 2008}
if {$cfg(twigpack)} {
lappend vd {} {Twigpack also contains} {programs by other authors}
}
return [join $vd \n]
}
###
#
#
#
proc tktwig::license {} {
variable cfg
if {$cfg(twigpack)} {
set {} {
TkTwig is copyright Stuart Cassoff (see below).
Everything else copyright their respective authors.
}
}
return [append {} {
Copyright (c) 2008 Stuart Cassoff <[email protected]>
Permission to use, copy, modify, and/or distribute this software for any
purpose with or without fee is hereby granted, provided that the above
copyright notice and this permission notice appear in all copies.
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
}]
}
###
#
#
#
proc tktwig::messages {} {
variable cfg
return [join $cfg(messages) \n]
}
###
#-------------------------------------------------------------------
# TkTwig
#-------------------------------------------------------------------
#
#
#
proc tktwig::checkTwig {twig} {
variable cfg
if {[catch {llength $twig} l] || $l < [llength $cfg(twigFields)]} { return 0 }
return 1
}
###
#
#
#
proc tktwig::rovosTwig {rovos} {
variable cfg
variable gui
variable attached
set sel [$gui(lb) curselection]
if {[llength $sel] == 0} { return }
set idx [lindex $sel 0]
set twig [lindex $cfg(twigs) $idx]
lassign $twig page blocks sum url name
if {[catch {
if {[info exists attached($twig)]} {
if {$rovos in {run view sum}} {
set blob [lindex [loadFile $twig] 1]
verifySum $twig $blob
switch -exact -- $rovos {
run { exec $cfg(run) <<$blob & }
view { view $blob $name }
sum { $gui(lb) itemconfigure [lindex $sel 0] \
-background green -selectbackground lightgreen }
default { Huh? }
}
} else {
huh?
}
} else {
switch -exact -- $rovos {
run { if {$cfg(runPipe)} {
exec $cfg(tclsh) $cfg(twig) -s $sum $page $blocks | $cfg(run) &
} else {
exec $cfg(run) <<[twiggit $page $blocks $sum] &
} }
view { view [twiggit $page $blocks $sum] $name }
sum { twiggit $page $blocks $sum
$gui(lb) itemconfigure [lindex $sel 0] \
-background green -selectbackground lightgreen
}
default { huh? }
}
}
} err]} {
$gui(lb) itemconfigure [lindex $sel 0] \
-background red -selectbackground pink
addError $err
}
}
###
#
#
#
proc tktwig::newTwig {} {
variable cfg
set editData {}
foreach n $cfg(twigFields) {
lappend editData $n {}
}
editSomething $cfg(NS)::newTwigSaveCallback {} $editData New\ Twig true
}
###
#
#
#
proc tktwig::newTwigSaveCallback {clientData editData} {
variable cfg
set twig {}
foreach {n v} $editData { lappend twig $v }
lappend cfg(twigs) $twig
refreshTwiglist
return 1
}
###
#
#
#
proc tktwig::editTwig {{twig {}}} {
variable cfg
if {![checkTwig $twig]} {
variable gui
set sel [$gui(lb) curselection]
if {[llength $sel] == 0} { return }
set idx [lindex $sel 0]
set twig [lindex $cfg(twigs) $idx]
} else {
set idx -1
}
if {![checkTwig $twig]} { return }
set editData {}
foreach n $cfg(twigFields) v $twig {
lappend editData $n $v
}
editSomething $cfg(NS)::editTwigSaveCallback $idx $editData Edit\ Twig\ $idx:\ [lindex $editData end] true
}
###
#
#
#
proc tktwig::editTwigSaveCallback {clientData editData} {
variable cfg
set twig {}
foreach {n v} $editData { lappend twig $v }
set cfg(twigs) [lreplace $cfg(twigs) $clientData $clientData $twig]
refreshTwiglist
return 1
}
###
#
#
#
proc tktwig::deleteTwig {{idx -1}} {
variable cfg
if {$idx == -1} {
variable gui
set sel [$gui(lb) curselection]
if {[llength $sel] == 0} { return }
set idx [lindex $sel 0]
}
set cfg(twigs) [lreplace $cfg(twigs) $idx $idx]
refreshTwiglist
}
###
#-------------------------------------------------------------------
# Bundle
#-------------------------------------------------------------------
#
#
#
proc tktwig::loadBundle {{fn {?}} {append false}} {
variable cfg
if {$fn eq {}} { set fn $cfg(bundleFile) }
lassign [loadListFile $fn [list $cfg(filetypes,bundle)]] fn data
if {$fn eq ""} { return 0 }
if {!$append} { set cfg(twigs) {} }
foreach t $data { if {[checkTwig $t]} { lappend cfg(twigs) [lrange $t 0 end] }}
set cfg(bundleFile) $fn
refreshTwiglist
return 1
}
###
#
#
#
proc tktwig::saveBundle {{fn {}}} {
variable cfg
if {$fn eq {}} { set fn $cfg(bundleFile) }
set cfg(bundleFile) [saveFile $fn [join $cfg(twigs) \n] [list $cfg(filetypes,bundle)]]
refreshGUI
}
###
#
#
#
proc tktwig::unsumBundle {} {
variable gui
for {set i [$gui(lb) size];incr i -1} {$i >= 0} {incr i -1} {
$gui(lb) itemconfigure $i \
-background $gui(defBackground) \
-selectbackground $gui(defSelectbackground)
}
}
###
#-------------------------------------------------------------------
# Config
#-------------------------------------------------------------------
#
#
#
proc tktwig::loadConfig {{fn {?}}} {
variable cfg
if {$fn eq {}} { set fn $cfg(configFile) }
lassign [loadListFile $fn [list $cfg(filetypes,config)]] fn data
if {$fn eq ""} { return 0 }
array set cfg [processNv $data $cfg(configFileFields)]
set cfg(configFile) $fn
adjustConfig
refreshGUI
return 1
}
###
#
#
#
proc tktwig::saveConfig {{fn {}}} {
variable cfg
if {$fn eq {}} { set fn $cfg(configFile) }
set l {}
foreach n $cfg(configFileFields) {
lappend l [list $n $cfg($n)]
}
set fn [saveFile $fn [join $l \n] [list $cfg(filetypes,config)]]
if {$fn eq ""} { return 0 }
set cfg(configFile) $fn
adjustConfig
refreshGUI
return 1
}
###
#
#
#
proc tktwig::autoloadConfig {} {
variable cfg
adjustConfig
if {[info exists cfg(pConfigFile)]} { set cfg(configFile) $cfg(pConfigFile) }
adjustConfig
if {$cfg(autoloadConfigFile)} { loadConfig {} }
if {[info exists cfg(pBundleFile)]} { set cfg(bundleFile) $cfg(pBundleFile) }
adjustConfig
if {$cfg(autoloadBundleFile)} { loadBundle $cfg(bundleFile) }
adjustConfig
}
###
#
#
#
proc tktwig::editConfig {} {
variable cfg
set editData {}
foreach n $cfg(configFileFields) {
lappend editData $n $cfg($n)
}
editSomething $cfg(NS)::editConfigSaveCallback {} $editData Edit\ Config
}
###
#
#
#
proc tktwig::editConfigSaveCallback {clientData editData} {
variable cfg
foreach {n v} $editData { set cfg($n) $v }
adjustConfig
refreshGUI
return 1
}
###
#
#
#
proc tktwig::adjustConfig {} {
variable cfg
#set cfg(configFile) [file normalize $cfg(configFile)]
#set cfg(bundleFile) [file normalize $cfg(bundleFile)]
}
###
#-------------------------------------------------------------------
# File
#-------------------------------------------------------------------
#
#
#
proc tktwig::loadFile {{fn {}} {filetypes {}} } {
variable cfg
variable gui
variable attached
if {$fn eq {} || $fn eq {?}} {
lappend filetypes $cfg(filetypes,all)
set fn [tk_getOpenFile -filetypes $filetypes -parent $gui(W)]
}
if {$fn eq {}} { return {} }
set isAttached false
if {[catch {
if {[string index $fn 0] eq "+"} {
if {![info exists [set var [string range $fn 1 end]]]} { return {} }
upvar 1 $var data
} elseif {$fn eq "-"} {
set data [read -nonewline stdin]
} elseif {[info exists attached($fn)]} {
set f [open $::argv0]
seek $f [lindex $attached($fn) 0] start
set data [read $f [lindex $attached($fn) 1]]
close $f
set isAttached true
} else {
set f [open $fn r]
set data [read -nonewline $f]
close $f
}
} err]} {
addError $err
return {}
}
return [list $fn $data $isAttached]
}
###
#
#
#
proc tktwig::saveFile {{fn {}} data {filetypes {}}} {
variable cfg
if {$fn eq {?}} {
lappend filetypes $cfg(filetypes,all)
set fn [tk_getSaveFile -filetypes $filetypes]
}
if {$fn eq {}} { return $fn }
if {$fn eq "-"} { puts stdout $data; return $fn }
set f [open $fn w]
puts $f $data
close $f
return $fn
}
###
#
#
#
proc tktwig::loadListFile {{fn {}} {filetypes {}} } {
set res {}
lassign [loadFile $fn $filetypes] fn data
foreach l [split $data \n] {
set l [string trim $l]
if {$l eq {} || [string index $l 0] eq {#}} { continue }
if {[catch {set len [llength $l]}] || $len < 1} { continue }
lappend res $l
}
return [list $fn $res]
}
###
#-------------------------------------------------------------------
# Twig
#-------------------------------------------------------------------
#
#
#
proc tktwig::run {code} {
variable cfg
exec $cfg(run) <<$code &
}
###
#
#
#
proc tktwig::twiggit {page {blocks 0} {sum {flipper}}} {
variable cfg
return [exec $cfg(tclsh) $cfg(twig) -s $sum $page $blocks]
}
###
#
#
#
proc tktwig::query {editInfo} {
variable cfg
variable gui
array set ei $editInfo
set page [$ei(page) get]
if {$page eq ""} { return }
set name [$ei(name) get]
if {[catch {
set data [exec $cfg(tclsh) $cfg(twig) -q $gui(query) $page]
} err]} {
addError $err
view $err ERROR
return
}
view $data "Query ($gui(query)): $page $name"
}
###
#
#
#
proc tktwig::acquire {editInfo} {
variable cfg
variable gui
array set ei $editInfo
set page [$ei(page) get]
if {$page eq ""} { return }
set blocks [$ei(blocks) get]
if {$blocks eq ""} { $ei(blocks) insert end [set blocks 0] }
if {[catch {
set twig [exec $cfg(tclsh) $cfg(twig) -g -n $page $blocks]
} err]} {
addError $err
view $err ERROR
return
}
$ei(sum) delete 0 end
$ei(sum) insert 0 [lindex $twig 2]
$ei(name) delete 0 end
$ei(name) insert 0 [lindex $twig 4]
}
###
#
#
#
proc tktwig::eView {editInfo} {
variable cfg
variable gui
array set ei $editInfo
set page [$ei(page) get]
if {$page eq ""} { return }
set blocks [$ei(blocks) get]
if {$blocks eq ""} { $ei(blocks) insert end [set blocks 0] }
set sum DO-NOT-VERIFY-SUM
if {[catch {
set data [twiggit $page $blocks $sum]
} err]} {
addError $err
view $err ERROR
return
}
view $data $page:$blocks\ [$ei(name) get]
}
###
#-------------------------------------------------------------------
# Misc
#-------------------------------------------------------------------
#
#
#
proc tktwig::processNv {data flds} {
set res {}
foreach l $data {
if {[lsearch -exact $flds [lindex $l 0]] == -1} { continue }
lappend res {*}$l
}
return $res
}
###
#
#
#
proc tktwig::viewFile {} {
if {[lindex [set what [loadFile]] 0] ne ""} { view {*}[lreverse [lrange $what 0 end-1]] }
}
###
#
#
#
proc tktwig::viewIt {what} {
view [[string tolower $what]] $what
}
###
#
#
#
proc tktwig::alias {this that args} {
variable cfg
interp alias {} $cfg(NS)::$this {} $cfg(NS)::$that {*}$args
}
###
#
#
#
proc tktwig::addError {msg} {
variable cfg
variable gui
lappend cfg(messages) [clock seconds]\ $msg
set gui(ntwigs,norm) false
refreshGUI
}
###
#
#
#
proc tktwig::verifySum {twig blob} {
variable cfg
if {!$cfg(md5Available)} { return }
set csum [::md5::md5 -hex $blob]
if {$csum ne [lindex $twig 2]} {
error Bad\ checksum!\n[lrange $twig 0 2]\ $csum
}
}
###
#-------------------------------------------------------------------
# GUI
#-------------------------------------------------------------------
#
#
#
proc tktwig::resetButton {button} {
variable gui
if {$button eq "ntwigs" && !$gui($button,norm)} { viewIt messages }
set gui($button,norm) true
refreshGUI
}
###
#
#
#
proc tktwig::toggleButton {button} {
variable gui
set gui($button,norm) [expr {!$gui($button,norm)}]
refreshGUI
}
###
#
#
#
proc tktwig::refreshGUI {} {
variable cfg
if {!$cfg(guiCreated)} { return }
variable gui
foreach what [list bundle config] {
set t [file normalize $cfg($what\File)]
if {$gui($what,norm)} { set t [file tail $t] }
$gui($what) configure -text $t
}
if {$gui(ntwigs,norm)} {
set txt ([llength $cfg(twigs)])
set bg $gui(defButtonBackground)
} else {
set txt "Check Messages"
set bg red
}
$gui(ntwigs) configure -text $txt -bg $bg
}
###
#
#
#
proc tktwig::refreshTwiglist {} {
variable cfg
if {!$cfg(guiCreated)} { return }
variable gui
$gui(lb) delete 0 end
foreach t $cfg(twigs) {
$gui(lb) insert end [lindex $t 4]\ -\ ([file tail [lindex $t 0]]\ [lindex $t 1])
}
set ntwigs [llength $cfg(twigs)]
if {$ntwigs > 0} {
$gui(lb) configure -width 0 -height 20
} else {
$gui(lb) configure -width 0 -height 0
}
refreshGUI
}
###
#
#
#
proc tktwig::refreshQueryButton {{incr 0}} {
variable gui
incr gui(query) $incr
if {$gui(query) < 0} { set gui(query) 0 }
$gui(queryButton) configure -text "Query ($gui(query))"
}
###
#
#
#
proc tktwig::newToplevelName {} {
variable cfg
variable gui
return $gui(w).[string tolower $cfg(name)][regsub -all {\.} $cfg(ver) {}]_[subst [string repeat {[format %c [expr {65 + int(rand() * 26)}]]} 10]]
}
###
#
#
#
proc tktwig::view {{what {}} {title {}}} {
variable cfg
variable gui
toplevel [set dlg [newToplevelName]]
wm group $dlg $gui(W)
set w $dlg
set tf [ttk::frame $w.tf]
text $tf.text -wrap none -yscroll [list $tf.vsb set] -xscroll [list $tf.hsb set]
ttk::scrollbar $tf.vsb -orient vertical -command [list $tf.text yview]
ttk::scrollbar $tf.hsb -orient horizontal -command [list $tf.text xview]
set bf [ttk::frame $w.bf]
ttk::button $bf.br -text Run -width -12 -command "$cfg(NS)::run \[$tf.text get 1.0 end-1c\]"
ttk::button $bf.bc -text Clear -width -12 -command "$tf.text delete 1.0 end"
ttk::button $bf.bs -text Save -width -12 -command "$cfg(NS)::saveFile ? \[$tf.text get 1.0 end-1c\]"
ttk::button $bf.bd -text Dismiss -width -12 -command [list destroy $dlg]
grid $tf.text $tf.vsb -sticky news
grid $tf.hsb -sticky ew
set c -1
grid $bf.br -row 0 -column [incr c] -sticky e -padx 4
grid $bf.bc -row 0 -column [incr c] -sticky e
grid $bf.bs -row 0 -column [incr c] -sticky e -padx 4
grid $bf.bd -row 0 -column [incr c] -sticky e
grid $tf -sticky news
grid $bf -sticky ew
grid rowconfigure $tf 0 -weight 1
grid columnconfigure $tf 0 -weight 1
grid rowconfigure $bf 0 -weight 1
grid columnconfigure $bf 0 -weight 1
grid rowconfigure $w 0 -weight 1
grid columnconfigure $w 0 -weight 1
bind $dlg <Control-q> [list $bf.bd invoke]
bind $dlg <Control-Q> [list $bf.bd invoke]
wm title $dlg [wm title $gui(W)]\ -\ $title
$tf.text delete 1.0 end
$tf.text insert end $what
focus $dlg
::tk::PlaceWindow $dlg widget $gui(W)
}
###
#
#
#
proc tktwig::editSomething {saveCallback clientData editData {title {Edit}} {tool false}} {
variable cfg
variable gui
toplevel [set dlg [newToplevelName]]
wm group $dlg $gui(W)
set w $dlg
set ef [ttk::frame $w.ef]
foreach {n v} $editData {
set nt [string totitle $n]
grid [ttk::label $ef.l$nt -text $n -justify left] \
[ttk::entry $ef.e$nt -width 40] -sticky ew
$ef.e$nt insert end $v
lappend editInfo $n $ef.e$nt
}
set bf [ttk::frame $w.bf]
if {$tool} {
set bqp [ttk::button $bf.bqp -text + -width -1 -command [list $cfg(NS)::refreshQueryButton 1]]
set bqm [ttk::button $bf.bqm -text - -width -1 -command [list $cfg(NS)::refreshQueryButton -1]]
set bq [ttk::button $bf.bq -width -12 -command [list $cfg(NS)::query $editInfo]]
set ba [ttk::button $bf.ba -text Acquire -width -12 -command [list $cfg(NS)::acquire $editInfo]]
set bv [ttk::button $bf.bv -text View -width -12 -command [list $cfg(NS)::eView $editInfo]]
set gui(query) 1
set gui(queryButton) $bq
refreshQueryButton
}
ttk::button $bf.bk -text Keep -width -12 -command [list $cfg(NS)::editSomethingSaveCallback $dlg $editInfo $saveCallback $clientData]
ttk::button $bf.bd -text Discard -width -12 -command [list destroy $dlg]
if {$tool} { grid $bqp $bqm $bq $ba $bv -sticky e; set push x } else { set push "" }
grid {*}$push {*}$push {*}$push $bf.bk $bf.bd -sticky e
grid $ef -sticky nsew -padx 1 -pady 1
grid $bf -sticky ew -padx 1 -pady 1
grid columnconfigure $ef 1 -weight 1
grid columnconfigure $bf 0 -weight 1
grid rowconfigure $bf 1 -weight 1
grid rowconfigure $w 0 -weight 1
grid columnconfigure $w 0 -weight 1
bind $dlg <Control-q> [list $bf.bd invoke]
bind $dlg <Control-Q> [list $bf.bd invoke]
wm title $dlg [wm title $gui(W)]\ -\ $title
focus $ef.e[string totitle [lindex $editData 0 0]]
::tk::PlaceWindow $dlg widget $gui(W)
}
###
#
#
#
proc tktwig::editSomethingSaveCallback {w editInfo saveCallback clientData} {
set editData {}
foreach {n e} $editInfo {
lappend editData $n [$e get]
}
if {[$saveCallback $clientData $editData]} {
destroy $w
}
}
###
#-------------------------------------------------------------------
# Setup
#-------------------------------------------------------------------
#
#
#
proc tktwig::setupGUI {{W {.}}} {
variable cfg
variable gui
set gui(W) $W
set gui(w) [string trimright $gui(W) .]
set w $gui(w)
ttk::style theme use clam
set M [menu $w.m -tearoff 0]
foreach {menu items} [list \
File [list New View Exit] \
Twig [list Run View Sum Edit New Delete] \
Bundle [list Load Append Reload Save "Save As..." Unsum] \
Config [list Edit Load Save "Save As..."] \
Help [set helps [list About Readme Usage Messages License]]] {
$M add cascade -label $menu -menu [set menuw [menu $M.[string tolower $menu] -tearoff 0]] -underline 0
foreach item $items {
$menuw add command -label $item -command [list $cfg(NS)::[string tolower $item]$menu] -underline 0
}
}
set bf [ttk::frame $w.bf]
foreach button [list bundle ntwigs config] {
set b [string index $button 0]
set gui($button) [set btn$b [button $bf.btn$b -command [list $cfg(NS)::toggleButton $button]]]
set gui($button,norm) true
}
$gui(ntwigs) configure -command [list $cfg(NS)::resetButton ntwigs]
set gui(lb) [listbox $w.lb -selectmode browse -exportselection 0 -yscrollcommand [list $w.vsb set] -xscrollcommand [list $w.hsb set]]
ttk::scrollbar $w.vsb -orient vertical -command [list $gui(lb) yview]
ttk::scrollbar $w.hsb -orient horizontal -command [list $gui(lb) xview]
grid $btnb $btnn $btnc -sticky ew
grid $bf -columnspan 2 -sticky ew
grid $gui(lb) $w.vsb -sticky nsew
grid $w.hsb -sticky ew
grid columnconfigure $bf 0 -weight 1
grid columnconfigure $bf 2 -weight 1
grid rowconfigure $W 1 -weight 1
grid columnconfigure $W 0 -weight 1
$W configure -menu $M
wm title $W $cfg(title)
bind $gui(W) <Control-q> exit
bind $gui(W) <Control-Q> exit
bind $gui(lb) <Double-Button-1> [list $cfg(NS)::rovosTwig run]
bind a <Button-3> [bind Listbox <Button-1>]
bind b <Button-3> [bind Listbox <ButtonRelease-1>]
bind c <Button-3> [list tk_popup $M.twig %X %Y]
bindtags $gui(lb) [bindtags $gui(lb)]\ a\ b\ c
alias newFile view {} "New file"
alias exitFile exit
interp alias {} $cfg(NS)::exit {} ::exit
foreach a $helps { alias [string tolower $a]Help viewIt $a }
foreach a [list run view sum] { alias $a\Twig rovosTwig $a }
set gui(defBackground) [$gui(lb) cget -background]
set gui(defSelectbackground) [$gui(lb) cget -selectbackground]
set gui(defButtonBackground) [$gui(ntwigs) cget -background]
set cfg(guiCreated) true
}
###
#
#
#
proc tktwig::args {} {
if {$::argc == 0} { return }
variable cfg
set state opt
foreach arg $::argv {
switch -exact -- $state {
opt {
switch -exact -- $arg {
-b - -z { set state $arg }
-h - -? - -help - --help { puts stderr [usage]; exit 0 }
default { puts stderr "Huh? Try -?"; exit 1 }
}
}
-b { set state opt; set cfg(pBundleFile) $arg }
-z { set state opt; set cfg(pConfigFile) $arg }
}
}
}
###
#
#
#
proc tktwig::setupAttached {} {
variable attached
array set attached {}
set f [open $::argv0]
fconfigure $f -eofchar \x1a
read $f
set offset [tell $f]
while {1} {
seek $f 1 current
set name [gets $f]
if {[eof $f]} { break }
incr offset;incr offset [string length $name];incr offset; #^Z+name+\n
set length [string length [read $f]]
set attached($name) [list $offset $length]
incr offset $length
}
close $f
}
###
#
#
#
proc tktwig::setupTwigpack {} {
variable cfg
if {!$cfg(twigpack)} { return }
variable attached
if {[catch {
set fn md5x.tcl
if {[info exists attached($fn)]} { uplevel #0 [lindex [loadFile $fn] 1] }
package require md5
set cfg(md5Available) true
} err]} {
addError Sum\ Verification\ Unavailable!\n$err
}
}
###
#
#
#
proc tktwig::setup {} {
variable cfg
variable attached
array set attached {}
set cfg(NS) [namespace current]
set cfg(name) TkTwig
set cfg(ver) 0.4
set cfg(author) {Stuart Cassoff}
set cfg(twigpack) 0
set cfg(tclsh) tclsh
set cfg(wish) wish
set cfg(twig) /path/to/twig.tcl
set cfg(run) $cfg(wish)
set cfg(runPipe) 0
set cfg(configFile) ~/.tktwig.conf
set cfg(autoloadConfigFile) 1
set cfg(configFileFields) [list tclsh wish twig run bundleFile \
runPipe autoloadBundleFile]
set cfg(bundleFile) ~/mytwigs.twig
set cfg(autoloadBundleFile) 1
set cfg(twigs) {}
set cfg(twigFields) {page blocks sum url name}
set cfg(filetypes,config) {{Twig Configuration Files} *.conf}
set cfg(filetypes,bundle) {{Twig Bundles} .twig}
set cfg(filetypes,all) {{All Files} *}
set cfg(messages) {}
set cfg(guiCreated) false
set cfg(title) $cfg(name)\ $cfg(ver)
if {$cfg(twigpack)} {
set cfg(twigpackName) TwigPack
set cfg(twigpackNum) 1
set cfg(md5Available) false
append cfg(title) " + " $cfg(twigpackName) " #" $cfg(twigpackNum)
}
alias reloadBundle loadBundle ""
alias appendBundle loadBundle ? true
alias save\ as...Bundle saveBundle ?
alias save\ as...Config saveConfig ?
}
###
#
namespace eval tktwig {
setup; args
catch { setupAttached }
package require Tk 8.5-
setupGUI
setupTwigpack
after idle tktwig::autoloadConfig;tktwig::refreshTwiglist
}
#
# EOF