FloatEnt.tcl 3.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. # $Id: FloatEnt.tcl,v 1.4 2004/03/28 02:44:57 hobbs Exp $
  4. #
  5. # FloatEnt.tcl --
  6. #
  7. # An entry widget that can be attached on top of any widget to
  8. # provide dynamic editing. It is used to provide dynamic editing
  9. # for the tixGrid widget, among other things.
  10. #
  11. # Copyright (c) 1993-1999 Ioi Kim Lam.
  12. # Copyright (c) 2000-2001 Tix Project Group.
  13. # Copyright (c) 2004 ActiveState
  14. #
  15. # See the file "license.terms" for information on usage and redistribution
  16. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  17. #
  18. tixWidgetClass tixFloatEntry {
  19. -classname TixFloatEntry
  20. -superclass tixPrimitive
  21. -method {
  22. invoke post unpost
  23. }
  24. -flag {
  25. -command -value
  26. }
  27. -configspec {
  28. {-value value Value ""}
  29. {-command command Command ""}
  30. }
  31. -default {
  32. {.entry.highlightThickness 0}
  33. }
  34. }
  35. #----------------------------------------------------------------------
  36. #
  37. # Initialization bindings
  38. #
  39. #----------------------------------------------------------------------
  40. proc tixFloatEntry:InitWidgetRec {w} {
  41. upvar #0 $w data
  42. tixChainMethod $w InitWidgetRec
  43. }
  44. proc tixFloatEntry:ConstructWidget {w} {
  45. upvar #0 $w data
  46. tixChainMethod $w ConstructWidget
  47. set data(w:entry) [entry $w.entry]
  48. pack $data(w:entry) -expand yes -fill both
  49. }
  50. proc tixFloatEntry:SetBindings {w} {
  51. upvar #0 $w data
  52. tixChainMethod $w SetBindings
  53. tixBind $data(w:entry) <Return> [list tixFloatEntry:invoke $w]
  54. }
  55. #----------------------------------------------------------------------
  56. #
  57. # Class bindings
  58. #
  59. #----------------------------------------------------------------------
  60. proc tixFloatEntryBind {} {
  61. tixBind TixFloatEntry <FocusIn> {
  62. if {[focus -displayof [set %W(w:entry)]] ne [set %W(w:entry)]} {
  63. focus [%W subwidget entry]
  64. [set %W(w:entry)] selection from 0
  65. [set %W(w:entry)] selection to end
  66. [set %W(w:entry)] icursor end
  67. }
  68. }
  69. }
  70. #----------------------------------------------------------------------
  71. #
  72. # Public methods
  73. #
  74. #----------------------------------------------------------------------
  75. proc tixFloatEntry:post {w x y {width ""} {height ""}} {
  76. upvar #0 $w data
  77. if {$width == ""} {
  78. set width [winfo reqwidth $data(w:entry)]
  79. }
  80. if {$height == ""} {
  81. set height [winfo reqheight $data(w:entry)]
  82. }
  83. place $w -x $x -y $y -width $width -height $height -bordermode ignore
  84. raise $w
  85. focus $data(w:entry)
  86. }
  87. proc tixFloatEntry:unpost {w} {
  88. upvar #0 $w data
  89. place forget $w
  90. }
  91. proc tixFloatEntry:config-value {w val} {
  92. upvar #0 $w data
  93. $data(w:entry) delete 0 end
  94. $data(w:entry) insert 0 $val
  95. $data(w:entry) selection from 0
  96. $data(w:entry) selection to end
  97. $data(w:entry) icursor end
  98. }
  99. #----------------------------------------------------------------------
  100. #
  101. # Private methods
  102. #
  103. #----------------------------------------------------------------------
  104. proc tixFloatEntry:invoke {w} {
  105. upvar #0 $w data
  106. if {[llength $data(-command)]} {
  107. set bind(specs) {%V}
  108. set bind(%V) [$data(w:entry) get]
  109. tixEvalCmdBinding $w $data(-command) bind $bind(%V)
  110. }
  111. }