Événements, redirections et mégawidgets

 

dc 15/06/08

Pour rediriger/copier un événement vers un autre, ce n'est pas très difficile :

 bind $w1 <1> [list event generate $w2 <1>]

Quand on appuiera sur $w1, on appellera la procédure de callback, du même événement, sur le widget $w2.

 package require Tk

 label .l -text .l
 label .m -text .m

 bind .l <1> [list tk_messageBox -message "appui <1> sur %W"]
 bind .l <3> [list tk_messageBox -message "appui <3> sur %W"]
 bind .m <3> [list event generate .l <3>]

 pack .l .m

Néanmoins, pour rediriger tous les événements d'un widget vers un autre .... ça se complique si on doit traiter tous les événéments un par un. Pour ce faire, on va redéfinir l'ordre d'obéissance du widget avec la commande bindtags. Invoquée seulement avec le nom du widget, voilà le retour :

 % bindtags .m
 .m Label . all

Ainsi, .m appelle d'abord les callbacks des évenements définis pour lui-même, puis pour sa classe, ensuite pour la toplevel et pour tous. On va donc modifier cette liste pour que le widget n'appelle plus les callbacks de ses propres événements mais celles d'un autre avec bindtags .m {.l Label . all} :

 package require Tk

 label .l -text .l
 label .m -text .m

 bind .l <1> [list tk_messageBox -message "appui <1> sur %W"]
 bind .l <3> [list tk_messageBox -message "appui <3> sur %W"]
 bindtags .m {.l Label . all}

 pack .l .m

Cette fois-ci les deux événements sont bien couverts par des procédures pour les deux labels, et luxe, %W identifie bien différemment .l et .m.

Hélas, cette fonctionnalité possède un inconvénient : lors de la création d'un megawidget, on peut avoir envie de créer un bind pour la classe du megawidget :

 package require Tk

 bind Maframe <1> [list changer %W]

 proc changer {w} {
     tk_messageBox -message "argument : $w"
 }

 proc maframe {w} {
     frame $w -class Maframe -bd 0
     label $w.l -text "Texte à adapter"
     pack $w.l
     return $w
 }

 maframe .f
 pack .f

Hélas, dans notre cas, il ne se passe rien : on clique non sur la frame qui donne son nom (chemin) au megawidget mais sur le label, on rajoute donc une redirection du label vers la frame :

 package require Tk

 bind Maframe <1> [list changer %W]

 proc changer {w} {
    tk_messageBox -message "argument : $w"
 }

 proc maframe {w} {
    frame $w -class Maframe -bd 0
    label $w.l -text "Texte à adapter"
    bindtags $w.l [list $w Maframe . all]
    pack $w.l
    return $w
 }

 maframe .f
 pack .f

Cela fonctionne donc à un détail, l'argument est bien le chemin du label : .f.l Ainsi, dans ce cas, l'utilisation de %W devra faire intervenir au début du script de callback :

 if {[winfo class $w] ne "Frame"} {
    set w [winfo parent $w]
 }

qui reviendra bien à .f

 package require Tk

 bind Maframe <1> [list changer %W]

 proc changer {w} {
    if {[winfo class $w] ne "Frame"} {
     set w [winfo parent $w]
    }
    tk_messageBox -message "argument : $w"
 }

 proc maframe {w} {
    frame $w -class Maframe -bd 0
    label $w.l -text "Texte à adapter"
    bindtags $w.l [list $w Maframe . all]
    pack $w.l
    return $w
 }

 maframe .f
 pack .f

Bien entendu, dans le cas de la création d'un megawidget, l'utilisateur final ne pourra pas utiliser %W sous peine d'avoir quelques surprises, par contre il pourra passer directement le nom du widget en argument :

 package require Tk

 bind Maframe <1> [list changer %W]

 proc changer {w} {
    if {[winfo class $w] ne "Frame"} {
     set w [winfo parent $w]
    }
    tk_messageBox -message "argument : $w"
 }

 proc maframe {w} {
    frame $w -class Maframe -bd 0
    label $w.l -text "Texte à adapter"
    bindtags $w.l [list $w Maframe . all]
    pack $w.l
    return $w
 }

 maframe .f
 pack .f

 ## Utilisateur du megawidget
 proc changerUser {w} {
    tk_messageBox -message "argument : $w"
 }

 bind .f <1> [list changerUser .f]

Maintenant peut-être y a-t-il une solution que je ne connais pas pour substituer %W au widget frame automatiquement...