TouTanKamon : éditeur de texte .TTC

 

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