Tk Source Code

Changes On Branch bug-3049518
Login
EuroTcl/OpenACS 11 - 12 JULY 2024, VIENNA

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

Changes In Branch bug-3049518 Excluding Merge-Ins

This is equivalent to a diff from 0acc329c to 32e7718b

2021-10-22
04:08
TIP 608 implementation - Add <<TkWorldChanged>> virtual event check-in: ec2e648e user: griffin tags: trunk, main
03:38
TIP 608 implementation - Add <<TkWorldChanged>> virtual event check-in: a297eb00 user: griffin tags: core-8-6-branch
2021-08-27
08:21
Fix erroneous comment (labelframe widgets do exist) Closed-Leaf check-in: 32e7718b user: fvogel tags: bug-3049518
2021-08-15
23:39
Remove unused pixelpower field from XImage. check-in: 6115aeee user: culler tags: core-8-6-branch
2021-08-07
13:15
remove unused pixelpower field from XImage Closed-Leaf check-in: 9dac460b user: culler tags: clean_ximage
2021-08-05
17:47
Correct documentation for this new virtual event. check-in: c50b5aed user: griffin tags: bug-3049518
2021-08-04
21:40
Possible fix for tkticket 3049518 - Generate <<TkWorldChanged>> event. check-in: 1e04d669 user: griffin tags: bug-3049518
2021-07-29
09:04
merge-mark check-in: 0acc329c user: jan.nijtmans tags: core-8-6-branch
2021-07-28
10:39
Don't bother a "make install" on MacOS either. check-in: 0c8ab335 user: jan.nijtmans tags: core-8-5-branch
2021-07-26
09:43
Fix a few places where still old non-wide-API constructs (Win95/98) were used. check-in: a791aeee user: jan.nijtmans tags: core-8-6-branch

Changes to doc/event.n.

338
339
340
341
342
343
344









345
346
347
348
349
350
351
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360







+
+
+
+
+
+
+
+
+







This is sent to a text widget when the selection in the widget is
changed.
.TP
\fB<<ThemeChanged>>\fR
This is sent to all widgets when the ttk theme changed. The ttk
widgets listen to this event and redisplay themselves when it fires.
The legacy widgets ignore this event.
.TP
\fB<<TkWorldChanged>>\fR
.
This event is sent to all widgets when a font is changed, for example,
by the use of [font configure].  The user_data field (%d) will have the
value "FontChanged".  For other system wide changes, this event will
be sent to all widgets, and the user_data field will indicate the
cause of the change.  NOTE: all tk and ttk widgets already handle this
event internally.
.TP
\fB<<TraverseIn>>\fR
This is sent to a widget when the focus enters the widget because of a
user-driven
.QW "tab to widget"
action.
.TP

Changes to generic/tkFont.c.

893
894
895
896
897
898
899

900

901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918




919
920
921
922
923
924
925


926







927
928
929
930
931
932
933
893
894
895
896
897
898
899
900

901
902
903
904
905
906
907
908
909
910
911
912
913
914
915




916
917
918
919
920
921
922
923
924


925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941







+
-
+














-
-
-
-
+
+
+
+





-
-
+
+

+
+
+
+
+
+
+








static void
RecomputeWidgets(
    TkWindow *winPtr)		/* Window to which command is sent. */
{
    Tk_ClassWorldChangedProc *proc =
	    Tk_GetClassProc(winPtr->classProcsPtr, worldChangedProc);
    TkWindow *tkwinPtr;

    
    if (proc != NULL) {
	proc(winPtr->instanceData);
    }

    /*
     * Notify all the descendants of this window that the world has changed.
     *
     * This could be done recursively or iteratively. The recursive version is
     * easier to implement and understand, and typically, windows with a -font
     * option will be leaf nodes in the widget heirarchy (buttons, labels,
     * etc.), so the recursion depth will be shallow.
     *
     * However, the additional overhead of the recursive calls may become a
     * performance problem if typical usage alters such that -font'ed widgets
     * appear high in the heirarchy, causing deep recursion. This could happen
     * with text widgets, or more likely with the (not yet existant) labeled
     * frame widget. With these widgets it is possible, even likely, that a
     * -font'ed widget (text or labeled frame) will not be a leaf node, but
     * appear high in the hierarchy, causing deep recursion. This could happen
     * with text widgets, or more likely with the labelframe
     * widget. With these widgets it is possible, even likely, that a
     * -font'ed widget (text or labelframe) will not be a leaf node, but
     * will instead have many descendants. If this is ever found to cause a
     * performance problem, it may be worth investigating an iterative version
     * of the code below.
     */

    for (winPtr=winPtr->childList ; winPtr!=NULL ; winPtr=winPtr->nextPtr) {
	RecomputeWidgets(winPtr);
    for (tkwinPtr=winPtr->childList ; tkwinPtr!=NULL ; tkwinPtr=tkwinPtr->nextPtr) {
	RecomputeWidgets(tkwinPtr);
    }
    
    /* 
     * Broadcast font change virtually for mega-widget layout managers.
     * Do this after the font change has been propagated to core widgets. 
    */
    TkSendVirtualEvent((Tk_Window)winPtr, "TkWorldChanged",
		       Tcl_NewStringObj("FontChanged",-1));
}

/*
 *---------------------------------------------------------------------------
 *
 * TkCreateNamedFont --
 *

Changes to generic/tkUtil.c.

1182
1183
1184
1185
1186
1187
1188

1189
1190
1191
1192
1193
1194
1195
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196







+







    event.general.xany.type = VirtualEvent;
    event.general.xany.serial = NextRequest(Tk_Display(target));
    event.general.xany.send_event = False;
    event.general.xany.window = Tk_WindowId(target);
    event.general.xany.display = Tk_Display(target);
    event.virt.name = Tk_GetUid(eventName);
    event.virt.user_data = detail;
    if (detail) Tcl_IncrRefCount(detail); // Event code will DecrRefCount

    Tk_QueueWindowEvent(&event.general, TCL_QUEUE_TAIL);
}

/* Tcl 8.6 has a different definition of Tcl_UniChar than other Tcl versions for TCL_UTF_MAX > 3 */
#if TCL_UTF_MAX <= (3 + (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 6))
/*

Changes to tests/font.test.

2403
2404
2405
2406
2407
2408
2409













































































































































2410
2411
2412
2413
2414
2415
2416
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    load {} Tk one
    load {} Tk two
    one eval menu .menubar
    two eval menu .menubar
    interp delete one
    interp delete two
} -result {}

test font-47.2 {Bug 3049518 - Canvas} -body {
    if {"MyFont" ni [font names]} {
	font create MyFont -family "Liberation Sans" -size 13
    }
    set text Hello!
    destroy .t.c
    set c [canvas .t.c]
    set textid [$c create text 20 20 -font MyFont -text $text -anchor nw]
    set twidth [font measure MyFont $text]
    set theight [font metrics MyFont -linespace]
    set circid [$c create polygon \
		    15                    15 \
		    [expr {15 + $twidth}] 15 \
		    [expr {15 + $twidth}] [expr {15 + $theight}] \
		    15                    [expr {15 + $theight}] \
		    -width 1 -joinstyle round -smooth true -fill {} -outline blue]
    pack $c -fill both -expand 1 -side top
    tkwait visibility $c
    
    # Lamda test functions
    set circle_text {{w user_data text circ} {
	if {[winfo class $w] ne "Canvas"} {
	    puts "Wrong widget type: $w"
	    return
	}
	if {$user_data ne "FontChanged"} {
	    return
	}
	lappend ::results called-$w
	lassign [$w bbox $text] x0 y0 x1 y1
	set offset 5
	set coord [lmap expr {
			      $x0-5 $y0-5   $x1+5 $y0-5
			      $x1+5 $y1+5   $x0-5 $y1+5
			  } {expr $expr}]
	if {[catch {$w coord $circ $coord} err]} {
	    puts Error:$err
	}
    }}
    set waitfor {{tag {time 333}} {after $time incr ::wait4; vwait ::wait4}}
    set enclosed {{can id} {$can find enclosed {*}[$can bbox $id]}}

    set results {}
    apply $circle_text $c FontChanged $textid $circid
    bind $c <<TkWorldChanged>> [list apply $circle_text %W %d $textid $circid]
    apply $waitfor 1

    # Begin test:
    set results {}
    lappend results [apply $enclosed $c $circid]
    font configure MyFont -size 26
    apply $waitfor 2
    lappend results [apply $enclosed $c $circid]
    font configure MyFont -size 9
    apply $waitfor 3
    lappend results [apply $enclosed $c $circid]
    apply $waitfor 4
    font configure MyFont -size 12
    apply $waitfor 5
    lappend results [apply $enclosed $c $circid]
} -cleanup {
    destroy $c
    unset -nocomplain ::results
} -result {{1 2} called-.t.c {1 2} called-.t.c {1 2} called-.t.c {1 2}}

test font-47.3 {Bug 3049518 - Label} -body {
    if {"MyFont" ni [font names]} {
	font create MyFont -family "Liberation Sans" -size 13
    }
    set text "Label Test"
    destroy .t.l

    set make-img {{size} {
	set img [image create photo -width $size -height $size]
	$img blank
	set max [expr {$size - 1}]
	for {set x 0} {$x < $size} {incr x} {
	    $img put red -to $x $x
	    $img put black -to 0 $x
	    $img put black -to $x 0
	    $img put black -to $max $x
	    $img put black -to $x $max
	}
	return $img
    }}
    
    set testWorldChanged {{w user_data} {
	global make-img
	if {$user_data ne "FontChanged"} {
	    return
	}
	if {![winfo exists $w] || [winfo class $w] ne "Label"} {
	    return
	}
	if {[$w cget -image] ne ""} {
	    image delete [$w cget -image]
	}
	set size [font metrics [$w cget -font] -linespace]
	set img [apply ${make-img} $size]
	$w configure -image $img
    }}

    set waitfor {{tag {time 500}} {
	after $time incr ::wait4
	vwait ::wait4
    }}

    set check {{w} {
	global results
	set f [$w cget -font]
	set i [$w cget -image]
	set fs [font metrics $f -linespace]
	set ish [image height $i]
	set isw [image width $i]
	lappend results [list [expr {$fs == $ish ? 1 : [list $fs $ish]}] [expr {$fs == $isw ? 1 : [list $fs $isw]}]]
    }}

    set size [font metrics MyFont -linespace]
    set img [apply ${make-img} $size]
    set l [label .t.l -compound left -image $img -text $text -font MyFont]
    pack $l -side top -fill both -expand 1
    bind $l <<TkWorldChanged>> [list apply $testWorldChanged %W %d]
    set ::results {}

    apply $waitfor 0
    apply $check $l
    font configure MyFont -size 26
    apply $waitfor 1
    apply $check $l
    font configure MyFont -size 9
    apply $waitfor 2
    apply $check $l
    font configure MyFont -size 13
    apply $waitfor 3
    apply $check $l
    set results
} -cleanup {
    destroy $l
    unset -nocomplain ::results
} -result {{1 1} {1 1} {1 1} {1 1}}

# cleanup
cleanupTests
return