SText.tcl 3.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. # $Id: SText.tcl,v 1.4 2001/12/09 05:04:02 idiscovery Exp $
  4. #
  5. # SText.tcl --
  6. #
  7. # This file implements Scrolled Text 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. tixWidgetClass tixScrolledText {
  16. -classname TixScrolledText
  17. -superclass tixScrolledWidget
  18. -method {
  19. }
  20. -flag {
  21. }
  22. -static {
  23. }
  24. -configspec {
  25. }
  26. -default {
  27. {.scrollbar both}
  28. {*Scrollbar.takeFocus 0}
  29. }
  30. -forcecall {
  31. -scrollbar
  32. }
  33. }
  34. proc tixScrolledText:ConstructWidget {w} {
  35. upvar #0 $w data
  36. global tcl_platform
  37. tixChainMethod $w ConstructWidget
  38. set data(w:text) \
  39. [text $w.text]
  40. set data(w:hsb) \
  41. [scrollbar $w.hsb -orient horizontal]
  42. set data(w:vsb) \
  43. [scrollbar $w.vsb -orient vertical]
  44. if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
  45. # set data(w:sizebox) [ide_sizebox $w.sizebox]
  46. }
  47. set data(pw:client) $data(w:text)
  48. }
  49. proc tixScrolledText:SetBindings {w} {
  50. upvar #0 $w data
  51. tixChainMethod $w SetBindings
  52. $data(w:text) config \
  53. -xscrollcommand "tixScrolledText:XScroll $w"\
  54. -yscrollcommand "tixScrolledText:YScroll $w"
  55. $data(w:hsb) config -command "$data(w:text) xview"
  56. $data(w:vsb) config -command "$data(w:text) yview"
  57. }
  58. #----------------------------------------------------------------------
  59. #
  60. # option configs
  61. #----------------------------------------------------------------------
  62. proc tixScrolledText:config-takefocus {w value} {
  63. upvar #0 $w data
  64. $data(w:text) config -takefocus $value
  65. }
  66. proc tixScrolledText:config-scrollbar {w value} {
  67. upvar #0 $w data
  68. if {[string match "auto*" $value]} {
  69. set value "both"
  70. }
  71. set data(-scrollbar) $value
  72. tixChainMethod $w config-scrollbar $value
  73. return $value
  74. }
  75. #----------------------------------------------------------------------
  76. #
  77. # Widget commands
  78. #----------------------------------------------------------------------
  79. #----------------------------------------------------------------------
  80. #
  81. # Private Methods
  82. #----------------------------------------------------------------------
  83. #----------------------------------------------------------------------
  84. # virtual functions to query the client window's scroll requirement
  85. #----------------------------------------------------------------------
  86. proc tixScrolledText:GeometryInfo {w mW mH} {
  87. upvar #0 $w data
  88. return [list "$data(x,first) $data(x,last)" "$data(y,first) $data(y,last)"]
  89. }
  90. proc tixScrolledText:XScroll {w first last} {
  91. upvar #0 $w data
  92. set data(x,first) $first
  93. set data(x,last) $last
  94. $data(w:hsb) set $first $last
  95. tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
  96. }
  97. proc tixScrolledText:YScroll {w first last} {
  98. upvar #0 $w data
  99. set data(y,first) $first
  100. set data(y,last) $last
  101. $data(w:vsb) set $first $last
  102. tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
  103. }