f8ee1b92 |
1 | #! /usr/bin/wish |
2 | |
3 | # --- Configuration --- |
4 | |
5 | if {[info exists env(HOME)]} { |
6 | set home $env(HOME) |
7 | } else { |
8 | set bin [info nameofexecutable] |
9 | if {[string compare $bin ""] == 0} { |
10 | set home "." |
11 | } else { |
12 | set home [file dirname $bin] |
13 | } |
14 | } |
15 | set conffile [list "/etc/anagrc" \ |
16 | [file join $home "anagrc"]] |
17 | if {[string compare "unix" $tcl_platform(platform)] == 0} { |
18 | lappend conffile [file join $home ".anagrc"] |
19 | } |
20 | set C_tags {anag wordlist} |
21 | set C(anag) "@ANAG@" |
22 | set C(wordlist) "@DICTIONARY@" |
23 | |
24 | foreach i $C_tags { |
25 | if {![info exists C($i)]} { |
26 | error "internal error: unset configuration option `$i'" |
27 | } |
28 | } |
29 | |
30 | foreach f $conffile { |
31 | if {[catch { set fh [open $f] } err]} { continue } |
32 | while {[gets $fh line] >= 0} { |
33 | if {[regexp {^[[:space:]]*(\#|$)} $line]} continue |
34 | regexp {^\s*([[:alnum:]]\w*)\s*=?\s*(|.*\S)\s*$} $line - n v |
35 | set C($n) $v |
36 | } |
37 | close $fh |
38 | break |
39 | } |
40 | |
41 | # --- Other setting up --- |
42 | |
43 | if {[string compare "windows" $tcl_platform(platform)] == 0} { |
44 | set exetypes { |
45 | {Executables {.exe} {}} |
46 | {All files {*} {}} |
47 | } |
48 | } else { |
49 | set exetypes {} |
50 | } |
51 | |
52 | # --- Handy subroutines --- |
53 | |
54 | proc wordlist {args} { |
55 | set l {} |
56 | foreach s $args { |
57 | while {![regexp {^\s*$} $s]} { |
58 | regexp {^\s*(\S+)(.*)$} $s - w s |
59 | lappend l $w |
60 | } |
61 | } |
62 | return $l |
63 | } |
64 | |
65 | proc report {msg} { |
66 | tk_messageBox -type ok -icon error \ |
67 | -title "Error from [wm title .]" -message $msg |
68 | } |
69 | |
70 | # --- Options --- |
71 | |
72 | proc conf-copyout {} { |
73 | global C C_tags |
74 | foreach i $C_tags { |
75 | upvar \#0 C:$i c |
76 | set c $C($i) |
77 | } |
78 | } |
79 | |
80 | proc conf-copyin {} { |
81 | global C C_tags |
82 | foreach i $C_tags { |
83 | upvar \#0 C:$i c |
84 | set C($i) $c |
85 | } |
86 | } |
87 | |
88 | proc options {} { |
89 | global C C_tags tcl_platform home conffile |
90 | |
91 | if {[winfo exists .opt]} { |
92 | raise .opt |
93 | return |
94 | } |
95 | |
96 | toplevel .opt |
97 | wm title .opt "[wm title .] options" |
98 | conf-copyout |
99 | |
100 | frame .opt.anag |
101 | label .opt.anag.l -text "Anagram solver binary: " |
102 | entry .opt.anag.e -textvariable C:anag |
103 | button .opt.anag.b -text "..." -command { |
104 | set C:anag [tk_getOpenFile -parent .opt \ |
105 | -title "Anagram solver binary" -filetypes $exetypes \ |
106 | -initialdir [file dirname ${C:anag}]] |
107 | } |
108 | pack .opt.anag.l -side left -padx 2 -pady 2 |
109 | pack .opt.anag.e -side left -expand yes -fill x -padx 2 -pady 2 |
110 | pack .opt.anag.b -side left -padx 2 -pady 2 |
111 | |
112 | frame .opt.wordlist |
113 | label .opt.wordlist.l -text "Wordlist file: " |
114 | entry .opt.wordlist.e -textvariable C:wordlist |
115 | button .opt.wordlist.b -text "..." -command { |
116 | set C:wordlist [tk_getOpenFile -parent .opt \ |
117 | -title "Wordlist file" \ |
118 | -initialdir [file dirname ${C:wordlist}]] |
119 | } |
120 | pack .opt.wordlist.l -side left -padx 2 -pady 2 |
121 | pack .opt.wordlist.e -side left -expand yes -fill x -padx 2 -pady 2 |
122 | pack .opt.wordlist.b -side left -padx 2 -pady 2 |
123 | |
124 | frame .opt.b |
125 | button .opt.b.cancel -text "Cancel" -command { destroy .opt } |
126 | button .opt.b.ok -text "OK" -command { conf-copyin; destroy .opt } |
127 | button .opt.b.save -default active -text "Save" -command { |
128 | set tf [lindex $conffile end] |
129 | if {[catch { |
130 | set date [clock format [clock seconds] -format "%Y-%m-%s %H:%M:%S"] |
131 | set fh [open "$tf.new" w] |
132 | puts $fh "# Anagram settings, written $date" |
133 | puts $fh "" |
134 | foreach n $C_tags { |
135 | upvar \#0 C:$n c |
136 | puts $fh "$n = $c" |
137 | } |
138 | close $fh |
139 | file copy -force -- $tf "$tf.old" |
140 | file rename -force -- "$tf.new" $tf |
141 | } msg]} { |
142 | catch { close $fh; file delete -- "$tf.new" } |
143 | report $msg |
144 | break |
145 | } |
146 | conf-copyin |
147 | destroy .opt |
148 | } |
149 | pack .opt.b.cancel .opt.b.ok .opt.b.save -side left -padx 2 -pady 2 |
150 | |
151 | bind .opt <Return> { tkButtonInvoke .opt.b.save } |
152 | bind .opt <Escape> { tkButtonInvoke .opt.b.cancel } |
153 | |
154 | pack .opt.anag .opt.wordlist -expand yes -fill x |
155 | pack .opt.b -anchor e |
156 | } |
157 | |
158 | # --- Run the command --- |
159 | |
160 | proc run-search {args} { run-search-v $args } |
161 | proc run-search-v {v} { |
162 | global C |
163 | set v [linsert $v 0 | $C(anag) "--file" $C(wordlist)] |
164 | if {[catch {set fh [open $v]} err]} { report $err; return } |
165 | set l {} |
166 | while {[gets $fh line] >= 0} { lappend l $line } |
167 | if {[catch {close $fh} err]} { report $err; return } |
168 | .list delete 0 end |
169 | foreach i $l { .list insert end $i } |
170 | } |
171 | |
172 | # --- Construct the main window --- |
173 | |
174 | wm title . "Anagram solver" |
175 | frame .f-entry |
176 | frame .f-list |
177 | frame .f-buttons |
178 | |
de6b7015 |
179 | foreach {opt text mnem} { |
180 | anagram Anagram a |
181 | subgram Subgram s |
182 | wildcard Crossword w |
183 | trackword Trackword t |
184 | mono Monoalphabetic m |
185 | regexp "Regular expression" r |
d9af4a2b |
186 | pcre "Perl regexp" p |
de6b7015 |
187 | } { |
188 | button .b-$opt -text $text \ |
189 | -underline [string first $mnem [string tolower $text]] \ |
190 | -command [concat [list run-search -$opt] \$word] |
191 | bind . <Alt-$mnem> [list tkButtonInvoke .b-$opt] |
192 | pack .b-$opt -in .f-buttons -fill x -padx 2 -pady 2 |
193 | } |
f8ee1b92 |
194 | |
195 | button .b-custom -text "Custom" -underline 0 \ |
196 | -command { run-search-v [wordlist $word] } |
de6b7015 |
197 | bind . <Alt-c> { tkButtonInvoke .b-custom } |
198 | pack .b-custom -in .f-buttons -fill x -padx 2 -pady 2 |
f8ee1b92 |
199 | |
200 | listbox .list \ |
201 | -xscrollcommand { .f-list.xscroll set } \ |
202 | -yscrollcommand { .f-list.yscroll set } |
203 | scrollbar .f-list.xscroll -orient horizontal -command { .list xview } |
204 | scrollbar .f-list.yscroll -orient vertical -command { .list yview } |
205 | |
206 | entry .e-word -textvariable word |
207 | |
208 | grid .list -in .f-list -row 0 -column 0 -sticky nsew |
209 | grid .f-list.xscroll -row 1 -column 0 -sticky ew |
210 | grid .f-list.yscroll -row 0 -column 1 -sticky ns |
211 | grid rowconfigure .f-list 0 -weight 1 |
212 | grid columnconfigure .f-list 0 -weight 1 |
213 | |
f8ee1b92 |
214 | pack .e-word -in .f-entry -expand yes -fill x -padx 2 -pady 2 |
215 | |
216 | pack .f-entry -fill x |
217 | pack .f-list -side left -expand yes -fill both |
218 | pack .f-buttons -side left -anchor s |
219 | |
220 | menu .menu |
221 | .menu add cascade -label "File" -underline 0 -menu .menu.file |
222 | menu .menu.file |
223 | .menu.file add command -label "Options..." -underline 0 -command { options } |
224 | .menu.file add command -label "Quit" -underline 0 -command { destroy . } |
225 | . configure -menu .menu |
226 | |
227 | focus .e-word |
228 | bind .e-word <Return> { tkButtonInvoke .b-anagram } |
229 | |