Bwidget Source Code
Check-in [30642ba1a6]
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:New MultipleScrollableWidgets [Patch-1053086]
Timelines: family | ancestors | patch-1053086
Files: files | file ages | folders
SHA1: 30642ba1a63b43baa5e3de9d659ca0d386fa8f18
User & Date: oehhar 2013-06-21 18:05:51
Context
2013-06-21
18:05
New MultipleScrollableWidgets [Patch-1053086] Leaf check-in: 30642ba1a6 user: oehhar tags: patch-1053086
17:52
Add combobox method getentry to get path of entry component [Patch-2340355] check-in: 38c05dab1f user: oehhar tags: bwidget
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.

13
14
15
16
17
18
19



20
21
22
23
24
25
26
	
	* init.tcl: Make loadable in save interpreter.
	Fix by K.J.Nash [Bug-4365a23bd3]

	* combobox.tcl: Add method getentry to return entry
	widget path for bind purposes.
	Patch by Michael [Patch-2340355]



	
2013-01-09 Harald Oehlmann <[email protected]>

	* widget.tcl: Bug fixed:
	Error 'invalid command name ".#BWidget.#ttk::entry"'
	arises in themed mode when an Entry widget should get
	focus by the tab key.






>
>
>







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
	
	* init.tcl: Make loadable in save interpreter.
	Fix by K.J.Nash [Bug-4365a23bd3]

	* combobox.tcl: Add method getentry to return entry
	widget path for bind purposes.
	Patch by Michael [Patch-2340355]
	
	* mscrollw.tcl: New MultipleScrollableWidgets
	Patch by Georgios Petasis [Patch-1053086]
	
2013-01-09 Harald Oehlmann <[email protected]>

	* widget.tcl: Bug fixed:
	Error 'invalid command name ".#BWidget.#ttk::entry"'
	arises in themed mode when an Entry widget should get
	focus by the tab key.

Added mscrollw.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
27
28
29
30
31
32
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
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
# -----------------------------------------------------------------------------
#  mscrollw.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: scrollw.tcl,v 1.11 2004/02/04 00:11:29 hobbs Exp $
# -----------------------------------------------------------------------------
#  Index of commands:
#     - MultipleScrollableWidgets::create
#     - MultipleScrollableWidgets::getframe
#     - MultipleScrollableWidgets::addwidget
#     - MultipleScrollableWidgets::removewidget
#     - MultipleScrollableWidgets::configure
#     - MultipleScrollableWidgets::cget
#     - MultipleScrollableWidgets::xview
#     - MultipleScrollableWidgets::yview
#     - MultipleScrollableWidgets::xscrollcommand
#     - MultipleScrollableWidgets::yscrollcommand
# -----------------------------------------------------------------------------

namespace eval MultipleScrollableWidgets {
    Widget::define MultipleScrollableWidgets mscrollw

    namespace eval ScrollableWidget {
        Widget::declare MultipleScrollableWidgets::ScrollableWidget {
            {-scroll Enum both 0 {none both vertical horizontal}}
        }
    }

    Widget::declare MultipleScrollableWidgets {
	{-background  TkResource ""   0 button}
	{-relief      TkResource flat 0 frame}
	{-borderwidth TkResource 0    0 frame}
        {-xscrollcommand    TkResource "" 0 canvas}
        {-yscrollcommand    TkResource "" 0 canvas}
	{-bg	      Synonym	 -background}
	{-bd	      Synonym	 -borderwidth}
    }

    Widget::addmap MultipleScrollableWidgets "" :cmd {-relief {} -borderwidth {}}
}


# -----------------------------------------------------------------------------
#  Command MultipleScrollableWidgets::create
# -----------------------------------------------------------------------------
proc MultipleScrollableWidgets::create { path args } {
    Widget::init MultipleScrollableWidgets $path $args

    Widget::getVariable $path data

    set data(widgets) {}

    set bg     [Widget::cget $path -background]
    set sw     [eval [list frame $path \
			  -relief flat -borderwidth 0 -background $bg \
			  -highlightthickness 0 -takefocus 0] \
		    [Widget::subcget $path :cmd]]

    #bind $path <Configure> [list MultipleScrollableWidgets::_realize $path]
    #bind $path <Destroy>   [list MultipleScrollableWidgets::_destroy $path]

    return [Widget::create MultipleScrollableWidgets $path]
}


# -----------------------------------------------------------------------------
#  Command MultipleScrollableWidgets::getframe
# -----------------------------------------------------------------------------
proc MultipleScrollableWidgets::getframe { path } {
    return $path
}


# -----------------------------------------------------------------------------
#  Command MultipleScrollableWidgets::addwidget
# -----------------------------------------------------------------------------
proc MultipleScrollableWidgets::addwidget { path widget args } {
    Widget::init MultipleScrollableWidgets::ScrollableWidget $widget $args
    Widget::getVariable $path data
    lappend data(widgets) $widget
    set scroll [Widget::getoption $widget -scroll]
    switch -exact -- $scroll {
      both {
        set data($widget:x) 1; set data($widget:y) 1
        $widget configure \
            -xscrollcommand \
                [list MultipleScrollableWidgets::xscrollcommand $path $widget] \
            -yscrollcommand \
                [list MultipleScrollableWidgets::yscrollcommand $path $widget]
      }
      vertical {
        set data($widget:x) 0; set data($widget:y) 1
        $widget configure \
            -yscrollcommand \
                [list MultipleScrollableWidgets::yscrollcommand $path $widget]
      }
      horizontal {
        set data($widget:x) 1; set data($widget:y) 0
        $widget configure \
            -xscrollcommand \
                [list MultipleScrollableWidgets::xscrollcommand $path $widget]
      }
      default {set data($widget:x) 0; set data($widget:y) 0}
    }
}

# -----------------------------------------------------------------------------
#  Command MultipleScrollableWidgets::removewidget
# -----------------------------------------------------------------------------
proc MultipleScrollableWidgets::removewidget { path widget } {
    Widget::getVariable $path data
    set index [lsearch -exact $data(widgets) $widget]
    if {$index == -1} {
      error "widget \"$widget\" is not contained in widget \"$path\"!"
    } else {
      set data(widgets) [lreplace $data(widgets) $index $index]
      if {$data($widget:x)} {
        $widget configure -xscrollcommand {}
      }
      if {$data($widget:y)} {
        $widget configure -yscrollcommand {}
      }
      array unset data $widget:* 
      Widget::destroy $widget
    }
}


# -----------------------------------------------------------------------------
#  Command MultipleScrollableWidgets::configure
# -----------------------------------------------------------------------------
proc MultipleScrollableWidgets::configure { path args } {
    Widget::getVariable $path data

    set res [Widget::configure $path $args]
    if { [Widget::hasChanged $path -background bg] } {
	$path configure -background $bg
    }
    return $res
}


# -----------------------------------------------------------------------------
#  Command MultipleScrollableWidgets::cget
# -----------------------------------------------------------------------------
proc MultipleScrollableWidgets::cget { path option } {
    return [Widget::cget $path $option]
}


# ----------------------------------------------------------------------------
#  Command MultipleScrollableWidgets::xview
# ----------------------------------------------------------------------------
proc MultipleScrollableWidgets::xview { path args } {
    #puts "xview '$path' '$args'"
    set result {}
    Widget::getVariable $path data
    foreach widget $data(widgets) {
      set result [eval [list $widget xview] $args]
    }
    return $result
}


# ----------------------------------------------------------------------------
#  Command MultipleScrollableWidgets::yview
# ----------------------------------------------------------------------------
proc MultipleScrollableWidgets::yview { path args } {
    #puts "yview '$path' '$args'"
    set result {}
    Widget::getVariable $path data
    foreach widget $data(widgets) {
      set result [eval [list $widget yview] $args]
    }
    return $result
}


# ----------------------------------------------------------------------------
#  Command MultipleScrollableWidgets::xscrollcommand
# ----------------------------------------------------------------------------
proc MultipleScrollableWidgets::xscrollcommand { path widget args } {
    #puts "xscrollcommand '$path' '$widget' '$args'"
    set cmd [Widget::cget $path -xscrollcommand]
    if {[string length $cmd]} {
      return [eval $cmd $args]
    }
}


# ----------------------------------------------------------------------------
#  Command MultipleScrollableWidgets::yscrollcommand
# ----------------------------------------------------------------------------
proc MultipleScrollableWidgets::yscrollcommand { path widget args } {
    #puts "yscrollcommand '$path' '$widget' '$args'"
    set cmd [Widget::cget $path -yscrollcommand]
    if {[string length $cmd]} {
      return [eval $cmd $args]
    }
}

Changes to pkgIndex.tcl.

32
33
34
35
36
37
38

39
40
41
42
43
44
45
46
{tree.tcl source {Tree Tree::create Tree::use}}
{color.tcl source {SelectColor SelectColor::menu SelectColor::dialog SelectColor::setcolor}}
{dynhelp.tcl source {DynamicHelp::configure DynamicHelp::use DynamicHelp::register DynamicHelp::include DynamicHelp::add DynamicHelp::delete}}
{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}}
{wizard.tcl source {Wizard Wizard::create Wizard::use SimpleWizard ClassicWizard}}

{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]]; \
"






>








32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
{tree.tcl source {Tree Tree::create Tree::use}}
{color.tcl source {SelectColor SelectColor::menu SelectColor::dialog SelectColor::setcolor}}
{dynhelp.tcl source {DynamicHelp::configure DynamicHelp::use DynamicHelp::register DynamicHelp::include DynamicHelp::add DynamicHelp::delete}}
{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}}
{wizard.tcl source {Wizard Wizard::create Wizard::use SimpleWizard ClassicWizard}}
{mscrollw.tcl source {MultipleScrollableWidgets MultipleScrollableWidgets::create MultipleScrollableWidgets::use}}
{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]]; \
"