home *** CD-ROM | disk | FTP | other *** search
/ Internet File Formats / InternetFileFormatsCD.bin / text / latex / mac / alpha60.hqx / Tcl / SystemCode / sql.tcl < prev    next >
Encoding:
Text File  |  1995-06-11  |  5.0 KB  |  135 lines
  1.  
  2. #############################################################################
  3. #   FILE: sql.tcl
  4. #----------------------------------------------------------------------------
  5. # AUTHOR:     Joel D. Elkins
  6. #     of      New Media, Inc.
  7. #             200 South Meridian, Ste. 220
  8. #             Indianapolis, IN 46225
  9. #
  10. # internet:   jdelkins@iquest.net  (preferred)
  11. # compuserve: 72531,314
  12. # AOL:        jdelkins
  13. #
  14. #   Copyright ⌐ 1994-1995 by Joel D. Elkins
  15. #   All rights reserved.
  16. #############################################################################
  17. #
  18. #  Alpha mode for SQL and Oracle's PL/SQL programming language
  19. #  Converts SQL and PL/SQL keywords to uppercase on the fly and colorizes
  20. #
  21. #############################################################################
  22. # HISTORY
  23. #                  
  24. # modified who rev reason
  25. # -------- --- --- ------ 
  26. # 7/29/94  JDE 1.0 Original 
  27. # 2/8/95   JDE 1.1 Added electUpper for tab, cr, and ';'
  28. #############################################################################
  29.  
  30. proc dummySQL {} {}
  31.  
  32. #############################################################################
  33. # PL/SQL mode by Joel D. Elkins
  34. #############################################################################
  35. lappend modes SQL
  36. set modeMenus(SQL)                        { }
  37. set dummyProc(SQL)                        dummySQL
  38. lappend modeSuffixes                    {*.sql} { set winMode SQL }
  39. lappend modeSuffixes                    {*.SQL} { set winMode SQL }
  40. lappend modeSuffixes                    {*.pkg}    { set winMode SQL }
  41. newModeVar    SQL     elecRBrace            {0}    1
  42. newModeVar    SQL     electricSemi        {1}    1
  43. newModeVar    SQL        wordBreak            {(\$)?[a-zA-Z0-9_]+} 0
  44. newModeVar    SQL        prefixString        {--} 0
  45. newModeVar    SQL        elecLBrace            {0} 1
  46. newModeVar    SQL        wordWrap            {0} 1
  47. newModeVar    SQL        funcExpr            {(PROCEDURE|FUNCTION)[ \t]+([a-zA-Z0-9_]+)} 0
  48. newModeVar    SQL        wordBreakPreface    {[^a-zA-Z0-9_\$]} 0
  49. newModeVar    SQL        optionIsMeta        {0} 1
  50.  
  51. set sqlKeywords {
  52.     ABORT ACCEPT ACCESS ALTER AND ARRAY ARRAYLEN AS ASSERT AT AVG BEGIN BETWEEN BODY
  53.     CASE COLUMNS COMMIT CONSTANT COUNT CREATE CURSOR DECLARE DEFAULT DEFINITION
  54.     DELETE DESC DISPOSE DISTINCT DO DROP ELSE ELSIF END ENTRY EXCEPTION EXISTS EXIT
  55.     FALSE FETCH FOR FROM FUNCTION GOTO IF IN INSERT INTERSECT INTO IS LIKE LOOP MAX MIN
  56.     MINUS MOD NEW OF ON OPEN OR OUT PACKAGE PARTITION POSITIVE PRAGMA PRIVATE
  57.     PROCEDURE PUBLIC RANGE RECORD REM REPLACE RETURN ROLLBACK ROWTYPE RUN SAVEPOINT
  58.     SELECT SET SIZE START STDDEV SUM THEN TO TYPE UNION UNIQUE UPDATE USE VALUES
  59.     VARIANCE WHEN WHERE WHILE WITH XOR
  60. }
  61. ###    Just colorize uppercase keywords
  62. #    abort accept access alter and array arraylen as assert at avg begin between body
  63. #    case columns commit constant count create cursor declare default definition
  64. #    delete desc dispose distinct do drop else elsif end entry exception exists exit
  65. #    false fetch for from function goto if in insert intersect into is like loop max min
  66. #    minus mod new of on open or out package partition positive pragma private
  67. #    procedure public range record rem replace return rollback rowtype run savepoint
  68. #    select set size start stddev sum then to type union unique update use values
  69. #    variance when where while with xor
  70. ###
  71. regModeKeywords -e {--} -b {/*} {*/} -c red -k blue SQL $sqlKeywords
  72. unset sqlKeywords
  73. #================================================================================
  74.  
  75. catch {unset plSqlKeywords}
  76.  
  77. lappend plSqlKeywords \
  78.     abort accept access alter and array arraylen as assert at avg begin between body \
  79.     case columns commit constant count create cursor declare default definition \
  80.     delete desc dispose distinct do drop else elsif end entry exception exists exit \
  81.     false fetch for from function goto if in insert intersect into is like loop max min \
  82.     minus mod new of on open or out package partition positive pragma private \
  83.     procedure public range record rem replace return rollback rowtype run savepoint \
  84.     select set size start stddev sum then to type union unique update use values \
  85.     variance when where while with xor
  86.  
  87.  
  88. proc electUpper {char} {
  89.     global plSqlKeywords
  90.     
  91.     set a [getPos]
  92.     backwardWord
  93.     set b [getPos]
  94.     
  95.     #make sure we're not in a comment
  96.     beginningOfLine
  97.     set commentSearch {(^[ \t]*rem[ \t]+)|(^[ \t]*REM[ \t]+)|--}
  98.     if {[catch {search -r 1 -f 1 -l $b -- $commentSearch [getPos]}] != 0} {
  99.         #if not, make the word uppercase if it's a keyword
  100.         set cmd [getText $b $a]
  101.         goto $b
  102.         if {[lsearch -exact $plSqlKeywords $cmd] >= 0} {
  103.             upcaseWord
  104.         }
  105.     }
  106.     goto $a
  107.     if { 0 == [string compare $char "\r"] } {
  108.         carriageReturn
  109.     } else {
  110.         insertText $char
  111.     }
  112. }
  113.  
  114. bind '\ ' {electUpper "\ "} "SQL"
  115. bind '\t' {electUpper "\t"} "SQL"
  116. bind '\r' {electUpper "\r"} "SQL"
  117. bind '\;' {electUpper "\;"} "SQL"
  118.  
  119. proc SQLMarkFile {} {
  120.     global SQLmodeVars
  121.     set pos 0
  122.     while {![catch {search -f 1 -r 1 -m 0 -i 0 $SQLmodeVars(funcExpr) $pos} res]} {
  123.         set start [lindex $res 0]
  124.         set end [lindex $res 1]
  125.         set text [lindex [getText $start $end] 1]
  126.         set pos $end
  127.         set inds($text) "$start $end"
  128.     }
  129.     
  130.     if {[info exists inds]} {
  131.         foreach f [lsort [array names inds]] {
  132.             setNamedMark $f [lineStart [lineStart [lindex $inds($f) 0]] - 1] [lindex $inds($f) 0] [lindex $inds($f) 1]
  133.         }
  134.     }
  135. }