#!/bin/bash
	  # lancement de l'interpréteur wish\
	  exec wish "$0" "${1+"$@"}"
	  
	  
	  #______________________________________________________
	  #	 Occurrences janvier 2007 - 
	  # ______________________________________________________
	  
  	 # OCCURRENCES  est un mini programme permettant de rechercher 
	  # des mots dans un texte d'un widget "text" 
	  # écrit en TCL-TK
	  # auteur : daniel MACOUIN à partir de codes d'autres personnes. 
	  # licence NOL
	
	  #=======================================================
	  # l'interface est minimaliste, elle sert pour illustrer les routines de recherches
	 # qui peuvent s'insérer dans n'importe quel éditeur de texte écrit en TclTk
	  #---------------------------------------------------------------------------------------------------
	
	
	
	
	 package require Tk
	
	#<programme> d'accueil pour les routines "Occurrences"
	
	frame .f
	pack .f -side top -expand 1 -fill x
	
	button .f.b0 -text "ouvrir un fichier  " -bg red -fg yellow  -command "ChargerTexte   .texte"
	pack .f.b0 -side left -fill x -expand 1
	
	button .f.b1 -text Quitter -bg red -fg yellow  -command "exit" 
	pack .f.b1 -side right -fill x 	-expand 1
	
	button .f.b2 -text Rechercher -bg GreenYellow -fg black  -command ChoisirMot 
	pack .f.b2  -side right -fill x -expand 1
	
	text .texte -width 50 -height 35 
	pack .texte -side bottom -expand 1 -fill both
	
	
	
 proc ChargerTexte { widtexte } {
		 
 set choix [ tk_getOpenFile -title "OCCURRENCES  : 0uvrir"]
		  if [ catch { open $choix } FIC ] {
		  tk_messageBox -type ok -icon warning \
			  -message "Impossible d'ouvrir le fichier $choix"
		  return 1
		} else {
		  $widtexte delete 0.0 end
		  set contenu [ read -nonewline $FIC ]
		  regsub -all {\ {4}} $contenu "\t" contenu
		  $widtexte insert 0.0 $contenu
		   		
		  close $FIC
		  return 0
		}
	  }
		
	  
	  
	

	  


	  ###########################################################################
	  #	# LES ROUTINES d' "OCCURRENCES "
	  ###########################################################################
 #<Occurences>

 # la variable global widtexte est nécessaire. 
 # Elle désigne le widget text dans lequel il faut rechercher la suite de mots indiqués. 
 # dans cet exemple se sera le widget " text" nommé .texte
	global widtexte
	set widtexte .texte 
	
 proc OuvrirAide {aide}  {
	tk_messageBox -message " AIDE  pour OCCURRENCES \n$aide"
	}
	
 proc OuvrirAideRegExp {aide} {
		destroy .topRG
		# création d'une fenêtre pour les expressions régulières
		toplevel .topRG
		set largeurEcran [ winfo screenwidth . ]
		wm geometry .topRG +[expr ${largeurEcran}/2]+60
		text .topRG.fenRG -wrap none  -bg beige  -fg black\
			-tabs {1c} -font "Helvetica 10"	-yscrollcommand ".topRG.sy set" -xscrollcommand ".topRG.sx set" -relief groove  -cursor "hand1"
		scrollbar .topRG.sy -orient vertical -command ".topRG.fenRG yview" -cursor hand2
		scrollbar .topRG.sx  -orient horizontal -command ".topRG.fenRG xview" -cursor hand2
		
		pack .topRG.sx -fill x  -side top
		pack .topRG.sy -fill y -side left
		pack .topRG.fenRG -expand false -fill both -side left
		
		.topRG.fenRG insert 1.0 $aide
	
		.topRG.fenRG configure -state disabled
		bind .topRG <3> {destroy .topRG}
		
	  }
	  


 proc ChoisirMot {} {
		destroy .topMot 	; #ferme la fenêtre précédemment ouverte
		toplevel .topMot		; #ouvre la fenêtre de recherche
		
 #----------------------------------------
		
		variable fichierAideRegExp {
	Aide mémoire sur les 
		
 EXPRESSIONS REGULIERES
 *************************************

 ________________________
 SYNTAXE
 regexp ?option? motif chaine ?variables?
 ________________________
 options
	-about	informations sur l'expression régulière
	-all	  recherche toutes les occurences du motif défini
	-expanded la syntaxe développée est acceptée
	-indices  retourne la position des occurences trouvées
	-inline   les résultats sont retournés sous forme de liste
	-lineanchor ancrage aux extrémités des lignes
	-linestop  pas de correspondances sur plusieurs lignes
	-line	  recherche ligne par ligne
	-nocase	  recherche sans tenir compte de la casse des caractères
	-start	  recherche à partir de l'indice défini
	--	  fin des options
 ________________________
 METACARACTERES

 .	n'importe quel caractère, sauf fin de ligne
 []	n'importe quel caractère entre crochets
 *	zéro ou plusieurs fois
 +	une ou plusieurs fois
 ?	zéro ou une fois
 ^	1)en début d'expressio : début de ligne
	2) entre crochet : pas les caractères entre crochets
 $	fin de ligne
 \	caractère modifiant le sens du caractère qui le suit
 ()	sert à grouper des sous expressions
 |	ou d'alternative propre à regexp
 ________________________
 LES "ECHAPPEMENTS"

 \a	bip interne
 \b	retour arrière
 \f	saut de page
 \n	saut de ligne
 \r	retour chariot
 \t	tabulation horizontale
 \v	tabulation verticale
 \B	contre-oblique \

 \d	nombre entier
 \s	espace
 \w	lettre, chiffre ou _
 \D	tout sauf un nombre
 \S	tout sauf une espace
 \W	tout sauf lettre chiffre ou _

 \m	debut de mot
 \M	fin de mot
 \y	extrémité de mot
 \Y	pas une extrémité de mot
 \A	début de chaine
 \Z	fin de chaine

 \e	séquence ESC (octal: 033)
 \0	zéro octet nul
 \xy	code octal 0xy
 \xyz	code octal xyz
 \xhhh	code hexadécimal 0xhhh
 \uxxxx Unicode U+xxxx
 \Uxxxxxxxx Unicode U+xxxxxxxx
 \cX	mise à zéro des 3 bits forts de X

 a-z	tout caractère alpha minuscule
 A-Z	tout caractère alpha majuscule
 ___________________________
 LES CLASSES

 [:alpha:]	lettres alpha
 [:upper:]	lettres majuscules
 [:lower:]	lettres minuscules
 [:digit:]	chiffre 0 à 9
 [:xdigit:]	nombre hexadécimal
 [:alnum:]	alphanumérique
 [:print:]	caractère affichable
 [:blank:]	espace ou tabulation
 [:space:]	espace
 [:punct:]	tout caractère de ponctuation
 [:graph:]	tout caractère imprimable
 [:cntrl:]	caractère non imprimable


 ======================== }

 #-------------------------------------------------
		
		
		variable fichierAide 		"Saississez le mot ou la portion de phrase que vous recherchez dans le texte.
		Des options permettent de  préciser votre recherche.
		
		Après avoir lancé la recherche, un deuxième volet s'ouvre à droite du tableau de commande. les résultats sont affichés.
		En positionnant le curseur de la souris sur une de ces lignes, une bulle apparait contenant le paragraphe où se trouve cette occurrence du motif recherché.
		Un clic gauche sur la ligne positionne le paragraphe dans la fenêtre principale.
		
		Tant que la fenêtre de recherche n'est pas refermée, le début des occurrences est marqué par un point jaune. 
		Un clic droit dans la fenêtre de recherche la referme, et le surlignage jaune disparait."
#-------------------------------------------------
	
		frame .topMot.f	
		button .topMot.f.boutonAide -text Aide -bg beige -fg red -command {variable fichierAide ; OuvrirAide $fichierAide} 
		button .topMot.f.boutonAideRegExp  -text "Aide memoire RegExp" -bg beige -fg red -command {variable fichierAideRegExp ; OuvrirAideRegExp $fichierAideRegExp} 
	
	
		label .topMot.label1 -text "Saisissez la phrase à rechercher :"  -height 2 -fg black -width 35 -font {-size 8}  -bg beige -justify left
		entry .topMot.entreMot  -textvariable motRecherche -font {-size 12} -bg ivory -justify left
		checkbutton .topMot.ch1 -text "Différencier Maj/Min" -variable majmin -onvalue 1 -offvalue 0 -font {-size 12} -bg beige -justify left
		checkbutton .topMot.ch2 -text "Expression Régulière" -variable expressRegul -onvalue 1 -offvalue 0 -font {-size 12} -bg beige -justify left
		checkbutton .topMot.ch3 -text "Dans texte caché	" -variable texteCache  -onvalue 1 -offvalue 0 -font {-size 12} -bg beige -justify left
		
		radiobutton .topMot.ch4 -text "Après curseur	" -variable wards  -value forwards -font {-size 12} -bg beige -justify left
		radiobutton .topMot.ch5 -text "Avant curseur	" -variable wards  -value backwards  -font {-size 12} -bg beige -justify left
		radiobutton .topMot.ch6 -text "Tout le texte	" -variable wards  -value 0  -font {-size 12} -bg beige -justify left
		radiobutton .topMot.ch7 -text "Texte sélectionné" -variable wards  -value selection  -font {-size 12} -bg beige -justify left
		
		button .topMot.ok -text "lancer la recherche" -bg beige -fg blue -font {-size 12} -bd 5 -relief raise \
			 -command { AfficheListeOccurences $widtexte $motRecherche $wards $texteCache $majmin $expressRegul  } -justify left
	
	grid .topMot.f -column 1 -row 0 -padx 3 -sticky ew
		#grid .topMot.boutonAide -column 1 -row 0 -padx 3 -sticky ew
		grid .topMot.label1   -column 1 -row 1 -padx  3 -sticky ew
		grid .topMot.entreMot -column 1 -row 2 -padx 3 -sticky ew
		grid .topMot.ch1 -column 1 -row 3 -padx 3 -sticky ew
		grid .topMot.ch2 -column 1 -row 4 -padx 3 -sticky ew
		grid .topMot.ch3 -column 1 -row 5 -padx 3  -sticky ew
		grid .topMot.ch4 -column 1 -row 6 -padx 3  -sticky ew
		grid .topMot.ch5 -column 1 -row 7 -padx 3  -sticky ew
		grid .topMot.ch6 -column 1 -row 8 -padx 3  -sticky ew
		grid .topMot.ch7 -column 1 -row 9 -padx 3  -sticky ew
		grid .topMot.ok  -column 1 -row 10 -padx 3 -sticky ew
		
		pack .topMot.f.boutonAide .topMot.f.boutonAideRegExp -side left -fill x -expand 1
		
		bind .topMot <3> {destroy .topMot }
		
	  }
	  

 proc RechercherElement { widtexte element wards texteCache minMaj expressRegul } { 
 
		
		variable ListeOccurences
		
		 set indices [ $widtexte tag ranges sel ]
		  if { [llength $indices] == 0  } {
		  set debut 1.0
		  set fin end
		} else {
		  	set indices [ $widtexte tag ranges sel ]
		 	set debut [$widtexte index  [lindex $indices 0]]
			set fin [$widtexte index  [lindex $indices 1]]
			  }
		  
		
		$widtexte tag remove  surligner 1.0 end
		
	
		#différenciation des majuscules et des minuscules
		if {$minMaj == 1} {
		set  casse ""
		} else {
		 set casse "-nocase"
		}
		# recherche avec ou sans expression régulière
		set ListeOccurences ""
		if {$expressRegul==1} {
		  set com "-regexp $casse \{$element\}"
		} else {		  
		  set com \"$element\"
		}
		
		#recherche avec ou sans texte caché
		if {$texteCache == 1} {
			set masque "-elide"
		} else {
			set masque ""
		}
		
		#sens de la recherche
				
		switch $wards forwards {set debut [$widtexte index insert] ; set fin end  }
		switch $wards backwards {set fin [$widtexte index insert] ;set debut 1.0 }
		switch $wards 0 {set fin end  }
		switch $wards "" {set debut 1.0 ; set fin end  }
		switch $wards "selection" {set debut $debut ; set fin $fin  }
		
		# boucle de recherche enregistrant les indices d'occurences dans une liste "ListeOccurences"
		while 1 {
		  set lacom "$widtexte search $casse $masque -count longueur $com  \"$debut\" \"$fin\" "
		  set indice [eval $lacom]
		  if {$indice==""} { break }
		  lappend ListeOccurences $indice
		  set debut "$indice + $longueur char"
		}
		
	
	}
	
	
 proc AfficheListeOccurences { widtexte element wards texteCache majmin expressRegul} {
		variable ListeOccurences
		
				
		destroy .topMot.fenoccs
		destroy .topMot.occssy
		scrollbar .topMot.occssy -orient vertical -command ".topMot.fenoccs yview" -cursor "hand2"
		text  .topMot.fenoccs -wrap word -bd 6 -relief raised -bg lavender -fg black \
			-tabs {1c} -font "Helvetica 12" -height 18 -yscrollcommand ".topMot.occssy set" -width 40 -cursor "hand1"
		
		
		
	
		
		RechercherElement $widtexte $element $wards $texteCache $majmin $expressRegul
		
		grid .topMot.fenoccs  -row 1 -column 2 -rowspan 10
		grid .topMot.occssy -row 1 -column 3 -rowspan 10 -sticky ns
		
		# lancement de la boucle d'affichage dans la fenêtre crée à la ligne ci-dessus
		set compteur 0
		if {[llength $ListeOccurences]!=0} {
		  foreach el $ListeOccurences {
			
			set ligneOccurence "... ligne N° $el ème caractère..." ;# $el est un indice text (ex : 10.5 ) N°ligne.N°caractère
			
			$widtexte tag add surligner $el
			$widtexte tag configure surligner -background yellow
			
			.topMot.fenoccs insert end "Occurence $compteur : $ligneOccurence"
			.topMot.fenoccs tag add $compteur "current linestart" "current lineend"
			.topMot.fenoccs tag configure $compteur -foreground blue -underline 1
			.topMot.fenoccs tag bind $compteur <1> "$widtexte see $el ;destroy .topBulleOccurence "
			
			.topMot.fenoccs tag bind $compteur <Enter> ".topMot.fenoccs tag configure $compteur -background AntiqueWhite  -foreground blue -underline 1 ; BulleOccurence $widtexte $el"
			.topMot.fenoccs tag bind $compteur <Leave> " .topMot.fenoccs tag configure $compteur -background  lavender  ; destroy .topBulleOccurence "
			
			.topMot.fenoccs insert end \n
			incr compteur
			
			
		  }

		}
		.topMot.fenoccs insert 1.0 "$compteur occurence(s) de \"$element\"\n\n"
		
		bind .topMot.fenoccs <3> {	destroy .topBulleOccurence  ;	destroy .topMot	; $widtexte tag remove "surligner" 1.0 end }
	  }
	  
 proc BulleOccurence { widtexte indice} {
		toplevel .topBulleOccurence
		text .topBulleOccurence.texte   -bg White -fg tomato -relief raised -borderwidth 2 -wrap word -width 45
		
		wm overrideredirect .topBulleOccurence  1 ; # supprime la barre de titre
		set x [ winfo pointerx . ]
		set y [ winfo pointery . ]
		wm geometry .topBulleOccurence  +[expr $x + 10]+[expr $y - 10]
		
		set contenuLigneOccurence [ string trimleft [$widtexte get "$indice linestart" "$indice  lineend" ] " \t"]
		set contenuLigneOccurence [ string trimright $contenuLigneOccurence " " ]
		.topBulleOccurence.texte insert end $contenuLigneOccurence
		pack .topBulleOccurence.texte
		.topBulleOccurence.texte configure -height [expr [string length $contenuLigneOccurence] / 45 + 1] 
		
	  }
	
 #---------------------------------------------------------------------------------------------------------------------------------------