Tcl Library Source Code

Artifact f1be9e6f25e2124ed3e9dae946c75b5f4205d16f:

#!/usr/bin/tclsh
# This is a Tcl Library for eggdrop or similar bots
# It creates a safe, empty Tcl interpreter to which commands can be added.
# The commands are parsed by Tcl's parser

namespace eval ::command {
variable ns [namespace current]
variable interpns ${ns}::interps
namespace eval ${interpns} {}

variable interps;
array set interps {}

# helper to check whether an interpreter exists
proc _check_interp {name} {
	variable interps

	if {![info exists interps($name)]} {
		error "Interpreter '$name' does not exist"
	}
	return $interps($name)
}

proc make_interp {{name ""}} {
	variable interps; variable interpns;

	if {![info exists interps($name)]} {
		set fullname [interp create -safe -- ${interpns}::${name}]
		interp hide $fullname namespace
		interp invokehidden $fullname -global namespace delete ::
		set interps($name) $fullname
		return $name
	}
	error "Interpreter '$name' already exists"
}

# Delete an interpreter. If it's the default inteprreter, create a replacement
proc delete_interp {{name ""}} {
	interp delete [_check_interp $name]
	if {$name == ""} make_interp ;# ensure the default interpreter always exists
}

# clear all commands and variables from the interpreter by deleteing the global
# namespace using the hidden namespace command
proc clear_interp {{name ""}} {
	interp invokehidden [_check_interp $name] -global namespace delete ::
}

# register a command in an interpreter
proc register {cmd {newcmd ""} {name ""}} {
	if {$newcmd == ""} { set newcmd $cmd }
	uplevel 1 interp alias [_check_interp $name] $newcmd {} $cmd
}

# drop command from interpreter
proc unregister {cmd {name ""}} {
	interp alias [_check_interp $name] $cmd {}
}

# add an alias $cmd2 for $cmd which is already in interp
# syntax is like cp <src> <dst>, interp alias does it the other way around
proc alias {cmd cmd2 {name ""}} {
	set name [_check_interp $name]
	interp alias $name $cmd2 $name $cmd
}

make_interp ;# create default interpreter, $interps("")
}