separator.tcl 2.6 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283
  1. # ------------------------------------------------------------------------------
  2. # separator.tcl
  3. # This file is part of Unifix BWidget Toolkit
  4. # ------------------------------------------------------------------------------
  5. # Index of commands:
  6. # - Separator::create
  7. # - Separator::configure
  8. # - Separator::cget
  9. # ------------------------------------------------------------------------------
  10. namespace eval Separator {
  11. Widget::declare Separator {
  12. {-background TkResource "" 0 frame}
  13. {-relief Enum groove 0 {ridge groove}}
  14. {-orient Enum horizontal 1 {horizontal vertical}}
  15. {-bg Synonym -background}
  16. }
  17. Widget::addmap Separator "" :cmd {-background {}}
  18. proc ::Separator { path args } { return [eval Separator::create $path $args] }
  19. proc use {} {}
  20. }
  21. # ------------------------------------------------------------------------------
  22. # Command Separator::create
  23. # ------------------------------------------------------------------------------
  24. proc Separator::create { path args } {
  25. Widget::init Separator $path $args
  26. if { [Widget::getoption $path -relief] == "groove" } {
  27. set relief sunken
  28. } else {
  29. set relief raised
  30. }
  31. if { [Widget::getoption $path -orient] == "horizontal" } {
  32. frame $path \
  33. -background [Widget::getoption $path -background] \
  34. -borderwidth 1 \
  35. -relief $relief \
  36. -height 2
  37. } else {
  38. frame $path \
  39. -background [Widget::getoption $path -background] \
  40. -borderwidth 1 \
  41. -relief $relief \
  42. -width 2
  43. }
  44. bind $path <Destroy> {Widget::destroy %W; rename %W {}}
  45. rename $path ::$path:cmd
  46. proc ::$path { cmd args } "return \[eval Separator::\$cmd $path \$args\]"
  47. return $path
  48. }
  49. # ------------------------------------------------------------------------------
  50. # Command Separator::configure
  51. # ------------------------------------------------------------------------------
  52. proc Separator::configure { path args } {
  53. set res [Widget::configure $path $args]
  54. if { [Widget::hasChanged $path -relief relief] } {
  55. if { $relief == "groove" } {
  56. $path:cmd configure -relief sunken
  57. } else {
  58. $path:cmd configure -relief raised
  59. }
  60. }
  61. return $res
  62. }
  63. # ------------------------------------------------------------------------------
  64. # Command Separator::cget
  65. # ------------------------------------------------------------------------------
  66. proc Separator::cget { path option } {
  67. return [Widget::cget $path $option]
  68. }