home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / indentation.tcl < prev    next >
Encoding:
Text File  |  1997-12-11  |  12.5 KB  |  451 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #    Vince's    Additions -    an extension package for Alpha
  4.  # 
  5.  #    FILE: "indentation.tcl"
  6.  #                                      created: 27/7/97 {1:08:08 am}    
  7.  #                                  last update: 11/12/97 {7:51:32 pm}    
  8.  #    Author:    Vince Darley
  9.  #    E-mail:    <darley@fas.harvard.edu>
  10.  #      mail:    Division of    Applied    Sciences, Harvard University
  11.  #            Oxford Street, Cambridge MA    02138, USA
  12.  #       www:    <http://www.fas.harvard.edu/~darley/>
  13.  #    
  14.  # ###################################################################
  15.  ##
  16.  
  17. namespace eval indent {}
  18. namespace eval bind {}
  19. namespace eval text {}
  20.  
  21. proc indentLine {} { bind::IndentLine }
  22.  
  23. proc typeText {t} {
  24.     if [isSelection] {
  25.         deleteSelection
  26.     }
  27.     insertText $t
  28. }
  29.  
  30. proc normalLeftBrace {} {
  31.     typeText "\{"
  32. }
  33. proc normalRightBrace {} {
  34.     typeText "\}"
  35.     blink [matchIt "\}" [pos::math [getPos] - 2]]
  36. }
  37.             
  38. proc literalChar {} {
  39.     return [expr {[lookAt [pos::math [getPos] - 1]] == "\\"}]
  40. }
  41.  
  42. # ◊◊◊◊ Electric indentation ◊◊◊◊ #
  43. proc bind::LeftBrace {} {
  44.     if [isSelection] { deleteSelection }
  45.     global elecLBrace mode
  46.     if {![info exists elecLBrace] || !$elecLBrace} {
  47.         insertText "\{"
  48.         return
  49.     }
  50.     if {![catch {mode::proc electricLeft}]} {return}
  51.     if {![catch {search -l [lineStart [pos::math [lineStart [getPos]] - 1]] \
  52.       -s -f 0 -r 0 "\}" [getPos]} res]} {
  53.         set end [getPos]
  54.         if {[pos::compare [getPos] != [maxPos]]} {
  55.             incr end
  56.         }
  57.         
  58.         if {[regexp {\}[ \t\r\n]*else} [getText [lindex $res 0] $end]]} {
  59.             set res2 [search -s -f 0 -r 1 {else} [getPos]]
  60.             oneSpace
  61.             set text [getText [lindex $res2 0] [getPos]]
  62.             if {[lookAt [pos::math [getPos] - 1]] != " "} {
  63.                 append text " "
  64.             }
  65.             replaceText [pos::math [lindex $res 0] + 1] [getPos] " $text\{\r"
  66.             bind::IndentLine
  67.             return 
  68.         }
  69.     }
  70.     set pos [getPos]
  71.     set i [text::firstNonWsLinePos $pos]
  72.     if {([pos::compare $i == $pos]) || ([lookAt [pos::math $pos - 1]] == " ")} {
  73.         insertText "\{\r" [text::indentString $pos] "\t"
  74.     } else {
  75.         insertText " \{\r" [text::indentString $pos] "\t"
  76.     }
  77. }
  78.  
  79. proc bind::RightBrace {} {
  80.     if [isSelection] { deleteSelection }
  81.     global elecRBrace mode
  82.     if {![info exists elecRBrace] || !$elecRBrace} {
  83.         insertText "\}"
  84.         catch {blink [matchIt "\}" [pos::math [getPos] - 2]]}
  85.         return
  86.     }
  87.     if {![catch {mode::proc electricRight}]} {return}
  88.     set pos [getPos]
  89.     set start [lineStart $pos]
  90.     
  91.     if {[catch {matchIt "\}" [pos::math $pos - 1]} matched]} {
  92.         beep
  93.         message "No matching '\{'!"
  94.         return
  95.     }
  96.     set text [getText [lineStart $matched] $matched]
  97.     regexp {^[     ]*} $text indentation
  98.     if {[string trim [getText $start $pos]] != ""} {
  99.         insertText "\r" $indentation "\}\r" $indentation
  100.         blink $matched
  101.         return
  102.     }
  103.     set text "${indentation}\}\r$indentation"
  104.     replaceText $start $pos $text
  105.     goto [pos::math $start + [string length $text]]
  106.     blink [matchIt "\}" [pos::math $start - 2]]
  107. }
  108.  
  109. proc bind::electricSemi {} {
  110.     if [isSelection] { deleteSelection }
  111.     global electricSemi mode
  112.     if {![info exists electricSemi] || !$electricSemi} {
  113.         insertText ";"
  114.         return
  115.     }
  116.     if {![catch {mode::proc electricSemi}]} {return}
  117.     set pos [getPos]
  118.     set start [lineStart $pos]
  119.     set text [getText $start $pos]
  120.     
  121.     if {[string first "for" $text] != "-1"} {
  122.         set paren 0
  123.         set len [string length $text]
  124.         for {set i 0} {$i < $len} {incr i} {
  125.             switch -- [string index $text $i] {
  126.                 "("    { incr paren }
  127.                 ")"    { incr paren -1 }
  128.             }
  129.         }
  130.         if {$paren != 0} {
  131.             insertText ";"
  132.             return
  133.         }
  134.     }
  135.     
  136.     insertText ";\r" [text::indentString $pos]
  137. }
  138.  
  139.  
  140. ## 
  141.  # -------------------------------------------------------------------------
  142.  #     
  143.  # "bind::CarriageReturn" --
  144.  #    
  145.  #    General    purpose    CR procedure.  Should be bound to 'return' for all 
  146.  #    modes really.  Calls a mode-specific procedure if required.
  147.  # -------------------------------------------------------------------------
  148.  ##
  149. proc bind::CarriageReturn {} {
  150.     if [isSelection] { deleteSelection }
  151.     if [text::isInComment [set p [getPos]] start] {
  152.         # special case for beginning of line
  153.         if {[pos::compare $p == [lineStart $p]]} {
  154.             backwardChar
  155.         }
  156.         insertText "\r${start}"
  157.         return
  158.     }
  159.     global mode
  160.     if [catch {mode::proc carriageReturn}] {
  161.         insertText "\r"
  162.         global indentOnCR
  163.         if $indentOnCR {bind::IndentLine}
  164.     }        
  165. }
  166.  
  167. proc bind::IndentLine {} {
  168.     global mode    
  169.     if [catch {mode::proc indentLine}] {
  170.         text::genericIndent
  171.     }    
  172. }
  173.  
  174. proc insertActualTab {} { typeText "\t" }
  175.  
  176. proc bind::_haveElectricColon {} {
  177.     global mode
  178.     global ${mode}modeVars
  179.     if [info exists ${mode}modeVars(electricColon)] {
  180.         return [set ${mode}modeVars(electricColon)]
  181.     } else {
  182.         return 0
  183.     }
  184. }
  185.  
  186.  
  187. ## 
  188.  # -------------------------------------------------------------------------
  189.  #     
  190.  # "text::isInComment" --
  191.  #    
  192.  #    Are    we in a    block comment?    Just checks    if both    the    given line and the
  193.  #    next line commence with    any    of a set of    known block-comment    characters.
  194.  #    Not 100% satisfactory for C comments, but fine for all others.
  195.  # -------------------------------------------------------------------------
  196.  ##
  197. proc text::isInComment {pos {st ""}} {
  198.     set p [lineStart $pos]
  199.     if {[pos::compare $pos == $p] && [pos::compare $p != 0]} { 
  200.         set pos [pos::math $pos - 1] ; set p [lineStart $pos] 
  201.     }
  202.     set q [nextLineStart $pos]
  203.     set t [getText $p $q]
  204.     if { $st != "" } {
  205.         upvar $st a
  206.     }
  207.     foreach commentCh [commentCharacters "General"] {    
  208.         if [regexp  "^\[ \t\]*[quote::Regfind ${commentCh}]\[ \t\]*" $t a] {
  209.             # if we hit return in the middle of a line
  210.             if {[string trim [getText $pos $q]] != "" && [pos::compare $pos != $p]} { 
  211.                 return 1
  212.             }
  213.             # if the next line is a comment 
  214.             if [catch {text::firstNonWsLinePos $q} qq] { return 0 }
  215.             if {[getText $qq [pos::math $qq + [string length $commentCh]]] == $commentCh} {
  216.                 return 1
  217.             }
  218.         }
  219.     }
  220.     return 0
  221. }
  222.  
  223.  
  224. # ◊◊◊◊ Indentation utility routines ◊◊◊◊ #
  225.  
  226. proc posX {pos} {return [lindex [posToRowCol $pos] 1] }
  227. # the above version doesn't work!  Need to ask Pete to fix it.
  228. proc posX {pos} {return [string length [text::maxSpaceForm [getText [lineStart $pos] $pos]]]}
  229.  
  230. proc text::firstNonWs {pos} {
  231.     set p [text::firstNonWsPos $pos]
  232.     if {[pos::compare $p > 0]} {
  233.         return [lookAt $p]
  234.     } else {
  235.         return ""
  236.     }
  237. }
  238.  
  239. ## 
  240.  # -------------------------------------------------------------------------
  241.  #   
  242.  # "text::firstNonWsPos" --
  243.  #  
  244.  #  This returns the position of the first non-whitespace character from
  245.  #  the start of pos' line.  It need not return something on the same
  246.  #  line.
  247.  # -------------------------------------------------------------------------
  248.  ##
  249. proc text::firstNonWsPos {pos} {
  250.     return [lindex [search -s -f 1 -r 1 {[^ \t\r]} [lineStart $pos]] 0]
  251. }
  252.  
  253. proc text::firstNonWsLinePos {pos} {
  254.     return [lindex [search -s -f 1 -r 1 {[^ \t]} [lineStart $pos]] 0]
  255. }
  256.  
  257. proc text::indentation {pos} {
  258.     return [search -s -m 0 -f 1 -r 1 {^[ \t]*[^ \t]} [lineStart $pos]]
  259. }
  260.  
  261. ## 
  262.  # -------------------------------------------------------------------------
  263.  # 
  264.  # "text::minSpaceForm" --
  265.  # 
  266.  #  Converts to minimal form: tabs then spaces.  Uses one regsub to do
  267.  #  the job.  Note that the regexp used relies upon the left-to-right
  268.  #  priority of branch matching.  If the regexp library used is more
  269.  #  sophisticated and finds maximal matches, then this is no good.
  270.  #  In that case use:
  271.  #        regsub -all $sp $ws "\t" ws
  272.  #        regsub -all " +\t" $ws "\t" ws
  273.  # -------------------------------------------------------------------------
  274.  ##
  275. proc text::minSpaceForm {ws} {
  276.     regsub -all "([spacesEqualTab]| +\t)" $ws "\t" ws
  277.     return $ws
  278. }
  279.  
  280. ## 
  281.  # -------------------------------------------------------------------------
  282.  # 
  283.  # "text::maxSpaceForm" --
  284.  # 
  285.  #  Converts it to maximal form - just spaces.
  286.  #  Just uses one funky regsub to do the job!  Takes account of tab-size,
  287.  #  spaces interspersed with tabs,...
  288.  # -------------------------------------------------------------------------
  289.  ##
  290. proc text::maxSpaceForm {ws} {
  291.     set sp [spacesEqualTab]
  292.     regsub -all "(($sp)*) *\t" $ws "\\1$sp" ws
  293.     return $ws
  294. }
  295.  
  296. ## 
  297.  # -------------------------------------------------------------------------
  298.  # 
  299.  # "spacesEqualTab" --
  300.  # 
  301.  #  Return the number of spaces equivalent to a single tab.
  302.  # -------------------------------------------------------------------------
  303.  ##
  304. proc spacesEqualTab {} {
  305.     getWinInfo a
  306.     string range "              " 1 $a(tabsize)
  307. }
  308.  
  309. proc doubleLookAt {pos} {return [getText $pos [pos::math $pos + 2]]}
  310.  
  311. set bind::_IndentSpaces "                       "
  312. set bind::_IndentTabs "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t"
  313.  
  314. proc text::indentOf {size} {
  315.     global bind::_IndentSpaces bind::_IndentTabs
  316.     getWinInfo a
  317.     set ret [string range ${bind::_IndentTabs} 1 [expr $size / $a(tabsize)]]
  318.     append ret [string range ${bind::_IndentSpaces} 1 [expr $size % $a(tabsize)]]
  319.     return $ret
  320. }
  321.  
  322. # returns the indent string of the line named by 'pos'
  323. proc text::indentString {pos} {
  324.     set beg [lineStart $pos]
  325.     set text [getText $beg [nextLineStart $beg]]
  326.     if [regexp {^[ \t]*} $text white] { return $white } else { return "" }
  327. }
  328.  
  329. # returns the indent string of the line named by 'pos'
  330. proc text::indentTo {pos} {
  331.     if [regexp {^[ \t]*} [getText [lineStart $pos] $pos] white] { return $white } else { return "" }
  332. }
  333.  
  334. proc text::halfTab {} {
  335.     global indent_amounts
  336.     return [string range "              " 1 $indent_amounts(1)]
  337. }
  338. proc text::Tab {} {
  339.     global indentationAmount
  340.     return [text::indentOf $indentationAmount]
  341. }
  342.  
  343. proc text::getTabSize {} {
  344.     getWinInfo a
  345.     return $a(tabsize)
  346. }
  347.  
  348. # ◊◊◊◊ General purpose indentation ◊◊◊◊ #
  349.  
  350. proc indentRegion {} {
  351.     global mode    
  352.     if {![catch {mode::proc indentRegion}]} {return}
  353.     simpleIndentRegion
  354. }
  355.  
  356. ##########################################################################
  357. #                                                                         #
  358. #    Stuff below    here is    largely    unchanged from Pete's "electric.tcl".     #
  359. #    I've just put it here so I can totally override    that file and make     #
  360. #    changes    more easily    myself.                                             #
  361. #                                                                         #
  362. ##########################################################################
  363.  
  364. proc simpleIndentRegion {} {
  365.     set from [lindex [posToRowCol [getPos]] 0]
  366.     set to [lindex [posToRowCol [selEnd]] 0]
  367.     select [getPos]
  368.     while {$from <= $to} {
  369.         goto [rowColToPos $from 0]
  370.         bind::IndentLine
  371.         incr from
  372.     }
  373. }
  374.  
  375. set PerlcommentRegexp {^[ \t]*#}
  376. set cCommentRegexp    {/\*([^*]|[^*]\/|\*[^\/]|\r)*\*/}
  377.  
  378. #########################################################################
  379. # Generic C-style indentation (works for Tcl and Perl)
  380. # Significant changes by Vince.
  381. proc text::genericIndent {} {
  382.     global mode 
  383.     global ${mode}commentRegexp cCommentRegexp
  384.     if {[info exists ${mode}commentRegexp]} {
  385.         set comPat [set ${mode}commentRegexp]
  386.     } else {
  387.         set comPat $cCommentRegexp
  388.     }
  389.     set comPat "($comPat|^\[ \t\]\t*$)"
  390.  
  391.     # get details of current line
  392.     set beg [lineStart [getPos]]
  393.     set text [getText $beg [nextLineStart $beg]]
  394.     regexp {^[ \t]*} $text white
  395.     set len [string length $white]
  396.     set epos [pos::math $beg + $len]
  397.  
  398.     # Find last previous non-comment line and get its leading whitespace
  399.     set pos $beg
  400.     set lst [search -s -f 0 -r 1 -i 0 -m 0 {^[ \t]*[^ \t\r]} [pos::math $pos - 1]]    
  401.     set line [getText [lindex $lst 0] [pos::math [nextLineStart [lindex $lst 0]] - 1]]
  402.     set lwhite [posX [pos::math [lindex $lst 1] - 1]]    
  403.     # Find the last preceding comment block
  404.     set prvPos [lindex $lst 0]
  405.     if {![catch {search -s -f 0 -r 1 -i 0 $comPat [pos::math $pos - 1]} lstCmt]} {
  406.         set begCmt [lindex $lstCmt 0]
  407.         set endCmt [lindex $lstCmt 1]
  408.         # If current non-blank line is in the comment...
  409.         while {[pos::compare $begCmt <= $prvPos] && [pos::compare $endCmt >= $prvPos]} {
  410.             # ...find the last non-blank line that precedes the comment block,
  411.             if {![catch {search -s -f 0 -r 1 -i 0 {^[ \t]*[^ \t\r]} [pos::math $begCmt - 1]} lst]} {    
  412.                 set prvPos [lindex $lst 0]
  413.                 set line [getText [lindex $lst 0] [pos::math [nextLineStart [lindex $lst 0]] - 1]]
  414.                 set lwhite [posX [pos::math [lindex $lst 1] - 1]]
  415.                 # ...and the next preceding comment block.
  416.                 if {![catch {search -s -f 0 -r 1 -i 0 $comPat [expr $prvPos]} lstCmt]} {
  417.                     set begCmt [lindex $lstCmt 0]
  418.                     set endCmt [lindex $lstCmt 1]
  419.                 } else {
  420.                     break
  421.                 }
  422.             } else {
  423.                 # Handle search failure at top-of-file
  424.                 set line "#"
  425.                 set lwhite 0
  426.                 break
  427.             }
  428.         }
  429.     }
  430.  
  431.     regexp {([^ \t])[ \t]*$} $line allofit nextC
  432.     global indentationAmount
  433.     if {($nextC == "\{")} {
  434.         incr lwhite $indentationAmount
  435.     } elseif {$nextC == ":" && [bind::_haveElectricColon]} {
  436.         incr lwhite [expr $indentationAmount /2]
  437.     }
  438.  
  439.     if {[regexp {:[ \t\r]*$} $text] && [bind::_haveElectricColon]} {incr lwhite [expr -$indentationAmount / 2]}
  440.     if {[lookAt $epos] == "\}"} {
  441.         incr lwhite [expr -$indentationAmount]
  442.     }
  443.     
  444.     set lwhite [text::indentOf $lwhite]
  445.     if {$white != $lwhite} {
  446.         replaceText $beg $epos $lwhite
  447.     }
  448.     goto [pos::math $beg + [string length $lwhite]]
  449. }
  450.  
  451.