~aleteoryx/ntalk

b7dd0c2f400b9b738c8218b15c6980bfc659c957 — Aleteoryx 2 months ago 05d277d
add servlist
1 files changed, 218 insertions(+), 26 deletions(-)

M ntalk.tcl
M ntalk.tcl => ntalk.tcl +218 -26
@@ 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 ###