New front-end in Tcl/Tk. Easier to maintain than the Java interface.

diff --git a/anag-gui.in b/anag-gui.in
new file mode 100644 (file)
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 <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 }