Bwidget Source Code
Check-in [d4234674be]
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:* buttonbox.tcl (ButtonBox::_redraw) Bug corrected: -uniform gridding option is used if tcl version >= 8.4 (not 8.3). [Patch 2807147] by Koen Danckaert

* tree.tcl (Tree::_drop_cmd) If there is no node, drop didn't work. [Bug 1042613] reported by Rolf Ade

* Tree.html Bind commands: removed promise that %W would work in future. The underlying widgets should only be manipulated using the node id. [Bug 1224203] by Jasper Taylor, remarks by J. Tang

* Tree.html Bind commands: with -selectfill, the given command is overwritten for the background box. [Bug 1003962] by Torsten Berg

* dropsite.tcl (DropSite::register) Bug fixed: fails on multiple drop targets [Bug 1213123] by T.Neil

* combobox.tcl (ComboBox::_create_popup) Bug fixed: Return key in drop down list when -bwlistbox true [Bug 1205536] patch by Steve Landers

* combobox.tcl (ComboBox::_create_popup, ComboBox::_unmapliste) Mac aqua and x11 fixes, multi screen issue still open. [Bug 1451784] report by Jasper Taylor, fix by Kevin Walzer

* listbox.tcl (ListBox::_multiple_select) Selected item not deselected on control-click [Bug 1029144] reported by Konrad Rosenbaum

Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: d4234674bef91abe3b12a28c8cc058cb43116d64
User & Date: oehhar 2009-06-30 16:17:37
Context
2009-07-01
14:41
* mainframe.tcl, MainFrame.html (MainFrame::getmenustate) Added method getmenustate to return menu tag state [Bug 948063] reported by Rolf Ade

* combobox.tcl (ComboBox::configure) Bug fixed: Widget did not take focus, when -editable false and "configure -state normal" called. [Bug 756334] reported by Rolf Ade

* widget.tcl (Widget::configure) Bug: ProgressDlg option -bg not setable. The special handling of subwidgets with special class or path ":cmd" was improved. [Bug 611477]

* notebook.tcl (NoteBook::_itemconfigure) Not honored option: itemconfigure ... -helptext [Patch 2814050] by Koen Danckaert check-in: f39181862b user: oehhar tags: trunk

2009-06-30
16:17
* buttonbox.tcl (ButtonBox::_redraw) Bug corrected: -uniform gridding option is used if tcl version >= 8.4 (not 8.3). [Patch 2807147] by Koen Danckaert

* tree.tcl (Tree::_drop_cmd) If there is no node, drop didn't work. [Bug 1042613] reported by Rolf Ade

* Tree.html Bind commands: removed promise that %W would work in future. The underlying widgets should only be manipulated using the node id. [Bug 1224203] by Jasper Taylor, remarks by J. Tang

* Tree.html Bind commands: with -selectfill, the given command is overwritten for the background box. [Bug 1003962] by Torsten Berg

* dropsite.tcl (DropSite::register) Bug fixed: fails on multiple drop targets [Bug 1213123] by T.Neil

* combobox.tcl (ComboBox::_create_popup) Bug fixed: Return key in drop down list when -bwlistbox true [Bug 1205536] patch by Steve Landers

* combobox.tcl (ComboBox::_create_popup, ComboBox::_unmapliste) Mac aqua and x11 fixes, multi screen issue still open. [Bug 1451784] report by Jasper Taylor, fix by Kevin Walzer

* listbox.tcl (ListBox::_multiple_select) Selected item not deselected on control-click [Bug 1029144] reported by Konrad Rosenbaum check-in: d4234674be user: oehhar tags: trunk

2009-06-29
16:34
* widget.tcl (Widget::init) : fixed a memory leak on wrong option value. [Bug 1230737] check-in: 37c527d396 user: oehhar tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to BWman/Tree.html.

495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
...
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
<DL><DT><A NAME="bindArea"><I>pathName</I> <B>bindArea</B></A>
 <I>event</I>
 <I>script</I>
</DT><DD>

This command associates a command to execute whenever the event
sequence given by <I>event</I> occurs anywhere within the Tree area.

<p>
Any occurrence of <b>%W</b> in script is substituted with the path of
the tree.  <em><a href="#bug">(See note below about this behavior.)</a></em>
</p>

</DD></DL>
<DL><DT><A NAME="bindImage"><I>pathName</I> <B>bindImage</B></A>
 <I>event</I>
 <I>script</I>
</DT><DD>

This command associates a command to execute whenever the event
sequence given by <I>event</I> occurs on the image of a node.
The node idenfier on which the event occurs is appended to the command.

<p>
Any occurrence of <b>%W</b> in script is substituted with the path of
the tree.  <em><a href="#bug">(See note below about this behavior.)</a></em>
</p>

</DD></DL>
<DL><DT><A NAME="bindText"><I>pathName</I> <B>bindText</B></A>
 <I>event</I>
 <I>script</I>
</DT><DD>

This command associates a command to execute whenever the event
sequence given by <I>event</I> occurs on the label of a node.
The node idenfier on which the event occurs is appended to the command.

<p>
Any occurrence of <b>%W</b> in script is substituted with the path of
the tree.  <em><a href="#bug">(See note below about this behavior.)</a></em>
</p>

</DD></DL>
<DL><DT><A NAME="cget"><I>pathName</I> <B>cget</B></A>
 <I>option</I>
</DT><DD>

Returns the current value of the configuration option given by <I>option</I>.
<I>Option</I> may have any of the values accepted by the creation command.
................................................................................
not be generated.
</p>

<p>
The tree has all the standard mouse wheel bindings when it has focus.
</p>

<B><A NAME="bug">CURRENT BUG WITH BINDS</A></B><BR>

<p>
There currently exists a bug with the Tree's <B>bindArea</B>,
<B>bindImage</B>, and <B>bindText</B> commands.  Contrary to the given
text, occurrences of <B>%W</B> within scripts do <em>not</em>
substitute the Tree's path, but rather the Tree's underlying canvas.
A future release of BWidget will fix this error.  For now it is
recommended that you do not use <B>%W</B> within your scripts.
</p>

</BODY></HTML>






<
<
<
<
<
<








|

|
|
<
|
<








|

|
|
<
|
<







 







<
<
<
<
<
<
<
<
<
<
<

495
496
497
498
499
500
501






502
503
504
505
506
507
508
509
510
511
512
513

514

515
516
517
518
519
520
521
522
523
524
525
526

527

528
529
530
531
532
533
534
...
921
922
923
924
925
926
927











928
<DL><DT><A NAME="bindArea"><I>pathName</I> <B>bindArea</B></A>
 <I>event</I>
 <I>script</I>
</DT><DD>

This command associates a command to execute whenever the event
sequence given by <I>event</I> occurs anywhere within the Tree area.






</DD></DL>
<DL><DT><A NAME="bindImage"><I>pathName</I> <B>bindImage</B></A>
 <I>event</I>
 <I>script</I>
</DT><DD>

This command associates a command to execute whenever the event
sequence given by <I>event</I> occurs on the image of a node.
The node idenfier on which the event occurs is appended to the command and may be used to manipulate the tree (e.g. don't use <B>%W</B>).

<P>
If <B>-selectfill</B> is given, an eventual binding of the background box by <B>bindText</B> is overwritten.

</P>

</DD></DL>
<DL><DT><A NAME="bindText"><I>pathName</I> <B>bindText</B></A>
 <I>event</I>
 <I>script</I>
</DT><DD>

This command associates a command to execute whenever the event
sequence given by <I>event</I> occurs on the label of a node.
The node idenfier on which the event occurs is appended to the command and may be used to manipulate the tree (e.g. don't use <B>%W</B>).

<P>
If <B>-selectfill</B> is given, an eventual binding of the background box by <B>bindImage</B> is overwritten.

</P>

</DD></DL>
<DL><DT><A NAME="cget"><I>pathName</I> <B>cget</B></A>
 <I>option</I>
</DT><DD>

Returns the current value of the configuration option given by <I>option</I>.
<I>Option</I> may have any of the values accepted by the creation command.
................................................................................
not be generated.
</p>

<p>
The tree has all the standard mouse wheel bindings when it has focus.
</p>












</BODY></HTML>

Changes to ChangeLog.































1
2
3
4
5
6
7





























2009-06-29 Harald Oehlmann  <[email protected]>

	* ScrolledWindow.html ScrolledWindow documentation changed:
	Documented options: -ipad, -sides, -size, -managed
	[Patch 2807160] Text by Koen Danckaert
	Removed (read only) remark of option -scrollbar.
	
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
2009-06-30 Harald Oehlmann  <[email protected]>

	* buttonbox.tcl (ButtonBox::_redraw) Bug corrected:
	-uniform gridding option is used if tcl version >= 8.4 (not 8.3).
	[Patch 2807147] by Koen Danckaert

	* tree.tcl (Tree::_drop_cmd) If there is no node, drop didn't work.
	[Bug 1042613] reported by Rolf Ade
	
	* Tree.html Bind commands: removed promise that %W would work in future.
	The underlying widgets should only be manipulated using the node id.
	[Bug 1224203] by Jasper Taylor, remarks by J. Tang 

	* Tree.html Bind commands: with -selectfill, the given command is
	overwritten for the background box. [Bug 1003962] by Torsten Berg
	
	* dropsite.tcl (DropSite::register) Bug fixed: fails on multiple drop
	targets [Bug 1213123] by T.Neil

	* combobox.tcl (ComboBox::_create_popup) Bug fixed: Return key in drop
	down list when -bwlistbox true [Bug 1205536] patch by Steve Landers
	
	* combobox.tcl (ComboBox::_create_popup, ComboBox::_unmapliste)
	Mac aqua and x11 fixes, multi screen issue still open.
	[Bug 1451784] report by Jasper Taylor, fix by Kevin Walzer

	* listbox.tcl (ListBox::_multiple_select) Selected item not deselected
	on control-click [Bug 1029144] reported by Konrad Rosenbaum
	

2009-06-29 Harald Oehlmann  <[email protected]>

	* ScrolledWindow.html ScrolledWindow documentation changed:
	Documented options: -ipad, -sides, -size, -managed
	[Patch 2807160] Text by Koen Danckaert
	Removed (read only) remark of option -scrollbar.
	

Changes to buttonbox.tcl.

331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
#  Command ButtonBox::_redraw
# ----------------------------------------------------------------------------
proc ButtonBox::_redraw { path } {
    variable $path
    upvar 0  $path data
    Widget::getVariable $path buttons

    # For tk >= 8.3, -uniform gridding option is used.
    # Otherwise, there is the constraint, that button size may not change after
    # creation.
    set uniformAvailable [expr {0 <= [package vcompare [info patchlevel] 8.3.0]}]

    ## We re-grid the buttons from left-to-right.  As we go through
    ## each button, we check its spacing and which direction the
    ## spacing applies to.  Once spacing has been applied to an index,
    ## it is not changed.  This means spacing takes precedence from
    ## left-to-right.







|


|







331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
#  Command ButtonBox::_redraw
# ----------------------------------------------------------------------------
proc ButtonBox::_redraw { path } {
    variable $path
    upvar 0  $path data
    Widget::getVariable $path buttons

    # For tk >= 8.4, -uniform gridding option is used.
    # Otherwise, there is the constraint, that button size may not change after
    # creation.
    set uniformAvailable [expr {0 <= [package vcompare [info patchlevel] 8.4.0]}]

    ## We re-grid the buttons from left-to-right.  As we go through
    ## each button, we check its spacing and which direction the
    ## spacing applies to.  Once spacing has been applied to an index,
    ## it is not changed.  This means spacing takes precedence from
    ## left-to-right.

Changes to combobox.tcl.

1
2
3
4
5
6
7
8
9
10
11
..
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
...
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463



464
465

466
467
468
469
470
471
472
...
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
...
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
...
619
620
621
622
623
624
625

626

627
628
629
630
631
632
633

634
635


636
637
638
639
640
641
642

643
644
645
646
647
648
649
# ----------------------------------------------------------------------------
#  combobox.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: combobox.tcl,v 1.39 2009/06/25 16:48:52 oehhar Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - ComboBox::create
#     - ComboBox::configure
#     - ComboBox::cget
#     - ComboBox::setvalue
#     - ComboBox::getvalue
................................................................................
    if {[Widget::cget $path -autopost]} {
        ::bind $path.e <KeyRelease> +[list $path _auto_post %K]
    } else {
        ::bind $entry <Key-Up>	  [list ComboBox::_unmapliste $path]
        ::bind $entry <Key-Down>  [list ComboBox::_mapliste $path]
    }

    if {[string equal $::tcl_platform(platform) "unix"]} {
	set ipadx 0
	set width 11
    } else {
	set ipadx 2
	set width 15
    }
    set height [winfo reqheight $entry]
................................................................................
	} elseif { $len > 10 } {
	    set h 10
	} else {
	    set h $len
	}
    }

    if { $::tcl_platform(platform) == "unix" } {
	set sbwidth 11
    } else {
	set sbwidth 15
    }

    toplevel            $shell -relief solid -bd 1
    wm withdraw         $shell
    update idle
    wm overrideredirect $shell 1



    wm transient        $shell [winfo toplevel $path]
    catch { wm attributes $shell -topmost 1 }


    set sw [ScrolledWindow $shell.sw -managed 1 -size $sbwidth -ipad 0]

    if {$bw} {
        set listb  [ListBox $shell.listb \
                -relief flat -borderwidth 0 -highlightthickness 0 \
                -selectmode single -selectfill 1 -autofocus 0 -height $h \
................................................................................
        if {[Widget::cget $path -hottrack]} {
            bindtags $listb [concat [bindtags $listb] ListBoxHotTrack]
        }
    }
    pack $sw -fill both -expand yes
    $sw setwidget $listb

    ::bind $listb <Return> "ComboBox::_select [list $path] \[%W curselection\]"
    ::bind $listb <Escape>   [list ComboBox::_unmapliste $path]
    ::bind $listb <FocusOut> [list ComboBox::_focus_out $path]
}


proc ComboBox::_recreate_popup { path } {
    variable background
................................................................................
	} elseif { $len > 10 } {
	    set h 10
	} else {
	    set h $len
	}
    }

    if { $::tcl_platform(platform) == "unix" } {
	set sbwidth 11
    } else {
	set sbwidth 15
    }

    _create_popup $path

................................................................................

    set width [Widget::cget $path -listboxwidth]
    if {!$width} { set width [winfo width $path] }
    BWidget::place $path.shell $width 0 below $path
    wm deiconify $path.shell
    raise $path.shell
    BWidget::focus set $listb

    BWidget::grab global $path

}


# ----------------------------------------------------------------------------
#  Command ComboBox::_unmapliste
# ----------------------------------------------------------------------------
proc ComboBox::_unmapliste { path {refocus 1} } {

    if {[winfo exists $path.shell] && \
	    [string equal [wm state $path.shell] "normal"]} {


        BWidget::grab release $path
        BWidget::focus release $path.shell.listb $refocus
	# Update now because otherwise [focus -force...] makes the app hang!
	if {$refocus} {
	    update
	    focus -force $path.e
	}

        wm withdraw $path.shell
        ArrowButton::configure $path.a -relief raised
    }
}


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


|







 







|







 







|







<

>
>
>
|
|
>







 







|







 







|







 







>
|
>







>

|
>
>
|
|
|
|
|
|
|
>







1
2
3
4
5
6
7
8
9
10
11
..
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
...
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461

462
463
464
465
466
467
468
469
470
471
472
473
474
475
...
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
...
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
...
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
# ----------------------------------------------------------------------------
#  combobox.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: combobox.tcl,v 1.40 2009/06/30 16:17:37 oehhar Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - ComboBox::create
#     - ComboBox::configure
#     - ComboBox::cget
#     - ComboBox::setvalue
#     - ComboBox::getvalue
................................................................................
    if {[Widget::cget $path -autopost]} {
        ::bind $path.e <KeyRelease> +[list $path _auto_post %K]
    } else {
        ::bind $entry <Key-Up>	  [list ComboBox::_unmapliste $path]
        ::bind $entry <Key-Down>  [list ComboBox::_mapliste $path]
    }

    if {[string equal [tk windowingsystem] "x11"]} {
	set ipadx 0
	set width 11
    } else {
	set ipadx 2
	set width 15
    }
    set height [winfo reqheight $entry]
................................................................................
	} elseif { $len > 10 } {
	    set h 10
	} else {
	    set h $len
	}
    }

    if {[string equal [tk windowingsystem] "x11"]} {
	set sbwidth 11
    } else {
	set sbwidth 15
    }

    toplevel            $shell -relief solid -bd 1
    wm withdraw         $shell

    wm overrideredirect $shell 1
    # these commands cause the combobox to behave strangely on OS X
    if {![string equal [tk windowingsystem] "aqua"]} {
        update idle
        wm transient    $shell [winfo toplevel $path]
        catch { wm attributes $shell -topmost 1 }
    }

    set sw [ScrolledWindow $shell.sw -managed 1 -size $sbwidth -ipad 0]

    if {$bw} {
        set listb  [ListBox $shell.listb \
                -relief flat -borderwidth 0 -highlightthickness 0 \
                -selectmode single -selectfill 1 -autofocus 0 -height $h \
................................................................................
        if {[Widget::cget $path -hottrack]} {
            bindtags $listb [concat [bindtags $listb] ListBoxHotTrack]
        }
    }
    pack $sw -fill both -expand yes
    $sw setwidget $listb

    ::bind $listb <Return> "ComboBox::_select [list $path] \[$listb curselection\]"
    ::bind $listb <Escape>   [list ComboBox::_unmapliste $path]
    ::bind $listb <FocusOut> [list ComboBox::_focus_out $path]
}


proc ComboBox::_recreate_popup { path } {
    variable background
................................................................................
	} elseif { $len > 10 } {
	    set h 10
	} else {
	    set h $len
	}
    }

    if { [string equal [tk windowingsystem] "x11"] } {
	set sbwidth 11
    } else {
	set sbwidth 15
    }

    _create_popup $path

................................................................................

    set width [Widget::cget $path -listboxwidth]
    if {!$width} { set width [winfo width $path] }
    BWidget::place $path.shell $width 0 below $path
    wm deiconify $path.shell
    raise $path.shell
    BWidget::focus set $listb
    if { ! [string equal [tk windowingsystem] "aqua"] } {
        BWidget::grab global $path
    }
}


# ----------------------------------------------------------------------------
#  Command ComboBox::_unmapliste
# ----------------------------------------------------------------------------
proc ComboBox::_unmapliste { path {refocus 1} } {
    # On aqua, state is zoomed, otherwise normal
    if {[winfo exists $path.shell] && \
      ( [string equal [wm state $path.shell] "normal"] ||
	[string equal [wm state $path.shell] "zoomed"] ) } {
        if {![string equal [tk windowingsystem] "aqua"]} {
            BWidget::grab release $path
            BWidget::focus release $path.shell.listb $refocus
            # Update now because otherwise [focus -force...] makes the app hang!
            if {$refocus} {
                update
                focus -force $path.e
            }
        }
        wm withdraw $path.shell
        ArrowButton::configure $path.a -relief raised
    }
}


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

Changes to dropsite.tcl.

1
2
3
4
5
6
7
8
9
10
11
...
146
147
148
149
150
151
152

153
154
155
156
157
158
159
# ------------------------------------------------------------------------------
#  dropsite.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: dropsite.tcl,v 1.7 2003/10/20 21:23:52 damonc Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - DropSite::include
#     - DropSite::setdrop
#     - DropSite::register
#     - DropSite::setcursor
#     - DropSite::setoperation
................................................................................
    set overcmd [Widget::getMegawidgetOption .drop$path -dropovercmd]
    Widget::destroy .drop$path
    if { $dropcmd != "" && $types != "" } {
        set drop(dropcmd) $dropcmd
        set drop(overcmd) $overcmd
        foreach {type ops} $types {
            set drop($type,ops) {}

            foreach {descop lmod} $ops {
                if { ![llength $descop] || [llength $descop] > 3 } {
                    return -code error "invalid operation description \"$descop\""
                }
                foreach {subop baseop imgop} $descop {
                    set subop [string trim $subop]
                    if { ![string length $subop] } {


|







 







>







1
2
3
4
5
6
7
8
9
10
11
...
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
# ------------------------------------------------------------------------------
#  dropsite.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: dropsite.tcl,v 1.8 2009/06/30 16:17:37 oehhar Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - DropSite::include
#     - DropSite::setdrop
#     - DropSite::register
#     - DropSite::setcursor
#     - DropSite::setoperation
................................................................................
    set overcmd [Widget::getMegawidgetOption .drop$path -dropovercmd]
    Widget::destroy .drop$path
    if { $dropcmd != "" && $types != "" } {
        set drop(dropcmd) $dropcmd
        set drop(overcmd) $overcmd
        foreach {type ops} $types {
            set drop($type,ops) {}
            set masklist {}
            foreach {descop lmod} $ops {
                if { ![llength $descop] || [llength $descop] > 3 } {
                    return -code error "invalid operation description \"$descop\""
                }
                foreach {subop baseop imgop} $descop {
                    set subop [string trim $subop]
                    if { ![string length $subop] } {

Changes to listbox.tcl.

1
2
3
4
5
6
7
8
9
10
11
....
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
# ----------------------------------------------------------------------------
#  listbox.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: listbox.tcl,v 1.28 2009/06/26 14:46:05 oehhar Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - ListBox::create
#     - ListBox::configure
#     - ListBox::cget
#     - ListBox::insert
#     - ListBox::itemconfigure
................................................................................
    switch -exact -- $mode {
	n {
	    _mouse_select $path set $idx
	    set data(anchor) $idx
	    set data(sel_anchor) {}
	}
	c {
	    set l [_mouse_select $path get]
	    if { [lsearch -exact $l $idx] >= 0 } {
		_mouse_select $path remove $idx
	    } else {
		_mouse_select $path add $idx
	    }
	    set data(anchor) $idx
	    set data(sel_anchor) {}


|







 







|







1
2
3
4
5
6
7
8
9
10
11
....
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
# ----------------------------------------------------------------------------
#  listbox.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: listbox.tcl,v 1.29 2009/06/30 16:17:37 oehhar Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - ListBox::create
#     - ListBox::configure
#     - ListBox::cget
#     - ListBox::insert
#     - ListBox::itemconfigure
................................................................................
    switch -exact -- $mode {
	n {
	    _mouse_select $path set $idx
	    set data(anchor) $idx
	    set data(sel_anchor) {}
	}
	c {
	    set l [$path selection get]
	    if { [lsearch -exact $l $idx] >= 0 } {
		_mouse_select $path remove $idx
	    } else {
		_mouse_select $path add $idx
	    }
	    set data(anchor) $idx
	    set data(sel_anchor) {}

Changes to tree.tcl.

1
2
3
4
5
6
7
8
9
10
11
....
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
# ----------------------------------------------------------------------------
#  tree.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: tree.tcl,v 1.58 2008/10/31 00:49:33 hobbs Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - Tree::create
#     - Tree::configure
#     - Tree::cget
#     - Tree::insert
#     - Tree::itemconfigure
................................................................................

    $path.c delete drop
    if { [string length $data(dnd,afterid)] } {
        after cancel $data(dnd,afterid)
        set data(dnd,afterid) ""
    }
    set data(dnd,scroll) ""
    if {[llength $data(dnd,node)]
	&& [llength [set cmd [Widget::getoption $path -dropcmd]]]} {
	return [uplevel \#0 $cmd \
		    [list $path $source $data(dnd,node) $op $type $dnddata]]
    }
    return 0
}




|







 







<
|







1
2
3
4
5
6
7
8
9
10
11
....
1596
1597
1598
1599
1600
1601
1602

1603
1604
1605
1606
1607
1608
1609
1610
# ----------------------------------------------------------------------------
#  tree.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: tree.tcl,v 1.59 2009/06/30 16:17:37 oehhar Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - Tree::create
#     - Tree::configure
#     - Tree::cget
#     - Tree::insert
#     - Tree::itemconfigure
................................................................................

    $path.c delete drop
    if { [string length $data(dnd,afterid)] } {
        after cancel $data(dnd,afterid)
        set data(dnd,afterid) ""
    }
    set data(dnd,scroll) ""

    if {[llength [set cmd [Widget::getoption $path -dropcmd]]]} {
	return [uplevel \#0 $cmd \
		    [list $path $source $data(dnd,node) $op $type $dnddata]]
    }
    return 0
}