| 1 | #! @WISH@ |
| 2 | ### -*-tcl-*- |
| 3 | ### |
| 4 | ### Graphical frontend for `anag' |
| 5 | ### |
| 6 | ### (c) 2002 Mark Wooding |
| 7 | ### |
| 8 | |
| 9 | ###----- Licensing notice --------------------------------------------------- |
| 10 | ### |
| 11 | ### This file is part of Anag: a simple wordgame helper. |
| 12 | ### |
| 13 | ### Anag is free software; you can redistribute it and/or modify |
| 14 | ### it under the terms of the GNU General Public License as published by |
| 15 | ### the Free Software Foundation; either version 2 of the License, or |
| 16 | ### (at your option) any later version. |
| 17 | ### |
| 18 | ### Anag is distributed in the hope that it will be useful, |
| 19 | ### but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 20 | ### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 21 | ### GNU General Public License for more details. |
| 22 | ### |
| 23 | ### You should have received a copy of the GNU General Public License |
| 24 | ### along with Anag; if not, write to the Free Software Foundation, |
| 25 | ### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
| 26 | |
| 27 | ###-------------------------------------------------------------------------- |
| 28 | ### Configuration. |
| 29 | |
| 30 | if {[info exists env(HOME)]} { |
| 31 | set home $env(HOME) |
| 32 | } else { |
| 33 | set bin [info nameofexecutable] |
| 34 | if {[string compare $bin ""] == 0} { |
| 35 | set home "." |
| 36 | } else { |
| 37 | set home [file dirname $bin] |
| 38 | } |
| 39 | } |
| 40 | set conffile [list "/etc/anagrc" \ |
| 41 | [file join $home "anagrc"]] |
| 42 | if {[string compare "unix" $tcl_platform(platform)] == 0} { |
| 43 | lappend conffile [file join $home ".anagrc"] |
| 44 | } |
| 45 | set C_tags {anag wordlist} |
| 46 | set C(anag) "@ANAG@" |
| 47 | set C(wordlist) "@DICTIONARY@" |
| 48 | |
| 49 | foreach i $C_tags { |
| 50 | if {![info exists C($i)]} { |
| 51 | error "internal error: unset configuration option `$i'" |
| 52 | } |
| 53 | } |
| 54 | |
| 55 | foreach f $conffile { |
| 56 | if {[catch { set fh [open $f] } err]} { continue } |
| 57 | while {[gets $fh line] >= 0} { |
| 58 | if {[regexp {^[[:space:]]*(\#|$)} $line]} continue |
| 59 | regexp {^\s*([[:alnum:]]\w*)\s*=?\s*(|.*\S)\s*$} $line - n v |
| 60 | set C($n) $v |
| 61 | } |
| 62 | close $fh |
| 63 | break |
| 64 | } |
| 65 | |
| 66 | ###-------------------------------------------------------------------------- |
| 67 | ### Other setting up. |
| 68 | |
| 69 | if {[string compare "windows" $tcl_platform(platform)] == 0} { |
| 70 | set exetypes { |
| 71 | {Executables {.exe} {}} |
| 72 | {All files {*} {}} |
| 73 | } |
| 74 | } else { |
| 75 | set exetypes {} |
| 76 | } |
| 77 | |
| 78 | ###-------------------------------------------------------------------------- |
| 79 | ### Handy subroutines. |
| 80 | |
| 81 | proc wordlist {args} { |
| 82 | set l {} |
| 83 | foreach s $args { |
| 84 | while {![regexp {^\s*$} $s]} { |
| 85 | regexp {^\s*(\S+)(.*)$} $s - w s |
| 86 | lappend l $w |
| 87 | } |
| 88 | } |
| 89 | return $l |
| 90 | } |
| 91 | |
| 92 | proc report {msg} { |
| 93 | tk_messageBox -type ok -icon error \ |
| 94 | -title "Error from [wm title .]" -message $msg |
| 95 | } |
| 96 | |
| 97 | ###-------------------------------------------------------------------------- |
| 98 | ### Options. |
| 99 | |
| 100 | proc conf-copyout {} { |
| 101 | global C C_tags |
| 102 | foreach i $C_tags { |
| 103 | upvar \#0 C:$i c |
| 104 | set c $C($i) |
| 105 | } |
| 106 | } |
| 107 | |
| 108 | proc conf-copyin {} { |
| 109 | global C C_tags |
| 110 | foreach i $C_tags { |
| 111 | upvar \#0 C:$i c |
| 112 | set C($i) $c |
| 113 | } |
| 114 | } |
| 115 | |
| 116 | proc options {} { |
| 117 | global C C_tags tcl_platform home conffile |
| 118 | |
| 119 | if {[winfo exists .opt]} { |
| 120 | raise .opt |
| 121 | return |
| 122 | } |
| 123 | |
| 124 | toplevel .opt |
| 125 | wm title .opt "[wm title .] options" |
| 126 | conf-copyout |
| 127 | |
| 128 | frame .opt.anag |
| 129 | label .opt.anag.l -text "Anagram solver binary: " |
| 130 | entry .opt.anag.e -textvariable C:anag |
| 131 | button .opt.anag.b -text "..." -command { |
| 132 | set C:anag [tk_getOpenFile -parent .opt \ |
| 133 | -title "Anagram solver binary" -filetypes $exetypes \ |
| 134 | -initialdir [file dirname ${C:anag}]] |
| 135 | } |
| 136 | pack .opt.anag.l -side left -padx 2 -pady 2 |
| 137 | pack .opt.anag.e -side left -expand yes -fill x -padx 2 -pady 2 |
| 138 | pack .opt.anag.b -side left -padx 2 -pady 2 |
| 139 | |
| 140 | frame .opt.wordlist |
| 141 | label .opt.wordlist.l -text "Wordlist file: " |
| 142 | entry .opt.wordlist.e -textvariable C:wordlist |
| 143 | button .opt.wordlist.b -text "..." -command { |
| 144 | set C:wordlist [tk_getOpenFile -parent .opt \ |
| 145 | -title "Wordlist file" \ |
| 146 | -initialdir [file dirname ${C:wordlist}]] |
| 147 | } |
| 148 | pack .opt.wordlist.l -side left -padx 2 -pady 2 |
| 149 | pack .opt.wordlist.e -side left -expand yes -fill x -padx 2 -pady 2 |
| 150 | pack .opt.wordlist.b -side left -padx 2 -pady 2 |
| 151 | |
| 152 | frame .opt.b |
| 153 | button .opt.b.cancel -text "Cancel" -command { destroy .opt } |
| 154 | button .opt.b.ok -text "OK" -command { conf-copyin; destroy .opt } |
| 155 | button .opt.b.save -default active -text "Save" -command { |
| 156 | set tf [lindex $conffile end] |
| 157 | if {[catch { |
| 158 | set date [clock format [clock seconds] -format "%Y-%m-%s %H:%M:%S"] |
| 159 | set fh [open "$tf.new" w] |
| 160 | puts $fh "# Anagram settings, written $date" |
| 161 | puts $fh "" |
| 162 | foreach n $C_tags { |
| 163 | upvar \#0 C:$n c |
| 164 | puts $fh "$n = $c" |
| 165 | } |
| 166 | close $fh |
| 167 | file copy -force -- $tf "$tf.old" |
| 168 | file rename -force -- "$tf.new" $tf |
| 169 | } msg]} { |
| 170 | catch { close $fh; file delete -- "$tf.new" } |
| 171 | report $msg |
| 172 | break |
| 173 | } |
| 174 | conf-copyin |
| 175 | destroy .opt |
| 176 | } |
| 177 | pack .opt.b.cancel .opt.b.ok .opt.b.save -side left -padx 2 -pady 2 |
| 178 | |
| 179 | bind .opt <Return> { tkButtonInvoke .opt.b.save } |
| 180 | bind .opt <Escape> { tkButtonInvoke .opt.b.cancel } |
| 181 | |
| 182 | pack .opt.anag .opt.wordlist -expand yes -fill x |
| 183 | pack .opt.b -anchor e |
| 184 | } |
| 185 | |
| 186 | ###-------------------------------------------------------------------------- |
| 187 | ### Run the command. |
| 188 | |
| 189 | proc run-search {args} { run-search-v $args } |
| 190 | proc run-search-v {v} { |
| 191 | global C |
| 192 | set v [linsert $v 0 | $C(anag) "--file" $C(wordlist)] |
| 193 | if {[catch {set fh [open $v]} err]} { report $err; return } |
| 194 | set l {} |
| 195 | while {[gets $fh line] >= 0} { lappend l $line } |
| 196 | if {[catch {close $fh} err]} { report $err; return } |
| 197 | .list delete 0 end |
| 198 | foreach i $l { .list insert end $i } |
| 199 | } |
| 200 | |
| 201 | ###-------------------------------------------------------------------------- |
| 202 | ### Construct the main window. |
| 203 | |
| 204 | wm title . "Anagram solver" |
| 205 | frame .f-entry |
| 206 | frame .f-list |
| 207 | frame .f-buttons |
| 208 | |
| 209 | foreach {opt text mnem} { |
| 210 | anagram Anagram a |
| 211 | subgram Subgram s |
| 212 | wildcard Crossword w |
| 213 | trackword Trackword t |
| 214 | mono Monoalphabetic m |
| 215 | regexp "Regular expression" r |
| 216 | pcre "Perl regexp" p |
| 217 | } { |
| 218 | button .b-$opt -text $text \ |
| 219 | -underline [string first $mnem [string tolower $text]] \ |
| 220 | -command [concat [list run-search -$opt] \$word] |
| 221 | bind . <Alt-$mnem> [list tkButtonInvoke .b-$opt] |
| 222 | pack .b-$opt -in .f-buttons -fill x -padx 2 -pady 2 |
| 223 | } |
| 224 | |
| 225 | button .b-custom -text "Custom" -underline 0 \ |
| 226 | -command { run-search-v [wordlist $word] } |
| 227 | bind . <Alt-c> { tkButtonInvoke .b-custom } |
| 228 | pack .b-custom -in .f-buttons -fill x -padx 2 -pady 2 |
| 229 | |
| 230 | listbox .list \ |
| 231 | -xscrollcommand { .f-list.xscroll set } \ |
| 232 | -yscrollcommand { .f-list.yscroll set } |
| 233 | scrollbar .f-list.xscroll -orient horizontal -command { .list xview } |
| 234 | scrollbar .f-list.yscroll -orient vertical -command { .list yview } |
| 235 | |
| 236 | entry .e-word -textvariable word |
| 237 | |
| 238 | grid .list -in .f-list -row 0 -column 0 -sticky nsew |
| 239 | grid .f-list.xscroll -row 1 -column 0 -sticky ew |
| 240 | grid .f-list.yscroll -row 0 -column 1 -sticky ns |
| 241 | grid rowconfigure .f-list 0 -weight 1 |
| 242 | grid columnconfigure .f-list 0 -weight 1 |
| 243 | |
| 244 | pack .e-word -in .f-entry -expand yes -fill x -padx 2 -pady 2 |
| 245 | |
| 246 | pack .f-entry -fill x |
| 247 | pack .f-list -side left -expand yes -fill both |
| 248 | pack .f-buttons -side left -anchor s |
| 249 | |
| 250 | menu .menu |
| 251 | .menu add cascade -label "File" -underline 0 -menu .menu.file |
| 252 | menu .menu.file |
| 253 | .menu.file add command -label "Options..." -underline 0 -command { options } |
| 254 | .menu.file add command -label "Quit" -underline 0 -command { destroy . } |
| 255 | . configure -menu .menu |
| 256 | |
| 257 | focus .e-word |
| 258 | bind .e-word <Return> { tkButtonInvoke .b-anagram } |
| 259 | |
| 260 | ###----- That's all, folks -------------------------------------------------- |