Updated 2011-10-18 12:23:27 by dkf

WJG (10/08/06). The University of Chicago (http://machaut.uchicago.edu) provides a useful portal to a large number of language resources amongst which are the Webster Dictionaries and Roget's Thesaurus (made available by the Gutenberg Project). Naturally, as an Englishman I prefer the Oxford English Dictionary, however, as I don't have a copy (who does?) the Webster dictionary is a fine alternative. Indeed, the placement of etymological notes at the head of each entry is precisely what I'm interested in. Rather than searching through the portal itself, I hacked up a few lines of code today to enable me to add some query buttons to my Tk apps. Good ol' Tcl/Tk!

To use the demo, type in some text, select the word that needs to be queried and click on "W" for a Webster Dictionary search or "R" for Roget's thesaurus. Some further enhancements could be made, any comments warmly welcomed.
 # webster.tcl
 # Provide access to online text resources
 # Ref:
 # http://wiki.tcl.tk/4094

 package require optcl 
 # create toolbar icons 
 image create photo W -data {
 image create photo R -data {
 # add toolbar buttons
 # w is name of the container 
 proc WR:toolbar {c} {
  set base [frame $c._wb]
  # Webster's Dictionaries 
  button $base._w -image W -command { WR:search W }
  # Roget's thesaurus   
  button $base._r -image R -command { WR:search R } 
  pack $base $base._w $base._r -side left

 # performs request
 # type = W or R
 proc WR:search {type} {
  if {[selection own] == ""} {return}
  set word [selection get]
  # create browser
  destroy .wb
  toplevel .wb
  wm withdraw .wb
  set htm [optcl::new -window .wb.htm Shell.Explorer.2]
  .wb.htm config -width 600 -height 400
  pack .wb.htm -fill both -expand 1
  # search for word
  if {$word != "" } {
    switch -- $type { 
      W { set url http://machaut.uchicago.edu/?resource=Webster%27s&word=${word}&use1913=on&use1828=on
          wm title .wb "Webster's Dictionary: Lookup \"$word\""
      R { set url http://machaut.uchicago.edu/?action=search&resource=Roget%27s&word=${word}&searchtype=fulltext
          wm title .wb "Roget's Thesaurus: Lookup \"$word\""
    catch {$htm navigate $url}
    wm deiconify .wb
    focus .wb

 # the ubiquitous demo
 proc demo {} {
  frame .tb
  pack .tb -side top -anchor nw -fill x
  WR:toolbar .tb
  text .txt
  pack .txt -side top -anchor nw -fill both -expand 1