Index: init.tcl
===================================================================
RCS file: /cvsroot/tcl/library/init.tcl,v
retrieving revision 1.29
diff -c -r1.29 init.tcl
*** init.tcl    1999/04/16 00:46:56     1.29
--- init.tcl    1999/04/19 23:19:17
***************
*** 195,208 ****
            set code [catch {uplevel 1 $args} msg]
            if {$code ==  1} {
                #
!               # Strip the last five lines off the error stack (they're
!               # from the "uplevel" command).
                #
! 
                set new [split $errorInfo \n]
!               set new [join [lrange $new 0 [expr {[llength $new] - 6}]] \n]
!               return -code error -errorcode $errorCode \
!                       -errorinfo $new $msg
            } else {
                return -code $code $msg
            }
--- 195,302 ----
            set code [catch {uplevel 1 $args} msg]
            if {$code ==  1} {
                #
!               # Strip off the error stack those lines generated by
!               # the "uplevel" command.
                #
!               # 1. Remove the last 3 lines, which are:
!               #           ("uplevel" body line 1)
!               #           invoked from within
!               #       "uplevel 1 $args"
!               #
                set new [split $errorInfo \n]
!               set new [join [lrange $new 0 [expr {[llength $new] - 4}]] \n]
!               #
!               # 2. Remove the quoted (and possibly truncated) $args
!               #    which was passed to [uplevel] from the error stack.
!               #
!               # First strip off trailing "
!               regsub {"$} $new {} new
!               # Trailing "..." indicates truncation
!               if {![regsub {\.\.\.$} $new {} new]} {
!                   #
!                   # No truncation -> this is the easy case.
!                   # $new ends with "\n\"$args", strip that away
!                   #
!                   set index [string last "\n\"$args" $new]
!                   set new [string trimright [string range $new 0 $index]]
!               } elseif {[string first \n $args] == -1} {
!                   #
!                   # $args contains no "\n" -> also easy.
!                   # The quoted and truncated $args occupies the
!                   # last line of $new.  Strip it off.
!                   set index [string last "\n\"" $new]
!                   set new [string trimright [string range $new 0 $index]]
!               } else {
!                   #
!                   # The tricky case
!                   # $new ends with truncation of "\n\"$args", like so:
!                   #
!                   # $new: ________\n"|_______|
!                   #                  | ^^^^^ |
!                   #                  | match |
!                   #                  | vvvvv |
!                   #           $args: |_______|____________
!                   #                  ^
!                   #                  |
!                   # Need to find this/
!                   # point in $new and delete from there to the end.
!                   # Find all the candidates...
!                   set lines [split $new \n]
!                   set tailStart [expr {[llength $lines] - 1}]
!                   set candidates {}
!                   while {$tailStart >= 0} {
!                       if {[string match {"*} [lindex $lines $tailStart]]} {
!                           set tail [join [lrange $lines $tailStart end] \n]
!                           if {[string first $tail \"$args] == 0} {
!                               lappend candidates $tailStart
!                           }
!                       }
!                       incr tailStart -1
!                   }
!                   if {[llength $candidates] == 1} {
!                       #
!                       # There was exactly one candidate, so that's the
!                       # prune point.
!                       #
!                       set lastKeepLine [expr {[lindex $candidates 0] - 1}]
!                       set new [join [lrange $lines 0 $lastKeepLine] \n]
!                   } else {
!                       #
!                       # In rare circumstances, there can be multiple
!                       # candidates, or if something changes in the way
!                       # future releases of the Tcl C library build 
!                       # $errorInfo, this code may fail to find any candidate.
!                       # The safest thing to do in that circumstance is
!                       # just give up trying to remove the evidence of the
!                       # [uplevel] from the error stack and just pass the
!                       # error stack on to the caller as it was passed to us.
!                       #
!                       # Anybody have a better idea?
!                       #
!                       append errorInfo \
!                               "\n    (evaluating \"unknown $name ...\")"
!                       return -code error -errorcode $errorCode \
!                               -errorinfo $errorInfo $msg
!                   }
!               }
!               #
!               # 3. Remove the last remaining line, which is:
!               #           while executing
!               #    or some similar introductory phrase.
!               #
!               set index [string last \n $new]
!               set new [string trimright [string range $new 0 $index]]
!               #
!               # 4. Guarantee that proper introductory phrase is appended.
!               #       When ($new == $msg)     ==> "    while executing"
!               #       Otherwise               ==> "    invoked from within"
!               #
!               if {[string compare $new $msg] == 0} {
!                   return -code error -errorcode $errorCode $msg
!               } else {
!                   return -code error -errorcode $errorCode \
!                           -errorinfo $new $msg
!               }
            } else {
                return -code $code $msg
            }