LabEntry.tcl 2.1 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. # $Id: LabEntry.tcl,v 1.4 2004/03/28 02:44:57 hobbs Exp $
  4. #
  5. # LabEntry.tcl --
  6. #
  7. # TixLabelEntry Widget: an entry box with a label
  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 tixLabelEntry {
  16. -classname TixLabelEntry
  17. -superclass tixLabelWidget
  18. -method {
  19. }
  20. -flag {
  21. -disabledforeground -state
  22. }
  23. -forcecall {
  24. -state
  25. }
  26. -static {
  27. }
  28. -configspec {
  29. {-disabledforeground disabledForeground DisabledForeground #303030}
  30. {-state state State normal}
  31. }
  32. -default {
  33. {.borderWidth 0}
  34. {*entry.relief sunken}
  35. {*entry.width 7}
  36. {*label.anchor e}
  37. {*label.borderWidth 0}
  38. }
  39. }
  40. proc tixLabelEntry:ConstructFramedWidget {w frame} {
  41. upvar #0 $w data
  42. tixChainMethod $w ConstructFramedWidget $frame
  43. set data(w:entry) [entry $frame.entry]
  44. pack $data(w:entry) -side left -expand yes -fill both
  45. # This value is used to configure the disable/normal fg of the ebtry
  46. #
  47. set data(entryfg) [$data(w:entry) cget -fg]
  48. set data(labelfg) [$data(w:label) cget -fg]
  49. }
  50. proc tixLabelEntryBind {} {
  51. tixBind TixLabelEntry <FocusIn> {
  52. if {[focus -displayof [set %W(w:entry)]] ne [set %W(w:entry)]} {
  53. focus [%W subwidget entry]
  54. [set %W(w:entry)] selection from 0
  55. [set %W(w:entry)] selection to end
  56. [set %W(w:entry)] icursor end
  57. }
  58. }
  59. }
  60. #----------------------------------------------------------------------
  61. # CONFIG OPTIONS
  62. #----------------------------------------------------------------------
  63. proc tixLabelEntry:config-state {w value} {
  64. upvar #0 $w data
  65. if {$value == "normal"} {
  66. catch {
  67. $data(w:label) config -fg $data(labelfg)
  68. }
  69. $data(w:entry) config -state $value -fg $data(entryfg)
  70. } else {
  71. catch {
  72. $data(w:label) config -fg $data(-disabledforeground)
  73. }
  74. $data(w:entry) config -state $value -fg $data(-disabledforeground)
  75. }
  76. }