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