if {![catch {namespace children ::tinycombo}]} { return }
namespace eval ::tinycombo \
{
# beginning of the ::tinycombo namespace definition

  namespace export tinycombo

# ####################################
#
#   tinycombo
#
set version 0.9
#
#   ulis, (C) 2003
#
#   NOL (no obligation licence)
#
# ------------------------------------
# a combo box based on the tinylist widget
# ####################################

  # ====================
  #
  #   packages
  #
  # ====================
  
  package provide Tinycombo $version
  package provide tinycombo $version
  
  package require Tcl 8.4
  package require Tk 8.4
  
  # ====================
  #
  # options
  #
  # ====================
  
  set w ._tinycombo_entry_test_
  entry $w
  foreach option {
    background 
    disabledbackground
    disabledforeground
    foreground
    highlightbackground
    highlightcolor
    insertbackground
    readonlybackground
    selectbackground
    selectforeground
  } \
  { set $option [$w cget -$option] }
  destroy $w
  eval [format {
  set options \
  {
    {-background background Background %s}
    {-bd -borderwidth}
    {-bg -background}
    {-borderwidth borderWidth BorderWidth 2}
    {-cursor cursor Cursor {}}
    {-disabledbackground disabledBackground DisabledBackground %s}
    {-disabledforeground disabledForeground DisabledForeground %s}
    {-exportselection exportSelection ExportSelection 1}
    {-fg -foreground}
    {-font font Font {}}
    {-foreground foreground Foreground %s}
    {-height height Height 5}
    {-highlightbackground highlightBackground HighlightBackground %s}
    {-highlightcolor highlightColor HighlightColor %s}
    {-highlightthickness highlightThickness HighlightThickness 0}
    {-insertbackground insertBackground Foreground %s}
    {-insertborderwidth insertBorderWidth BorderWidth 0}
    {-insertofftime insertOffTime OffTime 300}
    {-insertontime insertOnTime OnTime 600}
    {-insertwidth insertWidth InsertWidth 2}
    {-invalidcommand invalidCommand InvalidCommand {}}
    {-invcmd -invalidcommand}
    {-justify justify Justify left}
    {-listvariable listVariable Variable {}}
    {-readonlybackground readonlyBackground ReadonlyBackground %s}
    {-relief relief Relief sunken}
    {-selectbackground selectBackground Foreground %s}
    {-selectborderwidth selectBorderWidth BorderWidth 0}
    {-selectforeground selectForeground Background %s}
    {-show show Show {}}
    {-state state State normal}
    {-takefocus takeFocus TakeFocus 0}
    {-textvariable textVariable Variable {}}
    {-validate validate Validate none}
    {-validatecommand validateCommand ValidateCommand {}}
    {-values values Values {}}
    {-vcmd -validatecommand}
    {-width width Width 20}
    {-xscrollcommand xScrollCommand ScrollCommand {}}
  }
               } $background $disabledbackground $disabledforeground \
                 $foreground $highlightbackground $highlightcolor \
                 $insertbackground $readonlybackground \
                 $selectbackground $selectforeground]               
    # --------------------
    # get:default
    # --
    # get a default value
    # --------------------
    # parm1: key of the option or empty
    # --------------------
    # return: parameter definition or all definitions if empty parm1
    # --------------------
    proc get:default {{key ""}} \
    {
      variable options
      if {$key == ""} \
      { 
        # all options
        return $options 
      } \
      else \
      {
        # the selected option
        foreach item $options \
        { if {[string match $key [lindex $item 0]]} { return $item } }
        error "\"$key\" does not match a tinycombo option"
      }
    }
  
    # --------------------
    # set:default
    # --
    # set a default value
    # --------------------
    # parm1: key of the option
    # parm2: associated default value
    # --------------------
    proc set:default {key value} \
    {
      variable options
      set found 0
      foreach item $options \
      { 
        if {[string match $key [lindex $item 0]]} \
        { 
          set item [lreplace $item 3 3 $value]
          set key ""
          set found 1
        } 
        lappend new $item
      }
      if {!$found} { error "\"$key\" does not match a tinycombo option" }
      set options $new
    }
  
  # ==========================
  #
  # commands syntax check
  #
  # ==========================

  set optmsg \
  {bbox, cget, component, configure, curselection, delete, get, icursor, index, insert, scan, selection, send, size, validate or xview}
  array set cmdmsg \
  { 
    bbox        {}
    cget:1      {}
    cget        {cget option}
    component:1 {}
    component   {component name}
    config      {}
    cursel:0    {}
    cursel      {curselection}
    delete      {}
    get         {}
    icursor     {}
    index       {}
    insert      {}
    itemcget    {}
    itemconf    {}
    scan        {}
    selection   {}
    send:1      {}
    send        {send keyname}
    size        {}
    validate    {}
    xview       {}
  }

  # ====================
  #
  # inits
  #
  # ====================
  
  set w ._tinycombo_
  entry $w
  set font [$w cget -font]
  destroy $w
  unset w
  set inits \
  {
    class                 Tinycombo
    find                  0
    listvariable          {}
    opened                0
    selection             {}
    value                 {}
    values                {}
    b:borderwidth         0
    b:highlightthickness  0
    b:image               _tinycombo_
    b:width               16
    e:borderwidth         0
    e:highlightthickness  0
    e:relief              flat
    e:selectborderwidth   0
    l:activestyle         none
    l:borderwidth         0
    l:highlightthickness  0
    l:relief              flat
    t:relief              raised
  }

    # --------------------
    # get:initial
    # --
    # get an initial value
    # --------------------
    # parm1: key of the parameter
    # --------------------
    # return: initial value
    # --------------------
    proc get:initial {key} \
    {
      variable inits
      array set ia $inits
      if {![info exists ia($key)]} \
      { error "\"$key\" does not match a tinycombo parameter" }
      return $ia($key)
    }
  
    # --------------------
    # set:initial
    # --
    # set an initial value
    # --------------------
    # parm1: key of the parameter
    # parm2: associated initial value
    # --------------------
    proc set:initial {key value} \
    { 
      variable inits
      array set ia $inits
      if {![info exists ia($key)]} \
      { error "\"$key\" does not match a tinycombo parameter" }
      set ia($key) $value
      set inits [array get ia]
    }
  
  # ====================
  #
  # bindings
  #
  # ====================

  bind TinyCombo <ButtonRelease>    [namespace code {top:close  %W}]
  bind TinyCombo <FocusIn>          { focus -force %W.e }

  bind TinyList <<ListboxSelect>>  [namespace code {top:select %W}]
  bind TinyList <Motion>           [namespace code {top:move   %W @0,%y}]

  bind TinyEntry <Destroy>          { destroy [winfo parent %W] }
  bind TinyEntry <FocusIn>          [namespace code {top:raise  %W}]
  bind TinyEntry <Escape>           [namespace code {top:close  %W}]
  bind TinyEntry <Return>           [namespace code {top:select %W}]
  bind TinyEntry <Control-Return>   [namespace code {top:find   %W}]
  bind TinyEntry <Control-Home>     [namespace code {top:home   %W}]
  bind TinyEntry <Prior>            [namespace code {top:prior  %W}]
  bind TinyEntry <Up>               [namespace code {top:up     %W}]
  bind TinyEntry <Down>             [namespace code {top:down   %W}]
  bind TinyEntry <Next>             [namespace code {top:next   %W}]
  bind TinyEntry <Control-End>      [namespace code {top:end    %W}]
  
  # ====================
  #
  # tinycombo image
  #
  # ====================

  set data "
  #define v_width 8
  #define v_height 4
  static unsigned char v_bits[] = { 0xff, 0x7e, 0x3c, 0x18 };"
  image create bitmap _tinycombo_ -data $data

  # ====================
  #
  # create/destroy widget
  #
  # ====================

    # --------------------
    # widget constructor
    # --
    # create a tinycombo
    # --------------------
    # parm1: widget path, widget config
    # --------------------
    # return: path of the widget
    # --------------------
    proc tinycombo {args} \
    {
      variable {}
      variable options
      variable inits
      # check args
      if {[llength $args] < 1} \
      { error "wrong # args: should be \"tinycombo pathName ?options?\"" }
      set w [lindex $args 0]
      set args [lrange $args 1 end]
      # init
      set config {}
      foreach item $options \
      {
        if {[llength $item] > 2} \
        {  
          foreach {key - - value} $item break
          set ($w:$key) $value
          if {$value != ""} { lappend config $key $value }
        }
      }
      foreach {key value} $inits { set ($w:$key) $value }
      set ($w:listvariable) ::tinycombo::($w:values)
      # create frame, entry & button
      frame $w -class $($w:class) -relief $($w:-relief) -bd $($w:-borderwidth)
      entry $w.e -width $($w:-width) -relief $($w:e:relief) -exportselection 0 \
                 -bd $($w:e:borderwidth) -highlightthickness $($w:e:highlightthickness) \
                 -selectborderwidth $($w:e:selectborderwidth)
      button $w.b -image $($w:b:image) -width $($w:b:width) \
                  -highlightthickness $($w:b:highlightthickness) \
                  -command [namespace code [list top:toggle $w]]
#      grid $w.e $w.b -sticky ns
	grid $w.e -row 0 -column 0 -sticky "ew"
	grid $w.b -row 0 -column 1 -sticky "ns"
	grid columnconfigure $w 0 -weight 1
      # bindings
      bindtags $w [list $w TinyCombo Tinycombo Frame . all]
      bindtags $w.e [list $w.e TinyEntry Entry . all]
      bind $w <Destroy> [namespace code [list dispose $w %W]]
      # widget reference
      rename $w ::_$w
      interp alias {} ::$w {} ::tinycombo::dispatch $w
      set ($w:reference) $w
      trace add command $w {rename delete} [namespace code [list reference $w]]
     # configure widget
      set rc [catch \
      {
        eval [linsert $config 0 w:config $w]
        if {$args != ""} { eval [linsert $args 0 w:config $w] }
      } msg]
      if {$rc} \
      {
        catch { destroy $w }
        return -code error $msg
      }
      # trap tolevel references
      interp alias {} ::$w.t {} ::tinycombo::top:forward $w $w.t
      interp alias {} ::$w.t.f {} ::tinycombo::top:forward $w $w.t.f
      interp alias {} ::$w.t.f.l {} ::tinycombo::top:forward $w $w.t.f.l
      interp alias {} ::$w.t.f.vs {} ::tinycombo::top:forward $w $w.t.f.vs
      # return path
      return $w
    }
    
    # --------------------
    # widget destructor
    # --
    # release all ressources
    # --------------------
    # parm1: path of the widget
    # parm2: current destroyed widget path
    # --------------------
    proc dispose {w W} \
    {
      # delete reference proc
      catch { interp expose {} $W }
      catch { rename $W "" }
      # skip if not tinylist
      if {$w != $W} { return }
      # delete toplevel
      catch { destroy $w.t }
      # delete old trace
      variable {}
      set oldname $($w:listvariable)
      if {$oldname != ""} \
      {
        global $oldname
        trace vdelete $oldname w [namespace code [list set:list $w]]
      }
      # delete reference proc
      catch { rename $($w:reference) "" }
      # delete all variables
      array unset {} $w:* 
    }

    # -------------
    # dispatch 
    # -
    # dispatch the operations of a tinycombo widget
    # -------------
    # parm1: widget path
    # parm2: called operation, operation args
    # -------------
    # return: depending on operation
    # -------------

    proc dispatch {w {cmd ""} args} \
    { 
      variable {}
      variable optmsg
      variable cmdmsg
      # check args
      if {$cmd == ""} { error "wrong # args: should be \"$w option ?arg arg ...?\"" }
      # catch error
      set rc [catch {
        # retrieve command
        foreach {pattern op} \
        { 
          bbo*    bbox
          cge*    cget
          com*    component
          con*    config
          cur*    cursel
          del*    delete
          get     get
          icu*    icursor
          ind*    index
          ins*    insert
          itemcg* itemcget
          itemco* itemconf
          sca*    scan
          sel*    selection
          sen*    send
          siz*    size
          val*    validate
          xvi*    xview
        } \
        { if {[string match $pattern $cmd]} { set oper $op; break } }
        if {![info exists oper]} { error "bad option \"$cmd\": must be $optmsg" }
        # check args
        set n [llength $args]
        if {[info exists cmdmsg($oper:$n)]} { set msg $cmdmsg($oper:$n) } \
        else { set msg $cmdmsg($oper) }
        if {$msg != ""} { error "wrong # args: should be \"$w $msg\"" }
        # eval operation
        eval [linsert $args 0 w:$oper $w]
      } msg]
      # return result
      if {$rc} \
      {
        set code error
        set map [list $w.e $w $w.t.f.l $w entry tinycombo tinylist tinycombo]
        set msg [string map $map $msg]
      } \
      else { set code ok }
      return -code $code $msg
    }

    # -------------
    # reference
    # -
    # trace reference name 
    # -------------
    # parm1: widget path
    # parm2: reference old name
    # parm3: reference new name
    # parm4: triggered op
    # -------------

    proc reference {w old new op} \
    {
      if {$new == ""} \
      { 
        # deleting
        catch { destroy $w } 
      } \
      else \
      { 
        # renaming
        uplevel 1 [format { set ::tinycombo::var [namespace which %s] } $new]
        set new $::tinycombo::var
        set ::tinycombo::($w:reference) $new 
      }
    }
  
  # ====================
  #
  # options
  #
  # ====================

    # --------------------
    # w:config
    # --
    # configure the widget
    # --------------------
    # parm1: path of the widget
    # parm2: widget config or option key or empty
    # -------------
    # return: option(s) description if parm2 is a key or empty
    # --------------------
    proc w:config {w args} \
    {
      variable {}
      # check if description request
      if {[llength $args] < 2} { return [eval get:option $w $args] }
      # update config
      foreach {key value} $args \
      {
        switch -glob -- $key \
        {
          -bg         -
          -bac*       \
          {
            # -background
            set ($w:-background) $value
            $w.e config -bg $value
            if {[winfo exists $w.t]} { $w.t.f.l config -bg $value }
          }
          -bd         -
          -bor*       \
          {
            # -borderwidth
            set ($w:-borderwidth) [winfo pixels . $value]
            _$w config -bd $value
            if {[winfo exists $w.t]} { $w.t.f.l config -bd $value }
          }
          -cur*       \
          {
            # -cursor
            set ($w:-cursor) $value
            _$w config -cursor $value
          }
          -disb*      -
          -disabledb* \
          {
            # -disabledbackground
            set ($w:-disabledbackground) $value
            $w.e config -disabledbackground $value
          }
          -disf*      -
          -disabledf* \
          {
            # -disabledforeground
            set ($w:-disabledforeground) $value
            $w.e config -disabledforeground $value
          }
          -exp*       \
          {
            # -exportselection
            set ($w:-exportselection) [expr {$value ? 1 : 0}]
            if {$value} \
            { 
              ::selection handle $w [namespace code [list xsel:handle $w]] 
              if {$($w:selection) != ""} { ::selection own $w }
            }
          }
          -fon*       \
          {
            # -font
            set ($w:-font) $value
            if {$value == ""} { set value $::tinycombo::font }
            $w.e config -font $value
            if {[winfo exists $w.t]} { $w.t.f.l config -font $value }
          }
          -fg         -
          -for*       \
          {
            # -foreground
            set ($w:-foreground) $value
            $w.e config -fg $value
            if {[winfo exists $w.t]} { $w.t.f.l config -fg $value }
          }
          -hei*       \
          {
            # -height
            if {![string is integer -strict $value]} \
            { error "expected integer but got \"$value\"" }
            set ($w:-height) $value
            if {[winfo exists $w.t]} {$w.t.f.l config -height $value}
          }
          -highb*     -
          -highlightb*  \
          {
            # -highlightbackground
            set ($w:-highlightbackground) $value
            _$w config -highlightbackground $value
          }
          -highc*     -
          -highlightc*  \
          {
            # -highlightcolor
            set ($w:-highlightcolor) $value
            _$w config -highlightcolor $value
          }
          -hight*     -
          -highlightt*  \
          {
            # -highlightthickness
            _$w config -highlightthickness $value
            set ($w:-highlightthickness) [_$w cget -highlightthickness]
          }
          -insbg      -
          -insba*     -
          -insertba*  \
          {
            # -insertbackground
            set ($w:-insertbackground) $value
            $w.e config -insertbackground $value
          }
          -insbg      -
          -insbo*     -
          -insertbo*  \
          {
            # -insertborderwidth
            set ($w:-insertborderwidth) [winfo pixels . $value]
            $w.e config -insertborderwidth $value
          }
          -insof*     -
          -insertof*  \
          {
            # -insertofftime
            set ($w:-insertofftime) $value
            $w.e config -insertofftime $value
          }
          -inson*     -
          -inserton*  \
          {
            # -insertontime
            set ($w:-insertontime) $value
            $w.e config -insertontime $value
          }
          -insw*      -
          -insertw*   \
          {
            # -insertwidth
            set ($w:-insertwidth) [winfo pixels . $value]
            $w.e config -insertwidth $value
          }
          -invc*      -
          -inva*      \
          {
            # -invalidcommand/-invcmd
            set ($w:-invalidcommand) $value
            $w.e config -invalidcommand $value
          }
          -jus*       \
          {
            # -justify
            set ($w:-justify) $value
            $w.e config -justify $value
          }
          -lis*       \
          {
            # -listvariable
            listvar $w $value
          }
          -rea*       \
          {
            # -readonlybackground
            set ($w:-readonlybackground) $value
            $w.e config -readonlybackground $value
          }
          -rel*       \
          {
            # -relief
            switch -glob -- $value \
            {
              fla*    { set value flat }
              gro*    { set value groove }
              rai*    { set value raised }
              rid*    { set value ridge }
              sol*    { set value solid }
              sun*    { set value sunken }
              default { error "bad relief \"$value\": must be flat, groove, raised, ridge, solid, or sunken" }
            }
            set ($w:-relief) $value
            _$w config -relief $value
          }
          -selbg      -
          -selba*     -
          -selectba*  \
          {
            # -selectbackground
            set ($w:-selectbackground) $value
            $w.e config -selectbackground $value
            if {[winfo exists $w.t]} { $w.t.f.l config -selectbackground $value }
          }
          -selbd      -
          -selbo*     -
          -selectbo*  \
          {
            # -selectborderwidth
            set ($w:-selectborderwidth) [winfo pixels . $value]
            $w.e config -selectborderwidth $value
            if {[winfo exists $w.t]} { $w.t.f.l config -selectborderwidth $value }
          }
          -self*      -
          -selectf*   \
          {
            # -selectforeground
            set ($w:-selectforeground) $value
            $w.e config -selectforeground $value
            if {[winfo exists $w.t]} { $w.t.f.l config -selectforeground $value }
          }
          -sho*       \
          {
            # -show
            set ($w:-show) $value
            $w.e config -show $value
          }
          -sta*       \
          {
            # -state
            switch -glob -- $value \
            {
              d*    { set value disabled }
              n*    { set value normal }
              r*    { set value readonly }
              default { error "bad state \"$value\": must be disabled, normal, or readonly" }
            }
            set ($w:-state) $value
            $w.e config -state $value
          }
          -tak*       \
          {
            # -takefocus
            set ($w:-takefocus) $value
            _$w config -takefocus $value
          }
          -tex*       \
          {
            # -textvariable
            set ($w:-textvariable) $value
            $w.e config -textvariable $value
          }
          -validate   \
          {
            # -validate
            set ($w:-validate) $value
            switch -glob -- $value \
            {
              all     { set value all }
              focus   { set value focus }
              focusi* { set value focusin }
              focuso* { set value focusout }
              key     { set value key }
              non*    { set value none }
              default { error "bad validation mode \"$value\": must be none, focus, focusin, focusout, key or all" }
            }
            set ($w:-validate) $value
            $w.e config -validate $value
          }
          -vcm*       -
          -validatec* \
          {
            # -validatecommand/-vcmd
            set ($w:-validatecommand) $value
            $w.e config -validatecommand $value
          }
          -valu*      \
          {
            # -values
            set ($w:values) $value
            listvar $w ""
          }
          -wid*       \
          {
            # -width
            if {![string is integer -strict $value]} \
            { error "expected integer but got \"$value\"" }
            set ($w:-width) $value
            $w.e config -width $value
            if {[winfo exists $w.t]} { $w.t.f.l config -width $value }
          }
          -xsc*       \
          {
            # -xscrollcommand
            set ($w:-xscrollcommand) $value
            $w.e config -xscrollcommand $value
          }
          default     { error "unknown option \"$key\"" }
        }
      }
    }
    
    # --------------------
    # get:option
    # --
    # get option(s) description
    # --------------------
    # parm1: path of the widget
    # parm2: key or empty
    # -------------
    # return: option(s) description
    # --------------------
    proc get:option {w {key ""}} \
    {
      variable {}
      variable options
      if {$key == ""} \
      {
        # all options
        set result {}
        foreach option $options \
        {
          if {[llength $option] > 2} \
          { 
            set key [lindex $option 0]
            lappend option $($w:$key) 
          }
          lappend result $option
        }
      } \
      else \
      {
        # the specified option
        foreach option $options \
        {
          if {[string match $key [lindex $option 0]]} \
          {
            if {[llength $option] == 2} \
            { set result [get:option $w [lindex $option 1]] } \
            else \
            { set result [concat $option [list $($w:$key)]] }
            break
          }
        }
        if {![info exists result]} { error "unknown option \"$key\"" }
      }
      return $result
    }
    
    # --------------------
    # w:cget
    # --
    # get an option value
    # --------------------
    # parm1: path of the widget
    # parm2: key
    # -------------
    # return: associated option value
    # --------------------
    proc w:cget {w key} \
    {
      variable {}
      switch -glob -- $key \
      {
        -bg         -
        -bac*       \
        {
          # -background
          set ($w:-background)
        }
        -bd         -
        -bor*       \
        {
          # -borderwidth
          set ($w:-borderwidth)
        }
        -cur*       \
        {
          # -cursor
          set ($w:-cursor)
        }
        -disb*      -
        -disabledb* \
        {
          # -disabledbackground
          set ($w:-disabledbackground)
        }
        -disf*      -
        -disabledf* \
        {
          # -disabledforeground
          set ($w:-disabledforeground)
        }
        -exp*       \
        {
          # -exportselection
          set ($w:-exportselection)
        }
        -fon*       \
        {
          # -font
          set ($w:-font)
        }
        -fg         -
        -for*       \
        {
          # -foreground
          set ($w:-foreground)
        }
        -hei*       \
        {
          # -height
          set ($w:-height)
        }
        -highb*     -
        -highlightb*  \
        {
          # -highlightbackground
          set ($w:-highlightbackground)
        }
        -highc*     -
        -highlightc*  \
        {
          # -highlightcolor
          set ($w:-highlightcolor)
        }
        -hight*     -
        -highlightt*  \
        {
          # -highlightthickness
          set ($w:-highlightthickness)
        }
        -insbg      -
        -insba*     -
        -insertba*  \
        {
          # -insertbackground
          set ($w:-insertbackground)
        }
        -insbg      -
        -insbo*     -
        -insertbo*  \
        {
          # -insertborderwidth
          set ($w:-insertborderwidth)
        }
        -insof*     -
        -insertof*  \
        {
          # -insertofftime
          set ($w:-insertofftime)
        }
        -inson*     -
        -inserton*  \
        {
          # -insertontime
          set ($w:-insertontime)
        }
        -insw*      -
        -insertw*   \
        {
          # -insertwidth
          set ($w:-insertwidth)
        }
        -invc*      -
        -inva*      \
        {
          # -invalidcommand/-invcmd
          set ($w:-invalidcommand)
        }
        -jus*       \
        {
          # -justify
          set ($w:-justify)
        }
        -lis*       \
        {
          # -listvariable
          set ($w:-listvariable)
        }
        -rea*       \
        {
          # -readonlybackground
          set ($w:-readonlybackground)
        }
        -rel*       \
        {
          # -relief
          set ($w:-relief)
        }
        -selbg      -
        -selba*     -
        -selectba*  \
        {
          # -selectbackground
          set ($w:-selectbackground)
        }
        -selbd      -
        -selbo*     -
        -selectbo*  \
        {
          # -selectborderwidth
          set ($w:-selectborderwidth)
        }
        -self*      -
        -selectf*   \
        {
          # -selectforeground
          set ($w:-selectforeground)
        }
        -sho*       \
        {
          # -show
          set ($w:-show)
        }
        -sta*       \
        {
          # -state
          set ($w:-state)
        }
        -tak*       \
        {
          # -takefocus
          set ($w:-takefocus)
        }
        -tex*       \
        {
          # -textvariable
          set ($w:-textvariable)
        }
        -validate   \
        {
          # -validate
          #set ($w:-validate)
          $w.e cget -validate
        }
        -vcm*       -
        -validatec* \
        {
          # -validatecommand/-vcmd
          set ($w:-validatecommand)
        }
        -valu*      \
        {
          # -values
          set [set ($w:values)]
        }
        -wid*       \
        {
          # -width
          set ($w:-width)
        }
        -xsc*       \
        {
          # -xscrollcommand
          set ($w:-xscrollcommand)
        }
        default     { error "unknown option \"$key\"" }
      }
    }
    
  # ====================
  #
  # create/reference toplevel
  #
  # ====================

    # --------------------
    # toplevel constructor
    # --
    # create the widget associated toplevel
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc top:create {w} \
    {
      variable {}
      # create toplevel, tinylist and scroll bar
      catch \
      {
        interp alias {} ::$w.t {}
        interp alias {} ::$w.t.f {}
        interp alias {} ::$w.t.f.l {}
        interp alias {} ::$w.t.f.vs {}
      }
      toplevel $w.t
      wm withdraw $w.t
      wm overrideredirect $w.t 1
      frame $w.t.f -relief $($w:t:relief) -bd $($w:-borderwidth)
      scrollbar $w.t.f.vs -command [namespace code [list top:yview $w]]
      listbox  $w.t.f.l -listvariable $($w:listvariable) \
               -height $($w:-height) -bg $($w:-background)\
               -relief $($w:l:relief) -bd $($w:l:borderwidth) \
               -font [$w.e cget -font] \
               -activestyle $($w:l:activestyle) \
               -highlightthickness $($w:l:highlightthickness) \
               -yscrollcommand [namespace code [list top:yset $w]]              
#      pack $w.t.f
	# SUIT
	pack $w.t.f -fill both -expand yes
	# SUIT
      grid $w.t.f.l  -row 0 -column 0 -padx 1 -pady 1 \
	  -sticky "snew"
      grid $w.t.f.vs -row 0 -column 1 -sticky ns
	# SUIT
	grid rowconfigure $w.t.f 0 -weight 1
	grid columnconfigure $w.t.f 0 -weight 1
	# SUIT
      # binding
      bind $w.t.f.l  <<ListboxSelect>>  [namespace code [list top:select $w]]
      bind $w.t.f.l  <Motion>           [namespace code [list top:move   $w @0,%y]]
      bindtags $w.t.f.l [linsert [bindtags $w.t.f.l] 1 TinyList]
    }

    # --------------------
    # toplevel reference
    # --
    # reference to the toplevel
    # --------------------
    # parm1: path of the widget
    # parm2: path of the referenced widget
    # parm3: arguments
    # --------------------
    proc top:forward {w W args} \
    {
      top:create $w
      eval $W $args
    }

  # ====================
  #
  # toplevel actions
  #
  # ====================

  # --------------------
  # getting widget path
  # --------------------

    # --------------------
    # top:widget
    # --
    # get widget path
    # --------------------
    # parm1: path of the subwidget
    # --------------------
    # return: path of the widget
    # --------------------
    proc top:widget {w} \
    {
      switch [winfo class $w] \
      {
        Entry     { set w [winfo parent $w] }
        Listbox   { set w [join [lrange [split $w .] 0 end-3] .] }
      }
      return $w
    }
  
  # --------------------
  # opening/closing
  # --------------------

    # --------------------
    # top:toggle
    # --
    # toggle between open & close
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc top:toggle {w} \
    {
      variable {}
      set w [top:widget $w]
      # toggle between open & close
      if {$($w:opened)} { top:close $w } else { top:open $w }
    }
    
    # --------------------
    # top:open
    # --
    # open the toplevel
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc top:open {w} \
    {
      variable {}
      set w [top:widget $w]
      # set opened flag
      set ($w:opened) 1
      # create toplevel if needed
      if {![winfo exists $w.t]} { top:create $w }
      # open toplevel
      focus -force $w.e
	# SUIT
	set ww [winfo width $w]
	# SUIT
      set x [expr [winfo rootx $w] + 0]
      set y [expr [winfo rooty $w] + [winfo height $w]]
      if {[expr {$y + [winfo height $w.t]}] > [winfo screenheight $w.t]} \
      { set y [expr [winfo rooty $w] - [winfo height $w.t]] }
	#wm geometry $w.t +$x+$y
	# SUIT
	update
	set hh [winfo height $w.t]
	set _hh [winfo reqheight $w.t]
	wm geometry $w.t ${ww}x[expr $hh<$_hh?$_hh:$hh]+$x+$y
	# SUIT
      wm deiconify $w.t
      raise $w.t
      # set grab
      array unset {} $w:grab:*
      foreach win [grab current] { set ($w:grab:$win) [grab status $win] }
      grab set -global $w
      # inti finding
      set ($w:find) 0
    }

    # --------------------
    # top:close
    # --
    # close the toplevel
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc top:close {w} \
    {
      variable {}
      set w [top:widget $w]
      if {!$($w:opened)} { return }
      # reset opened flag
      set ($w:opened) 0
      # close window
      wm withdraw $w.t
      # restitute old grab
      grab release $w
      foreach win [array names ::grab] \
      {
        switch $::grab($win) \
        {
          local     { grab set $win }
          global    { grab set -global $win }
        }
      }
    }

  # --------------------
  # raising 
  # --------------------

    # --------------------
    # top:raise
    # --
    # raise the toplevel
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc top:raise {w} \
    { 
      set w [top:widget $w]
      if {[winfo exists $w.t]} { raise $w.t $w }
    }

  # --------------------
  # scrolling
  # --------------------

    # --------------------
    # top:yview
    # --
    # reset focus to entry after scroll bar activation
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc top:yview {w args} \
    {
      set w [top:widget $w]
      eval $w.t.f.l yview $args
      focus -force $w.e
    }

    # --------------------
    # top:yset
    # --
    # show/hide the scroll bar
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc top:yset {w args} \
    {
      set w [top:widget $w]
      eval $w.t.f.vs set $args
      if {$args == {0 1}} { grid forget $w.t.f.vs } \
      else { grid $w.t.f.vs -row 0 -column 1 -sticky ns }
    }

  # --------------------
  # selecting
  # --------------------

    # --------------------
    # top:select
    # --
    # change the entry value with a row value
    # --------------------
    # parm1: path of the widget
    # parm2: index of the row or empty
    # parm3: close flag or empty
    # --------------------
    proc top:select {w {index ""} {close 1}} \
    {
      variable {}
      set w [top:widget $w]
      if {$index == ""} { set index [$w.t.f.l curselection] }
      if {$index == ""} { set index 0 }
	# SUIT
	set _state_ [$w.e cget -state]
	$w.e configure -state normal
	# SUIT
      $w.e delete 0 end
      $w.e insert 0 [lindex [set $($w:listvariable)] $index]
	# SUIT
	$w.e configure -state $_state_
	# SUIT
      if {$close} { top:close $w}
    }

  # --------------------
  # moving
  # --------------------

    # --------------------
    # w:send
    # --
    # simulate a key send
    # --------------------
    # parm1: path of the widget
    # parm2: key name
    # --------------------
    proc w:send {w key} \
    {
      switch -- $key \
      {
        <Escape>          { top:close  $w }
        <Return>          { top:select $w }
        <Control-Return>  { top:find   $w }
        <Control-Home>    { top:home   $w }
        <Prior>           { top:prior  $w }
        <Up>              { top:up     $w }
        <Down>            { top:down   $w }
        <Next>            { top:next   $w }
        <Control-End>     { top:end    $w }
        default           { error "unknown key symbol \"$key\"" }
      }
    }
    
    # --------------------
    # top:move
    # --
    # move the index of the selected row
    # --------------------
    # parm1: path of the widget
    # parm2: index of the new selected row
    # --------------------
    proc top:move {w index} \
    {
      set w [top:widget $w]
      $w.t.f.l selection clear 0 end
      $w.t.f.l selection set $index
      $w.t.f.l see $index
    }

    # --------------------
    # top:home
    # --
    # move the selected row to the top
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc top:home {w} \
    {
      variable {}
      set w [top:widget $w]
      if {!$($w:opened)} { top:toggle $w }
      top:move $w 0
    }

    # --------------------
    # top:prior
    # --
    # move the selected one page before
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc top:prior {w} \
    {
      variable {}
      set w [top:widget $w]
      if {!$($w:opened)} { top:toggle $w }
      set index [$w.t.f.l curselection]
      if {$index == ""} { top:home $w } \
      else \
      {
        incr index
        incr index -$($w:-height)
        if {$index < 0} { top:home $w } \
        else { top:move $w $index }
      }
    }

    # --------------------
    # top:up
    # --
    # move the selected one row before
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc top:up {w} \
    {
      variable {}
      set w [top:widget $w]
      if {!$($w:opened)} { top:toggle $w }
      set index [$w.t.f.l curselection]
      if {$index == "" || $index == 0} { top:home $w } \
      else { top:move $w [incr index -1] }
    }

    # --------------------
    # top:down
    # --
    # move the selected one row after
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc top:down {w} \
    {
      variable {}
      set w [top:widget $w]
      if {!$($w:opened)} { top:toggle $w }
      set index [$w.t.f.l curselection]
      if {$index == ""} { top:home $w } \
      elseif {$index + 1 < $($w:count)} { top:move $w [incr index] }
    }

    # --------------------
    # top:next
    # --
    # move the selected one page after
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc top:next {w} \
    {
      variable {}
      set w [top:widget $w]
      if {!$($w:opened)} { top:toggle $w }
      set index [$w.t.f.l curselection]
      if {$index == ""} { top:home $w } \
      else \
      {
        incr index -1
        incr index $($w:-height)
        if {$index >= $($w:count)} { top:end $w } \
        else { top:move $w $index }
      }
    }

    # --------------------
    # top:home
    # --
    # move the selected row to the bottom
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc top:end {w} \
    {
      variable {}
      set w [top:widget $w]
      if {!$($w:opened)} { top:toggle $w }
      top:move $w [expr {$($w:count) - 1}]
    }

  # --------------------
  # finding
  # --------------------

    # --------------------
    # top:find
    # --
    # find the next occurrence of the pattern
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc top:find {w} \
    {
      variable {}
      set w [top:widget $w]
      if {!$($w:opened)} { top:toggle $w; return }
      set index [$w.t.f.l curselection]
      if {$index == ""} { set index 0 } \
      elseif {$($w:find)} { incr index }
      set ($w:find) 1
      set pattern [$w.e get]
      for {set i $index} {$i < $($w:count)} {incr i} \
      {
        set item [lindex [set $($w:listvariable)] $i]
        if {[string match $pattern $item]} { top:move $w $i; return }
      }
    }

  # ====================
  #
  # entry operations
  #
  # ====================

    # --------------------
    # w:bbox
    # --
    # 
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc w:bbox {w args} { eval $w.e bbox $args }

    # --------------------
    # w:cursel
    # --
    # return the entry selection
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc w:cursel {w} { variable {}; return $($w:selection) }

    # --------------------
    # w:delete
    # --
    # 
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc w:delete {w args} { eval $w.e delete $args }

    # --------------------
    # w:get
    # --
    # 
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc w:get {w args} { eval $w.e get $args }

    # --------------------
    # w:icursor
    # --
    # 
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc w:icursor {w args} { eval $w.e icursor $args }

    # --------------------
    # w:index
    # --
    # 
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc w:index {w args} { eval $w.e index $args }

    # --------------------
    # w:insert
    # --
    # 
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc w:insert {w args} { eval $w.e insert $args }

    # --------------------
    # w:scan
    # --
    # 
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc w:scan {w args} { eval $w.e scan $args }

    # --------------------
    # w:selection
    # --
    # 
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc w:selection {w args} \
    { 
      set res [eval $w.e selection $args ]
      # set X selection
      variable {}
      if {![catch { set first [$w.e index sel.first] }]} \
      {
        set last [$w.e index sel.last]
        set ($w:selection) [string range [$w.e get] $first [incr last -1]]
      } \
      else { set ($w:selection) "" }
      if {$($w:-exportselection)} \
      { 
        if {$($w:selection) == ""} { ::selection clear -selection PRIMARY } \
        else { ::selection own $w }
      }
      return $res
    }

    # --------------------
    # w:validate
    # --
    # 
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc w:validate {w args} { eval $w.e validate $args }
  
    # --------------------
    # w:xview
    # --
    # 
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc w:xview {w args} { eval $w.e xview $args }
  
  # ====================
  #
  # list operations
  #
  # ====================

    # -------------
    # listvar
    # -
    # set the items list variable
    # -------------
    # parm1: widget path
    # parm2: list name
    # -------------
    proc listvar {w listname} \
    {
      variable {}
      # save new name & old name
      set realname $listname
      set oldname $($w:listvariable)
      # get name
      if {$listname == ""} \
      { 
        if {$oldname != ""} { set ($w:values) [set $oldname] }
        set listname ::tinycombo::($w:values) 
      } \
      else \
      {
        if {[string range $listname 0 1] != "::"} \
        {
          uplevel 3 { set ::tinycombo::var [namespace current] }
          append ::tinycombo::var ::$listname
          set listname $::tinycombo::var
        }
      }
      # check if name changed
      if {$oldname == $listname && $realname != ""} { return }
      # delete old trace
      if {$oldname != ""} { trace vdelete $oldname w [namespace code [list set:list $w]] }
      # create list if not exists
      if {![info exists $listname]} \
      { 
        # get old values
        set $listname {}
        if {$oldname != ""} { set $listname [set $oldname] }
      }
      # update items count & listvariable
      set ($w:count) [llength [set $listname]]
      set ($w:listvariable) $listname 
      # save real name
      set ($w:-listvariable) $realname 
      # set new trace
      trace variable $listname w [namespace code [list set:list $w]]
      # set tinylist
      if {[winfo exists $w.t]} { $w.t.f.l config -listvar $listname }
      # set entry
      top:select $w 0
    }

    # -------------
    # set:list
    # -
    # called on list change
    # -------------
    # parm1: widget path
    # parm2: dummy
    # -------------
    proc set:list {w args} \
    {
      # set list count
      set listname $::tinycombo::($w:listvariable)
      set ::tinycombo::($w:count) [llength [set $listname]]
    }

    # --------------------
    # w:itemcget
    # --
    # 
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc w:itemcget {w args} \
    { 
      # create toplevel if needed
      if {![winfo exists $w.t]} { top:create $w }
      # do the operation
      eval $w.t.f.l itemcget $args 
    }

    # --------------------
    # w:itemconf
    # --
    # 
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc w:itemconf {w args} \
    { 
      # create toplevel if needed
      if {![winfo exists $w.t]} { top:create $w }
      # do the operation
      eval $w.t.f.l itemconf $args 
    }

    # --------------------
    # w:size
    # --
    # 
    # --------------------
    # parm1: path of the widget
    # --------------------
    proc w:size {w} { variable {}; return $($w:count) }

  # ====================
  #
  # miscellaneous
  #
  # ====================

    # -------------
    # xsel:handle
    # -
    # handle X selection
    # -------------
    # parm1: widget path
    # parm2: offset inside the selection
    # parm3: chunk max chars count
    # -------------

    proc xsel:handle {w offset maxchars} \
    {
      variable {}
      if {!$($w:-exportselection)} { error "can't export selection" }
      set res [string range $($w:selection) $offset [expr {$offset + $maxchars - 1}]]
      if {$($w:-show) != ""} { set res [string repeat $($w:-show) [string length $res]] }
      return $res
    }
  
    # -------------
    # component
    # -
    # return a component path
    # -------------
    # parm1: widget path
    # parm2: component name
    # -------------
    proc w:component {w name} \
    {
      switch -glob -- $name \
      {
        but*    { return $w.b }
        ent*    { return $w.e }
        lis*    { return $w.t.f.l }
        scr*    { return $w.t.f.vs }
        default { error "unknown component \"$name\": must be button, entry, listbox or scrollbar" }
      }
    }
    
}
# end of the ::tinycombo namespace definition

