Bwidget Source Code
Check-in [9c53cf5397]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:*** continous developement, some small improvements
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 9c53cf53977005d6c2ce9727773dda106376c4fa
User & Date: oberdorfer 2009-10-25 20:54:54
Context
2009-10-25
20:57
*** important: programming interface changed:

# BWidget::use # Argument usage: # -package ttk # | # specify a package name to be initialized, currently # support for the following packages is implemented: # ttk ... try to use tile'd widget set (if available) # # -style default / native / myFavoriteStyleName # | | | # | | specify a valid style name, # | | use "BWidget::_get_colordcls" which gives # | | you a list of what's avaliable for tk # | | # | if specified, BW tries to emulate OS color scheme, # | a specific color schema associated to each individual # | operationg system is going to be used # | # same behaviour as before, stay compatible # with previous releases # # -setoptdb [no=default|0|yes|1] # | # maintain the option database # if you need a dynamic behavior when changing # the underlying style, activate this option! # # -themedirs {} = default / a list of valid directory names, # to specifing additional ttk theme packages check-in: 10d9b3e6db user: oberdorfer tags: trunk

20:54
*** continous developement, some small improvements check-in: 9c53cf5397 user: oberdorfer tags: trunk
20:53
*** continous developement, minor changes check-in: bd460bc3a4 user: oberdorfer tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to dialog.tcl.

1
2
3
4
5
6
7
8
9
10
11
...
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
...
191
192
193
194
195
196
197
198



199
200
201
202
203
204
205
# ----------------------------------------------------------------------------
#  dialog.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: dialog.tcl,v 1.16 2009/09/06 21:09:39 oberdorfer Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - Dialog::create
#     - Dialog::configure
#     - Dialog::cget
#     - Dialog::getframe
#     - Dialog::add
................................................................................
    if { [BWidget::using ttk] } {
         set frame [ttk::frame $path.frame -relief flat]
    } else {
         set frame [frame $path.frame -relief flat -borderwidth 0 -background $bg]
    }

    if { [set bitmap [Widget::getoption $path -image]] != "" } {
        if { [BWidget::using ttk] } {
            set label [ttk::label $path.label -image $bitmap]
        } else {
            set label [label $path.label -image $bitmap -background $bg]
        }
    } elseif { [set bitmap [Widget::getoption $path -bitmap]] != "" } {
        set label [label $path.label -bitmap $bitmap -background $bg]
    }
    if { [Widget::getoption $path -separator] } {
	Separator::create $path.sep -orient $orient -background $bg
    }
    set _widget($path,realized) 0
................................................................................
	set width 8
    }
    set cmd [list ButtonBox::add $path.bbox -width $width \
		 -command [list Dialog::enddialog $path $_widget($path,nbut)]]

    set res [eval $cmd $args]

    # a button box button - by default - is flat!



    if { [BWidget::using ttk] } {
        $res configure -style "TButton"
    }

    incr _widget($path,nbut)
    return $res
}


|







 







<
<
<
|
<







 







|
>
>
>







1
2
3
4
5
6
7
8
9
10
11
...
116
117
118
119
120
121
122



123

124
125
126
127
128
129
130
...
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
# ----------------------------------------------------------------------------
#  dialog.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: dialog.tcl,v 1.17 2009/10/25 20:54:54 oberdorfer Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - Dialog::create
#     - Dialog::configure
#     - Dialog::cget
#     - Dialog::getframe
#     - Dialog::add
................................................................................
    if { [BWidget::using ttk] } {
         set frame [ttk::frame $path.frame -relief flat]
    } else {
         set frame [frame $path.frame -relief flat -borderwidth 0 -background $bg]
    }

    if { [set bitmap [Widget::getoption $path -image]] != "" } {



        set label [label $path.label -image $bitmap -background $bg]

    } elseif { [set bitmap [Widget::getoption $path -bitmap]] != "" } {
        set label [label $path.label -bitmap $bitmap -background $bg]
    }
    if { [Widget::getoption $path -separator] } {
	Separator::create $path.sep -orient $orient -background $bg
    }
    set _widget($path,realized) 0
................................................................................
	set width 8
    }
    set cmd [list ButtonBox::add $path.bbox -width $width \
		 -command [list Dialog::enddialog $path $_widget($path,nbut)]]

    set res [eval $cmd $args]

    # a button box button by default is flat, this isn't what we want
    # here for normal dialog box action buttons, so we need to
    # override the default:

    if { [BWidget::using ttk] } {
        $res configure -style "TButton"
    }

    incr _widget($path,nbut)
    return $res
}

Changes to init.tcl.

1
2
3
4
5
6
7
8
9
10
11
..
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
..
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111

112
# ----------------------------------------------------------------------------
#  init.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: init.tcl,v 1.91 2009/09/06 20:51:44 oberdorfer Exp $
# ----------------------------------------------------------------------------
#
namespace eval Widget {}
proc Widget::_opt_defaults {{prio widgetDefault}} {
    if {$::tcl_version >= 8.4} {
	set plat [tk windowingsystem]
    } else {
................................................................................
	set plat $::tcl_platform(platform)
    }
    switch -exact $plat {
	"aqua" {
	}
	"win32" -
	"windows" {
	    #option add *Listbox.background	SystemWindow $prio
	    option add *ListBox.background	SystemWindow $prio
	    #option add *Button.padY		0 $prio
	    option add *ButtonBox.padY		0 $prio
	    option add *Dialog.padY		0 $prio
	    option add *Dialog.anchor		e $prio
	}
	"x11" -
................................................................................
	}
    }
}
Widget::_opt_defaults

option read [file join $::BWIDGET::LIBRARY "lang" "en.rc"]

## Add a TraverseIn binding to standard Tk widgets to handle some of
## the BWidget-specific things we do.
bind Entry   <<TraverseIn>> { %W selection range 0 end; %W icursor end }
bind Spinbox <<TraverseIn>> { %W selection range 0 end; %W icursor end }

bind all <Key-Tab>       { Widget::traverseTo [Widget::focusNext %W] }
bind all <<PrevWindow>>  { Widget::traverseTo [Widget::focusPrev %W] }

namespace eval ::BWidget {

    if {[lsearch -exact [font names] "TkTextFont"] < 0} {
        catch {font create TkTextFont}
        catch {font create TkDefaultFont}
        catch {font create TkHeadingFont}
        catch {font create TkCaptionFont}
        catch {font create TkTooltipFont}

        switch -- [tk windowingsystem] {
            "win32" {
                if {$::tcl_platform(osVersion) >= 5.0} {
                    variable family "Tahoma"
                } else {
                    variable family "MS Sans Serif"
                }
                variable size 8

                font configure TkDefaultFont -family $family -size $size
                font configure TkTextFont    -family $family -size $size
                font configure TkHeadingFont -family $family -size $size
                font configure TkCaptionFont -family $family -size $size \
                    -weight bold
                font configure TkTooltipFont -family $family -size $size
            }

            "classic" - "aqua" {
                variable family "Lucida Grande"
                variable size 13
                variable viewsize 12
                variable smallsize 11

                font configure TkDefaultFont -family $family -size $size
                font configure TkTextFont    -family $family -size $size
                font configure TkHeadingFont -family $family -size $smallsize
                font configure TkCaptionFont -family $family -size $size \
                    -weight bold
                font configure TkTooltipFont -family $family -size $viewsize
            }

            "x11" {
                if {![catch {tk::pkgconfig get fontsystem} fs]
                    && [string equal $fs "xft"]} {
                    variable family "sans-serif"
                } else {
                    variable family "Helvetica"
                }
                variable size -12
                variable ttsize -10
                variable capsize -14

                font configure TkDefaultFont -family $family -size $size
                font configure TkTextFont    -family $family -size $size
                font configure TkHeadingFont -family $family -size $size \
                    -weight bold
                font configure TkCaptionFont -family $family -size $capsize \
                    -weight bold
                font configure TkTooltipFont -family $family -size $ttsize
            }
        }
    }
} ; ## namespace eval ::BWidget



BWidget::set_themedefaults "initialize"


|







 







<







 







|
|






<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
>
|
1
2
3
4
5
6
7
8
9
10
11
..
12
13
14
15
16
17
18

19
20
21
22
23
24
25
..
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46

47






























































48
49
# ----------------------------------------------------------------------------
#  init.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: init.tcl,v 1.92 2009/10/25 20:55:36 oberdorfer Exp $
# ----------------------------------------------------------------------------
#
namespace eval Widget {}
proc Widget::_opt_defaults {{prio widgetDefault}} {
    if {$::tcl_version >= 8.4} {
	set plat [tk windowingsystem]
    } else {
................................................................................
	set plat $::tcl_platform(platform)
    }
    switch -exact $plat {
	"aqua" {
	}
	"win32" -
	"windows" {

	    option add *ListBox.background	SystemWindow $prio
	    #option add *Button.padY		0 $prio
	    option add *ButtonBox.padY		0 $prio
	    option add *Dialog.padY		0 $prio
	    option add *Dialog.anchor		e $prio
	}
	"x11" -
................................................................................
	}
    }
}
Widget::_opt_defaults

option read [file join $::BWIDGET::LIBRARY "lang" "en.rc"]

#  Add a TraverseIn binding to standard Tk widgets to handle some of
#  the BWidget-specific things we do.
bind Entry   <<TraverseIn>> { %W selection range 0 end; %W icursor end }
bind Spinbox <<TraverseIn>> { %W selection range 0 end; %W icursor end }

bind all <Key-Tab>       { Widget::traverseTo [Widget::focusNext %W] }
bind all <<PrevWindow>>  { Widget::traverseTo [Widget::focusPrev %W] }

































































::BWidget::createSystemFonts
::BWidget::set_themedefaults "default"

Changes to label.tcl.

1
2
3
4
5
6
7
8
9
10
11
..
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
# ------------------------------------------------------------------------------
#  label.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: label.tcl,v 1.11 2009/09/06 21:15:25 oberdorfer Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - Label::create
#     - Label::configure
#     - Label::cget
#     - Label::setfocus
#     - Label::_drag_cmd
................................................................................

    Widget::declare Label {
        {-name               String     ""     0}
        {-text               String     ""     0}
        {-textvariable       String     ""     0}
        {-underline          Int        -1     0 "%d >= -1"}
        {-focus              String     ""     0}
	{-foreground         Color      "SystemWindow"       0}
        {-background         Color      "SystemWindowFrame"  0}
        {-disabledforeground Color      "SystemDisabledText" 0}
        {-state              Enum       normal 0  {normal disabled}}
        {-fg                 Synonym    -foreground}
    }

    DynamicHelp::include Label balloon


|







 







|







1
2
3
4
5
6
7
8
9
10
11
..
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
# ------------------------------------------------------------------------------
#  label.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: label.tcl,v 1.12 2009/10/25 20:55:36 oberdorfer Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - Label::create
#     - Label::configure
#     - Label::cget
#     - Label::setfocus
#     - Label::_drag_cmd
................................................................................

    Widget::declare Label {
        {-name               String     ""     0}
        {-text               String     ""     0}
        {-textvariable       String     ""     0}
        {-underline          Int        -1     0 "%d >= -1"}
        {-focus              String     ""     0}
	{-foreground         Color      "SystemWindowText"   0}
        {-background         Color      "SystemWindowFrame"  0}
        {-disabledforeground Color      "SystemDisabledText" 0}
        {-state              Enum       normal 0  {normal disabled}}
        {-fg                 Synonym    -foreground}
    }

    DynamicHelp::include Label balloon

Changes to mainframe.tcl.

1
2
3
4
5
6
7
8
9
10
11
...
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
# ----------------------------------------------------------------------------
#  mainframe.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: mainframe.tcl,v 1.25 2009/09/06 21:22:36 oberdorfer Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - MainFrame::create
#     - MainFrame::configure
#     - MainFrame::cget
#     - MainFrame::getframe
#     - MainFrame::addtoolbar
................................................................................

    set index     $_widget($path,ntoolbar)
    set toolframe $path.topf.f$index
    set toolbar   $path.topf.tb$index
    set bg        [Widget::getoption $path -background]
    if { $tcl_platform(platform) == "unix" } {
	if { [BWidget::using ttk] } {
	    ttk::frame $toolframe -padding 1
	} else {
	    frame $toolframe -relief raised -borderwidth 1 \
		-takefocus 0 -highlightthickness 0 -background $bg
	}
    } else {
	if { [BWidget::using ttk] } {
	    ttk::frame $toolframe


|







 







|







1
2
3
4
5
6
7
8
9
10
11
...
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
# ----------------------------------------------------------------------------
#  mainframe.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: mainframe.tcl,v 1.26 2009/10/25 20:55:36 oberdorfer Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - MainFrame::create
#     - MainFrame::configure
#     - MainFrame::cget
#     - MainFrame::getframe
#     - MainFrame::addtoolbar
................................................................................

    set index     $_widget($path,ntoolbar)
    set toolframe $path.topf.f$index
    set toolbar   $path.topf.tb$index
    set bg        [Widget::getoption $path -background]
    if { $tcl_platform(platform) == "unix" } {
	if { [BWidget::using ttk] } {
	    ttk::frame $toolframe -padding 1 -relief raised -borderwidth 1
	} else {
	    frame $toolframe -relief raised -borderwidth 1 \
		-takefocus 0 -highlightthickness 0 -background $bg
	}
    } else {
	if { [BWidget::using ttk] } {
	    ttk::frame $toolframe

Changes to notebook.tcl.

1
2
3
4
5
6
7
8
9
10
11
...
270
271
272
273
274
275
276
277

278
279
280
281
282

283
284
285
286
287
288
289
# ---------------------------------------------------------------------------
#  notebook.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: notebook.tcl,v 1.27 2009/09/08 20:50:46 oberdorfer Exp $
# ---------------------------------------------------------------------------
#  Index of commands:
#     - NoteBook::create
#     - NoteBook::configure
#     - NoteBook::cget
#     - NoteBook::compute_size
#     - NoteBook::insert
................................................................................

    set data(pages) [linsert $data(pages) $index $page]
    # If the page doesn't exist, create it; if it does reset its bg and ibd
    if { ![winfo exists $f] } {
        frame $f \
	    -relief      flat \
	    -background  [Widget::cget $path -background] \
	    -borderwidth [Widget::cget $path -internalborderwidth]

        set data($page,realized) 0
    } else {
	$f configure \
	    -background  [Widget::cget $path -background] \
	    -borderwidth [Widget::cget $path -internalborderwidth]

    }
    _compute_height $path
    _compute_width  $path
    _draw_page $path $page 1
    _set_help  $path $page
    _redraw $path



|







 







|
>




|
>







1
2
3
4
5
6
7
8
9
10
11
...
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
# ---------------------------------------------------------------------------
#  notebook.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: notebook.tcl,v 1.28 2009/10/25 20:55:36 oberdorfer Exp $
# ---------------------------------------------------------------------------
#  Index of commands:
#     - NoteBook::create
#     - NoteBook::configure
#     - NoteBook::cget
#     - NoteBook::compute_size
#     - NoteBook::insert
................................................................................

    set data(pages) [linsert $data(pages) $index $page]
    # If the page doesn't exist, create it; if it does reset its bg and ibd
    if { ![winfo exists $f] } {
        frame $f \
	    -relief      flat \
	    -background  [Widget::cget $path -background] \
	    -borderwidth [Widget::cget $path -internalborderwidth] \
	    -highlightthickness 0
        set data($page,realized) 0
    } else {
	$f configure \
	    -background  [Widget::cget $path -background] \
	    -borderwidth [Widget::cget $path -internalborderwidth] \
	    -highlightthickness 0
    }
    _compute_height $path
    _compute_width  $path
    _draw_page $path $page 1
    _set_help  $path $page
    _redraw $path

Changes to panedw.tcl.

1
2
3
4
5
6
7
8
9
10
11
..
57
58
59
60
61
62
63
64

65
66
67
68
69
70
71
# ----------------------------------------------------------------------------
#  panedw.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: panedw.tcl,v 1.15 2009/09/06 21:29:34 oberdorfer Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - PanedWindow::create
#     - PanedWindow::configure
#     - PanedWindow::cget
#     - PanedWindow::add
#     - PanedWindow::getframe
................................................................................
#  Command PanedWindow::create
# ----------------------------------------------------------------------------
proc PanedWindow::create { path args } {
    variable _panedw

    Widget::init PanedWindow $path $args
    frame $path -background [Widget::cget $path -background] \
                -class PanedWindow


    set _panedw($path,nbpanes) 0
    set _panedw($path,weights) ""
    set _panedw($path,configuredone) 0

    set activator [Widget::getoption $path -activator]
    if {[string equal $activator ""]} {


|







 







|
>







1
2
3
4
5
6
7
8
9
10
11
..
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
# ----------------------------------------------------------------------------
#  panedw.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: panedw.tcl,v 1.16 2009/10/25 20:55:36 oberdorfer Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - PanedWindow::create
#     - PanedWindow::configure
#     - PanedWindow::cget
#     - PanedWindow::add
#     - PanedWindow::getframe
................................................................................
#  Command PanedWindow::create
# ----------------------------------------------------------------------------
proc PanedWindow::create { path args } {
    variable _panedw

    Widget::init PanedWindow $path $args
    frame $path -background [Widget::cget $path -background] \
                -class PanedWindow \
		-highlightthickness 0

    set _panedw($path,nbpanes) 0
    set _panedw($path,weights) ""
    set _panedw($path,configuredone) 0

    set activator [Widget::getoption $path -activator]
    if {[string equal $activator ""]} {

Changes to pkgIndex.tcl.

1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
# ----------------------------------------------------------------------------
#  pkgIndex.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: pkgIndex.tcl,v 1.20 2009/09/06 21:00:07 oberdorfer Exp $
# ----------------------------------------------------------------------------

if {[catch {package require Tcl}]} return
package ifneeded BWidget 1.9.1 "\
    package require Tk 8.1.1;\
    [list tclPkgSetup $dir BWidget 1.9.1 {
{arrow.tcl source {ArrowButton ArrowButton::create ArrowButton::use}}

{labelframe.tcl source {LabelFrame LabelFrame::create LabelFrame::use}}
{labelentry.tcl source {LabelEntry LabelEntry::create LabelEntry::use}}
{bitmap.tcl source {Bitmap::get Bitmap::use}}
{button.tcl source {Button Button::create Button::use}}
{buttonbox.tcl source {ButtonBox ButtonBox::create ButtonBox::use}}
{combobox.tcl source {ComboBox ComboBox::create ComboBox::use}}
{label.tcl source {Label Label::create Label::use}}


|







>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
# ----------------------------------------------------------------------------
#  pkgIndex.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: pkgIndex.tcl,v 1.21 2009/10/25 20:55:36 oberdorfer Exp $
# ----------------------------------------------------------------------------

if {[catch {package require Tcl}]} return
package ifneeded BWidget 1.9.1 "\
    package require Tk 8.1.1;\
    [list tclPkgSetup $dir BWidget 1.9.1 {
{arrow.tcl source {ArrowButton ArrowButton::create ArrowButton::use}}
{frame.tcl source {Frame Frame::create Frame::use}}
{labelframe.tcl source {LabelFrame LabelFrame::create LabelFrame::use}}
{labelentry.tcl source {LabelEntry LabelEntry::create LabelEntry::use}}
{bitmap.tcl source {Bitmap::get Bitmap::use}}
{button.tcl source {Button Button::create Button::use}}
{buttonbox.tcl source {ButtonBox ButtonBox::create ButtonBox::use}}
{combobox.tcl source {ComboBox ComboBox::create ComboBox::use}}
{label.tcl source {Label Label::create Label::use}}

Changes to scrollframe.tcl.

1
2
3
4
5
6
7
8
9
10
11
..
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
# ----------------------------------------------------------------------------
#  scrollframe.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: scrollframe.tcl,v 1.12 2009/09/06 21:38:51 oberdorfer Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - ScrollableFrame::create
#     - ScrollableFrame::configure
#     - ScrollableFrame::cget
#     - ScrollableFrame::getframe
#     - ScrollableFrame::see
................................................................................
#     - ScrollableFrame::_themechanged
# ----------------------------------------------------------------------------

namespace eval ScrollableFrame {
    Widget::define ScrollableFrame scrollframe

    Widget::declare ScrollableFrame {
        {-background	    Color      "SystemWindow"  0}
        {-width             Int        0  0 {}}
        {-height            Int        0  0 {}}
        {-areawidth         Int        0  0 {}}
        {-areaheight        Int        0  0 {}}
        {-constrainedwidth  Boolean    0 0}
        {-constrainedheight Boolean    0 0}
        {-xscrollcommand    TkResource "" 0 canvas}


|







 







|







1
2
3
4
5
6
7
8
9
10
11
..
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
# ----------------------------------------------------------------------------
#  scrollframe.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: scrollframe.tcl,v 1.13 2009/10/25 20:55:36 oberdorfer Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - ScrollableFrame::create
#     - ScrollableFrame::configure
#     - ScrollableFrame::cget
#     - ScrollableFrame::getframe
#     - ScrollableFrame::see
................................................................................
#     - ScrollableFrame::_themechanged
# ----------------------------------------------------------------------------

namespace eval ScrollableFrame {
    Widget::define ScrollableFrame scrollframe

    Widget::declare ScrollableFrame {
        {-background	    Color      "SystemWindowFrame"  0}
        {-width             Int        0  0 {}}
        {-height            Int        0  0 {}}
        {-areawidth         Int        0  0 {}}
        {-areaheight        Int        0  0 {}}
        {-constrainedwidth  Boolean    0 0}
        {-constrainedheight Boolean    0 0}
        {-xscrollcommand    TkResource "" 0 canvas}

Changes to scrollview.tcl.

1
2
3
4
5
6
7
8
9
10
11
..
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
# ------------------------------------------------------------------------------
#  scrollview.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: scrollview.tcl,v 1.71 2009/09/06 21:39:24 oberdorfer Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - ScrolledWindow::create
#     - ScrolledWindow::configure
#     - ScrolledWindow::cget
#     - ScrolledWindow::_set_hscroll
#     - ScrolledWindow::_set_vscroll
................................................................................
	    include {-relief -borderwidth -background -width -height -cursor} \
	    initialize {-relief flat -borderwidth 0 -width 30 -height 30 \
		-cursor crosshair}

    Widget::declare ScrollView {
        {-width       TkResource 30        0 canvas}
        {-height      TkResource 30        0 canvas}
        {-foreground		Color      "SystemWindow"      0}
        {-background		Color      "SystemWindowFrame" 0}
        {-fill        String     ""        0}
        {-relief      TkResource flat      0 canvas}
        {-borderwidth TkResource 0         0 canvas}
        {-cursor      TkResource crosshair 0 canvas}
        {-window      String     ""        0}
        {-fg          Synonym    -foreground}


|







 







|







1
2
3
4
5
6
7
8
9
10
11
..
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
# ------------------------------------------------------------------------------
#  scrollview.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: scrollview.tcl,v 1.72 2009/10/25 20:55:36 oberdorfer Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - ScrolledWindow::create
#     - ScrolledWindow::configure
#     - ScrolledWindow::cget
#     - ScrolledWindow::_set_hscroll
#     - ScrolledWindow::_set_vscroll
................................................................................
	    include {-relief -borderwidth -background -width -height -cursor} \
	    initialize {-relief flat -borderwidth 0 -width 30 -height 30 \
		-cursor crosshair}

    Widget::declare ScrollView {
        {-width       TkResource 30        0 canvas}
        {-height      TkResource 30        0 canvas}
        {-foreground		Color      "SystemWindowText"  0}
        {-background		Color      "SystemWindowFrame" 0}
        {-fill        String     ""        0}
        {-relief      TkResource flat      0 canvas}
        {-borderwidth TkResource 0         0 canvas}
        {-cursor      TkResource crosshair 0 canvas}
        {-window      String     ""        0}
        {-fg          Synonym    -foreground}

Changes to spinbox.tcl.

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
..
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
#
#	BWidget SpinBox implementation.
#
# Copyright (c) 1999 by Unifix
# Copyright (c) 2000 by Ajuba Solutions
# All rights reserved.
# 
# RCS: @(#) $Id: spinbox.tcl,v 1.13 2009/09/06 21:41:25 oberdorfer Exp $
# -----------------------------------------------------------------------------
#  Index of commands:
#     - SpinBox::create
#     - SpinBox::configure
#     - SpinBox::cget
#     - SpinBox::setvalue
#     - SpinBox::_destroy
................................................................................

    Widget::declare SpinBox {
        {-range          String ""  0}
        {-values         String ""  0}
        {-modifycmd      String ""  0}
        {-repeatdelay    Int    400 0 {%d >= 0}}
        {-repeatinterval Int    100 0 {%d >= 0}}
        {-foreground     Color  "SystemWindow" 0}
    }

    Widget::addmap SpinBox "" :cmd {-background {}}
    Widget::addmap SpinBox ArrowButton .arrup {
        -foreground {} -background {} -disabledforeground {} -state {} \
		-repeatinterval {} -repeatdelay {}
    }






|







 







|







2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
..
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
#
#	BWidget SpinBox implementation.
#
# Copyright (c) 1999 by Unifix
# Copyright (c) 2000 by Ajuba Solutions
# All rights reserved.
# 
# RCS: @(#) $Id: spinbox.tcl,v 1.14 2009/10/25 20:55:36 oberdorfer Exp $
# -----------------------------------------------------------------------------
#  Index of commands:
#     - SpinBox::create
#     - SpinBox::configure
#     - SpinBox::cget
#     - SpinBox::setvalue
#     - SpinBox::_destroy
................................................................................

    Widget::declare SpinBox {
        {-range          String ""  0}
        {-values         String ""  0}
        {-modifycmd      String ""  0}
        {-repeatdelay    Int    400 0 {%d >= 0}}
        {-repeatinterval Int    100 0 {%d >= 0}}
        {-foreground     Color  "SystemWindowText" 0}
    }

    Widget::addmap SpinBox "" :cmd {-background {}}
    Widget::addmap SpinBox ArrowButton .arrup {
        -foreground {} -background {} -disabledforeground {} -state {} \
		-repeatinterval {} -repeatdelay {}
    }

Changes to titleframe.tcl.

1
2
3
4
5
6
7
8
9
10
11
..
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
# ------------------------------------------------------------------------------
#  titleframe.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: titleframe.tcl,v 1.51 2009/09/06 21:44:21 oberdorfer Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - TitleFrame::create
#     - TitleFrame::configure
#     - TitleFrame::cget
#     - TitleFrame::getframe
#     - TitleFrame::_place
................................................................................
namespace eval TitleFrame {
    Widget::define TitleFrame titleframe

    Widget::declare TitleFrame {
        {-relief      TkResource groove 0 frame}
        {-borderwidth TkResource 2      0 frame}
        {-font        TkResource ""     0 label}
        {-foreground  Color      "SystemWindow"      0}
        {-background  Color      "SystemWindowFrame" 0}
        {-state       TkResource ""     0 label}
        {-background  TkResource ""     0 frame}
        {-text        String     ""     0}
        {-ipad        Int        4      0 "%d >=0"}
        {-side        Enum       left   0 {left center right}}
        {-baseline    Enum       center 0 {top center bottom}}


|







 







|







1
2
3
4
5
6
7
8
9
10
11
..
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
# ------------------------------------------------------------------------------
#  titleframe.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: titleframe.tcl,v 1.52 2009/10/25 20:55:36 oberdorfer Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - TitleFrame::create
#     - TitleFrame::configure
#     - TitleFrame::cget
#     - TitleFrame::getframe
#     - TitleFrame::_place
................................................................................
namespace eval TitleFrame {
    Widget::define TitleFrame titleframe

    Widget::declare TitleFrame {
        {-relief      TkResource groove 0 frame}
        {-borderwidth TkResource 2      0 frame}
        {-font        TkResource ""     0 label}
        {-foreground  Color      "SystemWindowText"  0}
        {-background  Color      "SystemWindowFrame" 0}
        {-state       TkResource ""     0 label}
        {-background  TkResource ""     0 frame}
        {-text        String     ""     0}
        {-ipad        Int        4      0 "%d >=0"}
        {-side        Enum       left   0 {left center right}}
        {-baseline    Enum       center 0 {top center bottom}}

Changes to utils.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17


18
19
20
21
22
23
24
...
702
703
704
705
706
707
708
































































































# ----------------------------------------------------------------------------
#  utils.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: utils.tcl,v 1.17 2009/09/08 20:28:07 oberdorfer Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - GlobalVar::exists
#     - GlobalVar::setvarvar
#     - GlobalVar::getvarvar
#     - BWidget::assert
#     - BWidget::clonename
#     - BWidget::get3dcolor
#     - BWidget::XLFDfont
#     - BWidget::place
#     - BWidget::grab
#     - BWidget::focus
#     - BWidget::bindMiddleMouseMovement


# ----------------------------------------------------------------------------

namespace eval GlobalVar {
    proc use {} {}
}


................................................................................
      set ydir 1
      if { %x > $BWidget::__private(x) } {set xdir -1}
      if { %y > $BWidget::__private(y) } {set ydir -1}
      catch {%W xview scroll [expr $xdir * $scrollspeed] units}
      catch {%W yview scroll [expr $ydir * $scrollspeed] units}
  }
}


































































































|













>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
...
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
# ----------------------------------------------------------------------------
#  utils.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: utils.tcl,v 1.18 2009/10/25 20:55:36 oberdorfer Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - GlobalVar::exists
#     - GlobalVar::setvarvar
#     - GlobalVar::getvarvar
#     - BWidget::assert
#     - BWidget::clonename
#     - BWidget::get3dcolor
#     - BWidget::XLFDfont
#     - BWidget::place
#     - BWidget::grab
#     - BWidget::focus
#     - BWidget::bindMiddleMouseMovement
#     - BWidget::getSystemFontProperties
#     - BWidget::createSystemFonts
# ----------------------------------------------------------------------------

namespace eval GlobalVar {
    proc use {} {}
}


................................................................................
      set ydir 1
      if { %x > $BWidget::__private(x) } {set xdir -1}
      if { %y > $BWidget::__private(y) } {set ydir -1}
      catch {%W xview scroll [expr $xdir * $scrollspeed] units}
      catch {%W yview scroll [expr $ydir * $scrollspeed] units}
  }
}


# ----------------------------------------------------------------------------
# utility function for font support
# ----------------------------------------------------------------------------

proc ::BWidget::getSystemFontProperties {} {

    array set fp {
        family   "Courier New"
        stdsize  12
        headingsize 10
	captionsize 12
        tooltipsize 10
        wheading normal
        wcaption normal
    }

    if {$::tcl_version >= 8.4} {
             set plat [tk windowingsystem]
    } else { set plat $::tcl_platform(platform) }


    switch -exact -- [string tolower $plat] {
        "win32" - "windows" {
            if {$::tcl_platform(osVersion) >= 5.0} {
                     set fp(family) "Tahoma"
            } else { set fp(family) "MS Sans Serif" }
            set fp(stdsize) 8
	    set fp(headingsize) 8
	    set fp(captionsize) 8
	    set fp(tooltipsize) 8
            set fp(wcaption) bold
	}
        "classic" - "aqua" {
            set fp(family) "Lucida Grande"
            set fp(stdsize) 13
	    set fp(headingsize) 11
	    set fp(captionsize) 13
            set fp(tooltipsize) 12
	    set fp(wcaption) bold
        }
        "x11" {
            if { ![catch {tk::pkgconfig get fontsystem} fs] &&
                  [string equal $fs "xft"] } {
                     set fp(family) "sans-serif"
            } else { set fp(family) "Helvetica" }
            set fp(stdsize) -12
            set fp(headingsize) -12
            set fp(captionsize) -14
            set fp(tooltipsize) -10
	    set fp(wheading) bold
            set fp(wcaption) bold
        }
    }
    return [array get fp]
}


# under tk >= 8.5 / tile 0.8,
# the following predefined fonts are available:
#    TkCaptionFont TkDefaultFont TkFixedFont TkHeadingFont
#    TkIconFont TkMenuFont TkSmallCaptionFont TkTextFont TkTooltipFont
# to be compatible with older versions and to make sure,
# those fonts are available at runtime, we need to ensure that they exist:

proc ::BWidget::createSystemFonts {} {
  variable vars

    array set fp [getSystemFontProperties]
    set fnames [font names]

    foreach fname { TkCaptionFont TkDefaultFont TkFixedFont TkHeadingFont
                    TkIconFont TkMenuFont TkSmallCaptionFont TkTextFont
		    TkTooltipFont } {

        if {[lsearch $fnames $fname] == -1} {
            font create $fname -family $fp(family) -size $fp(stdsize)
	  
	    switch -- $fname {
	      TkCaptionFont {
	          font configure $fname \
	              -size $fp(captionsize) -weight $fp(wcaption)
	      }
	      TkHeadingFont {
	          font configure $fname \
	              -size $fp(headingsize) -weight $fp(wheading)
	      }
	      TkTooltipFont {
	          font configure $fname -size $fp(tooltipsize)
	      }	      
	    }
        }
    }
}