home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rexxtk12.zip / extensions / rexxtkcombobox.c next >
Text File  |  2002-08-07  |  48KB  |  1,405 lines
  1. /*
  2.  *  Rexx/Tk Combobox Extension
  3.  *  Copyright (C) 2000  Mark Hessling  <M.Hessling@qut.edu.au>
  4.  *
  5.  *  This library is free software; you can redistribute it and/or
  6.  *  modify it under the terms of the GNU Library General Public
  7.  *  License as published by the Free Software Foundation; either
  8.  *  version 2 of the License, or (at your option) any later version.
  9.  *
  10.  *  This library is distributed in the hope that it will be useful,
  11.  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  12.  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13.  *  Library General Public License for more details.
  14.  *
  15.  *  You should have received a copy of the GNU Library General Public
  16.  *  License along with this library; if not, write to the Free
  17.  *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  */
  19.  
  20.  
  21. #include "rexxtk.h"
  22.  
  23. char *RxPackageName = "rexxtkcombobox";
  24. char *ExtensionSource =
  25.    "package require Tk 8.0\n"
  26.    "package provide combobox 2.0\n"
  27.    "namespace eval ::combobox {\n"
  28.    "namespace export combobox\n"
  29.    "variable widgetOptions\n"
  30.    "variable widgetCommands\n"
  31.    "variable scanCommands\n"
  32.    "variable listCommands\n"
  33.    "}\n"
  34.    "proc ::combobox::combobox {w args} {\n"
  35.    "variable widgetOptions\n"
  36.    "variable widgetCommands\n"
  37.    "variable scanCommands\n"
  38.    "variable listCommands\n"
  39.    "if {![info exists widgetOptions]} {\n"
  40.    "Init\n"
  41.    "}\n"
  42.    "eval Build $w $args\n"
  43.    "SetBindings $w\n"
  44.    "return $w\n"
  45.    "}\n"
  46.    "proc ::combobox::Init {} {\n"
  47.    "variable widgetOptions\n"
  48.    "variable widgetCommands\n"
  49.    "variable scanCommands\n"
  50.    "variable listCommands\n"
  51.    "variable defaultEntryCursor\n"
  52.    "array set widgetOptions [list  "
  53.    "-background          {background          Background}  "
  54.    "-bd                  -borderwidth  "
  55.    "-bg                  -background  "
  56.    "-borderwidth         {borderWidth         BorderWidth}  "
  57.    "-command             {command             Command}  "
  58.    "-commandstate        {commandState        State}  "
  59.    "-cursor              {cursor              Cursor}  "
  60.    "-editable            {editable            Editable}  "
  61.    "-fg                  -foreground  "
  62.    "-font                {font                Font}  "
  63.    "-foreground          {foreground          Foreground}  "
  64.    "-height              {height              Height}  "
  65.    "-highlightbackground {highlightBackground HighlightBackground}  "
  66.    "-highlightcolor      {highlightColor      HighlightColor}  "
  67.    "-highlightthickness  {highlightThickness  HighlightThickness}  "
  68.    "-image               {image               Image}  "
  69.    "-maxheight           {maxHeight           Height}  "
  70.    "-relief              {relief              Relief}  "
  71.    "-selectbackground    {selectBackground    Foreground}  "
  72.    "-selectborderwidth   {selectBorderWidth   BorderWidth}  "
  73.    "-selectforeground    {selectForeground    Background}  "
  74.    "-state               {state               State}  "
  75.    "-takefocus           {takeFocus           TakeFocus}  "
  76.    "-textvariable        {textVariable        Variable}  "
  77.    "-value               {value               Value}  "
  78.    "-width               {width               Width}  "
  79.    "-xscrollcommand      {xScrollCommand      ScrollCommand}  "
  80.    "]\n"
  81.    "set widgetCommands [list  "
  82.    "bbox      cget     configure    curselection  "
  83.    "delete    get      icursor      index         "
  84.    "insert    list     scan         selection     "
  85.    "xview     select   toggle       open          "
  86.    "close  "
  87.    "]\n"
  88.    "set listCommands [list  "
  89.    "delete       get       "
  90.    "index        insert       size  "
  91.    "]\n"
  92.    "set scanCommands [list mark dragto]\n"
  93.    "if {[lsearch -exact [package names] \"Tk\"] != -1} {\n"
  94.    "if {$::tcl_platform(platform) == \"windows\"} {\n"
  95.    "image create bitmap ::combobox::bimage -data {\n"
  96.    "#define down_arrow_width 12\n"
  97.    "#define down_arrow_height 12\n"
  98.    "static char down_arrow_bits[] = {\n"
  99.    "0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,\n"
  100.    "0xfc,0xf1,0xf8,0xf0,0x70,0xf0,0x20,0xf0,\n"
  101.    "0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00;\n"
  102.    "}\n"
  103.    "}\n"
  104.    "} else {\n"
  105.    "image create bitmap ::combobox::bimage -data  {\n"
  106.    "#define down_arrow_width 15\n"
  107.    "#define down_arrow_height 15\n"
  108.    "static char down_arrow_bits[] = {\n"
  109.    "0x00,0x80,0x00,0x80,0x00,0x80,0x00,0x80,\n"
  110.    "0x00,0x80,0xf8,0x8f,0xf0,0x87,0xe0,0x83,\n"
  111.    "0xc0,0x81,0x80,0x80,0x00,0x80,0x00,0x80,\n"
  112.    "0x00,0x80,0x00,0x80,0x00,0x80\n"
  113.    "}\n"
  114.    "}\n"
  115.    "}\n"
  116.    "set tmpWidget \".tmp\"\n"
  117.    "set count 0\n"
  118.    "while {[winfo exists $tmpWidget] == 1} {\n"
  119.    "set tmpWidget \".tmp$count\"\n"
  120.    "incr count\n"
  121.    "}\n"
  122.    "scrollbar $tmpWidget\n"
  123.    "set sb_width [winfo reqwidth $tmpWidget]\n"
  124.    "destroy $tmpWidget\n"
  125.    "entry $tmpWidget\n"
  126.    "foreach foo [$tmpWidget configure] {\n"
  127.    "if {[lindex $foo 0] == \"-cursor\"} {\n"
  128.    "set defaultEntryCursor [lindex $foo 4]\n"
  129.    "}\n"
  130.    "if {[llength $foo] == 5} {\n"
  131.    "set option [lindex $foo 1]\n"
  132.    "set value [lindex $foo 4]\n"
  133.    "option add *Combobox.$option $value widgetDefault\n"
  134.    "if {[string compare $option \"foreground\"] == 0  "
  135.    "|| [string compare $option \"background\"] == 0  "
  136.    "|| [string compare $option \"font\"] == 0} {\n"
  137.    "option add *Combobox*ComboboxListbox.$option $value  "
  138.    "widgetDefault\n"
  139.    "}\n"
  140.    "}\n"
  141.    "}\n"
  142.    "destroy $tmpWidget\n"
  143.    "option add *Combobox.cursor              {}\n"
  144.    "option add *Combobox.commandState        normal widgetDefault\n"
  145.    "option add *Combobox.editable            1      widgetDefault\n"
  146.    "option add *Combobox.maxHeight           10     widgetDefault\n"
  147.    "option add *Combobox.height              0\n"
  148.    "}\n"
  149.    "SetClassBindings\n"
  150.    "}\n"
  151.    "proc ::combobox::SetClassBindings {} {\n"
  152.    "bind Combobox <Destroy> [list ::combobox::DestroyHandler %W]\n"
  153.    "set this {[::combobox::convert %W -W]}\n"
  154.    "bind Combobox <Any-ButtonPress>   \"$this close\"\n"
  155.    "bind Combobox <Any-ButtonRelease> \"$this close\"\n"
  156.    "bind Combobox <FocusIn> {tkTabToWindow [::combobox::convert %W -W].entry}\n"
  157.    "bind Combobox <Unmap> {[::combobox::convert %W -W] close}\n"
  158.    "return \"\"\n"
  159.    "}\n"
  160.    "proc ::combobox::SetBindings {w} {\n"
  161.    "upvar ::combobox::${w}::widgets  widgets\n"
  162.    "upvar ::combobox::${w}::options  options\n"
  163.    "bindtags $widgets(entry)  "
  164.    "[concat $widgets(this) [bindtags $widgets(entry)]]\n"
  165.    "bindtags $widgets(button)  "
  166.    "[concat $widgets(this) [bindtags $widgets(button)]]\n"
  167.    "bind $widgets(entry) <Tab>  "
  168.    "\"tkTabToWindow \\[tk_focusNext $widgets(entry)\\]; break\"\n"
  169.    "bind $widgets(entry) <Shift-Tab>  "
  170.    "\"tkTabToWindow \\[tk_focusPrev $widgets(this)\\]; break\"\n"
  171.    "bind $widgets(button) <ButtonPress-1> [list $widgets(this) toggle]\n"
  172.    "bind $widgets(entry) <B1-Enter> \"break\"\n"
  173.    "bind $widgets(listbox) <ButtonRelease-1>  "
  174.    "\"::combobox::Select $widgets(this) \\[$widgets(listbox) nearest %y\\]; break\"\n"
  175.    "bind $widgets(vsb) <ButtonPress-1>   {continue}\n"
  176.    "bind $widgets(vsb) <ButtonRelease-1> {continue}\n"
  177.    "bind $widgets(listbox) <Any-Motion> {\n"
  178.    "%W selection clear 0 end\n"
  179.    "%W activate @%x,%y\n"
  180.    "%W selection anchor @%x,%y\n"
  181.    "%W selection set @%x,%y @%x,%y\n"
  182.    "}\n"
  183.    "foreach event [list <Up> <Down> <Tab> <Return> <Escape>  "
  184.    "<Next> <Prior> <Double-1> <1> <Any-KeyPress>  "
  185.    "<FocusIn> <FocusOut>] {\n"
  186.    "bind $widgets(entry) $event  "
  187.    "\"::combobox::HandleEvent $widgets(this) $event\"\n"
  188.    "}\n"
  189.    "}\n"
  190.    "proc ::combobox::Build {w args } {\n"
  191.    "variable widgetOptions\n"
  192.    "if {[winfo exists $w]} {\n"
  193.    "error \"window name \\\"$w\\\" already exists\"\n"
  194.    "}\n"
  195.    "namespace eval ::combobox::$w {\n"
  196.    "variable ignoreTrace 0\n"
  197.    "variable oldFocus    {}\n"
  198.    "variable oldGrab     {}\n"
  199.    "variable oldValue    {}\n"
  200.    "variable options\n"
  201.    "variable this\n"
  202.    "variable widgets\n"
  203.    "set widgets(foo) foo  ;# coerce into an array\n"
  204.    "set options(foo) foo  ;# coerce into an array\n"
  205.    "unset widgets(foo)\n"
  206.    "unset options(foo)\n"
  207.    "}\n"
  208.    "upvar ::combobox::${w}::widgets widgets\n"
  209.    "upvar ::combobox::${w}::options options\n"
  210.    "set widgets(this)   [frame  $w -class Combobox -takefocus 0]\n"
  211.    "set widgets(entry)  [entry  $w.entry -takefocus 1]\n"
  212.    "set widgets(button) [label  $w.button -takefocus 0]\n"
  213.    "foreach name [array names widgetOptions] {\n"
  214.    "if {[llength $widgetOptions($name)] == 1} continue\n"
  215.    "set optName  [lindex $widgetOptions($name) 0]\n"
  216.    "set optClass [lindex $widgetOptions($name) 1]\n"
  217.    "set value [option get $w $optName $optClass]\n"
  218.    "set options($name) $value\n"
  219.    "}\n"
  220.    "if {[info exists options(-value)]  "
  221.    "&& [string length $options(-value)] == 0} {\n"
  222.    "unset options(-value)\n"
  223.    "}\n"
  224.    "set widgets(frame) ::combobox::${w}::$w\n"
  225.    "pack $widgets(entry)  -side left  -fill both -expand yes\n"
  226.    "pack $widgets(button) -side right -fill y    -expand no\n"
  227.    "array set options $args\n"
  228.    "set widgets(popup)   [toplevel  $w.top]\n"
  229.    "set widgets(listbox) [listbox   $w.top.list]\n"
  230.    "set widgets(vsb)     [scrollbar $w.top.vsb]\n"
  231.    "pack $widgets(listbox) -side left -fill both -expand y\n"
  232.    "$widgets(vsb) configure  "
  233.    "-command \"$widgets(listbox) yview\"  "
  234.    "-highlightthickness 0\n"
  235.    "$widgets(button) configure  "
  236.    "-highlightthickness 0  "
  237.    "-borderwidth 1  "
  238.    "-relief raised  "
  239.    "-width [expr {[winfo reqwidth $widgets(vsb)] - 2}]\n"
  240.    "$widgets(entry) configure  "
  241.    "-borderwidth 0  "
  242.    "-relief flat  "
  243.    "-highlightthickness 0\n"
  244.    "$widgets(popup) configure  "
  245.    "-borderwidth 1  "
  246.    "-relief sunken\n"
  247.    "$widgets(listbox) configure  "
  248.    "-selectmode browse  "
  249.    "-background [$widgets(entry) cget -bg]  "
  250.    "-yscrollcommand \"$widgets(vsb) set\"  "
  251.    "-exportselection false  "
  252.    "-borderwidth 0\n"
  253.    "wm overrideredirect $widgets(popup) 1\n"
  254.    "wm transient        $widgets(popup) [winfo toplevel $w]\n"
  255.    "wm group            $widgets(popup) [winfo parent $w]\n"
  256.    "wm resizable        $widgets(popup) 0 0\n"
  257.    "wm withdraw         $widgets(popup)\n"
  258.    "rename ::$w $widgets(frame)\n"
  259.    "proc ::$w {command args}  "
  260.    "\"eval ::combobox::WidgetProc $w \\$command \\$args\"\n"
  261.    "if {[catch \"::combobox::Configure $widgets(this) [array get options]\" error]} {\n"
  262.    "catch {destroy $w}\n"
  263.    "error $error\n"
  264.    "}\n"
  265.    "return \"\"\n"
  266.    "}\n"
  267.    "proc ::combobox::HandleEvent {w event} {\n"
  268.    "upvar ::combobox::${w}::widgets  widgets\n"
  269.    "upvar ::combobox::${w}::options  options\n"
  270.    "upvar ::combobox::${w}::oldValue oldValue\n"
  271.    "switch $event {\n"
  272.    "\"<Any-KeyPress>\" {\n"
  273.    "if {$options(-editable)} {\n"
  274.    "$widgets(listbox) see 0\n"
  275.    "$widgets(listbox) selection clear 0 end\n"
  276.    "$widgets(listbox) selection anchor 0\n"
  277.    "$widgets(listbox) activate 0\n"
  278.    "}\n"
  279.    "}\n"
  280.    "\"<FocusIn>\" {\n"
  281.    "set oldValue [$widgets(entry) get]\n"
  282.    "}\n"
  283.    "\"<FocusOut>\" {\n"
  284.    "if {![winfo ismapped $widgets(popup)]} {\n"
  285.    "set newValue [$widgets(entry) get]\n"
  286.    "if {$oldValue != $newValue} {\n"
  287.    "CallCommand $widgets(this) $newValue\n"
  288.    "}\n"
  289.    "}\n"
  290.    "}\n"
  291.    "\"<1>\" {\n"
  292.    "set editable [::combobox::GetBoolean $options(-editable)]\n"
  293.    "if {!$editable} {\n"
  294.    "if {[winfo ismapped $widgets(popup)]} {\n"
  295.    "$widgets(this) close\n"
  296.    "return -code break;\n"
  297.    "} else {\n"
  298.    "if {$options(-state) != \"disabled\"} {\n"
  299.    "$widgets(this) open\n"
  300.    "return -code break;\n"
  301.    "}\n"
  302.    "}\n"
  303.    "}\n"
  304.    "}\n"
  305.    "\"<Double-1>\" {\n"
  306.    "if {$options(-state) != \"disabled\"} {\n"
  307.    "$widgets(this) toggle\n"
  308.    "return -code break;\n"
  309.    "}\n"
  310.    "}\n"
  311.    "\"<Tab>\" {\n"
  312.    "if {[winfo ismapped $widgets(popup)]} {\n"
  313.    "::combobox::Find $widgets(this) 0\n"
  314.    "return -code break;\n"
  315.    "} else {\n"
  316.    "::combobox::SetValue $widgets(this) [$widgets(this) get]\n"
  317.    "}\n"
  318.    "}\n"
  319.    "\"<Escape>\" {\n"
  320.    "if {[winfo ismapped $widgets(popup)]} {\n"
  321.    "$widgets(this) close\n"
  322.    "return -code break;\n"
  323.    "}\n"
  324.    "}\n"
  325.    "\"<Return>\" {\n"
  326.    "set newValue [$widgets(entry) get]\n"
  327.    "if {$oldValue != $newValue} {\n"
  328.    "CallCommand $widgets(this) $newValue\n"
  329.    "}\n"
  330.    "if {[winfo ismapped $widgets(popup)]} {\n"
  331.    "::combobox::Select $widgets(this)  "
  332.    "[$widgets(listbox) curselection]\n"
  333.    "return -code break;\n"
  334.    "}\n"
  335.    "}\n"
  336.    "\"<Next>\" {\n"
  337.    "$widgets(listbox) yview scroll 1 pages\n"
  338.    "set index [$widgets(listbox) index @0,0]\n"
  339.    "$widgets(listbox) see $index\n"
  340.    "$widgets(listbox) activate $index\n"
  341.    "$widgets(listbox) selection clear 0 end\n"
  342.    "$widgets(listbox) selection anchor $index\n"
  343.    "$widgets(listbox) selection set $index\n"
  344.    "}\n"
  345.    "\"<Prior>\" {\n"
  346.    "$widgets(listbox) yview scroll -1 pages\n"
  347.    "set index [$widgets(listbox) index @0,0]\n"
  348.    "$widgets(listbox) activate $index\n"
  349.    "$widgets(listbox) see $index\n"
  350.    "$widgets(listbox) selection clear 0 end\n"
  351.    "$widgets(listbox) selection anchor $index\n"
  352.    "$widgets(listbox) selection set $index\n"
  353.    "}\n"
  354.    "\"<Down>\" {\n"
  355.    "if {[winfo ismapped $widgets(popup)]} {\n"
  356.    "tkListboxUpDown $widgets(listbox) 1\n"
  357.    "return -code break;\n"
  358.    "} else {\n"
  359.    "if {$options(-state) != \"disabled\"} {\n"
  360.    "$widgets(this) open\n"
  361.    "return -code break;\n"
  362.    "}\n"
  363.    "}\n"
  364.    "}\n"
  365.    "\"<Up>\" {\n"
  366.    "if {[winfo ismapped $widgets(popup)]} {\n"
  367.    "tkListboxUpDown $widgets(listbox) -1\n"
  368.    "return -code break;\n"
  369.    "} else {\n"
  370.    "if {$options(-state) != \"disabled\"} {\n"
  371.    "$widgets(this) open\n"
  372.    "return -code break;\n"
  373.    "}\n"
  374.    "}\n"
  375.    "}\n"
  376.    "}\n"
  377.    "return \"\"\n"
  378.    "}\n"
  379.    "proc ::combobox::DestroyHandler {w} {\n"
  380.    "if {[string compare [winfo class $w] \"Combobox\"] == 0} {\n"
  381.    "upvar ::combobox::${w}::widgets  widgets\n"
  382.    "upvar ::combobox::${w}::options  options\n"
  383.    "namespace delete ::combobox::$w\n"
  384.    "rename $w {}\n"
  385.    "}\n"
  386.    "return \"\"\n"
  387.    "}\n"
  388.    "proc ::combobox::Find {w {exact 0}} {\n"
  389.    "upvar ::combobox::${w}::widgets widgets\n"
  390.    "upvar ::combobox::${w}::options options\n"
  391.    "set pattern [$widgets(entry) get]\n"
  392.    "if {[string length $pattern] == 0} {\n"
  393.    "$widgets(listbox) see 0\n"
  394.    "$widgets(listbox) selection clear 0 end\n"
  395.    "$widgets(listbox) selection anchor 0\n"
  396.    "$widgets(listbox) activate 0\n"
  397.    "return\n"
  398.    "}\n"
  399.    "set list [$widgets(listbox) get 0 end]\n"
  400.    "set exactMatch -1\n"
  401.    "if {$exact} {\n"
  402.    "set exactMatch [lsearch -exact $list $pattern]\n"
  403.    "}\n"
  404.    "set index -1\n"
  405.    "while {$index == -1 && [string length $pattern]} {\n"
  406.    "set index [lsearch -glob $list \"$pattern*\"]\n"
  407.    "if {$index == -1} {\n"
  408.    "regsub {.$} $pattern {} pattern\n"
  409.    "}\n"
  410.    "}\n"
  411.    "set thisItem [lindex $list $index]\n"
  412.    "if {$index != -1} {\n"
  413.    "set nextIndex [expr {$index + 1}]\n"
  414.    "set nextItem [lindex $list $nextIndex]\n"
  415.    "if {[string match $pattern* $nextItem]} {\n"
  416.    "set marker [string length $pattern]\n"
  417.    "while {$marker <= [string length $pattern]} {\n"
  418.    "set a [string index $thisItem $marker]\n"
  419.    "set b [string index $nextItem $marker]\n"
  420.    "if {[string compare $a $b] == 0} {\n"
  421.    "append pattern $a\n"
  422.    "incr marker\n"
  423.    "} else {\n"
  424.    "break\n"
  425.    "}\n"
  426.    "}\n"
  427.    "} else {\n"
  428.    "set marker [string length $pattern]\n"
  429.    "}\n"
  430.    "} else {\n"
  431.    "set marker end\n"
  432.    "set index 0\n"
  433.    "}\n"
  434.    "if {$exact && $exactMatch == -1} {\n"
  435.    "$widgets(listbox) selection clear 0 end\n"
  436.    "$widgets(listbox) see $index\n"
  437.    "} elseif {!$exact}  {\n"
  438.    "set oldstate [$widgets(entry) cget -state]\n"
  439.    "$widgets(entry) configure -state normal\n"
  440.    "$widgets(entry) delete 0 end\n"
  441.    "$widgets(entry) insert end $thisItem\n"
  442.    "$widgets(entry) selection clear\n"
  443.    "$widgets(entry) selection range $marker end\n"
  444.    "$widgets(listbox) activate $index\n"
  445.    "$widgets(listbox) selection clear 0 end\n"
  446.    "$widgets(listbox) selection anchor $index\n"
  447.    "$widgets(listbox) selection set $index\n"
  448.    "$widgets(listbox) see $index\n"
  449.    "$widgets(entry) configure -state $oldstate\n"
  450.    "}\n"
  451.    "}\n"
  452.    "proc ::combobox::Select {w index} {\n"
  453.    "upvar ::combobox::${w}::widgets widgets\n"
  454.    "upvar ::combobox::${w}::options options\n"
  455.    "catch {\n"
  456.    "set data [$widgets(listbox) get [lindex $index 0]]\n"
  457.    "::combobox::SetValue $widgets(this) $data\n"
  458.    "$widgets(listbox) selection clear 0 end\n"
  459.    "$widgets(listbox) selection anchor $index\n"
  460.    "$widgets(listbox) selection set $index\n"
  461.    "$widgets(entry) selection range 0 end\n"
  462.    "}\n"
  463.    "$widgets(this) close\n"
  464.    "return \"\"\n"
  465.    "}\n"
  466.    "proc ::combobox::HandleScrollbar {w {action \"unknown\"}} {\n"
  467.    "upvar ::combobox::${w}::widgets widgets\n"
  468.    "upvar ::combobox::${w}::options options\n"
  469.    "if {$options(-height) == 0} {\n"
  470.    "set hlimit $options(-maxheight)\n"
  471.    "} else {\n"
  472.    "set hlimit $options(-height)\n"
  473.    "}\n"
  474.    "switch $action {\n"
  475.    "\"grow\" {\n"
  476.    "if {$hlimit > 0 && [$widgets(listbox) size] > $hlimit} {\n"
  477.    "pack $widgets(vsb) -side right -fill y -expand n\n"
  478.    "}\n"
  479.    "}\n"
  480.    "\"shrink\" {\n"
  481.    "if {$hlimit > 0 && [$widgets(listbox) size] <= $hlimit} {\n"
  482.    "pack forget $widgets(vsb)\n"
  483.    "}\n"
  484.    "}\n"
  485.    "\"crop\" {\n"
  486.    "pack $widgets(vsb) -side right -fill y -expand n\n"
  487.    "}\n"
  488.    "default {\n"
  489.    "if {$hlimit > 0 && [$widgets(listbox) size] > $hlimit} {\n"
  490.    "pack $widgets(vsb) -side right -fill y -expand n\n"
  491.    "} else {\n"
  492.    "pack forget $widgets(vsb)\n"
  493.    "}\n"
  494.    "}\n"
  495.    "}\n"
  496.    "return \"\"\n"
  497.    "}\n"
  498.    "proc ::combobox::ComputeGeometry {w} {\n"
  499.    "upvar ::combobox::${w}::widgets widgets\n"
  500.    "upvar ::combobox::${w}::options options\n"
  501.    "if {$options(-height) == 0 && $options(-maxheight) != \"0\"} {\n"
  502.    "set nitems [$widgets(listbox) size]\n"
  503.    "if {$nitems > $options(-maxheight)} {\n"
  504.    "$widgets(listbox) configure -height $options(-maxheight)\n"
  505.    "} else {\n"
  506.    "$widgets(listbox) configure -height 0\n"
  507.    "}\n"
  508.    "update idletasks\n"
  509.    "}\n"
  510.    "set bd [$widgets(popup) cget -borderwidth]\n"
  511.    "set height [expr {[winfo reqheight $widgets(popup)] + $bd + $bd}]\n"
  512.    "set width [winfo width $widgets(this)]\n"
  513.    "set screenWidth  [winfo screenwidth $widgets(this)]\n"
  514.    "set screenHeight [winfo screenheight $widgets(this)]\n"
  515.    "set rootx        [winfo rootx $widgets(this)]\n"
  516.    "set rooty        [winfo rooty $widgets(this)]\n"
  517.    "set vrootx       [winfo vrootx $widgets(this)]\n"
  518.    "set vrooty       [winfo vrooty $widgets(this)]\n"
  519.    "set x  [expr {$rootx + $vrootx}]\n"
  520.    "if {0} {\n"
  521.    "set rightEdge [expr {$x + $width}]\n"
  522.    "if {$rightEdge > $screenWidth} {\n"
  523.    "set x [expr {$screenWidth - $width}]\n"
  524.    "}\n"
  525.    "if {$x < 0} {set x 0}\n"
  526.    "}\n"
  527.    "set y [expr {$rooty + $vrooty + [winfo reqheight $widgets(this)] + 1}]\n"
  528.    "set bottomEdge [expr {$y + $height}]\n"
  529.    "if {$bottomEdge >= $screenHeight} {\n"
  530.    "set y [expr {($rooty - $height - 1) + $vrooty}]\n"
  531.    "if {$y < 0} {\n"
  532.    "if {$rooty > [expr {$screenHeight / 2}]} {\n"
  533.    "set y 1\n"
  534.    "set height [expr {$rooty - 1 - $y}]\n"
  535.    "} else {\n"
  536.    "set y [expr {$rooty + $vrooty +  "
  537.    "[winfo reqheight $widgets(this)] + 1}]\n"
  538.    "set height [expr {$screenHeight - $y}]\n"
  539.    "}\n"
  540.    "HandleScrollbar $widgets(this) crop\n"
  541.    "}\n"
  542.    "}\n"
  543.    "if {$y < 0} {\n"
  544.    "set y 0\n"
  545.    "set height $screenheight\n"
  546.    "}\n"
  547.    "set geometry [format \"=%dx%d+%d+%d\" $width $height $x $y]\n"
  548.    "return $geometry\n"
  549.    "}\n"
  550.    "proc ::combobox::DoInternalWidgetCommand {w subwidget command args} {\n"
  551.    "upvar ::combobox::${w}::widgets widgets\n"
  552.    "upvar ::combobox::${w}::options options\n"
  553.    "set subcommand $command\n"
  554.    "set command [concat $widgets($subwidget) $command $args]\n"
  555.    "if {[catch $command result]} {\n"
  556.    "regsub $widgets($subwidget) $result $widgets(this) result\n"
  557.    "switch $subwidget,$subcommand {\n"
  558.    "listbox,index  {regsub \"index\"  $result \"list index\"  result}\n"
  559.    "listbox,insert {regsub \"insert\" $result \"list insert\" result}\n"
  560.    "listbox,delete {regsub \"delete\" $result \"list delete\" result}\n"
  561.    "listbox,get    {regsub \"get\"    $result \"list get\"    result}\n"
  562.    "listbox,size   {regsub \"size\"   $result \"list size\"   result}\n"
  563.    "}\n"
  564.    "error $result\n"
  565.    "} else {\n"
  566.    "return $result\n"
  567.    "}\n"
  568.    "}\n"
  569.    "proc ::combobox::WidgetProc {w command args} {\n"
  570.    "upvar ::combobox::${w}::widgets widgets\n"
  571.    "upvar ::combobox::${w}::options options\n"
  572.    "upvar ::combobox::${w}::oldFocus oldFocus\n"
  573.    "upvar ::combobox::${w}::oldFocus oldGrab\n"
  574.    "set command [::combobox::Canonize $w command $command]\n"
  575.    "set doWidgetCommand  "
  576.    "[list ::combobox::DoInternalWidgetCommand $widgets(this)]\n"
  577.    "if {$command == \"list\"} {\n"
  578.    "set command \"list-[lindex $args 0]\"\n"
  579.    "set args [lrange $args 1 end]\n"
  580.    "}\n"
  581.    "set result \"\"\n"
  582.    "switch $command {\n"
  583.    "bbox -\n"
  584.    "delete -\n"
  585.    "get -\n"
  586.    "icursor -\n"
  587.    "index -\n"
  588.    "insert -\n"
  589.    "scan -\n"
  590.    "selection -\n"
  591.    "xview {\n"
  592.    "set result [eval $doWidgetCommand entry $command $args]\n"
  593.    "}\n"
  594.    "list-get  {set result [eval $doWidgetCommand listbox get $args]}\n"
  595.    "list-index  {set result [eval $doWidgetCommand listbox index $args]}\n"
  596.    "list-size  {set result [eval $doWidgetCommand listbox size $args]}\n"
  597.    "select {\n"
  598.    "if {[llength $args] == 1} {\n"
  599.    "set index [lindex $args 0]\n"
  600.    "set result [Select $widgets(this) $index]\n"
  601.    "} else {\n"
  602.    "error \"usage: $w select index\"\n"
  603.    "}\n"
  604.    "}\n"
  605.    "subwidget {\n"
  606.    "set knownWidgets [list button entry listbox popup vsb]\n"
  607.    "if {[llength $args] == 0} {\n"
  608.    "return $knownWidgets\n"
  609.    "}\n"
  610.    "set name [lindex $args 0]\n"
  611.    "if {[lsearch $knownWidgets $name] != -1} {\n"
  612.    "set result $widgets($name)\n"
  613.    "} else {\n"
  614.    "error \"unknown subwidget $name\"\n"
  615.    "}\n"
  616.    "}\n"
  617.    "curselection {\n"
  618.    "set result [eval $doWidgetCommand listbox curselection]\n"
  619.    "}\n"
  620.    "list-insert {\n"
  621.    "eval $doWidgetCommand listbox insert $args\n"
  622.    "set result [HandleScrollbar $w \"grow\"]\n"
  623.    "}\n"
  624.    "list-delete {\n"
  625.    "eval $doWidgetCommand listbox delete $args\n"
  626.    "set result [HandleScrollbar $w \"shrink\"]\n"
  627.    "}\n"
  628.    "toggle {\n"
  629.    "if {$options(-state) == \"disabled\"} return\n"
  630.    "if {[winfo ismapped $widgets(popup)]} {\n"
  631.    "set result [$widgets(this) close]\n"
  632.    "} else {\n"
  633.    "set result [$widgets(this) open]\n"
  634.    "}\n"
  635.    "}\n"
  636.    "open {\n"
  637.    "if {$options(-editable)} {\n"
  638.    "focus $widgets(entry)\n"
  639.    "$widgets(entry) select range 0 end\n"
  640.    "$widgets(entry) icur end\n"
  641.    "}\n"
  642.    "if {$options(-state) == \"disabled\"} {\n"
  643.    "return 0\n"
  644.    "}\n"
  645.    "set geometry [::combobox::ComputeGeometry $widgets(this)]\n"
  646.    "wm geometry $widgets(popup) $geometry\n"
  647.    "update idletasks\n"
  648.    "if {[winfo ismapped $widgets(popup)]} {\n"
  649.    "return 0\n"
  650.    "}\n"
  651.    "set oldFocus [focus]\n"
  652.    "$widgets(button) configure -relief sunken\n"
  653.    "raise $widgets(popup) [winfo parent $widgets(this)]\n"
  654.    "wm deiconify $widgets(popup)\n"
  655.    "focus -force $widgets(entry)\n"
  656.    "::combobox::Find $widgets(this) 1\n"
  657.    "set status \"none\"\n"
  658.    "set grab [grab current $widgets(this)]\n"
  659.    "if {$grab != \"\"} {set status [grab status $grab]}\n"
  660.    "set oldGrab [list $grab $status]\n"
  661.    "unset grab status\n"
  662.    "grab -global $widgets(this)\n"
  663.    "event generate $widgets(listbox) <B1-Enter>\n"
  664.    "return 1\n"
  665.    "}\n"
  666.    "close {\n"
  667.    "if {![winfo ismapped $widgets(popup)]} {\n"
  668.    "return 0\n"
  669.    "}\n"
  670.    "catch {focus $oldFocus} result\n"
  671.    "catch {grab release $widgets(this)}\n"
  672.    "catch {\n"
  673.    "set status [lindex $oldGrab 1]\n"
  674.    "if {$status == \"global\"} {\n"
  675.    "grab -global [lindex $oldGrab 0]\n"
  676.    "} elseif {$status == \"local\"} {\n"
  677.    "grab [lindex $oldGrab 0]\n"
  678.    "}\n"
  679.    "unset status\n"
  680.    "}\n"
  681.    "$widgets(button) configure -relief raised\n"
  682.    "wm withdraw $widgets(popup)\n"
  683.    "set editable [::combobox::GetBoolean $options(-editable)]\n"
  684.    "if {$editable} {\n"
  685.    "$widgets(entry) selection range 0 end\n"
  686.    "$widgets(button) configure -relief raised\n"
  687.    "}\n"
  688.    "tkCancelRepeat\n"
  689.    "return 1\n"
  690.    "}\n"
  691.    "cget {\n"
  692.    "if {[llength $args] != 1} {\n"
  693.    "error \"wrong # args: should be $w cget option\"\n"
  694.    "}\n"
  695.    "set opt [::combobox::Canonize $w option [lindex $args 0]]\n"
  696.    "if {$opt == \"-value\"} {\n"
  697.    "set result [$widget(entry) get]\n"
  698.    "} else {\n"
  699.    "set result $options($opt)\n"
  700.    "}\n"
  701.    "}\n"
  702.    "configure {\n"
  703.    "set result [eval ::combobox::Configure {$w} $args]\n"
  704.    "}\n"
  705.    "default {\n"
  706.    "error \"bad option \\\"$command\\\"\"\n"
  707.    "}\n"
  708.    "}\n"
  709.    "return $result\n"
  710.    "}\n";
  711. char *ExtensionSource1 =
  712.    "proc ::combobox::Configure {w args} {\n"
  713.    "variable widgetOptions\n"
  714.    "variable defaultEntryCursor\n"
  715.    "upvar ::combobox::${w}::widgets widgets\n"
  716.    "upvar ::combobox::${w}::options options\n"
  717.    "if {[llength $args] == 0} {\n"
  718.    "set results {}\n"
  719.    "foreach opt [lsort [array names widgetOptions]] {\n"
  720.    "if {[llength $widgetOptions($opt)] == 1} {\n"
  721.    "set alias $widgetOptions($opt)\n"
  722.    "set optName $widgetOptions($alias)\n"
  723.    "lappend results [list $opt $optName]\n"
  724.    "} else {\n"
  725.    "set optName  [lindex $widgetOptions($opt) 0]\n"
  726.    "set optClass [lindex $widgetOptions($opt) 1]\n"
  727.    "set default [option get $w $optName $optClass]\n"
  728.    "lappend results [list $opt $optName $optClass  "
  729.    "$default $options($opt)]\n"
  730.    "}\n"
  731.    "}\n"
  732.    "return $results\n"
  733.    "}\n"
  734.    "if {[llength $args] == 1} {\n"
  735.    "set opt [::combobox::Canonize $w option [lindex $args 0]]\n"
  736.    "set optName  [lindex $widgetOptions($opt) 0]\n"
  737.    "set optClass [lindex $widgetOptions($opt) 1]\n"
  738.    "set default [option get $w $optName $optClass]\n"
  739.    "set results [list $opt $optName $optClass  "
  740.    "$default $options($opt)]\n"
  741.    "return $results\n"
  742.    "}\n"
  743.    "if {[expr {[llength $args]%2}] == 1} {\n"
  744.    "error \"value for \\\"[lindex $args end]\\\" missing\"\n"
  745.    "}\n"
  746.    "foreach {name value} $args {\n"
  747.    "set name [::combobox::Canonize $w option $name]\n"
  748.    "set opts($name) $value\n"
  749.    "}\n"
  750.    "foreach option [array names opts] {\n"
  751.    "set newValue $opts($option)\n"
  752.    "if {[info exists options($option)]} {\n"
  753.    "set oldValue $options($option)\n"
  754.    "}\n"
  755.    "switch -- $option {\n"
  756.    "-background {\n"
  757.    "$widgets(frame)   configure -background $newValue\n"
  758.    "$widgets(entry)   configure -background $newValue\n"
  759.    "$widgets(listbox) configure -background $newValue\n"
  760.    "$widgets(vsb)     configure -background $newValue\n"
  761.    "$widgets(vsb)     configure -troughcolor $newValue\n"
  762.    "set options($option) $newValue\n"
  763.    "}\n"
  764.    "-borderwidth {\n"
  765.    "$widgets(frame) configure -borderwidth $newValue\n"
  766.    "set options($option) $newValue\n"
  767.    "}\n"
  768.    "-command {\n"
  769.    "set options($option) $newValue\n"
  770.    "}\n"
  771.    "-commandstate {\n"
  772.    "if {$newValue != \"normal\" && $newValue != \"disabled\"} {\n"
  773.    "set options($option) $oldValue\n"
  774.    "set message \"bad state value \\\"$newValue\\\";\"\n"
  775.    "append message \" must be normal or disabled\"\n"
  776.    "error $message\n"
  777.    "}\n"
  778.    "set options($option) $newValue\n"
  779.    "}\n"
  780.    "-cursor {\n"
  781.    "$widgets(frame) configure -cursor $newValue\n"
  782.    "$widgets(entry) configure -cursor $newValue\n"
  783.    "$widgets(listbox) configure -cursor $newValue\n"
  784.    "set options($option) $newValue\n"
  785.    "}\n"
  786.    "-editable {\n"
  787.    "if {$newValue} {\n"
  788.    "$widgets(entry) configure  "
  789.    "-state normal  "
  790.    "-cursor $defaultEntryCursor\n"
  791.    "} else {\n"
  792.    "$widgets(entry) configure  "
  793.    "-state disabled  "
  794.    "-cursor $options(-cursor)\n"
  795.    "}\n"
  796.    "set options($option) $newValue\n"
  797.    "}\n"
  798.    "-font {\n"
  799.    "$widgets(entry) configure -font $newValue\n"
  800.    "$widgets(listbox) configure -font $newValue\n"
  801.    "set options($option) $newValue\n"
  802.    "}\n"
  803.    "-foreground {\n"
  804.    "$widgets(entry)   configure -foreground $newValue\n"
  805.    "$widgets(button)  configure -foreground $newValue\n"
  806.    "$widgets(listbox) configure -foreground $newValue\n"
  807.    "set options($option) $newValue\n"
  808.    "}\n"
  809.    "-height {\n"
  810.    "$widgets(listbox) configure -height $newValue\n"
  811.    "HandleScrollbar $w\n"
  812.    "set options($option) $newValue\n"
  813.    "}\n"
  814.    "-highlightbackground {\n"
  815.    "$widgets(frame) configure -highlightbackground $newValue\n"
  816.    "set options($option) $newValue\n"
  817.    "}\n"
  818.    "-highlightcolor {\n"
  819.    "$widgets(frame) configure -highlightcolor $newValue\n"
  820.    "set options($option) $newValue\n"
  821.    "}\n"
  822.    "-highlightthickness {\n"
  823.    "$widgets(frame) configure -highlightthickness $newValue\n"
  824.    "set options($option) $newValue\n"
  825.    "}\n"
  826.    "-image {\n"
  827.    "if {[string length $newValue] > 0} {\n"
  828.    "$widgets(button) configure -image $newValue\n"
  829.    "} else {\n"
  830.    "$widgets(button) configure -image ::combobox::bimage\n"
  831.    "}\n"
  832.    "set options($option) $newValue\n"
  833.    "}\n"
  834.    "-maxheight {\n"
  835.    "$widgets(listbox) configure -height $options(-height)\n"
  836.    "HandleScrollbar $w\n"
  837.    "set options($option) $newValue\n"
  838.    "}\n"
  839.    "-relief {\n"
  840.    "$widgets(frame) configure -relief $newValue\n"
  841.    "set options($option) $newValue\n"
  842.    "}\n"
  843.    "-selectbackground {\n"
  844.    "$widgets(entry) configure -selectbackground $newValue\n"
  845.    "$widgets(listbox) configure -selectbackground $newValue\n"
  846.    "set options($option) $newValue\n"
  847.    "}\n"
  848.    "-selectborderwidth {\n"
  849.    "$widgets(entry) configure -selectborderwidth $newValue\n"
  850.    "$widgets(listbox) configure -selectborderwidth $newValue\n"
  851.    "set options($option) $newValue\n"
  852.    "}\n"
  853.    "-selectforeground {\n"
  854.    "$widgets(entry) configure -selectforeground $newValue\n"
  855.    "$widgets(listbox) configure -selectforeground $newValue\n"
  856.    "set options($option) $newValue\n"
  857.    "}\n"
  858.    "-state {\n"
  859.    "if {$newValue == \"normal\"} {\n"
  860.    "set editable [::combobox::GetBoolean  "
  861.    "$options(-editable)]\n"
  862.    "if {$editable} {\n"
  863.    "$widgets(entry) configure -state normal\n"
  864.    "$widgets(entry) configure -takefocus 1\n"
  865.    "}\n"
  866.    "} elseif {$newValue == \"disabled\"}  {\n"
  867.    "$widgets(entry) configure -state disabled\n"
  868.    "$widgets(entry) configure -takefocus 0\n"
  869.    "} else {\n"
  870.    "set options($option) $oldValue\n"
  871.    "set message \"bad state value \\\"$newValue\\\";\"\n"
  872.    "append message \" must be normal or disabled\"\n"
  873.    "error $message\n"
  874.    "}\n"
  875.    "set options($option) $newValue\n"
  876.    "}\n"
  877.    "-takefocus {\n"
  878.    "$widgets(entry) configure -takefocus $newValue\n"
  879.    "set options($option) $newValue\n"
  880.    "}\n"
  881.    "-textvariable {\n"
  882.    "$widgets(entry) configure -textvariable $newValue\n"
  883.    "set options($option) $newValue\n"
  884.    "}\n"
  885.    "-value {\n"
  886.    "::combobox::SetValue $widgets(this) $newValue\n"
  887.    "set options($option) $newValue\n"
  888.    "}\n"
  889.    "-width {\n"
  890.    "$widgets(entry) configure -width $newValue\n"
  891.    "$widgets(listbox) configure -width $newValue\n"
  892.    "set options($option) $newValue\n"
  893.    "}\n"
  894.    "-xscrollcommand {\n"
  895.    "$widgets(entry) configure -xscrollcommand $newValue\n"
  896.    "set options($option) $newValue\n"
  897.    "}\n"
  898.    "}\n"
  899.    "}\n"
  900.    "}\n"
  901.    "proc ::combobox::VTrace {w args} {\n"
  902.    "upvar ::combobox::${w}::widgets widgets\n"
  903.    "upvar ::combobox::${w}::options options\n"
  904.    "upvar ::combobox::${w}::ignoreTrace ignoreTrace\n"
  905.    "if {[info exists ignoreTrace]} return\n"
  906.    "::combobox::SetValue $widgets(this) [set ::$options(-textvariable)]\n"
  907.    "return \"\"\n"
  908.    "}\n"
  909.    "proc ::combobox::SetValue {w newValue} {\n"
  910.    "upvar ::combobox::${w}::widgets     widgets\n"
  911.    "upvar ::combobox::${w}::options     options\n"
  912.    "upvar ::combobox::${w}::ignoreTrace ignoreTrace\n"
  913.    "upvar ::combobox::${w}::oldValue    oldValue\n"
  914.    "if {[info exists options(-textvariable)]  "
  915.    "&& [string length $options(-textvariable)] > 0} {\n"
  916.    "set variable ::$options(-textvariable)\n"
  917.    "set $variable $newValue\n"
  918.    "} else {\n"
  919.    "set oldstate [$widgets(entry) cget -state]\n"
  920.    "$widgets(entry) configure -state normal\n"
  921.    "$widgets(entry) delete 0 end\n"
  922.    "$widgets(entry) insert 0 $newValue\n"
  923.    "$widgets(entry) configure -state $oldstate\n"
  924.    "}\n"
  925.    "set oldValue $newValue\n"
  926.    "CallCommand $w $newValue\n"
  927.    "return \"\"\n"
  928.    "}\n"
  929.    "proc ::combobox::CallCommand {w newValue} {\n"
  930.    "upvar ::combobox::${w}::widgets widgets\n"
  931.    "upvar ::combobox::${w}::options options\n"
  932.    "if {$options(-commandstate) == \"normal\" &&  "
  933.    "[string length $options(-command)] > 0} {\n"
  934.    "set args [list $widgets(this) $newValue]\n"
  935.    "uplevel \\#0 $options(-command) $args\n"
  936.    "}\n"
  937.    "}\n"
  938.    "proc ::combobox::GetBoolean {value {errorValue 1}} {\n"
  939.    "if {[catch {expr {([string trim $value])?1:0}} res]} {\n"
  940.    "return $errorValue\n"
  941.    "} else {\n"
  942.    "return $res\n"
  943.    "}\n"
  944.    "}\n"
  945.    "proc ::combobox::convert {w args} {\n"
  946.    "set result {}\n"
  947.    "if {![winfo exists $w]} {\n"
  948.    "error \"window \\\"$w\\\" doesn't exist\"\n"
  949.    "}\n"
  950.    "while {[llength $args] > 0} {\n"
  951.    "set option [lindex $args 0]\n"
  952.    "set args [lrange $args 1 end]\n"
  953.    "switch -exact -- $option {\n"
  954.    "-x {\n"
  955.    "set value [lindex $args 0]\n"
  956.    "set args [lrange $args 1 end]\n"
  957.    "set win $w\n"
  958.    "while {[winfo class $win] != \"Combobox\"} {\n"
  959.    "incr value [winfo x $win]\n"
  960.    "set win [winfo parent $win]\n"
  961.    "if {$win == \".\"} break\n"
  962.    "}\n"
  963.    "lappend result $value\n"
  964.    "}\n"
  965.    "-y {\n"
  966.    "set value [lindex $args 0]\n"
  967.    "set args [lrange $args 1 end]\n"
  968.    "set win $w\n"
  969.    "while {[winfo class $win] != \"Combobox\"} {\n"
  970.    "incr value [winfo y $win]\n"
  971.    "set win [winfo parent $win]\n"
  972.    "if {$win == \".\"} break\n"
  973.    "}\n"
  974.    "lappend result $value\n"
  975.    "}\n"
  976.    "-w -\n"
  977.    "-W {\n"
  978.    "set win $w\n"
  979.    "while {[winfo class $win] != \"Combobox\"} {\n"
  980.    "set win [winfo parent $win]\n"
  981.    "if {$win == \".\"} break;\n"
  982.    "}\n"
  983.    "lappend result $win\n"
  984.    "}\n"
  985.    "}\n"
  986.    "}\n"
  987.    "return $result\n"
  988.    "}\n"
  989.    "proc ::combobox::Canonize {w object opt} {\n"
  990.    "variable widgetOptions\n"
  991.    "variable columnOptions\n"
  992.    "variable widgetCommands\n"
  993.    "variable listCommands\n"
  994.    "variable scanCommands\n"
  995.    "switch $object {\n"
  996.    "command {\n"
  997.    "if {[lsearch -exact $widgetCommands $opt] >= 0} {\n"
  998.    "return $opt\n"
  999.    "}\n"
  1000.    "set list $widgetCommands\n"
  1001.    "foreach element $list {\n"
  1002.    "set tmp($element) \"\"\n"
  1003.    "}\n"
  1004.    "set matches [array names tmp ${opt}*]\n"
  1005.    "}\n"
  1006.    "{list command} {\n"
  1007.    "if {[lsearch -exact $listCommands $opt] >= 0} {\n"
  1008.    "return $opt\n"
  1009.    "}\n"
  1010.    "set list $listCommands\n"
  1011.    "foreach element $list {\n"
  1012.    "set tmp($element) \"\"\n"
  1013.    "}\n"
  1014.    "set matches [array names tmp ${opt}*]\n"
  1015.    "}\n"
  1016.    "{scan command} {\n"
  1017.    "if {[lsearch -exact $scanCommands $opt] >= 0} {\n"
  1018.    "return $opt\n"
  1019.    "}\n"
  1020.    "set list $scanCommands\n"
  1021.    "foreach element $list {\n"
  1022.    "set tmp($element) \"\"\n"
  1023.    "}\n"
  1024.    "set matches [array names tmp ${opt}*]\n"
  1025.    "}\n"
  1026.    "option {\n"
  1027.    "if {[info exists widgetOptions($opt)]  "
  1028.    "&& [llength $widgetOptions($opt)] == 2} {\n"
  1029.    "return $opt\n"
  1030.    "}\n"
  1031.    "set list [array names widgetOptions]\n"
  1032.    "set matches [array names widgetOptions ${opt}*]\n"
  1033.    "}\n"
  1034.    "}\n"
  1035.    "if {[llength $matches] == 0} {\n"
  1036.    "set choices [HumanizeList $list]\n"
  1037.    "error \"unknown $object \\\"$opt\\\"; must be one of $choices\"\n"
  1038.    "} elseif {[llength $matches] == 1} {\n"
  1039.    "set opt [lindex $matches 0]\n"
  1040.    "switch $object {\n"
  1041.    "option {\n"
  1042.    "set opt [lindex $matches 0]\n"
  1043.    "if {[llength $widgetOptions($opt)] == 1} {\n"
  1044.    "set opt $widgetOptions($opt)\n"
  1045.    "}\n"
  1046.    "}\n"
  1047.    "}\n"
  1048.    "return $opt\n"
  1049.    "} else {\n"
  1050.    "set choices [HumanizeList $list]\n"
  1051.    "error \"ambiguous $object \\\"$opt\\\"; must be one of $choices\"\n"
  1052.    "}\n"
  1053.    "}\n"
  1054.    "proc ::combobox::HumanizeList {list} {\n"
  1055.    "if {[llength $list] == 1} {\n"
  1056.    "return [lindex $list 0]\n"
  1057.    "} else {\n"
  1058.    "set list [lsort $list]\n"
  1059.    "set secondToLast [expr {[llength $list] -2}]\n"
  1060.    "set most [lrange $list 0 $secondToLast]\n"
  1061.    "set last [lindex $list end]\n"
  1062.    "return \"[join $most {, }] or $last\"\n"
  1063.    "}\n"
  1064.    "}\n";
  1065.  
  1066. RexxFunctionHandler TkCombobox  ;
  1067. RexxFunctionHandler TkComboboxClose  ;
  1068. RexxFunctionHandler TkComboboxICursor;
  1069. RexxFunctionHandler TkComboboxListDelete ;
  1070. RexxFunctionHandler TkComboboxListGet ;
  1071. RexxFunctionHandler TkComboboxListIndex ;
  1072. RexxFunctionHandler TkComboboxListInsert ;
  1073. RexxFunctionHandler TkComboboxListSize ;
  1074. RexxFunctionHandler TkComboboxOpen  ;
  1075. RexxFunctionHandler TkComboboxSelect  ;
  1076. RexxFunctionHandler TkComboboxSubwidget  ;
  1077. RexxFunctionHandler TkComboboxLoadFuncs    ;
  1078. RexxFunctionHandler TkComboboxDropFuncs    ;
  1079.  
  1080. /*-----------------------------------------------------------------------------
  1081.  * Table of TK Functions. Used to install/de-install functions.
  1082.  * If you change this table, don't forget to change the table at the end
  1083.  * of this file.
  1084.  *----------------------------------------------------------------------------*/
  1085. RexxFunction RxPackageFunctions[] = {
  1086.    { "TKCOMBOBOXDROPFUNCS"       ,TkComboboxDropFuncs       ,"TkComboboxDropFuncs"       , 1 },
  1087.    { "TKCOMBOBOXLOADFUNCS"       ,TkComboboxLoadFuncs       ,"TkComboboxLoadFuncs"       , 0 }, /* don't load this from a DLL */
  1088.    { "TKCOMBOBOX"                ,TkCombobox                ,"TkCombobox"                , 1 },
  1089.    { "TKCOMBOBOXICURSOR"         ,TkComboboxICursor         ,"TkComboboxICursor"         , 1 },
  1090.    { "TKCOMBOBOXLISTDELETE"      ,TkComboboxListDelete      ,"TkComboboxListDelete"      , 1 },
  1091.    { "TKCOMBOBOXLISTGET"         ,TkComboboxListGet         ,"TkComboboxListGet"         , 1 },
  1092.    { "TKCOMBOBOXLISTINDEX"       ,TkComboboxListIndex       ,"TkComboboxListIndex"       , 1 },
  1093.    { "TKCOMBOBOXLISTINSERT"      ,TkComboboxListInsert      ,"TkComboboxListInsert"      , 1 },
  1094.    { "TKCOMBOBOXLISTSIZE"        ,TkComboboxListSize        ,"TkComboboxListSize"        , 1 },
  1095.    { "TKCOMBOBOXSELECT"          ,TkComboboxSelect          ,"TkComboboxSelect"          , 1 },
  1096.    { "TKCOMBOBOXSUBWIDGET"       ,TkComboboxSubwidget       ,"TkComboboxSubwidget"       , 1 },
  1097.    { NULL, NULL, NULL, 0 }
  1098. };
  1099.  
  1100. static char czTclCommand[TCLCOMMANDLEN];
  1101. static REXXTKDATA *RexxTkData;
  1102.    
  1103. #if defined(WIN32) || defined(OS2_DYN)
  1104. Tcl_Interp *RexxTk_TclCreateInterp(void)
  1105. {
  1106.    return RexxTkData->Dyn_TclCreateInterp();
  1107. }
  1108.  
  1109. int RexxTk_TclEval(Tcl_Interp *interp, char *string)
  1110. {
  1111.    return RexxTkData->Dyn_TclEval( interp, string );
  1112. }
  1113.  
  1114. int RexxTk_TclInit(Tcl_Interp *interp)
  1115. {
  1116.    return RexxTkData->Dyn_TclInit( interp );
  1117. }
  1118.  
  1119. int RexxTk_TkInit(Tcl_Interp *interp)
  1120. {
  1121.    return RexxTkData->Dyn_TkInit( interp );
  1122. }
  1123. #endif
  1124.  
  1125. /*
  1126.  * Rexx/Tk combobox functions start here...
  1127.  */
  1128.  
  1129. /*
  1130.  * Combobox:create pathName ?options?
  1131.  * TkCombobox(pathName [,options])
  1132.  */
  1133. RFH_RETURN_TYPE TkCombobox
  1134.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  1135. {
  1136.    FunctionPrologue( (char *)name, argc, argv );
  1137.  
  1138.    return rtk_TypeA(RexxTkData,czTclCommand,name,"combobox::combobox", argc, argv, retstr);
  1139. }
  1140.  
  1141. /*
  1142.  * pathName list delete first ?last?
  1143.  * TkComboboxListDelete(pathName, first [,last])
  1144.  */
  1145. RFH_RETURN_TYPE TkComboboxListDelete
  1146.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  1147. {
  1148.    FunctionPrologue( (char *)name, argc, argv );
  1149.  
  1150.    if (RexxTkData->REXXTK_IntCode) ClearIntError( RexxTkData);
  1151.  
  1152.    if ( my_checkparam( name, argc, 2, 3 ) )
  1153.       return 1;
  1154.  
  1155.    return rtk_TypeC(RexxTkData,czTclCommand,name,"list delete", argc, argv, retstr);
  1156. }
  1157.  
  1158. /*
  1159.  * pathName list size
  1160.  * TkComboboxListSize(pathName)
  1161.  */
  1162. RFH_RETURN_TYPE TkComboboxListSize
  1163.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  1164. {
  1165.    FunctionPrologue( (char *)name, argc, argv );
  1166.  
  1167.    if (RexxTkData->REXXTK_IntCode) ClearIntError( RexxTkData);
  1168.  
  1169.    if ( my_checkparam( name, argc, 1, 1 ) )
  1170.       return 1;
  1171.  
  1172.    return rtk_TypeC(RexxTkData,czTclCommand,name,"list size", argc, argv, retstr);
  1173. }
  1174.  
  1175. /*
  1176.  * pathName list index index
  1177.  * TkComboboxListIndex(pathName, index)
  1178.  */
  1179. RFH_RETURN_TYPE TkComboboxListIndex
  1180.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  1181. {
  1182.    FunctionPrologue( (char *)name, argc, argv );
  1183.  
  1184.    if (RexxTkData->REXXTK_IntCode) ClearIntError( RexxTkData);
  1185.  
  1186.    if ( my_checkparam( name, argc, 2, 2 ) )
  1187.       return 1;
  1188.  
  1189.    return rtk_TypeC(RexxTkData,czTclCommand,name,"list index", argc, argv, retstr);
  1190. }
  1191.  
  1192. /*
  1193.  * pathName list get first ?last?
  1194.  * TkComboboxListGet(pathName, first [,last])
  1195.  */
  1196. RFH_RETURN_TYPE TkComboboxListGet
  1197.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  1198. {
  1199.    FunctionPrologue( (char *)name, argc, argv );
  1200.  
  1201.    if (RexxTkData->REXXTK_IntCode) ClearIntError( RexxTkData);
  1202.  
  1203.    if ( my_checkparam( name, argc, 2, 3 ) )
  1204.       return 1;
  1205.  
  1206.    return rtk_TypeC(RexxTkData,czTclCommand,name,"list get", argc, argv, retstr);
  1207. }
  1208.  
  1209. /*
  1210.  * pathName list insert index ?text...?
  1211.  * TkComboboxListInsert(pathName, index [,args...])
  1212.  */
  1213. RFH_RETURN_TYPE TkComboboxListInsert
  1214.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  1215. {
  1216.    FunctionPrologue( (char *)name, argc, argv );
  1217.  
  1218.    if (RexxTkData->REXXTK_IntCode) ClearIntError( RexxTkData);
  1219.  
  1220.    if ( my_checkparam( name, argc, 2, 0 ) )
  1221.       return 1;
  1222.  
  1223.    return rtk_TypeC(RexxTkData,czTclCommand,name,"list insert", argc, argv, retstr);
  1224. }
  1225.  
  1226. /*
  1227.  * pathName icursor index
  1228.  * TkComboboxICursor(pathName, index)
  1229.  */
  1230. RFH_RETURN_TYPE TkComboboxICursor
  1231.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  1232. {
  1233.    FunctionPrologue( (char *)name, argc, argv );
  1234.  
  1235.    if (RexxTkData->REXXTK_IntCode) ClearIntError( RexxTkData);
  1236.  
  1237.    if ( my_checkparam( name, argc, 2, 2 ) )
  1238.       return 1;
  1239.  
  1240.    return rtk_TypeC(RexxTkData,czTclCommand,name,"icursor", argc, argv, retstr);
  1241. }
  1242.  
  1243. /*
  1244.  * pathName select index
  1245.  * TkComboboxSelect(pathName, index)
  1246.  */
  1247. RFH_RETURN_TYPE TkComboboxSelect
  1248.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  1249. {
  1250.    FunctionPrologue( (char *)name, argc, argv );
  1251.  
  1252.    if (RexxTkData->REXXTK_IntCode) ClearIntError( RexxTkData);
  1253.  
  1254.    if ( my_checkparam( name, argc, 2, 2 ) )
  1255.       return 1;
  1256.  
  1257.    return rtk_TypeC(RexxTkData,czTclCommand,name,"select", argc, argv, retstr);
  1258. }
  1259.  
  1260. /*
  1261.  * pathName subwidget ?name?
  1262.  * TkComboboxSelect(pathName [,name])
  1263.  */
  1264. RFH_RETURN_TYPE TkComboboxSubwidget
  1265.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  1266. {
  1267.    FunctionPrologue( (char *)name, argc, argv );
  1268.  
  1269.    if (RexxTkData->REXXTK_IntCode) ClearIntError( RexxTkData);
  1270.  
  1271.    if ( my_checkparam( name, argc, 1, 2 ) )
  1272.       return 1;
  1273.  
  1274.    return rtk_TypeC(RexxTkData,czTclCommand,name,"subwidget", argc, argv, retstr);
  1275. }
  1276.  
  1277.  
  1278.  
  1279. RFH_RETURN_TYPE TkComboboxDropFuncs
  1280.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  1281. {
  1282.    ULONG rc=0;
  1283.    int unload=0;
  1284.  
  1285.    if ( my_checkparam(name, argc, 0, 1 ) )
  1286.       return( 1 );
  1287.    if ( argv[0].strlength == 6
  1288.    &&   memcmpi( argv[0].strptr, "UNLOAD", 6 ) == 0 )
  1289.       unload = 1;
  1290.    (void)TermRxPackage( RxPackageName, unload );
  1291.    return RxReturnNumber( retstr, rc );
  1292. }
  1293.  
  1294.  
  1295. RFH_RETURN_TYPE TkComboboxLoadFuncs
  1296.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  1297. {
  1298.    ULONG rc = 0L;
  1299.  
  1300. #if defined(DYNAMIC_LIBRARY)
  1301.    if ( !QueryRxFunction( "TKWAIT" ) )
  1302.    {
  1303.       fprintf(stderr,"The base Rexx/Tk function package must be loaded before this one\n");
  1304.       return RxReturnNumber( retstr, 1 );
  1305.    }
  1306.    /*
  1307.     * get the pointer to the tcl Interpreter and the base data from base Rexx/Tk
  1308.     * library
  1309.     */
  1310.    if ( argc == 0 )
  1311.    {
  1312.       fprintf(stderr,"You must pass the return value from TkGetBaseData() as the one and only argument.\n");
  1313.       return RxReturnNumber( retstr, 1 );
  1314.    }
  1315.    RexxTkData = (REXXTKDATA *)atol(argv[0].strptr);
  1316.    rc = InitRxPackage( NULL );
  1317.    /* 
  1318.     * Register all external functions
  1319.     */
  1320.    if ( !rc )
  1321.    {
  1322.       rc = RegisterRxFunctions( );
  1323.    }
  1324. #endif
  1325.    return RxReturnNumber( retstr, rc );
  1326. }
  1327.    
  1328. /*
  1329.  * The following functions are used in rxpackage.c
  1330.  */
  1331.  
  1332. /*-----------------------------------------------------------------------------
  1333.  * Execute any initialisation
  1334.  *----------------------------------------------------------------------------*/
  1335. int InitialisePackage
  1336.  
  1337. #ifdef HAVE_PROTO
  1338.    ( void )
  1339. #else
  1340.    ( )
  1341. #endif
  1342.  
  1343. {
  1344.    InternalTrace( "InitialisePackage", NULL );
  1345.  
  1346.    /*
  1347.     * Install the Combobox widget
  1348.     */
  1349.    if ( Tcl_Eval(RexxTkData->RexxTkInterp, ExtensionSource ) !=TCL_OK) {
  1350.       fprintf(stderr, "Tk_Eval for Combobox widget failed miserably at line %d: %s\n", RexxTkData->RexxTkInterp->errorLine, RexxTkData->RexxTkInterp->result);
  1351.       return 1;
  1352.    }
  1353.    if ( Tcl_Eval(RexxTkData->RexxTkInterp, ExtensionSource1 ) !=TCL_OK) {
  1354.       fprintf(stderr, "Tk_Eval for Combobox widget failed miserably at line %d: %s\n", RexxTkData->RexxTkInterp->errorLine, RexxTkData->RexxTkInterp->result);
  1355.       return 1;
  1356.    }
  1357.    DEBUGDUMP(fprintf(stderr,"%s-%d: After Tcl_Eval()\n",__FILE__,__LINE__);)
  1358.    return 0;
  1359. }
  1360.  
  1361. /*-----------------------------------------------------------------------------
  1362.  * Execute any termination
  1363.  *----------------------------------------------------------------------------*/
  1364. int TerminatePackage
  1365.  
  1366. #ifdef HAVE_PROTO
  1367.    ( void )
  1368. #else
  1369.    ( )
  1370. #endif
  1371.  
  1372. {
  1373.    return 0;
  1374. }
  1375.  
  1376.  
  1377. #if defined(USE_REXX6000)
  1378. /*
  1379.  * This function is used as the entry point for the REXX/6000
  1380.  * Rexx Interpreter
  1381.  * If you change this table, don't forget to change the table at the
  1382.  * start of this file.
  1383.  */
  1384. USHORT InitFunc( RXFUNCBLOCK **FuncBlock )
  1385. {
  1386.    static RXFUNCBLOCK funcarray[] =
  1387.    {
  1388.       { "TKCOMBOBOXDROPFUNCS"       ,TkComboboxDropFuncs      ,NULL },
  1389.       { "TKCOMBOBOXLOADFUNCS"       ,TkComboboxLoadFuncs      ,NULL },
  1390.       { "TKCOMBOBOX"                ,TkCombobox               ,NULL },
  1391.       { "TKCOMBOBOXICURSOR"         ,TkComboboxICursor        ,NULL },
  1392.       { "TKCOMBOBOXLISTDELETE"      ,TkComboboxListDelete     ,NULL },
  1393.       { "TKCOMBOBOXLISTGET"         ,TkComboboxListGet        ,NULL },
  1394.       { "TKCOMBOBOXLISTINDEX"       ,TkComboboxListIndex      ,NULL },
  1395.       { "TKCOMBOBOXLISTINSERT"      ,TkComboboxListInsert     ,NULL },
  1396.       { "TKCOMBOBOXLISTSIZE"        ,TkComboboxListSize       ,NULL },
  1397.       { "TKCOMBOBOXSELECT"          ,TkComboboxSelect         ,NULL },
  1398.       { "TKCOMBOBOXSUBWIDGET"       ,TkComboboxSubwidget      ,NULL },
  1399.       { NULL, NULL, NULL }
  1400.    } ;
  1401.    *FuncBlock = funcarray;
  1402.    return (USHORT)0;
  1403. }
  1404. #endif
  1405.