# ----------------------------------------------------------------------------
# Boite de saisie de texte
#
# Michel Beaudouin-Lafon
# Nov, 1997
#
# mailto:mbl@lri.fr
# http://www-ihm.lri.fr/~mbl/
# ----------------------------------------------------------------------------

# --- UniqueWidgetName root
#	cree un nom unique de widget
# parametres
#	root	nom de widget que l'on veut rendre unique
# valeur de retour
#	nom unique de widget
#
proc UniqueWidgetName {root} {
	# ajouter un numero a la fin du nom jusqu'a ce que la fenetre n'existe pas
	set i 0
	while [winfo exist $root$i] {
		incr i
	}
	return $root$i
}

# --- GetText_Done top
#	callback pour le bouton OK de la boite de saisie de texte
# parametre
#	top	nom du toplevel widget contenant la boite de dialogue
# valeur de retour
#	aucune
#
proc GetText_Done {top} {
	# recuperer la valeur
	global GetText_String
	set GetText_String [$top.entry get]
	# detruire la boite de dialogue
	destroy $top
}

# --- GetText_EnableOK top
#	active ou desactive le bouton OK selon la valeur du champ de saisie
# parametre
#	top	nom du toplevel widget contenant la boite de dialogue
# valeur de retour
#	aucune
#
proc GetText_EnableOK {top} {
	if {[$top.entry get] == ""} {
		$top.ok configure -state disabled
	} else {
		$top.ok configure -state normal
	}
}

# --- GetText msg [default]
#       saisie d'un texte
# parametre
#       msg     message a afficher
#	default	valeur par defaut (chaine vide par defaut)
# valeur de retour
#	chaine saisie ou chaine vide si l'utilisateur a annule
#
proc GetText {msg {default {}}} {
	# variable qui contiendra la chaine saisie
	global GetText_String
	set GetText_String {}
	
	# creer la fenetre et lui donner un titre
	set top [toplevel [UniqueWidgetName .get]]
	wm title $top Saisie
	wm geometry $top +100+100
	
	# creer le message, la zone de saisie et les boutons OK et Annuler
	label $top.msg -text $msg
	entry $top.entry -width 20
	$top.entry insert 0 $default
	button $top.cancel -text Annuler -command "destroy $top"
	button $top.ok -text OK -command "GetText_Done $top"
	
	# placer les elements
	pack $top.msg -side top -fill both -expand on -padx 5 -pady 5
	pack $top.entry -side top -fill x -padx 5 -pady 5
	pack $top.ok -side right -anchor s -padx 5 -pady 5
	pack $top.cancel -side right -anchor s -padx 5 -pady 5
	
	# Return sur la zone de saise = OK
	bind $top.entry <Key-Return> "$top.ok invoke"
	
	# gerer l'activation du bouton OK.
	# il faut utiliser bindtags pour que le binding soit execute
	# apres les bindings standards du widget entry.
	# on utilise le tag enableOK a cet effet.
	if {$default == ""} {
		$top.ok configure -state disabled
	}
	bind entryEnable <Key> "GetText_EnableOK $top"
	bindtags $top.entry [concat [bindtags $top.entry] entryEnable]
	
	# attendre que l'on clique dans le bouton OK
	focus $top.entry
	grab set $top
	tkwait window $top
	
	# retourner la valeur saisie
	return $GetText_String
}

# ---- test

while {1} {
	set fich [GetText "Nom de fichier :"]
	puts "fichier=$fich"
}