pcre.c, etc.: Support the PCRE2 library.

[anag] / anag-gui.in

#! @WISH@
### -*-tcl-*-
###
### Graphical frontend for `anag'
###
### (c) 2002 Mark Wooding
###

###----- Licensing notice ---------------------------------------------------
###
### This file is part of Anag: a simple wordgame helper.
###
### Anag is free software; you can redistribute it and/or modify
### it under the terms of the GNU General Public License as published by
### the Free Software Foundation; either version 2 of the License, or
### (at your option) any later version.
###
### Anag is distributed in the hope that it will be useful,
### but WITHOUT ANY WARRANTY; without even the implied warranty of
### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
### GNU General Public License for more details.
###
### You should have received a copy of the GNU General Public License
### along with Anag; if not, write to the Free Software Foundation,
### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

###--------------------------------------------------------------------------
### 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

foreach {opt text mnem} {
  anagram Anagram a
  subgram Subgram s
  wildcard Crossword w
  trackword Trackword t
  mono Monoalphabetic m
  regexp "Regular expression" r
  pcre "Perl regexp" p
} {
  button .b-$opt -text $text \
      -underline [string first $mnem [string tolower $text]] \
      -command [concat [list run-search -$opt] \$word]
  bind . <Alt-$mnem> [list tkButtonInvoke .b-$opt]
  pack .b-$opt -in .f-buttons -fill x -padx 2 -pady 2
}

button .b-custom -text "Custom" -underline 0 \
    -command { run-search-v [wordlist $word] }
bind . <Alt-c> { tkButtonInvoke .b-custom }
pack .b-custom -in .f-buttons -fill x -padx 2 -pady 2

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 .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 }

###----- That's all, folks --------------------------------------------------