herring

# herring
#
# May 2008
# Stuart Cassoff
#
# Use at your own risk
# (many have died)
#

namespace eval herring {
	variable HookUserInfoDialog 0
	variable InfoRaw 0
	variable TwigRun 0

	variable cfg

	set cfg(version) 0.1
	
	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) ~/twiglist.twig

	set cfg(twigs) {}

	# Chat Text Window
	set cfg(ctw) .txt

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

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


}

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

	if {[llength $msg] == 2} {
		set user [lindex $msg 0]
		set msg [lindex $msg 1]
		if {$user eq {me}} {
			set user $Options(Nickname)
		}
	} else  {
		set user {}
	}
	set srchres [wikisearch $msg 10]
	if {[llength $srchres] > 0} {
		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}} {
	variable cfg
	return [exec $cfg(tclsh) $cfg(twig) $page $blocks]
}

proc herring::runTwig  {page {blocks 0} {name {}}} {
	variable cfg
#	exec $cfg(wish) <<[twiggit $page $blocks] &
	exec $cfg(tclsh) $cfg(twig) $page $blocks | $cfg(run) &
}

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

proc herring::twig {msg} {
	variable cfg

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

	switch -exact -- [lindex $msg 0] {
	load {
		set fn {}
		set tag {}
		if {[llength $msg] == 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 {
		if {[lindex $msg 0] eq {view}} {
			if {[llength $msg] == 1} {
				view
			} else {
				set tag {}
				if {[catch {viewFile [lindex $msg 1]} e]} { set tag ERROR }
				if {$e eq {}} { return }
				print $e $tag
			}
			return
		}
		if {[regexp {^(.+)\.$} [lindex $msg end] -> num]} {
			if {[llength $msg] > 2} {
				variable HookUserInfoDialog 1
				variable TwigRun $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} ERROR
				return
			}
			incr num -1
			set twig [lindex $cfg(twigs) $num]
			set page [lindex $twig 0]
			set blocks [lindex $twig 1]
			set name [lindex $twig 4]
		} elseif {[llength $msg] > 1} {
			set page [lindex $msg 1]
			set blocks [lindex $msg 2]
			set name {}
		} else {
			print "run|view usage:\nrun|view ?user? #.\nrun|view page ?blocks?\nview" SYSTEM
			return
		}
		if {[catch [list [lindex $msg 0]Twig $page $blocks $name] e]} {
			print $e ERROR
		}
	}
	? {
		set m {}
		lappend m "TWiG $cfg(version) 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?"
		print [join $m \n]
	}
	default {
		print "TWiG $cfg(version)\n/twig ? for help" SYSTEM
	}
	}
}

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

	incr floodcount

	if {$floodcount > $floodmax} {return}

	if {$floodcount == $floodmax} {
		::tkjabber::msgSend "/nolog stubot: outgoing msg count exceeded $floodmax msgs" -user $Options(Nickname) -attrs [list nolog 1]
		return
	}

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

	set max 300
	if {[string length $msg] <= $max} {
		::tkjabber::msgSend "/nolog$msg" -user $user -attrs [list nolog 1]
	} else {
		::tkjabber::msgSend "/nolog stubot: outgoing msg exceeded $max chars" -user $Options(Nickname) -attrs [list nolog 1]
	}
}

proc herring::print {msg {tag MSG}} {
	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 TWiG\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
    catch {destroy .view}
    set dlg [::tkchat::Dialog .view]
    set w [${NS}::frame $dlg.f]
    wm withdraw $dlg
    wm title $dlg $title
    if {[llength [info command ::tkchat::img::Tkchat]] != 0} {
	catch {wm iconphoto $dlg ::tkchat::img::Tkchat}
    }
    ${NS}::button $w.b -text Dismiss -width -12 -command [list wm withdraw $dlg] -default active
    ::tkchat::ScrolledWidget text $w.text 0 1 -height 23 -width 80 \
        -borderwidth 0 -padx 2 -pady 2 -font FNT
    grid $w.text -sticky news
	${NS}::button $w.bs -text Save -width -12 -command "::herring::save \[$w.text get 1.0 end\]" -default active
	${NS}::button $w.br -text Run -width -12 -command "::herring::run \[$w.text get 1.0 end\]" -default active
	grid $w.bs            -sticky se
	grid    ^  $w.br      -sticky se -padx 4
	grid    ^     ^  $w.b -sticky se
	grid configure $w.text -columnspan 3

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

    $w.text insert end $what

    grid $w -sticky news
    grid rowconfigure $dlg 0 -weight 1
    grid columnconfigure $dlg 0 -weight 1

#    $w.text configure -state disabled
#    bind $dlg <Return> [list $w.b invoke]
#    bind $dlg <Escape> [list $w.b invoke]
	bind $dlg <Control-q> [list $w.b invoke]
	bind $dlg <Control-Q> [list $w.b invoke]
    catch {::tk::PlaceWindow $dlg widget .}
    wm deiconify $dlg
# This was originally TkChat's [About]
}


# Here starts the evil section

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

	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 {$TwigRun > 0} {
		set i $TwigRun
		set TwigRun 0
		if {$i < 1 || $i >= [llength $twigs]} {
			print No\ TWiGs\ for\ $jid
			return
		}
		incr i -1
		set twig [lindex $twigs $i]
		set page [lindex $twig 0]
		set blocks [lindex $twig 1]
		if {[catch {runTwig $page $blocks} e]} {
			send $e
		}
	} else {
		print TWiGs\ for\ $jid:\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