home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Menus / codeWarriorMenu.tcl next >
Encoding:
Text File  |  1997-12-10  |  15.4 KB  |  552 lines  |  [TEXT/ALFA]
  1. #=== nowrap =====================================================================
  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. alpha::menu codewarriorMenu    1.1 "•268" "" {
  14.     set cwdebugMenu        "•274"
  15. } uninstall {this-file} maintainer {
  16.     "Vince Darley" darley@fas.harvard.edu <http://www.fas.harvard.edu/~darley/>
  17. } help {file "CodeWarrior"}
  18.  
  19. alpha::package require modeSearchPaths 1.0
  20.  
  21. hook::register savePostHook cw::modified "C++" "C"
  22. newPref flag debugger 0 cw
  23. newPref flag switchWhenCompiling 1 cw
  24. newPref var cwSearchPath "" cw
  25.  
  26. ensureset CWCompilerSig CWIE
  27. ensureset CWDebuggerSig MWDB
  28.  
  29. proc codewarriorMenu {} {}
  30.  
  31. menu -n "$codewarriorMenu" -p cw::menuProc {
  32.     "help"
  33.     "/-<UswitchTo"
  34.     {menu -m -n werksFlags {}}
  35.     "createFileset"
  36.     {menu -m -n headers {}}
  37.     "(-"
  38.     "addFile"
  39.     "/K<Ucompile"
  40.     "compileFiles"
  41.     "checkSyntax"
  42.     "precompile…"
  43.     "(-"
  44.     "openHeader"
  45.     "(-"
  46.     "/U<Uupdate"
  47.     "/M<Umake"
  48.     "(-"
  49.     "/D<UgotoDebugger"
  50.     "/B<UsetBreakpoint"
  51.     "clearBreakpoint"
  52.     "/J<UshowSource"
  53.     "(-"
  54.     "/N<UnextError"
  55.     "/R<Urun"
  56. }
  57.  
  58. menu::buildFlagMenu werksFlags array cwmodeVars
  59. mode::rebuildSearchPathMenu 
  60.  
  61. proc cw::help {} {
  62.     global HOME
  63.     edit -r "$HOME:Help:CodeWarrior"
  64. }
  65.  
  66. set CWCLASS        MMPR
  67. set CDCLASS        MWDB
  68.  
  69. proc cw::nextError {} {
  70.     nextMatch "*Compiler Errors*"
  71. }
  72.  
  73. proc cw::menuProc {menu item} {
  74.     cw::$item
  75. }
  76.     
  77. proc cw::switchTo {} {
  78.     global CODEWarrior
  79.     cw::check
  80.     switchTo $CODEWarrior
  81. }
  82.  
  83. proc cw::make {} {cw::killErrors; cw::Do Make}
  84. proc cw::update {} {cw::Do UpdP}
  85.  
  86. proc cw::Do {param} {
  87.     global CODEWarrior CWCLASS ALPHA
  88.     cw::check
  89.     switchTo $CODEWarrior
  90.     if {[string length [set res [AEBuild -r -t 500000 $CODEWarrior $CWCLASS $param "Errs" "bool(«01»)"]]]} {
  91.         cw::errors $res
  92.     }
  93. }
  94.  
  95. proc cw::run {} {
  96.     global CODEWarrior CWCLASS ALPHA cwmodeVars
  97.     cw::check
  98.     cw::killErrors
  99.     set bug $cwmodeVars(cwdebugger)
  100.     switchTo $CODEWarrior
  101.     if {[string length [set res [AEBuild -r -t 500000 $CODEWarrior $CWCLASS RunP "Errs" "bool(«01»)" DeBg $bug]]]} {
  102.         cw::errors $res
  103.     }
  104. }
  105.  
  106. proc cw::precompile {} {
  107.     global CODEWarrior CWCLASS res
  108.     cw::check
  109.     set fname [win::Current]
  110.     set targ [putfile "Precompile target:"]
  111.     switchTo $CODEWarrior
  112.     if {[string length [set res [AEBuild $CODEWarrior $CWCLASS PreC "----" [makeAlis $fname] "Errs" "bool(«01»)" Targ [makeAlis $targ]]]] > 40} {
  113.         cw::errors $res
  114.     } else {
  115.         if {[regexp {errn:([-0-9]+)} $res dummy errno]}  {
  116.             message "Error number: $errno"
  117.         }
  118.     }
  119. }
  120.  
  121. proc cw::addFile {} {
  122.     global CODEWarrior CWCLASS
  123.     cw::check
  124.     switchTo $CODEWarrior
  125.     set fname [win::Current]
  126.     set res [AEBuild -t 500000 -q $CODEWarrior $CWCLASS AddF "----" [makeAlis $fname]]
  127. }
  128.  
  129. proc cw::checkSyntax {} {
  130.     global CODEWarrior CWCLASS res
  131.     cw::check
  132. #    switchTo $CODEWarrior
  133.     set fname [win::Current]
  134.     if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Chek "----" [concat {[alis(«} [coerce TEXT $fname -x alis] {»)]}] "Errs" "bool(«01»)"]]] > 40} {
  135.         cw::errors $res
  136.     }
  137. }
  138.  
  139.  
  140. proc cw::killErrors {} {
  141.     set wins [winNames]
  142.     if {[set res [lsearch $wins "*Compiler Errors*"]] >= 0} {
  143.         set name [lindex $wins $res]
  144.         bringToFront $name
  145.         killWindow
  146.     }
  147. }    
  148.  
  149.  
  150. proc cw::compile {} {
  151.     global CODEWarrior CWCLASS res ALPHA cwmodeVars
  152.     save
  153.     cw::check
  154.     set fname [win::Current]
  155.     cw::killErrors
  156.     if {$cwmodeVars(cwswitchWhenCompiling)} {
  157.         switchTo $CODEWarrior
  158.     }
  159.     if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Comp "----" [makeAlis $fname] "Errs" "bool(«01»)"]]] > 40} {
  160.         cw::errors $res
  161.     }
  162.     switchTo $ALPHA
  163. }
  164.  
  165.  
  166. proc cw::compileFiles {} {
  167.     global CODEWarrior CWCLASS res ALPHA win::Modes
  168.     saveAll
  169.     cw::check
  170.     set files {}
  171.     set wins [winNames -f]
  172.     set md [set win::Modes([lindex $wins 0])]
  173.     foreach w $wins {
  174.         if {$md == [set win::Modes($w)]} {
  175.             lappend files $w
  176.         }
  177.     }
  178.     cw::killErrors
  179.     switchTo $CODEWarrior
  180.     if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Comp "----" [makeAlises $files] "Errs" "bool(«01»)"]]] > 40} {
  181.         cw::errors $res
  182.     }
  183.     switchTo $ALPHA
  184. }
  185.  
  186.  
  187. proc cw::GetFiles {} {
  188.     global CODEWarrior CWCLASS
  189.     cw::check
  190.     set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS GSeg]
  191.     regexp {\[(.*)\]} $res dummy segs
  192.     regsub -all {, Seg} $segs {•} segs
  193.     set ind 1
  194.     foreach seg [split $segs {•}] {
  195.         regexp {NumF:([0-9]+)} $seg dummy num
  196.         
  197.         while {$num > 0} {
  198.             set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS GFil "----" "long($num)" Segm "long($ind)"]
  199.             if {[regexp {FTxt} $res]} {
  200.                 regexp {«(.*)»} $res dummy spec
  201.                 set f [specToPathName $spec]
  202.                 message $f
  203.                 lappend files $f
  204.             }
  205.             incr num -1
  206.         }
  207.         incr ind
  208.     }
  209.     return $files
  210. }
  211.  
  212. proc cw::createFileset {} {
  213.     createWarriorFileset
  214.     rebuildAllFilesets
  215. }
  216.  
  217.  
  218. proc createWarriorFileset {} {
  219.     global gfileSets gfileSetsType
  220.     
  221.     set name [prompt "Fileset name? " "CodeWarrior"]
  222.     set gfileSets($name) [lsort -command sortByTail [cw::GetFiles]]
  223.     set gfileSetsType($name) codewarrior
  224.  
  225.     if {[askyesno "Save project fileset?"] == "yes"} {
  226.         addArrDef gfileSets $name  $gfileSets($name)
  227.         addArrDef gfileSetsType $name codewarrior
  228.     }
  229.     return $name
  230. }
  231.  
  232.  
  233. # the error reply from CodeWarrior looks like this
  234. # [ErrM{ErrT:ErCW, ErrS:“function declaration hides inherited virtual function”, file:fss («FFFB000014371443536D617274537464506F7075704D656E752E6800000000000000000000000000000000000000000000000000000000000000000000000000000000000000»), ErrL:64}, ...]
  235. #
  236. # ErrT is the error type parameter
  237. #     ErCW indicates a warning
  238. #     ErCE indicates an error
  239. # Improvements by jdunning@cs.Princeton.EDU (John Dunning)
  240. proc cw::errors {res} {    
  241.     global win::Modes tileLeft tileTop tileWidth errorHeight
  242.  
  243.     if {[regexp {\[.*\]} $res res]} {
  244.             # trim off the outside brackets
  245.         set res [string trim $res {[]}]
  246.         
  247.             # replace all the returns in the error list with spaces.  this is 
  248.             # necessary because CW 7.0 can return multi-line error messages,
  249.             # which aren't processed correctly by this function.
  250.         regsub -all "\r" $res " " res
  251.         
  252.             # delete the first ErrM, and replace the remaining ones (and the preceeding commas)
  253.             # with returns
  254.         regsub {ErrM} $res "" res
  255.         regsub -all {, ErrM} $res "\r" res
  256.         
  257.         set text ""
  258.         set errors 0
  259.         set warnings 0
  260.         set messages 0
  261.         set link 0
  262.         
  263.             # split the string into separate lines, one error per line.  only process
  264.             # process the first 101 errors
  265.         foreach err [lrange [split $res "\r"] 0 100] {
  266.                 # the last two letters in ErrT:Er.. signal whether it's a compile (C) or link (L)
  267.                 # error and whether it's an error (E) or a warning (W).  stick the rest of
  268.                 # the error message back into err.
  269.             if {[regexp {ErrT:Er(.)(.),[ \t]*(.*)} $err unused compileOrLink errorOrWarning err]} {
  270.                 if {$errorOrWarning == "E"} {
  271.                         # mark actual errors with a bullet
  272.                     append text " • "
  273.                     incr errors
  274.                 } else {
  275.                         # mark warnings with a delta
  276.                     append text " Δ "
  277.                     incr warnings
  278.                 }
  279.                 
  280.                 if {$compileOrLink == "C"} {
  281.                         # we have a compile error, so strip out the error message, the filespec
  282.                         # and the line number
  283.                     if {[regexp {ErrS:“(.*)”.*«(.*)».*ErrL:([0-9]+)} $err unused errorString fileSpec lineNumber]} {
  284.                             # conver the filespec that was returned in the apple event into a pathname
  285.                             # so we can display it
  286.                         set pathName [specToPathName $fileSpec]
  287.                     
  288.                             # append the file name (the tail of the pathname), the line number,
  289.                             # the error string, lots of tabs, and then the full pathname
  290.                         append text "\"[file tail $pathName]\"\t; Line $lineNumber: $errorString\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∞$pathName\r"
  291.                     }
  292.                 } else {
  293.                         # we got a link error
  294.                     set link 1
  295.                     
  296.                         # just strip out the error message.  the file the error occurs in doesn't 
  297.                         # seem to get included in the event
  298.                     if {[regexp {ErrS:“(.*)”} $err unused errorString]} {
  299.                             # append the error message
  300.                         append text "$errorString\r"
  301.                     }
  302.                 }
  303.             } elseif {[regexp {“([^:]*): (.*)”} $err unused fileName message]} {
  304.                     # we got some sort of message, so strip out the associated file name and 
  305.                     # the message.  I'm not sure if CodeWarrior still returns anything of this form.
  306.                 append text "\"$fileName\" ; $message\r"
  307.                 incr messages
  308.             }
  309.         }
  310.  
  311.         set wins [winNames]
  312.         if {$errors == 0 && $warnings == 0 && $messages == 0} {
  313.             global killCompilerErrors
  314.             set killCompilerErrors 1
  315.             return
  316.         }
  317.         
  318.         new -n {* Compiler Errors *} -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws
  319.         if {$link} {
  320.             insertText "(Link: $errors errors, $warnings warnings, $messages messages)\r-----\r$text"
  321.         } else {
  322.             insertText "($errors errors, $warnings warnings, $messages messages: <cr> to go to line)\r-----\r$text"
  323.         }
  324.  
  325.         display 0
  326.         goto 0
  327.         downBrowse
  328.         setWinInfo dirty 0
  329.         setWinInfo read-only 1
  330.         gotoMatch
  331.     }
  332. }
  333.  
  334.  
  335.  
  336. proc cw::modified {fname} { 
  337.     global CWCompilerSig CWCLASS mode
  338.     cw::checkRunning
  339.     AEBuild -t 500000 $CODEWarrior $CWCLASS "Toch" "----" [makeAlis $fname]
  340. }
  341.  
  342. proc cw::Touch {} {
  343.     global CODEWarrior CWCLASS
  344.     cw::check
  345.     switchTo $CODEWarrior
  346.     set fname [win::Current]
  347.     set res [AEBuild -t 500000 -q $CODEWarrior $CWCLASS "Toch" "----" [makeAlis $fname]]
  348. }
  349.  
  350. proc cw::check {} {
  351.     global CODEWarrior modifiedVars CWCompilerSig 
  352.     app::launchElseTryThese {CWIE MMCC MPCC} CWCompilerSig
  353.     set CODEWarrior [file tail [app::launchBack $CWCompilerSig]]
  354. }
  355.  
  356. proc cw::checkDebug {} {
  357.     global CODEDEBUGGER CWDebuggerSig modifiedVars
  358.     app::launchElseTryThese {MPDB MWDB} CWDebuggerSig
  359.     set CODEDEBUGGER [file tail [app::launchBack $CWDebuggerSig]]
  360. }
  361.  
  362. proc cw::gotoDebugger {} {
  363.     global CODEDEBUGGER
  364.     cw::checkDebug
  365.     switchTo $CODEDEBUGGER
  366. }
  367.  
  368. proc cw::setBreakpoint {} {
  369.     global CODEDEBUGGER CDCLASS res
  370.     cw::checkDebug
  371.     switchTo $CODEDEBUGGER
  372.     set fname [win::Current]
  373.     set ln [lindex [posToRowCol [getPos]] 0]
  374.     set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Sbrk" "----" [makeAlis $fname] "Line" "long($ln)"]
  375. }
  376.  
  377. proc cw::clearBreakpoint {} {
  378.     global CODEDEBUGGER CDCLASS res
  379.     cw::checkDebug
  380.     switchTo $CODEDEBUGGER
  381.     set fname [win::Current]
  382.     set ln [lindex [posToRowCol [getPos]] 0]
  383.     set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Cbrk" "----" [makeAlis $fname] "Line" "long($ln)"]
  384. }
  385.  
  386.  
  387. proc cw::showSource {} {
  388.     global CODEDEBUGGER CDCLASS res
  389.     cw::checkDebug
  390.     switchTo $CODEDEBUGGER
  391.     set fname [win::Current]
  392.     set ln [lindex [posToRowCol [getPos]] 0]
  393.     set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Show" "----" [makeAlis $fname] "Line" "long($ln)"]
  394. }
  395. #  "Soff" "long([getPos]" "Eoff" "long([selEnd])"
  396.  
  397. proc cw::openHeader {} {
  398.     if {[regexp {#include.*("|<)(.*)("|>)} [getText [lineStart [getPos]] [nextLineStart [getPos]]] d1 d1 inc]} {
  399.         return [editIncludeFile $inc]
  400.     }
  401.     message "No include file found on this line!"
  402.     beep
  403. }
  404.  
  405.  
  406.  ## 
  407.   # from old "codeWarriorMenu+.tcl"                                       
  408.   #                                                                       
  409.   # July 15, 1996       Jonathan E. Guyer   <mailto:j-guyer@nwu.edu>  
  410.   #                                                                   
  411.   # These routines implement an includes list for CodeWarrior when you 
  412.   # option-click in the title bar.  It requires CodeWarrior IDE 1.6 or 
  413.   # greater (earlier versions didn't return file dependencies with 
  414.   # «MMPRGFil» events.
  415.   #                                                                            
  416.   # As discussed within the code, it's not the                                 
  417.   # most efficient thing in the world, due to the IDE's                        
  418.   # dain-bramaged object model. I hope to improve this in the future.          
  419.   ##
  420.  
  421. proc cw::checkRunning {} {
  422.     global CODEWarrior CWCompilerSig launchIDEifRequired
  423.     if ![app::isRunning $CWCompilerSig CODEWarrior] {
  424.         if ![app::isRunning {CWIE MMCC MPCC} CODEWarrior CWCompilerSig] {
  425.             error "Not running"
  426.         }
  427.     }
  428. }
  429.  
  430. proc cw::include {name} {
  431.     global CODEWarrior cwpaths 
  432.     
  433.     # This may be more trouble than    it's worth:
  434.     # I got    tired of "* CodeWarrior    Not Running *" messages    when it    _was_ running
  435.     #    (CODEWarrior wasn't defined yet) but this way it'll launch CW on an option-click, 
  436.     #    whether    you want it to or not.
  437.     cw::checkRunning
  438.     
  439.     # Make sure the    file is    in the current project before we start iterating 
  440.     #    through    all its    files.
  441.     
  442.     set blah [AEBuild -r $CODEWarrior "MMPR" "FInP"    "----" "TEXT(“[file tail $name]”)"]
  443.     # aevt\ansr{'----':[?]}
  444.     if {![regexp {'----':\[([^]]*)\]} $blah    dummy errCode]}    {
  445.         # aevt\ansr{errn:????}
  446.         regexp {errn:([-0-9]*)}    $blah dummy errCode
  447.     }
  448.     
  449.     # error    codes defined in CWAppleEvents.h in CodeWarrior's MacOS    Examples
  450.     if         {$errCode == 1} {
  451.         # errShell_ActionFailed
  452.         set theReply {{(Action Failed}}
  453.     } elseif {$errCode == 2} {
  454.         # errShell_FileNotFound
  455.         set theReply {{(Not in current CW project}}
  456.     } elseif {$errCode == 6} {
  457.         # errShell_NoOpenProject
  458.         set theReply {{(No project open    in CW}}
  459.     } elseif {$errCode != 0} {
  460.         lappend    theReply "(CW AppleEvent Error:    $errCode"
  461.     }
  462.     
  463.     if {![info exists theReply]} {
  464.         
  465.         if {[info exists cwpaths]} {unset cwpaths}
  466.     
  467.         # CodeWarrior is a pain    in the ass about this and won't    just 
  468.         #    return the file    with a given name so we:
  469.     
  470.         # get list of Segments
  471.     
  472.         set blah [AEBuild -r $CODEWarrior "MMPR" "GSeg"]
  473.         # aevt\ansr{'----':[Seg    {...}, Seg {...}, ...]}
  474.         if {![regexp {aevt\\ansr\{'----':\[.+\]\}} $blah]} {return {{(Empty project}}}
  475.     
  476.         # strip    out everthing down to a    list of    file counts
  477.     
  478.         set fileCountList ""
  479.         # ... Seg {... NumF:??,    ...}, ...
  480.         while {[regexp -indices    {NumF:([0-9]*),?} $blah    dummy mtchRange]} {
  481.             set fileCountList [concat $fileCountList " " [string range $blah [lindex $mtchRange 0] [lindex $mtchRange 1]]]
  482.             set blah [string range $blah [expr [lindex $mtchRange 1] + 1] [string length $blah]]
  483.         }
  484.     
  485.         # then iterate through each file in each segment 
  486.         #    until we find what we're looking for
  487.     
  488.         set segmentNumber 0
  489.         set foundFile 0
  490.         foreach    fileCount $fileCountList {
  491.             incr segmentNumber
  492.             for {set fileNumber 1} {$fileNumber <= $fileCount} {incr fileNumber} {
  493.                 set blah [AEBuild -r $CODEWarrior "MMPR" "GFil"    "----" $fileNumber "Segm" $segmentNumber]
  494.                 # aevt\ansr{'----':SrcF{... pnam:“?????.??” ...}}
  495.                 regexp {pnam:“([^”]*)”}    $blah dummy fileName
  496.                 if {$fileName == $name}    {
  497.                     set foundFile 1
  498.                     break
  499.                 }
  500.             }
  501.             if {$foundFile}    {
  502.                 break
  503.             }
  504.         
  505.         }
  506.         
  507.         # and finally break down the list of included files, 
  508.         
  509.         if {$foundFile}    {
  510.             # aevt\ansr{'----':SrcF{... IncF:[fss («...»), ... ] ...}}
  511.             regexp {IncF:\[([^]]*)\]} $blah    dummy raw
  512.             if {$raw == ""}    {return    {{(No includes}}}
  513.             # fss («??????»), fss («??????»), ... ,    fss («??????») ...
  514.             regsub -all {»[^«]*«} $raw { } raw
  515.             # fss («?????? ?????? ... ??????») ...
  516.             regsub {[^«]*«}    $raw {}    raw
  517.             # ?????? ??????    ... ??????») ...
  518.             regsub {».*} $raw {} raw
  519.             # ?????? ??????    ... ??????
  520.             foreach    f $raw {
  521.                 # ??????     (really about a bazillion numbers)
  522.                 set path [specToPathName $f]
  523.                 set tl [file tail $path]
  524.                 set cwpaths($tl) $path
  525.                 lappend    names $tl
  526.             }
  527.             set theReply [lsort -ignore $names]
  528.         } else {
  529.             # should never get here
  530.             set theReply {{(Not in current CW project}}
  531.         }
  532.     }
  533.     return $theReply
  534. }
  535.  
  536. # Called by Alpha to get list of include files for popup.
  537. proc cw::getIncludeFiles {} {
  538.     if {[catch {cw::include [win::CurrentTail]} ret]} {
  539.         error {{(* CodeWarrior not running *}}
  540.     }
  541.     return $ret
  542. }
  543.  
  544. proc cw::editIncludeFile {fname} {
  545.     global cwpaths
  546.     if [info exists cwpaths($fname)] {
  547.         openFileQuietly $cwpaths($fname)
  548.     } else {
  549.         error "Not found!"
  550.     }
  551. }
  552.