[George Peter Staplin] - Have you ever wanted to treat strings as objects?  Well, now you can.  

I'm also working on a class system like [Smalltalk]'s, which will probably appear here in a little while.

----
======
  #! /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)]
======


<<categories>> Arts and crafts of Tcl-Tk programming | Language