From b7dd0c2f400b9b738c8218b15c6980bfc659c957 Mon Sep 17 00:00:00 2001
From: Aleteoryx <alyx@aleteoryx.me>
Date: Mon, 22 Sep 2025 21:12:32 -0400
Subject: [PATCH] add servlist

---
 ntalk.tcl | 244 ++++++++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 218 insertions(+), 26 deletions(-)

diff --git a/ntalk.tcl b/ntalk.tcl
index 3407114af617e1f4d848f9118ac7bf9483e0f87b..266e368dbbc94113e5a866e1c65a159492eddc98 100755
--- a/ntalk.tcl
+++ b/ntalk.tcl
@@ -1,16 +1,20 @@
 #!/bin/env wish
 
 
-set confdir ~/.config/ntalk
-set scriptpath "${confdir}/cscript.tcl"
+set confdir [file normalize ~/.config/ntalk]
+set config "${confdir}/config.tcl"
+set scriptdir "${confdir}/cscript"
 set sixelpath "${confdir}/sixels.txt"
 file mkdir $confdir
 
 
 proc quit {} {exit 0}
-proc restart {} {
+proc runself args {
 	global argv0
-	exec [info nameofexecutable] $argv0 &
+	exec [info nameofexecutable] $argv0 {*}$args &
+}
+proc restart args {
+	runself {*}$args
 	exit 0
 }
 
@@ -202,7 +206,6 @@ proc make16 {} {
 		font configure $font -size $fontsize
 	}
 }
-make16
 
 
 ### UI SETUP ###
@@ -237,8 +240,10 @@ if {[catch {package require history}] == 0} {
 	}
 }
 
+bind . <Destroy> {if {[list %W] == "."} quit}
 bind . <Control-q> quit
 bind . <Control-R> restart
+bind . <Control-N> runself
 bind . <Control-s> {.menu.opt invoke "show raw sixel codes"}
 
 .buffer tag configure rawsixel -elide true -foreground DarkSlateGrey
@@ -253,15 +258,18 @@ menu .menu.nt -tearoff 0
 menu .menu.opt -tearoff 1
 menu .menu.sixels -tearoff 1 -title "sixel picker"
 menu .menu.sixels.rm -tearoff 0
+menu .menu.server -tearoff 0
+menu .menu.server.rm -tearoff 0
 
 .menu add cascade -label "ntalk" -menu .menu.nt
 .menu.nt add command -label "about ntalk" -command {
 	tk_messageBox -title "about ntalk" \
 		-message "ntalk\nby aleteoryx" \
-		-detail "last updated 2025-09-21" \
+		-detail "last updated 2025-09-22" \
 		-icon "info"
 }
 .menu.nt add separator
+.menu.nt add command -label "new window" -command runself -accelerator "Ctrl-Shift-N"
 .menu.nt add command -label "restart" -command restart -accelerator "Ctrl-Shift-R"
 .menu.nt add command -label "quit" -command quit -accelerator "Ctrl-Q"
 
@@ -269,6 +277,11 @@ menu .menu.sixels.rm -tearoff 0
 .menu.sixels add separator
 .menu.sixels add cascade -label "delete a sixel..." -menu .menu.sixels.rm
 
+.menu add cascade -label "servers" -menu .menu.server
+.menu.server add separator
+.menu.server add command -label "add a server" -command addserver_open
+.menu.server add cascade -label "delete a server..." -menu .menu.server.rm
+
 .menu add cascade -label "options" -menu .menu.opt
 .menu.opt add checkbutton -label "show raw sixel codes" \
 	-accelerator "Ctrl-s" -variable showsixel -command {
@@ -337,13 +350,15 @@ proc getsubmenu {menu name} {
 proc regensixelmenu {} {
 	global sixellib
 	
-	.menu.sixels delete 0 [expr {[.menu.sixels index end]-2}]
-	.menu.sixels.rm delete 0 end
-	foreach menu [winfo children .menu.sixels] {
-		if {$menu == ".menu.sixels.rm"} continue
-		destroy $menu
+	if {[.menu.sixels index end] > 2} {
+		.menu.sixels delete 0 [expr {[.menu.sixels index end]-2}]
+		.menu.sixels.rm delete 0 end
+		foreach menu [winfo children .menu.sixels] {
+			if {$menu == ".menu.sixels.rm"} continue
+			destroy $menu
+		}
+		destroy {*}[winfo children .menu.sixels.rm]
 	}
-	destroy {*}[winfo children .menu.sixels.rm]
 	
 	for {set i 0} {$i < [llength $sixellib]} {incr i} {
 		if {[lindex $sixellib $i] == {}} continue
@@ -405,8 +420,9 @@ menu .savesixel -tearoff 0
 .savesixel add command -label "save sixel..." -command {
 	bind . <Button> {}
 
-	toplevel .namesixel
+	toplevel .namesixel -pady 5 -padx 5
 	wm title .namesixel "<  |  name sixel  |  >"
+	wm attributes .namesixel -type dialog
 	
 	entry .namesixel.entry
 	button .namesixel.ok -text ok -command finishsixel
@@ -437,23 +453,199 @@ bind .buffer <Button-3> {
 }
 
 
-### CONNECTING ###
+### SERVER MANAGEMENT ###
 
-set user marmalade
-set cmds {}
-set sok {}
-set server "the series of tubes"
-if [file readable $scriptpath] {
-	set fp [open $scriptpath]
-	.buffer insert 1.0 [read $fp]
+proc gencscript {{server localhost} {port 44322}} {
+	set server [list $server]
+	set port [list $port]
+	
+	set ret [subst \
+{# the entire connection is run through sok, make sure to set it up right.
+# press C-RET to connect
+# your changes will be saved
+
+# set servername "johann smith's server"
+
+set server $server
+set port $port
+}]
+	append ret {set sok [socket $server $port]}
+	return [string trim $ret]
+}
+
+# figure out what server to connect to
+proc locatecscript {} {
+	global scriptpath
+	set scriptpath [_locatecscript]
+	# we might have created or moved files
+	regenservlist
+	return $scriptpath
+}
+proc _locatecscript {} {
+	global confdir scriptdir defaultserver argv
+
+	# migrate old config
+	set scriptpath "${confdir}/cscript.tcl"
+	if {[file readable $scriptpath] && ![file exists $scriptdir]} {
+		file mkdir $scriptdir
+		file rename $scriptpath "$scriptdir/default.tcl"
+		return "$scriptdir/default.tcl"
+	}
+
+	file mkdir $scriptdir
+
+	# handle argument
+	if {[llength $argv] > 0 && [file readable "${scriptdir}/[lindex $argv 0].tcl"]} {
+		return "${scriptdir}/[lindex $argv 0].tcl";
+	}
+
+	# try using the default
+	set scriptpath [file join $scriptdir "${defaultserver}.tcl"]
+	if {[file readable $scriptpath]} {
+		return $scriptpath
+	}
+
+	# try picking a default
+	set servlist [lsort [glob -directory $scriptdir "*.tcl"]]
+	if {[llength $servlist] > 0} {
+		return [lindex $servlist 0]
+	}
+	
+	# fine, create a new one
+	set fp [open "${scriptdir}/default.tcl" w]
+	puts $fp [gencscript]
 	close $fp
-} else {
-	.buffer insert 1.0 {# input connection script, then hit C-RET. your changes will be saved.
-set server localhost
-set sok [socket $server 44322]
+	return "${scriptdir}/default.tcl"
+}
+
+proc regenservlist {} {
+	global scriptdir scriptpath
+
+	if {[.menu.server index end] > 2} {
+		.menu.server delete 0 [expr {[.menu.server index end]-3}]
+		.menu.server.rm delete 0 end
+	}
+	
+	foreach filename [lsort -decreasing [glob -directory $scriptdir *.tcl]] {
+		set slug [file tail [file rootname $filename]]
+
+		if {$filename == $scriptpath} {
+			set slug "$slug (current)"
+			set en disabled
+		} else {
+			set en normal
+		}
+
+		.menu.server insert 0 command -label $slug -state $en \
+			-command [list restart $slug]
+		.menu.server.rm insert 0 command -label $slug -state $en \
+			-command [concat [list file delete $filename] ";" regenservlist]
+	}
+}
+
+proc addserver_open {} {
+	destroy .addserver
+	toplevel .addserver -pady 5 -padx 5
+	wm title .addserver "<  |  add server  |  >"
+	wm attributes .addserver -type dialog
+
+	frame .addserver.i
+
+	frame .addserver.i.name
+	label .addserver.i.name.label -text "short name: "
+	entry .addserver.i.name.entry
+	pack .addserver.i.name.entry .addserver.i.name.label -side right
+
+	frame .addserver.i.host
+	label .addserver.i.host.label -text "hostname: "
+	entry .addserver.i.host.entry
+	.addserver.i.host.entry insert 0 localhost
+	pack .addserver.i.host.entry .addserver.i.host.label -side right
+
+	frame .addserver.i.port
+	label .addserver.i.port.label -text "port: "
+	entry .addserver.i.port.entry
+	.addserver.i.port.entry insert 0 44322
+	pack .addserver.i.port.entry .addserver.i.port.label -side right
+	
+	pack .addserver.i.name .addserver.i.host .addserver.i.port -side top -fill x
+
+	label .addserver.err -foreground red
+
+	frame .addserver.btn
+	button .addserver.btn.cancel -text "cancel" -command {destroy .addserver}
+	button .addserver.btn.ok -text "add" -command addserver_finish
+	pack .addserver.btn.cancel .addserver.btn.ok -side left
+	
+	pack .addserver.i .addserver.btn -side top -pady 5 -padx 5
+	
+	focus .addserver.i.name.entry
+}
+
+proc addserver_finish {} {
+	global scriptdir
+
+	set name [.addserver.i.name.entry get]
+	set host [.addserver.i.host.entry get]
+	set port [.addserver.i.port.entry get]
+
+	if {$name == {}} {
+		.addserver.err configure -text "short name cannot be empty!"
+		return
+	} elseif {[string first / $name] != -1} {
+		.addserver.err configure -text "short name cannot include slashes!"
+		return
+	}
+
+	set path [file join $scriptdir "${name}.tcl"]
+	if [file readable $path] {
+		.addserver.err configure -text "there's already a server called ${name}!"
+		return
+	}
+
+	set fp [open $path w]
+	puts $fp [gencscript $host $port]
+	close $fp
+	runself $name
+	
+	destroy .addserver
+	regenservlist
+}
+
+
+### LOAD BASE CONFIG ###
+
+set servername "the series of tubes"
+set sok {}
+
+set baseconfig \
+{# these settings are applied to all connections
+# hit C-RET to apply and restart
 set user marmalade
+set cmds {}
+set defaultserver default
+
+font configure TkDefaultFont -family monospace
+font configure TkTextFont -family monospace
+font configure TkFixedFont -family monospace
 }
+
+eval $baseconfig
+if [file readable $config] {
+	set fp [open $config]
+	set $configtext [read $fp]
+	close $fp
+	eval $configtext; # TODO: wrap in catch or something
 }
+make16
+
+
+### CONNECTING ###
+
+locatecscript
+set fp [open $scriptpath]
+.buffer insert 1.0 [read $fp]
+close $fp
 
 bind . <Control-Return> {
 	eval [.buffer get 1.0 end]
@@ -481,7 +673,7 @@ fconfigure $sok -translation lf; # dammit
 set user [string trim $user]
 .foot.name configure -text "${user}:"
 
-settitle "nanochatting on $server"
+settitle "nanochatting on $servername"
 
 
 ### NETCODE ###