home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / lib / bwidget1.3.0 / combobox.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  13.8 KB  |  434 lines
  1. # -----------------------------------------------------------------------------
  2. #  combobox.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: combobox.tcl,v 1.18 2001/06/11 23:57:33 hobbs 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. # ComboBox uses the 8.3 -listvariable listbox option
  20. package require Tk 8.3
  21.  
  22. namespace eval ComboBox {
  23.     ArrowButton::use
  24.     Entry::use
  25.  
  26.     Widget::tkinclude ComboBox frame :cmd \
  27.         include {-relief -borderwidth -bd -background} \
  28.         initialize {-relief sunken -borderwidth 2} \
  29.         
  30.     Widget::bwinclude ComboBox Entry .e \
  31.         remove {-relief -bd -borderwidth -bg} \
  32.         rename {-background -entrybg}
  33.  
  34.     Widget::declare ComboBox {
  35.         {-height      TkResource 0  0 listbox}
  36.         {-values      String     "" 0}
  37.         {-images      String     "" 0}
  38.         {-indents     String     "" 0}
  39.         {-modifycmd   String     "" 0}
  40.         {-postcommand String     "" 0}
  41.     }
  42.  
  43.     Widget::addmap ComboBox ArrowButton .a {
  44.         -background {} -foreground {} -disabledforeground {} -state {}
  45.     }
  46.  
  47.     Widget::syncoptions ComboBox Entry .e {-text {}}
  48.  
  49.     ::bind BwComboBox <FocusIn> [list after idle {BWidget::refocus %W %W.e}]
  50.     ::bind BwComboBox <Destroy> {Widget::destroy %W; rename %W {}}
  51.  
  52.     proc ::ComboBox { path args } { return [eval ComboBox::create $path $args] }
  53.     proc use {} {}
  54. }
  55.  
  56.  
  57. # ComboBox::create --
  58. #
  59. #    Create a combobox widget with the given options.
  60. #
  61. # Arguments:
  62. #    path    name of the new widget.
  63. #    args    optional arguments to the widget.
  64. #
  65. # Results:
  66. #    path    name of the new widget.
  67.  
  68. proc ComboBox::create { path args } {
  69.     array set maps [list ComboBox {} :cmd {} .e {} .a {}]
  70.     array set maps [Widget::parseArgs ComboBox $args]
  71.  
  72.     eval frame $path $maps(:cmd) -highlightthickness 0 \
  73.         -takefocus 0 -class ComboBox
  74.     Widget::initFromODB ComboBox $path $maps(ComboBox)
  75.  
  76.     bindtags $path [list $path BwComboBox [winfo toplevel $path] all]
  77.  
  78.     set entry [eval Entry::create $path.e $maps(.e) \
  79.                    -relief flat -borderwidth 0 -takefocus 1]
  80.     ::bind $path.e <FocusIn> "$path _focus_in"
  81.     ::bind $path.e <FocusOut> "$path _focus_out"
  82.  
  83.     if {[string equal $::tcl_platform(platform) "unix"]} {
  84.         set ipadx 0
  85.         set width 11
  86.     } else {
  87.         set ipadx 2
  88.         set width 15
  89.     }
  90.     set height [winfo reqheight $entry]
  91.     set arrow [eval ArrowButton::create $path.a $maps(.a) \
  92.                    -width $width -height $height \
  93.                    -highlightthickness 0 -borderwidth 1 -takefocus 0 \
  94.                    -dir   bottom \
  95.                    -type  button \
  96.            -ipadx $ipadx \
  97.                    -command [list "ComboBox::_mapliste $path"]]
  98.  
  99.     pack $arrow -side right -fill y
  100.     pack $entry -side left  -fill both -expand yes
  101.  
  102.     if { [Widget::cget $path -editable] } {
  103.     ::bind $entry <ButtonPress-1> "ComboBox::_unmapliste $path"
  104.     Entry::configure $path.e -editable true
  105.     } else {
  106.     ::bind $entry <ButtonPress-1> "ArrowButton::invoke $path.a"
  107.     Entry::configure $path.e -editable false
  108.     if { ![string equal [Widget::cget $path -state] "disabled"] } {
  109.         Entry::configure $path.e -takefocus 1
  110.     }
  111.     }
  112.  
  113.     ::bind $path  <ButtonPress-1> "ComboBox::_unmapliste $path"
  114.     ::bind $entry <Key-Up>        "ComboBox::_unmapliste $path"
  115.     ::bind $entry <Key-Down>      "ComboBox::_mapliste $path"
  116.     ::bind $entry <Control-Up>        "ComboBox::_modify_value $path previous"
  117.     ::bind $entry <Control-Down>      "ComboBox::_modify_value $path next"
  118.     ::bind $entry <Control-Prior>     "ComboBox::_modify_value $path first"
  119.     ::bind $entry <Control-Next>      "ComboBox::_modify_value $path last"
  120.  
  121.     rename $path ::$path:cmd
  122.     proc ::$path { cmd args } "return \[eval ComboBox::\$cmd $path \$args\]"
  123.  
  124.     return $path
  125. }
  126.  
  127.  
  128. # ComboBox::configure --
  129. #
  130. #    Configure subcommand for ComboBox widgets.  Works like regular
  131. #    widget configure command.
  132. #
  133. # Arguments:
  134. #    path    Name of the ComboBox widget.
  135. #    args    Additional optional arguments:
  136. #            ?-option?
  137. #            ?-option value ...?
  138. #
  139. # Results:
  140. #    Depends on arguments.  If no arguments are given, returns a complete
  141. #    list of configuration information.  If one argument is given, returns
  142. #    the configuration information for that option.  If more than one
  143. #    argument is given, returns nothing.
  144.  
  145. proc ComboBox::configure { path args } {
  146.     set res [Widget::configure $path $args]
  147.  
  148.     if { [Widget::hasChangedX $path -editable] } {
  149.         if { [Widget::cget $path -editable] } {
  150.             ::bind $path.e <ButtonPress-1> "ComboBox::_unmapliste $path"
  151.         Entry::configure $path.e -editable true
  152.     } else {
  153.         ::bind $path.e <ButtonPress-1> "ArrowButton::invoke $path.a"
  154.         Entry::configure $path.e -editable false
  155.  
  156.         # Make sure that non-editable comboboxes can still be tabbed to.
  157.  
  158.         if { ![string equal [Widget::cget $path -state] "disabled"] } {
  159.         Entry::configure $path.e -takefocus 1
  160.         }
  161.         }
  162.     }
  163.  
  164.     return $res
  165. }
  166.  
  167.  
  168. # ------------------------------------------------------------------------------
  169. #  Command ComboBox::cget
  170. # ------------------------------------------------------------------------------
  171. proc ComboBox::cget { path option } {
  172.     return [Widget::cget $path $option]
  173. }
  174.  
  175.  
  176. # ------------------------------------------------------------------------------
  177. #  Command ComboBox::setvalue
  178. # ------------------------------------------------------------------------------
  179. proc ComboBox::setvalue { path index } {
  180.     set values [Widget::getMegawidgetOption $path -values]
  181.     set value  [Entry::cget $path.e -text]
  182.     switch -- $index {
  183.         next {
  184.             if { [set idx [lsearch -exact $values $value]] != -1 } {
  185.                 incr idx
  186.             } else {
  187.                 set idx [lsearch -exact $values "$value*"]
  188.             }
  189.         }
  190.         previous {
  191.             if { [set idx [lsearch -exact $values $value]] != -1 } {
  192.                 incr idx -1
  193.             } else {
  194.                 set idx [lsearch -exact $values "$value*"]
  195.             }
  196.         }
  197.         first {
  198.             set idx 0
  199.         }
  200.         last {
  201.             set idx [expr {[llength $values]-1}]
  202.         }
  203.         default {
  204.             if { [string index $index 0] == "@" } {
  205.                 set idx [string range $index 1 end]
  206.         if { ![string is integer -strict $idx] } {
  207.                     return -code error "bad index \"$index\""
  208.                 }
  209.             } else {
  210.                 return -code error "bad index \"$index\""
  211.             }
  212.         }
  213.     }
  214.     if { $idx >= 0 && $idx < [llength $values] } {
  215.         set newval [lindex $values $idx]
  216.     Entry::configure $path.e -text $newval
  217.         return 1
  218.     }
  219.     return 0
  220. }
  221.  
  222.  
  223. # ------------------------------------------------------------------------------
  224. #  Command ComboBox::getvalue
  225. # ------------------------------------------------------------------------------
  226. proc ComboBox::getvalue { path } {
  227.     set values [Widget::getMegawidgetOption $path -values]
  228.     set value  [Entry::cget $path.e -text]
  229.  
  230.     return [lsearch -exact $values $value]
  231. }
  232.  
  233.  
  234. # ------------------------------------------------------------------------------
  235. #  Command ComboBox::bind
  236. # ------------------------------------------------------------------------------
  237. proc ComboBox::bind { path args } {
  238.     return [eval ::bind $path.e $args]
  239. }
  240.  
  241.  
  242. # ------------------------------------------------------------------------------
  243. #  Command ComboBox::_create_popup
  244. # ------------------------------------------------------------------------------
  245. proc ComboBox::_create_popup { path } {
  246.     set shell $path.shell
  247.     set lval  [Widget::cget $path -values]
  248.     set h     [Widget::cget $path -height]
  249.     if { $h <= 0 } {
  250.         set len [llength $lval]
  251.         if { $len < 3 } {
  252.             set h 3
  253.         } elseif { $len > 10 } {
  254.             set h 10
  255.         } else {
  256.             set h $len
  257.         }
  258.     }
  259.     if { $::tcl_platform(platform) == "unix" } {
  260.     set sbwidth 11
  261.     } else {
  262.     set sbwidth 15
  263.     }
  264.     if {![winfo exists $path.shell]} {
  265.         set shell [toplevel $path.shell -relief sunken -bd 2]
  266.         wm overrideredirect $shell 1
  267.         wm transient $shell [winfo toplevel $path]
  268.         wm withdraw  $shell
  269.  
  270.         set sw     [ScrolledWindow $shell.sw -managed 0 -size $sbwidth -ipad 0]
  271.         set listb  [listbox $shell.listb \
  272.         -relief flat -borderwidth 0 -highlightthickness 0 \
  273.         -exportselection false \
  274.         -font   [Widget::cget $path -font]  \
  275.         -height $h \
  276.         -listvariable [Widget::varForOption $path -values]]
  277.         pack $sw -fill both -expand yes
  278.         $sw setwidget $listb
  279.  
  280.         ::bind $listb <ButtonRelease-1> "ComboBox::_select $path @%x,%y"
  281.         ::bind $listb <Return>          "ComboBox::_select $path active; break"
  282.         ::bind $listb <Escape>          "ComboBox::_unmapliste $path; break"
  283.     } else {
  284.         set listb $shell.listb
  285.         destroy $shell.sw
  286.         set sw [ScrolledWindow $shell.sw -managed 0 -size $sbwidth -ipad 0]
  287.         $listb configure -height $h -font [Widget::cget $path -font]
  288.         pack $sw -fill both -expand yes
  289.         $sw setwidget $listb
  290.         raise $listb
  291.     }
  292. }
  293.  
  294.  
  295. # ------------------------------------------------------------------------------
  296. #  Command ComboBox::_mapliste
  297. # ------------------------------------------------------------------------------
  298. proc ComboBox::_mapliste { path } {
  299.     set listb $path.shell.listb
  300.     if {[winfo exists $path.shell] &&
  301.         ![string compare [wm state $path.shell] "normal"]} {
  302.     _unmapliste $path
  303.         return
  304.     }
  305.  
  306.     if { [Widget::cget $path -state] == "disabled" } {
  307.         return
  308.     }
  309.     if { [set cmd [Widget::getMegawidgetOption $path -postcommand]] != "" } {
  310.         uplevel \#0 $cmd
  311.     }
  312.     if { ![llength [Widget::getMegawidgetOption $path -values]] } {
  313.         return
  314.     }
  315.     _create_popup $path
  316.  
  317.     ArrowButton::configure $path.a -relief sunken
  318.     update
  319.  
  320.     $listb selection clear 0 end
  321.     set values [Widget::getMegawidgetOption $path -values]
  322.     set curval [Entry::cget $path.e -text]
  323.     if { [set idx [lsearch -exact $values $curval]] != -1 ||
  324.          [set idx [lsearch -exact $values "$curval*"]] != -1 } {
  325.         $listb selection set $idx
  326.         $listb activate $idx
  327.         $listb see $idx
  328.     } else {
  329.     $listb selection set 0
  330.         $listb activate 0
  331.         $listb see 0
  332.     }
  333.  
  334.     BWidget::place $path.shell [winfo width $path] 0 below $path
  335.     wm deiconify $path.shell
  336.     raise $path.shell
  337.     BWidget::focus set $listb
  338.     BWidget::grab global $path
  339. }
  340.  
  341.  
  342. # ------------------------------------------------------------------------------
  343. #  Command ComboBox::_unmapliste
  344. # ------------------------------------------------------------------------------
  345. proc ComboBox::_unmapliste { path } {
  346.     if {[winfo exists $path.shell] && \
  347.         ![string compare [wm state $path.shell] "normal"]} {
  348.         BWidget::grab release $path
  349.         BWidget::focus release $path.shell.listb
  350.     # Update now because otherwise [focus -force...] makes the app hang!
  351.     update
  352.     focus -force $path.e
  353.         wm withdraw $path.shell
  354.         ArrowButton::configure $path.a -relief raised
  355.     }
  356. }
  357.  
  358.  
  359. # ------------------------------------------------------------------------------
  360. #  Command ComboBox::_select
  361. # ------------------------------------------------------------------------------
  362. proc ComboBox::_select { path index } {
  363.     set index [$path.shell.listb index $index]
  364.     _unmapliste $path
  365.     if { $index != -1 } {
  366.         if { [setvalue $path @$index] } {
  367.         set cmd [Widget::getMegawidgetOption $path -modifycmd]
  368.             if { $cmd != "" } {
  369.                 uplevel \#0 $cmd
  370.             }
  371.         }
  372.     }
  373.     $path.e selection clear
  374.     $path.e selection range 0 end
  375.     return -code break
  376. }
  377.  
  378.  
  379. # ------------------------------------------------------------------------------
  380. #  Command ComboBox::_modify_value
  381. # ------------------------------------------------------------------------------
  382. proc ComboBox::_modify_value { path direction } {
  383.     if { [setvalue $path $direction] } {
  384.         if { [set cmd [Widget::getMegawidgetOption $path -modifycmd]] != "" } {
  385.             uplevel \#0 $cmd
  386.         }
  387.     }
  388. }
  389.  
  390. # ----------------------------------------------------------------------------
  391. #  Command ComboBox::_focus_in
  392. # ----------------------------------------------------------------------------
  393. proc ComboBox::_focus_in { path } {
  394.     variable background
  395.     variable foreground
  396.  
  397.     if { [Widget::cget $path -editable] == 0 } {
  398.         set value  [Entry::cget $path.e -text]
  399.         if {[string equal $value ""]} {
  400.             # If the entry is empty, we need to do some magic to
  401.             # make it "selected"
  402.             if {[$path.e cget -bg] != [$path.e cget -selectbackground]} {
  403.                 # Copy only if we know that this is not the selection
  404.                 # background color (by accident... focus out without
  405.                 # focus in etc.
  406.                 set background [$path.e cget -bg]
  407.                 set foreground [$path.e cget -fg]
  408.             }
  409.             $path.e configure -bg [$path.e cget -selectbackground]
  410.             $path.e configure -fg [$path.e cget -selectforeground]
  411.         }
  412.     }
  413.     $path.e selection clear
  414.     $path.e selection range 0 end
  415. }
  416.  
  417.  
  418. # ----------------------------------------------------------------------------
  419. #  Command ComboBox::_focus_out
  420. # ----------------------------------------------------------------------------
  421. proc ComboBox::_focus_out { path } {
  422.     variable background
  423.     variable foreground
  424.  
  425.     if { [Widget::cget $path -editable] == 0 } {
  426.         if {[info exists background]} {
  427.             $path.e configure -bg $background
  428.             $path.e configure -fg $foreground
  429.             unset background
  430.             unset foreground
  431.         }
  432.     }
  433. }
  434.