Commit | Line | Data |
---|---|---|
0279756e MW |
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. | |
f8ee1b92 | 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" \ | |
0279756e | 41 | [file join $home "anagrc"]] |
f8ee1b92 | 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 | ||
0279756e MW |
66 | ###-------------------------------------------------------------------------- |
67 | ### Other setting up. | |
f8ee1b92 | 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 | ||
0279756e MW |
78 | ###-------------------------------------------------------------------------- |
79 | ### Handy subroutines. | |
f8ee1b92 | 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 | ||
0279756e MW |
97 | ###-------------------------------------------------------------------------- |
98 | ### Options. | |
f8ee1b92 | 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 | ||
0279756e MW |
186 | ###-------------------------------------------------------------------------- |
187 | ### Run the command. | |
f8ee1b92 | 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 | ||
0279756e MW |
201 | ###-------------------------------------------------------------------------- |
202 | ### Construct the main window. | |
f8ee1b92 | 203 | |
204 | wm title . "Anagram solver" | |
205 | frame .f-entry | |
206 | frame .f-list | |
207 | frame .f-buttons | |
208 | ||
de6b7015 | 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 | |
d9af4a2b | 216 | pcre "Perl regexp" p |
de6b7015 | 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 | } | |
f8ee1b92 | 224 | |
225 | button .b-custom -text "Custom" -underline 0 \ | |
226 | -command { run-search-v [wordlist $word] } | |
de6b7015 | 227 | bind . <Alt-c> { tkButtonInvoke .b-custom } |
228 | pack .b-custom -in .f-buttons -fill x -padx 2 -pady 2 | |
f8ee1b92 | 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 | ||
f8ee1b92 | 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 | ||
0279756e | 260 | ###----- That's all, folks -------------------------------------------------- |