StdBBox.tcl 1.6 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. # $Id: StdBBox.tcl,v 1.2 2001/12/09 05:04:02 idiscovery Exp $
  4. #
  5. # StdBBox.tcl --
  6. #
  7. # Standard Button Box, used in standard dialog boxes
  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 tixStdButtonBox {
  16. -classname TixStdButtonBox
  17. -superclass tixButtonBox
  18. -flag {
  19. -applycmd -cancelcmd -helpcmd -okcmd
  20. }
  21. -configspec {
  22. {-applycmd applyCmd ApplyCmd ""}
  23. {-cancelcmd cancelCmd CancelCmd ""}
  24. {-helpcmd helpCmd HelpCmd ""}
  25. {-okcmd okCmd OkCmd ""}
  26. }
  27. -default {
  28. {.borderWidth 1}
  29. {.relief raised}
  30. {.padX 5}
  31. {.padY 10}
  32. {*Button.anchor c}
  33. {*Button.padX 5}
  34. }
  35. }
  36. proc tixStdButtonBox:ConstructWidget {w} {
  37. upvar #0 $w data
  38. tixChainMethod $w ConstructWidget
  39. $w add ok -text OK -under 0 -width 6 -command $data(-okcmd)
  40. $w add apply -text Apply -under 0 -width 6 -command $data(-applycmd)
  41. $w add cancel -text Cancel -under 0 -width 6 -command $data(-cancelcmd)
  42. $w add help -text Help -under 0 -width 6 -command $data(-helpcmd)
  43. }
  44. proc tixStdButtonBox:config {w flag value} {
  45. upvar #0 $w data
  46. case $flag {
  47. -okcmd {
  48. $data(w:ok) config -command $value
  49. }
  50. -applycmd {
  51. $data(w:apply) config -command $value
  52. }
  53. -cancelcmd {
  54. $data(w:cancel) config -command $value
  55. }
  56. -helpcmd {
  57. $data(w:help) config -command $value
  58. }
  59. default {
  60. tixChainMethod $w config $flag $value
  61. }
  62. }
  63. }