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.
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# 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 https://wiki.tcl-lang.org/_search?S=$what]
if {[http::status $h] eq {ok}} {
foreach {. p n} [regexp -inline -all {<li>.*?\. \. \. <a href="/(.*?)">(.*?)</a>} [http::data $h]] {
lappend z https://wiki.tcl-lang.org/$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