TkTwig - GUI frontend to [Twig]

Directions to find it at [Stu]
----
**SOURCE**
======
#! /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 <stwo@users.sourceforge.net>

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
======


<<categories>> Application | Tcler's Wiki