#!/bin/sh
 # Tcl/Tk client to http://dict.org/ server
 #
 # (C) 2006 Fedor Zhigaltsov(samolet2003@mail.ru), 
 # may be freely distributed under terms and conditions of GNU GPL.
 # 
 #
 # -*- mode: tcl -*-
 # next line is a comment for Tcl, but not for bash: \
 exec wish "$0" -- "$@"
 
 set dictHost localhost
 set dictPort 2628
 set dictClientName tkdict
 set dictsWithTranscription {mueller7}
 
 option add *text.relief      sunken startupFile
 option add *text.borderWidth 2      startupFile
 option add *text.height      25     startupFile
 option add *text.width       70     startupFile
 # <tags>
 option add *text.searchwordForeground blue startupFile
 option add *text.matchwordForeground blue startupFile
 option add *text.transcriptionForeground \#ce5555 startupFile
 option add *text.transcriptionFont -*-sildoulosipa-*-*-*-*-*-*-*-*-*-*-iso8859-1 startupFile
 # </tags>
 option add *exitKeySequences {Control-q Alt-q Meta-q} startupFile
 
 
 proc showWordDef {entry text} {
     set word [$entry get]
     $text configure -state normal
     $text delete 0.0 end
     
     #$text insert 0.0 [exec dictl $word]
     if {[dictDefineWord $word $text] < 1} {
 	if {[dictMatchWord $word $text] <1} {
 	    $text insert end "No definitions found for \"$word\""
 	}
     }
 
     $text mark set insert 0.0
 
     #textSearch $text $word
 
     updateWmTitle $word
     $text configure -state disabled
 
     # select input text for easy deletion
     #$entry selection range 0 end
     
     recordWordInHistory $word
 }
 
 proc dictDefineWord {word text} {
     global dictHost dictPort dictClientName
     set sk [ socket $dictHost $dictPort ]
     fconfigure $sk -translation crlf
     fconfigure $sk -buffering none
     fconfigure $sk -encoding utf-8
     puts $sk {client "$dictClientName"}
     puts $sk "define * \"$word\""
     puts $sk {quit}
     
     set STATE_START 0
     set STATE_WAIT_DEFINITION 1
     set STATE_IN_DEFINITION 2
     
     set state $STATE_START
     configure_text_tag $text transcription transcription Transcription
     configure_text_tag $text searchword searchword Searchword
 
     set found 0
 
     while { ![ eof $sk ] } {
 	gets $sk line
 	#$rawtext insert end "$line\n"
 	if {$state == $STATE_START} {
 	    if [string match {150 *} $line] {
 		# 150 7 definitions retrieved
 		$text insert end [regsub "retrieved" \
 				      [string range $line 4 end] "found"]
 		$text insert end "\n"
 		set state $STATE_WAIT_DEFINITION
 		continue
 	    }
 	} elseif {$state == $STATE_WAIT_DEFINITION} {
 	    if [string match {151 *} $line] {
 		incr found
 		# 151 "one" mueller7 "Mueller English-Russian Dictionary"
 		# cut "151 "
 		set line [string range $line 4 end] 
 		set next [string first " " $line]
 		set word [string range $line 0 $next ]
 		set word [string trim $word " \""]
 
 		# cut word
 		incr next
 		set line [string range $line $next end]
 		set next [string first " " $line]
 		set dictName [string range $line 0 $next]
 		set dictName [string trim $dictName  " \""]
 
 		# cut dict name
 		incr next
 		set line [string range $line $next end]
 		set dictDesc [string trim $line " \""]
 
 		$text insert end "\n"
 		$text insert end "From $dictDesc \[$dictName\]:\n"
 		$text insert end "\n"
 
 		global dictsWithTranscription
 		set useTranscriptionTag \
 		    [expr  \
 			 [lsearch -exact \
 			      $dictsWithTranscription \
 			      $dictName] !=-1 ]
 		set state $STATE_IN_DEFINITION
 		continue
 	    }
 	} elseif {$state == $STATE_IN_DEFINITION} {
 	    if {$line == "."} {
 		# The textual body of each definition is 
 		# terminated with a CRLF period  CRLF sequence.
 		set state $STATE_WAIT_DEFINITION
 		continue
 	    }
 
 	    $text insert end $line
 
 	    # mark search word 
 	    set cur {insert linestart}
 	    while { [set cur \
 			 [$text search -nocase \
 			      -count length -- $word $cur end]] != "" } {
 		set next [ $text index "$cur + $length char" ]
 		$text tag add searchword $cur $next
 		set cur $next
 	    }
 
 	    # mark transcription 
 	    if {$useTranscriptionTag} {
 		set cur {insert linestart}
 		while { [set cur \
 			     [$text search -nocase\
 				  -count length\
 				  -regexp {\[[^\]]*\]} $cur end]] != "" } {
 		    set next [ $text index "$cur + $length char" ]
 		    $text tag add transcription $cur $next
 		    set cur $next
 		}	
 	    }
 
 	    $text insert end "\n"
 	}
     }
     close $sk
     return $found
 }
 
 
 proc dictMatchWord {word text} {
     global dictHost dictPort dictClientName
     set sk [ socket $dictHost $dictPort ]
     fconfigure $sk -translation crlf
     fconfigure $sk -buffering none
     fconfigure $sk -encoding utf-8
     puts $sk {client "$dictClientName"}
     puts $sk "match * . \"$word\""
     puts $sk {quit}
 
     set STATE_START 0
     set STATE_MATCH 1
     set STATE_FINISH 2
     set matchesFound 0
     set state $STATE_START
 
     configure_text_tag $text matchword matchword Matchword
 
     while { ![ eof $sk ] } {
 	gets $sk line
 	#$rawtext insert end "$line\n"
 	if {$state == $STATE_START} {
 	    if [string match {152 *} $line] {
 		# 150 94 matches found
 		#$text insert end [string range $line 4 end]
 		#$text insert end "\n"
 		$text insert end "No definitions found for \"$word\", perhaps you mean:"
 		set state $STATE_MATCH
 		continue
 	    }
 	} elseif {$state == $STATE_MATCH} {
 	    if {$line == "."} {
 		$text insert end "\n"
 		set state $STATE_FINISH
 		continue
 	    }
 	    incr matchesFound
 	    # mueller7 "k"
 	    set spaceIdx [string first " " $line]
 	    if {$spaceIdx == -1} {
 		continue
 	    }
 	    set curDict [string trim [string range $line 0 $spaceIdx] " "]
 	    set curWord [string trim [string range $line $spaceIdx end ] " \""]
 	    
 	    if { ! [info exists prevDict] || $prevDict != $curDict } {
 		$text insert end "\n"
 		$text insert end "$curDict:"
 		set prevDict $curDict
 	    } 
 	    $text insert end "  "
 	    $text insert end $curWord matchword
 
 	}
     }
     close $sk
     return $matchesFound
 }
 
 set history {}
 set historyIdx 0
 
 proc recordWordInHistory {word} {
     global history
     global historyIdx
     # don't put duplicate words into history
     if { [lsearch $history $word] == -1 } {
 	lappend history $word
 	set historyIdx [llength $history]
 	incr historyIdx -1
     }
 }
 
 proc historyUp {entry} {
     global history
     global historyIdx
     if { ! [ llength $history ] } {
 	return
     }
     if { $historyIdx > 0 } {
 	incr historyIdx -1
     }
     setInputValue $entry [lindex $history $historyIdx]
 }
 
 proc historyDown {entry} {
     global history
     global historyIdx
     if { ! [ llength $history ] } {
 	return
     }
     if { $historyIdx < [ llength $history ] - 1 } {
 	incr historyIdx
     }
     setInputValue $entry [lindex $history $historyIdx]
 }
 
 # get X selection and insert into entry
 proc setInputValueFromXSelection {entry} {
     if { [catch {setInputValue $entry [selection get] } ] } {
 	# error
 	return 0
     }
     return 1
 }
 
 proc setInputValue {entry value} {
     $entry delete 0 end
     $entry insert 0 $value
 }
 
 proc deleteWordBackward {entry} {
     set insertIndex [$entry index insert]
     set leftPart [string range [$entry get] 0 $insertIndex]
     set spaceIndex [string last " " $leftPart]
     if { $spaceIndex < 0 } {
 	set spaceIndex 0
     } else {
 	incr spaceIndex
     }
     $entry delete $spaceIndex $insertIndex
 }
 
 proc updateWmTitle {{searchWord ""}} {
     set s "TkDict"
     if {$searchWord != ""} {
 	append s ": $searchWord"
     }
     wm title . $s
 }
 
 proc configure_text_tag { wt tag rpfx cpfx } {
     foreach { o s } {
         -background  Background
         -borderwidth BorderWidth
         -font        Font
         -foreground  Foreground
         -overstrike  Overstrike
         -relief      Relief
         -underline   Underline
     } {
         if { [ set v [ option get $wt $rpfx$s $cpfx$s ] ] != "" } {
             $wt tag configure $tag $o $v
         }
     }
 }
 
 proc usage {} {
     puts {Usage: tkdict [-h host] [-p port] [-xsel|word]}
 }
 
 proc parseArguments {argv} {
     set STATE_START 0
     set STATE_HOST 1
     set STATE_PORT 2
     set state $STATE_START
 
     foreach arg $argv {
 	if {$state == $STATE_START} {
 	    if { $arg == "-h" } {
 		set state $STATE_HOST
 	    } elseif { $arg == "-p" } {
 		set state $STATE_PORT
 	    } elseif { $arg == "-xsel" } {
 		set xsel 1
 	    } else {
 		set word $arg
 	    }
 	} elseif {$state == $STATE_HOST} {
 	    global dictHost
 	    set dictHost $arg
 	    set state $STATE_START
 	} elseif {$state == $STATE_PORT} {
 	    global dictPort
 	    set dictPort $arg
 	    set state $STATE_START
 	} 
     }
 
     if {$state != $STATE_START} {
 	usage
 	exit 1
     }
 
     if [info exist word] {
 	setInputValue .input $word
 	showWordDef .input .text
     } elseif [info exist xsel] {
 	if [setInputValueFromXSelection .input] {
 	    showWordDef .input .text
 	}
     }
 }
 
 
 text .text -yscrollcommand {.scroll set} -setgrid 1 \
     -undo 1 -autosep 1 -state disabled
 
 entry .input
 
 scrollbar .scroll -command {.text yview}
 
 grid .input -sticky we -columnspan 2
 grid .text .scroll -sticky news
 grid rowconfigure . 1 -weight 1
 grid columnconfigure . 0 -weight 1
 
 bind . <Up> {historyUp .input}
 bind . <Control-p> {historyUp .input}
 bind . <Down> {historyDown .input}
 bind . <Control-n> {historyDown .input}
 bind . <F1> {
     if [setInputValueFromXSelection .input] {
 	showWordDef .input .text
     }
 }
 
 bind .input <Return> {showWordDef .input .text}
 bind .input <Mod1-BackSpace> {deleteWordBackward .input}
 
 bind .input <Prior> {.text yview scroll -1 page}
 bind .input <Mod1-v> {.text yview scroll -1 page}
 
 bind .input <Next> {.text yview scroll 1 page}
 bind .input <Control-v> {.text yview scroll 1 page}
 
 # configure exit key sequences
 foreach seq [option get . "exitKeySequences" {}] {
     bind . <$seq> {destroy .}
 }
 
 updateWmTitle
 
 parseArguments $argv
 
 focus .input

Example .Xdefaults:

 Tkdict.exitKeySequences: Escape
 !Tkdict.text.markedBackground: Red
 !Tkdict.text.markedForeground: Yellow
 Tkdict.input.font: -cronyx-fixed-medium-*-*-*-15-*-*-*-*-*-koi8-r
 Tkdict.text.font: -cronyx-fixed-medium-*-*-*-15-*-*-*-*-*-koi8-r
 !Tkdict.text.background: Black
 !Tkdict.text.foreground: Yellow

----
[Arts and crafts of Tcl-Tk programming] | [Category Application] | [Category Human Language]