1# ---------------------------------------------------------------------- 2# EXAMPLE: using inheritance to specialize mega-widgets 3# ---------------------------------------------------------------------- 4# COURSE: Object-Oriented Programming with [incr Tcl] 5# AUTHOR: Michael J. McLennan, Bell Labs Innovations 6# ====================================================================== 7# Copyright (c) 1996 Lucent Technologies 8# ====================================================================== 9 10option add *MessageInfo.title "Notice" widgetDefault 11 12class MessageInfo { 13 inherit Info 14 15 constructor {args} { 16 itk_component add message { 17 label $itk_interior.mesg -width 20 18 } { 19 usual 20 rename -text -message message Text 21 } 22 pack $itk_component(message) -expand yes -fill both 23 bind $itk_component(message) <Configure> [code $this resize] 24 25 eval itk_initialize $args 26 } 27 28 private method resize {} { 29 set w [winfo width $itk_component(message)] 30 if {$w > 1} { 31 $itk_component(message) configure -wraplength $w 32 } 33 } 34} 35 36usual MessageInfo { 37 keep -background -cursor -foreground -font 38 keep -activebackground -activeforeground -disabledforeground 39 keep -highlightcolor -highlightthickness 40} 41