Tcl script using osascript to set and read Terminal.app colors

tcolor.tcl

#!/usr/bin/tclsh8.5
package require md5

set script {
tell application "Terminal" 
    tell %s
    set the background color to { %s } 
    end tell 
    %s
end tell
}

proc gen_rgba_script {args} {
    global winID
    if {[info exists winID] && [string length $winID] && $winID} {
	set win "window id $winID"
        set getid ""
    } else {
        set win "the front window"
        set getid "set windowID to id of the front window"
    }
    return [format $::script $win [join $args ", "] $getid]
}

proc defcolor {name args} {
    set ::colors($name) $args
}

proc defcolor8 {name args} {
    set list [list]
    foreach arg $args {
        lappend list [expr {$arg * 256}]
    }
    
    set ::colors($name) $list
}

proc random_pastel {name} {
    set name [lindex [split $name @] end]
    set name [lindex [split $name .] 0]
    if {[string length $name] == 0} {
	return ""
    }
    set n 0
    foreach ch [split [string tolower $name] ""] {
	set i [string first $ch "0123456789abcdefghijklmnopqrstuvwxyz"]
	if {$i >= 0} {
		set n [expr {$n * 36 + $i}]
	}
    }
    set r [expr {($n % 64 + 192) * 256}]
    set n [expr $n / 64]
    set g [expr {($n % 64 + 192) * 256}]
    set n [expr $n / 64]
    set b [expr {($n % 64 + 192) * 256}]


    return [list $r $g $b]
}

proc gen_color_script {name} {
    if {[string match {@*} $name]} {
	      set rgb [random_pastel $name]
    }
    if {[info exists ::colors($name)]} {
        set rgb $::colors($name)
    }
    if {![info exists rgb] || ![string length $rgb]} {
	      return ""
    }

    return [gen_rgba_script {*}$rgb]
}

proc def_colors {} {
    defcolor pink 65280 58368 62720
    defcolor white 65535 65535 65535
    defcolor black 0 0 0
    defcolor8 misty_rose 255 228 225
    defcolor8 seashell 255 245 238
    defcolor8 lavender_blush 255 240 245
    defcolor8 cornsilk 255 248 220
    defcolor8 bisque 255 228 196
    defcolor8 linen 240 240 230
    defcolor8 lavender 230 230 250
    defcolor8 azure 240 255 255
    defcolor8 honeydew 240 255 240
    defcolor8 indigo 0x4b 0 0x82
    defcolor8 darkred 0x50 0 0
    defcolor8 navy 0 0 128
    defcolor8 light_cyan 224 255 255
}

proc send_osascript {script} {
    set fp [open "|osascript" w]
    puts $fp $script
    if [catch {close $fp} err] {
      if {[string match "*ApplePersistence=*" $err]} {
	        return
      }
      puts stderr "    [join [split $script "\n"] "\n    "]"
      puts stderr "osascript error: $err"
    }
}

proc usage {} {
    puts stderr "usage: $::argv0 ?-id=windowid? colorName or $::argv0 ?-id=windowid? r g b ?a?"
    puts stderr "available colors: [lsort [array names ::colors]]"
    exit 1
}

proc main {{argv ""}} {
    global winID

    if {[regexp {^-id=([0-9]+)$} [lindex $argv 0] _ winID]} {
	      set argv [lrange $argv 1 end]
    }

    set n [llength $argv]

    def_colors

    if {$n == 1} {
        set script [gen_color_script $argv]
	if {$script == ""} {
	    puts stderr "unrecognized color name"
	    usage
	}
    } elseif {$n >= 3 && $n <= 4} {
        set script [gen_rgba_script {*}$argv]
    } else {
        usage
    }

    send_osascript $script
}

if !$tcl_interactive {
    main $argv
}

set comments {
Usage: tcolor.tcl [-id=window-id] [-dark] color-name-or-hostname

Returns window ID for use in recovering the default color.

Example "go hostname additional-ssh-options":

#!/bin/sh
winid=0
# light mode
defcolor=white
d=
# dark mode
#defcolor='#171717'
#d=-dark

trap 'tcolor -id=$winid "$defcolor"' 0
host=$1
color=@$host
shift

winid=`tcolor $d "$color"`
ssh "$@" "$host"
tcolor -id=$winid "$defcolor"
}