 #!/bin/bash
	  # lancement de l'interpréteur wish\
	  exec wish "$0" "${1+"$@"}"

	package require Tk
 # ______________________________

 # 							TTCReader
 # Lecteur de fichier texte au format TTC (TousTags Compris )
 #_______________________________



 wm title . "Lecteur Ttc *** TtcReader "
 frame .f
 pack .f  -fill x
 frame .f2
 pack .f2  -fill both -expand true

 button .f.ouvrir -text "ouvrir un fichier .ttc" -command {destroy .f2.texttc ; text .f2.texttc -bg ivory -xscrollcommand {.f2.scrolx set}  -yscrollcommand {.f2.scroly set} -wrap none ;pack .f2.texttc -fill both -expand true -side left ; loadTTCfile .f2.texttc }
 pack .f.ouvrir -fill x -expand true -side left

 button .f.sauver -text "sauver un fichier en .ttc" -command { saveTagsAndText .f2.texttc }
 pack .f.sauver  -fill x -expand true -side left

 scrollbar .f2.scrolx  -orient horizontal -command {.f2.texttc xview}
 pack .f2.scrolx -side bottom  -fill x

 scrollbar .f2.scroly -orient vertical -command {.f2.texttc yview}
 pack .f2.scroly -side right  -fill y

 text .f2.texttc -bg ivory -xscrollcommand {.f2.scrolx set}  -yscrollcommand {.f2.scroly set} -wrap none
 pack .f2.texttc -fill both -expand true -side left



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