Version 2 of Herring

Updated 2012-09-08 15:37:38 by RLE

Herring - extension for TkChat

Herring extends TkChat by adding wiki search and TWiG capabilities.

Directions to find it at Stu

Stu 2008-10-23 Created this page.


README

Herring - extension for TkChat
Stuart Cassoff
October 2008

Herring is a chunk of Tcl code that extends TkChat,
adding wiki search and TWiG capabilities.


(-O-) Config, Install & Nomenclature (-O-)

* Acquire: herring.
* Modify: change any paths listed in the
  '# Set paths here' chunk near the top of the file.
* Start: TkChat.
* Open: console from debug menu.
* Type: source /path/to/herring.tcl
* Hit: Enter, Return, CR, ^M or whatever.
* No errors should mean that herring is ready to go!

This doc:
* > means what you type.
* ] means response from chat.
* Checksums vetted at time of writing.


{-O-} Herring {-O-}

> /herring
] Herring        Herring 0.2
                October 2008, Stuart Cassoff
                /herring ? for help

> /herring ?
] Herring        Herring 0.2 can do
                /wikref
                /twig
                Consult each one and try to
                figure out what it does.


<-O-> Wikiref <-O->

To search the Tcler's wiki for 'term' and inject
the result into the chat:
> /wikiref term

Send the result to a user:
> /wikiref user term

Send the result to yourself:
> /wikiref me term


[-O-] TWiG [-O-]

Usage:
> /twig
] TWiG        TWiG 0.2
        /twig ? for help

Help:
> /twig ?
] TWiG        TWiG 0.2 Commands
        list ?-raw? ?user?
        run|view ?user? #.
        run|view page ?blocks?
        view ?filename?
        view ? (ask for file to view)
        view {} (view your .twig file)
        load ?filename?
        conf ?name? ?value?

Run 'colliding balls':
> /twig run 8573

View a clock
> /twig view 1011 1

Open a view window:
> /twig view

Ask for a file to load into a view window:
> /twig view ?

Specify a file to load and view:
> /twig view myfile

Load and view myTwigListFile:
> /twig view {}

Config:
> /twig conf
] TWiG        Configuration
        tclsh                /usr/local/bin/tclsh8.5
        wish                /usr/local/bin/wish8.5
        twig                ~/tcl/twig/twig.tcl
        run                /usr/local/bin/wish8.5
        myTwigListFile        ~/twig/twiglist.twig
        runPipe                0

> /twig conf wish
] TWiG        /usr/local/bin/wish8.5

> /twig conf wish ~/test/testwish
] TWiG        ~/test/testwish

Load myTwigListFile twig list:
> /twig load
] TWiG        ~/twig/twiglist.twig loaded ok

Load twig list:
> /twig load anothertwiglist

Ask and load twig list:
> /twig load ?

Lists:
> /twig list
] TWiG        no twigs

> /twig load
] TWiG        ~/twig/twiglist.twig loaded ok

> /twig list
] TWiG        Loaded TWiGs 
        1. Colliding balls
        2. Analog clock in Tk 1
        3. Digital clock in Tk
        4. tkGoldberg
        5. Kandinsky Dance
        6. Starfield

> /twig list -raw
TWiG        Loaded TWiGs  (raw)
        1. 8573 1 0D1C40670AA51DCA086643CCD5BE2AFA {} {Colliding balls}
        2. 1011 1 0620FE9712B3D0F7D222B45CC6BAB383 {} {Analog clock in Tk 1}
        3. 1011 2 DA0E37255F9EDEC2D0A7AD7A5F95DC98 {} {Digital clock in Tk}
        4. 8607 1 6D3E93EA90FF3F77736081A20976BA4E {} tkGoldberg
        5. 15178 1 91F26376C0EA8118032C7CD650B8D262 {} {Kandinsky Dance}
        6. 10100 1 E44CD350F9AE925AAEF2C328DAC550C6 {} Starfield

Refer to twigs from lists by number + dot:
> /twig run 5.
> /twig view 2.


|-O-| TkChat Integration |-O-|

Place twigs in the 'anything else' box of your 'User Info',
sandwiched between: -*- TWiGs -*- like this:

-*- TWiGs -*-
8573 0 0D1C40670AA51DCA086643CCD5BE2AFB {} {Colliding balls}
1011 1 0620FE9712B3D0F7D222B45CC6BAB383 {} {An analog clock in Tk}
8607 0 6D3E93EA90FF3F77736081A20976BA4E {} tkGoldberg
-*- TWiGs -*-

Then, others can access them through TkChat:

> /twig list stu
] TWiG        TWiGs for [email protected]
        1. Colliding balls
        2. An analog clock in Tk
        3. tkGoldberg

> /twig run stu 1.
> /twig view stu 2.

In the above, 'Colliding balls' has the wrong checksum, for testing.


# EOF

SOURCE

# herring
#
# May 2008
# Stuart Cassoff
#
# October 2008
# Slight update
#
# ISC license
#
# Use at your own risk :p
#

namespace eval herring {
        variable HookUserInfoDialog 0
        variable InfoRaw 0
        variable TwigAction [list {} 0]

        variable cfg

        set cfg(version) 0.2
        set cfg(verdate) "October 2008"
        set cfg(author) "Stuart Cassoff"
        set cfg(twigversion) 0.2
        

        # Set paths here
        set cfg(tclsh) /usr/local/bin/tclsh8.5
        set cfg(wish) /usr/local/bin/wish8.5
        set cfg(twig) ~/tcl/twig/twig.tcl
        set cfg(run) $cfg(wish)

        set cfg(myTwigListFile) ~/twig/twiglist.twig
        #


        set cfg(twigs) {}

        # Chat Text Window
        set cfg(ctw) .txt

        set cfg(aliasMap) [list \
                wikiref        ::herring::wikiref \
                twig        ::herring::twig \
                herring ::herring::herring
        ]

        set cfg(floodcount) 0
        set cfg(floodmax) 15

        set cfg(runPipe) 0

        set cfg(cfgElems) [list tclsh wish twig run myTwigListFile runPipe]
}

proc herring::herring {msg} {
        variable cfg
        set m {}
        if {[lindex $msg 0] eq "?"} {
                lappend m "Herring $cfg(version) can do"
                lappend m "/wikref"
                lappend m "/twig"
                lappend m "Consult each one and try to"
                lappend m "figure out what it does."
        } else {
                lappend m "Herring $cfg(twigversion)"
                lappend m "$cfg(verdate), $cfg(author)"
                lappend m "/herring ? for help"
        }
        print [join $m \n] MSG Herring
}

proc herring::wikisearch {what {max -1}} {
        set z {}
        set c 0
        set h [http::geturl http://wiki.tcl.tk/_search?S=$what]
        if {[http::status $h] eq {ok}} {
                foreach {. p n} [regexp -inline -all {<li>.*?\. \. \. <a href="/(.*?)">(.*?)</a>} [http::data $h]] {
                        lappend z http://wiki.tcl.tk/$p\ \t$n   
                        if {$max == -1} { continue }
                        if {[incr c] >= $max} {        break }
                }
        }
        http::cleanup $h
        return $z
}

proc herring::wikiref {msg} {
        global Options
        variable cfg

        set local 0
        if {[llength $msg] > 1} {
                set user [lindex $msg 0]
                set msg [lindex $msg 1]
                if {$user eq {me}} {
                        set user $Options(Nickname)
                }
                if {$user eq $Options(Nickname)} {
                        set local 1
                }
        } else  {
                set msg [lindex $msg 0]
                if {$msg eq "?"} {
                        lappend m "Wikiref $cfg(version) Commands"
                        lappend m "term (search term > chat)"
                        lappend m "user term (search term > user)"
                        lappend m "me term (search term > you)"
                        print [join $m \n] MSG Wikiref
                        return
                } elseif {$msg eq ""} {
                        lappend m "Wikiref $cfg(version)"
                        lappend m "/wikiref ? for help"
                        print [join $m \n] MSG Wikiref
                        return
                } else {
                        set user {}
                }
        }

        set msg [string map [list { } %20] $msg]
        set srchres [wikisearch $msg 10]
        if {[llength $srchres] > 0} {
                if {$local} {
                        print [join $srchres \n]
                } else {
                        send [join $srchres \n] $user
                }
        }
}

proc herring::loadTwigs {{fn {}}} {
        variable cfg

        if {$fn eq {}} {
                set fn $cfg(myTwigListFile)
        } elseif {$fn eq {?}} {
                set fn [tk_getOpenFile -defaultextension .twig -filetypes {{{TWiG Files} .twig} {{All Files} *}}]
                if {$fn eq {}} {
                        return {}
                }
        }

        set cfg(twigs) {}

        set f [open $fn r]
        set cfg(twigs) [split [read -nonewline $f] \n]
        close $f

        return "$fn loaded ok"
}

proc herring::prettyTwigs {twigs {raw 0}} {
        if {[llength $twigs] == 0} {
                return {no twigs}
        }
        set t {}
        set n 0
        foreach l $twigs {
                if {$raw} {
                        set l [linsert $l 0 [incr n].]
                } else {
                        set l "[incr n]. [lindex $l 4]"
                }
                lappend t $l
        }
        return [join $t \n]
}

proc herring::twiggit {page {blocks 0} {sum {flipper}}} {
        variable cfg
        return [exec $cfg(tclsh) $cfg(twig) -s $sum $page $blocks]
}

proc herring::runTwig {page {blocks 0} {sum {trout}} {name {}}} {
        variable cfg
        if {$cfg(runPipe)} {
                exec $cfg(tclsh) $cfg(twig) -s $sum $page $blocks > /tmp/cow &
        } else {
                exec $cfg(run) <<[twiggit $page $blocks $sum] &
        }
}

proc herring::viewTwig {page {blocks 0} {sum {zorro}} {name {}}} {
        view [twiggit $page $blocks $sum] $name
}

proc herring::twig {msg} {
        variable cfg

        if {[catch {llength $msg}]} { return }
        set mlen [llength $msg]

        switch -exact -- [lindex $msg 0] {
        conf {
                if {$mlen > 1 && $mlen < 4} {
                        set elem [lindex $msg 1]
                        if {[set i [lsearch -exact $cfg(cfgElems) $elem]] == -1} {
                                print "Unknown config option \"$elem\""
                        }
                        set elemName [lindex $cfg(cfgElems) $i]
                        if {$mlen > 2} {
                                set cfg($elemName) [lindex $msg 2]
                        }
                        print $cfg($elemName)
                } elseif {$mlen == 1} {
                        set m {}
                        lappend m "Configuration"
                        foreach c $cfg(cfgElems) {
                                lappend m $c\t$cfg($c)
                        }
                        print [join $m \n]
                } else {
                        print "conf usage: conf ?name? ?value?"
                }
        }
        load {
                set fn {}
                set tag {}
                if {$mlen == 2} { set fn [lindex $msg 1] }
                if {[catch {loadTwigs $fn} e]} { set tag ERROR }
                if {$e eq {}} { return }
                print $e $tag
        }
        list {
                set start 1
                set raw [expr {[lindex $msg $start] eq {-raw}}]
                if {$raw} { incr start }
                set user [lindex $msg $start]
                if {$user ne {}} {
                        variable HookUserInfoDialog 1
                        variable TwigInfoRaw $raw
                        ::tkjabber::userinfo $user
                        return
                }
                if {[llength $cfg(twigs)] == 0} {
                        print {no twigs}
                        return
                }
                print Loaded\ TWiGs\ [expr {$raw?" (raw)":""}]\n[prettyTwigs $cfg(twigs) $raw] 
        }
        view -
        run {
                set hasNumDot [regexp {^(.+)\.$} [lindex $msg end] -> num]
                set msg0 [lindex $msg 0]
                if {$msg0 eq {view}} {
                        if {$mlen == 1} {
                                view
                                return
                        } elseif {$mlen == 2 && !$hasNumDot} {
                                set tag {}
                                if {[catch {viewFile [lindex $msg 1]} e]} { set tag ERROR }
                                if {$e eq {}} { return }
                                print $e $tag
                                return
                        }
                }
                if {$hasNumDot} {
                        if {$mlen > 2} {
                                variable HookUserInfoDialog 1
                                variable TwigAction [list $msg0 $num]
                                ::tkjabber::userinfo [lindex $msg 1]
                                return
                        }
                        if {[llength $cfg(twigs)] == 0} {
                                print {no twigs}
                                return
                        }
                        if {$num < 1 || $num > [llength $cfg(twigs)]} {
                                print {TWiG not found}
                                return
                        }
                        incr num -1
                        lassign [lindex $cfg(twigs) $num] page blocks sum url name
                } elseif {$mlen > 1} {
                        set page [lindex $msg 1]
                        set blocks [lindex $msg 2]
                        if {[llength $blocks] == 0} {
                                set blocks 0
                        }
                        set name {}
                        set sum DO-NOT-VERIFY-SUM
                } else {
                        print "run|view usage\nrun|view ?user? #.\nrun|view page ?blocks?\nview"
                        return
                }
                if {[catch [list ${msg0}Twig $page $blocks $sum $name] e]} {
                        print $e ERROR
                }
        }
        ? {
                set m {}
                lappend m "TWiG $cfg(twigversion) Commands"
                lappend m "list ?-raw? ?user?"
                lappend m "run|view ?user? #."
                lappend m "run|view page ?blocks?"
                lappend m "view ?filename?"
                lappend m "view ? (ask for file to view)"
                lappend m "view {} (view your .twig file)"
                lappend m "load ?filename?"
                lappend m "conf ?name? ?value?"
                print [join $m \n]
        }
        default {
                print "TWiG $cfg(twigversion)\n/twig ? for help"
        }
        }
}

proc herring::send {msg {user {me}}} {
        global Options
        variable cfg

        incr cfg(floodcount)

        if {$cfg(floodcount) > $cfg(floodmax)} {return}

        if {$cfg(floodcount) == $cfg(floodmax)} {
                print "stubot: outgoing msg count exceeded $cfg(floodmax) msgs - not sending"
                return
        }

        if {[set c [string index $msg 0]] ne { } && $c ne {/}} {
                set msg " $msg"
        }
        if {$user eq {me}} {
                set user $Options(Nickname)
        }

        set max 350
        if {[string length $msg] <= $max} {
                ::tkjabber::msgSend "/nolog$msg" -user $user -attrs [list nolog 1]
        } else {
                print "stubot: outgoing msg exceeded $max chars - not sending"
        }
}

proc herring::print {msg {tag MSG} {from TWiG}} {
        variable cfg
        global Options

        if {$tag eq {}} {
                info default [lindex [info level 0] 0] tag tag
        }

        $cfg(ctw) configure -state normal

        set stuff [split $msg \n]
        $cfg(ctw) insert end $from\t[lindex $stuff 0]\n $tag
        foreach l [lrange $stuff 1 end] {
                $cfg(ctw) insert end \t$l\n $tag
        }

        $cfg(ctw) configure -state disabled
        if {$Options(AutoScroll)} {
                $cfg(ctw) see end
        }
}

proc herring::run {code} {
        variable cfg
        exec $cfg(run) <<$code &        
}

proc herring::save {what {name {}}} {
        if {$name eq {}} {
                set name [tk_getSaveFile]
                if {$name eq {}} {
                        return
                }
        }
        if {[catch {
                set f [open $name w]
                puts -nonewline $f $what
                close $f
        } e]} {
                print $e ERROR
        } else {
                print "$name saved ok"
        }
}

proc herring::viewFile {{fn {}}} {
        variable cfg
        if {$fn eq {}} {
                set fn $cfg(myTwigListFile)
        } elseif {$fn eq {?}} {
                set fn [tk_getOpenFile]
                if {$fn eq {}} {
                        return {}
                }
        }

        set f [open $fn r]
        set d [read -nonewline $f]
        close $f

        view $d $fn

        return {}
}

proc herring::view {{what {}} {title {}}} {
        variable ::tkchat::NS

        set dlg .plop
        set w $dlg.f
        if {![winfo exists $dlg]} {
                set dlg [::tkchat::Dialog $dlg]
                set w [${NS}::frame $w]
                wm transient $dlg {}
                wm withdraw $dlg
                if {[llength [info command ::tkchat::img::Tkchat]] != 0} {
                        catch {wm iconphoto $dlg ::tkchat::img::Tkchat}
                }
                ::tkchat::ScrolledWidget text $w.text 0 1 -height 23 -width 80 -borderwidth 0 -padx 2 -pady 2 -font FNT
                ${NS}::button $w.br -text Run     -width -12 -command "::herring::run \[$w.text get 1.0 end\]"  -default active
                ${NS}::button $w.bc -text Clear   -width -12 -command "$w.text delete 1.0 end"                  -default active
                ${NS}::button $w.bs -text Save    -width -12 -command "::herring::save \[$w.text get 1.0 end\]" -default active
                ${NS}::button $w.bd -text Dismiss -width -12 -command [list wm withdraw $dlg]                   -default active

                grid $w.text -sticky news  -columnspan 4

                grid $w.br                   -sticky se -padx 4
                grid    ^  $w.bc             -sticky se
                grid    ^     ^  $w.bs       -sticky se -padx 4
                grid    ^     ^     ^  $w.bd -sticky se

                grid rowconfigure    $w 0 -weight 1
                grid columnconfigure $w 0 -weight 1

                grid $w -sticky news

                grid rowconfigure    $dlg 0 -weight 1
                grid columnconfigure $dlg 0 -weight 1

                bind $dlg <Control-q> [list $w.bd invoke]
                bind $dlg <Control-Q> [list $w.bd invoke]

                catch {::tk::PlaceWindow $dlg widget .}
        }
        wm title $dlg $title
        $w.text delete 1.0 end
        $w.text insert end $what
        focus $dlg
        wm deiconify $dlg
        wm attributes $dlg -topmost 1
        wm attributes $dlg -topmost 0
        # This was originally TkChat's [About]
}


# Here starts the evil section

proc herring::incomingUserInfo {jid desc} {
        variable TwigInfoRaw
        variable TwigAction

        set delim {-*- TWiGs -*-}
        set delimmatch {-\*-*TWiGs*-\*-}
        set twigs {}
        set inTwigs 0

        foreach l [split $desc \n] {
                set l [string trim $l]
                if {$inTwigs} {
                        if {[string match -nocase $delimmatch $l]} {
                                set inTwigs 0
                        } else {
                                if {![catch {llength $l} len] && $len == 5} {
                                        lappend twigs $l
                                }
                        }
                } elseif {[string match -nocase $delimmatch $l]} {
                        set inTwigs 1
                }
        }

        if {[set action [lindex $TwigAction 0]] ne {} && [set i [lindex $TwigAction 1]] > 0} {
                set TwigAction [list {} 0]
                if {$i < 1 || $i > [llength $twigs]} {
                        print {TWiG not found}
                        return
                }
                incr i -1
                lassign [lindex $twigs $i] page blocks sum url name
                if {[catch {${action}Twig $page $blocks $sum $name} e]} {
                        print $e ERROR
                }
        } else {
                print TWiGs\ for\ $jid[expr {$TwigInfoRaw?" (raw)":""}]\n[prettyTwigs $twigs $TwigInfoRaw]
        }
}

proc herring::pimple {n1 n2 op} {
        uplevel 1 {trace remove variable UI(id) write ::herring::pimple}
        variable TwigInfo [uplevel 1 { set UI(DESC) }]
        rename ::tkchat::Dialog ::herring::_Dialog
        proc ::tkchat::Dialog {id} {
                rename ::tkchat::Dialog {}
                rename ::herring::_Dialog ::tkchat::Dialog
                ::tkchat::addStatus 0 "Getting [uplevel 1 { set jid }]'s TWiGs ..."
                after idle [list ::herring::incomingUserInfo [uplevel 1 { set jid }] [uplevel 1 { set UI(DESC) }]]
                uplevel 1 { unset -nocomplain [namespace current]::$id UI }
                uplevel 1 { return -level 2 }
        }
}

proc ::herring::cow {n1 n2 op} {
        trace remove variable ::tkchat::UserInfoWin write ::herring::cow
        uplevel 1 {trace add variable UI(id) write ::herring::pimple}
}


if {[info command ::tkchat::_UserInfoDialog] eq {}} {
        rename ::tkchat::UserInfoDialog ::tkchat::_UserInfoDialog
}
proc ::tkchat::UserInfoDialog {{jid {}}} {
#        upvar #0 ::herring::HookUserInfoDialog HookUserInfoDialog
        variable ::herring::HookUserInfoDialog

        if {!$HookUserInfoDialog} {
                ::tkchat::_UserInfoDialog $jid
                return
        }

        set HookUserInfoDialog 0

        trace remove variable ::tkchat::UserInfoWin write ::herring::cow
        variable UserInfoWin
        unset -nocomplain UserInfoWin
        trace add variable ::tkchat::UserInfoWin write ::herring::cow

        ::tkchat::_UserInfoDialog $jid

        trace remove variable ::tkchat::UserInfoWin write ::herring::cow
}

# End of evil section


proc ::herring::init {} {
        variable cfg


        foreach {alias proc} $cfg(aliasMap) {
                ::tkchat::processAliasCommand "/alias $alias proc $proc"
        }
}

namespace eval herring {
        init
}


# EOF