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
	3. An analog clock in Tk
	4. 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 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