home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / BWidget-1.2 / combobox.tcl < prev    next >
Text File  |  2000-11-02  |  12KB  |  341 lines
  1. # ------------------------------------------------------------------------------
  2. #  combobox.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: combobox.tcl,v 1.1.1.1 1996/02/22 06:05:55 daniel Exp $
  5. # ------------------------------------------------------------------------------
  6. #  Index of commands:
  7. #     - ComboBox::create
  8. #     - ComboBox::configure
  9. #     - ComboBox::cget
  10. #     - ComboBox::setvalue
  11. #     - ComboBox::getvalue
  12. #     - ComboBox::_create_popup
  13. #     - ComboBox::_mapliste
  14. #     - ComboBox::_unmapliste
  15. #     - ComboBox::_select
  16. #     - ComboBox::_modify_value
  17. # ------------------------------------------------------------------------------
  18.  
  19. namespace eval ComboBox {
  20.     ArrowButton::use
  21.     Entry::use
  22.     LabelFrame::use
  23.  
  24.     Widget::bwinclude ComboBox LabelFrame .labf \
  25.         rename     {-text -label} \
  26.         remove     {-focus} \
  27.         prefix     {label -justify -width -anchor -height -font} \
  28.         initialize {-relief sunken -borderwidth 2}
  29.  
  30.     Widget::bwinclude ComboBox Entry .e \
  31.         remove {-relief -bd -borderwidth -bg -fg} \
  32.         rename {-foreground -entryfg -background -entrybg}
  33.  
  34.     Widget::declare ComboBox {
  35.         {-height      TkResource 0  0 listbox}
  36.         {-values      String     "" 0}
  37.         {-modifycmd   String     "" 0}
  38.         {-postcommand String     "" 0}
  39.     }
  40.  
  41.     Widget::addmap ComboBox "" :cmd {-background {}}
  42.     Widget::addmap ComboBox ArrowButton .a \
  43.         {-foreground {} -background {} -disabledforeground {} -state {}}
  44.  
  45.     Widget::syncoptions ComboBox Entry .e {-text {}}
  46.     Widget::syncoptions ComboBox LabelFrame .labf {-label -text -underline {}}
  47.  
  48.     ::bind BwComboBox <FocusIn> {focus %W.labf}
  49.     ::bind BwComboBox <Destroy> {Widget::destroy %W; rename %W {}}
  50.  
  51.     proc ::ComboBox { path args } { return [eval ComboBox::create $path $args] }
  52.     proc use {} {}
  53. }
  54.  
  55.  
  56. # ------------------------------------------------------------------------------
  57. #  Command ComboBox::create
  58. # ------------------------------------------------------------------------------
  59. proc ComboBox::create { path args } {
  60.     Widget::init ComboBox $path $args
  61.  
  62.     frame $path -background [Widget::getoption $path -background] \
  63.         -highlightthickness 0 -bd 0 -relief flat -takefocus 0
  64.  
  65.     bindtags $path [list $path BwComboBox [winfo toplevel $path] all]
  66.  
  67.     set labf  [eval LabelFrame::create $path.labf [Widget::subcget $path .labf] \
  68.                    -focus $path.e]
  69.     set entry [eval Entry::create $path.e [Widget::subcget $path .e] \
  70.                    -relief flat -borderwidth 0]
  71.  
  72.     set width  11
  73.     set height [winfo reqheight $entry]
  74.     set arrow [eval ArrowButton::create $path.a [Widget::subcget $path .a] \
  75.                    -width $width -height $height \
  76.                    -highlightthickness 0 -borderwidth 1 -takefocus 0 \
  77.                    -dir   bottom \
  78.                    -type  button \
  79.                    -command [list "ComboBox::_mapliste $path"]]
  80.  
  81.     set frame [LabelFrame::getframe $labf]
  82.  
  83.     pack $arrow -in $frame -side right -fill y
  84.     pack $entry -in $frame -side left  -fill both -expand yes
  85.     pack $labf  -fill x -expand yes
  86.  
  87.     if { [Widget::getoption $path -editable] == 0 } {
  88.         ::bind $entry <ButtonPress-1> "ArrowButton::invoke $path.a"
  89.     } else {
  90.         ::bind $entry <ButtonPress-1> "ComboBox::_unmapliste $path"
  91.     }
  92.  
  93.     ::bind $path  <ButtonPress-1> "ComboBox::_unmapliste $path"
  94.     ::bind $entry <Key-Up>        "ComboBox::_modify_value $path previous"
  95.     ::bind $entry <Key-Down>      "ComboBox::_modify_value $path next"
  96.     ::bind $entry <Key-Prior>     "ComboBox::_modify_value $path first"
  97.     ::bind $entry <Key-Next>      "ComboBox::_modify_value $path last"
  98.  
  99.     rename $path ::$path:cmd
  100.     proc ::$path { cmd args } "return \[eval ComboBox::\$cmd $path \$args\]"
  101.  
  102.     return $path
  103. }
  104.  
  105.  
  106. # ------------------------------------------------------------------------------
  107. #  Command ComboBox::configure
  108. # ------------------------------------------------------------------------------
  109. proc ComboBox::configure { path args } {
  110.     set res [Widget::configure $path $args]
  111.  
  112.     if { [Widget::hasChanged $path -values values] |
  113.          [Widget::hasChanged $path -height h] |
  114.          [Widget::hasChanged $path -font f] } {
  115.         destroy $path.shell.listb
  116.     }
  117.  
  118.     if { [Widget::hasChanged $path -editable ed] } {
  119.         if { $ed } {
  120.             ::bind $path.e <ButtonPress-1> "ComboBox::_unmapliste $path"
  121.         } else {
  122.             ::bind $path.e <ButtonPress-1> "ArrowButton::invoke $path.a"
  123.         }
  124.     }
  125.  
  126.     return $res
  127. }
  128.  
  129.  
  130. # ------------------------------------------------------------------------------
  131. #  Command ComboBox::cget
  132. # ------------------------------------------------------------------------------
  133. proc ComboBox::cget { path option } {
  134.     Widget::setoption $path -text [Entry::cget $path.e -text]
  135.     return [Widget::cget $path $option]
  136. }
  137.  
  138.  
  139. # ------------------------------------------------------------------------------
  140. #  Command ComboBox::setvalue
  141. # ------------------------------------------------------------------------------
  142. proc ComboBox::setvalue { path index } {
  143.     set values [Widget::getoption $path -values]
  144.     set value  [Entry::cget $path.e -text]
  145.     switch -- $index {
  146.         next {
  147.             if { [set idx [lsearch $values $value]] != -1 } {
  148.                 incr idx
  149.             } else {
  150.                 set idx [lsearch $values "$value*"]
  151.             }
  152.         }
  153.         previous {
  154.             if { [set idx [lsearch $values $value]] != -1 } {
  155.                 incr idx -1
  156.             } else {
  157.                 set idx [lsearch $values "$value*"]
  158.             }
  159.         }
  160.         first {
  161.             set idx 0
  162.         }
  163.         last {
  164.             set idx [expr {[llength $values]-1}]
  165.         }
  166.         default {
  167.             if { [string index $index 0] == "@" } {
  168.                 set idx [string range $index 1 end]
  169.                 if { [catch {string compare [expr {int($idx)}] $idx} res] || $res != 0 } {
  170.                     return -code error "bad index \"$index\""
  171.                 }
  172.             } else {
  173.                 return -code error "bad index \"$index\""
  174.             }
  175.         }
  176.     }
  177.     if { $idx >= 0 && $idx < [llength $values] } {
  178.         set newval [lindex $values $idx]
  179.         Widget::setoption $path -text $newval
  180.         if { [set varname [Entry::cget $path.e -textvariable]] != "" } {
  181.             GlobalVar::setvar $varname $newval
  182.         } else {
  183.             Entry::configure $path.e -text $newval
  184.         }
  185.         return 1
  186.     }
  187.     return 0
  188. }
  189.  
  190.  
  191. # ------------------------------------------------------------------------------
  192. #  Command ComboBox::getvalue
  193. # ------------------------------------------------------------------------------
  194. proc ComboBox::getvalue { path } {
  195.     set values [Widget::getoption $path -values]
  196.     set value  [Entry::cget $path.e -text]
  197.  
  198.     return [lsearch $values $value]
  199. }
  200.  
  201.  
  202. # ------------------------------------------------------------------------------
  203. #  Command ComboBox::bind
  204. # ------------------------------------------------------------------------------
  205. proc ComboBox::bind { path args } {
  206.     return [eval ::bind $path.e $args]
  207. }
  208.  
  209.  
  210. # ------------------------------------------------------------------------------
  211. #  Command ComboBox::_create_popup
  212. # ------------------------------------------------------------------------------
  213. proc ComboBox::_create_popup { path } {
  214.     set shell [menu $path.shell -tearoff 0 -relief flat -bd 0]
  215.     wm overrideredirect $shell 1
  216.     wm withdraw $shell
  217.     wm transient $shell [winfo toplevel $path]
  218.     wm group $shell [winfo toplevel $path]
  219.     set lval [Widget::getoption $path -values]
  220.     set h    [Widget::getoption $path -height] 
  221.     set sb   0
  222.     if { $h <= 0 } {
  223.         set len [llength $lval]
  224.         if { $len < 3 } {
  225.             set h 3
  226.         } elseif { $len > 10 } {
  227.             set h  10
  228.         set sb 1
  229.         }
  230.     }
  231.     set frame  [frame $shell.frame -relief sunken -bd 2]
  232.     set listb  [listbox $shell.listb -relief flat -bd 0 -highlightthickness 0 \
  233.                     -exportselection false \
  234.                     -font   [Widget::getoption $path -font]  \
  235.                     -height $h]
  236.  
  237.     if { $sb } {
  238.     set scroll [scrollbar $shell.scroll \
  239.         -orient vertical \
  240.         -command "$shell.listb yview" \
  241.         -highlightthickness 0 -takefocus 0 -width 9]
  242.     $listb configure -yscrollcommand "$scroll set"
  243.     }
  244.     $listb delete 0 end
  245.     foreach val $lval {
  246.         $listb insert end $val
  247.     }
  248.  
  249.     if { $sb } {
  250.     pack $scroll -in $frame -side right -fill y
  251.     }
  252.     pack $listb  -in $frame -side left  -fill both -expand yes
  253.     pack $frame  -fill both -expand yes
  254.  
  255.     ::bind $listb <ButtonRelease-1> "ComboBox::_select $path @%x,%y"
  256.     ::bind $listb <Return>          "ComboBox::_select $path active"
  257.     ::bind $listb <Escape>          "ComboBox::_unmapliste $path"
  258. }
  259.  
  260.  
  261. # ------------------------------------------------------------------------------
  262. #  Command ComboBox::_mapliste
  263. # ------------------------------------------------------------------------------
  264. proc ComboBox::_mapliste { path } {
  265.     set listb $path.shell.listb
  266.     if { [winfo exists $path.shell] } {
  267.     _unmapliste $path
  268.         return
  269.     }
  270.  
  271.     if { [Widget::getoption $path -state] == "disabled" } {
  272.         return
  273.     }
  274.     if { [set cmd [Widget::getoption $path -postcommand]] != "" } {
  275.         uplevel \#0 $cmd
  276.     }
  277.     if { ![llength [Widget::getoption $path -values]] } {
  278.         return
  279.     }
  280.     _create_popup $path
  281.  
  282.     ArrowButton::configure $path.a -dir top
  283.     $listb selection clear 0 end
  284.     set values [$listb get 0 end]
  285.     set curval [Entry::cget $path.e -text]
  286.     if { [set idx [lsearch $values $curval]] != -1 ||
  287.          [set idx [lsearch $values "$curval*"]] != -1 } {
  288.         $listb selection set $idx
  289.         $listb activate $idx
  290.         $listb see $idx
  291.     } else {
  292.         $listb activate 0
  293.         $listb see 0
  294.     }
  295.  
  296.     set frame [LabelFrame::getframe $path.labf]
  297.     BWidget::place $path.shell [winfo width $frame] 0 below $frame
  298.     wm deiconify $path.shell
  299.     raise $path.shell
  300.     BWidget::grab global $path
  301. }
  302.  
  303.  
  304. # ------------------------------------------------------------------------------
  305. #  Command ComboBox::_unmapliste
  306. # ------------------------------------------------------------------------------
  307. proc ComboBox::_unmapliste { path } {
  308.     BWidget::grab release $path
  309.     destroy $path.shell
  310.     ArrowButton::configure $path.a -dir bottom
  311. }
  312.  
  313.  
  314. # ------------------------------------------------------------------------------
  315. #  Command ComboBox::_select
  316. # ------------------------------------------------------------------------------
  317. proc ComboBox::_select { path index } {
  318.     set index [$path.shell.listb index $index]
  319.     _unmapliste $path
  320.     if { $index != -1 } {
  321.         if { [setvalue $path @$index] } {
  322.             if { [set cmd [Widget::getoption $path -modifycmd]] != "" } {
  323.                 uplevel \#0 $cmd
  324.             }
  325.         }
  326.     }
  327.     return -code break
  328. }
  329.  
  330.  
  331. # ------------------------------------------------------------------------------
  332. #  Command ComboBox::_modify_value
  333. # ------------------------------------------------------------------------------
  334. proc ComboBox::_modify_value { path direction } {
  335.     if { [setvalue $path $direction] } {
  336.         if { [set cmd [Widget::getoption $path -modifycmd]] != "" } {
  337.             uplevel \#0 $cmd
  338.         }
  339.     }
  340. }
  341.