~aleteoryx/ntalk

748e48f0b7409ba3c6f32cc18a758111c9affdff — Aleteoryx a month ago e9b9fea 
netcode rewrite

command parsing rewrite

moo-style dialogue

URL parsing
patch browse .tar.gz 
2 files changed, 218 insertions(+), 184 deletions(-)

M README.md
M ntalk.tcl

M README.md => README.md +4 -5
@@ 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.


M ntalk.tcl => ntalk.tcl +214 -179
@@ 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