Index: doc/event.n
==================================================================
--- doc/event.n
+++ doc/event.n
@@ -340,10 +340,19 @@
 .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"

Index: generic/tkFont.c
==================================================================
--- generic/tkFont.c
+++ generic/tkFont.c
@@ -895,11 +895,12 @@
 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);
     }
 
     /*
@@ -910,22 +911,29 @@
      * 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));
 }
 
 /*
  *---------------------------------------------------------------------------
  *

Index: generic/tkUtil.c
==================================================================
--- generic/tkUtil.c
+++ generic/tkUtil.c
@@ -1184,10 +1184,11 @@
     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 */

Index: tests/font.test
==================================================================
--- tests/font.test
+++ tests/font.test
@@ -2405,10 +2405,151 @@
     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