home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / javaMode.tcl < prev    next >
Encoding:
Text File  |  1997-05-08  |  6.2 KB  |  187 lines  |  [TEXT/ALFA]
  1. if {$startingUp} {
  2.     addMode    Java javaMenu        {*.java    *.j} javaMenu
  3.     set javaMenu                "•140"
  4.     addMenu    javaMenu
  5.     set modeMenus(Java)            {javaMenu}
  6.     return
  7. }
  8.  
  9. newModeVar Java    elecColon {1} 1
  10. newModeVar Java    elecRBrace {1} 1
  11. newModeVar Java    leftFillColumn {3} 0
  12. newModeVar Java    prefixString {//} 0 
  13. newModeVar Java    electricSemi {1} 1
  14. newModeVar Java    elecLBrace {1} 1
  15. newModeVar Java    elecElse {1} 1
  16. newModeVar Java    wordWrap {0} 1
  17. newModeVar Java    funcExpr {^[^ \t\(#\r/@].*\(.*\)$} 0
  18. newModeVar Java    parseExpr {\b([_:\w]+)\s*\(} 0
  19. newModeVar Java    wordBreak {\w+}    0
  20. newModeVar Java    wordBreakPreface {\W} 0
  21. newModeVar Java    electricTab {0}    1
  22. newModeVar Java    autoMark    0    1
  23. newModeVar Java    stringColor        green    0
  24. newModeVar Java    commentColor    red        0
  25. newModeVar Java    keywordColor    blue    0
  26.  
  27. regModeKeywords     -e {//} -b {/*} {*/} -c $JavamodeVars(commentColor) -k    $JavamodeVars(keywordColor)  -s    $JavamodeVars(stringColor) Java    {
  28.     abstract boolean break byte byvalue case catch char class const 
  29.     continue default do double else extends false final finally float for 
  30.     goto if implements import instanceof int interface long native new 
  31.     null package private protected public return short static super switch 
  32.     synchronized this throw throws transient true try void while future 
  33.     generic inner outer operator rest var volatile
  34. }
  35.  
  36. proc javaMenu {} {}
  37.  
  38. # A better Java menu by Ulf Dittmer <ucdittme@top.cis.syr.edu>:
  39. menu -n    $javaMenu -p javaMenuProc {
  40.     "/S<U<OswitchToCompiler"
  41.     "(-"
  42.     "/K<U<OcompileFile"
  43.     "(-"
  44.     "/V<U<OviewApplet"
  45. }
  46.  
  47. proc javaMenuProc {menu    item} {
  48.     switch $item {
  49.         switchToCompiler {launchForeAppl Javc}
  50.         compileFile {launchForeAppl Javc; sendOpenEvent    -n 'Javc' [car [winNames -f]]}
  51.         viewApplet {regsub "\.java" [car [winNames -f]]    ".html"    text
  52.                     launchForeAppl AppV; sendOpenEvent -n 'AppV' $text}
  53.     }
  54. }
  55.  
  56. # Need better values for 'funcExpr' and 'parseExpr':
  57. proc parseFuncsJava {} {
  58.     global funcExpr parseExpr
  59.  
  60.     set m {}
  61.     set pos 0
  62.     while {[set res [search -s -f 1 -r 1 -i 0 -n $funcExpr $pos]] != ""} {
  63.         set text [getText [car $res] [expr [nextLineStart [cadr $res]] - 1]]
  64.         if {[regexp $parseExpr $text dummy word]} {
  65.             set num [regsub -all sub $text sub dummy]
  66.             lappend m "[format %${num}s {}]$word" [car $res]
  67.         }
  68.         set pos [cadr $res]
  69.     }
  70.     return $m
  71. }
  72.  
  73. # My version of    JavaMarkFile. First revision, April 1996.
  74. # Jim Menard, jimm@io.com
  75. proc JavaMarkFile {} {
  76.     # Sorry, but globals are a lot easier than using "upvar" in subroutines
  77.     global markArray
  78.     global classStartPositions
  79.     global classNames
  80.  
  81.     catch {    unset markArray    }
  82.  
  83.     # Look for class definitions first
  84.     set markExpr {^[ \t]*([A-Za-z_][A-Za-z0-9_]*[ \t]+)*class[ \t]+[A-Za-z_][A-Za-z0-9_]*[ \t\r]([A-Za-z_][A-Za-z0-9_.]*[ \t]+)*\{}
  85.     set wordExpr {class[ \t]+([A-Za-z_][A-Za-z0-9_]*)}
  86.     set commands {
  87.         set markArray([concat $word "class"]) $markPos
  88.         # Remember mark    position and name separately so    we can call
  89.         # getClassFromPos() later.
  90.         lappend    classStartPositions $markPos
  91.         lappend    classNames $word
  92.     }
  93.     searchAndDestroy $markExpr $wordExpr $commands 0
  94.  
  95.     # The following    regular    expression is overly restrictive. After    the open
  96.     # paren, I disallow semicolons.    That avoids finding lines like
  97.     #    throw new FooException(arg);
  98.     # which    is good, but unfortunately also    avoids finding lines like
  99.     #    public int foo(arg) // comment with semi;
  100.     #
  101.     # It doesn't find constructors without a "public", "private", or other phrase
  102.     # before the method name since it requires at least one    word before the
  103.     # method name. They are    special-cased below. I did that    so function calls,
  104.     # "if" statements, and the like    wouldn't be found.
  105.     set markExpr {^[ \t]*([A-Za-z_][A-Za-z0-9_]*(\[\])*[ \t]+)+[A-Za-z_][A-Za-z0-9_]*[ \t\r]*\([^;]+$}
  106.     set wordExpr {([A-Za-z_][A-Za-z0-9_]*)[    \t]*\(}
  107.     set commands {
  108.         if {$className == $word} {
  109.             set markArray([concat $className "constructor"]) $markPos
  110.         } else {
  111.             set markArray($className::$word) $markPos
  112.         }
  113.     }
  114.     searchAndDestroy $markExpr $wordExpr $commands 1
  115.  
  116.     # One more time; let's go back for constructors    with no    modifiers.
  117.     set markExpr {^[ \t]*[A-Za-z][A-Za-z0-9_]*[ \t\r]*\([^;]+$}
  118.     set wordExpr {([A-Za-z][A-Za-z0-9_]*)[ \t]*\(}
  119.     set commands {
  120.         if {$className == $word} {
  121.             set markArray([concat $className "constructor"]) [lineStart [expr $start - 1]]
  122.         }
  123.     }
  124.     searchAndDestroy $markExpr $wordExpr $commands 1
  125.  
  126.     if {[info exists markArray]} {
  127.         foreach    f [lsort -ignore [array    names markArray]] {
  128.             set next [nextLineStart    $markArray($f)]
  129.  
  130.             if {[regexp {.*(::if)$}    $f] == 0} {
  131.                 if {[string length $f] > 35} { set f "[string range $f 0 31]..." }
  132.                 setNamedMark "${f}" "$markArray($f)" $next $next
  133.             }
  134.         }
  135.     }
  136. }
  137.  
  138. # Start    at top of file and find    text that matches markExpr. Clean it up    and
  139. # use wordExpr to find the word    we want. Execute commands.
  140. proc searchAndDestroy {markExpr    wordExpr commands needClassName} {
  141.     global markArray
  142.     global classStartPositions
  143.     global classNames
  144.  
  145.     set pos    0
  146.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 "$markExpr" $pos}    res]} {
  147.         set start [lindex $res 0]
  148.         set end    [expr [lindex $res 1] +    1]
  149.         set thistext [getText $start $end]
  150.         if {$needClassName} {
  151.             set className [getClassFromPos $start $classStartPositions $classNames]
  152.         }
  153.         # regexp doesn't like carriage returns or tabs
  154.         regsub -all "\r" $thistext " " thistext
  155.         regsub -all "\t" $thistext " " thistext
  156.         # If the open paren was    the last character on the line,
  157.         # the selected text included the last carriage return as well.
  158.         # Trim this off    now that it is changed into a space.
  159.         set thistext [string trimright $thistext]
  160.         if {[regexp $wordExpr $thistext    dummy word]} {
  161.             set markPos [lineStart [expr $start - 1]]
  162.             eval $commands
  163.         }
  164.         set pos    $end
  165.     }
  166. }
  167.  
  168. # Given    a file position, find the class    definition in which it resides.
  169. # There's got to be an easier way than passing two separate lists. I tried fooling
  170. # around with markArray(), but don't know Tcl well enough to use it instead.
  171. proc getClassFromPos {pos classStartPositions classNames} {
  172.     set nClasses [llength $classStartPositions]
  173.     for {set i [expr $nClasses - 1]} {$i >=    0} {set    i [expr    $i - 1]} {
  174.         if {[lindex $classStartPositions $i] <=    $pos} {
  175.             return [lindex $classNames $i]
  176.         }
  177.     }
  178.     return ""
  179. }
  180.  
  181. bind '\{' <s> electricLeft        Java
  182. bind '\;' electricSemi            Java
  183. bind '\}' <s> electricRight        Java
  184. bind '\;' <z> ordSemi            Java
  185.  
  186. insertMenu $javaMenu
  187.