"Fossies" - the Fresh Open Source Software Archive

Member "Pansophica-src-1.3/BAF_modules/tcl/src/NVR_BWidgets/buttonbox.tcl" (10 Apr 2007, 7274 Bytes) of package /linux/www/old/Pansophica-src-1.3-1.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Tcl/Tk source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "buttonbox.tcl" see the Fossies "Dox" file reference documentation.

    1 # ------------------------------------------------------------------------------
    2 #  buttonbox.tcl
    3 #  This file is part of Unifix BWidget Toolkit
    4 # ------------------------------------------------------------------------------
    5 #  Index of commands:
    6 #     - ButtonBox::create
    7 #     - ButtonBox::configure
    8 #     - ButtonBox::cget
    9 #     - ButtonBox::add
   10 #     - ButtonBox::itemconfigure
   11 #     - ButtonBox::itemcget
   12 #     - ButtonBox::setfocus
   13 #     - ButtonBox::invoke
   14 #     - ButtonBox::index
   15 #     - ButtonBox::_destroy
   16 # ------------------------------------------------------------------------------
   17 
   18 namespace eval ButtonBox {
   19     Button::use
   20 
   21     Widget::declare ButtonBox {
   22         {-background  TkResource ""         0 frame}
   23         {-orient      Enum       horizontal 1 {horizontal vertical}}
   24         {-homogeneous Boolean    1          1}
   25         {-spacing     Int        10         0 {=0}}
   26         {-padx        TkResource ""         0 button}
   27         {-pady        TkResource ""         0 button}
   28         {-default     Int        -1         0 {=-1}} 
   29         {-bg          Synonym    -background}
   30     }
   31 
   32     Widget::addmap ButtonBox "" :cmd {-background {}}
   33 
   34     proc ::ButtonBox { path args } { return [eval ButtonBox::create $path $args] }
   35     proc use {} {}
   36 }
   37 
   38 
   39 # ------------------------------------------------------------------------------
   40 #  Command ButtonBox::create
   41 # ------------------------------------------------------------------------------
   42 proc ButtonBox::create { path args } {
   43     Widget::init ButtonBox $path $args
   44 
   45     variable $path
   46     upvar 0  $path data
   47 
   48     eval frame $path [Widget::subcget $path :cmd] -takefocus 0 -highlightthickness 0
   49 
   50     set data(default)  [Widget::getoption $path -default]
   51     set data(nbuttons) 0
   52     set data(max)      0
   53 
   54     bind $path <Destroy> "ButtonBox::_destroy $path"
   55 
   56     rename $path ::$path:cmd
   57     proc ::$path { cmd args } "return \[eval ButtonBox::\$cmd $path \$args\]"
   58 
   59     return $path
   60 }
   61 
   62 
   63 # ------------------------------------------------------------------------------
   64 #  Command ButtonBox::configure
   65 # ------------------------------------------------------------------------------
   66 proc ButtonBox::configure { path args } {
   67     variable $path
   68     upvar 0  $path data
   69 
   70     set res [Widget::configure $path $args]
   71 
   72     if { [Widget::hasChanged $path -default val] } {
   73         if { $data(default) != -1 && $val != -1 } {
   74             set but $path.b$data(default)
   75             if { [winfo exists $but] } {
   76                 $but configure -default normal
   77             }
   78             set but $path.b$val
   79             if { [winfo exists $but] } {
   80                 $but configure -default active
   81             }
   82             set data(default) $val
   83         } else {
   84             Widget::setoption $path -default $data(default)
   85         }
   86     }
   87 
   88     return $res
   89 }
   90 
   91 
   92 # ------------------------------------------------------------------------------
   93 #  Command ButtonBox::cget
   94 # ------------------------------------------------------------------------------
   95 proc ButtonBox::cget { path option } {
   96     return [Widget::cget $path $option]
   97 }
   98 
   99 
  100 # ------------------------------------------------------------------------------
  101 #  Command ButtonBox::add
  102 # ------------------------------------------------------------------------------
  103 proc ButtonBox::add { path args } {
  104     variable $path
  105     upvar 0  $path data
  106 
  107     set but     $path.b$data(nbuttons)
  108     set spacing [Widget::getoption $path -spacing]
  109 
  110     if { $data(nbuttons) == $data(default) } {
  111         set style active
  112     } elseif { $data(default) == -1 } {
  113         set style disabled
  114     } else {
  115         set style normal
  116     }
  117 
  118     eval Button::create $but \
  119         -background [Widget::getoption $path -background]\
  120         -padx       [Widget::getoption $path -padx] \
  121         -pady       [Widget::getoption $path -pady] \
  122         $args \
  123         -default $style
  124 
  125     set idx [expr {2*$data(nbuttons)}]
  126     if { ![string compare [Widget::getoption $path -orient] "horizontal"] } {
  127         grid $but -column $idx -row 0 -sticky nsew
  128         if { [Widget::getoption $path -homogeneous] } {
  129             set req [winfo reqwidth $but]
  130             if { $req > $data(max) } {
  131                 for {set i 0} {$i < $data(nbuttons)} {incr i} {
  132                     grid columnconfigure $path [expr {2*$i}] -minsize $req
  133                 }
  134                 set data(max) $req
  135             }
  136             grid columnconfigure $path $idx -minsize $data(max) -weight 1
  137         } else {
  138             grid columnconfigure $path $idx -weight 0
  139         }
  140         if { $data(nbuttons) > 0 } {
  141             grid columnconfigure $path [expr {$idx-1}] -minsize $spacing
  142         }
  143     } else {
  144         grid $but -column 0 -row $idx -sticky nsew
  145         grid rowconfigure $path $idx -weight 0
  146         if { $data(nbuttons) > 0 } {
  147             grid rowconfigure $path [expr {$idx-1}] -minsize $spacing
  148         }
  149     }
  150 
  151     incr data(nbuttons)
  152 
  153     return $but
  154 }
  155 
  156 
  157 # ------------------------------------------------------------------------------
  158 #  Command ButtonBox::itemconfigure
  159 # ------------------------------------------------------------------------------
  160 proc ButtonBox::itemconfigure { path index args } {
  161     if { [set idx [lsearch $args -default]] != -1 } {
  162         set args [lreplace $args $idx [expr {$idx+1}]]
  163     }
  164     return [eval Button::configure $path.b[index $path $index] $args]
  165 }
  166 
  167 
  168 # ------------------------------------------------------------------------------
  169 #  Command ButtonBox::itemcget
  170 # ------------------------------------------------------------------------------
  171 proc ButtonBox::itemcget { path index option } {
  172     return [Button::cget $path.b[index $path $index] $option]
  173 }
  174 
  175 
  176 # ------------------------------------------------------------------------------
  177 #  Command ButtonBox::setfocus
  178 # ------------------------------------------------------------------------------
  179 proc ButtonBox::setfocus { path index } {
  180     set but $path.b[index $path $index]
  181     if { [winfo exists $but] } {
  182         focus $but
  183     }
  184 }
  185 
  186 
  187 # ------------------------------------------------------------------------------
  188 #  Command ButtonBox::invoke
  189 # ------------------------------------------------------------------------------
  190 proc ButtonBox::invoke { path index } {
  191     set but $path.b[index $path $index]
  192     if { [winfo exists $but] } {
  193         Button::invoke $but
  194     }
  195 }
  196 
  197 
  198 # ------------------------------------------------------------------------------
  199 #  Command ButtonBox::index
  200 # ------------------------------------------------------------------------------
  201 proc ButtonBox::index { path index } {
  202     if { ![string compare $index "default"] } {
  203         set res [Widget::getoption $path -default]
  204     } elseif { ![string compare $index "end"] || ![string compare $index "last"] } {
  205         variable $path
  206         upvar 0  $path data
  207 
  208         set res [expr {$data(nbuttons)-1}]
  209     } else {
  210         set res $index
  211     }
  212     return $res
  213 }
  214 
  215 
  216 # ------------------------------------------------------------------------------
  217 #  Command ButtonBox::_destroy
  218 # ------------------------------------------------------------------------------
  219 proc ButtonBox::_destroy { path } {
  220     variable $path
  221     upvar 0  $path data
  222 
  223     Widget::destroy $path
  224     unset data
  225     rename $path {}
  226 }