#!/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 -buffering none -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] [-s] [word]}
puts "\t-h host - dictd server host"
puts "\t-p port - dictd server port"
puts "\t-x - get word from x selection"
exit 0
}
proc parseArguments {argv} {
global dictHost dictPort
set args $argv
while { [ llength $args ] } {
set cur [ lindex $args 0 ]
set args [ lrange $args 1 end ]
if { ! [ string match "-*" $cur ] } {
lappend nonOptions $cur
continue
}
switch -exact -- $cur {
"-h" { set varn dictHost }
"-p" { set varn dictPort }
"-s" { set xsel t }
"--help" { usage ; exit 0 }
"--" {
set nonOptions [ concat $nonOptions $args ]
set args {}
}
default { puts "unrecognized option `$cur'"; usage }
}
if { [ info exists varn ] } {
if { ! [ llength $args ] } {
puts "option requires an argument -- `$cur'"
usage
}
set $varn [ lindex $args 0 ]
unset varn
set args [ lrange $args 1 end ]
}
}
if [ info exist nonOptions ] {
setInputValue .input $nonOptions
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 .inputExample .Xresources:
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
