--- /dev/null
+#! /usr/bin/wish
+
+# --- Configuration ---
+
+if {[info exists env(HOME)]} {
+ set home $env(HOME)
+} else {
+ set bin [info nameofexecutable]
+ if {[string compare $bin ""] == 0} {
+ set home "."
+ } else {
+ set home [file dirname $bin]
+ }
+}
+set conffile [list "/etc/anagrc" \
+ [file join $home "anagrc"]]
+if {[string compare "unix" $tcl_platform(platform)] == 0} {
+ lappend conffile [file join $home ".anagrc"]
+}
+set C_tags {anag wordlist}
+set C(anag) "@ANAG@"
+set C(wordlist) "@DICTIONARY@"
+
+foreach i $C_tags {
+ if {![info exists C($i)]} {
+ error "internal error: unset configuration option `$i'"
+ }
+}
+
+foreach f $conffile {
+ if {[catch { set fh [open $f] } err]} { continue }
+ while {[gets $fh line] >= 0} {
+ if {[regexp {^[[:space:]]*(\#|$)} $line]} continue
+ regexp {^\s*([[:alnum:]]\w*)\s*=?\s*(|.*\S)\s*$} $line - n v
+ set C($n) $v
+ }
+ close $fh
+ break
+}
+
+# --- Other setting up ---
+
+if {[string compare "windows" $tcl_platform(platform)] == 0} {
+ set exetypes {
+ {Executables {.exe} {}}
+ {All files {*} {}}
+ }
+} else {
+ set exetypes {}
+}
+
+# --- Handy subroutines ---
+
+proc wordlist {args} {
+ set l {}
+ foreach s $args {
+ while {![regexp {^\s*$} $s]} {
+ regexp {^\s*(\S+)(.*)$} $s - w s
+ lappend l $w
+ }
+ }
+ return $l
+}
+
+proc report {msg} {
+ tk_messageBox -type ok -icon error \
+ -title "Error from [wm title .]" -message $msg
+}
+
+# --- Options ---
+
+proc conf-copyout {} {
+ global C C_tags
+ foreach i $C_tags {
+ upvar \#0 C:$i c
+ set c $C($i)
+ }
+}
+
+proc conf-copyin {} {
+ global C C_tags
+ foreach i $C_tags {
+ upvar \#0 C:$i c
+ set C($i) $c
+ }
+}
+
+proc options {} {
+ global C C_tags tcl_platform home conffile
+
+ if {[winfo exists .opt]} {
+ raise .opt
+ return
+ }
+
+ toplevel .opt
+ wm title .opt "[wm title .] options"
+ conf-copyout
+
+ frame .opt.anag
+ label .opt.anag.l -text "Anagram solver binary: "
+ entry .opt.anag.e -textvariable C:anag
+ button .opt.anag.b -text "..." -command {
+ set C:anag [tk_getOpenFile -parent .opt \
+ -title "Anagram solver binary" -filetypes $exetypes \
+ -initialdir [file dirname ${C:anag}]]
+ }
+ pack .opt.anag.l -side left -padx 2 -pady 2
+ pack .opt.anag.e -side left -expand yes -fill x -padx 2 -pady 2
+ pack .opt.anag.b -side left -padx 2 -pady 2
+
+ frame .opt.wordlist
+ label .opt.wordlist.l -text "Wordlist file: "
+ entry .opt.wordlist.e -textvariable C:wordlist
+ button .opt.wordlist.b -text "..." -command {
+ set C:wordlist [tk_getOpenFile -parent .opt \
+ -title "Wordlist file" \
+ -initialdir [file dirname ${C:wordlist}]]
+ }
+ pack .opt.wordlist.l -side left -padx 2 -pady 2
+ pack .opt.wordlist.e -side left -expand yes -fill x -padx 2 -pady 2
+ pack .opt.wordlist.b -side left -padx 2 -pady 2
+
+ frame .opt.b
+ button .opt.b.cancel -text "Cancel" -command { destroy .opt }
+ button .opt.b.ok -text "OK" -command { conf-copyin; destroy .opt }
+ button .opt.b.save -default active -text "Save" -command {
+ set tf [lindex $conffile end]
+ if {[catch {
+ set date [clock format [clock seconds] -format "%Y-%m-%s %H:%M:%S"]
+ set fh [open "$tf.new" w]
+ puts $fh "# Anagram settings, written $date"
+ puts $fh ""
+ foreach n $C_tags {
+ upvar \#0 C:$n c
+ puts $fh "$n = $c"
+ }
+ close $fh
+ file copy -force -- $tf "$tf.old"
+ file rename -force -- "$tf.new" $tf
+ } msg]} {
+ catch { close $fh; file delete -- "$tf.new" }
+ report $msg
+ break
+ }
+ conf-copyin
+ destroy .opt
+ }
+ pack .opt.b.cancel .opt.b.ok .opt.b.save -side left -padx 2 -pady 2
+
+ bind .opt <Return> { tkButtonInvoke .opt.b.save }
+ bind .opt <Escape> { tkButtonInvoke .opt.b.cancel }
+
+ pack .opt.anag .opt.wordlist -expand yes -fill x
+ pack .opt.b -anchor e
+}
+
+# --- Run the command ---
+
+proc run-search {args} { run-search-v $args }
+proc run-search-v {v} {
+ global C
+ set v [linsert $v 0 | $C(anag) "--file" $C(wordlist)]
+ if {[catch {set fh [open $v]} err]} { report $err; return }
+ set l {}
+ while {[gets $fh line] >= 0} { lappend l $line }
+ if {[catch {close $fh} err]} { report $err; return }
+ .list delete 0 end
+ foreach i $l { .list insert end $i }
+}
+
+# --- Construct the main window ---
+
+wm title . "Anagram solver"
+frame .f-entry
+frame .f-list
+frame .f-buttons
+
+button .b-anagram -text "Anagram" -underline 0 \
+ -command { run-search "-anagram" $word }
+button .b-subgram -text "Subgram" -underline 0 \
+ -command { run-search "-subgram" $word }
+button .b-glob -text "Crossword" -underline 5 \
+ -command { run-search "-wildcard" $word }
+button .b-track -text "Trackword" -underline 0 \
+ -command { run-search "-trackword" $word }
+button .b-regexp -text "Regexp" -underline 0 \
+ -command { run-search "-regexp" $word }
+
+button .b-custom -text "Custom" -underline 0 \
+ -command { run-search-v [wordlist $word] }
+
+listbox .list \
+ -xscrollcommand { .f-list.xscroll set } \
+ -yscrollcommand { .f-list.yscroll set }
+scrollbar .f-list.xscroll -orient horizontal -command { .list xview }
+scrollbar .f-list.yscroll -orient vertical -command { .list yview }
+
+entry .e-word -textvariable word
+
+grid .list -in .f-list -row 0 -column 0 -sticky nsew
+grid .f-list.xscroll -row 1 -column 0 -sticky ew
+grid .f-list.yscroll -row 0 -column 1 -sticky ns
+grid rowconfigure .f-list 0 -weight 1
+grid columnconfigure .f-list 0 -weight 1
+
+pack .b-custom .b-track .b-regexp .b-glob .b-subgram .b-anagram \
+ -in .f-buttons -fill x -padx 2 -pady 2
+
+pack .e-word -in .f-entry -expand yes -fill x -padx 2 -pady 2
+
+pack .f-entry -fill x
+pack .f-list -side left -expand yes -fill both
+pack .f-buttons -side left -anchor s
+
+menu .menu
+.menu add cascade -label "File" -underline 0 -menu .menu.file
+menu .menu.file
+.menu.file add command -label "Options..." -underline 0 -command { options }
+.menu.file add command -label "Quit" -underline 0 -command { destroy . }
+. configure -menu .menu
+
+focus .e-word
+bind .e-word <Return> { tkButtonInvoke .b-anagram }
+
+bind . <Alt-a> { tkButtonInvoke .b-anagram }
+bind . <Alt-t> { tkButtonInvoke .b-track }
+bind . <Alt-s> { tkButtonInvoke .b-subgram }
+bind . <Alt-w> { tkButtonInvoke .b-glob }
+bind . <Alt-r> { tkButtonInvoke .b-regexp }
+bind . <Alt-c> { tkButtonInvoke .b-custom }