source: trunk/BWidget-1.2.1/separator.tcl @ 931

Last change on this file since 931 was 931, checked in by toby, 11 years ago

include rest of files

File size: 2.6 KB
Line 
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
11namespace 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# ------------------------------------------------------------------------------
28proc 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# ------------------------------------------------------------------------------
62proc 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# ------------------------------------------------------------------------------
80proc Separator::cget { path option } {
81    return [Widget::cget $path $option]
82}
Note: See TracBrowser for help on using the repository browser.