@@ 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 ###