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.

http://www.voiceinterconnect.de/tcl/autocomplete.png

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

 # eof

To 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?