home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 September (IDG) / Sep99.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / browserMode.tcl < prev    next >
Encoding:
Text File  |  1999-03-18  |  4.8 KB  |  179 lines  |  [TEXT/ALFA]
  1. #=============================================================================
  2. # Browser mode.
  3. # 
  4. # Alpha cannot do batch searches without this file
  5. #=============================================================================
  6.  
  7. alpha::mode Brws 1.0.2 dummyBrws 
  8.  
  9. Bind '\r'    gotoMatch  Brws
  10. Bind enter    gotoMatch  Brws
  11. ascii 0x3      gotoMatch  Brws
  12. Bind down     downBrowse Brws
  13. Bind up     upBrowse   Brws
  14. Bind 'n' <z>    downBrowse Brws
  15. Bind 'p' <z>    upBrowse   Brws
  16. ascii 0x20    downBrowse Brws
  17. ascii 0x8    upBrowse   Brws
  18. # this was below.  do we need it?
  19. Bind 'c' <Cz>    gotoMatch
  20.  
  21. proc dummyBrws {} {}
  22.  
  23. proc upBrowse {} {
  24.     set limit [nextLineStart [nextLineStart [minPos]]]
  25.     if {[pos::compare [getPos] > $limit]} {
  26.     set limit [pos::math [getPos] - 1]
  27.     }
  28.     select [lineStart $limit] [nextLineStart $limit]
  29. }
  30.  
  31. proc downBrowse {} {
  32.     set pos [getPos]
  33.     if {[pos::compare $pos < [nextLineStart [minPos]]]} {
  34.     set pos [nextLineStart [minPos]]
  35.     }
  36.     if {[pos::compare [nextLineStart $pos] != [maxPos]]} {
  37.     select [nextLineStart $pos] [nextLineStart [nextLineStart $pos]]
  38.     }
  39. }
  40.  
  41. proc nextPrevMatch {{dir 1} {wname "*Batch Find*"}} {
  42.     set wins [winNames]
  43.     set res [lsearch $wins $wname]
  44.     if {$res < 0} {
  45.     set res [lsearch -regexp $wins {\*.*\*}]
  46.     if {$res < 0} return
  47.     }
  48.     set win [lindex $wins $res]
  49.     bringToFront $win
  50.     if {$dir} {
  51.     downBrowse
  52.     } else {
  53.     upBrowse
  54.     }
  55.     gotoMatch
  56.     dispErr $win
  57. }
  58.  
  59. proc nextMatch {{wname "*Batch Find*"}} {
  60.     nextPrevMatch 1 $wname
  61. }
  62.  
  63. proc prevMatch {{wname "*Batch Find*"}} {
  64.     nextPrevMatch 0 $wname
  65. }
  66.  
  67. proc dispErr {{win "* Compiler Errors *"}} {
  68.     if {[string length $win]} {
  69.     set text [getText -w $win [getPos -w $win] [selEnd -w $win]]
  70.     if {[regexp {(Line.*)∞} $text dummy sub]} {
  71.         message "$sub"
  72.     }
  73.     }
  74. }
  75.         
  76.  
  77. ##############################################################################
  78. #  To be used in the windows created by "matchingLines" or by batch searches.
  79. #
  80. #  With the cursor positioned in a line corrsponding to a match, 
  81. #  go back and select the line in the original file that 
  82. #  generated this match.  (Like emacs 'Occur' functionality)
  83. #
  84. #  97-08-01 Now doesn't ask if you want a new copy of windows with <n>.
  85. #           Wrap dialog also skipped.
  86. proc gotoMatch {} {
  87.     if {[string match "*MAILBOX*" [win::CurrentTail]]} {
  88.     mailGotoMatch
  89.     return
  90.     }
  91.     global tileHeight tileWidth tileTop tileLeft tileHeight \
  92.       errorHeight errorDisp tileMargin
  93.     set text [getText [lineStart [getPos]] \
  94.       [pos::math [nextLineStart [getPos]] - 1]]
  95.     set ind1 [string first "∞" $text]
  96.     set ind2 [string last "∞" $text]
  97.     if {$ind1 == $ind2} {
  98.     set fname [string trim [string range $text $ind1 end] {∞}]
  99.     set msg ""
  100.     } else {
  101.     set fname [string trim [string range $text $ind1 $ind2] {∞}]
  102.     set msg [string trim [string range $text $ind2 end] {∞}]
  103.     }
  104.     
  105.     set top $tileTop
  106.     set geo [getGeometry]
  107.     if {([lindex $geo 0] != $tileLeft) || ([lindex $geo 1] != $top) \
  108.       || ([lindex $geo 3] != $errorHeight) } {
  109.     moveWin $tileLeft $top
  110.     sizeWin $tileWidth $errorHeight
  111.     }
  112.     set mar $tileMargin
  113.     incr top [expr {$errorHeight + $mar}]
  114.     if {[file exists $fname]} {
  115.     edit -c -w -g $tileLeft $top $tileWidth $errorDisp $fname
  116.     set geo [getGeometry]
  117.     if {([lindex $geo 0] != $tileLeft) || ([lindex $geo 1] != $top) \
  118.       || ([lindex $geo 2] != $tileWidth) || ([lindex $geo 3] != $errorDisp) } {
  119.         sizeWin $tileWidth $errorDisp
  120.         moveWin $tileLeft $top
  121.     }
  122.     } else {
  123.     if {![string match "*Link*" \
  124.       [getText [minPos] [nextLineStart [minPos]]]]} {
  125.         alertnote "File \" $fname \" not found." 
  126.     }
  127.     return
  128.     }
  129.     if {[regexp {Line ([0-9]+):} $text dummy line]} {
  130.     set pos [rowColToPos $line 0]
  131.     select $pos [nextLineStart $pos]
  132.     }
  133.     message $msg
  134. }
  135.  
  136. set lastMatchingLines ""
  137.  
  138. proc matchingLines {{reg ""} {for 1} {ign 1} {word 0} {regexp 1}} {
  139.     global lastMatchingLines
  140.     
  141.     if {![string length $reg] && \
  142.       [catch {prompt "Regular expression:" $lastMatchingLines} reg]} return
  143.     set lastMatchingLines $reg
  144.     if {![string length $reg]} return
  145.     if {!$regexp} {
  146.     set reg [quote::Regfind $reg]
  147.     }
  148.     if {$word} {
  149.     set reg "^.*\\b$reg\\b.*$"
  150.     } else {
  151.     set reg "^.*$reg.*$"
  152.     }
  153.     set pos [expr {$for ? [minPos] : [getPos]}]
  154.     set fileName [stripNameCount [win::Current]]
  155.     set matches 0
  156.     set lines {}
  157.     while {![catch {search -s -f 1 -r 1 -i $ign -- $reg $pos} mtch]} {
  158.     regsub -all "\t" [eval getText $mtch] "  " text
  159.     append lines "\r" [format "Line %d: " \
  160.       [lindex [posToRowCol [lindex $mtch 0]] 0]] \
  161.       $text \
  162.       "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\
  163.       \t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fileName"
  164.     set pos [lindex $mtch 1]
  165.     incr matches
  166.     }
  167.     if {$matches} {
  168.     grepsToWindow {* Matching Lines *} \
  169.       [format "%d matching lines (<cr> to go to match)\r-----" $matches] \
  170.       $lines "\r"
  171.     } else {
  172.     beep
  173.     message "No matches found."
  174.     }
  175. }
  176.  
  177.  
  178.  
  179.