[Sarnold] (2006 09 17) A [GUI] for advanced interactive search and replace with [regular expressions].
[forward-compatible dict] implementation is included in it.

If people are interessed, I will put it into the [tcllib] repository (tkapps).
----
	package require Tcl 8.4
	package require Tk 8.4
	# ATTENTION PLEASE!
	catch {package require dict}
	# Poor man's dict -- a pure tcl [dict] emulation
	# Very slow, but complete.
	#
	# Not all error checks are implemented!
	# e.g. [dict create odd arguments here] will work
	#
	# Implementation is based on lists, [array set/get]
	# and recursion

	if {![llength [info commands dict]]} {
	    proc dict {cmd args} {
		uplevel 1 [linsert $args 0 _dict_$cmd]
	    }
	    proc _dict_get {dv args} {
	        if {![llength $args]} {return $dv} else {
	            array set dvx $dv
	            set key [lindex $args 0]
	            set dv $dvx($key)
	            set args [lrange $args 1 end]
	            return [eval [linsert $args 0 _dict_get $dv]]
	        }
	    }
	    proc _dict_exists {dv key args} {
	        array set dvx $dv
	        set r [info exists dvx($key)]
	        if {!$r} {return 0}
	        if {[llength $args]} {
	            return [eval [linsert $args 0 _dict_exists $dvx($key) ]]
	        } else {return 1}
	    }
	    proc _dict_set {dvar key value args } {
	        upvar 1 $dvar dv
	        if {![info exists dv]} {set dv [list]}
	        array set dvx $dv
	        if {![llength $args]} {
	            set dvx($key) $value
	        } else {
	            eval [linsert $args 0 _dict_set dvx($key) $value]
	        }
	        set dv [array get dvx]
	    }
	    proc _dict_unset {dvar key args} {
	        upvar 1 $dvar mydvar
	        if {![info exists mydvar]} {return}
	        array set dv $mydvar
	        if {![llength $args]} {
	            if {[info exists dv($key)]} {
	                unset dv($key)
	            }
	        } else {
	            eval [linsert $args 0 _dict_unset dv($key) ]
	        }
	        set mydvar [array get dv]
	        return {}
	    }
	    proc _dict_keys {dv {pat *}} {
	        array set dvx $dv
	        return [array names dvx $pat]
	    }
	    proc _dict_append {dvar key {args}} {
	        upvar 1 $dvar dv
	        if {![info exists dv]} {set dv [list]}
	        array set dvx $dv
	        eval [linsert $args 0 append dvx($key) ]
	        set dv [array get dvx]
	    }
	    proc _dict_create {args} {
	        return $args
	    }
	    proc _dict_filter {dv ftype args} {
	        set r [list]
	        foreach {globpattern} $args {break}
	        foreach {varlist script} $args {break}

	        switch $ftype {
	            key {
	                foreach {key value} $dv {
	                    if {[string match $globpattern $key]} {
	                        lappend r $key $value
	                    }
	                }
	            }
	            value {
	                foreach {key value} $dv {
	                    if {[string match $globpattern $value]} {
	                        lappend r $key $value
	                    }
	                }
	            }
	            script {
	                foreach {Pkey Pval} $varlist {break}
	                upvar 1 $Pkey key $Pval value
	                foreach {key value} $dv {
			    if {[uplevel 1 $script]} {
	                        lappend r $key $value
	                    }
	                }
	            }
	            default {
	                error "Wrong filter type"
	            }
	        }
	        return $r
	    }
	    proc _dict_for {kv dict body} {
		uplevel 1 [list foreach $kv $dict $body]
	    }
	    proc _dict_incr {dvar key {incr 1}} {
	        upvar 1 $dvar dv
	        if {![info exists dv]} {set dv [list]}
	        array set dvx $dv
	        if {![info exists dvx($key)]} {set dvx($key) 0}
	        incr dvx($key) $incr
	        set dv [array get dvx]
	    }
	    proc _dict_info {dv} {
	        return "Dictionary is represented as plain list"
	    }
	    proc _dict_lappend {dvar key args} {
	        upvar 1 $dvar dv
	        if {![info exists dv]} {set dv [list]}
	        array set dvx $dv
	        eval [linsert $args 0 lappend dvx($key)]
	        set dv [array get dvx]
	    }
	    proc _dict_merge {args} {
	    foreach dv $args {
	        array set dvx $dv
	    }
	    array get dvx
	    }
	    proc _dict_replace {dv args} {
	        foreach {k v} $args {
	            _dict_set dv $k $v
	        }
	        return $dv
	    }
	    proc _dict_remove {dv args} {
	        foreach k $args {
	            _dict_unset dv $k
	        }
	        return $dv
	    }
	    proc _dict_size {dv} {
	        return [expr {[llength $dv]/2}]
	    }
	    proc _dict_values {dv {gp *}} {
	        set r [list]
	        foreach {k v} $dv {
	            if {[string match $gp $v]} {
	                lappend r $v
	            }
	        }
	        return $r
	    }
	}

	proc Error {str} {
		tk_messageBox -message $str
		return -code return $str
	}

	proc SelectDir {varname} {
		upvar $varname d
		set d [tk_chooseDirectory -initialdir $d -title "Choose a directory"\
			-parent .opt]
	}

	proc main {} {
		toplevel .opt
		wm title .opt "Parameters"
		set row 1
	        set fr	.opt
		foreach key {dir filter search replace backup} desc {
			"Start directory" "File filter" "Search for" 
			"Replace with" "Create backup files"
		} {
		    if {![info exists ::t($key)]} {
		        set ::t($key) ""
		    }
		    switch -- $key {
		        dir {
			    label $fr.lb$row -text $desc
			    grid $fr.lb$row -row $row -column 0
			    set fri [frame $fr.f$row]
			    grid $fri -row $row -column 1
			    button $fri.ds -text Choose -command [list SelectDir ::t($key)]
			    entry $fri.en -textvariable ::t($key)
			    pack $fri.en $fri.ds -padx 5 -pady 5 -side left
			}
			backup {
			    checkbutton $fr.ck$row -text $desc -variable ::t($key)
			    set ::t($key) 1
			    grid $fr.ck$row -row $row -column 0
			}
			default {
			    label $fr.lb$row -text $desc
			    entry $fr.en$row -textvariable ::t($key)
			    grid $fr.lb$row -row $row -column 0
			    grid $fr.en$row -row $row -column 1
			}
		    }
		    eval grid configure [winfo children $fr] -padx 5 -pady 5 
		    incr row
		}
		set fr [frame .opt.cmd]
		button $fr.val -text Proceed -command execute
		button $fr.exit -text Abort -command abort
		pack $fr.val $fr.exit -side left -padx 10 -pady 10
		grid $fr -row $row -column 0 -columnspan 2
		focus .opt
		lower .
		raise .opt
	}

	proc abort {} {
	    if {[tk_messageBox -type yesno -message "Do you really want to exit?"]} {
		global FILE
		file delete -force $FILE
		exit 0
	    }
	}

	proc execute {} {
		destroy .opt
		raise .
		focus -force .
		# re-active all buttons
		butstate normal
		set opts [eval dict create [array get ::t]]
		if {![file isdirectory [dict get $opts dir]]} {
			Error "[dict get $opts dir] is not a valid directory"
		}
		dict for {k v} $opts {if {$k ne "replace" && $v eq ""} {Error "Empty $k parameter"}}

		if {![dict get $opts backup] &&
		    ![tk_messageBox -type yesno -message \
		    "Files will not be saved as backup files.\nCheck you already did the backup.\nDo you want to continue?"]} {
		    main
		    return
		}

		# Create the substitution proc (regexps are compiled, thus faster)
		set search [dict get $opts search]
		set replace [dict get $opts replace]
		proc Replace {line} [string map [list SRCH $search REPL $replace] {
			if {![regexp -indices -line -- {SRCH} $line location]} {return [list $line]}
			foreach {b e} $location {break}
			# three parts of the string : before, at, and after the match
			set result [list [string range $line 0 [expr {$b-1}]]\
				[string range $line $b $e] [string range $line [expr {$e+1}] end]]
			# append the subst'd string
			lappend result [regsub -line -- {SRCH} [lindex $result 1] {REPL}]
		}]
		if {[catch {Replace ""} msg]} {
		    Error "Invalid search/replace pattern pair:\n$msg"
		}
		directory $opts
		butstate disabled
		if {[tk_messageBox -type yesno \
		-message "Operation completed\nDo you want to exit ?"]} {
			exit
		}
		main
	}
	proc fcontext {opts} {
		set dir [dict get $opts dir]
		set context [dict create dirs "" files ""]
		if {[catch {set flist [lsort [glob $dir/*]]}]} {
			# no more files
			return $context
		}
		set filter [dict get $opts filter]
		foreach f $flist {
		    if {[file isdirectory $f]} {
			dict lappend context dirs $f
		    }
		}
		foreach f [glob -nocomplain $dir/$filter] {
		    if {![file isdirectory $f]} {
			dict lappend context files $f
		    }
		}
		return $context
	}

	proc ScrollOpen {path} {
		global ROWNUM
		set res [dict create path $path fd [set fd [open $path]]\
		cache "" now -1 clen 0]
		while {![eof $fd] ||
		[dict get $res clen] == $ROWNUM} {
			dict lappend res cache [gets $fd]
			dict incr res clen
		}
		return $res
	}

	proc ScrollEof {in} {
		set fd [dict get $in fd]
		if {[dict get $in now] >= [dict get $in clen] - 1} {return yes}
		return no
	}

	proc ScrollClose {in} {
		close [dict get $in fd]
	}

	proc ScrollGets {in} {
		global ROWNUM
		set fd [dict get $in fd]
		if {[dict get $in now] <= $ROWNUM/2} {
			# head of the file or window larger than the file
			dict incr in now
		} elseif {![eof $fd]} {
			# middle of the file
			set cache [lrange [dict get $in cache] 1 end]
			lappend cache [gets $fd]
			dict set $in cache $cache
		} else {
			# end of the file
			dict incr in now
		}
		return [list [lindex [dict get $in cache] [dict get $in now]] $in]
	}

	proc File {path opts} {
		ShowFile $path $opts
		global STATUS FILE
		set STATUS proceed
		
		if {[dict get $opts backup]} {
		    if {[catch {file copy -force $path $path.bak}]} {   
			Error "cannot write $path.bak"
		    }
		}
		# open the chosen file
		# ScrollOpen/Close/Gets keeps into a dict
		# a view of 25 lines of code, with a cache
		# that anticipates reading file
		set in [ScrollOpen $path]
		# open a temporary file to write modified content to it
		set out [open [dict get $FILE TMP] w]
		set STATUS ""
		set previous [list]
		# store whether the file has been modified or not
		set changed no
		while {![ScrollEof $in]} {
		    foreach {line in} [ScrollGets $in] {break}
		    set search [dict get $opts search]
		    if {[regexp -line -- $search $line]} {
		        set newline [ShowReplace $in $line]
			if {![string equal $newline $line]} {
			    # the file has been modified
			    set changed yes
			}
		        switch -- $STATUS {
			    eof -
			    parentdir -
			    eod {
				ScrollClose $in
				close $out
				return
			    }
			    default {
				puts $out $line
			    }
			}
		    } else {
			puts $out $line
		    }
		}
		close $out
		ScrollClose $in
		if {$changed} {
		    if {[catch {file copy -force [dict get $FILE TMP] $path} err]} {
			Error "Cannot write result into $path:\n$err"
		    }
		}
	}

	proc ShowReplace {in line} {
		global STATUS
		set chunks [Replace $line]
		set outline [lindex $chunks 0]
		while {[llength $chunks] == 4} {
			ShowMatchingPiece $chunks $in
			if {$STATUS ne "auto"} {
				tkwait variable STATUS
			}
			switch -- $STATUS {
				eof -
				parentdir -
				eod {
					return ""
				}
				auto -
				proceed {
					append outline [lindex $chunks 3]
				}
				cancel {
					append outline [lindex $chunks 1]
				}
			}
			set chunks [Replace [lindex $chunks 2]]
			append outline [lindex $chunks 0]
			lset chunks 0 $outline
		}
		return $outline
	}

	proc ShowMatchingPiece {chunks in} {
		.snap delete 0.0 end
		.snap delete end
		global ROWNUM COLNUM
		set now [dict get $in now]
		set cache [dict get $in cache]
		set before [Align [lrange $cache 0 [expr {$now-1}]] $COLNUM]
		set after [Align [lrange $cache [expr {$now+1}] end] $COLNUM]
		set now [expr {[string length [concat $chunks]]/$COLNUM}]
		if {$now > $ROWNUM} {
			.snap insert 0 "Line too long"
			return
		}
		foreach {head match end replace} $chunks {break}
		set linesbefore [expr {($ROWNUM - $now)/2}]
		set linesafter  [expr {$ROWNUM - $now - $linesbefore}]
		set before [lrange $before end-[expr {2*$linesbefore-1}] end]
		set after [lrange $after 0 [expr {2*$linesafter-1}]]
		foreach {type line} $before {
			puts $type,$line,before
			.snap insert end $line\n $type
		}
		.snap insert end $head line
		.snap insert end $match match
		.snap insert end $replace replace
		.snap insert end $end\n line
		foreach {type line} $after {
			puts $type,$line,after
			.snap insert end $line\n $type
		}
		interp alias {} snaptag {} .snap tag configure
		snaptag match -overstrike yes -background #f88
		snaptag replace -background #8f8
		snaptag line -background #ee8
		snaptag newline -background #ccf
		snaptag next -background #eef
		update
	}

	proc Align {lines colnum} {
		set r ""
		foreach l $lines {
			lappend r newline
			if {$l eq ""} {lappend r ""}
			while {$l ne ""} {
				lappend r [string range $l 0 [incr colnum -1]]
				set l [string range $l [incr colnum] end]
				if {$l ne ""} {lappend r next}
			}
		}
		return $r
	}

	proc directory {opts} {
		global STATUS
		set d [dict get $opts dir]
		if {![dict exists $opts level]} {
			dict set opts level 0
		} else {
			dict incr opts level
		}
		ShowDir $opts
		set fcontext [fcontext $opts]
		foreach d [dict get $fcontext dirs] {
			dict set opts dir $d
			directory $opts
		}
		dict incr opts level
		foreach f [dict get $fcontext files] {
			File $f $opts
			if {$STATUS eq "eod"} {return}
			if {$STATUS eq "parentdir"} {return -code return}
		}
		return
	}

	proc ftext {level dir} {
		set t ""
		if {$level>0} {
			set t +
			incr level -1
		}
		set t [string repeat | $level]$t$dir
		global COLNUM
		set l [string length $t]
		if {$l > $COLNUM} {
			set t [string range $t 0 [expr {$COLNUM - 4}]]...
		}
		return $t
	}

	proc ShowDir {data} {
		global COLNUM
		set dirname [lindex [file split [dict get $data dir]] end]
		set t [ftext [dict get $data level] "$dirname/ (directory)"]
		.p.progress insert end \n$t
		.p.progress see end
		update
	}

	proc ShowFile {path data} {
		global COLNUM
		set t [ftext [dict get $data level] [file tail $path]]
		.p.progress insert end \n$t
		.p.progress see end
		update
	}

	foreach {p status} {
	    ExecuteOneChange proceed
	    CancelOneChange cancel
	    ExecuteAllChanges auto
	    SkipFile eof
	    SkipDir eod
	    SkipParentDir parentdir
	} {
	    interp alias {} $p {} set ::STATUS $status
	}

	proc buildGUI {} {
		global COLNUM ROWNUM
		set font [font create -family Courier -size 8]
		text .snap -width $COLNUM -height $ROWNUM -font $font;# -state disabled
		frame .p
		text .p.progress -width $COLNUM -height 8 -yscrollcommand {.p.scroll set}\
			-font $font
	#		-state disabled
		scrollbar .p.scroll -command {.p.progress yview}
		pack .snap .p
		grid .p.progress .p.scroll -sticky nsew
		frame .f -pady 10
		button .f.ex -text "Change" -command ExecuteOneChange
		button .f.can -text "Don't Change Here" -command CancelOneChange
		button .f.exa -text "Change all" -command ExecuteAllChanges
		button .f.sk -text "Skip File" -command SkipFile
		button .f.skd -text "Skip Current Directory" -command SkipDir
		button .f.skpd -text "Skip Parent Directory" -command SkipParentDir
		button .f.quit -text Abort -command abort
		button .f.new -text "New session" -command main
		pack .f
		pack .f.ex .f.can .f.exa .f.sk .f.skd .f.skpd .f.quit -side left -padx 10
	}
	set COLNUM 90
	set ROWNUM 25
	package require fileutil
	set FILE [dict create TMP [::fileutil::tempfile tsreplace]]
	set STATUS begin
	wm title . "Tcl Star Replace v0.1.2"
	buildGUI
	proc butstate {newstate} {
		foreach b {.f.ex .f.can .f.exa .f.sk .f.skd .f.skpd} {$b configure -state $newstate}
	}
	butstate disabled
	main

----
''20061224'' [Sarnold] updated to v0.1.1.

[RT] looks quite useful, I tried a "no-op" where the pattern wasn't found
and it still modified all the files. That behavior was an unwelcome surprise.

[Sarnold] Do you mean: the files were modified, but held the same content? I am a bit curious to know what
pattern you did use...[RT] I mean the files all had their modification date changed to the current minute, which
I suppose means they were all re-written. The contents didn't change. I used a nonsense pattern like 
s/monkeybait/monkeymeat and the pattern had no hits.

[Sarnold] Fixed... and moved to v0.1.2.
----
[[ 
[Category Dev. Tools] | 
[Category File] |
[Category GUI] | 
[Category String Processing] |
[Category Whizzlet] 
]]