home *** CD-ROM | disk | FTP | other *** search
/ Internet File Formats / InternetFileFormatsCD.bin / text / latex / mac / alpha60.hqx / Tcl / SystemCode / codeWarrior.tcl < prev    next >
Encoding:
Text File  |  1995-06-11  |  8.2 KB  |  358 lines
  1. #================================================================================
  2. #
  3. #             CodeWarrior Interaction
  4. #
  5. # Metrowerks currently has an incomplete appleevent interface. 
  6. # Apple events can be used to direct CodeWarrior to compile
  7. # or add individual files, make the project, etc. However, 
  8. # there is currently no provision to report specific errors
  9. # back to the controller.
  10. #
  11. #================================================================================
  12.  
  13. proc cwarriorMenu {} {}
  14.  
  15.  
  16. menu -n "$cwarriorMenu" -p codeWarriorProc {
  17.     "help"
  18.     "/-<UswitchTo"
  19.     {menu -n werksFlags -p werksProc {
  20.         "debugger"
  21.         "switchWhenCompiling"
  22.     }}
  23.     "createFileset"
  24.     "(-"
  25.     "addFile"
  26.     "/K<Ucompile"
  27.     "compileFiles"
  28.     "checkSyntax"
  29.     "precompile╔"
  30.     "(-"
  31.     "/U<Uupdate"
  32.     "/M<Umake"
  33.     "(-"
  34.     "/D<UgotoDebugger"
  35.     "/B<UsetBreakpoint"
  36.     "clearBreakpoint"
  37.     "/J<UshowSource"
  38.     "(-"
  39.     "/N<UnextError"
  40.     "/R<Urun"
  41. }
  42.  
  43. if {![info exists cwdebugger]}     {set cwdebugger     0}
  44. if {![info exists cwswitchWhenCompiling]}     {set cwswitchWhenCompiling 1}
  45. markMenuItem werksFlags cwdebugger $cwdebugger
  46. markMenuItem werksFlags cwswitchWhenCompiling $cwswitchWhenCompiling
  47.  
  48. proc cwhelp {} {
  49.     global HOME
  50.     edit -r "$HOME:Help:CodeWarrior"
  51. }
  52.     
  53. proc werksProc {menu item} {
  54.     global cw$item modifiedVars
  55.     
  56.     set cw$item [expr -1 * ([set cw$item] - 1)]
  57.     markMenuItem werksFlags $item [set cw$item]
  58.     lappend modifiedVars cw$item
  59. }
  60.  
  61.  
  62.  
  63. set CWCLASS        MMPR
  64. set CDCLASS        MWDB
  65.  
  66.  
  67. proc cwnextError {} {
  68.     nextMatch "*Compiler Errors*"
  69. }
  70.  
  71. proc dispErr {{win "* Compiler Errors *"}} {
  72.     if {[string length $win]} {
  73.         set text [getText -w $win [getPos -w $win] [selEnd -w $win]]
  74.         if {[regexp {(Line.*)░} $text dummy sub]} {
  75.             message "$sub"
  76.         }
  77.     }
  78. }
  79.         
  80.  
  81. proc codeWarriorProc {menu item} {
  82.     cw$item
  83. }
  84.     
  85. proc cwswitchTo {} {
  86.     global CODEWarrior
  87.     checkCw
  88.     switchTo $CODEWarrior
  89. }
  90.  
  91. proc cwmake {} {cwDo Make}
  92. proc cwupdate {} {cwDo UpdP}
  93.  
  94. proc cwDo {param} {
  95.     global CODEWarrior CWCLASS ALPHA
  96.     checkCw
  97.     switchTo $CODEWarrior
  98.     if {[string length [set res [AEBuild -r -t 500000 $CODEWarrior $CWCLASS $param "Errs" "bool(╟01╚)"]]]} {
  99.         warriorErrors $res
  100.     }
  101. }
  102.  
  103. proc cwrun {} {
  104.     global CODEWarrior CWCLASS ALPHA cwdebugger
  105.     checkCw
  106.     set bug $cwdebugger
  107.     switchTo $CODEWarrior
  108.     if {[string length [set res [AEBuild -r -t 500000 $CODEWarrior $CWCLASS RunP "Errs" "bool(╟01╚)" DeBg $bug]]]} {
  109.         warriorErrors $res
  110.     }
  111. }
  112.  
  113.  
  114. proc cwprecompile {} {
  115.     global CODEWarrior CWCLASS res
  116.     checkCw
  117.     set fname [lindex [winNames -f] 0]
  118.     set targ [putfile "Precompile target:"]
  119.     switchTo $CODEWarrior
  120.     if {[string length [set res [AEBuild $CODEWarrior $CWCLASS PreC "----" [makeAlis $fname] "Errs" "bool(╟01╚)" Targ [makeAlis $targ]]]] > 40} {
  121.         warriorErrors $res
  122.     } else {
  123.         if {[regexp {errn:([-0-9]+)} $res dummy errno]}  {
  124.             message "Error number: $errno"
  125.         }
  126.     }
  127. }
  128.  
  129.  
  130. proc cwaddFile {} {
  131.     global CODEWarrior CWCLASS
  132.     checkCw
  133.     switchTo $CODEWarrior
  134.     set fname [lindex [winNames -f] 0]
  135.     set res [AEBuild -t 500000 -q $CODEWarrior $CWCLASS AddF "----" [makeAlis $fname]]
  136. }
  137.  
  138. proc cwcheckSyntax {} {
  139.     global CODEWarrior CWCLASS res
  140.     checkCw
  141. #    switchTo $CODEWarrior
  142.     set fname [lindex [winNames -f] 0]
  143.     if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Chek "----" [concat {[alis(╟} [coerce TEXT $fname -x alis] {╚)]}] "Errs" "bool(╟01╚)"]]] > 40} {
  144.         warriorErrors $res
  145.     }
  146. }
  147.  
  148. proc cwcompile {} {
  149.     global CODEWarrior CWCLASS res ALPHA cwswitchWhenCompiling
  150.     save
  151.     checkCw
  152.     set fname [lindex [winNames -f] 0]
  153.     if {$cwswitchWhenCompiling} {
  154.         switchTo $CODEWarrior
  155.     }
  156.     if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Comp "----" [makeAlis $fname] "Errs" "bool(╟01╚)"]]] > 40} {
  157.         warriorErrors $res
  158.     } else {
  159.         set wins [winNames]
  160.         if {[set res [lsearch $wins "*Compiler Errors*"]] >= 0} {
  161.             set name [lindex $wins $res]
  162.             bringToFront $name
  163.             killWindow
  164.         }
  165.     }
  166.     switchTo $ALPHA
  167. }
  168.  
  169.  
  170. proc cwcompileFiles {} {
  171.     global CODEWarrior CWCLASS res ALPHA winModes
  172.     saveAll
  173.     checkCw
  174.     set files {}
  175.     set wins [winNames -f]
  176.     set md $winModes([lindex $wins 0])
  177.     foreach w $wins {
  178.         if {$md == $winModes($w)} {
  179.             lappend files $w
  180.         }
  181.     }
  182.     switchTo $CODEWarrior
  183.     if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Comp "----" [eval makeAlises $files] "Errs" "bool(╟01╚)"]]] > 40} {
  184.         warriorErrors $res
  185.     } else {
  186.         set wins [winNames]
  187.         if {[set res [lsearch $wins "*Compiler Errors*"]] >= 0} {
  188.             set name [lindex $wins $res]
  189.             bringToFront $name
  190.             killWindow
  191.         }
  192.     }
  193.     switchTo $ALPHA
  194. }
  195.  
  196.  
  197. proc cwGetFiles {} {
  198.     global CODEWarrior CWCLASS
  199.     checkCw
  200.     set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS GSeg]
  201.     regexp {\[(.*)\]} $res dummy segs
  202.     regsub -all {, Seg} $segs {Ñ} segs
  203.     set ind 1
  204.     foreach seg [split $segs {Ñ}] {
  205.         regexp {NumF:([0-9]+)} $seg dummy num
  206.         
  207.         while {$num > 0} {
  208.             set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS GFil "----" "long($num)" Segm "long($ind)"]
  209.             if {[regexp {FTxt} $res]} {
  210.                 regexp {╟(.*)╚} $res dummy spec
  211.                 set f [specToPathName $spec]
  212.                 message $f
  213.                 lappend files $f
  214.             }
  215.             incr num -1
  216.         }
  217.         incr ind
  218.     }
  219.     return $files
  220. }
  221.  
  222. proc createWarriorFileset {} {
  223.     cwcreateFileset
  224. }
  225.  
  226.  
  227. proc cwcreateFileset {} {
  228.     global fileSets
  229.     global currFileSet
  230.     
  231.     set name [prompt "Fileset name? " "CodeWarrior"]
  232.     set fileSets($name) [lsort -command sortByTail [cwGetFiles]]
  233.     addMenuItem -m choose $name
  234.     set currFileSet $name
  235.  
  236.     if {[askyesno "Save project fileset?"] == "yes"} {
  237.         addArrDef fileSets $name  $fileSets($name)
  238.     }
  239.     rebuildFilesetMenu
  240. }
  241.  
  242.  
  243. proc warriorErrors {res} {    
  244.     global winModes tileLeft tileTop tileWidth errorHeight
  245.     if {[regexp {\[.*\]} $res res]} {
  246.         set res [string trim $res {[]}]
  247.         regsub {ErrM} $res "" res
  248.         regsub -all {, ErrM} $res "\r" res
  249.         set text ""
  250.         set errs 0
  251.         set link 0
  252.         foreach err [lrange [split $res "\r"] 0 100] {
  253.             if {[regexp {╥(.*)╙.*╟(.*)╚.*ErrL:([0-9]+)} $err dummy msg spec line]} {
  254.                 set f [specToPathName $spec]
  255.                 append text "\r\"[file tail $f]\"\t; Line $line: $msg\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t░$f"
  256.             } elseif {[regexp {╥([^:]*): (.*)╙} $err dummy file msg]} {
  257.                 set link 1
  258.                 append text "\r\"$file\" ; $msg"
  259.             }
  260.             incr errs
  261.         }
  262.  
  263.         set wins [winNames]
  264.         if {!$errs} {
  265.             global killCompilerErrors
  266.             set killCompilerErrors 1
  267.             return
  268.         }
  269.         
  270.         if {[set res [lsearch $wins "*Compiler Errors*"]] >= 0} {
  271.             set name [lindex $wins $res]
  272.             bringToFront $name
  273.             setWinInfo read-only 0
  274.             deleteText 0 [maxPos]
  275.         } else {
  276.             new -n {* Compiler Errors *} -g $tileLeft $tileTop $tileWidth $errorHeight
  277.             changeMode [set winModes([lindex [winNames] 0]) Brws]
  278.         }
  279.         if {$link} {
  280.             insertText "($errs Link errors)\r-----$text\r"
  281.         } else {
  282.             insertText "($errs errs: <cr> to go to match)\r-----$text\r"
  283.         }
  284.  
  285.         display 0
  286.         goto 0
  287.         downBrowse
  288.         setWinInfo dirty 0
  289.         setWinInfo read-only 1
  290.     }
  291. }
  292.  
  293.  
  294. proc cwTouch {} {
  295.     global CODEWarrior CWCLASS
  296.     checkCw
  297.     switchTo $CODEWarrior
  298.     set fname [lindex [winNames -f] 0]
  299.     set res [AEBuild -t 500000 -q $CODEWarrior $CWCLASS "Toch" "----" [makeAlis $fname]]
  300. }
  301.     
  302. proc checkCw {} {
  303.     global CODEWarrior modifiedVars cwSig cwPath
  304.     set CODEWarrior [checkRunning "MW C/C++" $cwSig cwPath]
  305.     set sig [getFileSig $cwPath]
  306.     if {$sig != $cwSig} {
  307.         lappend modifiedVars cwSig
  308.         set cwSig $sig
  309.     }
  310. }
  311.  
  312.  
  313.  
  314. proc checkCwDebug {} {
  315.     global CODEDEBUGGER cwdSig cdPath modifiedVars
  316.     set CODEDEBUGGER [checkRunning "MW Debugger" $cwdSig cdPath]
  317.     set sig [getFileSig $cdPath]
  318.     if {$sig != $cwdSig} {
  319.         lappend modifiedVars cwdSig
  320.         set cwdSig $sig
  321.     }
  322. }
  323.  
  324.  
  325. proc cwgotoDebugger {} {
  326.     global CODEDEBUGGER
  327.     checkCwDebug
  328.     switchTo $CODEDEBUGGER
  329. }
  330.  
  331. proc cwsetBreakpoint {} {
  332.     global CODEDEBUGGER CDCLASS res
  333.     checkCwDebug
  334.     switchTo $CODEDEBUGGER
  335.     set fname [lindex [winNames -f] 0]
  336.     set ln [lindex [posToRowCol [getPos]] 0]
  337.     set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Sbrk" "----" [makeAlis $fname] "Line" "long($ln)"]
  338. }
  339.  
  340. proc cwclearBreakpoint {} {
  341.     global CODEDEBUGGER CDCLASS res
  342.     checkCwDebug
  343.     switchTo $CODEDEBUGGER
  344.     set fname [lindex [winNames -f] 0]
  345.     set ln [lindex [posToRowCol [getPos]] 0]
  346.     set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Cbrk" "----" [makeAlis $fname] "Line" "long($ln)"]
  347. }
  348.  
  349.  
  350. proc cwshowSource {} {
  351.     global CODEDEBUGGER CDCLASS res
  352.     checkCwDebug
  353.     switchTo $CODEDEBUGGER
  354.     set fname [lindex [winNames -f] 0]
  355.     set ln [lindex [posToRowCol [getPos]] 0]
  356.     set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Show" "----" [makeAlis $fname] "Line" "long($ln)"]
  357. }
  358. #  "Soff" "long([getPos]" "Eoff" "long([selEnd])"