The Wayback Machine - http://web.archive.org/web/20140815235508/http://wfr.tcl.tk:80/1116

## TTC : sauvegarder les tags et les images avec le texte d'un widget text

SAUVER LES TEXT ET LEURS CONTENUS et leurs contenus et leurs contenus ...

Le texte d'un widget text peut être sauvegardé au format TXT, c'est à dire sans formatage autre que les sauts de lignes.

Pour sauvegarder

- les tags,
- les images(photo)
- les widgets et leurs contenus
- et le contenu des canvas intégrés (line, rectangle, polygone ... image, canvas et leurs contenus ...)

voici le format TTC : un système simple s'appuyant sur la commande dump.

     26/05/06 -- Quelques complications inattendues ( et donc négligées ) font que les menus
     ne sont pas (encore?) sauvegardés. C'est le dumpage des items du menu qui pose problèmes.

dMc : Je me suis laissé embarquer par le sujet et les mystères et les beautés de la récurrence. TTC est semble-t-il au terme de son évolution et sauvegarde aussi les canvas et leurs contenus, a priori sans limitations de niveaux d'imbrication. Un fichier sauvegardé en TTC peut être réouvert avec une application différente de celle qui l'a créé, le chemin du widget text où on insère le fichier n'a pas d'importance, on s'en convaincra en créant un document avec Toutankamon et en le relisant avec TTCreader fourni ci-après.

Le principe général m'a été fourni par RS, en réponse à Une question ... J'ai rajouté les lignes pour les images et les widgets ainsi que les variables et les contenus et articulé des commandes sauvegarder et charger un fichier avec l'extension ".TTC" par défaut. N'importe quelle extension de nom fait cependant l'affaire.

Le premier nom envisagé pour ce format était TTK, mais je me suis aperçu que ttk était utilisé par TILE pour son espace de nom. Une recherche sur le wiki anglais et celui-ci ne signale aucun TTC déjà utilisé : va pour .ttc.

Les routines sont générales et peuvent être remployées telles quelles dans une nouvelle application, à condition de faire attention à la configuration des tags qui doivent pouvoir être re-configurés à partir du texte enregistré. C'est essentiellement pour les noms de police qu'il importe de se montrer vigilant en utilisant des listes pour que par exemple courier new soit un élément d'une liste {courier new}.

Les images doivent être situées au même niveau que le fichier texte *.ttc que l'on ouvre.

Ci-dessous

- les procédures de base

23/01/07 - voir TtcReader : lecteur de fichier .TTC pour les codes promis ci-dessus

TouTanKamon voir TouTanKamon : éditeur de texte .TTC

Toutankamon est un programme pour l'exemple, qui ne sert qu'à explorer .TTC

procédures de base Ces procédures doivent être intégrées dans un logiciel. Seules elles ne servent à rien.

     #\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
     #<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
     #\\\\\\\\\\\\\\\\\\\\\\\\\\\\\