A Find & Replace Dialog

Here's a procedure which takes a few parameters (at least a unique tk toplevel window name) and shows a dialog for Search & Replace-type operations:

 # 01.02.2010
 # ToDo:
 # - namespace

 proc sr {w args} {
      # eingebaute Defaults
      array set a {
         -command    {}
         -title      {Suchen & Ersetzen}
         -old        {}
         -new        {}
         -ignoreword 0
         -ignorecase 0
         -entryWidth 40
         -askempty   1
         -stay       0
      }
      array set a $args;# Fehler propagieren, kein Catch!

      toplevel $w
      if {[winfo viewable .]} {
         wm transient $w .; # [winfo parent] statt .?
      }
      wm withdraw $w
      wm title $w $a(-title)
      wm resizable $w 0 0; # wenn überhaupt, dann nur in x-Richtung (da Feldbreite fix)

      set wf1 [ttk::frame $w.txt -padding {4 8}]
      set wf2 [ttk::frame $w.but -padding {4 8}]
      set wf3 [ttk::labelframe $w.opt -padding {2 4} -text Optionen:]
      ttk::label $wf1.oldLbl -underline 0 -text "Suchen nach:"
      ttk::label $wf1.newLbl -underline 0 -text "Ersetzen durch:"
      ttk::entry $wf1.oldEntry -width $a(-entryWidth) -validate key \
       -validatecommand [list srVal $wf2.ok %P]
      ttk::entry $wf1.newEntry -width $a(-entryWidth)
      ttk::button $wf2.ok -width 10 -text "Start" -state disabled \
       -command [list srDo $w $a(-command) $a(-askempty) $a(-stay)]; # -default active
      ttk::button $wf2.quit -width 10 -text "Abbruch" -command [list destroy $w]
      ttk::checkbutton $wf3.word -text {Wortgrenzen ignorieren}  -underline 0
      ttk::checkbutton $wf3.case -text {Schreibweise ignorieren} -underline 1

      $wf1.oldEntry insert end $a(-old); # erspart uns globale -textvariable(n)
      $wf1.newEntry insert end $a(-new)

      grid $wf1.oldLbl   -column 0 -row 0 -sticky nse  -padx {4 4} -pady {8 0}
      grid $wf1.newLbl   -column 0 -row 1 -sticky nse  -padx {4 4} -pady {8 0}
      grid $wf1.oldEntry -column 1 -row 0 -sticky nsew -padx {4 4} -pady {8 0}
      grid $wf1.newEntry -column 1 -row 1 -sticky nsew -padx {4 4} -pady {8 0}
      grid $wf2.ok   -column 0 -row 0 -sticky nsew -padx {0 4} -pady {8 0}
      grid $wf2.quit -column 0 -row 1 -sticky nsew -padx {0 4} -pady {8 0}
      pack $wf3.word $wf3.case -side left -anchor nw
      grid $wf1 -column 0 -row 0 -sticky nsew -padx {4 4} -pady {4 0}
      grid $wf2 -column 1 -row 0 -sticky nsew -padx {4 4} -pady {4 4}
      grid $wf3 -column 0 -row 1 -sticky nsew -padx {12 12} -pady {0 12} -columnspan 2

      bind $w <Escape> "$wf2.quit invoke; break;"; # <Escape> ist *überall* 'Abbruch'
      bind $w <Return> "$wf2.ok   invoke; break;"; # <Return> ist *überall* 'Go!' (ausser auf Escape-Button)
      bind TButton <Return> "%W invoke; break;"; # alle Buttons führen sich mit <Return> aus
      bind $w <Alt-s>  "focus -force $wf1.oldEntry; break;"
      bind $w <Alt-e>  "focus -force $wf1.newEntry; break;"
      bind $w <Alt-w>  "$wf3.word invoke; break;"
      bind $w <Alt-c>  "$wf3.case invoke; break;"
      $wf3.word state !alternate
      $wf3.case state !alternate
      # geht das nicht eleganter???
      if {$a(-ignoreword)} {
         $wf3.word state selected
      }
      if {$a(-ignorecase)} {
         $wf3.case state selected
      }

      # Farbgebung wie früher korrigieren, nur gemäss Ttk-Systematik
      bind TButton <FocusIn>  {%W state  active}
      bind TButton <FocusOut> {%W state !active}

      catch {center_window $w}
      wm deiconify $w
      catch {tk visibility $w}
      focus -force $wf1.oldEntry;
      # die -stay-Option könnte als Checkbox exportiert werden
      if {!$a(-stay)} {
         catch {grab set $w}
      }
      catch {tkwait window $w}
 }

 proc srVal {b v} {
      # uns interessiert hier nur das Umschalten des Buttos
      if {[string length $v]} {
         $b configure -state normal
      } else {
         $b configure -state disabled
      }
      return 1
 }

 proc srDo {w command ask stay} {
      # vermeidet globale Vars
      set old [$w.txt.oldEntry get]
      set new [$w.txt.newEntry get]
      set igW [$w.opt.word instate selected]
      set igC [$w.opt.case instate selected]
      if {[string length $new] == 0 && $ask == 1} {
         if {[tk_messageBox -type yesno -title ACHTUNG: \
               -message "Die Zeichenkette '$old' wird *gelöscht* werden!
 Wirklich fortfahren (J/N)?" -icon warning] == "no"} {
            return
         }
      }
      catch {uplevel #0 [list $command $old $new $igW $igC $w]}
      if {$stay == 0} {
         destroy $w
      }
 }

Some little tests / demonstrations:

 #######################
 #
 # Demos
 #

 proc dummyCallback {args} {
      tk_messageBox -message "Dummy S/R-Aktion; args:= $args"
 }
 ttk::entry .e1 -width 40
 pack .e1
 bind .e1 <Control-f> [list sr .w1 -command dummyCallback]
 bind .e1 <Control-g> [list sr .w2 -command dummyCallback -stay 1 -old Datei -ignorecase 1]
 focus -force .e1

Some explanations (to be continued):

I don't know the "new" tile/ttk-widgets very well; therefore you may notice some odd constructs in my code.
I wanted to avoid the use of global vars (hence tkwait windows instead of tkwait variable, and no -textvariable options)
A callback can be specified via the -command-switch. This callback gets called with the old and new string values and some other args to perform the real search & replace operation. So this dialog is sort of generic.
For now, I'm using the german language in titles, names etc. sorry.
I've altered some bindings because I always come across the default behaviour of dialogs, e.g. if the CANCEL-Button has the focus, for me it's natural that hitting <Enter> then cancels the dialog, and nothing else.
This dialog (or its predecessor or successor) is in use by Phototools - Interactive Editing Of JPG-Comments, e.g.