voir TTC : sauvegarder les tags et les images avec le texte d'un widget text
dMc : j'écris TouTanKamon sans avoir la moindre idée de ce que à quoi ça pourrait bien servir. TouTanKamon est un éditeur de texte .ttc qui n'a pas d'autre utilité que de servir de base à une exploration de l'idée de format TTC, format dont je n'ai pas la moindre idée de ce que à quoi ça pourrait bien servir.
J'avais vaguement le projet de pouvoir transformer un fichier .ttc au format xml. Je ne sais pas si c'est faisable, en tout cas le html est exclu, car ne supportant pas le croisement des balises, contrairement aux tags de Tk.
Toutankamon évolue plus vite que la rubrique d'aide, et même que les commentaires sur cette page, mais c'est TTC qu compte, pas Toutankamon!
Tous les widgets ne sont peut-être pas encore complètement supportés pour leur configuration, seuls les button, checkbutton, entry et bien sur text et canvas bénéficient d'une boite de configuration. Essentiellement, ce n'est qu'une question de copier-coller à effectuer.
Des fonctions rudimentaires de dessin sont disponibles, mais répétons-le, il ne s'agit que de pouvoir créer des objets de dessins et des widgets afin de tester le code TTC.
TouTanKamon sait affecter quelques tags à un texte, y inclure une image et tous les widgets supportés par text.
Certains de ces widgets, possèdent une boite rudimentaire de paramétrage. C'est programmable sans difficultés pour les autres, ce n'est pas encore fait, c'est tout.
Mais encore TouTanKamon sait sauvegarder le contenu d'un text dans un fichier texte selon le format TTC. Ce format sauvegarde les widgets avec leurs variable associée, et les text embarqués avec leur contenu, et ce indépendamment du niveau d'embarquement. C'est à dire qu'un text peut être inscrit dans un autre, lui même dans un autre, dans un autre ... et son contenu sera réaffiché par TouTanKamon, mais encore par n'importe quel programme (voir TtcReader) qui incorpore les commandes relatives à TTC dans son code.
Les touches F1 et F2, quand un text est actif, permet d'afficher le texte TTC et de le réafficher. Pour insérer un widget dans un text inclus dans un autre text, il suffit de le rendre ce dernier actif par un clic gauche, et d'appeler par un clic droit dans ce text le menu pop-up des widgets. la procédure est similaire pour inclure un widget dans un canvas. Inclure une photo se fait par le bouton photo. Les boites de configuration des widgets sont éditables, et refermables par un clic droit.
Toutankamon : le code avec tous ses défauts de développement...
#!/bin/bash
# lancement de l'interpréteur wish\
exec tclsh "$0" "${1+"$@"}"
# toutankamon
# editeur de texte en tcl tk
# sauvegardant le texte au formatTTC
#_____________________________________________
#
# TOUTANKAMON 23 mai 2006
#_____________________________________________
#------------------------------------------------------------------------------------------
# Ce programme est un logiciel libre :
# vous pouvez le redistribuer et/ou le modifier
# licence NOL : pas d'Obligations, ni pour vous ni pour moi.
# Ce programme est distribué dans l'espoir qu'il sera utile,
# mais SANS AUCUNE GARANTIE ;
# sans même la garantie implicite de COMMERCIALISATION ou
# D'ADAPTATION A UN OBJET PARTICULIER.
#-------------------------------------------------------------------------------------------
# la ligne suivante (package require Tk) sert à tester l'évaluation avec Tclsh
#... sinon Toutankamon ne fonctionne pas :
package require Tk
#£ source TTC.tcl
set Chemin(abs) [pwd]
set NomScript [info script]
set Chemin(rel) [file dirname $NomScript]
set version 3_1
global widtexte
set widtexte .f2.t
variable fenobjet
variable fonte ""
variable application toutankamon
#variable définie pour le développement :
variable ttcFile C:/a_toutankamon/truc.txt
#_____________________________________
#<interface>
#<barre_commandes>
frame .f -background LimeGreen
pack .f -side top -fill x
# ce menu ''.menuTagsCleaner'' correspond au bouton de nettoyage des tags
menu .menuTagsCleaner
pack [button .f.bLoad -text "Ouvrir " -command "ouvrirTTC "] -side left
pack [button .f.bSave -text "Sauvegarder" -command "sauverFichierTTC $widtexte"] -side left
pack [button .f.bUndo -text "Undo" -command "defaire $widtexte"] -side left
pack [button .f.bRedo -text "Redo" -command "refaire $widtexte" ] -side left
pack [button .f.bSelectAll -text "Selectionner tout" -command "selectAll $widtexte" ] -side left
pack [label .f.textActif -bg white -relief sunken -borderwidth 5] -side left
pack [button .f.bBg -text "BG color" -command "tagBgColor $widtexte"] -side left
pack [button .f.bFg -text "FG color" -command "tagFgColor $widtexte"] -side left
pack [button .f.bFont -text "Fonte" -command "choixFonte $widtexte "] -side left
pack [button .f.bPhoto -text "Photo" -command "insertPhoto $widtexte"] -side left
pack [menubutton .f.mWidget -text "Widget" -menu .f.mWidget.menuWidgets -relief raise] -side left
pack [menubutton .f.mDraw -text "Draw" -menu .f.mDraw.menuCanvas -relief raise] -side left
#<menus>
# ce menu ''.f.mWidget.menuWidgets'' correspond au bouton d'insertion des widgets
menu .f.mWidget.menuWidgets
set lw [list button checkbutton canvas entry frame label listbox menubutton message radiobutton scale scrollbar spinbox text ]
foreach item $lw {
.f.mWidget.menuWidgets add command -label $item -command "insertWidget $item"
}
# ce menu permet d'insérer des objets dans un canvas
menu .f.mDraw.menuCanvas
set lw [list line rectangle polygone oval arc text bitmap image ]
foreach item $lw {
.f.mDraw.menuCanvas add command -label $item -command "configDraw $item"
}
pack [button .f.bCleanTags -text "Nettoyer" -foreground red -command "cleanDeadTags $widtexte"] -side left
pack [button .f.bAide -text "Aide" -background yellow -command {ttkaide } ] -side left
#<Fenetre_texte>
frame .f2 -background LimeGreen
pack .f2 -side bottom -fill both -expand true
scrollbar .f2.x -orient horizontal -command {.f2.t xview}
pack .f2.x -fill x -side bottom
text .f2.t -undo 1 -xscrollcommand {.f2.x set } -yscrollcommand {.f2.y set } -wrap none
pack .f2.t -side left -fill both -expand true
scrollbar .f2.y -orient vertical -command {.f2.t yview }
pack .f2.y -fill y -side left
#<bind>
pack [label .f.lBind -text "F1 aff ttc \n F2 réaffiche le texte" -background green ] -side left
pack [label .f.lBind2 -text "clic gauche sélectionne text \nclic droit ouvre menu insertion" -background orange ] -side left
bind $widtexte <F1> {
set dumpie [dumptags %W]\n[dumpwindows %W]\n[%W dump 1.0 end]
%W delete 1.0 end
%W insert end $dumpie
}
bind $widtexte <F2> {
set content [%W get 1.0 end-13char]
%W delete 1.0 end
undump %W $content
set niveaux [list %W ]
allWidgetsKnowed $niveaux ; # pour faire la liste de tous les widgets dans tous les widgets, puis insérer un bind pour chaque widget pour pouvoir le rééditer.
}
#<Escape>
bind $widtexte <Escape> {escapePermute $widtexte}
#<Control+A>
bind $widtexte <Control-a> { selectAll $widtexte}
bind $widtexte <Control-A> { selectAll $widtexte}
bind $widtexte <Control-w> { selectAll $widtexte}
bind $widtexte <Control-W> { selectAll $widtexte}
bind $widtexte <1> {set widtexte %W ; .f.textActif configure -text "texte actif : $widtexte" -fg red}
bind $widtexte <3> { tk_messageBox -message "insertion de widget dans : $widtexte" ;tk_popup .f.mWidget.menuWidgets 25 50}
bind $widtexte <2> {tk_popup .f.mDraw.menuCanvas 25 50 }
bind $widtexte <Control-3> {tk_popup .f.mDraw.menuCanvas 25 50 }#<fin_interface>
#---------------------------------------------------------
proc ttkaide {} {
destroy .aide
toplevel .aide
text .aide.t -bg pink -yscrollcommand {.aide.y set} -xscrollcommand {.aide.x set} -wrap word -font {helvetica 12}
scrollbar .aide.x -command {.aide.t xview} -orient h
scrollbar .aide.y -command {.aide.t yview} -orient v
pack .aide.x -side bottom -fill x
pack .aide.t -side left -fill both -expand true
pack .aide.y -side left -fill y
set textAide "AIDE TOUTANKAMON
Ce programme est développé non pour servir réellement, mais pour expérimenter et explorer les possibilités du format .ttc, et tendre vers une formalisation de sauvegarde la plus générale possible.
L'ergonomie n'est donc ni son fort ni son but. Les fonctions importantes sont essentiellement ''sauvegarder'' et '' ouvrir'', le reste, comme disait Goulebenèze, c'est de l'habillage.Toutankamon est néanmoins un éditeur de texte, sa fenêtre principale permet donc d'y écrire, mais aussi
* d'y incorporer des images
* d'y incorporer des zones de dessin et d'y tracer des figures vectorielles
* d'y incorporer les widgets classiques disponibles en tcl/tk
* d'y définir des balises de formatage du texte
Vous pouvez modifier la couleur de fond, et la couleur de premier plan, de la partie que vous sélectionnez au curseur.
De la même manière vous pouvez modifier la police, ainsi que la graisse et l'inclinaison, de la partie sélectionnée.
Le bouton ''nettoyer'' ouvre un menu où sont listés les tags et leurs indices.
En cliquant sur un item, le tag est désactivé pour la partie de texte sélectionnée.
En revanche il reste affecté aux zones extérieures à la sélection.
Pour les images, elles doivent se trouver au même niveau que le fichierTTC pour pouvoir être réaffichées après sauvegarde.
F1 et F2 permettent de voir le mode de sauvegarde et de réafficher le texte formaté.
Il faut avoir sauvegardé le fichier pour que la commande F2 reconnaisse le chemin de l'image sauvegardée au niveau du fichier TTC.
Les widgets sont reconnus par TTC,
Mais il faut être attentif à ce que l'option ''-command'' contienne des procédures ayant un sens dans le contexte d'un fenobjet ''text''.
La touche ''escape'' permute les deux caractères précédant le curseur.
Les fonctions ''Undo'' et ''Redo'' ne gèrent que le texte, ni les tags ni les images :
un tag ou une image ou un widget supprimé ne sera pas magiquement réaffiché par ''Undo''.
Un clic gauche dans un ''text'' ou un ''canvas'' sélectionne l'objet pour y insérer un nouvel objet.
Un clic droit ouvre un menu pop-up permettant de choisir un widget à inclure dans l'objet activé par un clic gauche, il s'agit d'un équivalent du bouton ''widget'' de la barre des menus.
Un clic central , ou clic gauche + clic droit ensemble, ouvre le menu pop-up pour insérer un objet dessin dans un ''canvas'' s'il y en a un de sélectionné auparavant par un clic gauche.
"
.aide.t insert end $textAide
}
#<procedures_toutankamon_editor>
proc ouvrirTTC {} {
global widtexte
set widtexte .f2.t
destroy $widtexte
text $widtexte -xscrollcommand {.f2.x set } -yscrollcommand { .f2.y set }
pack $widtexte -side left -before .f2.y -fill both -expand true
bind $widtexte <1> {set widtexte %W ; .f.textActif configure -text "texte actif : $widtexte" -fg red}
bind $widtexte <3> { tk_messageBox -message "insertion de widget dans : $widtexte" ;tk_popup .f.mWidget.menuWidgets 25 50}
bind $widtexte <2> {tk_popup .f.mDraw.menuCanvas 25 50 }
bind $widtexte <Control-3> {tk_popup .f.mDraw.menuCanvas 25 50 }
bind $widtexte <F1> {
set dumpie [dumptags %W]\n[dumpwindows %W]\n[%W dump 1.0 end]
%W delete 1.0 end
%W insert end $dumpie
}
bind $widtexte <F2> {
set content [%W get 1.0 end-13char]
%W delete 1.0 end
undump %W $content
set niveaux [list $widtexte ]
# faire la liste de tous les widgets dans tous les widgets, puis insérer un bind pour chaque widget pour pouvoir le rééditer.
allWidgetsKnowed $niveaux
}
loadTTCfile $widtexte
set listeWindows [list $widtexte]
allWidgetsKnowed $listeWindows
}
proc allWidgetsKnowed {listEmbeded} {
global widtexte
foreach {wg} $listEmbeded {
set mm [winfo children $wg]
foreach wwg $mm {
if { [string compare [winfo class $wwg ] Text] == 0 } {
bind $wwg <1> { global widtexte; set widtexte %W ;.f.textActif configure -text "texte actif : $widtexte" -fg red}
bind $wwg <3> { global widtexte ; tk_messageBox -message "insertion de widget dans : $widtexte" ;tk_popup .f.mWidget.menuWidgets 25 50}
bind $wwg <2> {tk_popup .f.mDraw.menuCanvas 25 50 }
bind $wwg <Control-3> {tk_popup .f.mDraw.menuCanvas 25 50 }
allWidgetsKnowed $mm
}
if { [string compare [winfo class $wwg ] Canvas] == 0 } {
bind $wwg <1> { global widtexte; set widtexte %W ;.f.textActif configure -text "canvas actif : $widtexte" -fg red}
bind $wwg <3> { global widtexte ; tk_messageBox -message "insertion de widget dans : $widtexte" ;tk_popup .f.mWidget.menuWidgets 25 50}
bind $wwg <2> {tk_popup .f.mDraw.menuCanvas 25 50 }
bind $wwg <Control-3> {tk_popup .f.mDraw.menuCanvas 25 50 }
allWidgetsKnowed $mm
}
}
}
}
proc sauverFichierTTC w {
#appel de la procédure générale de sauvegarde en .TTC
saveTagsAndText $w
}
#après réaffichage de ttc, il faut pouvoir assurer l'addition de nouvelles balises sans confusion de nom :
# ceci est obtenu dans toutankamon par le modèle ci-dessous :
# proc tagNouveauTag w {
# set i 0
# while {[lsearch [$w tag names ] ($i)NouveauTag ] != -1} {
# incr i
# }
# $w tag configure ($i)NouveauTag -options?
# $w tag add ($i)NouveauTag index? index?
# }
# le nom du nouveau tag commence par un numéro entre parenthèses
# toutankamon vérifie alors que ce nom avec ce numéro en préfixe n'existe pas avant de l'attribuer au nouveau tag
# la variable i est incrémentée jusqu'à ce qu'il n'y ait plus de balise portant ce nom et ce numéro.
proc tagBgColor w {
global widtexte
set w $widtexte
set possel [$w tag nextrange sel 1.0]
if {[string compare $possel 1.0] == -1 } {tk_messageBox -message "
Sélectionnez une portion de texte!
Select a part of the text contents! " ;
} else {
set i 0
while {[lsearch [$w tag names ] ($i)bg ] != -1} {
incr i
}
$w tag configure ($i)bg -background [tk_chooseColor ]
$w tag add ($i)bg [lindex $possel 0] [lindex $possel 1]
}
}
proc tagFgColor w {
global widtexte
set w $widtexte
set possel [$w tag nextrange sel 1.0]
if {[string compare $possel 1.0] == -1 } {tk_messageBox -message "
Sélectionnez une portion de texte!
Select a part of text contents." ;
} else {
set i 0
while {[lsearch [$w tag names ] ($i)bg ] != -1} {
incr i
}
$w tag configure ($i)fg -foreground [tk_chooseColor ]
$w tag add ($i)fg [lindex $possel 0] [lindex $possel 1]
}
}
proc insertPhoto w {
global widtexte
variable ttcFile
set w $widtexte
set imagePath [tk_getOpenFile]
set imageName [file tail $imagePath]
set imgNouveau [image create photo -file $imagePath]
if {[string compare [winfo class $widtexte] Canvas ] ==0} {
set id [ $w create image 0 0 -image $imgNouveau ]
configDrawWidget $id image $imgNouveau
} else {
$w image create insert -image $imgNouveau -name $imageName}
}
proc tagFonte w {
global widtexte
set w $widtexte
variable fonte
set possel [$w tag nextrange sel 1.0]
if {[string compare $possel 1.0] == -1 } {tk_messageBox -message "
Sélectionnez une portion de texte!
Select a part of text contents." ;
} else {
set i 0
while {[lsearch [$w tag names ] ($i)Fonte ] != -1} {
incr i
}
$w tag configure ($i)Fonte -font $fonte
$w tag add ($i)Fonte [lindex $possel 0] [lindex $possel 1]
}
}
proc choixFonte {w} {
global widtexte
set w $widtexte
set possel [$w tag nextrange sel 1.0]
if {[string compare $possel 1.0] == -1 } {tk_messageBox -message "
Sélectionnez une portion de texte!
Select a part of text contents." ;
} else {
set police helvetica
set taillePolice 12
set boldie normal
set italicie roman
global widtexte
variable fonte ""
destroy .fonte
toplevel .fonte
wm title .fonte "FONTE "
wm resizable .fonte false false
frame .fonte.f -relief raised
frame .fonte.f.ico -bg SteelBlue
pack .fonte.f -expand false -fill y
pack .fonte.f.ico -fill x
button .fonte.f.ico.plus -text "+" -command { incr taillePolice ; .fonte.f.tp configure -font "[list $police] $taillePolice " } -font {-size 12}
button .fonte.f.ico.moins -text "-" -command { incr taillePolice -1; .fonte.f.tp configure -font "[list $police] $taillePolice " } -font {-size 12}
spinbox .fonte.f.ico.nomFonte -text "nom de fonte" -relief raised -bd 3 -values [font families]\
-textvariable police -command {.fonte.f.tp configure -font "[list $police] $taillePolice "} -font {-size 12}
button .fonte.f.ico.okP -text valider -command { set fonte "[list $police] $taillePolice $boldie $italicie" ; tagFonte $widtexte; destroy .fonte} -font {-size 12} -fg red -bg SteelBlue -relief raise
label .fonte.f.ico.lP -text POLICE -relief flat -bd 0 -bg SteelBlue -fg yellow -font {-size 12}
spinbox .fonte.f.ico.sp -text police -relief raised -bd 3 -width 3 -from 6 -to 30 -incr 2 -textvariable taillePolice -command {.fonte.f.tp configure -font "[list $police] $taillePolice "}
label .fonte.f.ico.l -text CorpsFonte -relief flat -bd 0 -bg SteelBlue -fg yellow -font {-size 12}
pack .fonte.f.ico.l .fonte.f.ico.plus .fonte.f.ico.moins .fonte.f.ico.sp .fonte.f.ico.lP .fonte.f.ico.nomFonte -side left -fill y
radiobutton .fonte.f.ico.boldo1 -text bold -variable boldie -value bold
radiobutton .fonte.f.ico.boldo2 -text normal -variable boldie -value normal
radiobutton .fonte.f.ico.italico1 -text italic -variable italicie -value italic
radiobutton .fonte.f.ico.italico2 -text roman -variable italicie -value roman
pack .fonte.f.ico.boldo1 .fonte.f.ico.boldo2 .fonte.f.ico.italico1 .fonte.f.ico.italico2 .fonte.f.ico.okP -side left -fill y
text .fonte.f.tp -bg AntiqueWhite -font [list $police] -relief sunken -wrap char -height 5 -width 15
pack .fonte.f.tp -fill both -expand 1
.fonte.f.tp insert end "Ceci est un texte pour essayer les fontes \nabcdefghijklmnopqrstuvwyz\nABCDEFGHIJKLMNOPQRSTUVWXYZ"
.fonte.f.ico.nomFonte delete 0 end
.fonte.f.ico.nomFonte insert end "[ list [lindex [$widtexte cget -font] 0 ] ]"
.fonte.f.ico.sp delete 0 end
.fonte.f.ico.sp insert end "[lindex [$widtexte cget -font] 1]"
bind .fonte <3> { destroy .fonte }
}
}
proc cleanDeadTags w {
global widtexte
set w $widtexte
.menuTagsCleaner delete 1 end
set possel [$w tag nextrange sel 1.0]
if {[string compare $possel 1.0] == -1 } {tk_messageBox -message "
Sélectionnez une portion de texte!
Select a part of the text contents" ;
} else {
set dumpie [$w dump -tag 1.0 end]
foreach {tagon tagName pos} $dumpie {
.menuTagsCleaner add command -label "$tagon $tagName $pos" -command ".t tag remove $tagName [lindex $possel 0] [lindex $possel 1 ];.menuTagsCleaner delete 1 end"
}
}
.menuTagsCleaner add command -label "supprimer tous les tags | delete all tags" -command "deleteAllTags $w"
tk_popup .menuTagsCleaner 333 222
}
proc deleteAllTags w {
global widtexte
set w $widtexte
set allTags [$w tag names]
foreach element $allTags {
$w tag delete $element
}
.menuTagsCleaner delete 1 end
}
proc escapePermute {w} {
global widtexte
set w $widtexte
set dernier [$w get "insert -1 char"]
$w delete [$w index "insert -1 char"]
$w insert [$w index "insert -1 char"] $dernier
}
proc defaire { w } {
catch {$w edit undo}
}
proc refaire { w } {
global widtexte
set w $widtexte
catch {$w edit redo}
}
proc selectAll { w } {
global widtexte
set w $widtexte
$w tag add sel 1.0 end
}
#<procs_widgets>
# la proc "insertWidget" est appelée par l'interface
# parl'action siur le bouton "widget"
# w correspond au "text" où on désire insérer un widget de nature "wdgt" (button, entry ...)
# La proc recherche si un widget portant en fin de nom un numéro,
# et poursuit la recherche (incr i) jusqu'à ce qu'elle puisse accorder un numéro inutilisé en suffixe.
# on est certain ainsi que le nouveau widget porte un nom inutilisé.
proc insertWidget { wdgt} {
global widtexte
set i 0
while {[lsearch [ winfo children $widtexte ] $widtexte.$wdgt$i ] != -1} {
incr i
}
set widget $widtexte.$wdgt$i;
$wdgt $widget
if {[string compare [winfo class $widtexte] Canvas] == 0} {
set id [ $widtexte create window 0 0 -window $widget ]
configDrawWidget $id $wdgt $widget
} else {
$widtexte window create insert -window $widget
configWidget $widtexte $wdgt $widget
bind $widget <2> {tk_popup .f.mDraw.menuCanvas 25 50 }
bind $widget <Control-3> {tk_popup .f.mDraw.menuCanvas 25 50 }
#<F1>
bind $widget <F1> {
set dumpie [dumptags %W]\n[dumpwindows %W]\n[%W dump 1.0 end]
%W delete 1.0 end
%W insert end $dumpie
}
#<F2>
bind $widget <F2> {
set niveaux [list $widtexte ]
set content [%W get 1.0 end-13char]
%W delete 1.0 end
undump %W $content
# faire la liste de tous les widgets dans tous les widgets, puis insérer un bind pour chaque widget pour pouvoir le rééditer.
allWidgetsKnowed $niveaux
}
}
}
proc insertDraw {wdgt} {
global widtexte
set objetDraw [$widtexte create $wdgt ]
configDraw $objetDraw.
}
# la proc "configWidget "
# est appelée par le bouton "widget" de la barre de commandes >>
# Création d'un toplevel pour définir les options du widget à insérer
# une boucle définit pour chaque option (liste "optionsWidget") un label et une entry
# Le texte entré au clavier dans l'entry fournira la valeur de l'option
proc configWidget {w wdgt widget} {
global widtexte
variable fenobjet
set fenobjet(widget) $widget
set fenobjet(bgcolor) white
set fenobjet(fgcolor) black
set fenobjet(relief) raised
set fenobjet(borderwidth) 3
set fenobjet(text) {le fenobjet}
set fenobjet(command) {tk_messageBox -message {Il est préférable de définir une commande auparavant!}}
set fenobjet(textwidth) 25
set fenobjet(height) 25
set fenobjet(coord) [list 0 0]
set fenobjet(anchor) ne
set fenobjet(image) ""
variable listeOptions
set listeOptions ""
destroy .cfgwdgt
#création du widget à insérer
toplevel .cfgwdgt
wm title .cfgwdgt "ttkm config widget"
label .cfgwdgt.etq -text "configurez votre widget" -fg red -bg pink
grid .cfgwdgt.etq -row 0 -column 1
label .cfgwdgt.nom -text ">> $wdgt : $widget" -fg red -bg pink
grid .cfgwdgt.nom -row 0 -column 2 -sticky ew
bind .cfgwdgt <3> {destroy .cfgwdgt }
switch -- $wdgt {
button {
button .cfgwdgt.b1 -text "-background" -command { variable fenobjet ; set fenobjet(bgcolor) [tk_chooseColor] ;raise .cfgwdgt}
grid .cfgwdgt.b1 -row 1 -column 1 -sticky ew
entry .cfgwdgt.e1 -textvariable fenobjet(bgcolor)
grid .cfgwdgt.e1 -row 1 -column 2 -sticky ew
button .cfgwdgt.b2 -text "-foreground" -command { variable fenobjet ; set fenobjet(fgcolor) [tk_chooseColor] ;raise .cfgwdgt}
grid .cfgwdgt.b2 -row 2 -column 1 -sticky ew
entry .cfgwdgt.e2 -textvariable fenobjet(fgcolor)
grid .cfgwdgt.e2 -row 2 -column 2 -sticky ew
button .cfgwdgt.b3 -text "-relief" -command {variable fenobjet ;raise .cfgwdgt}
grid .cfgwdgt.b3 -row 3 -column 1 -sticky ew
entry .cfgwdgt.e3 -textvariable fenobjet(relief)
grid .cfgwdgt.e3 -row 3 -column 2 -sticky ew
button .cfgwdgt.b4 -text "-borderwidth" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b4 -row 4 -column 1 -sticky ew
entry .cfgwdgt.e4 -textvariable fenobjet(borderwidth)
grid .cfgwdgt.e4 -row 4 -column 2 -sticky ew
button .cfgwdgt.b5 -text "-text" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b5 -row 5 -column 1 -sticky ew
entry .cfgwdgt.e5 -textvariable fenobjet(text)
grid .cfgwdgt.e5 -row 5 -column 2 -sticky ew
button .cfgwdgt.b6 -text "-command" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b6 -row 6 -column 1 -sticky ew
entry .cfgwdgt.e6 -textvariable fenobjet(command)
grid .cfgwdgt.e6 -row 6 -column 2 -sticky ew
label .cfgwdgt.rien -text " "
grid .cfgwdgt.rien -row 10 -column 1
button .cfgwdgt.envoi -text valider -bg red -fg yellow \
-command {variable fenobjet ;variable listeOptions;\
set listeOptions "-background $fenobjet(bgcolor) -foreground $fenobjet(fgcolor) -relief $fenobjet(relief) -borderwidth $fenobjet(borderwidth) -text {$fenobjet(text)} -command {$fenobjet(command)} " ;\
eval $fenobjet(widget) configure $listeOptions ; }
grid .cfgwdgt.envoi -row 11 -column 1
}
label {
button .cfgwdgt.b1 -text "-background" -command {variable fenobjet ; set fenobjet(bgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.b1 -row 1 -column 1 -sticky ew
entry .cfgwdgt.e1 -textvariable fenobjet(bgcolor)
grid .cfgwdgt.e1 -row 1 -column 2 -sticky ew
button .cfgwdgt.b2 -text "-foreground" -command {variable fenobjet ; set fenobjet(fgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.b2 -row 2 -column 1 -sticky ew
entry .cfgwdgt.e2 -textvariable fenobjet(fgcolor)
grid .cfgwdgt.e2 -row 2 -column 2 -sticky ew
button .cfgwdgt.b3 -text "-relief" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b3 -row 3 -column 1 -sticky ew
entry .cfgwdgt.e3 -textvariable fenobjet(relief)
grid .cfgwdgt.e3 -row 3 -column 2 -sticky ew
button .cfgwdgt.b4 -text "-borderwidth" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b4 -row 4 -column 1 -sticky ew
entry .cfgwdgt.e4 -textvariable fenobjet(borderwidth)
grid .cfgwdgt.e4 -row 4 -column 2 -sticky ew
button .cfgwdgt.b5 -text "-text" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b5 -row 5 -column 1 -sticky ew
entry .cfgwdgt.e5 -textvariable fenobjet(text)
grid .cfgwdgt.e5 -row 5 -column 2 -sticky ew
label .cfgwdgt.rien -text " "
grid .cfgwdgt.rien -row 10 -column 1
button .cfgwdgt.envoi -text valider -bg red -fg yellow \
-command {variable fenobjet ;variable listeOptions;\
set listeOptions "-background $fenobjet(bgcolor) -foreground $fenobjet(fgcolor) -relief $fenobjet(relief) -borderwidth $fenobjet(borderwidth) -text {$fenobjet(text)} " ;\
eval $fenobjet(widget) configure $listeOptions ; }
grid .cfgwdgt.envoi -row 11 -column 1
}
checkbutton {
button .cfgwdgt.b1 -text "-background" -command {variable fenobjet ; set fenobjet(bgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.b1 -row 1 -column 1 -sticky ew
entry .cfgwdgt.e1 -textvariable fenobjet(bgcolor)
grid .cfgwdgt.e1 -row 1 -column 2 -sticky ew
button .cfgwdgt.b2 -text "-foreground" -command {variable fenobjet ; set fenobjet(fgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.b2 -row 2 -column 1 -sticky ew
entry .cfgwdgt.e2 -textvariable fenobjet(fgcolor)
grid .cfgwdgt.e2 -row 2 -column 2 -sticky ew
button .cfgwdgt.b3 -text "-relief" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b3 -row 3 -column 1 -sticky ew
entry .cfgwdgt.e3 -textvariable fenobjet(relief)
grid .cfgwdgt.e3 -row 3 -column 2 -sticky ew
button .cfgwdgt.b4 -text "-borderwidth" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b4 -row 4 -column 1 -sticky ew
entry .cfgwdgt.e4 -textvariable fenobjet(borderwidth)
grid .cfgwdgt.e4 -row 4 -column 2 -sticky ew
button .cfgwdgt.b5 -text "-text" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b5 -row 5 -column 1 -sticky ew
entry .cfgwdgt.e5 -textvariable fenobjet(text)
grid .cfgwdgt.e5 -row 5 -column 2 -sticky ew
button .cfgwdgt.b6 -text "-command" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b6 -row 6 -column 1 -sticky ew
entry .cfgwdgt.e6 -textvariable fenobjet(command)
grid .cfgwdgt.e6 -row 6 -column 2 -sticky ew
label .cfgwdgt.rien -text " "
grid .cfgwdgt.rien -row 10 -column 1
button .cfgwdgt.envoi -text valider -bg red -fg yellow \
-command {variable fenobjet ;variable listeOptions;\
set listeOptions "-background $fenobjet(bgcolor) -foreground $fenobjet(fgcolor) -relief $fenobjet(relief) -borderwidth $fenobjet(borderwidth) -text {$fenobjet(text)} -command {$fenobjet(command)} " ;\
eval $fenobjet(widget) configure $listeOptions ; }
# les parenthèses pour les options text et command permettent les espaces dans la valeur de la variable fenobjet(?).
grid .cfgwdgt.envoi -row 11 -column 1
}
entry {
button .cfgwdgt.b1 -text "-background" -command {variable fenobjet ; set fenobjet(bgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.b1 -row 1 -column 1 -sticky ew
entry .cfgwdgt.e1 -textvariable fenobjet(bgcolor)
grid .cfgwdgt.e1 -row 1 -column 2 -sticky ew
button .cfgwdgt.b2 -text "-foreground" -command {variable fenobjet ; set fenobjet(fgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.b2 -row 2 -column 1 -sticky ew
entry .cfgwdgt.e2 -textvariable fenobjet(fgcolor)
grid .cfgwdgt.e2 -row 2 -column 2 -sticky ew
button .cfgwdgt.b3 -text "-relief" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b3 -row 3 -column 1 -sticky ew
entry .cfgwdgt.e3 -textvariable fenobjet(relief)
grid .cfgwdgt.e3 -row 3 -column 2 -sticky ew
button .cfgwdgt.b4 -text "-borderwidth" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b4 -row 4 -column 1 -sticky ew
entry .cfgwdgt.e4 -textvariable fenobjet(borderwidth)
grid .cfgwdgt.e4 -row 4 -column 2 -sticky ew
button .cfgwdgt.b5 -text "-textvariable" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b5 -row 5 -column 1 -sticky ew
entry .cfgwdgt.e5 -textvariable fenobjet(text)
grid .cfgwdgt.e5 -row 5 -column 2 -sticky ew
label .cfgwdgt.rien -text " "
grid .cfgwdgt.rien -row 10 -column 1
button .cfgwdgt.envoi -text valider -bg red -fg yellow \
-command {variable fenobjet ;variable listeOptions;\
set listeOptions "-background $fenobjet(bgcolor) -foreground $fenobjet(fgcolor) -relief $fenobjet(relief) -borderwidth $fenobjet(borderwidth) -text {$fenobjet(text)} " ;\
eval $fenobjet(widget) configure $listeOptions ; }
grid .cfgwdgt.envoi -row 11 -column 1
}
text {
button .cfgwdgt.b1 -text "-background" -command {variable fenobjet ; set fenobjet(bgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.b1 -row 1 -column 1 -sticky ew
entry .cfgwdgt.e1 -textvariable fenobjet(bgcolor)
grid .cfgwdgt.e1 -row 1 -column 2 -sticky ew
button .cfgwdgt.b2 -text "-foreground" -command {variable fenobjet ; set fenobjet(fgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.b2 -row 2 -column 1 -sticky ew
entry .cfgwdgt.e2 -textvariable fenobjet(fgcolor)
grid .cfgwdgt.e2 -row 2 -column 2 -sticky ew
button .cfgwdgt.b3 -text "-relief" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b3 -row 3 -column 1 -sticky ew
entry .cfgwdgt.e3 -textvariable fenobjet(relief)
grid .cfgwdgt.e3 -row 3 -column 2 -sticky ew
button .cfgwdgt.b4 -text "-borderwidth" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b4 -row 4 -column 1 -sticky ew
entry .cfgwdgt.e4 -textvariable fenobjet(borderwidth)
grid .cfgwdgt.e4 -row 4 -column 2 -sticky ew
button .cfgwdgt.b5 -text "-width" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b5 -row 5 -column 1 -sticky ew
entry .cfgwdgt.e5 -textvariable fenobjet(textwidth)
grid .cfgwdgt.e5 -row 5 -column 2 -sticky ew
label .cfgwdgt.rien -text " "
grid .cfgwdgt.rien -row 10 -column 1
button .cfgwdgt.envoi -text valider -bg red -fg yellow \
-command {variable fenobjet ;variable listeOptions;\
set listeOptions "-background $fenobjet(bgcolor) -foreground $fenobjet(fgcolor) -relief $fenobjet(relief) \
-borderwidth $fenobjet(borderwidth) -width {$fenobjet(textwidth)} " ;\
eval $fenobjet(widget) configure $listeOptions ; \
;\
bind $fenobjet(widget) <1> {set widtexte %W; .f.textActif configure -text "texte actif : $widtexte"};\
bind $fenobjet(widget) <3> { tk_messageBox -message "insertion de widget dans : $widtexte" ;tk_popup .f.mWidget.menuWidgets 25 50}}
grid .cfgwdgt.envoi -row 11 -column 1
}
canvas {
button .cfgwdgt.b1 -text "-background" -command {variable fenobjet ; set fenobjet(bgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.b1 -row 1 -column 1 -sticky ew
entry .cfgwdgt.e1 -textvariable fenobjet(bgcolor)
grid .cfgwdgt.e1 -row 1 -column 2 -sticky ew
button .cfgwdgt.b2 -text "-borderwidth" -command {variable fenobjet ; ; raise .cfgwdgt}
grid .cfgwdgt.b2 -row 2 -column 1 -sticky ew
entry .cfgwdgt.e2 -textvariable fenobjet(borderwidth)
grid .cfgwdgt.e2 -row 2 -column 2 -sticky ew
button .cfgwdgt.b3 -text "-relief" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b3 -row 3 -column 1 -sticky ew
entry .cfgwdgt.e3 -textvariable fenobjet(relief)
grid .cfgwdgt.e3 -row 3 -column 2 -sticky ew
button .cfgwdgt.b4 -text "-height" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b4 -row 4 -column 1 -sticky ew
entry .cfgwdgt.e4 -textvariable fenobjet(height)
grid .cfgwdgt.e4 -row 4 -column 2 -sticky ew
button .cfgwdgt.b5 -text "-width" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b5 -row 5 -column 1 -sticky ew
entry .cfgwdgt.e5 -textvariable fenobjet(textwidth)
grid .cfgwdgt.e5 -row 5 -column 2 -sticky ew
label .cfgwdgt.rien -text " "
grid .cfgwdgt.rien -row 10 -column 1
button .cfgwdgt.envoi -text valider -bg red -fg yellow \
-command {variable fenobjet ;variable listeOptions;\
set listeOptions "-background $fenobjet(bgcolor) -height $fenobjet(height) -relief $fenobjet(relief) \
-borderwidth $fenobjet(borderwidth) -width {$fenobjet(textwidth)} " ;\
eval $fenobjet(widget) configure $listeOptions ; \
;\
bind $fenobjet(widget) <1> {set widtexte %W; .f.textActif configure -text "canvas actif : $widtexte"};\
bind $fenobjet(widget) <3> { tk_messageBox -message "insertion de widget dans : $widtexte" ;tk_popup .f.mWidget.menuWidgets 25 50}}
grid .cfgwdgt.envoi -row 11 -column 1
}
} ;#fin du switch
}
proc configDrawWidget { id wdgt widget } {
global widtexte
variable fenobjet
set fenobjet(widget) $widget
set fenobjet(bgcolor) white
set fenobjet(fgcolor) black
set fenobjet(relief) raised
set fenobjet(borderwidth) 3
set fenobjet(text) {le fenobjet}
set fenobjet(command) {tk_messageBox -message {Il est préférable de définir une commande auparavant!}}
set fenobjet(textwidth) 25
set fenobjet(height) 25
set fenobjet(id) $id
set fenobjet(image) ""
set fenobjet(coord) [list 0 0]
set fenobjet(anchor) nw
set fenobjet(font) [list helvetica 14 bold italic underline]
variable listeOptions
set listeOptions ""
destroy .cfgwdgt
#création du widget à insérer
toplevel .cfgwdgt
wm title .cfgwdgt "ttkm config widget"
label .cfgwdgt.etq -text "configurez votre widget" -fg red -bg pink
grid .cfgwdgt.etq -row 0 -column 1
label .cfgwdgt.nom -text ">> $wdgt : $widget" -fg red -bg pink
grid .cfgwdgt.nom -row 0 -column 2 -sticky ew
bind .cfgwdgt <3> {destroy .cfgwdgt }
switch -- $wdgt {
button {
button .cfgwdgt.b1 -text "-background" -command { variable fenobjet ; set fenobjet(bgcolor) [tk_chooseColor] ;raise .cfgwdgt}
grid .cfgwdgt.b1 -row 1 -column 1 -sticky ew
entry .cfgwdgt.e1 -textvariable fenobjet(bgcolor)
grid .cfgwdgt.e1 -row 1 -column 2 -sticky ew
button .cfgwdgt.b2 -text "-foreground" -command { variable fenobjet ; set fenobjet(fgcolor) [tk_chooseColor] ;raise .cfgwdgt}
grid .cfgwdgt.b2 -row 2 -column 1 -sticky ew
entry .cfgwdgt.e2 -textvariable fenobjet(fgcolor)
grid .cfgwdgt.e2 -row 2 -column 2 -sticky ew
button .cfgwdgt.b3 -text "-relief" -command {variable fenobjet ;raise .cfgwdgt}
grid .cfgwdgt.b3 -row 3 -column 1 -sticky ew
entry .cfgwdgt.e3 -textvariable fenobjet(relief)
grid .cfgwdgt.e3 -row 3 -column 2 -sticky ew
button .cfgwdgt.b4 -text "-borderwidth" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b4 -row 4 -column 1 -sticky ew
entry .cfgwdgt.e4 -textvariable fenobjet(borderwidth)
grid .cfgwdgt.e4 -row 4 -column 2 -sticky ew
button .cfgwdgt.b5 -text "-text" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b5 -row 5 -column 1 -sticky ew
entry .cfgwdgt.e5 -textvariable fenobjet(text)
grid .cfgwdgt.e5 -row 5 -column 2 -sticky ew
button .cfgwdgt.b6 -text "-command" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b6 -row 6 -column 1 -sticky ew
entry .cfgwdgt.e6 -textvariable fenobjet(command)
grid .cfgwdgt.e6 -row 6 -column 2 -sticky ew
button .cfgwdgt.b7 -text "-coord" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b7 -row 7 -column 1 -sticky ew
entry .cfgwdgt.e7 -textvariable fenobjet(coord)
grid .cfgwdgt.e7 -row 7 -column 2 -sticky ew
label .cfgwdgt.rien -text " "
grid .cfgwdgt.rien -row 10 -column 1
button .cfgwdgt.envoi -text valider -bg red -fg yellow \
-command {variable fenobjet ;variable listeOptions;variable identification \
set listeOptions "-background $fenobjet(bgcolor) -foreground $fenobjet(fgcolor) -relief $fenobjet(relief) -borderwidth $fenobjet(borderwidth) -text {$fenobjet(text)} -command {$fenobjet(command)} " ;\
eval $fenobjet(widget) configure $listeOptions ; eval $widtexte move $fenobjet(id) $fenobjet(coord) ; }
grid .cfgwdgt.envoi -row 11 -column 1
}
label {
button .cfgwdgt.b1 -text "-background" -command {variable fenobjet ; set fenobjet(bgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.b1 -row 1 -column 1 -sticky ew
entry .cfgwdgt.e1 -textvariable fenobjet(bgcolor)
grid .cfgwdgt.e1 -row 1 -column 2 -sticky ew
button .cfgwdgt.b2 -text "-foreground" -command {variable fenobjet ; set fenobjet(fgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.b2 -row 2 -column 1 -sticky ew
entry .cfgwdgt.e2 -textvariable fenobjet(fgcolor)
grid .cfgwdgt.e2 -row 2 -column 2 -sticky ew
button .cfgwdgt.b3 -text "-relief" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b3 -row 3 -column 1 -sticky ew
entry .cfgwdgt.e3 -textvariable fenobjet(relief)
grid .cfgwdgt.e3 -row 3 -column 2 -sticky ew
button .cfgwdgt.b4 -text "-borderwidth" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b4 -row 4 -column 1 -sticky ew
entry .cfgwdgt.e4 -textvariable fenobjet(borderwidth)
grid .cfgwdgt.e4 -row 4 -column 2 -sticky ew
button .cfgwdgt.b5 -text "-text" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b5 -row 5 -column 1 -sticky ew
entry .cfgwdgt.e5 -textvariable fenobjet(text)
grid .cfgwdgt.e5 -row 5 -column 2 -sticky ew
button .cfgwdgt.b6 -text "-coord" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b6 -row 6 -column 1 -sticky ew
entry .cfgwdgt.e6 -textvariable fenobjet(coord)
grid .cfgwdgt.e6 -row 6 -column 2 -sticky ew
label .cfgwdgt.rien -text " "
grid .cfgwdgt.rien -row 10 -column 1
button .cfgwdgt.envoi -text valider -bg red -fg yellow \
-command {variable fenobjet ;variable listeOptions;\
set listeOptions "-background $fenobjet(bgcolor) -foreground $fenobjet(fgcolor) -relief $fenobjet(relief) -borderwidth $fenobjet(borderwidth) -text {$fenobjet(text)} " ;\
eval $fenobjet(widget) configure $listeOptions ; eval $widtexte move $fenobjet(id) $fenobjet(coord) ;}
grid .cfgwdgt.envoi -row 11 -column 1
}
checkbutton {
button .cfgwdgt.b1 -text "-background" -command {variable fenobjet ; set fenobjet(bgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.b1 -row 1 -column 1 -sticky ew
entry .cfgwdgt.e1 -textvariable fenobjet(bgcolor)
grid .cfgwdgt.e1 -row 1 -column 2 -sticky ew
button .cfgwdgt.b2 -text "-foreground" -command {variable fenobjet ; set fenobjet(fgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.b2 -row 2 -column 1 -sticky ew
entry .cfgwdgt.e2 -textvariable fenobjet(fgcolor)
grid .cfgwdgt.e2 -row 2 -column 2 -sticky ew
button .cfgwdgt.b3 -text "-relief" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b3 -row 3 -column 1 -sticky ew
entry .cfgwdgt.e3 -textvariable fenobjet(relief)
grid .cfgwdgt.e3 -row 3 -column 2 -sticky ew
button .cfgwdgt.b4 -text "-borderwidth" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b4 -row 4 -column 1 -sticky ew
entry .cfgwdgt.e4 -textvariable fenobjet(borderwidth)
grid .cfgwdgt.e4 -row 4 -column 2 -sticky ew
button .cfgwdgt.b5 -text "-text" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b5 -row 5 -column 1 -sticky ew
entry .cfgwdgt.e5 -textvariable fenobjet(text)
grid .cfgwdgt.e5 -row 5 -column 2 -sticky ew
button .cfgwdgt.b6 -text "-command" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b6 -row 6 -column 1 -sticky ew
entry .cfgwdgt.e6 -textvariable fenobjet(command)
grid .cfgwdgt.e6 -row 6 -column 2 -sticky ew
button .cfgwdgt.b7 -text "-coord" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b7 -row 7 -column 1 -sticky ew
entry .cfgwdgt.e7 -textvariable fenobjet(coord)
grid .cfgwdgt.e7 -row 7 -column 2 -sticky ew
label .cfgwdgt.rien -text " "
grid .cfgwdgt.rien -row 10 -column 1
button .cfgwdgt.envoi -text valider -bg red -fg yellow \
-command {variable fenobjet ;variable listeOptions;\
set listeOptions "-background $fenobjet(bgcolor) -foreground $fenobjet(fgcolor) -relief $fenobjet(relief) -borderwidth $fenobjet(borderwidth) -text {$fenobjet(text)} -command {$fenobjet(command)} " ;\
eval $fenobjet(widget) configure $listeOptions ; eval $widtexte move $fenobjet(id) $fenobjet(coord) ; }
# les parenthèses pour les options text et command permettent les espaces dans la valeur de la variable fenobjet(?).
grid .cfgwdgt.envoi -row 11 -column 1
}
entry {
button .cfgwdgt.b1 -text "-background" -command {variable fenobjet ; set fenobjet(bgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.b1 -row 1 -column 1 -sticky ew
entry .cfgwdgt.e1 -textvariable fenobjet(bgcolor)
grid .cfgwdgt.e1 -row 1 -column 2 -sticky ew
button .cfgwdgt.b2 -text "-foreground" -command {variable fenobjet ; set fenobjet(fgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.b2 -row 2 -column 1 -sticky ew
entry .cfgwdgt.e2 -textvariable fenobjet(fgcolor)
grid .cfgwdgt.e2 -row 2 -column 2 -sticky ew
button .cfgwdgt.b3 -text "-relief" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b3 -row 3 -column 1 -sticky ew
entry .cfgwdgt.e3 -textvariable fenobjet(relief)
grid .cfgwdgt.e3 -row 3 -column 2 -sticky ew
button .cfgwdgt.b4 -text "-borderwidth" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b4 -row 4 -column 1 -sticky ew
entry .cfgwdgt.e4 -textvariable fenobjet(borderwidth)
grid .cfgwdgt.e4 -row 4 -column 2 -sticky ew
button .cfgwdgt.b5 -text "-textvariable" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b5 -row 5 -column 1 -sticky ew
entry .cfgwdgt.e5 -textvariable fenobjet(text)
grid .cfgwdgt.e5 -row 5 -column 2 -sticky ew
button .cfgwdgt.b6 -text "-coord" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b6 -row 6 -column 1 -sticky ew
entry .cfgwdgt.e6 -textvariable fenobjet(coord)
grid .cfgwdgt.e6 -row 6 -column 2 -sticky ew
label .cfgwdgt.rien -text " "
grid .cfgwdgt.rien -row 10 -column 1
button .cfgwdgt.envoi -text valider -bg red -fg yellow \
-command {variable fenobjet ;variable listeOptions;\
set listeOptions "-background $fenobjet(bgcolor) -foreground $fenobjet(fgcolor) -relief $fenobjet(relief) -borderwidth $fenobjet(borderwidth) -text {$fenobjet(text)} " ;\
eval $fenobjet(widget) configure $listeOptions ; eval $widtexte move $fenobjet(id) $fenobjet(coord) ;}
grid .cfgwdgt.envoi -row 11 -column 1
}
text { tk_messageBox -message "Utilisez le menu ''DRAW'' pour insérer un ''text'' dan sun ''canvas''"
}
canvas {
button .cfgwdgt.b1 -text "-background" -command {variable fenobjet ; set fenobjet(bgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.b1 -row 1 -column 1 -sticky ew
entry .cfgwdgt.e1 -textvariable fenobjet(bgcolor)
grid .cfgwdgt.e1 -row 1 -column 2 -sticky ew
button .cfgwdgt.b2 -text "-borderwidth" -command {variable fenobjet ; ; raise .cfgwdgt}
grid .cfgwdgt.b2 -row 2 -column 1 -sticky ew
entry .cfgwdgt.e2 -textvariable fenobjet(borderwidth)
grid .cfgwdgt.e2 -row 2 -column 2 -sticky ew
button .cfgwdgt.b3 -text "-relief" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b3 -row 3 -column 1 -sticky ew
entry .cfgwdgt.e3 -textvariable fenobjet(relief)
grid .cfgwdgt.e3 -row 3 -column 2 -sticky ew
button .cfgwdgt.b4 -text "-height" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b4 -row 4 -column 1 -sticky ew
entry .cfgwdgt.e4 -textvariable fenobjet(height)
grid .cfgwdgt.e4 -row 4 -column 2 -sticky ew
button .cfgwdgt.b5 -text "-width" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b5 -row 5 -column 1 -sticky ew
entry .cfgwdgt.e5 -textvariable fenobjet(textwidth)
grid .cfgwdgt.e5 -row 5 -column 2 -sticky ew
button .cfgwdgt.b6 -text "-coord" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b6 -row 6 -column 1 -sticky ew
entry .cfgwdgt.e6 -textvariable fenobjet(coord)
grid .cfgwdgt.e6 -row 6 -column 2 -sticky ew
label .cfgwdgt.rien -text " "
grid .cfgwdgt.rien -row 10 -column 1
button .cfgwdgt.envoi -text valider -bg red -fg yellow \
-command {variable fenobjet ;variable listeOptions;\
set listeOptions "-background $fenobjet(bgcolor) -height $fenobjet(height) -relief $fenobjet(relief) \
-borderwidth $fenobjet(borderwidth) -width {$fenobjet(textwidth)} " ;\
eval $fenobjet(widget) configure $listeOptions ; eval $widtexte move $fenobjet(id) $fenobjet(coord) ;\
bind $fenobjet(widget) <1> {set widtexte %W; .f.textActif configure -text "canvas actif : $widtexte"};\
bind $fenobjet(widget) <3> { tk_messageBox -message "insertion de widget dans : $widtexte" ;tk_popup .f.mWidget.menuWidgets 25 50}}
grid .cfgwdgt.envoi -row 11 -column 1
}
image {
button .cfgwdgt.b6 -text "-coord" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.b6 -row 6 -column 1 -sticky ew
entry .cfgwdgt.e6 -textvariable fenobjet(coord)
grid .cfgwdgt.e6 -row 6 -column 2 -sticky ew
label .cfgwdgt.rien -text " "
grid .cfgwdgt.rien -row 10 -column 1
button .cfgwdgt.envoi -text valider -bg red -fg yellow \
-command {variable fenobjet ;variable listeOptions; set listeOptions "";\
; eval $widtexte move $fenobjet(id) $fenobjet(coord) ;\
bind $fenobjet(widget) <1> {set widtexte %W; .f.textActif configure -text "canvas actif : $widtexte"};\
bind $fenobjet(widget) <3> { tk_messageBox -message "insertion de widget dans : $widtexte" ;tk_popup .f.mWidget.menuWidgets 25 50}
}
grid .cfgwdgt.envoi -row 11 -column 1
}
} ;#fin du switch
}
proc configDraw { wdgt } {
global widtexte
variable fenobjet
set fenobjet(bgcolor) white
set fenobjet(fgcolor) black
set fenobjet(relief) raised
set fenobjet(borderwidth) 3
set fenobjet(text) {le fenobjet}
set fenobjet(command) {tk_messageBox -message {Il est préférable de définir une commande auparavant!}}
set fenobjet(textwidth) 25
set fenobjet(height) 25
set fenobjet(coord) [list 0 0]
set fenobjet(smooth) 1
set fenobjet(arrow) none
set fenobjet(anchor) ne
set fenobjet(font) { [list helvetica 14 bold italic underline] }
set fenobjet(textcanvas) {[list text de dessin]}
set fenobjet(start) 0
set fenobjet(extent) 45
set fenobjet(style) pieslice
destroy .cfgwdgt
#création du widget à insérer
toplevel .cfgwdgt
wm title .cfgwdgt "ttkm config draw"
label .cfgwdgt.etq -text "configurez votre objet dessin" -fg red -bg pink
grid .cfgwdgt.etq -row 0 -column 1
label .cfgwdgt.nom -text ">> $wdgt " -fg red -bg pink
grid .cfgwdgt.nom -row 0 -column 2 -sticky ew
bind .cfgwdgt <3> {destroy .cfgwdgt }
switch -- $wdgt {
rectangle {
button .cfgwdgt.bc1 -text "coordonnées " -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.bc1 -row 1 -column 1 -sticky ew
entry .cfgwdgt.ec1 -textvariable fenobjet(coord)
grid .cfgwdgt.ec1 -row 1 -column 2 -sticky ew
button .cfgwdgt.bc2 -text "-fill" -command {variable fenobjet ; set fenobjet(bgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.bc2 -row 2 -column 1 -sticky ew
entry .cfgwdgt.ec2 -textvariable fenobjet(bgcolor)
grid .cfgwdgt.ec2 -row 2 -column 2 -sticky ew
button .cfgwdgt.bc4 -text "-anchor" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.bc4 -row 4 -column 1 -sticky ew
entry .cfgwdgt.ec4 -textvariable fenobjet(anchor)
grid .cfgwdgt.ec4 -row 4 -column 2 -sticky ew
button .cfgwdgt.bc5 -text "-width" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.bc5 -row 5 -column 1 -sticky ew
entry .cfgwdgt.ec5 -textvariable fenobjet(textwidth)
grid .cfgwdgt.ec5 -row 5 -column 2 -sticky ew
label .cfgwdgt.rien -text " "
grid .cfgwdgt.rien -row 10 -column 1
button .cfgwdgt.envoiC -text valider -bg red -fg yellow \
-command {variable fenobjet ;variable listeOptions;\
set listeOptions "$fenobjet(coord) -fill $fenobjet(bgcolor) -width $fenobjet(textwidth) " \
; eval $widtexte create rectangle $listeOptions }
grid .cfgwdgt.envoiC -row 11 -column 1
}
oval {
button .cfgwdgt.bc1 -text "coordonnées " -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.bc1 -row 1 -column 1 -sticky ew
entry .cfgwdgt.ec1 -textvariable fenobjet(coord)
grid .cfgwdgt.ec1 -row 1 -column 2 -sticky ew
button .cfgwdgt.bc2 -text "-fill" -command {variable fenobjet ; set fenobjet(bgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.bc2 -row 2 -column 1 -sticky ew
entry .cfgwdgt.ec2 -textvariable fenobjet(bgcolor)
grid .cfgwdgt.ec2 -row 2 -column 2 -sticky ew
button .cfgwdgt.bc4 -text "-anchor" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.bc4 -row 4 -column 1 -sticky ew
entry .cfgwdgt.ec4 -textvariable fenobjet(anchor)
grid .cfgwdgt.ec4 -row 4 -column 2 -sticky ew
button .cfgwdgt.bc5 -text "-width" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.bc5 -row 5 -column 1 -sticky ew
entry .cfgwdgt.ec5 -textvariable fenobjet(textwidth)
grid .cfgwdgt.ec5 -row 5 -column 2 -sticky ew
label .cfgwdgt.rien -text " "
grid .cfgwdgt.rien -row 10 -column 1
button .cfgwdgt.envoiC -text valider -bg red -fg yellow \
-command {variable fenobjet ;variable listeOptions;\
set listeOptions "$fenobjet(coord) -fill $fenobjet(bgcolor) -width $fenobjet(textwidth) " \
; eval $widtexte create oval $listeOptions }
grid .cfgwdgt.envoiC -row 11 -column 1
}
arc {
button .cfgwdgt.bc1 -text "coordonnées " -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.bc1 -row 1 -column 1 -sticky ew
entry .cfgwdgt.ec1 -textvariable fenobjet(coord)
grid .cfgwdgt.ec1 -row 1 -column 2 -sticky ew
button .cfgwdgt.bc2 -text "-start" -command {variable fenobjet ; raise .cfgwdgt }
grid .cfgwdgt.bc2 -row 2 -column 1 -sticky ew
entry .cfgwdgt.ec2 -textvariable fenobjet(start)
grid .cfgwdgt.ec2 -row 2 -column 2 -sticky ew
button .cfgwdgt.bc4 -text "-extent" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.bc4 -row 4 -column 1 -sticky ew
entry .cfgwdgt.ec4 -textvariable fenobjet(extent)
grid .cfgwdgt.ec4 -row 4 -column 2 -sticky ew
button .cfgwdgt.bc5 -text "-style" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.bc5 -row 5 -column 1 -sticky ew
entry .cfgwdgt.ec5 -textvariable fenobjet(style)
grid .cfgwdgt.ec5 -row 5 -column 2 -sticky ew
label .cfgwdgt.rien -text " "
grid .cfgwdgt.rien -row 10 -column 1
button .cfgwdgt.envoiC -text valider -bg red -fg yellow \
-command {variable fenobjet ;variable listeOptions;\
set listeOptions "$fenobjet(coord) -start $fenobjet(start) -extent $fenobjet(extent) -style $fenobjet(style) " \
; eval $widtexte create arc $listeOptions }
grid .cfgwdgt.envoiC -row 11 -column 1
}
line {
button .cfgwdgt.bc1 -text "coordonnées " -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.bc1 -row 1 -column 1 -sticky ew
entry .cfgwdgt.ec1 -textvariable fenobjet(coord)
grid .cfgwdgt.ec1 -row 1 -column 2 -sticky ew
button .cfgwdgt.bc2 -text "-fill" -command {variable fenobjet ; set fenobjet(fgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.bc2 -row 2 -column 1 -sticky ew
entry .cfgwdgt.ec2 -textvariable fenobjet(fgcolor)
grid .cfgwdgt.ec2 -row 2 -column 2 -sticky ew
button .cfgwdgt.bc3 -text "-arrow" -command {variable fenobjet ; ; raise .cfgwdgt}
grid .cfgwdgt.bc3 -row 3 -column 1 -sticky ew
entry .cfgwdgt.ec3 -textvariable fenobjet(arrow)
grid .cfgwdgt.ec3 -row 3 -column 2 -sticky ew
button .cfgwdgt.bc4 -text "-smooth" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.bc4 -row 4 -column 1 -sticky ew
entry .cfgwdgt.ec4 -textvariable fenobjet(smooth)
grid .cfgwdgt.ec4 -row 4 -column 2 -sticky ew
button .cfgwdgt.bc5 -text "-width" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.bc5 -row 5 -column 1 -sticky ew
entry .cfgwdgt.ec5 -textvariable fenobjet(textwidth)
grid .cfgwdgt.ec5 -row 5 -column 2 -sticky ew
label .cfgwdgt.rien -text " "
grid .cfgwdgt.rien -row 10 -column 1
button .cfgwdgt.envoiC -text valider -bg red -fg yellow \
-command {variable fenobjet ;variable listeOptions;\
set listeOptions "$fenobjet(coord) -fill $fenobjet(fgcolor) -arrow $fenobjet(arrow) -width $fenobjet(textwidth) -smooth $fenobjet(smooth) " \
; eval $widtexte create line $listeOptions }
grid .cfgwdgt.envoiC -row 11 -column 1
}
polygon {
button .cfgwdgt.bc1 -text "coordonnées " -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.bc1 -row 1 -column 1 -sticky ew
entry .cfgwdgt.ec1 -textvariable fenobjet(coord)
grid .cfgwdgt.ec1 -row 1 -column 2 -sticky ew
button .cfgwdgt.bc2 -text "-fill" -command {variable fenobjet ; set fenobjet(fgcolor) [tk_chooseColor] ; raise .cfgwdgt}
grid .cfgwdgt.bc2 -row 2 -column 1 -sticky ew
entry .cfgwdgt.ec2 -textvariable fenobjet(fgcolor)
grid .cfgwdgt.ec2 -row 2 -column 2 -sticky ew
button .cfgwdgt.bc3 -text "-arrow" -command {variable fenobjet ; ; raise .cfgwdgt}
grid .cfgwdgt.bc3 -row 3 -column 1 -sticky ew
entry .cfgwdgt.ec3 -textvariable fenobjet(arrow)
grid .cfgwdgt.ec3 -row 3 -column 2 -sticky ew
button .cfgwdgt.bc4 -text "-smooth" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.bc4 -row 4 -column 1 -sticky ew
entry .cfgwdgt.ec4 -textvariable fenobjet(smooth)
grid .cfgwdgt.ec4 -row 4 -column 2 -sticky ew
button .cfgwdgt.bc5 -text "-width" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.bc5 -row 5 -column 1 -sticky ew
entry .cfgwdgt.ec5 -textvariable fenobjet(textwidth)
grid .cfgwdgt.ec5 -row 5 -column 2 -sticky ew
label .cfgwdgt.rien -text " "
grid .cfgwdgt.rien -row 10 -column 1
button .cfgwdgt.envoiC -text valider -bg red -fg yellow \
-command {variable fenobjet ;variable listeOptions;\
set listeOptions "$fenobjet(coord) -fill $fenobjet(fgcolor) -arrow $fenobjet(arrow) -width $fenobjet(textwidth) -smooth $fenobjet(smooth) " \
; eval $widtexte create polygon $listeOptions }
grid .cfgwdgt.envoiC -row 11 -column 1
}
text {
button .cfgwdgt.bc1 -text "coordonnées " -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.bc1 -row 1 -column 1 -sticky ew
entry .cfgwdgt.ec1 -textvariable fenobjet(coord)
grid .cfgwdgt.ec1 -row 1 -column 2 -sticky ew
button .cfgwdgt.bc2 -text "-text" -command {variable fenobjet ; }
grid .cfgwdgt.bc2 -row 2 -column 1 -sticky ew
entry .cfgwdgt.ec2 -textvariable fenobjet(textcanvas)
grid .cfgwdgt.ec2 -row 2 -column 2 -sticky ew
button .cfgwdgt.bc3 -text "-anchor" -command {variable fenobjet ; ; raise .cfgwdgt}
grid .cfgwdgt.bc3 -row 3 -column 1 -sticky ew
entry .cfgwdgt.ec3 -textvariable fenobjet(anchor)
grid .cfgwdgt.ec3 -row 3 -column 2 -sticky ew
button .cfgwdgt.bc4 -text "-font" -command {variable fenobjet ; raise .cfgwdgt}
grid .cfgwdgt.bc4 -row 4 -column 1 -sticky ew
entry .cfgwdgt.ec4 -textvariable fenobjet(font)
grid .cfgwdgt.ec4 -row 4 -column 2 -sticky ew
label .cfgwdgt.rien -text " "
grid .cfgwdgt.rien -row 10 -column 1
button .cfgwdgt.envoiC -text valider -bg red -fg yellow \
-command {variable fenobjet ;variable listeOptions;\
set listeOptions "$fenobjet(coord) -anchor $fenobjet(anchor) -text $fenobjet(textcanvas) -font $fenobjet(font) " \
; eval $widtexte create text $listeOptions }
grid .cfgwdgt.envoiC -row 11 -column 1
}
}
}
#\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
#<PROCEDURES_TTC>
# Le format TTC permet de sauvegarder dans un fichier texte les indications de mise en page d'un texte d'un widget "text" de tcl-tk
# les configurations des tags sont récupérées par la procédure dumptags,
# le texte et ses tags le sont par la commande dump
# il en est de même des indications d'image
# les widgets sont non seulement sauvegardés, mais leur contenu éditable l'est aussi
# la procédure "undump" permet de réafficher le texte avec son formatage
# à partir du résultat de la commande "dump"
# et de la procédure "dumptags"
# et de la procédure "dumpwindows"
variable ttcFile ; # Il importe de définir une variable ''ttcFile'' afin de connaitre le nom du fichier ttc pour les sauvegardes rapides.
variable saveFlag 0 ; # la variable saveflag est prévue pour distinguer une fonction "Save" d'une fonction "Save As..."
variable fenetre "" ; # la variable fenetre est INDISPENSABLE
# pour que la proc undump relise les "contenu" sur plusieurs niveaux d'imbrication des widgets.
proc undump {w content} {
variable ttcFile
variable fenetre
set fenetre $w
foreach {type value pos } $content {
switch -- $type {
variable {variable $value $pos}
text {$w insert $pos $value}
image {$w image create $pos -image [image create photo -file [file join [file dirname $ttcFile ] $value]] -name $value}
tag {eval [list $w tag configure $value] $pos }
tagon {set on($value) $pos}
tagoff {$w tag add $value $on($value) $pos ; unset on($value) }
mark {$w mark set $value $pos }
window { set suffix [lindex [split $value .] [expr [llength [split $value .] ] -1] ]
catch [$w window create $pos -window $w.$suffix] }
Dwindow { variable fenetre ;
undumpdraw $fenetre $pos }
Button {eval [concat "button" $w.$value $pos ] }
Checkbutton {eval [concat "checkbutton" $w.$value $pos ] }
Canvas {variable fenetre ; eval [concat "canvas" $w.$value $pos ] ;set fenetre $w.$value }
Entry {eval [concat "entry" $w.$value $pos ] }
Frame {eval [concat "frame" $w.$value $pos ] }
Label {eval [concat "label" $w.$value $pos ] }
Listbox {eval [concat "listbox" $w.$value $pos ] }
Menubutton {eval [concat "menubutton" $w.$value $pos ] }
Message {eval [concat "message" $w.$value $pos ] }
Radiobutton {eval [concat "radiobutton" $w.$value $pos ] }
Scale {eval [concat "scale" $w.$value $pos ] }
Scrollbar {eval [concat "scrollbar" $w.$value $pos ] }
Spinbox {eval [concat "spinbox" $w.$value $pos ] }
Text {variable fenetre; eval [concat "text" $w.$value $pos ] ; set fenetre $w.$value}
contenu {variable fenetre ; undump $fenetre $pos ; }
draw {variable fenetre ; undumpdraw $fenetre $pos}
}
}
}
proc undumpdraw {w content } {
variable fenetre
variable ttcFile
foreach {type value pos } $content {
switch -- $type {
Button {eval [concat "button" $w.$value $pos ] }
Checkbutton {eval [concat "checkbutton" $w.$value $pos ] }
Canvas {variable fenetre; eval [concat "canvas" $w.$value $pos ] ; }
Dwindow { undumpdraw $w.[lindex [split $value .] end ] $pos }
Entry {eval [concat "entry" $w.$value $pos ] }
Frame {eval [concat "frame" $w.$value $pos ] }
Label {eval [concat "label" $w.$value $pos ] }
Listbox {eval [concat "listbox" $w.$value $pos ] }
Menubutton {eval [concat "menubutton" $w.$value $pos ] }
Message {eval [concat "message" $w.$value $pos ] }
Radiobutton {eval [concat "radiobutton" $w.$value $pos ] }
Scale {eval [concat "scale" $w.$value $pos ] }
Scrollbar {eval [concat "scrollbar" $w.$value $pos ] }
Spinbox {eval [concat "spinbox" $w.$value $pos ] }
draw {variable fenetre ; undumpdraw $w.[lindex [split $value .] end] $pos}
arc {eval $w create arc $value $pos }
line {eval $w create line $value $pos }
rectangle {eval $w create rectangle $value $pos}
polygon {eval $w create polygon $value $pos}
oval {eval $w create oval $value $pos}
text {eval $w create text $value $pos }
image {tk_messageBox -message pos=$pos ;$w create image $value -image [image create photo -file [file join [file dirname $ttcFile ] [lindex $pos end] ]] }
bitmap {eval $w create bitmap $value $pos}
window {variable fenetre ; eval $w create window $value -window $w.[ lindex [split [lindex $pos 1] . ] end ] }
}
}
}
proc dumpcanvas w {
set res {}
foreach element [$w find all] {
set items {}
foreach option [$w itemconfigure $element] {
if {[string compare [lindex $option 0] -image] ==0} {
tk_messageBox -message "procDumpCanvas image element=$element "
set iname [ $w itemcget $element -image]
if { [lindex $option 3] ne [lindex $option 4]} {
lappend items [lindex $option 0] [lindex [split [lindex [lindex [$iname configure] 2] end] / ] end ] ;
}
} else {
if { [lindex $option 3] ne [lindex $option 4]} {
lappend items [lindex $option 0] [lindex $option 4]
}
}
}
if [llength $items] {lappend res [$w type $element] [$w coord $element] $items }
}
return $res
}
proc dumptags w {
set res {}
foreach tagName [$w tag names] {
set items {}
foreach balise [$w tag configure $tagName] {
if { [lindex $balise 3] ne [lindex $balise 4]} {
lappend items [lindex $balise 0] [lindex $balise 4]
}
}
if [llength $items] {lappend res tag $tagName $items}
}
set res
}
proc dumpwindows w {
# il faut retrouver dans cette proc un shema semblable à dumptags : trois chaines dans une liste.
set res {}
foreach widget [winfo children $w] {
set suffix [lindex [split $widget .] [ expr [llength [split $widget .] ] - 1 ] ]
set items {}
foreach opti [$widget configure] {
if { [lindex $opti 3] ne [lindex $opti 4]} {
lappend items [lindex $opti 0] [lindex $opti 4]
}
}
if [llength $items] {lappend res [winfo class $widget] $suffix $items}
if {[string compare [winfo class $widget] Entry] == 0} {
foreach {opt val } $items {
if {[string compare $opt "-textvariable"] == 0 } {
variable $val
lappend res variable $val [set $val]
}
}
}
if {[string compare [winfo class $widget] Text] == 0} {
set contenu [dumptags $widget ]\n[dumpwindows $widget]\n[$widget dump 1.0 end]
lappend res contenu $widget $contenu
}
if {[string compare [winfo class $widget] Canvas] == 0} {
set contenu [dumpwindows $widget]
if {$contenu != ""} {
lappend res Dwindow $widget $contenu }
set draw [dumpcanvas $widget]
if {$draw != ""} {
lappend res draw $widget $draw}
}
}
set res
}
proc saveTagsAndText { w } {
variable application
variable ttcFile
# Il importe d'avoir une variable ''ttcFile'' afin de connaitre le nom du fichier ttc pour les sauvegardes rapides.
# ceci n'est pas nécessaire si on supprime la distinction entre ''sauvegarder'' et ''sauvegarder sous...''
# la variable saveflag est prévue pour distinguer éventuellement une fonction "Save" d'une fonction "Save As..."
variable saveFlag
set types {
{{Fichier TTC} {.ttc}} {{Fichier Texte} {.txt}} {{Tout fichier } {.*}}
}
# si le fichier a déja été sauvegardé sous un nom, l'enregistrement se fait de manière transparente.
if {$saveFlag == 1} {
set choix $ttcFile
set idf [open $choix w]
set dumpie [dumptags $w ]\n[dumpwindows $w]\n[$w dump 1.0 end]
puts -nonewline $idf $dumpie
close $idf
tk_messageBox -message "le fichier $choix a bien été enregistré.
The file $choix is saved well. "
return
}
# sinon une boite tk_getSaveFile s'ouvre, pour choisir un nom de fichier :
if {$saveFlag==0} {
set choix [ tk_getSaveFile \
-title " Sauvegarder sous ... / Save as ..." -defaultextension .ttc -filetypes $types] ;
set fichier $choix
} else {
if [catch {set choix $fichier}] {
tk_messageBox -type ok -icon warning \
-message "Aucun fichier n'a encore été défini, utilisez :\n''Sauvegarder sous''.
Not yet defined file: use ''Save as ...''."
return
}
}
if {$choix==""} {
tk_messageBox -type ok -icon warning \
-message "Erreur d'écriture ... le fichier n'a pas été enregistré.
Write error ... the file was not saved."
} else {
set idf [open $choix w]
set dumpie [dumptags $w ]\n[dumpwindows $w]\n[$w dump 1.0 end]
puts -nonewline $idf $dumpie
close $idf
set ttcFile $choix
set saveFlag 1
}
}
proc loadTTCfile w {
variable ttcFile
set types {
{{Fichier TTC} {.ttc}} {{Fichier Texte} {.txt}} {{Tout fichier } {.*}}
}
set choix [tk_getOpenFile -defaultextension .ttc -filetypes $types]
set ttcFile $choix
if [ catch { open $choix } FIC ] {
tk_messageBox -type ok -icon warning \
-message "Impossible d'ouvrir le fichier $choix
The file $choix cannot be open."
return 1
} else {
set contenu [ read -nonewline $FIC ]
regsub -all {\ {4}} $contenu "\t" contenu
undump $w $contenu
close $FIC
return 0
}
}
#Fin des procédures TTC
#\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
#-----------------------
# fin de TouTanKamon
#_______________Catégorie Exemple | Catégorie Interface utilisateur