home *** CD-ROM | disk | FTP | other *** search
/ Freelog Special Freeware 31 / FreelogHS31.iso / Texte / scribus / scribus-1.3.3.9-win32-install.exe / tcl / tix8.1 / SListBox.tcl < prev    next >
Text File  |  2001-12-08  |  7KB  |  301 lines
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. #    $Id: SListBox.tcl,v 1.2.2.2 2001/12/09 02:54:02 idiscovery Exp $
  4. #
  5. # SListBox.tcl --
  6. #
  7. #    This file implements Scrolled Listbox widgets
  8. #
  9. # Copyright (c) 1993-1999 Ioi Kim Lam.
  10. # Copyright (c) 2000-2001 Tix Project Group.
  11. #
  12. # See the file "license.terms" for information on usage and redistribution
  13. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14. #
  15.  
  16.  
  17. # ToDo:
  18. # -anchor (none)
  19. #
  20.  
  21. tixWidgetClass tixScrolledListBox {
  22.     -classname TixScrolledListBox
  23.     -superclass tixScrolledWidget
  24.     -method {
  25.     }
  26.     -flag {
  27.     -anchor -browsecmd -command -state
  28.     }
  29.     -static {
  30.     -anchor
  31.     }
  32.     -configspec {
  33.     {-anchor anchor Anchor w}
  34.     {-browsecmd browseCmd BrowseCmd ""}
  35.     {-command command Command ""}
  36.     {-state state State normal}
  37.     {-takefocus takeFocus TakeFocus 1 tixVerifyBoolean}
  38.     }
  39.     -default {
  40.     {.scrollbar            auto}
  41.     {*borderWidth            1}
  42.     {*listbox.highlightBackground    #d9d9d9}
  43.     {*listbox.relief        sunken}
  44.     {*listbox.background        #c3c3c3}
  45.     {*listbox.takeFocus        1}
  46.     {*Scrollbar.takeFocus        0}
  47.     }
  48. }
  49.  
  50. proc tixScrolledListBox:InitWidgetRec {w} {
  51.     upvar #0 $w data
  52.  
  53.     tixChainMethod $w InitWidgetRec
  54.  
  55.     set data(x-first) 0
  56.     set data(x-last)  1
  57.     set data(y-first) 0
  58.     set data(y-last)  1
  59. }
  60.  
  61. proc tixScrolledListBox:ConstructWidget {w} {
  62.     upvar #0 $w data
  63.  
  64.     tixChainMethod $w ConstructWidget
  65.  
  66.     set data(w:listbox) \
  67.     [listbox $w.listbox]
  68.     set data(w:hsb) \
  69.     [scrollbar $w.hsb -orient horizontal]
  70.     set data(w:vsb) \
  71.     [scrollbar $w.vsb -orient vertical ]
  72.  
  73.     set data(pw:client) $data(w:listbox)
  74. }
  75.  
  76. proc tixScrolledListBox:SetBindings {w} {
  77.     upvar #0 $w data
  78.  
  79.     tixChainMethod $w SetBindings
  80.  
  81.     $data(w:listbox) config \
  82.     -xscrollcommand "tixScrolledListBox:XView $w"\
  83.     -yscrollcommand "tixScrolledListBox:YView $w"
  84.  
  85.     $data(w:hsb) config -command "$data(w:listbox) xview"
  86.     $data(w:vsb) config -command "$data(w:listbox) yview"
  87.  
  88.     bind $w <Configure> "+tixScrolledListBox:Configure $w"
  89.     bind $w <FocusIn> "focus $data(w:listbox)"
  90.  
  91.     bindtags $data(w:listbox) \
  92.     "$data(w:listbox) TixListboxState Listbox TixListbox [winfo toplevel $data(w:listbox)] all"
  93.     tixSetMegaWidget $data(w:listbox) $w
  94. }
  95.  
  96. proc tixScrolledListBoxBind {} {
  97.     tixBind TixListboxState <1> {
  98.     if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
  99.         break
  100.     }
  101.     }
  102.     tixBind TixListbox      <1> {
  103.     if {[tixGetBoolean -nocomplain [%W cget -takefocus]]} {
  104.         focus %W
  105.     }
  106.     tixScrolledListBox:Browse [tixGetMegaWidget %W]
  107.     }
  108.  
  109.     tixBind TixListboxState <B1-Motion> {
  110.     if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
  111.         break
  112.     }
  113.     }
  114.     tixBind TixListbox      <B1-Motion> {
  115.     tixScrolledListBox:Browse [tixGetMegaWidget %W]
  116.     }
  117.  
  118.     tixBind TixListboxState <Up> {
  119.     if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
  120.         break
  121.     }
  122.     }
  123.     tixBind TixListbox      <Up> {
  124.     tixScrolledListBox:KeyBrowse [tixGetMegaWidget %W]
  125.     }
  126.  
  127.     tixBind TixListboxState <Down> {
  128.     if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
  129.         break
  130.     }
  131.     }
  132.     tixBind TixListbox      <Down> {
  133.     tixScrolledListBox:KeyBrowse [tixGetMegaWidget %W]
  134.     }
  135.  
  136.     tixBind TixListboxState <Return> {
  137.     if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
  138.         break
  139.     }
  140.     }
  141.     tixBind TixListbox      <Return> {
  142.     tixScrolledListBox:KeyInvoke [tixGetMegaWidget %W]
  143.     }
  144.  
  145.  
  146.     tixBind TixListboxState <Double-1> {
  147.     if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
  148.         break
  149.     }
  150.     }
  151.     tixBind TixListbox      <Double-1> {
  152.     tixScrolledListBox:Invoke [tixGetMegaWidget %W]
  153.     }
  154.  
  155.     tixBind TixListboxState <ButtonRelease-1> {
  156.     if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
  157.         break
  158.     }
  159.     }
  160.     tixBind TixListbox      <ButtonRelease-1> {
  161.     tixScrolledListBox:Browse [tixGetMegaWidget %W]
  162.     }
  163. }
  164.  
  165. proc tixScrolledListBox:Browse {w} {
  166.     upvar #0 $w data
  167.  
  168.     if {$data(-browsecmd) != ""} {
  169.     set bind(specs) {%V}
  170.     set bind(%V) [$data(w:listbox) get \
  171.         [$data(w:listbox) nearest [tixEvent flag y]]]
  172.     tixEvalCmdBinding $w $data(-browsecmd) bind
  173.     }
  174. }
  175.  
  176. proc tixScrolledListBox:KeyBrowse {w} {
  177.     upvar #0 $w data
  178.  
  179.     if {$data(-browsecmd) != ""} {
  180.     set bind(specs) {%V}
  181.     set bind(%V) [$data(w:listbox) get active]
  182.     tixEvalCmdBinding $w $data(-browsecmd) bind
  183.     }
  184. }
  185.  
  186. # tixScrolledListBox:Invoke --
  187. #
  188. #    The user has invoked the listbox by pressing either the <Returh>
  189. # key or double-clicking. Call the user-supplied -command function.
  190. #
  191. # For both -browsecmd and -command, it is the responsibility of the
  192. # user-supplied function to determine the current selection of the listbox
  193. # 
  194. proc tixScrolledListBox:Invoke {w} {
  195.     upvar #0 $w data
  196.  
  197.     if {$data(-command) != ""} {
  198.     set bind(specs) {%V}
  199.     set bind(%V) [$data(w:listbox) get \
  200.         [$data(w:listbox) nearest [tixEvent flag y]]]
  201.     tixEvalCmdBinding $w $data(-command) bind
  202.     }
  203. }
  204.  
  205. proc tixScrolledListBox:KeyInvoke {w} {
  206.     upvar #0 $w data
  207.  
  208.     if {$data(-command) != ""} {
  209.     set bind(specs) {%V}
  210.     set bind(%V) [$data(w:listbox) get active]
  211.     tixEvalCmdBinding $w $data(-command) bind
  212.     }
  213. }
  214.  
  215. #----------------------------------------------------------------------
  216. #
  217. #        option configs
  218. #----------------------------------------------------------------------
  219. proc tixScrolledListBox:config-takefocus {w value} {
  220.     upvar #0 $w data
  221.   
  222.     $data(w:listbox) config -takefocus $value
  223. }    
  224.  
  225.  
  226. #----------------------------------------------------------------------
  227. #
  228. #        Widget commands
  229. #----------------------------------------------------------------------
  230.  
  231.  
  232. #----------------------------------------------------------------------
  233. #
  234. #        Private Methods
  235. #----------------------------------------------------------------------
  236. proc tixScrolledListBox:XView {w first last} {
  237.     upvar #0 $w data
  238.  
  239.     set data(x-first) $first
  240.     set data(x-last) $last
  241.  
  242.     $data(w:hsb) set $first $last
  243.     tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
  244.  
  245.  
  246. }
  247.  
  248. proc tixScrolledListBox:YView {w first last} {
  249.     upvar #0 $w data
  250.  
  251.     set data(y-first) $first
  252.     set data(y-last) $last
  253.  
  254.     $data(w:vsb) set $first $last
  255.     tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
  256.  
  257.     # Somehow an update here must be used to advoid osscilation
  258.     #
  259.     update idletasks
  260. }
  261.  
  262. #
  263. #----------------------------------------------------------------------
  264. # virtual functions to query the client window's scroll requirement
  265. #----------------------------------------------------------------------
  266. proc tixScrolledListBox:GeometryInfo {w mW mH} {
  267.     upvar #0 $w data
  268.  
  269.     return [list \
  270.     [list $data(x-first) $data(x-last)]\
  271.     [list $data(y-first) $data(y-last)]]
  272. }
  273.  
  274. proc tixScrolledListBox:Configure {w} {
  275.     upvar #0 $w data
  276.  
  277.     tixWidgetDoWhenIdle tixScrolledListBox:TrickScrollbar $w
  278.  
  279.     if {$data(-anchor) == "e"} {
  280.     $data(w:listbox) xview 100000
  281.     }
  282. }
  283.  
  284. # This procedure is necessary because listbox does not call x,y scroll command
  285. # when its size is changed
  286. #
  287. proc tixScrolledListBox:TrickScrollbar {w} {
  288.     upvar #0 $w data
  289.  
  290.     if {[$data(w:listbox) select include 0]} {
  291.     set inc 1
  292.     } else {
  293.     set inc 0
  294.     }
  295.  
  296.     $data(w:listbox) select set 0
  297.     if {!$inc} {
  298.     $data(w:listbox) select clear 0
  299.     }
  300. }
  301.