home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / incoming / jstools-.6v3 / jstools- / jstools-tk3.6v3.0 / lib / jfindpanel.tcl < prev    next >
Encoding:
Text File  |  1995-02-09  |  9.2 KB  |  310 lines
  1. # jfindpanel.tcl - `find' panel for text widgets
  2. # 
  3. # Copyright 1992-1994 by Jay Sekora.  All rights reserved, except 
  4. # that this file may be freely redistributed in whole or in part 
  5. # for non-profit, noncommercial use.
  6. # 
  7. # 
  8. # these procedures are required by (at least)
  9. #     browser.tk
  10. #     edit.tk
  11. #     help.tk
  12. #     more.tk
  13. #     people.tk
  14. ######################################################################
  15.  
  16. ### TO DO
  17. ###   have find wrap around (if last time didn't match)
  18. ###   regex search/replace
  19. ###   `find' tags instead of selection (set of buttons)
  20. ###   rewrite find routines to pass options instead of using globals
  21. ###     e.g. j:find:find_pattern -case 0 -regex 1 \
  22. ###            -backwards 0 -tag found {foo$} .main.t
  23.  
  24. ######################################################################
  25. # j:find ?options? t - search-and-replace panel for text widget t
  26. # option is:
  27. #   -replace (default 1)
  28. # if $replace, the replace box and buttons will be drawn, otherwise
  29. #   it'll only be a search panel
  30. ######################################################################
  31.  
  32. proc j:find {args} {
  33.   j:parse_args {{replace 1}}
  34.   
  35.   set t $args                ;# text widget to search in
  36.   global j_find
  37.   set j_find(widget) $t
  38.   append j_find(searchfor) {}        ;# make sure it's defined
  39.   append j_find(replacewith) {}        ;# make sure it's defined
  40.  
  41.   if {! [info exists j_find(backwards)]} {
  42.     set j_find(backwards) 0
  43.   }
  44.   if {! [info exists j_find(case)]} {
  45.     set j_find(case) 0
  46.   }
  47.   if {! [info exists j_find(regex)]} {
  48.     set j_find(regex) 0
  49.   }
  50.  
  51.   if [winfo exists .find] {
  52.     wm withdraw .find
  53.     wm deiconify .find            ;# just try to make it visible
  54.     focus .find.t.search.e        ;# and focus on the search field
  55.     return 0
  56.   }
  57.  
  58.   toplevel .find
  59.   wm title .find "Find Panel"
  60.   frame .find.t
  61.   j:variable_entry .find.t.search \
  62.     -label "Search for:" -variable j_find(searchfor)
  63.   j:variable_entry .find.t.replace \
  64.     -label "Replace with:" -variable j_find(replacewith)
  65.   frame .find.t.options
  66.   label .find.t.options.filler -text {} -width 16 -anchor e
  67.   checkbutton .find.t.options.backwards -relief flat -anchor w \
  68.     -text {Backwards} -variable j_find(backwards)
  69.   checkbutton .find.t.options.case -relief flat -anchor w \
  70.     -text "Case\255sensitive" -variable j_find(case)
  71.   checkbutton .find.t.options.regex -relief flat -anchor w \
  72.     -text "Regex" -variable j_find(regex)
  73.   set buttons(search) {
  74.     search Search
  75.       {
  76.         if {[j:find:find_pattern $j_find(searchfor) $j_find(widget)] == 0} {
  77.           j:alert -text "Not found."
  78.         }
  79.       }
  80.     }
  81.   set buttons(replace) {
  82.     replace Replace
  83.       {
  84.         j:find:replace $j_find(searchfor) $j_find(replacewith) $j_find(widget)
  85.         j:find:find_pattern $j_find(searchfor) $j_find(widget)
  86.       }
  87.     }
  88.   set buttons(replace_all) {
  89.     replace_all {Replace All}
  90.       {
  91.         j:find:replace_all $j_find(searchfor) $j_find(replacewith) \
  92.           $j_find(widget)
  93.       }
  94.     }
  95.   set buttons(cancel) {cancel Cancel {destroy .find}}
  96.  
  97.   if $replace {
  98.     j:buttonbar .find.b -default search -buttons [list \
  99.       $buttons(search) \
  100.       $buttons(replace) \
  101.       $buttons(replace_all) \
  102.       $buttons(cancel) \
  103.     ]
  104.   } else {
  105.     j:buttonbar .find.b -default search -buttons [list \
  106.       $buttons(search) \
  107.       $buttons(cancel) \
  108.     ]
  109.   }
  110.   
  111.   j:tab_ring .find.t.search.e .find.t.replace.e
  112.   
  113.   pack .find.t.options.filler -side left -fill both
  114.   pack \
  115.     .find.t.options.backwards \
  116.     [j:filler .find.t.options] \
  117.     .find.t.options.case \
  118.     [j:filler .find.t.options] \
  119.     .find.t.options.regex \
  120.     -side left -fill y
  121.   
  122.   pack [j:filler .find.t] -side top
  123.   pack .find.t.search -side top -expand yes -fill x
  124.   if $replace {
  125.     pack [j:filler .find.t] -side top
  126.     pack .find.t.replace -side top -expand yes -fill x
  127.   }
  128.   pack .find.t.options -side top -expand yes -fill both
  129.   pack .find.t -side top -fill both -padx 10 -pady 5
  130.   pack [j:rule .find] -side top -fill x
  131.   pack .find.b -side bottom -fill x
  132.  
  133.   # Meta-g (or Return, below) in either field searches:
  134.   bind .find.t.search.e <Meta-g> \
  135.     {.find.b.search invoke}
  136.   bind .find.t.replace.e <Meta-g> \
  137.     {.find.b.search invoke}
  138.  
  139.   j:default_button .find.b.search .find.t.search.e .find.t.replace.e
  140.   j:cancel_button .find.b.cancel .find.t.search.e .find.t.replace.e
  141.  
  142.   focus .find.t.search.e
  143. }
  144.  
  145. ######################################################################
  146. # j:find:again t - search again for same string
  147. ######################################################################
  148.  
  149. proc j:find:again {t} {
  150.   global j_find
  151.   append j_find(searchfor) {}            ;# make sure it's defined
  152.   set j_find(widget) $t
  153.  
  154.   if {$j_find(searchfor) == {}} {
  155.     j:find $t
  156.   } else {
  157.     if {[j:find:find_pattern $j_find(searchfor) $t] == 0} {
  158.       j:alert -text "Not found."
  159.     }
  160.   }
  161. }
  162.  
  163. ######################################################################
  164. # j:find:find_pattern string t - find and select string in text widget t
  165. ######################################################################
  166. # WARNING: since this takes a copy of the file, it could use a LOT
  167. # of memory!
  168. # should be rewritten to use a different mark than insert.
  169.  
  170. proc j:find:find_pattern { string t } {
  171.   global j_find                ;# text widget to search in
  172.   set j_find(widget) $t
  173.   append j_find(searchfor) {}        ;# make sure it's defined
  174.   append j_find(replacewith) {}        ;# make sure it's defined
  175.  
  176.   if {! [info exists j_find(backwards)]} {
  177.     set j_find(backwards) 0
  178.   }
  179.   if {! [info exists j_find(case)]} {
  180.     set j_find(case) 0
  181.   }
  182.   if {! [info exists j_find(regex)]} {
  183.     set j_find(regex) 0
  184.   }
  185.  
  186.   # don't bother looking for the null string:
  187.   if {$string == {}} {
  188.     return 0                ;# return 0 if null string
  189.   }
  190.   
  191.   if $j_find(regex) {
  192.     if $j_find(backwards) {
  193.       j:alert -text "Backwards regex searches not yet implemented."
  194.       return 0
  195.     } else {                ;# forwards:
  196.       set text [$t get insert end]
  197.       if $j_find(case) {        ;# case-sensitive:
  198.         set countfrom insert
  199.         if [regexp -indices -- $string $text range] {
  200.           set foundpos [lindex $range 0]
  201.           set lastpos [expr [lindex $range 1] + 1]
  202.         } else {
  203.           set foundpos -1
  204.         }
  205.       } else {                ;# not case-sensitive:
  206.         set countfrom insert
  207.         if [regexp -nocase -indices -- $string $text range] {
  208.           set foundpos [lindex $range 0]
  209.           set lastpos [expr [lindex $range 1] + 1]
  210.         } else {
  211.           set foundpos -1
  212.         }
  213.       }
  214.     }
  215.   } else {
  216.     if $j_find(backwards) {
  217.       set lastfirst last
  218.       set textpart [$t get 0.0 {insert -1char}]
  219.       set countfrom 0.0
  220.     } else {
  221.       set lastfirst first
  222.       set textpart [$t get insert end]
  223.       set countfrom insert
  224.     }
  225.   
  226.     if {!$j_find(case)} {
  227.       set string [string tolower $string]
  228.       set textpart [string tolower $textpart]
  229.     }
  230.     set foundpos [string $lastfirst $string $textpart]
  231.     # find length of selection:
  232.     set lastpos [expr {$foundpos + [string length $string]}]
  233.   }
  234.   if {$foundpos == -1} then {
  235.     return 0                ;# return 0 if not found
  236.   }
  237.   # deselect any already-selected text:
  238.   catch {$t tag remove sel sel.first sel.last}
  239.   $t tag add sel \
  240.     "$countfrom + $foundpos chars" "$countfrom + $lastpos chars"
  241.   # move insert just after the match (so we can continue from there)
  242.   j:text:move $t "$countfrom + $lastpos chars"
  243.   return 1                ;# return 1 if found
  244. }
  245.  
  246. ######################################################################
  247. # j:find:replace from to t - replace selection in t with string
  248. ######################################################################
  249. # SHOULD CONFIRM THAT THE SELECTION IS IN t!
  250. # SHOULD CHECK THAT THE SELECTION MATCHES searchfor!
  251.  
  252. proc j:find:replace { searchfor replacewith t } {
  253.   global j_find
  254.   if [j:no_selection] {
  255.     return 0
  256.   }
  257.   if {! [info exists j_find(regex)]} {
  258.     set j_find(regex) 0
  259.   }
  260.   if $j_find(regex) {
  261.     return [j:find:replace_regexp $searchfor $replacewith $t]
  262.   } else {
  263.     j:text:replace $t sel.first sel.last $replacewith
  264.     return 1
  265.   }
  266. }
  267.  
  268. ######################################################################
  269. # j:find:replace_regexp from to t - regexp (search-and-)replace 
  270. #   selection in t with $to
  271. ######################################################################
  272. # SHOULD CONFIRM THAT THE SELECTION IS IN T!
  273. # SHOULD CHECK THAT THE SELECTION MATCHES searchfor!
  274.  
  275. proc j:find:replace_regexp { searchfor replacewith t } {
  276.   if [j:no_selection] {
  277.     return 0
  278.   }
  279.   if {! [info exists j_find(case)]} {
  280.     set j_find(case) 0
  281.   }
  282.   set searchstring [$t get sel.first sel.last]
  283.   if $j_find(case) {
  284.     set regsub_result \
  285.       [regsub -- $searchfor $searchstring $replacewith newstring]
  286.   } else {
  287.     set regsub_result \
  288.       [regsub -nocase -- $searchfor $searchstring $replacewith newstring]
  289.   }
  290.   if $regsub_result {
  291.     j:text:replace $t sel.first sel.last $replacewith
  292.     return 1
  293.   } else {
  294.     return 0
  295.   }
  296. }
  297.  
  298. ######################################################################
  299. # j:find:replace_all from to t - change all from to to in widget t
  300. ### BUG: this and the other routines need to be rewritten not to use
  301. ### the "insert" mark
  302. ######################################################################
  303.  
  304. proc j:find:replace_all {from to t} {
  305.   j:text:move $t 0.0
  306.   while {[j:find:find_pattern $from $t]} {
  307.     j:find:replace $from $to $t
  308.   }
  309. }
  310.