Bwidget Source Code
Check-in [c2f71bcc58]
Not logged in
Core Home Timeline Branches Tags Tickets Wiki Login

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

Overview
Comment:TCL9.0/Tk8.7 compatibility issues found by Paul Obermeier. https://wiki.tcl-lang.org/page/Porting+extensions+to+Tcl+9 Ticket [1bee17b353]
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | bwidget
Files: files | file ages | folders
SHA3-256: c2f71bcc5845af19210ec644b46e8c2d256106b18e55267c606fb13ae62fb842
User & Date: oehhar 2023-05-22 12:34:10.471
References
2023-05-22
12:35 • Closed ticket [1bee17b353]: TCL 9.0/Tk 8.7 compatibility plus 7 other changes artifact: 2e8711bd26 user: oehhar
Context
2023-05-23
06:43
Restored "" in documentation. Thanks, Rolf ! check-in: 26b04efb02 user: oehhar tags: bwidget
2023-05-22
12:34
TCL9.0/Tk8.7 compatibility issues found by Paul Obermeier. https://wiki.tcl-lang.org/page/Porting+extensions+to+Tcl+9 Ticket [1bee17b353] check-in: c2f71bcc58 user: oehhar tags: bwidget
12:23
Bugfix in tree widget: node name terminating on ":" gave error -> Change node name character replacement from "::"-> "\5" to ":"->"\5". Ticket [d075175ade]. Thanks, Rolf ! check-in: dfab9c41bc user: oehhar tags: bwidget
Changes
Unified Diff Ignore Whitespace Patch
Changes to ChangeLog. 









1
2
3
4
5
6
7










2023-05-22 Harald Oehlmann <[email protected]>
	tree.tcl: Bug: node names with leading colons gave error.
	The node name solution was changed, that ":" is now
	substituded by "\5", and not "::". Ticket [d075175ade].
	Thanks to Rolf Ade for the ticket.

2022-12-25 Harald Oehlmann <[email protected]>

>
>
>
>
>
>
>
>
>








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

2023-05-22 Harald Oehlmann <[email protected]>
	TCL9.0/Tk8.7 compatibility issues found by Paul Obermeier.
	https://wiki.tcl-lang.org/page/Porting+extensions+to+Tcl+9
	* dropsite.tcl: Replaced "$tcl_platform" with "$::tcl_platform"
	  in namespaces.
	* widget.tcl: Replaced "package require Tcl 8.1.1" with
	  "package require Tcl 8.1.1-".
	Ticket [1bee17b353] 

2023-05-22 Harald Oehlmann <[email protected]>
	tree.tcl: Bug: node names with leading colons gave error.
	The node name solution was changed, that ":" is now
	substituded by "\5", and not "::". Ticket [d075175ade].
	Thanks to Rolf Ade for the ticket.

2022-12-25 Harald Oehlmann <[email protected]>
︙︙
Changes to dropsite.tcl.
︙︙
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

        mod,control 4
        mod,alt     24
        ops,copy    1
        ops,move    1
        ops,link    1
    }

    if { $tcl_platform(platform) == "unix" } {
        set _tabops(mod,alt) 8
    } else {
        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]}
        bind DragTop <KeyPress-Alt_R>       {DropSite::_update_operation [expr %s | 8]}
    } else {
        bind DragTop <KeyPress-Alt_L>       {DropSite::_update_operation [expr %s | 16]}
        bind DragTop <KeyPress-Alt_R>       {DropSite::_update_operation [expr %s | 16]}
    }

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








|

















|











|








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

        mod,control 4
        mod,alt     24
        ops,copy    1
        ops,move    1
        ops,link    1
    }

    if { $::tcl_platform(platform) == "unix" } {
        set _tabops(mod,alt) 8
    } else {
        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]}
        bind DragTop <KeyPress-Alt_R>       {DropSite::_update_operation [expr %s | 8]}
    } else {
        bind DragTop <KeyPress-Alt_L>       {DropSite::_update_operation [expr %s | 16]}
        bind DragTop <KeyPress-Alt_R>       {DropSite::_update_operation [expr %s | 16]}
    }

    bind DragTop <KeyRelease-Shift_L>   {DropSite::_update_operation [expr %s & ~1]}
    bind DragTop <KeyRelease-Shift_R>   {DropSite::_update_operation [expr %s & ~1]}
    bind DragTop <KeyRelease-Control_L> {DropSite::_update_operation [expr %s & ~4]}
    bind DragTop <KeyRelease-Control_R> {DropSite::_update_operation [expr %s & ~4]}
    if { $::tcl_platform(platform) == "unix" } {
        bind DragTop <KeyRelease-Alt_L>     {DropSite::_update_operation [expr %s & ~8]}
        bind DragTop <KeyRelease-Alt_R>     {DropSite::_update_operation [expr %s & ~8]}
    } else {
        bind DragTop <KeyRelease-Alt_L>     {DropSite::_update_operation [expr %s & ~16]}
        bind DragTop <KeyRelease-Alt_R>     {DropSite::_update_operation [expr %s & ~16]}
    }
}
︙︙
Changes to widget.tcl.
︙︙
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

# Steps for creating a bwidget megawidget:
# 1. parse args to extract subwidget spec
# 2. Create frame with appropriate class and command line options
# 3. Get initialization options from optionDB, using frame
# 4. create subwidgets

# Uses newer string operations
package require Tcl 8.1.1

namespace eval Widget {
    variable _optiontype
    variable _class
    variable _tk_widget

    # This controls whether we try to use themed widgets from Tile








|








52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

# Steps for creating a bwidget megawidget:
# 1. parse args to extract subwidget spec
# 2. Create frame with appropriate class and command line options
# 3. Get initialization options from optionDB, using frame
# 4. create subwidgets

# Uses newer string operations
package require Tcl 8.1.1-

namespace eval Widget {
    variable _optiontype
    variable _class
    variable _tk_widget

    # This controls whether we try to use themed widgets from Tile
︙︙