#! /usr/local/bin/tclsh8.3
proc unknown {args} {
if {[string is integer [lindex $args 0]]} {
return [expr $args]
}
if {[string index [lindex $args 0] 0] == "@"} {
set astring [string range [lindex $args 0] 1 end]
set numArgs [llength $args]
for {set i 1} {$i < $numArgs} {incr i} {
set arg$i [lindex $args $i]
}
switch -- $arg1 {
byteLength {
return [string bytelength $astring]
}
first {
if {$numArgs < 3} {
error "Please use \"@string1\" first \"string2\" ?startIndex?"
}
if {$numArgs == 3} {
return [string first $astring $arg2]
}
if {$numArgs == 4} {
return [string first $astring $arg2 $arg3]
}
}
index {
if {$numArgs < 3} {
error "Please use \"@string\" index num Where num is the index."
}
return [string index $astring $arg2]
}
is {
if {$numArgs < 3} {
error "Please use \"@string\" is class Where class is alpha, digit, etc."
}
return [string is $arg2 $astring]
}
toLower {
return [string tolower $astring]
}
toUpper {
return [string toupper $astring]
}
default {
}
}
}
}Test code:
puts [2 + 3 + 2]
puts ["@HELLO WORLD" toLower]
proc hello {args} {puts $args}
hello world
puts ["@hello world" toUpper]
puts ["@blahblah" byteLength]
puts ["@wonder" first "wonder"]
puts ["@wonder" first "wonder" 0]
set blah "long string"
puts ["@$blah" index 1]
puts ["@long string" index 5]
puts ["@fun" is ascii] To get a real @ at the beginning of a string double it (just like in Smalltalk). I suggest that you don't name a proc @something, because it will mess this up.RS: One note - @ isn't exactly beautiful as string marker. The Tcl parser consumes double quotes, so you don't see those in the unknown proc. But single quotes are available - only they don't group... You could modify the validity check so the examples could be
puts ["'hello world'" toUpper] puts ['blahblah' byteLength]
GPS - How about this:
#! /usr/local/bin/tclsh8.3
#Kevin Kenny wrote the original source and meth (formerly to) procs.
#I've made it so that having multiple files is not needed and
#a bunch of other stuff.
proc cfork {} {
global cstate
if {[info exists cstate] != 1} {
set cstate 1
rename source ::tcl::source
proc source {fileName} {
variable source_channel
set source_channel [open $fileName r]
set command {}
set sep {}
set escaped 0
while {[gets $source_channel line] >= 0} {
for {set i 0} {$i < [string length $line]} {incr i} {
set ch [string index $line $i]
if {$ch == "'" && $escaped == 0} {
#puts "WONDER $i"
#puts $line
set line [string replace $line $i $i "\""]
} elseif {$ch == "\\"} {
set escaped 1
} else {
set escaped 0
}
}
append command $sep $line
if {[info complete $command]} {
set result [uplevel 1 $command]
set command {}
set sep {}
} else {
set sep \n
}
}
return $result
}
proc meth {name args} {
variable source_channel
set body {}
set sep {}
while {[gets $source_channel line] >= 0} {
if {[string equal [string trim $line] @]} {
return [proc $name $args $body]
} else {
append body $sep $line
set sep \n
}
}
return -code error {unterminated 'meth'}
}
proc unknown {args} {
#puts $args
set numArgs [llength $args]
set astring [lindex $args 0]
for {set i 1} {$i < $numArgs} {incr i} {
set arg$i [lindex $args $i]
}
if {[string is integer $astring] || [string index $astring 0] == "("} {
return [expr $args]
}
set sop [lindex $args 1]
#puts "sop $sop astring $astring"
switch -- $sop {
byteLength {
return [string bytelength $astring]
}
first: {
if {$numArgs < 3} {
error "Please use \"string1\" first \"string2\" ?startIndex?"
}
if {$numArgs == 3} {
return [string first $astring $arg2]
}
if {$numArgs == 4} {
return [string first $astring $arg2 $arg3]
}
}
index: {
if {$numArgs < 3} {
error "Please use \"string\" index num Where num is the index."
}
return [string index $astring $arg2]
}
is: {
if {$numArgs < 3} {
error "Please use \"string\" is class Where class is alpha, digit, etc."
}
return [string is $arg2 $astring]
}
toLower {
return [string tolower $astring]
}
toUpper {
return [string toupper $astring]
}
default {
}
}
}
source [info script]
return 1
}
return 0
}
if {[cfork] == 1} {
return
}
meth add x y
return [expr {$x + $y}]
@
puts [add 6 27]
puts ['This is Rebecca\'s flower not George\'s' toLower]
puts ['Hello Bob!' toUpper]
puts ['Blah Blah!' index: 0]
puts ['hmm' is: ascii]
puts [200 + 23]
puts [(200 + 33000)]