autocomplete
autocomplete is a simple package for extending a text widget with autocompletion.
For a simple translation utility UKo needed an autocomplete feature for the text widget to provide the editor with the matching already typed words to help in typing in words with many special chars (IPA code in this case).
The package is a simple extension for any text widget (though for the moment it can only serve one text widget per application). At the end of the page is a simple demo application.
Some words to the usage: If the current word contains at least -minwlen chars, the wordlist will be searched for words starting with these characters. The matching words will be presented in a popup with -maxent entries and a preceding number. One of these words can be chosen by pressing the number. Esc and FocusOut closes the popup. The wordlist can be loaded and saved to wherever you wish it to be.
Here is the code for the package. It requires Wcb. Save it as autocomplete.tcl
# ------------------------------------------------------------------------
# autocomplete package, version 1.1
# a simple package for extending a text widget with autocompletion
#
# Copyright (c) 2007 Uwe Koloska, voice INTER connect GmbH
# ------------------------------------------------------------------------
#
# This library is free software; you can use, modify, and redistribute it
# for any purpose, provided that existing copyright notices are retained
# in all copies and that this notice is included verbatim in any
# distributions.
#
# This software is distributed WITHOUT ANY WARRANTY; without even the
# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
# ------------------------------------------------------------------------
package provide autocomplete 1.1
package require wcb
namespace eval acmpl {}
proc acmpl::getWordlistVar {} {
return [namespace current]::run(words)
}
# the current word is the word that is around or before the insert cursor
# example: (cursor is meant before the character above)
# abc def ghi
# | -> abc
# | -> abc
# | -> abc
# | -> ""
# but the tcl text index is meant as pointing at the character, so the first
# index after the word is pointing at the space character after the word
proc acmpl::getCurrentWordIndex {w {back ""}} {
set index [$w index "insert $back"]
# if index points at a space character after the current word
if {[string is space -strict [$w get $index]]} {
set index [$w index "$index -1c"]
}
set startidx [$w index "$index wordstart"]
set endidx [$w index "$index wordend"]
return [list $startidx $endidx]
}
proc acmpl::getCurrentWord {w {back ""}} {
lassign [getCurrentWordIndex $w $back] startidx endidx
set word [string trim [$w get $startidx $endidx]]
return $word
}
proc acmpl::replaceCurrentWord {w word} {
lassign [getCurrentWordIndex $w ""] startidx endidx
$w delete $startidx $endidx
$w insert insert $word
}
proc acmpl::processCurrentWord {w word} {
variable run
if {$word ne "" && ![string is punct $word]} {
if {[lsearch $run(words) $word] == -1} {
lappend run(words) $word
}
}
}
proc acmpl::getScreenCoordsForCurrentWord {w idx} {
lassign [$w bbox $idx] x1 y1 width height
set wx [winfo rootx $w]
set wy [winfo rooty $w]
set x [expr $x1 + $wx]
set y [expr $y1 + $wy + $height]
return [list $x $y]
}
proc acmpl::showWordVariants {w word {back ""}} {
variable run
# puts "showWordVariants $w $word"
if {[string length $word] >= $run(minWordlen)} {
set match [lsearch -all -inline $run(words) "${word}?*"]
if {[llength $match] > 0} {
if {[llength $match] > $run(maxEntries)} {
set match [concat [lrange $match 0 [expr $run(maxEntries) - 1]] "..."]
}
set run(match) $match
lassign [getCurrentWordIndex $w $back] startidx endidx
lassign [getScreenCoordsForCurrentWord $w $startidx] x y
showWordVariantsPopup $w $x $y $match
} else {
catch {deleteWordVariantsPopup}
}
} else {
catch {deleteWordVariantsPopup}
}
}
proc acmpl::processInput {mode w args} {
variable run
if {$run(noCallback)} return
# FIXME: w (from wcb callback) contains the prefix "::_" and this leads to errors
# with some tk commands
regsub {^(::_)} $w "" w
# puts "processInput $mode $w $args"
switch -exact $mode {
"insert" {
set idx [lindex $args 0]
set str [lindex $args 1]
if {![string is wordchar $str]} {
set word [getCurrentWord $w "-1c"]
processCurrentWord $w $word
deleteWordVariantsPopup
} else {
set word [getCurrentWord $w]
showWordVariants $w $word
}
}
"delete" {
set word [getCurrentWord $w]
showWordVariants $w $word
}
}
}
proc acmpl::saveWordlist {fname {enc utf-8}} {
variable run
if {[llength $run(words)] == 0} return
if {[file exists $fname]} {
file copy -force $fname ${fname}~
}
set fp [open $fname "w"]
fconfigure $fp -encoding $enc
puts $fp "\# tdict '[file tail $fname]'; encoding: $enc"
set words [lsort -dictionary $run(words)]
puts $fp [join $words \n]
puts $fp "\n\# eof"
close $fp
}
proc acmpl::loadWordlist {fname {append 0} {enc utf-8}} {
variable run
if {[catch {open $fname} fp] || $fp eq ""} {
return
}
fconfigure $fp -encoding $enc
set data [read -nonewline $fp]
close $fp
if {!$append} {
set run(words) {}
}
foreach line [split $data \n] {
set line [string trim $line]
if {[string length $line] == 0 || [string index $line 0] eq "\#"} continue
lappend run(words) $line
}
return [llength $run(words)]
}
proc acmpl::init {} {
bind CompletionPopup <Key-Escape> [namespace code deleteWordVariantsPopup]
bind CompletionPopup <1> [namespace code deleteWordVariantsPopup]
bind CompletionPopup <Key> [namespace code {processPopupKey %A}]
}
proc acmpl::attachTo {w args} {
variable run
array set opts {
-font {Helvetica 11}
-minwlen 3
-maxent 6
}
array set opts $args
set run(attachedTo) $w
set run(words) ""
set run(font-popup) $opts(-font)
set run(maxEntries) $opts(-maxent)
set run(minWordlen) $opts(-minwlen)
set run(noCallback) 0
wcb::callback $w after insert [namespace code {processInput insert}]
wcb::callback $w after delete [namespace code {processInput delete}]
}
proc acmpl::processPopupKey {key} {
variable run
if {$key ne ""} {
#puts "key: $key"
if {$key > 0 && $key <= $run(maxEntries)} {
chooseWordVariant $key
return -code break
}
}
}
proc acmpl::chooseWordVariant {idx} {
variable run
if {$idx > 0 && $idx <= [llength $run(match)]} {
replaceCurrentWord $run(attachedTo) [lindex $run(match) [expr $idx - 1]]
}
}
proc acmpl::showWordVariantsPopup {w x y wordlist} {
variable run
# puts "showWordVariantsPopup $w $x $y '$wordlist'"
set t .cmplPopup
catch {destroy $t}
toplevel $t
wm overrideredirect $t yes
if {$::tcl_platform(platform) == "macintosh"} {
unsupported1 style $t floating sideTitlebar
}
set msg {}
for {set i 0} {$i < [llength $wordlist]} {incr i} {
set word [lindex $wordlist $i]
if {$word ne "..."} {
lappend msg "[expr $i + 1] $word"
} else {
lappend msg "..."
}
}
set msg [join $msg \n]
pack [label $t.l -text [subst $msg] -bg lightblue -font $run(font-popup) -justify left] \
-padx 0 -pady 0
set width [expr {[winfo reqwidth $t.l] + 2}]
set height [expr {[winfo reqheight $t.l] + 2}]
set xMax [expr {[winfo screenwidth .] - $width}]
set yMax [expr {[winfo screenheight .] - $height}]
if {$x > $xMax} then {
set x $xMax
}
if {$y > $yMax} then {
set y $yMax
}
wm geometry $t +$x+$y
bind $run(attachedTo) <FocusOut> [namespace code deleteWordVariantsPopup]
# Bindings Popup und Textwidget
foreach w [list $run(attachedTo) $t] {
set bindings [bindtags $w]
if {[lsearch $bindings CompletionPopup] == -1} {
set bindings [concat CompletionPopup $bindings]
bindtags $w $bindings
}
}
}
proc acmpl::deleteWordVariantsPopup {args} {
variable run
# delete bindings for Popup
set bindings [bindtags $run(attachedTo)]
while {[set idx [lsearch -exact $bindings "CompletionPopup"]] != -1} {
set bindings [lreplace $bindings $idx $idx]
}
bindtags $run(attachedTo) $bindings
catch {destroy .cmplPopup}
}
acmpl::init
# eofTo use this as a package, you have to provide a pkgIndex.tcl containing a line like this:
package ifneeded autocomplete 1.1 [list source -encoding utf-8 [file join $dir autocomplete.tcl]]
For the example application to work, you need the autocomplete package and its precondition - the great Wcb. Additionally you have to provide the excellent package tablelist. For convenience the application has the necessary settings to find the packages in a directory named lib just beside the script.
#! /usr/bin/env wish
# testapplication for autocomplete-package
package require Tk 8.5
set mydir [file dirname [info script]]
# use this to add the libdir of wcb, tablelist and autocomplete packages
lappend auto_path [file join $mydir "lib"]
package require autocomplete 1.0
package require tablelist
font create cmpl -family Verdana -size 14
proc createGui {font} {
text .t -width 40 -height 10 -wrap word -font $font
scrollbar .sby -command ".l yview" -orient vertical
tablelist::tablelist .l -exportselection false -stretch 0 \
-listvariable [acmpl::getWordlistVar] -columns {0 "word"} \
-background gray96 -stripebackground \#e0e8f0 -width 20 \
-showlabels 0 -selectmode single -yscrollcommand ".sby set"
grid .t .l -sticky ewns
grid columnconfigure . 0 -weight 1
grid rowconfigure . 0 -weight 1
}
createGui cmpl
acmpl::attachTo .t -font cmpl
# show the last inserted word
proc showListEnd {args} {
after idle {.l see end}
}
proc Quit {} {
acmpl::saveWordlist "~/.tdict"
exit
}
wm protocol . WM_DELETE_WINDOW Quit
trace add variable [acmpl::getWordlistVar] write showListEnd
acmpl::loadWordlist "~/.tdict"SOLVED:
- bug with the replace code. If just before the word to be replaced by a longer one from the dict is a lineend, the lineend will be deleted. Since I use wordstart for the beginning of the current word, I can't see where the \n vanishes.
TODO:
- make it work with more than one text widget
DKF: In Tk 8.5, the tk_getOpenFile dialog on Unix does auto-completion on pressing the Tab key.
schlenk: This would be a nice addition to tklib if it was a bit more polished and could work with multiple text widgets.
UKo: Could you elaborate just a bit more about what needs to be more polished?