Posted to tcl by jenglish at Wed Nov 17 22:13:45 GMT 2010view raw

  1. ### scrollview metawidget.
  2. #
  3. # Usage:
  4. # scrollview $sv
  5. # $sv manage $sv.child
  6. # $sv see $sv.$descendant...
  7. #
  8.  
  9. package provide scrollview 1.1
  10.  
  11. namespace eval scrollview {
  12. # State variables:
  13. # win -- renamed original widget command
  14. # slave -- managed slave.
  15. # [xy].constrain -- 1 => constrain; 0 => scroll
  16. # [xy].command -- scroll command
  17. # [xy].first -- current scroll position
  18. # [xy].requested -- requested size from slave
  19. # [xy].available -- available size
  20. # [xy].increment -- default increment for [$sv scroll $n units]
  21. #
  22. variable defaults {
  23. win ""
  24. slave ""
  25. x.constrain 1
  26. y.constrain 1
  27. x.command scrollview::nop
  28. y.command scrollview::nop
  29. x.first 0
  30. y.first 0
  31. x.requested 0
  32. y.requested 0
  33. x.increment 10
  34. y.increment 10
  35. }
  36. proc min {a b} { expr {$a < $b ? $a : $b} }
  37. proc max {a b} { expr {$a > $b ? $a : $b} }
  38. proc nop {args} {}
  39. }
  40.  
  41. ### Defaults.
  42. #
  43. # Default -width 10c and -height 7c are the BWidget ScrollableFrame defaults,
  44. # which in turn are taken from the core Canvas widget.
  45. #
  46. option add *Scrollview.width 10c
  47. option add *Scrollview.height 7c
  48.  
  49. ### Bindings.
  50. #
  51. bind Scrollview <Destroy> { scrollview::Destroy %W }
  52. bind Scrollview <Configure> { scrollview::Resize %W }
  53.  
  54. proc scrollview::Destroy {w} {
  55. upvar #0 $w W
  56. unset -nocomplain W
  57. rename $w {}
  58. }
  59.  
  60. proc scrollview::Resize {w} {
  61. upvar #0 $w W
  62. Refresh $w
  63. set W(x.first) [First $w x $W(x.first)]
  64. set W(y.first) [First $w y $W(y.first)]
  65. PlaceSlave $w
  66. Notify $w {x y}
  67. }
  68.  
  69. ### Internal utilities.
  70. #
  71.  
  72. ## PlaceSlave -- adjust position of slave window.
  73. #
  74. proc scrollview::PlaceSlave {w} {
  75. upvar #0 $w W
  76. if {$W(slave) eq ""} { return }
  77. place $W(slave) -in $w \
  78. -x [expr {-$W(x.first)}] \
  79. -y [expr {-$W(y.first)}] \
  80. -width [SlaveSize $w x] \
  81. -height [SlaveSize $w y] \
  82. ;
  83. }
  84.  
  85. ## SlaveSize --
  86. #
  87. proc scrollview::SlaveSize {w axis} {
  88. upvar #0 $w W
  89.  
  90. if {$W($axis.constrain)} {
  91. return $W($axis.available)
  92. } else {
  93. return $W($axis.requested)
  94. }
  95. # Other possibilities:
  96. # stretch -- [max $W($axis.available) $W($axis.requested)]
  97. # shrink -- [min $W($axis.available) $W($axis.requested)] (not useful)
  98. }
  99.  
  100. ## Refresh -- update sizes
  101. #
  102. proc scrollview::Refresh {w} {
  103. upvar #0 $w W
  104. set W(x.available) [winfo width $w]
  105. set W(y.available) [winfo height $w]
  106. if {$W(slave) ne ""} {
  107. set W(x.requested) [winfo reqwidth $W(slave)]
  108. set W(y.requested) [winfo reqheight $W(slave)]
  109. }
  110. }
  111.  
  112. ## Notify $w ?$axes? -- invoke -[xy]scrollcommands
  113. #
  114. proc scrollview::Notify {w {axes "x y"}} {
  115. upvar #0 $w W
  116. foreach axis $axes {
  117. set total [max 1.0 [expr { double($W($axis.requested)) }]]
  118. set first [expr { double($W($axis.first))/$total } ]
  119. set last [expr { double($W($axis.first)+$W($axis.available))/$total }]
  120. uplevel #0 [linsert $W($axis.command) end $first $last]
  121. }
  122. }
  123.  
  124. ## First --
  125. #
  126. proc scrollview::First {w axis pos} {
  127. upvar #0 $w W
  128. set lim [expr {$W($axis.requested) - $W($axis.available)}]
  129. return [max 0 [min $lim $pos]]
  130. }
  131.  
  132. proc scrollview::SetFirst {w axis pos} {
  133. upvar #0 $w W
  134. set W($axis.first) [First $w $axis $pos]
  135. PlaceSlave $w
  136. Notify $w $axis
  137. }
  138.  
  139. ## Widget constructor.
  140. #
  141. interp alias {} ::scrollview {} ::scrollview::Constructor
  142. proc scrollview::Constructor {w args} {
  143. upvar #0 $w W
  144. variable defaults
  145.  
  146. array set W $defaults
  147.  
  148. frame $w -class Scrollview
  149. rename $w [set W(win) ::scrollview::_$w]
  150. interp alias {} $w {} ::scrollview::Dispatch $w
  151.  
  152. uplevel 1 [linsert $args 0 $w configure]
  153.  
  154. return $w
  155. }
  156.  
  157. proc scrollview::Dispatch {w command args} {
  158. uplevel 1 [linsert $args 0 [namespace which -command $command] $w]
  159. }
  160.  
  161. ### Widget methods:
  162. #
  163.  
  164. ## $sv configure option value...
  165. #
  166. proc scrollview::configure {w args} {
  167. upvar #0 $w W
  168.  
  169. set frameopts [list]
  170. foreach {option value} $args {
  171. switch -- $option {
  172. -xscrollcommand { set W(x.command) $value;set W(x.constrain) 0 }
  173. -yscrollcommand { set W(y.command) $value;set W(y.constrain) 0 }
  174. -xscrollincrement { set W(x.increment) $value }
  175. -yscrollincrement { set W(y.increment) $value }
  176. -width -
  177. -height { lappend frameopts $option $value }
  178. default { error "Unrecognized option $option" }
  179. }
  180. }
  181. if {[llength $frameopts]} {
  182. eval [linsert $frameopts 0 $W(win) configure]
  183. }
  184. }
  185.  
  186. ## $sv manage $child
  187. #
  188. proc scrollview::manage {w slave} {
  189. upvar #0 $w W
  190. if {$W(slave) ne ""} {
  191. place forget $W(slave)
  192. }
  193. set W(slave) $slave
  194. Resize $w
  195. }
  196.  
  197. ## $sv xview, $sv yview -- standard scrolling methods.
  198. #
  199. proc scrollview::xview {w method amount {units ""}} {
  200. XYview $w x $method $amount $units
  201. }
  202.  
  203. proc scrollview::yview {w method amount {units ""}} {
  204. XYview $w y $method $amount $units
  205. }
  206.  
  207. proc scrollview::XYview {w axis method amount units} {
  208. switch -- $method {
  209. moveto { MoveTo $w $axis $amount }
  210. scroll { Scroll-$units $w $axis $amount }
  211. default { error "Unknown scroll directive $method" }
  212. }
  213. }
  214.  
  215. proc scrollview::MoveTo {w axis fraction} {
  216. upvar #0 $w W
  217. SetFirst $w $axis [expr {int($fraction * $W($axis.requested))}]
  218. }
  219.  
  220. proc scrollview::Scroll-units {w axis count} {
  221. upvar #0 $w W
  222. SetFirst $w $axis [expr {$W($axis.first) + $W($axis.increment)*$count}]
  223. }
  224. proc scrollview::Scroll-pages {w axis count} {
  225. upvar #0 $w W
  226. SetFirst $w $axis [expr {$W($axis.first) + $count*$W($axis.available)}]
  227. }
  228.  
  229. ## $sv see $descendant --
  230. # Ensure that $descendant is visible.
  231. #
  232. proc scrollview::see {w descendant} {
  233. upvar #0 $w W
  234. set xpos [set ypos 0]
  235. set d $descendant
  236. while {$d ne $W(slave)} {
  237. incr xpos [winfo x $d]
  238. incr ypos [winfo y $d]
  239. set d [winfo parent $d]
  240. if {$d eq "."} {
  241. return -code error "$descendant not a descendant of $w"
  242. }
  243. }
  244.  
  245. See $w x $xpos [winfo width $descendant]
  246. See $w y $ypos [winfo height $descendant]
  247. }
  248.  
  249. proc scrollview::See {w axis pos len} {
  250. upvar #0 $w W
  251. # ENSURE: first <= pos <= pos + len <= first + available
  252. # If both can't be satisfied, ensure first <= pos.
  253. set min [expr {$pos + $len - $W($axis.available)}]
  254. if {$W($axis.first) < $min} { SetFirst $w $axis $min }
  255. if {$pos < $W($axis.first)} { SetFirst $w $axis $pos }
  256. }
  257.  
  258. #*EOF*