Return to tcl.tlb CVS log

Up to [Micropolis - Activity] / micropolis / res

Annotation of micropolis/res/tcl.tlb, revision 1.1

1.1     ! root        1: 
        !             2: #@package: TclX-ArrayProcedures for_array_keys
        !             3: 
        !             4: proc for_array_keys {varName arrayName codeFragment} {
        !             5:     upvar $varName enumVar $arrayName enumArray
        !             6: 
        !             7:     if ![info exists enumArray] {
        !             8:        error "\"$arrayName\" isn't an array"
        !             9:     }
        !            10: 
        !            11:     set searchId [array startsearch enumArray]
        !            12:     while {[array anymore enumArray $searchId]} {
        !            13:        set enumVar [array nextelement enumArray $searchId]
        !            14:        uplevel $codeFragment
        !            15:     }
        !            16:     array donesearch enumArray $searchId
        !            17: }
        !            18: 
        !            19: #@package: TclX-assign_fields assign_fields
        !            20: 
        !            21: proc assign_fields {list args} {
        !            22:     foreach varName $args {
        !            23:         set value [lvarpop list]
        !            24:         uplevel "set $varName [list $value]"
        !            25:     }
        !            26: }
        !            27: 
        !            28: #@package: TclX-developer_utils saveprocs edprocs
        !            29: 
        !            30: proc saveprocs {fileName args} {
        !            31:     set fp [open $fileName w]
        !            32:     puts $fp "# tcl procs saved on [fmtclock [getclock]]\n"
        !            33:     puts $fp [eval "showprocs $args"]
        !            34:     close $fp
        !            35: }
        !            36: 
        !            37: proc edprocs {args} {
        !            38:     global env
        !            39: 
        !            40:     set tmpFilename /tmp/tcldev.[id process]
        !            41: 
        !            42:     set fp [open $tmpFilename w]
        !            43:     puts $fp "\n# TEMP EDIT BUFFER -- YOUR CHANGES ARE FOR THIS SESSION ONLY\n"
        !            44:     puts $fp [eval "showprocs $args"]
        !            45:     close $fp
        !            46: 
        !            47:     if [info exists env(EDITOR)] {
        !            48:         set editor $env(EDITOR)
        !            49:     } else {
        !            50:        set editor vi
        !            51:     }
        !            52: 
        !            53:     set startMtime [file mtime $tmpFilename]
        !            54:     system "$editor $tmpFilename"
        !            55: 
        !            56:     if {[file mtime $tmpFilename] != $startMtime} {
        !            57:        source $tmpFilename
        !            58:        echo "Procedures were reloaded."
        !            59:     } else {
        !            60:        echo "No changes were made."
        !            61:     }
        !            62:     unlink $tmpFilename
        !            63:     return
        !            64: }
        !            65: 
        !            66: #@package: TclX-forfile for_file
        !            67: 
        !            68: proc for_file {var filename code} {
        !            69:     upvar $var line
        !            70:     set fp [open $filename r]
        !            71:     while {[gets $fp line] >= 0} {
        !            72:         uplevel $code
        !            73:     }
        !            74:     close $fp
        !            75: }
        !            76: 
        !            77: 
        !            78: #@package: TclX-forrecur for_recursive_glob
        !            79: 
        !            80: proc for_recursive_glob {var globlist code {depth 1}} {
        !            81:     upvar $depth $var myVar
        !            82:     foreach globpat $globlist {
        !            83:         foreach file [glob -nocomplain $globpat] {
        !            84:             if [file isdirectory $file] {
        !            85:                 for_recursive_glob $var $file/* $code [expr {$depth + 1}]
        !            86:            }
        !            87:            set myVar $file
        !            88:            uplevel $depth $code
        !            89:         }
        !            90:     }
        !            91: }
        !            92: 
        !            93: #@package: TclX-globrecur recursive_glob
        !            94: 
        !            95: proc recursive_glob {globlist} {
        !            96:     set result ""
        !            97:     foreach pattern $globlist {
        !            98:         foreach file [glob -nocomplain $pattern] {
        !            99:             lappend result $file
        !           100:             if [file isdirectory $file] {
        !           101:                 set result [concat $result [recursive_glob $file/*]]
        !           102:             }
        !           103:         }
        !           104:     }
        !           105:     return $result
        !           106: }
        !           107: 
        !           108: #@package: TclX-help help helpcd helppwd apropos
        !           109: 
        !           110: 
        !           111: proc help:flattenPath {pathName} {
        !           112:     set newPath {}
        !           113:     foreach element [split $pathName /] {
        !           114:         if {"$element" == "."} {
        !           115:            continue
        !           116:         }
        !           117:         if {"$element" == ".."} {
        !           118:             if {[llength [join $newPath /]] == 0} {
        !           119:                 error "Help: name goes above subject directory root"}
        !           120:             lvarpop newPath [expr [llength $newPath]-1]
        !           121:             continue
        !           122:         }
        !           123:         lappend newPath $element
        !           124:     }
        !           125:     set newPath [join $newPath /]
        !           126:     
        !           127: 
        !           128:     if {("$newPath" == "") && [string match "/*" $pathName]} {
        !           129:         set newPath "/"}
        !           130:         
        !           131:     return $newPath
        !           132: }
        !           133: 
        !           134: 
        !           135: proc help:EvalPath {pathName} {
        !           136:     global TCLENV
        !           137: 
        !           138:     if {![string match "/*" $pathName]} {
        !           139:         if {"$pathName" == ""} {
        !           140:             return $TCLENV(help:curDir)}
        !           141:         if {"$TCLENV(help:curDir)" == "/"} {
        !           142:             set pathName "/$pathName"
        !           143:         } else {
        !           144:             set pathName "$TCLENV(help:curDir)/$pathName"
        !           145:         }
        !           146:     }
        !           147:     set pathName [help:flattenPath $pathName]
        !           148:     if {[string match "*/" $pathName] && ($pathName != "/")} {
        !           149:         set pathName [csubstr $pathName 0 [expr [length $pathName]-1]]}
        !           150: 
        !           151:     return $pathName    
        !           152: }
        !           153: 
        !           154: 
        !           155: proc help:Display {line} {
        !           156:     global TCLENV
        !           157:     if {$TCLENV(help:lineCnt) >= 23} {
        !           158:         set TCLENV(help:lineCnt) 0
        !           159:         puts stdout ":" nonewline
        !           160:         flush stdout
        !           161:         gets stdin response
        !           162:         if {![lempty $response]} {
        !           163:             return 0}
        !           164:     }
        !           165:     puts stdout $line
        !           166:     incr TCLENV(help:lineCnt)
        !           167: }
        !           168: 
        !           169: 
        !           170: proc help:DisplayFile {filepath} {
        !           171: 
        !           172:     set inFH [open $filepath r]
        !           173:     while {[gets $inFH fileBuf] >= 0} {
        !           174:         if {![help:Display $fileBuf]} {
        !           175:             break}
        !           176:     }
        !           177:     close $inFH
        !           178: 
        !           179: }    
        !           180: 
        !           181: 
        !           182: proc help:ListDir {dirPath} {
        !           183:     set dirList {}
        !           184:     set fileList {}
        !           185:     if {[catch {set dirFiles [glob $dirPath/*]}] != 0} {
        !           186:         error "No files in subject directory: $dirPath"}
        !           187:     foreach fileName $dirFiles {
        !           188:         if [file isdirectory $fileName] {
        !           189:             lappend dirList "[file tail $fileName]/"
        !           190:         } else {
        !           191:             lappend fileList [file tail $fileName]
        !           192:         }
        !           193:     }
        !           194:    return [list [lsort $dirList] [lsort $fileList]]
        !           195: }
        !           196: 
        !           197: 
        !           198: proc help:DisplayColumns {nameList} {
        !           199:     set count 0
        !           200:     set outLine ""
        !           201:     foreach name $nameList {
        !           202:         if {$count == 0} {
        !           203:             append outLine "   "}
        !           204:         append outLine $name
        !           205:         if {[incr count] < 4} {
        !           206:             set padLen [expr 17-[clength $name]]
        !           207:             if {$padLen < 3} {
        !           208:                set padLen 3}
        !           209:             append outLine [replicate " " $padLen]
        !           210:         } else {
        !           211:            if {![help:Display $outLine]} {
        !           212:                return}
        !           213:            set outLine ""
        !           214:            set count 0
        !           215:         }
        !           216:     }
        !           217:     if {$count != 0} {
        !           218:         help:Display $outLine}
        !           219:     return
        !           220: }
        !           221: 
        !           222: 
        !           223: 
        !           224: proc help {{subject {}}} {
        !           225:     global TCLENV
        !           226: 
        !           227:     set TCLENV(help:lineCnt) 0
        !           228: 
        !           229: 
        !           230:     if {($subject == "help") || ($subject == "?")} {
        !           231:         help:DisplayFile "$TCLENV(help:root)/help"
        !           232:         return
        !           233:     }
        !           234: 
        !           235:     set request [help:EvalPath $subject]
        !           236:     set requestPath "$TCLENV(help:root)$request"
        !           237: 
        !           238:     if {![file exists $requestPath]} {
        !           239:         error "Help:\"$request\" does not exist"}
        !           240:     
        !           241:     if [file isdirectory $requestPath] {
        !           242:         set dirList [help:ListDir $requestPath]
        !           243:         set subList  [lindex $dirList 0]
        !           244:         set fileList [lindex $dirList 1]
        !           245:         if {[llength $subList] != 0} {
        !           246:             help:Display "\nSubjects available in $request:"
        !           247:             help:DisplayColumns $subList
        !           248:         }
        !           249:         if {[llength $fileList] != 0} {
        !           250:             help:Display "\nHelp files available in $request:"
        !           251:             help:DisplayColumns $fileList
        !           252:         }
        !           253:     } else {
        !           254:         help:DisplayFile $requestPath
        !           255:     }
        !           256:     return
        !           257: }
        !           258: 
        !           259: 
        !           260: 
        !           261: proc helpcd {{dir /}} {
        !           262:     global TCLENV
        !           263: 
        !           264:     set request [help:EvalPath $dir]
        !           265:     set requestPath "$TCLENV(help:root)$request"
        !           266: 
        !           267:     if {![file exists $requestPath]} {
        !           268:         error "Helpcd: \"$request\" does not exist"}
        !           269:     
        !           270:     if {![file isdirectory $requestPath]} {
        !           271:         error "Helpcd: \"$request\" is not a directory"}
        !           272: 
        !           273:     set TCLENV(help:curDir) $request
        !           274:     return    
        !           275: }
        !           276: 
        !           277: 
        !           278: proc helppwd {} {
        !           279:         global TCLENV
        !           280:         echo "Current help subject directory: $TCLENV(help:curDir)"
        !           281: }
        !           282: 
        !           283: 
        !           284: proc apropos {name} {
        !           285:     global TCLENV
        !           286: 
        !           287:     set TCLENV(help:lineCnt) 0
        !           288: 
        !           289:     set aproposCT [scancontext create]
        !           290:     scanmatch -nocase $aproposCT $name {
        !           291:         set path [lindex $matchInfo(line) 0]
        !           292:         set desc [lrange $matchInfo(line) 1 end]
        !           293:         if {![help:Display [format "%s - %s" $path $desc]]} {
        !           294:             return}
        !           295:     }
        !           296:     foreach brief [glob -nocomplain $TCLENV(help:root)/*.brf] {
        !           297:         set briefFH [open $brief]
        !           298:         scanfile $aproposCT $briefFH
        !           299:         close $briefFH
        !           300:     }
        !           301:     scancontext delete $aproposCT
        !           302: }
        !           303: 
        !           304: global TCLENV TCLPATH
        !           305: 
        !           306: set TCLENV(help:root) [searchpath $TCLPATH help]
        !           307: set TCLENV(help:curDir) "/"
        !           308: set TCLENV(help:outBuf) {}
        !           309: 
        !           310: #@package: TclX-packages packages autoprocs
        !           311: 
        !           312: proc packages {{option {}}} {
        !           313:     global TCLENV
        !           314:     set packList {}
        !           315:     foreach key [array names TCLENV] {
        !           316:         if {[string match "PKG:*" $key]} {
        !           317:             lappend packList [string range $key 4 end]
        !           318:         }
        !           319:     }
        !           320:     if [lempty $option] {
        !           321:         return $packList
        !           322:     } else {
        !           323:         if {$option != "-location"} {
        !           324:             error "Unknow option \"$option\", expected \"-location\""
        !           325:         }
        !           326:         set locList {}
        !           327:         foreach pack $packList {
        !           328:             set fileId [lindex $TCLENV(PKG:$pack) 0]
        !           329:             
        !           330:             lappend locList [list $pack [concat $TCLENV($fileId) \
        !           331:                                              [lrange $TCLENV(PKG:$pack) 1 2]]]
        !           332:         }
        !           333:         return $locList
        !           334:     }
        !           335: }
        !           336: 
        !           337: proc autoprocs {} {
        !           338:     global TCLENV
        !           339:     set procList {}
        !           340:     foreach key [array names TCLENV] {
        !           341:         if {[string match "PROC:*" $key]} {
        !           342:             lappend procList [string range $key 5 end]
        !           343:         }
        !           344:     }
        !           345:     return $procList
        !           346: }
        !           347: 
        !           348: #@package: TclX-directory_stack pushd popd dirs
        !           349: 
        !           350: global TCLENV(dirPushList)
        !           351: 
        !           352: set TCLENV(dirPushList) ""
        !           353: 
        !           354: proc pushd {args} {
        !           355:     global TCLENV
        !           356: 
        !           357:     if {[llength $args] > 1} {
        !           358:         error "bad # args: pushd [dir_to_cd_to]"
        !           359:     }
        !           360:     set TCLENV(dirPushList) [linsert $TCLENV(dirPushList) 0 [pwd]]
        !           361: 
        !           362:     if {[llength $args] != 0} {
        !           363:         cd [glob $args]
        !           364:     }
        !           365: }
        !           366: 
        !           367: proc popd {} {
        !           368:     global TCLENV
        !           369: 
        !           370:     if [llength $TCLENV(dirPushList)] {
        !           371:         cd [lvarpop TCLENV(dirPushList)]
        !           372:         pwd
        !           373:     } else {
        !           374:         error "directory stack empty"
        !           375:     }
        !           376: }
        !           377: 
        !           378: proc dirs {} { 
        !           379:     global TCLENV
        !           380:     echo [pwd] $TCLENV(dirPushList)
        !           381: }
        !           382: 
        !           383: #@package: TclX-set_functions union intersect intersect3 lrmdups
        !           384: 
        !           385: proc union {lista listb} {
        !           386:     set full_list [lsort [concat $lista $listb]]
        !           387:     set check_element [lindex $full_list 0]
        !           388:     set outlist $check_element
        !           389:     foreach element [lrange $full_list 1 end] {
        !           390:        if {$check_element == $element} continue
        !           391:        lappend outlist $element
        !           392:        set check_element $element
        !           393:     }
        !           394:     return $outlist
        !           395: }
        !           396: 
        !           397: proc lrmdups {list} {
        !           398:     set list [lsort $list]
        !           399:     set result [lvarpop list]
        !           400:     lappend last $result
        !           401:     foreach element $list {
        !           402:        if {$last != $element} {
        !           403:            lappend result $element
        !           404:            set last $element
        !           405:        }
        !           406:     }
        !           407:     return $result
        !           408: }
        !           409: 
        !           410: 
        !           411: proc intersect3 {list1 list2} {
        !           412:     set list1Result ""
        !           413:     set list2Result ""
        !           414:     set intersectList ""
        !           415: 
        !           416:     set list1 [lrmdups $list1]
        !           417:     set list2 [lrmdups $list2]
        !           418: 
        !           419:     while {1} {
        !           420:         if [lempty $list1] {
        !           421:             if ![lempty $list2] {
        !           422:                 set list2Result [concat $list2Result $list2]
        !           423:             }
        !           424:             break
        !           425:         }
        !           426:         if [lempty $list2] {
        !           427:            set list1Result [concat $list1Result $list1]
        !           428:             break
        !           429:         }
        !           430:         set compareResult [string compare [lindex $list1 0] [lindex $list2 0]]
        !           431: 
        !           432:         if {$compareResult < 0} {
        !           433:             lappend list1Result [lvarpop list1]
        !           434:             continue
        !           435:         }
        !           436:         if {$compareResult > 0} {
        !           437:             lappend list2Result [lvarpop list2]
        !           438:             continue
        !           439:         }
        !           440:         lappend intersectList [lvarpop list1]
        !           441:         lvarpop list2
        !           442:     }
        !           443:     return [list $list1Result $intersectList $list2Result]
        !           444: }
        !           445: 
        !           446: proc intersect {list1 list2} {
        !           447:     set intersectList ""
        !           448: 
        !           449:     set list1 [lsort $list1]
        !           450:     set list2 [lsort $list2]
        !           451: 
        !           452:     while {1} {
        !           453:         if {[lempty $list1] || [lempty $list2]} break
        !           454: 
        !           455:         set compareResult [string compare [lindex $list1 0] [lindex $list2 0]]
        !           456: 
        !           457:         if {$compareResult < 0} {
        !           458:             lvarpop list1
        !           459:             continue
        !           460:         }
        !           461: 
        !           462:         if {$compareResult > 0} {
        !           463:             lvarpop list2
        !           464:             continue
        !           465:         }
        !           466: 
        !           467:         lappend intersectList [lvarpop list1]
        !           468:         lvarpop list2
        !           469:     }
        !           470:     return $intersectList
        !           471: }
        !           472: 
        !           473: 
        !           474: 
        !           475: #@package: TclX-show_procedures showproc showprocs
        !           476: 
        !           477: proc showproc {procname} {
        !           478:     if [lempty [info procs $procname]] {demand_load $procname}
        !           479:        set arglist [info args $procname]
        !           480:        set nargs {}
        !           481:        while {[llength $arglist] > 0} {
        !           482:            set varg [lvarpop arglist 0]
        !           483:            if [info default $procname $varg defarg] {
        !           484:                lappend nargs [list $varg $defarg]
        !           485:            } else {
        !           486:                lappend nargs $varg
        !           487:            }
        !           488:     }
        !           489:     format "proc %s \{%s\} \{%s\}\n" $procname $nargs [info body $procname]
        !           490: }
        !           491: 
        !           492: proc showprocs {args} {
        !           493:     if [lempty $args] { set args [info procs] }
        !           494:     set out ""
        !           495: 
        !           496:     foreach i $args {
        !           497:        foreach j $i { append out [showproc $j] "\n"}
        !           498:     }
        !           499:     return $out
        !           500: }
        !           501: 
        !           502: 
        !           503: #@package: TclX-stringfile_functions read_file write_file
        !           504: 
        !           505: proc read_file {fileName {numBytes {}}} {
        !           506:     set fp [open $fileName]
        !           507:     if {$numBytes != ""} {
        !           508:         set result [read $fp $numBytes]
        !           509:     } else {
        !           510:         set result [read $fp]
        !           511:     }
        !           512:     close $fp
        !           513:     return $result
        !           514: } 
        !           515: 
        !           516: proc write_file {fileName args} {
        !           517:     set fp [open $fileName w]
        !           518:     foreach string $args {
        !           519:         puts $fp $string
        !           520:     }
        !           521:     close $fp
        !           522: }
        !           523: 
        !           524: 
        !           525: #@package: TclX-Compatibility execvp
        !           526: 
        !           527: proc execvp {progname args} {
        !           528:     execl $progname $args
        !           529: }
        !           530: 
        !           531: #@package: TclX-convertlib convert_lib
        !           532: 
        !           533: proc convert_lib {tclIndex packageLib {ignore {}}} {
        !           534:     if {[file tail $tclIndex] != "tclIndex"} {
        !           535:         error "Tail file name numt be `tclIndex': $tclIndex"}
        !           536:     set srcDir [file dirname $tclIndex]
        !           537: 
        !           538:     if {[file extension $packageLib] != ".tlib"} {
        !           539:         append packageLib ".tlib"}
        !           540: 
        !           541: 
        !           542:     set tclIndexFH [open $tclIndex r]
        !           543:     while {[gets $tclIndexFH line] >= 0} {
        !           544:         if {([cindex $line 0] == "#") || ([llength $line] != 2)} {
        !           545:             continue}
        !           546:         if {[lsearch $ignore [lindex $line 1]] >= 0} {
        !           547:             continue}
        !           548:         lappend entryTable([lindex $line 1]) [lindex $line 0]
        !           549:     }
        !           550:     close $tclIndexFH
        !           551: 
        !           552:     set libFH [open $packageLib w]
        !           553:     foreach srcFile [array names entryTable] {
        !           554:         set srcFH [open $srcDir/$srcFile r]
        !           555:         puts $libFH "#@package: $srcFile $entryTable($srcFile)\n"
        !           556:         copyfile $srcFH $libFH
        !           557:         close $srcFH
        !           558:     }
        !           559:     close $libFH
        !           560:     buildpackageindex $packageLib
        !           561: }
        !           562: 
        !           563: #@package: TclX-profrep profrep
        !           564: 
        !           565: proc profrep:summarize {profDataVar stackDepth sumProfDataVar} {
        !           566:     upvar $profDataVar profData $sumProfDataVar sumProfData
        !           567: 
        !           568:     if {(![info exists profData]) || ([catch {array size profData}] != 0)} {
        !           569:         error "`profDataVar' must be the name of an array returned by the `profile off' command"
        !           570:     }
        !           571:     set maxNameLen 0
        !           572:     foreach procStack [array names profData] {
        !           573:         if {[llength $procStack] < $stackDepth} {
        !           574:             set sigProcStack $procStack
        !           575:         } else {
        !           576:             set sigProcStack [lrange $procStack 0 [expr {$stackDepth - 1}]]
        !           577:         }
        !           578:         set maxNameLen [max $maxNameLen [clength $sigProcStack]]
        !           579:         if [info exists sumProfData($sigProcStack)] {
        !           580:             set cur $sumProfData($sigProcStack)
        !           581:             set add $profData($procStack)
        !           582:             set     new [expr [lindex $cur 0]+[lindex $add 0]]
        !           583:             lappend new [expr [lindex $cur 1]+[lindex $add 1]]
        !           584:             lappend new [expr [lindex $cur 2]+[lindex $add 2]]
        !           585:             set $sumProfData($sigProcStack) $new
        !           586:         } else {
        !           587:             set sumProfData($sigProcStack) $profData($procStack)
        !           588:         }
        !           589:     }
        !           590:     return $maxNameLen
        !           591: }
        !           592: 
        !           593: proc profrep:sort {sumProfDataVar sortKey} {
        !           594:     upvar $sumProfDataVar sumProfData
        !           595: 
        !           596:     case $sortKey {
        !           597:         {calls} {set keyIndex 0}
        !           598:         {real}  {set keyIndex 1}
        !           599:         {cpu}   {set keyIndex 2}
        !           600:         default {
        !           601:             error "Expected a sort of: `calls',  `cpu' or ` real'"}
        !           602:     }
        !           603: 
        !           604: 
        !           605:     foreach procStack [array names sumProfData] {
        !           606:         set key [format "%016d" [lindex $sumProfData($procStack) $keyIndex]]
        !           607:         lappend keyProcList [list $key $procStack]
        !           608:     }
        !           609:     set keyProcList [lsort $keyProcList]
        !           610: 
        !           611: 
        !           612:     for {set idx [expr [llength $keyProcList]-1]} {$idx >= 0} {incr idx -1} {
        !           613:         lappend sortedProcList [lindex [lindex $keyProcList $idx] 1]
        !           614:     }
        !           615:     return $sortedProcList
        !           616: }
        !           617: 
        !           618: 
        !           619: proc profrep:print {sumProfDataVar sortedProcList maxNameLen outFile
        !           620:                     userTitle} {
        !           621:     upvar $sumProfDataVar sumProfData
        !           622:     
        !           623:     if {$outFile == ""} {
        !           624:         set outFH stdout
        !           625:     } else {
        !           626:         set outFH [open $outFile w]
        !           627:     }
        !           628: 
        !           629: 
        !           630:     set stackTitle "Procedure Call Stack"
        !           631:     set maxNameLen [max $maxNameLen [clength $stackTitle]]
        !           632:     set hdr [format "%-${maxNameLen}s %10s %10s %10s" $stackTitle \
        !           633:                     "Calls" "Real Time" "CPU Time"]
        !           634:     if {$userTitle != ""} {
        !           635:         puts $outFH [replicate - [clength $hdr]]
        !           636:         puts $outFH $userTitle
        !           637:     }
        !           638:     puts $outFH [replicate - [clength $hdr]]
        !           639:     puts $outFH $hdr
        !           640:     puts $outFH [replicate - [clength $hdr]]
        !           641: 
        !           642: 
        !           643:     foreach procStack $sortedProcList {
        !           644:         set data $sumProfData($procStack)
        !           645:         puts $outFH [format "%-${maxNameLen}s %10d %10d %10d" $procStack \
        !           646:                             [lindex $data 0] [lindex $data 1] [lindex $data 2]]
        !           647:     }
        !           648:     if {$outFile != ""} {
        !           649:         close $outFH
        !           650:     }
        !           651: }
        !           652: 
        !           653: 
        !           654: proc profrep {profDataVar sortKey stackDepth {outFile {}} {userTitle {}}} {
        !           655:     upvar $profDataVar profData
        !           656: 
        !           657:     set maxNameLen [profrep:summarize profData $stackDepth sumProfData]
        !           658:     set sortedProcList [profrep:sort sumProfData $sortKey]
        !           659:     profrep:print sumProfData $sortedProcList $maxNameLen $outFile $userTitle
        !           660: 
        !           661: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.