From 748e48f0b7409ba3c6f32cc18a758111c9affdff Mon Sep 17 00:00:00 2001
From: Aleteoryx <alyx@aleteoryx.me>
Date: Fri, 17 Oct 2025 19:23:01 -0400
Subject: [PATCH] netcode rewrite

command parsing rewrite

moo-style dialogue

URL parsing
---
 README.md |   9 +-
 ntalk.tcl | 393 +++++++++++++++++++++++++++++-------------------------
 2 files changed, 218 insertions(+), 184 deletions(-)

diff --git a/README.md b/README.md
index 0a1e357ba3ca963792ccf283250198a893c68050..2e78e5efe3b879343ebc3ec9ecc69976677f3b70 100644
--- a/README.md
+++ b/README.md
@@ -32,16 +32,15 @@ slashes are interpreted, so naming one e.g. "faces / :D" will create a submenu c
 sixels are saved to/read from ~/.config/ntalk/cscript.tcl.
 each non-empty line stores one sixel, with the first '=' separating the name and the data.
 
-if $cmds is set, it will be used for command parsing. it is inserted
-into the body of a switch statement, with globbing enabled. you do
-not need to start your commands with /. if $server is set, it'll be
-shown in the top bar. if $user is set, it'll be used for the username.
+if $cmds is set, it will be used for command parsing, as part of a switch statement.
+the rhs is the command name, the lhs is the script. the contents of the line are in $line
+if $server is set, it'll be shown in the top bar. if $user is set, it'll
+be used for the username.
 
 to see the builtin commands, read the source code. they're torwards
 the bottom.
 
 if tklib is installed, history will be setup on the main input box.
-if Thread is installed, netcode will run on a second thread (recommended!!!).
 
 Ctrl-Shift-R will restart the client, allowing you to test config
 changes rapidly. Ctrl-Q exits.
diff --git a/ntalk.tcl b/ntalk.tcl
index 0a55b28ea03e96b1f42c063b1a2f8387165ccaba..270a05ed9a28f30b5fe47cd0d566576e1a4adf82 100755
--- a/ntalk.tcl
+++ b/ntalk.tcl
@@ -2,6 +2,7 @@
 
 
 set confdir [file normalize ~/.config/ntalk]
+set persisted "${confdir}/persist.tcldict"
 set config "${confdir}/config.tcl"
 set scriptdir "${confdir}/cscript"
 set sixelpath "${confdir}/sixels.txt"
@@ -28,9 +29,40 @@ settitle ntalk
 tk appname ntalk
 
 
+### PERSISTED DATA ###
+
+set persistwhat {
+	talktype irc
+}
+foreach {var val} $persistwhat {
+	set $var $val
+}
+if {[file readable $persisted]} {
+	set fp [open $persisted r]
+	set pdata [read $fp]
+	close $fp
+	foreach {var _} $persistwhat {
+		if {[dict exists $pdata $var]} {
+			set $var [dict get $pdata $var]
+		}
+	}
+}
+
+proc savepersist {} {
+	global persistwhat persisted
+	foreach {var _} $persistwhat {
+		global $var
+		dict set pdata $var [set $var]
+	}
+	set fp [open $persisted w]
+	puts $fp $pdata
+	close $fp
+}
+
+
 ### ICON ###
 
-# don't worry!! it is just an image!!!!
+# do not be alarmed!! it is just an image!!!!
 set nanooo {
 iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAAAAACPAi4CAAAABGdBTUEAALGPC/xhBQAAACBjSFJN
 AAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAAAmJLR0QA/4ePzL8AAAAHdElN
@@ -251,6 +283,25 @@ bind . <Control-s> {.menu.opt invoke "show raw sixel codes"}
 .buffer tag configure rawsixel -elide true -foreground DarkSlateGrey
 .buffer tag configure motd -foreground DarkOliveGreen -justify center -spacing1 5 -spacing3 5 -underline 1
 .buffer tag configure mention -foreground DarkOrchid4
+.buffer tag configure url -underline 1 -foreground "dark cyan"
+.buffer tag configure url2 -underline 1 -foreground "dark blue"
+
+.buffer tag bind url <Enter> {
+	set range [.buffer tag prevrange url current]
+	.buffer tag add url2 {*}$range
+	.buffer tag remove url {*}$range
+	.buffer configure -cursor hand2
+}
+.buffer tag bind url2 <Leave> {
+	set range [.buffer tag prevrange url2 current]
+	.buffer tag add url {*}$range
+	.buffer tag remove url2 {*}$range
+	.buffer configure -cursor xterm
+}
+.buffer tag bind url2 <Button-1> {
+	set range [.buffer tag prevrange url2 current]
+	exec xdg-open [.buffer get {*}$range] &
+}
 
 
 ### MENU ###
@@ -258,6 +309,7 @@ bind . <Control-s> {.menu.opt invoke "show raw sixel codes"}
 menu .menu
 menu .menu.nt -tearoff 0
 menu .menu.opt -tearoff 1
+menu .menu.opt.style -tearoff 0
 menu .menu.sixels -tearoff 1 -title "sixel picker"
 menu .menu.sixels.rm -tearoff 0
 menu .menu.server -tearoff 0
@@ -267,7 +319,7 @@ menu .menu.server.rm -tearoff 0
 .menu.nt add command -label "about ntalk" -command {
 	tk_messageBox -title "about ntalk" \
 		-message "ntalk\nby aleteoryx" \
-		-detail "last updated 2025-09-23" \
+		-detail "last updated 2025-10-17" \
 		-icon "info"
 }
 .menu.nt add separator
@@ -287,8 +339,14 @@ menu .menu.server.rm -tearoff 0
 .menu add cascade -label "options" -menu .menu.opt
 .menu.opt add checkbutton -label "show raw sixel codes" \
 	-accelerator "Ctrl-s" -variable showsixel -command {
-	.buffer tag configure rawsixel -elide [expr {!$showsixel}]
-}
+		.buffer tag configure rawsixel -elide [expr {!$showsixel}]
+	}
+.menu.opt add separator
+.menu.opt add cascade -label "message style..." -menu .menu.opt.style
+.menu.opt.style add radiobutton -label "IRC" -value irc \
+	-variable talktype -command savepersist
+.menu.opt.style add radiobutton -label "MOO" -value moo \
+	-variable talktype -command savepersist
 
 . configure -menu .menu
 
@@ -663,7 +721,8 @@ set fp [open $scriptpath w]
 puts $fp [string trim $cscript]
 close $fp
 
-fconfigure $sok -translation lf; # dammit
+fconfigure $sok -translation lf -blocking false
+fileevent $sok readable [list incoming $sok]
 set user [string trim $user]
 .foot.name configure -text "${user}:"
 
@@ -672,89 +731,98 @@ settitle "nanochatting on $servername"
 
 ### NETCODE ###
 
-proc setclients {newc} {
-	global clients
-	set clients $newc
-}
-proc setlastmsg {new} {
-	global lastmsg
-	set lastmsg $new
+proc neterr {} {
+	restart
 }
 
-set lastmsg 0
-set netcode { ### ENTER SECTION THAT MAY BE THREADED ###
-set lastmsg 0
+set next {}
+set sendqueue {}
+
+proc incoming {sok} {
+	global next
+	while {[gets $sok line] != -1} {
+		eval $next [list $line]
+	}
+	if {[eof $sok]} { neterr }
+}
 
 proc sendl {line} {
-	global sok inrecv
-	if {$inrecv} return
+	global sok
 	regsub "\n" $line " " line
 	if [catch {
 		puts $sok $line
 		flush $sok
-	}] { restart }
-}
-proc recvl {} {
-	global sok
-	gets $sok ret
-#	if [catch { gets $sok ret }] { restart }
-	return $ret
-}
-set inrecv 0
-proc recvlines {{bd 0}} {
-	global lastmsg inrecv
-	if {$inrecv} return
-	set inrecv 1
-	set n [recvl]
-	for {set i 0} {$i < $n} {incr i} {
-		bufpush [recvl]
-		if $bd bufdown
+	}] { neterr }
+}
+proc pumpq {} {
+	global next sendqueue
+	set sendqueue [lassign $sendqueue send recv]
+	set next $recv
+	eval $send
+}
+proc sendq {send recv} {
+	global next sendqueue
+	if {$next == {}} {
+		set next $recv
+		eval $send
+	} else {
+		lappend sendqueue $send $recv
 	}
-	setlastmsg [recvl]
-	set inrecv 0
 }
 
-proc send {line} {
-	global lastmsg
-	sendl "SEND $line"
-	set msgid [recvl]
-	if {$msgid == $lastmsg+1} {
-		setlastmsg $msgid
-		return 1
+proc sendr {line id} {
+	global lastmsg 
+	if {$lastmsg+1 == $id} {
+		set lastmsg $id
+		bufpush $line
+		bufdown
 	}
-	after idle skip
-	return 0
+	pumpq
 }
-
-proc sendmsg {msg} {
-	if {[send $msg]} {
-		bufpush "$msg"
-		bufdown
+proc send {line} {
+	sendq [list sendl "SEND $line"] [list sendr $line]
+}
+
+proc lines {post n line} {
+	global lastmsg next
+	if {$n == 0} {
+		set lastmsg $line
+		eval $post
+		pumpq
+	} else {
+		set next [list lines $post [expr {$n - 1}]]
+		bufpush $line
 	}
 }
-
-proc poll {} {
-	global lastmsg
-	sendl "POLL $lastmsg"
-	recvl
+proc appended {post n} {
+	global next
+	set next [list lines $post $n]
 }
-
-proc hist {} {
+proc cleared {n} {
 	bufclear
-	sendl HIST
-	recvlines 1
+	appended bufdown $n
 }
 
+proc hist {} {
+	sendq {sendl HIST} cleared
+}
 proc last {n} {
-	bufclear
-	sendl "LAST $n"
-	recvlines 1
+	sendq [list sendl "LAST $n"] cleared
 }
 
-proc skip {} {
-	global lastmsg
-	sendl "SKIP $lastmsg"
-	recvlines
+set skipid {}
+proc skipr {delay} {
+	global skipid
+	set skipid [after $delay skip $delay]
+}
+proc skip {delay} {
+	global skipid
+	after cancel $skipid
+
+	sendq {
+		global lastmsg
+		sendl "SKIP $lastmsg"
+	} [list appended [list skipr $delay]]
 }
 
 proc quit {} {
@@ -762,72 +830,26 @@ proc quit {} {
 	exit 0
 }
 
-proc stat {} {
-	sendl STAT
-	lassign [recvl] msgs
-	lassign [recvl] bytes
-	lassign [recvl] clients
-	
-	setclients $clients
-}
-
-set pmid {}
-proc pollmsgs {delay} {
-	global inrecv pmid
-	after cancel $pmid
-	set pmid [after $delay doskip $delay]
-}
-proc doskip {delay} {
-	global inrecv
-	if !$inrecv {
-		stat
-		skip
+proc statr {line} {
+	global clients
+	lassign $line n type
+	switch -- $type {
+		clients {
+			set clients $n
+			after 10000 stat
+			pumpq
+		}
 	}
-	set pmid [after $delay doskip $delay]
 }
-}; ### END OF SECTION THAT MAY BE THREADED ###
-
-if {[catch {package require Thread}] == 0} { # threading supported!
-	set threads 1
-	set main [thread::id]
-
-	set nett [thread::create]
-	thread::transfer $nett $sok
-	
-	thread::send $nett [concat [subst -nocommands {	
-		proc restart {} {
-			global argv0
-			exec [info nameofexecutable] $argv0 &
-			exit 0
-		}
-		set sok $sok
-		interp alias {} bufdown {} thread::send -async $main bufdown
-		interp alias {} bufclear {} thread::send -async $main bufclear
-		proc bufpush {x} { thread::send -async $main [list bufpush [set x]] }
-		proc setclients {x} { thread::send -async $main [list setclients [set x]] }
-		proc setlastmsg {x} {
-			global lastmsg
-			set lastmsg [set x]
-			thread::send -async $main [list setlastmsg [set x]]
-		}
-	}] ";" $netcode]
-
-
-	interp alias {} hist {} thread::send -async $nett hist
-	proc send {line} [subst -nocommands { thread::send $nett [list send [set line]] }]
-	proc sendmsg {line} [subst -nocommands { thread::send -async $nett [list sendmsg [set line]] }]
-	proc pollmsgs {n} [subst -nocommands { thread::send -async $nett [list pollmsgs [set n]] }]
-	proc last {n} [subst -nocommands { thread::send -async $nett [list last [set n]] }]
-} else {
-	set threads 0
-	eval $netcode
+proc stat {} {
+	sendq {sendl STAT} {statr}
 }
 
 
 ### ACTUAL CLIENT CODE LMAO ###
 
 proc bufpush {line} {
-	global images motd user threads
+	global images motd user
 
 	set tag {}
 	if {[string first "MOTD:" $line] == 0} {
@@ -854,22 +876,26 @@ proc bufpush {line} {
 			.buffer tag add $tag {end -1 chars}
 		}
 	}
-	.buffer insert end "\n" $tag
+
+	set urlre {(https?:(//)?)?([^ ./?#]+\.)+[^ ./?#]{2,}([/?#][^\s]*)?}
+	set urls [.buffer search -all -strictlimits -regexp -- $urlre "end - 1 lines" end]
+	foreach idx $urls {
+		set idx2 [.buffer search -regexp -- {\s} "$idx + 1 chars"]
+		.buffer tag add url $idx $idx2
+	}
+	
+
+	.buffer insert end "\n"
 	.buffer configure -state disabled
-	if !$threads update
 }
 proc bufdown {} {
-	global threads
 	.buffer yview moveto 1
-	if !$threads update
 }
 proc bufclear {} {
-	global threads
 	.buffer configure -state normal
 	.buffer replace 1.0 end {}
 	.buffer configure -state disabled
 	setmotd "no MOTD yet! maybe you should send one..."
-	if !$threads update
 }
 
 proc n64k_secs {msgcount} {
@@ -877,12 +903,25 @@ proc n64k_secs {msgcount} {
 	set proto_epoch 1758247178
 	expr {$proto_epoch + (([clock seconds] - $proto_epoch) * 65535 / $msgcount)}
 }
-
 proc n64k_date {} {
 	global lastmsg
 	clock format [n64k_secs $lastmsg]
 }
 
+proc setuser {new} {
+	global user
+	set user [string trim $new]
+	.foot.name configure -text "${user}:"
+}
+proc say {msg} {
+	global talktype user
+	if {$talktype == "moo"} {
+		send "${user} says, \"$msg\""
+	} else {
+		send "${user}: $msg"
+	}
+}
+
 
 ### BOOT ###
 
@@ -903,64 +942,60 @@ bind .buffer <KeyPress> {
 
 set typingid {}
 bind .foot.input <KeyPress> {
+	if {$typingid == {}} {skip 3000}
+
 	after cancel $typingid
-	pollmsgs 3000
-	set typingid [after 15000 pollmsgs 15000]
+	set typingid [after 15000 {
+		set typingid {}
+		skip 15000
+	}]
 }
 
 
 bind .foot.input <Return> [concat [bind .foot.input <Return>] ";" {
 	set line [.foot.input get]
 	.foot.input delete 0 end
-	switch -glob -- $line [concat $cmds {
-		/hist {
-			hist
-		}
-		/quit {
-			quit
-		}
-		/restart {
-			restart
-		}
-		{/last *} {
-			last [string range $line 6 end]
-		}
-		{/send *} {
-			sendmsg [string range $line 6 end]
-		}
-		{/motd *} {
-			sendmsg "MOTD [string range $line 6 end]"
-		}
-		/me* {
-			sendmsg "${user}[string range $line 3 end]"
-		}
-		{/my *} {
-			sendmsg "${user}'s [string range $line 4 end]"
-		}
-		{/nick *} {
-			set user [string trim [string range $line 6 end]]
-			.foot.name configure -text "${user}:"
-		}
-		{/eval *} {
-			.foot.input insert 0 [eval [string range $line 6 end]]
-		}
-		{/exec *} {
-			.foot.input insert 0 [exec sh -c [string range $line 6 end]]
-		}
-		{/calc *} {
-			.foot.input insert 0 [expr [string range $line 6 end]]
-		}
-		{/n64k} {
-			.foot.input insert 0 [n64k_date]
-		}
-		{} {}
-		default {
-			sendmsg "$user: $line"
-		}
+
+	set line [string trim $line]
+	if {[string length $line] == 0} {
+		return
+	} elseif {[string first "//" $line] == 0} {
+		say [string range $line 1 end]
+		return
+	} elseif {[string first "/" $line] != 0} {
+		say $line
+		return
+	}
+
+	set line [lassign [string range $line 1 end] cmd]
+	switch -nocase -- $cmd [concat $cmds {
+		hist { hist }
+		quit { quit }
+		restart { restart }
+
+		nick { setuser $line }
+		name { setuser $line }
+		user { setuser $line }
+
+		last { last $line }
+		send { send $line}
+
+		motd  { send "MOTD $line" }
+		me    { send "${user} $line" }
+		my    { send "${user}'s $line" }
+		think { send "${user} . o ( $line )" }
+		<=    { send "${user} <= $line" }
+
+		eval { .foot.input insert 0 [eval $line] }
+		exec { .foot.input insert 0 [exec sh -c $line]}
+		calc { .foot.input insert 0 [expr $line] }
+		
+		n64k { .foot.input insert 0 [n64k_date] }
 	}]
 }]
 
 focus .foot.input
 
+stat
 last 64
-pollmsgs 15000
+skip 15000