Autocompleting combobox

###############################################################################
#
# entryWithCompletion demo script
#
###############################################################################

set HISTORY {
    1.0a2 nurdglaw 26-May-2013 "Standalone version. Add version number."
    1.0a3 nurdglaw 27-May-2013 "Add utility procs."
}

###############################################################################
#
# Homebrew combobox class
#
#     Move this class into utils.tcl when complete.
#
###############################################################################

if {[llength [info commands entryWithCompletion]] == 1} {
    entryWithCompletion destroy
}

oo::class create entryWithCompletion {
    variable m_ent m_listboxHeight m_valuesActive m_valuesAll
    variable -append m_popdownFrame m_popdownListbox m_popdownScrollbar
    variable -append m_popdownToplevel

    constructor {ent values} {
    set reqClass TEntry
    set actClass [winfo class $ent]
    if {![string equal $actClass $reqClass]} {
        error "$ent has class $actClass; must be $reqClass"
    }
    set m_listboxHeight 5

    set m_ent $ent
    set m_valuesAll $values

    my PopdownInitialise

    # Connect us to the entry widget

    $ent configure -validate key                                      \
        -validatecommand [list [self object] validateCommand %P]

    bind $ent <Destroy> [list [self object] destroy]
    bind $ent <FocusIn> [list [self object] focusIn]
    bind $ent <FocusOut> [list [self object] focusOut]
    bind $ent <Key-Down> [list [self object] keyDown]
    bind $ent <Key-Up> [list [self object] keyUp]
    }

    destructor {
    destroy $m_popdownListbox
    destroy $m_popdownScrollbar
    destroy $m_popdownFrame
    destroy $m_popdownToplevel
    }

    method focusIn {} {
    my ConfigureListbox ""
    my Post
    }

    method focusOut {} {
    my SetEntryFromListbox
    my Unpost
    }

    #----------------------------------------------------------------------
    #
    # keyDown, keyUp
    #
    #     Entry widget bindings for, repectively <Key-Down> and <Key-Up>.
    # Change the listbox selection repectively to the next, previous entry.
    #
    #----------------------------------------------------------------------

    method keyDown {} {
    my ListboxSelect next
    }

    method keyUp {} {
    my ListboxSelect prev
    }

    method validateCommand {str} {
    my ConfigureListbox $str
    return 1
    }

    #----------------------------------------------------------------------
    #
    # ConfigureListbox
    #
    #     Get the current contents of the entry widget and set the values
    # of the listbox with the object values that match it. If there are
    # many values, then map the scrollbar
    #
    #----------------------------------------------------------------------

    method ConfigureListbox {str} {
    set m_valuesActive [list]
    foreach val $m_valuesAll {
        if {[string match -nocase $str* $val]} {
        lappend m_valuesActive $val
        }
    }
    $m_popdownListbox configure                                      \
        -listvariable [self namespace]::m_valuesActive
    $m_popdownListbox selection set 0 0
    if {[llength $m_valuesActive] > $m_listboxHeight} {
        grid $m_popdownScrollbar -row 0 -column 1 -sticky nsew
    } else {
        grid remove $m_popdownScrollbar
    }
                                        # ttk::combobox also modifies the
                                        # gridding of the listbox with -padx
                                        # {1 0} when adding and 1 when removing
                                        # the scrollbar.
    }

    #----------------------------------------------------------------------
    #
    # ListboxSelect
    #
    #     Change the selection in the liustbox to the next or previous
    # entry, according as dirn is next or prev. If that would move off the
    # bottom or the top, wrap around.
    #
    #----------------------------------------------------------------------

    method ListboxSelect {dirn} {
 puts stdout [info level 0]
    set vals [set [$m_popdownListbox cget -listvariable]]
    set nEnts [llength $vals]
    for {set i 0} {$i < $nEnts} {incr i} {
        if {[$m_popdownListbox selection includes $i]} {
        set current $i
        break
        }
    }

    switch $dirn {
        next {
        set new [expr $current + 1]
        if {$new >= $nEnts} {
            incr new -$nEnts
        }
        }

        prev {
        set new [expr $current - 1]
        if {$new < 0} {
            incr new $nEnts
        }
        }

        default {
        error "Unexpected dirn $dir"
        }
    }

    $m_popdownListbox selection clear 0 [expr $nEnts - 1]
    $m_popdownListbox selection set $new $new
    $m_popdownListbox see $new

#   $m_ent delete 0 end
#   $m_ent insert 0 [lindex $vals $new]
    }

    #----------------------------------------------------------------------
    #
    # PopdownInitialise
    #
    #     Configure the popdown widgets. These comprise a frame with a
    # listbox and scrollbar gridded into it. (The scrollbar is not gridded
    # if the listbox doesn't need one to display all its values.) The
    # frame is the child of a toplevel window on whose behalf it acts as a
    # transient window.
    #     Configure the popdown toplevel widget, comprising a listbox and
    # scrollbar gridded into a frame.
    #
    #----------------------------------------------------------------------

    method PopdownInitialise {} {
    # Create a toplevel for the listbox
    #
    # We seem to need a frame within the toplevel which we can say is
    # a transient for the toplevel. We need to display the listbox as
    # a transient to prevent the window manage providing decoration
    # (borders and a title bar).
    # Note that we grid the listbox and scrollbar directly into the
    # toplevel, while ttl::combobox has a frame between them.

#   set m_popdownToplevel [toplevel $m_ent.tl -class ComboboxPopdown]
    set m_popdownToplevel [toplevel $m_ent.tl]
    wm withdraw $m_popdownToplevel
    switch -- [tk windowingsystem] {
        x11 {
        $m_popdownToplevel configure -relief flat -borderwidth 0
        wm attributes $m_popdownToplevel -type combo
        wm overrideredirect $m_popdownToplevel true
        }

        win32 {
        $m_popdownToplevel configure -relief flat -borderwidth 0
        wm attributes $m_popdownToplevel -topmost 1
        wm overrideredirect $m_popdownToplevel true
        }

        default {
        error "Unsupported windoing system [tk windowingsystem]"
        }
    }

    # Create frame and pack it into the toplevel

    set m_popdownFrame [ttk::frame $m_popdownToplevel.frm             \
                -style ComboboxPopdownFrame]
    pack $m_popdownFrame -fill both -expand yes

    # Create a listbox and scrollbar grid them into the frame and link them
    # together

    set m_popdownListbox [listbox $m_popdownFrame.lb                      \
                  -selectmode browse                          \
                  -activestyle none                           \
                  -exportselection false]
                                        # Flags cribbed from ttk/combox/tcl
    grid $m_popdownListbox -row 0 -column 0 -sticky nsew
                                        # ttk::combobox also quotes           \
                                        #      -padx {1 0} -pady 1

    set m_popdownScrollbar                                            \
        [scrollbar $m_popdownFrame.sb -orient vertical                \
         -command [list $m_popdownListbox yview]]
    grid $m_popdownScrollbar -row 0 -column 1 -sticky ns

    $m_popdownListbox configure                                       \
        -yscrollcommand [list $m_popdownScrollbar set]

    # Configure the grid

    grid rowconfigure $m_popdownToplevel 0 -weight 1
    grid columnconfigure $m_popdownToplevel 0 -weight 1
    grid columnconfigure $m_popdownToplevel 1 -weight 0
    }

    #----------------------------------------------------------------------
    #
    # Post
    #
    #     Position and display the lisbox associated with the entry
    #
    #----------------------------------------------------------------------

    method Post {} {
    update idletasks;          # Apparently require for geometry
    # propogation - presumably to proogate
    # the listbox (and possibly scrollbar)
    # geometry to the popdown toplevel.

    # Get the geometry of the linked entry widget

    set x [winfo rootx $m_ent]
    set y [winfo rooty $m_ent]
    set h [winfo height $m_ent]
    set w [winfo width $m_ent]

    # Place the popdown below the entry if there's space, otherwise
    # above it.

    set H [winfo reqheight $m_popdownFrame]
    if {$y + $h + $H < [winfo screenheight $m_popdownFrame]} {
        set Y [expr $y + $h]
    } else {
        set Y [expr $y - $H]
    }

    wm geometry $m_popdownToplevel ${w}x${H}+$x+$Y
    wm transient $m_popdownToplevel [winfo toplevel $m_ent]
    # ttk::combobox only does this for x11
    # and win32, but we don't support other
    # windowing systems

    # ttk::combobox does
    #    wm attribute                     \
    #              $m_popdownToplevel     \
    #                   -topmost 1
    # at this point, but this appears to put
    # a global grab on it (at least on UNIX)
    # This is VERY bad news.
    #       wm attribute $m_popdownToplevel -topmost 1
    wm deiconify $m_popdownToplevel
    raise $m_popdownToplevel
    }

    #----------------------------------------------------------------------
    #
    # SetEntryFromListbox
    #
    #----------------------------------------------------------------------

    method SetEntryFromListbox {} {
    set vals [set [$m_popdownListbox cget -listvariable]]

    set seln 0
    for {set i 0} {$i < [llength $vals]} {incr i -1} {
        if {[$m_popdownListbox selection includes $i]} {
        set seln $i
        break
        }
    }

    $m_ent delete 0 end
    $m_ent insert 0 [lindex $vals $seln]
    }

    method Unpost {} {
    if {[winfo exists $m_popdownToplevel]} {
        wm withdraw $m_popdownToplevel
        # ttk::combobox also does a grab release
        # but we aren't messing with grabs.
    }
    }
}

###############################################################################
#
# Some utility routines for debugging
#
###############################################################################

proc showbindings {w {chn stdout}} {
    foreach evt [bind $w] {
    puts $chn ""
    puts $chn $evt
    puts $chn
    puts $chn [bind $w $evt]
    }
}

proc showwindows {w {indent 0} {chn stdout}} {
    showwindowsrecursively $w $indent $chn

    puts $chn ""
    puts $chn "focus: [focus]"
    puts $chn "grabs: [grab current]"
}

proc scheduleshowbindings {w} {
    showbindings $w

    after 5000 scheduleshowbindings $w
}

proc scheduleshowwindows {w} {
    showwindows $w

    after 5000 scheduleshowwindows $w
}

proc showwindowsrecursively {w indent chn} {
    puts $chn [string repeat " " $indent]$w:\ [winfo class $w]
    set newIndent [expr $indent + 4]
    foreach child [winfo children $w] {
    showwindowsrecursively $child $newIndent $chn
    }
}

proc writebindings {w fnm} {
    set fil [open $fnm w]
    showbindings $w $fil
    close $fil
}

proc writewindows {w fnm} {
    set fil [open $fnm w]
    showwindows $w 0 $fil
    close $fil
}

###############################################################################
#
# mainline code
#
###############################################################################

if {[catch {set retain [winfo viewable .]}]} {
    set retain no
}
package require Tk
if {!$retain} {
    wm withdraw .
}

# Make a uniquely named toplevel

for {set i 0} {[winfo exists .tl$i]} {incr i} {
}
set tl [toplevel .tl$i]
wm title $tl "entryWithCompletion demo v[lindex $HISTORY end-3]"

# Create a frame with three labelled entry widgets gridded into it

set frm [ttk::frame $tl.frm]
pack $frm -fill both -expand yes

array set label {0 "Dummy entry" 1 "State" 2 "Dummy entry"}

for {set i 0} {$i < 3} {incr i} {
    set lbl [ttk::label $frm.l$i -text $label($i)]
    grid $lbl -row $i -column 0 -sticky nsew
    set ent  [ttk::entry $frm.e$i]
    grid $ent -row $i -column 1 -sticky nsew
}

# Add a menu with File > Exit command

set mnu [menu $tl.mnu]
$tl configure -menu $mnu

set m [menu $mnu.file -tearoff no]
$mnu add cascade -label File -underline 0 -menu $m

$m add command -label Exit -underline 1 -command [list destroy $tl]

# Make a new hand-crafted combobox, associated with the second entry widget

entryWithCompletion new $frm.e1 {
    Alabama Alaska Arizona Arkansas California
    Colorado Connecticut Delaware Florida Georgia
    Hawaii Idaho Illinois Indiana Iowa
    Kansas Kentucky Louisiana Maine Maryland
    Massachusetts Michigan Minnesota Mississippi Missouri
    Montana Nebraska Nevada "New Hampshire" "New Jersey"
    "New Mexico" "New York" "North Carolina" "North Dakota" Ohio
    Oklahoma Oregon Pennsylvania "Rhode Island" "South Carolina"
    "South Dakota" Tennessee Texas Utah Vermont
    Virginia Washington "West Virginia" Wisconsin Wyoming
}

focus $frm.e0

# Set up to exit after a minute

if {$tcl_interactive} {
    after 60000 destroy $tl
} else {
    after 60000 exit
}