Bwidget Source Code
Check-in [149d9e6ba2]
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:Changed env(BWIDGET_LIBRARY) to ::BWIDGET::LIBRARY everywhere. This makes BWidgets behave more nicely with tcltest.
Timelines: family | ancestors | descendants | both | trunk | scriptics-sc-1-0-base
Files: files | file ages | folders
SHA1: 149d9e6ba2ca62b17a3b02c31677a6ea43586f5e
User & Date: ericm 1999-11-05 03:38:54
Context
1999-11-12
04:12
The tkwait visibility .drag is now in a catch, so the destruction of the window can no longer cause a Tcl stack trace. Fixed bug # 3571. Leaf check-in: 96b3418c47 user: sven tags: scriptics-sc-1-0, scriptics-sc-1-0-branch
04:12
The tkwait visibility .drag is now in a catch, so the destruction of the window can no longer cause a Tcl stack trace. Fixed bug # 3571. check-in: 1d263889a1 user: sven tags: trunk, scriptics-sc-1-1, scriptics-sc-1-1-b1, scriptics-sc-1-1-base
1999-11-05
03:38
Changed env(BWIDGET_LIBRARY) to ::BWIDGET::LIBRARY everywhere. This makes BWidgets behave more nicely with tcltest. check-in: 149d9e6ba2 user: ericm tags: trunk, scriptics-sc-1-0-base
1999-10-30
00:31
* buttonbox.tcl: Added a gettags function, which allows the user to query the tags that are used on buttons in the buttonbox. check-in: 133c515858 user: ericm tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to bitmap.tcl.

1
2
3
4
5
6
7
8
9
10
11
..
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
# ------------------------------------------------------------------------------
#  bitmap.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: bitmap.tcl,v 1.1.1.1 1999/08/03 20:20:23 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - Bitmap::get
#     - Bitmap::_init
# ------------------------------------------------------------------------------
namespace eval Bitmap {
    variable path
................................................................................
# ------------------------------------------------------------------------------
proc Bitmap::_init { } {
    global   env
    variable path
    variable _bmp
    variable _types

    set path [list "." [file join $env(BWIDGET_LIBRARY) images]]
    set supp [image types]
    foreach {type ext} $_types {
        if { [lsearch $supp $type] != -1} {
            set _bmp($ext) $type
        }
    }
}


Bitmap::_init


|







 







|










1
2
3
4
5
6
7
8
9
10
11
..
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
# ------------------------------------------------------------------------------
#  bitmap.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: bitmap.tcl,v 1.2 1999/11/05 03:38:54 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - Bitmap::get
#     - Bitmap::_init
# ------------------------------------------------------------------------------
namespace eval Bitmap {
    variable path
................................................................................
# ------------------------------------------------------------------------------
proc Bitmap::_init { } {
    global   env
    variable path
    variable _bmp
    variable _types

    set path [list "." [file join $::BWIDGET::LIBRARY images]]
    set supp [image types]
    foreach {type ext} $_types {
        if { [lsearch $supp $type] != -1} {
            set _bmp($ext) $type
        }
    }
}


Bitmap::_init

Changes to demo/tmpldlg.tcl.

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
    set titf1 [TitleFrame $frame.titf1 -text "Resources"]
    set titf2 [TitleFrame $frame.titf2 -text "Template Dialog"]
    set titf3 [TitleFrame $frame.titf3 -text "Message Dialog"]
    set titf4 [TitleFrame $frame.titf4 -text "Other dialog"]

    set subf [$titf1 getframe]
    set cmd  {option read [file join $env(BWIDGET_LIBRARY) "lang" $DemoDlg::resources.rc]}
    set rad1 [radiobutton $subf.rad1 -text "English" \
                  -variable DemoDlg::resources -value en \
                  -command  $cmd]
    set rad2 [radiobutton $subf.rad2 -text "French" \
                  -variable DemoDlg::resources -value fr \
                  -command  $cmd]
    set rad3 [radiobutton $subf.rad3 -text "German" \






|







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
    set titf1 [TitleFrame $frame.titf1 -text "Resources"]
    set titf2 [TitleFrame $frame.titf2 -text "Template Dialog"]
    set titf3 [TitleFrame $frame.titf3 -text "Message Dialog"]
    set titf4 [TitleFrame $frame.titf4 -text "Other dialog"]

    set subf [$titf1 getframe]
    set cmd  {option read [file join $::BWIDGET::LIBRARY) "lang" $DemoDlg::resources.rc]}
    set rad1 [radiobutton $subf.rad1 -text "English" \
                  -variable DemoDlg::resources -value en \
                  -command  $cmd]
    set rad2 [radiobutton $subf.rad2 -text "French" \
                  -variable DemoDlg::resources -value fr \
                  -command  $cmd]
    set rad3 [radiobutton $subf.rad3 -text "German" \

Changes to dropsite.tcl.

1
2
3
4
5
6
7
8
9
10
11
..
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
# ------------------------------------------------------------------------------
#  dropsite.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: dropsite.tcl,v 1.1.1.1 1999/08/03 20:20:23 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - DropSite::include
#     - DropSite::setdrop
#     - DropSite::register
#     - DropSite::setcursor
#     - DropSite::setoperation
................................................................................
        set _tabops(mod,alt) 16
    }
    array set _defops \
        [list \
             copy,mod  shift   \
             move,mod  control \
             link,mod  alt     \
             copy,img  @[file join $env(BWIDGET_LIBRARY) "images" "opcopy.xbm"] \
             move,img  @[file join $env(BWIDGET_LIBRARY) "images" "opmove.xbm"] \
             link,img  @[file join $env(BWIDGET_LIBRARY) "images" "oplink.xbm"]]

    bind DragTop <KeyPress-Shift_L>     {DropSite::_update_operation [expr %s | 1]}
    bind DragTop <KeyPress-Shift_R>     {DropSite::_update_operation [expr %s | 1]}
    bind DragTop <KeyPress-Control_L>   {DropSite::_update_operation [expr %s | 4]}
    bind DragTop <KeyPress-Control_R>   {DropSite::_update_operation [expr %s | 4]}
    if { $tcl_platform(platform) == "unix" } {
        bind DragTop <KeyPress-Alt_L>       {DropSite::_update_operation [expr %s | 8]}


|







 







|
|
|







1
2
3
4
5
6
7
8
9
10
11
..
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
# ------------------------------------------------------------------------------
#  dropsite.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: dropsite.tcl,v 1.2 1999/11/05 03:38:54 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - DropSite::include
#     - DropSite::setdrop
#     - DropSite::register
#     - DropSite::setcursor
#     - DropSite::setoperation
................................................................................
        set _tabops(mod,alt) 16
    }
    array set _defops \
        [list \
             copy,mod  shift   \
             move,mod  control \
             link,mod  alt     \
             copy,img  @[file join $::BWIDGET::LIBRARY "images" "opcopy.xbm"] \
             move,img  @[file join $::BWIDGET::LIBRARY "images" "opmove.xbm"] \
             link,img  @[file join $::BWIDGET::LIBRARY "images" "oplink.xbm"]]

    bind DragTop <KeyPress-Shift_L>     {DropSite::_update_operation [expr %s | 1]}
    bind DragTop <KeyPress-Shift_R>     {DropSite::_update_operation [expr %s | 1]}
    bind DragTop <KeyPress-Control_L>   {DropSite::_update_operation [expr %s | 4]}
    bind DragTop <KeyPress-Control_R>   {DropSite::_update_operation [expr %s | 4]}
    if { $tcl_platform(platform) == "unix" } {
        bind DragTop <KeyPress-Alt_L>       {DropSite::_update_operation [expr %s | 8]}

Changes to init.tcl.

11
12
13
14
15
16
17
18
19
20
21
    option add *Scrollbar.width         12 widgetDefault
    option add *Scrollbar.borderWidth   1  widgetDefault
    option add *Dialog.separator        1  widgetDefault
    option add *MainFrame.relief        raised widgetDefault
    option add *MainFrame.separator     none   widgetDefault
}

option read [file join $env(BWIDGET_LIBRARY) "lang" "en.rc"]

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






|



11
12
13
14
15
16
17
18
19
20
21
    option add *Scrollbar.width         12 widgetDefault
    option add *Scrollbar.borderWidth   1  widgetDefault
    option add *Dialog.separator        1  widgetDefault
    option add *MainFrame.relief        raised widgetDefault
    option add *MainFrame.separator     none   widgetDefault
}

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

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

Changes to pkgIndex.tcl.

32
33
34
35
36
37
38
39

40
41
42
43
{dynhelp.tcl source {DynamicHelp::configure DynamicHelp::use DynamicHelp::register DynamicHelp::include}}
{dialog.tcl source {Dialog Dialog::create Dialog::use}}
{messagedlg.tcl source {MessageDlg MessageDlg::create MessageDlg::use}}
{font.tcl source {SelectFont SelectFont::create SelectFont::use SelectFont::loadfont}}
{widgetdoc.tcl source {Widget::generate-doc Widget::generate-widget-doc}}
{xpm2image.tcl source {xpm-to-image}}
}]; \
    [list set env(BWIDGET_LIBRARY) $dir]; \

    [list source [file join $dir widget.tcl]]; \
    [list source [file join $dir init.tcl]]; \
    [list source [file join $dir utils.tcl]]; \
"






|
>




32
33
34
35
36
37
38
39
40
41
42
43
44
{dynhelp.tcl source {DynamicHelp::configure DynamicHelp::use DynamicHelp::register DynamicHelp::include}}
{dialog.tcl source {Dialog Dialog::create Dialog::use}}
{messagedlg.tcl source {MessageDlg MessageDlg::create MessageDlg::use}}
{font.tcl source {SelectFont SelectFont::create SelectFont::use SelectFont::loadfont}}
{widgetdoc.tcl source {Widget::generate-doc Widget::generate-widget-doc}}
{xpm2image.tcl source {xpm-to-image}}
}]; \
	[list namespace eval ::BWIDGET {}]; \
	[list set ::BWIDGET::LIBRARY $dir]; \
    [list source [file join $dir widget.tcl]]; \
    [list source [file join $dir init.tcl]]; \
    [list source [file join $dir utils.tcl]]; \
"

Changes to tree.tcl.

1
2
3
4
5
6
7
8
9
10
11
...
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
....
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
# ------------------------------------------------------------------------------
#  tree.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: tree.tcl,v 1.4 1999/10/22 18:16:08 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - Tree::create
#     - Tree::configure
#     - Tree::cget
#     - Tree::insert
#     - Tree::itemconfigure
................................................................................
    if { $len && $exp } {
        set y1 [_draw_subnodes $path [lrange $data($node) 1 end] \
                    [expr {$x0+$deltax}] $y0 $deltax $deltay $padx $showlines]
    }

    if { [string compare $dc "never"] && ($len || ![string compare $dc "allways"]) } {
        if { $exp } {
            set bmp [file join $env(BWIDGET_LIBRARY) "images" "minus.xbm"]
        } else {
            set bmp [file join $env(BWIDGET_LIBRARY) "images" "plus.xbm"]
        }
        $path:cmd create bitmap $x0 $y0 \
            -bitmap     @$bmp \
            -background [$path:cmd cget -background] \
            -foreground [Widget::getoption $path -linesfill] \
            -tags       "cross c:$node" -anchor c
    }
................................................................................
            set len [expr {[llength $data($node)] > 1}]
            set dc  [Widget::getoption $path.$node -drawcross]
            set exp [Widget::getoption $path.$node -open]
            set idc [$path:cmd find withtag c:$node]

            if { [string compare $dc "never"] && ($len || ![string compare $dc "allways"]) } {
                if { $exp } {
                    set bmp [file join $env(BWIDGET_LIBRARY) "images" "minus.xbm"]
                } else {
                    set bmp [file join $env(BWIDGET_LIBRARY) "images" "plus.xbm"]
                }
                if { $idc == "" } {
                    $path:cmd create bitmap [expr {$x0-$deltax-5}] $y0 \
                        -bitmap     @$bmp \
                        -background [$path:cmd cget -background] \
                        -foreground [Widget::getoption $path -linesfill] \
                        -tags       "cross c:$node" -anchor c


|







 







|

|







 







|

|







1
2
3
4
5
6
7
8
9
10
11
...
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
....
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
# ------------------------------------------------------------------------------
#  tree.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: tree.tcl,v 1.5 1999/11/05 03:38:55 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - Tree::create
#     - Tree::configure
#     - Tree::cget
#     - Tree::insert
#     - Tree::itemconfigure
................................................................................
    if { $len && $exp } {
        set y1 [_draw_subnodes $path [lrange $data($node) 1 end] \
                    [expr {$x0+$deltax}] $y0 $deltax $deltay $padx $showlines]
    }

    if { [string compare $dc "never"] && ($len || ![string compare $dc "allways"]) } {
        if { $exp } {
            set bmp [file join $::BWIDGET::LIBRARY "images" "minus.xbm"]
        } else {
            set bmp [file join $::BWIDGET::LIBRARY "images" "plus.xbm"]
        }
        $path:cmd create bitmap $x0 $y0 \
            -bitmap     @$bmp \
            -background [$path:cmd cget -background] \
            -foreground [Widget::getoption $path -linesfill] \
            -tags       "cross c:$node" -anchor c
    }
................................................................................
            set len [expr {[llength $data($node)] > 1}]
            set dc  [Widget::getoption $path.$node -drawcross]
            set exp [Widget::getoption $path.$node -open]
            set idc [$path:cmd find withtag c:$node]

            if { [string compare $dc "never"] && ($len || ![string compare $dc "allways"]) } {
                if { $exp } {
                    set bmp [file join $::BWIDGET::LIBRARY "images" "minus.xbm"]
                } else {
                    set bmp [file join $::BWIDGET::LIBRARY "images" "plus.xbm"]
                }
                if { $idc == "" } {
                    $path:cmd create bitmap [expr {$x0-$deltax-5}] $y0 \
                        -bitmap     @$bmp \
                        -background [$path:cmd cget -background] \
                        -foreground [Widget::getoption $path -linesfill] \
                        -tags       "cross c:$node" -anchor c