From f8ee1b92d2979ad8811322e038a3d82fc469b60e Mon Sep 17 00:00:00 2001 From: mdw Date: Sun, 11 Aug 2002 12:58:41 +0000 Subject: [PATCH] New front-end in Tcl/Tk. Easier to maintain than the Java interface. --- anag-gui.in | 231 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 231 insertions(+) create mode 100644 anag-gui.in diff --git a/anag-gui.in b/anag-gui.in new file mode 100644 index 0000000..327164e --- /dev/null +++ b/anag-gui.in @@ -0,0 +1,231 @@ +#! /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 { tkButtonInvoke .opt.b.save } + bind .opt { 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 { tkButtonInvoke .b-anagram } + +bind . { tkButtonInvoke .b-anagram } +bind . { tkButtonInvoke .b-track } +bind . { tkButtonInvoke .b-subgram } +bind . { tkButtonInvoke .b-glob } +bind . { tkButtonInvoke .b-regexp } +bind . { tkButtonInvoke .b-custom } -- 2.11.0