SHList.tcl 3.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. # $Id: SHList.tcl,v 1.7 2004/04/09 21:37:33 hobbs Exp $
  4. #
  5. # SHList.tcl --
  6. #
  7. # This file implements Scrolled HList widgets
  8. #
  9. # Copyright (c) 1993-1999 Ioi Kim Lam.
  10. # Copyright (c) 2000-2001 Tix Project Group.
  11. # Copyright (c) 2004 ActiveState
  12. #
  13. # See the file "license.terms" for information on usage and redistribution
  14. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15. #
  16. tixWidgetClass tixScrolledHList {
  17. -classname TixScrolledHList
  18. -superclass tixScrolledWidget
  19. -method {
  20. }
  21. -flag {
  22. -highlightbackground -highlightcolor -highlightthickness
  23. }
  24. -configspec {
  25. {-highlightbackground -highlightBackground HighlightBackground #d9d9d9}
  26. {-highlightcolor -highlightColor HighlightColor black}
  27. {-highlightthickness -highlightThickness HighlightThickness 2}
  28. }
  29. -default {
  30. {.scrollbar auto}
  31. {*f1.borderWidth 1}
  32. {*hlist.Background #c3c3c3}
  33. {*hlist.highlightBackground #d9d9d9}
  34. {*hlist.relief sunken}
  35. {*hlist.takeFocus 1}
  36. {*Scrollbar.takeFocus 0}
  37. }
  38. -forcecall {
  39. -highlightbackground -highlightcolor -highlightthickness
  40. }
  41. }
  42. proc tixScrolledHList:ConstructWidget {w} {
  43. upvar #0 $w data
  44. tixChainMethod $w ConstructWidget
  45. set data(pw:f1) [frame $w.f1 -takefocus 0]
  46. set data(w:hlist) \
  47. [tixHList $w.f1.hlist -bd 0 -takefocus 1 -highlightthickness 0]
  48. pack $data(w:hlist) -in $data(pw:f1) -expand yes -fill both -padx 0 -pady 0
  49. set data(w:hsb) [scrollbar $w.hsb -orient horizontal -takefocus 0]
  50. set data(w:vsb) [scrollbar $w.vsb -orient vertical -takefocus 0]
  51. set data(pw:client) $data(pw:f1)
  52. }
  53. proc tixScrolledHList:SetBindings {w} {
  54. upvar #0 $w data
  55. tixChainMethod $w SetBindings
  56. $data(w:hlist) config \
  57. -xscrollcommand [list $data(w:hsb) set] \
  58. -yscrollcommand [list $data(w:vsb) set] \
  59. -sizecmd [list tixScrolledWidget:Configure $w]
  60. $data(w:hsb) config -command [list $data(w:hlist) xview]
  61. $data(w:vsb) config -command [list $data(w:hlist) yview]
  62. }
  63. #----------------------------------------------------------------------
  64. #
  65. # option configs
  66. #----------------------------------------------------------------------
  67. proc tixScrolledHList:config-takefocus {w value} {
  68. upvar #0 $w data
  69. $data(w:hlist) config -takefocus $value
  70. }
  71. proc tixScrolledHList:config-highlightbackground {w value} {
  72. upvar #0 $w data
  73. $data(pw:f1) config -highlightbackground $value
  74. }
  75. proc tixScrolledHList:config-highlightcolor {w value} {
  76. upvar #0 $w data
  77. $data(pw:f1) config -highlightcolor $value
  78. }
  79. proc tixScrolledHList:config-highlightthickness {w value} {
  80. upvar #0 $w data
  81. $data(pw:f1) config -highlightthickness $value
  82. }
  83. #----------------------------------------------------------------------
  84. #
  85. # Widget commands
  86. #----------------------------------------------------------------------
  87. #----------------------------------------------------------------------
  88. #
  89. # Private Methods
  90. #----------------------------------------------------------------------
  91. # virtual
  92. #
  93. proc tixScrolledHList:RepackHook {w} {
  94. upvar #0 $w data
  95. tixChainMethod $w RepackHook
  96. }
  97. #----------------------------------------------------------------------
  98. # virtual functions to query the client window's scroll requirement
  99. #----------------------------------------------------------------------
  100. proc tixScrolledHList:GeometryInfo {w mW mH} {
  101. upvar #0 $w data
  102. if {[winfo class $w.f1] eq "Frame"} {
  103. set extra [expr {[$w.f1 cget -bd]+[$w.f1 cget -highlightthickness]}]
  104. } else {
  105. set extra 0
  106. }
  107. set mW [expr {$mW - $extra*2}]
  108. set mH [expr {$mH - $extra*2}]
  109. if {$mW < 1} {
  110. set mW 1
  111. }
  112. if {$mH < 1} {
  113. set mH 1
  114. }
  115. return [$data(w:hlist) geometryinfo $mW $mH]
  116. }