home *** CD-ROM | disk | FTP | other *** search
/ Internet File Formats / InternetFileFormatsCD.bin / text / latex / mac / alpha60.hqx / Tcl / SystemCode / tcl.tcl < prev    next >
Encoding:
Text File  |  1995-07-14  |  5.8 KB  |  241 lines
  1.  
  2. # The menu.
  3. menu -n $tclMenu -p tclMenuProc {
  4.     "/Z<O<UtraceTclProc╔"
  5.     "/D<O<UdumpTraces"
  6.     "(-"
  7.     "rebuildTclIndices"
  8.     "(-"
  9.     "<U/PprocDefinition"
  10.     "getVarValue╔"
  11. }
  12. proc tclMenu {} {}
  13.  
  14. newModeVar Tcl prefixString {# } 0
  15. newModeVar Tcl wordWrap {0} 1
  16. newModeVar Tcl funcExpr {^proc *([+-a-zA-Z0-9]+)} 0
  17. newModeVar Tcl wordBreak {(\$)?[a-zA-Z0-9_]+} 0
  18. newModeVar Tcl wordBreakPreface {([^a-zA-Z0-9_\$]|.\$)} 0
  19. newModeVar Tcl elecLBrace    1    1
  20. newModeVar Tcl elecRBrace    1    1
  21. newModeVar Tcl elecReturn    1    1
  22. newModeVar Tcl autoMark    0    1
  23. newModeVar Tcl electricTab 1 1
  24.  
  25. set tclKeyWords {
  26.     then append array break case catch cd close concat continue elseif else eof 
  27.     error eval exec exit expr file flush foreach format for gets global glob 
  28.     history if incr info join lappend library lindex linsert list llength 
  29.     lrange lreplace lsearch lsort open pid proc puts pwd read regexp regsub 
  30.     rename return scancontext scan seek set source split string switch tell 
  31.     time trace unknown unset uplevel upvar while
  32.     
  33.     menu
  34. }
  35. if {[info exists Tclwords]} {set tclKeyWords [concat $tclKeyWords $Tclwords]}
  36. regModeKeywords -e {#} -c red -k blue Tcl $tclKeyWords
  37. unset tclKeyWords
  38.  
  39. #================================================================================
  40.  
  41. proc electricTclLeft {} {
  42.     global TclmodeVars
  43.     
  44.     if {[getPos] != [selEnd]} {
  45.         set beg [getPos]
  46.         set end [selEnd]
  47.         select $end $end
  48.         deleteText $beg $end
  49.     }
  50.     if {!$TclmodeVars(elecLBrace) || (([lookAt [getPos]] != "\r") && ([getPos] != [maxPos])) || [catch {search -s -f 0 -r 1 "\}" [getPos]} res] || 
  51.         ![regexp {\}[ \t\r]*(else(if)?)[ \t\r]*} [getText [lindex $res 0] [getPos]] dum word]} {
  52.         insertText "\{"
  53.         return
  54.     }
  55.     replaceText [lindex $res 0] [getPos] "\} $word \{\r"
  56.     indentLine
  57.     if {$word == "elseif"} {
  58.         previousLine
  59.         endOfLine
  60.     }
  61. }
  62. bind '\{' <s> electricTclLeft Tcl
  63.  
  64.  
  65. proc electricTclRight {} {
  66.     global TclmodeVars {}
  67.         
  68.     if {!$TclmodeVars(elecRBrace) || [regexp {[^ \t]} [getText [lineStart [getPos]] [getPos]]]} {
  69.         insertText "\}"
  70.         blink [matchIt "\}" [expr [getPos] - 2]]
  71.         return
  72.     }
  73.     set start [lineStart [getPos]]
  74.     insertText "\}"
  75.     backwardChar
  76.     indentLine
  77.     endOfLine
  78.     tclCarriageReturn
  79.     blink [matchIt "\}" $start]
  80. }
  81. bind '\}' <s> electricTclRight Tcl
  82.     
  83.  
  84. proc tclCarriageReturn {} {
  85.     global TclmodeVars
  86.     
  87.     insertText "\r"
  88.     if {$TclmodeVars(elecReturn)} {
  89.         indentLine
  90.     }
  91. }
  92. bind '\r' tclCarriageReturn Tcl
  93.  
  94.  
  95.  
  96. proc rebuildTclIndices {} {
  97.     set dir [pwd]
  98.     cd
  99.     message "Building SystemCode index╔"
  100.     auto_mkindex :Tcl:SystemCode *.tcl
  101.     message "Building UserCode index╔"
  102.     auto_mkindex :Tcl:UserCode *.tcl
  103.     message ""
  104.     cd $dir
  105. }
  106.  
  107.  
  108. proc tclMenuProc {menu item} {
  109.     global tclColoring
  110.  
  111.     eval $item
  112. }
  113.  
  114.  
  115. #===========================================================================
  116. # Debug a Tcl procedure.
  117. #===========================================================================
  118.  
  119. # Alpha TCL programming mode
  120.  
  121. proc traceTclProc {} {
  122.     global tclMenu
  123.     if {[llength [traceFunc status]]>2} {
  124.         markMenuItem $tclMenu {traceTclProc╔} off
  125.         enableMenuItem $tclMenu dumpTraces off
  126.         if {[string length [set data [traceDump]]]} {
  127.             if {[askyesno "Dump traces?"] == "yes"} {
  128.                 dumpTraces [string trimright [lindex [traceFunc status] 3] {,}] $data
  129.                 setWinInfo dirty 0
  130.             }
  131.         }
  132.         traceFunc off
  133.         message "Tracing off."
  134.         return
  135.     }
  136.     if {[llength [winNames]] && [string length [set sel [getSelect]]]} {
  137.         set func [listpick -L $sel -p {Func Name:} [lsort -ignore [info procs]]]
  138.     } else {
  139.         set func [listpick -p {Func Name:} [lsort -ignore [info procs]]]
  140.     }
  141.     if {![string length $func]} return
  142.     traceFunc on $func ""
  143.     catch {markMenuItem $tclMenu {traceTclProc╔} on}
  144.     enableMenuItem $tclMenu dumpTraces on
  145.     message "Tracing '$func'╔"
  146. }
  147.  
  148.  
  149. proc dumpTraces {{name ""} {data ""}} {
  150.     if {![string length $name]} {
  151.         set name [string trimright [lindex [traceFunc status] 3] {,}]
  152.     }
  153.     if {![string length $data]} {
  154.         set data [traceDump]
  155.     }
  156.     
  157.     if {![string length $data]} {
  158.         message "Trace buffer empty"
  159.     } else {
  160.         new -n "* Trace '$name' *"
  161.         insertText $data
  162.         setWinInfo dirty 0
  163.         goto 0 
  164.     }
  165. }
  166.  
  167. proc setTclMode {} {
  168.     changeMode "Tcl"
  169. }
  170.  
  171. #================================================================================
  172. proc TclMarkFile {} {
  173.     set end [maxPos]
  174.     set pos 0
  175.     set l {}
  176.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 {^proc} $pos} res]} {
  177.         set start [lindex $res 0]
  178.         set end [nextLineStart $start]
  179.         set text [lindex [getText $start $end] 1]
  180.         set pos $end
  181.         set inds($text) [lineStart [expr $start - 1]]
  182.     }
  183.  
  184.     if {[info exists inds]} {
  185.         foreach f [lsort -ignore [array names inds]] {
  186.             set next [nextLineStart $inds($f)]
  187.             setNamedMark $f $inds($f) $next $next
  188.         }
  189.     }
  190. }
  191.  
  192. proc dummyTcl {} {}
  193.  
  194. #===============================================================================
  195. proc TclDblClick {from to} {
  196.     global HOME auto_index
  197.     
  198.     select $from $to
  199.     set text [getSelect]
  200.  
  201.     # Is it a loaded proc?
  202.     if {[info exists "auto_index($text)"]} {
  203.         editMark "$auto_index($text)" $text
  204.         return
  205.     }
  206.     # Is it a built-in Alpha command?
  207.     set lines [grep "^Ñ $text " "$HOME:Help:Alpha Commands"]
  208.     if {[string length $lines]} {
  209.         editMark "$HOME:Help:Alpha Commands" $text
  210.         setWinInfo read-only 1
  211.         return
  212.     }
  213.     # Is it a core Tcl command?
  214.     set lines [grep "^     $text -" "$HOME:Help:Tcl Commands"]
  215.     if {[string length $lines]} {
  216.         editMark "$HOME:Help:Tcl Commands" $text
  217.         setWinInfo read-only 1
  218.         return
  219.     }
  220.     # Is it a global variable?
  221.      if {[llength [info globals [string trimleft $text {$}]]]==1} {
  222.         showVarValue [string trimleft $text {$}]
  223.         return
  224.     }
  225.     message "No docs"
  226. }
  227.  
  228. proc procDefinition {} {
  229.     global auto_index auto_help 
  230.     
  231.     if {[llength [winNames]] && [string length [set sel [getSelect]]]} {
  232.         set func [listpick -L $sel -p {Proc?} [lsort -ignore [array names auto_index]]]
  233.     } else {
  234.         set func [listpick -p {Proc?} [lsort -ignore [array names auto_index]]]
  235.     }
  236.  
  237.     editMark "$auto_index($func)" $func
  238. }
  239.  
  240. #===============================================================================
  241.