A Widget Library
Check-in [eefd4f8fba]
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:handle some 8.4 behavior changes
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: eefd4f8fba6ddb9146dbd59d5e9b76f594ea6ed1
User & Date: hobbs 2003-12-03 05:26:16
Context
2005-07-12
23:28
scrub mailto and obvious email refs to hobbs Leaf check-in: 401a955574 user: hobbs tags: trunk
2003-12-03
05:26
handle some 8.4 behavior changes check-in: eefd4f8fba user: hobbs tags: trunk
2003-08-20
21:06
code cleanup check-in: f23e06ca46 user: hobbs tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.







1
2
3
4
5
6
7





2003-08-20  Jeff Hobbs  <[email protected]>

	* library/console.tcl: update mark usage
	* library/balloonhelp.tcl: add canvas item id tooltip support

2001-08-20  Jeff Hobbs  <[email protected]>

>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
2003-12-02  Jeff Hobbs  <[email protected]>

	* library/hierarchy.tcl:
	* library/widget.tcl:
	* library/console.tcl: handle some 8.4 behavior changes

2003-08-20  Jeff Hobbs  <[email protected]>

	* library/console.tcl: update mark usage
	* library/balloonhelp.tcl: add canvas item id tooltip support

2001-08-20  Jeff Hobbs  <[email protected]>

Changes to library/console.tcl.

383
384
385
386
387
388
389












390
391
392
393
394
395
396
;proc _show w { if {[winfo exists $w]} { wm deiconify $w; raise $w } }

}; # end namespace ::Widget::ConsoleDialog

##
## END CONSOLE DIALOG
##













##
## CONSOLE MEGAWIDGET
##

namespace eval ::Widget::Console {;







>
>
>
>
>
>
>
>
>
>
>
>







383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
;proc _show w { if {[winfo exists $w]} { wm deiconify $w; raise $w } }

}; # end namespace ::Widget::ConsoleDialog

##
## END CONSOLE DIALOG
##

# Tk 8.4 makes previously exposed stuff private.
# FIX: Update tkcon to not rely on the private Tk code.
#
if {![llength [info globals tkPriv]]} {
    ::tk::unsupported::ExposePrivateVariable tkPriv
}
foreach cmd {tkTextScrollPages tkTextTranspose tkTextUpDownLine tkTextSetCursor} {
    if {![llength [info commands $cmd]]} {
        ::tk::unsupported::ExposePrivateCommand $cmd
    }
}

##
## CONSOLE MEGAWIDGET
##

namespace eval ::Widget::Console {;

Changes to library/hierarchy.tcl.

246
247
248
249
250
251
252












253
254
255
256
257
258
259
...
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
    uplevel [list hierarchy $w -root "Localhost" \
	    -nodelook  {namespace inscope ::Widget::Hierarchy RegistryLook} \
	    -command   {namespace inscope ::Widget::Hierarchy RegistryAct} \
	    -browsecmd {namespace inscope ::Widget::Hierarchy RegistryList}] \
	    $args
}
}













namespace eval ::Widget::Hierarchy {;

;proc construct w {
    upvar \#0 [namespace current]::$w data

    ## Private variables
................................................................................
		$c create image 0 0 -anchor nw -tags [list img:$np image]
	    }
	    ## Catch just in case the image doesn't exist
	    catch {
		$c itemconfigure img:$np -image $img
		lappend tags $img
		foreach {x y img_width img_height} [$c bbox img:$np] {
		    incr img_width -$x; incr img_height -$y
		}
	    }
	}
	if {[string compare $txt {}]} {
	    if {[string match {} [$c find withtag txt:$np]]} {
		$c create text 0 0 -anchor nw -tags [list txt:$np text]
	    }
	    if {[string match {} $font]} { set font $data(-font) }
	    if {[string match {} $fg]}   { set fg $data(-foreground) }
	    $c itemconfigure txt:$np -fill $fg -text $txt -font $font
	    if {[string compare $np $txt]} { lappend tags $txt }
	    foreach {x y txt_width txt_height} [$c bbox txt:$np] {
		incr txt_width -$x; incr txt_height -$y
	    }
	}
	if {[string match {} [$c find withtag box:$np]]} {
	    $c create rect 0 0 1 1 -tags [list box:$np box] -outline {}
	}
	$c itemconfigure box:$np -tags $tags
	## We only want to go through this once






>
>
>
>
>
>
>
>
>
>
>
>







 







|












|







246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
...
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
    uplevel [list hierarchy $w -root "Localhost" \
	    -nodelook  {namespace inscope ::Widget::Hierarchy RegistryLook} \
	    -command   {namespace inscope ::Widget::Hierarchy RegistryAct} \
	    -browsecmd {namespace inscope ::Widget::Hierarchy RegistryList}] \
	    $args
}
}

# Tk 8.4 makes previously exposed stuff private.
# FIX: Update tkcon to not rely on the private Tk code.
#
if {![llength [info globals tkPriv]]} {
    ::tk::unsupported::ExposePrivateVariable tkPriv
}
foreach cmd {tkCancelRepeat} {
    if {![llength [info commands $cmd]]} {
        ::tk::unsupported::ExposePrivateCommand $cmd
    }
}

namespace eval ::Widget::Hierarchy {;

;proc construct w {
    upvar \#0 [namespace current]::$w data

    ## Private variables
................................................................................
		$c create image 0 0 -anchor nw -tags [list img:$np image]
	    }
	    ## Catch just in case the image doesn't exist
	    catch {
		$c itemconfigure img:$np -image $img
		lappend tags $img
		foreach {x y img_width img_height} [$c bbox img:$np] {
		    incr img_width [expr {-$x}]; incr img_height [expr {-$y}]
		}
	    }
	}
	if {[string compare $txt {}]} {
	    if {[string match {} [$c find withtag txt:$np]]} {
		$c create text 0 0 -anchor nw -tags [list txt:$np text]
	    }
	    if {[string match {} $font]} { set font $data(-font) }
	    if {[string match {} $fg]}   { set fg $data(-foreground) }
	    $c itemconfigure txt:$np -fill $fg -text $txt -font $font
	    if {[string compare $np $txt]} { lappend tags $txt }
	    foreach {x y txt_width txt_height} [$c bbox txt:$np] {
		incr txt_width [expr {-$x}]; incr txt_height [expr {-$y}]
	    }
	}
	if {[string match {} [$c find withtag box:$np]]} {
	    $c create rect 0 0 1 1 -tags [list box:$np box] -outline {}
	}
	$c itemconfigure box:$np -tags $tags
	## We only want to go through this once

Changes to library/widget.tcl.

761
762
763
764
765
766
767

768
769




770
771
772
773
774
775
776
    regexp Key|Focus "[bind $w] [bind [winfo class $w]]"
}

}; #end namespace ::Widget

namespace eval :: {
    namespace import -force ::Widget::widget

    catch {tkFocusOK .}; # we want this auto-loaded
    interp alias {} tkFocusOK {} widget tkFocusOK




}

########################################################################
########################## EXAMPLES ####################################
########################################################################

########################################################################






>
|
|
>
>
>
>







761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
    regexp Key|Focus "[bind $w] [bind [winfo class $w]]"
}

}; #end namespace ::Widget

namespace eval :: {
    namespace import -force ::Widget::widget
    if {$tk_version < 8.4} {
	catch {tkFocusOK .}; # we want this auto-loaded
	interp alias {} tkFocusOK {} widget tkFocusOK
    } else {
	catch {tk::FocusOK .}; # we want this auto-loaded
	interp alias {} tk::FocusOK {} widget tkFocusOK
    }
}

########################################################################
########################## EXAMPLES ####################################
########################################################################

########################################################################