home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / BWidget-1.2 / separator.tcl < prev    next >
Text File  |  2000-11-02  |  3KB  |  83 lines
  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.  
  11. namespace eval Separator {
  12.     Widget::declare Separator {
  13.         {-background TkResource ""         0 frame}
  14.         {-relief     Enum       groove     0 {ridge groove}}
  15.         {-orient     Enum       horizontal 1 {horizontal vertical}}
  16.         {-bg         Synonym    -background}
  17.     }
  18.     Widget::addmap Separator "" :cmd {-background {}}
  19.  
  20.     proc ::Separator { path args } { return [eval Separator::create $path $args] }
  21.     proc use {} {}
  22. }
  23.  
  24.  
  25. # ------------------------------------------------------------------------------
  26. #  Command Separator::create
  27. # ------------------------------------------------------------------------------
  28. proc Separator::create { path args } {
  29.     Widget::init Separator $path $args
  30.  
  31.     if { [Widget::getoption $path -relief] == "groove" } {
  32.         set relief sunken
  33.     } else {
  34.         set relief raised
  35.     }
  36.  
  37.     if { [Widget::getoption $path -orient] == "horizontal" } {
  38.         frame $path \
  39.             -background  [Widget::getoption $path -background] \
  40.             -borderwidth 1 \
  41.             -relief      $relief \
  42.             -height      2
  43.     } else {
  44.         frame $path \
  45.             -background  [Widget::getoption $path -background] \
  46.             -borderwidth 1 \
  47.             -relief      $relief \
  48.             -width       2
  49.     }
  50.     bind $path <Destroy> {Widget::destroy %W; rename %W {}}
  51.  
  52.     rename $path ::$path:cmd
  53.     proc ::$path { cmd args } "return \[eval Separator::\$cmd $path \$args\]"
  54.  
  55.     return $path
  56. }
  57.  
  58.  
  59. # ------------------------------------------------------------------------------
  60. #  Command Separator::configure
  61. # ------------------------------------------------------------------------------
  62. proc Separator::configure { path args } {
  63.     set res [Widget::configure $path $args]
  64.  
  65.     if { [Widget::hasChanged $path -relief relief] } {
  66.         if { $relief == "groove" } {
  67.             $path:cmd configure -relief sunken
  68.         } else {
  69.             $path:cmd configure -relief raised
  70.         }
  71.     }
  72.  
  73.     return $res
  74. }
  75.  
  76.  
  77. # ------------------------------------------------------------------------------
  78. #  Command Separator::cget
  79. # ------------------------------------------------------------------------------
  80. proc Separator::cget { path option } {
  81.     return [Widget::cget $path $option]
  82. }
  83.