> Retour au Perl et XML - Maitrise Tal 2002 <


 

-----------------------------------> Document MenuGosia.pl

 

#/usr/local/bin

#-- M. Stachura Mai 2002

 

use Tk; #-- Programme utilisant l'extension Tk de Perl.

use Tk::Text;

use Tk::TextUndo;

use Tk::Date;

use Tk::Balloon;

use Tk::Animation;

use Tk::FBox;

use Tk::Toplevel;

use Tk::FileSelect;

 

use XML::Parser; 

use XML::XPath;  

$mkTextXpath;

 

 

 

#------------------

#Tableaux

@courant=();

%Courant=();

@liste_xmlBalise = ();

%Liste_xmlBalise = ();

%compteurBaliseXml=() ;

%listeBaliseXml=();

%mapTextFull=() ;

@mapText=();

 

 

#---------------------------------------------------------------------------

######### Variables globales pour toutes les actions #################

#--Creations de la fenetre principale et d'un cadre.

 

$mw= MainWindow->new;

 

 

 

#-- Image Boutons dans le dossier icons

 

$imageSearch = $mw->Photo(-file => "icons/search.xpm");

$imageLoad = $mw->Photo(-file => "icons/doc.xpm");

$imageExit = $mw->Photo(-file => "icons/small.exit.xpm");

$imageSave = $mw->Photo(-file => "icons/filesave.xpm");

$imageSelect=$mw->Photo(-file => "icons/small.select_3d.xpm");

$imageDelete=$mw->Photo(-file => "icons/cut.xpm");

 

#-- Variables

$mw->title("Interfaces graphiques avec Perl/Tk - Mai 2002");

 

$winBalloon;

 

#-- Variable des bulles d'information

$winBalloon = $mw->Balloon(

                                                  -initwait => 100,

                                                  -state    => 'balloon',

                                                  -background => 'pink',

                                                  );

 

 

#---------------------------------------------------

 

#-- texte inscrit par defaut dans la fenetre adresse

$nom_fic="C:\\votre_fichier.txt";

 

$cadre1 = $mw->Frame->pack(-side => 'top',

                                                 -fill => 'x');

 

my $date = $cadre1->Date(-editable => 0,

 

                 -variable => \$time,

 

                 -value => 'now',

                -foreground => 'white',

                )->pack(-side => 'left');

 

$date->repeat(999, sub { $time = time(); });

 

my $running;

my $enfant=$mw->Animation('-format' => 'gif',

                                                  -file => Tk->findINC('anim_enfant.gif'));

 

my $l = $cadre1->Label(-image => $enfant)->pack(-side => 'right');

$BoutonAnim=$cadre1->Button(-text => 'l / O',-relief => 'groove', -background => '#669999',

                            -foreground => 'darkgreen',

                               -command => sub {

                                if (!$running) {

                                    $enfant->start_animation(80);

                                } else {

                                    $enfant->stop_animation();

                                }

                                $running = !$running;

                     })->pack(-side => 'right');

 

$winBalloon->attach($BoutonAnim,

                  -balloonmsg => "Marche/Arrêt" );

 

################################################################################# 

 

$cadre = $mw->Frame->pack(-side => 'top',

    -fill => 'x');

 

####------- Creation du Menu 'Fichier' (Ouvrir, Enregistrer, Chercher, Quitter).-----------####

 

$a_menu=$cadre->Menubutton(-text => "Fichier",

                                                  -tearoff => 0,

                                                  -relief => 'ridge',

                           -background => 'orange',

 

                                                  -menuitems => [['command' => "Ouvrir",

                                                                               -command => \&query_file_dialog],

                                                                                               

                                                                      ['command' => "Enregistrer",

                                                                              -command => \&sauve_fic],

 

                                                                      ['command' => "Chercher",

                                                                              -command => \&search_in_fic],

 

                                                                      ['command' => "Quitter",

                                                                              -command =>  sub {exit;}]])->pack(-side => 'left');

 

 

#-- Creation du Menu 'Edition' (I-Search, Repeat ISearch, Global Search, I-Replace ...).

#--recherches incrementales/globales avec ou sans regexp

$c_menu=$cadre->Menubutton(-text => "Edition",

                                                  -tearoff => 0,

                                                  -relief => 'ridge',

                                                  -background => 'darkorange',

 

                                                  -menuitems => [['command' => "Rechercher une occurence",

                                                                                 -command => \&i_search],

                                                                                ['command' => "Repeter la Recherche",

                                                                                 -command => \&i_search2],

                                                                                ['command' => "Recherche globale",

                                                                                 -command => \&search_in_fic],

                                                                                ['command' => "Remplacer une occurence ",

                                                                                 -command => \&i_replace],

                                                                                ['command' => "Repeter le Remplacement",

                                                                                 -command => \&i_replace2],

                                                                                ['command' => "Remplacement global",

                                                                                 -command => \&replace]])->pack(-side => 'left');

 

$mw->bind(Tk::Text,"<Button-3>",sub{ $c_menu->Popup(-popover => 'cursor',

_popanchor => "nw")});

 

####------ Creation du Menu 'Balises' (Voir, Effacer, Rechercher ....).-----####

 

$d0_menu=$cadre->Menubutton(-text => "Balises <[^>]+>",

                                                   -tearoff => 0,

                                                   -relief => 'ridge',

                                                    -background => '#f85d4e',

                               -menuitems => [['command' => "Voir",

                                                                                  -command => \&list_balise],

                                                                                 ['command' => "Effacer",

                                                                                  -command => \&del_balise],

                                                                                 ['command' => "Rechercher",

                                                                                  -command => \&search_balise],

                                                                                 ['command' => "Recherche une balise",

                                                                                  -command => \&i_search],

                                                                                 ['command' => "Repeter la Recherche",

                                                                                  -command => \&i_search2],

                                                                                 ['command' => "Effacer le texte entre les signes",

                                                                                  -command => \&query_search_text_in_balise]

                                                                                 ])->pack(-side => 'left');

 

 

####------ Creation du Menu 'Outils' ( Extract, Concordance, Dico ).------####

$c_menu=$cadre->Menubutton(-text => "Outils",

                                                  -tearoff => 0,

                                                  -relief => 'ridge',

                                                  -background => '#ff0000',

 

                                                  -menuitems => [['command' => "Extraire-from-tag",

                                                                                 -command => \&extract],

                                                                                ['command' => "Concordance",

                                                                                 -command => \&concordance],

                                                                                ['command' => "Dico",

                                                                                 -command => \&dico]])->pack(-side => 'left');

 

 

####-------- Creation du Menu 'Count' (Search, RegexpSearch ).--------####

$d_menu=$cadre->Menubutton(-text => "Count",

 

                     -tearoff => 0,

                     -relief => 'ridge',    

                  -background => '#FF0066',

                     -menuitems => [['command' => "Rechercher",

                                                                    -command => \&search_in_fic],

                                                                   ['command' => "RegexpSearch",

                                                                    -command => \&search_in_fic]])->pack(-side => 'left');

 

 

 

 

####------ Creation du Menu 'Outils XML'----------#####

 

$e_menu=$cadre->Menubutton(-text => "Outils Xml",

                                                  -tearoff => 0,

                                                  -relief => 'ridge',

                                                  -background => 'maroon',                     

     -menuitems => [['command' => "Xpath",

                                                         -command => \&xmlXpath]])->pack(-side => 'left');

      

 

 

####------ Creation d'un cadre avec le texte "Adresse :".------####

$cadre->Label(-text => "Adresse : ")->pack(-side => 'left',

                                                                     -anchor => 'w');

 

 

####------- Creation d'une zone de texte de l'adresse a indiquer.------####

$Adres=$cadre->Entry( -foreground => '#9e6303',

                       -textvariable => \$nom_fic)->pack(-side => 'left',

                                                                                              -anchor => 'w',

                                                                                              -fill => 'x',

                                                                                              -expand => 1);

$winBalloon->attach($Adres,

                  -balloonmsg => "Taper le chemin de votre fichier" );

 

 

####------- Creation d'un bouton avec le texte "Ouvrir".------####

$BoutonOuvrir=$cadre->Button(-text => "Ouvrir",

                -image => $imageLoad,

                       -background => '#99CC99',

                       -foreground => 'white',

 

                       -command => sub {&lire_fic})->pack(-side => 'left',

                                                                                                 -anchor => 'e');

$winBalloon->attach($BoutonOuvrir,

                  -balloonmsg => "Charger le fichier" );

 

 

##################################################################################################

 

########------------ Creation d'une etiquette et d'une zone de saisie----------############

 

##--- Creation d'une zone de saisie.

$zonesaisie=$texte = $mw->Scrolled("Text")->pack(-side => 'bottom',

                                                                    -fill => 'both',

                                                                    -expand => 1);

 

$winBalloon->attach($zonesaisie,

                  -balloonmsg => "Zone de saisie" );

 

##-- Widgets textes.

$texte->Text(-setgrid => 'true');

$search_string = '';

 

###---- Creation d'un cadre avec le texte "Rechercher occurence :".

$w_string = $mw->Frame()->pack(-side => 'top', -fill => 'x');

$w_string_label = $w_string->Label(-text => 'Rechercher occurence :', -width => 20, -anchor => 'w');

$saisie2= $w_string_entry = $w_string->Entry(-textvariable => \$search_string, -width => 48);

$winBalloon->attach($w_string_entry,

                  -balloonmsg => "Taper une occurence" );

 

###---- Creation d'un cadre avec le texte "Effacer occurence :".

$w_string_label2 = $w_string->Label(-text => 'Effacer occurence :', -width => 16, -anchor => 'w');

$w_string_entry2 = $w_string->Entry( -textvariable => \$search_string);

 

###--- Creation du bouton "OK"

$w_string_button = $w_string->Button(-text => 'OK',-image => $imageSearch, -background => '#f0d098');

$winBalloon->attach($w_string_button,

                  -balloonmsg => "Recherche globale" );

 

###---- Creation du bouton "X"

$w_string_button1 = $w_string->Button(-text => 'X', -background => '#FFCC33',  -foreground => 'white');

$winBalloon->attach($w_string_button1,

                  -balloonmsg => "Arrêter la recherche" );

 

###--- Creation du bouton "Supprimer"

$w_string_button2 = $w_string->Button(-text => 'Supprimer', -image => $imageDelete, -background => 'darkorange', -foreground => 'white');

$winBalloon->attach($w_string_button2,

                  -balloonmsg => "Effacer les Occurences sélectionnées" );

 

 

###--- Affichages des etiquettes, zones de saisie et les 3boutons (OK, X, Supprimer):

$w_string_label->pack(-side => 'left');

$w_string_entry->pack(-side => 'left');

 

 

###--- Distance entre les boutons.

$w_string_button->pack(-side => 'left', -pady => 5, -padx => 5);

$w_string_button1->pack(-side => 'left', -pady => 5, -padx => 5);

$w_string_button2->pack(-side => 'left', -pady => 5, -padx => 5);

 

$w_string->pack(-side => 'top', -fill => 'x');

 

$w_string_button->configure(-command => [sub {&text_search($texte, $search_string, 'search')}, $texte]);

$w_string_button1->configure(-command => [sub {&remove_mark_search}]);

$w_string_button2->configure(-command => [sub {&text_delete($texte, $search_string, 'search')}, $texte]);

 

$w_string_entry->bind('<Return>' => [sub {shift; &text_search($texte, $search_string, 'search')}, $texte]);

 

###---- recherche des occurences, plus --> affichage du texte en couleur.

$w_string->pack(-side => 'top', -fill => 'x');

if ($mw->depth > 1) {

    text_toggle($texte, ['configure', 'search', -background => '#5d005d', -foreground => 'white'], 800,

                               ['configure', 'search', -background => undef, -foreground => undef], 200);

} else {

    text_toggle($texte, ['configure', 'search', -background => '#5d005d', -foreground => 'white'], 800,

                               ['configure', 'search', -background => undef, -foreground => undef], 200);

}

$saisie2->delete(0,'end');

 

 

###---- Remplacement des occurences.

$w_string2 = $mw->Frame()->pack(-side => 'top', -fill => 'x');

$w_string2_label = $w_string2->Label(-text => 'Remplacer occurence avec :', -width => 23, -anchor => 'w');

$saisie3= $w_string2_entry = $w_string2->Entry(-textvariable => \$replace_string,  -width => 38,);

$winBalloon->attach($w_string2_entry,

                  -balloonmsg => "Taper une nouvelle occurence" );

 

###---- Creation du bouton "Remplacer" et "contact"------###

$w_string2_button = $w_string2->Button(-text => 'Remplacer', -background => '#6699CC', -foreground => 'white');

$w_string2_label->pack(-side => 'left');

$w_string2_entry->pack(-side => 'left');

$w_string2_button->pack(-side => 'left', -pady => 5, -padx => 10);

 

 

$w_string2_button->configure(-command => [sub {&text_replace($texte, $search_string, $replace_string, 'search')}, $texte]);

$w_string2_entry->bind('<Return>' => [sub {shift; &text_replace($texte, $search_string, $replace_string, 'search')}, $texte]);

$w_string2->pack(-side => 'top', -fill => 'x');

$saisie3->delete(0,'end');

 

 

###---- Creation du bouton 'Quitter'.

$BoutonQuitter=$cadre->Button(-text => "Quitter",

                       -image => $imageExit,

               -background => 'darkgreen',

                -foreground => 'white',

                       -command => sub {exit;})->pack(-side => 'right');

$winBalloon->attach($BoutonQuitter,

                  -balloonmsg => "QUITTER" );

 

###---- Creation du bouton 'Enregistrer'.

$BoutonEnregistrer=$cadre->Button(-text => "Enregistrer",

                               -image => $imageSave,

              -background => '#669966',

                      -command => sub {&sauve_fic})->pack(-side => 'right',

                      -anchor => 'e');

$winBalloon->attach($BoutonEnregistrer,

                  -balloonmsg => "Sauvegarder" );

 

###---- Creation d'une barre d'informations.

$barre=$mw->Label(-textvariable => \$info,

                   -background => '#CCCCCC',

                   -relief => 'groove')->pack(-side => 'bottom',

                   -fill => 'x');

 

$winBalloon->attach($barre,

                  -balloonmsg => "Barre d'informations" );

 

###########################################################

#########--------sous-programmes--------------#############

###########################################################

 

MainLoop;

 

###---1) MENU FICHIER.

##-----a) Ouvrir le fichier

##-- Infos de la barre d'information "charge".

sub lire_fic {

 

    $info="Chargement du fichier < $nom_fic >...";

    $texte->delete("1.0","end");

    if (!open(FIC,"$nom_fic")) {

                $texte->insert("end","ERREUR : Impossible d\'ouvrir < $nom_fic >\n");

                return;

    }

    while (<FIC>) {

                $texte->insert("end",$_);

    }

    close(FIC);

    $info = "Fichier < $nom_fic > chargé.";

}

 

##--- Infos de la barre d'information "enregistré".

sub sauve_fic {

    

    $info="Sauvegarde du fichier < $nom_fic >...";

    open(FIC,">$nom_fic");

    print FIC $texte->get("1.0","end");

    $info= "Fichier < $nom_fic > sauvegardé.";

}

 

##--- Infos de la barre d'information "terminée".

sub search_in_fic {

   

    $info="Recherche dans le fichier < $nom_fic >...";

    &text_search($texte, $search_string, 'search');

    if ($mw->depth > 1) {

                text_toggle($texte, ['configure', 'search', -background => 'SeaGreeRed', -foreground => 'white'], 800,

                                         ['configure', 'search', -background => undef, -foreground => undef],   200);

      } else {

                text_toggle($texte, ['configure', 'search', -background => 'SeaGreeRed', -foreground => 'white'], 800,

                                         ['configure', 'search', -background => undef, -foreground => undef], 200);

      }

    $info= "Recherche dans Fichier < $nom_fic > terminée.";

}

 

 

 

#-- PN9 "Ouvrir" du menu 'Fichier' .

 

sub query_file_dialog {

    if (! Exists ($pn9)) {

 

                $pn9 = $mw ->Toplevel();

                foreach my $i (qw(open)) {

                    my $f = $pn9->Frame;

                    my $lab = $f->Label(-text => "Adresse : ", -anchor => 'e');

 

#-- PN9 Espace pour taper l'adresse

                    my $ent = $f->Entry(-textvariable => \$nom_fic, -width => 50, -background => '#99CCCC');

 

#-- PN9 Creation d'un bouton avec le texte "Parcourir".

                    my $but = $f->Button(-text => "Parcourir",

                                                                -background => '#669966',

                                                                -foreground => 'white',

                                                                -command => sub { fileDialog($pn9, $ent, $i)});

 

#-- PN9 Creation d'un bouton avec le texte "Ouvrir".

                    my $ouv = $f->Button(-text => "Ouvrir",

                                                                -image => $imageLoad,

                                                                -background => '#99CC99',

                                                                -foreground => 'white',

                                                                -command => sub {&lire_fic});

 

#-- PN9 Creation du bouton 'Quitter'.

                    my $quit = $f->Button(-text => "Annuler",

                                                                 -image => $imageExit,

                                                                 -background => 'darkgreen',

                                                                 -foreground => 'white',

                                                                 -command => sub {$pn9->destroy()});

 

#-- PN9 Position des boutons

                    $lab->pack(-side => 'left');

                    $ent->pack(-side => 'left',-expand => 'yes', -fill => 'x', -pady => 20, -padx => 10);

                    $ouv->pack(-side => 'left', -anchor => 'e', -pady => 20, -padx => 10);

                    $quit->pack(-side => 'right',-pady => 20, -padx => 10);

                    $but->pack(-side => 'left');

                    $f->pack(-fill => 'x', -padx => '1c', -pady => 3);

                }

    }

}

 

#--  PN9 "sous-programme du bouton Parcourir"

sub fileDialog {

    my $w = shift;

    my $ent = shift;

    my $operation = shift;

    my $types;

    my $file;

 

#-- PN9 Variable types = Différentes Extension(s) de format pour un document

@types =

    (

     ["All files", '*'],

     ["(HT/X/SG)ML files", [qw/.xml .html .sgml .htm .dtd/]],

     ["Text files", [qw/.txt .doc/]],

     ["Text files", '', 'TEXT'],

     ["Perl Scripts", '.pl', 'TEXT'],

     ["C Source Files", ['.c', '.h']],

     ["All Source Files", [qw/.tcl .c .h/]],

     ["Image Files", '.gif'],

     ["Image Files", ['.jpeg', '.jpg']],

     ["Image Files", '', [qw/GIFF JPEG/]],

     );

 

#-- PN9 Ouvrir le document

if ($operation eq 'open') {

    $file = $w->getOpenFile(-filetypes => \@types);

    if (defined $file and $file ne '') {&load_selected_fic($file);}

    if (Exists ($pn9)) {$pn9->destroy();}

} else {

    $file = $w->getSaveFile(-filetypes => \@types,

                                                   -initialfile => 'Untitled',

                                                   -defaultextension => '.txt');

    if (Exists ($pn9)) {$pn9->destroy();}

}

}

 

 

##--- PN9 Chargement d'un fichier

sub load_selected_fic {

    ($nom_fic) = @_;

    if (&ConfirmNewDocument($texte)) {

                my $nom = "$nom_fic";

                if (!exists ($Courant{$nom})){

                    $Courant{$nom}++;

                    $num_doc++;

                    push (@courant, $nom);

                    $b_menu->command(-label => "$nom",

                                                    -command => [ \&load_selected_fic, "$nom"]);

                }

                $info="Chargement du fichier < $nom_fic >...";

                $texte->Load($nom_fic);

                $info = "Fichier '$nom_fic' chargé.";

    }

}

 

########################################################

 

#-- Variable pour le bouton "OK" Rechercher

sub text_search {

 

    # The utility procedure below searches for all instances of a given string in a text widget and applies a given tag

    # to each instance found.

    # Arguments:

        # w -               The window in which to search.  Must be a text widget.

        # string -       The string to search for. (regexp and so on...)

        # tag -            Tag to apply to each instance of a matching string.

 

    my($w, $string, $tag) = @_;

 

    $w->tag('remove',  $tag, '0.0', 'end');

    (my $num_lines) = $w->index('end') =~ /(\d*)\.\d*/;

    for($i = 1; $i <=$num_lines; $i++) {

                my $line = $w->get("${i}.0", "${i}.1000");

                next if not defined $line or $line !~ /($string)/;

        my $l = length $1;

                $stringRegexp=$1;

                my $offset = 0;

                while (1) {

                    my $tmpoffset=0;

                    my $index = index $line, $stringRegexp, $tmpoffset;

                    last if $index == -1;

                    $offset += $index;

                    $w->tag('add', $tag, sprintf("%d.%d", $i, $offset), sprintf("%d.%d", $i, $offset+$l));

                    $offset += $l;

                    $line = substr $line, $index+$l;

                    if ($line=~/($string)/) { $stringRegexp=$1;

                                                                     $l = length $1;}

 

                } # whilend

    } # forend

 

} # end text_search

 

 

###-- Variable pour le Bouton "Remplacer"

sub text_replace {

     # The utility procedure below searches for all instances of a given string in a text widget and applies a given tag

     # to each instance found.

     # Arguments:

     # w - The window in which to search. Must be a text widget.

     # string - The string to search for. (regexp and so on...)

     # tag - Tag to apply to each instance of a matching string.

 

    my($w, $string, $replace, $tag) = @_;

    my @seenElt=();

    if ($string eq "") {

                &mkPrintErreur("ERREUR : Aucune sélection de chaîne de recherche donnée\n");

                return;

    }

    my $resultat=$w->search(-regexp, "$string",'1.0','end');

    if ($resultat eq "") {

&mkPrintMsgInfo("Aucune chaîne correspondante pour le motif de recherche donné\n");

return;

}

 

$w->tag('remove', $tag, '0.0', 'end');

    (my $num_lines) = $w->index('end') =~ /(\d*)\.\d*/;

    my $id = 0;

    for($i = 1; $i <=$num_lines; $i++) {

                my $line = $w->get("${i}.0", "${i}.1000");

                next if not defined $line or $line !~ /($string)/;

                my $l = length $1;

                my $stringRegexp=$1;

                my $offset = 0;

                while (1) {

                    my $tmpoffset=0;

                    my $index = index $line, $stringRegexp, $tmpoffset;

                    last if $index == -1;

                    $offset += $index;

                    $w->tag('add', $tag, sprintf("%d.%d", $i, $offset), sprintf("%d.%d", $i, $offset+$l));

                    $seenElt[$id] =[$i, $offset, $i, $offset+$l,$l];

                    $id++;

                    $offset += $l;

                    $line = substr $line, $index+$l;

                    if ($line=~/($string)/) { $stringRegexp=$1;

                                                                     $l = length $1;}

                } # whilend

    } # forend

 

    for ($i = $#seenElt; $i >= 0; $i--) {

                $w->delete(sprintf("%d.%d",$seenElt[$i][0],$seenElt[$i][1]),sprintf("%d.%d",$seenElt[$i][2],$seenElt[$i][3]));

                $w->insert(sprintf("%d.%d",$seenElt[$i][0],$seenElt[$i][1]),$replace);

                my $lenght = length $replace;

                $w->tag('add', 'search', sprintf("%d.%d", $seenElt[$i][0],$seenElt[$i][1]), sprintf("%d.%d", $seenElt[$i][2],$seenElt[$i][3] + $lenght - $seenElt[$i][4]));

    }

} # end text_replace

 

 

###---- Variable pour le Bouton "Effacer"

sub text_delete {

       # The utility procedure below searches and destroy for all instances of a given string in a text widget

       #and applies a given tag

       # to each instance found.

       # Arguments:

         # w - The window in which to search. Must be a text widget.

         # string - The string to search for.

         # tag - Tag to apply to each instance of a matching string.

 

    my($w, $string, $tag) = @_;

    my @seenElt=();

    if ($string eq "") {

                &mkPrintErreur("ERREUR : Aucune sélection de chaîne de recherche donnée\n");

                return;

    }

    my $resultat=$w->search(-regexp, "$string",'1.0','end');

    if ($resultat eq "") {

                &mkPrintMsgInfo("Aucune chaîne correspondante pour le motif de recherche donné\n");

return;

}

    $w->tag('remove', $tag, '0.0', 'end');

    (my $num_lines) = $w->index('end') =~ /(\d*)\.\d*/;

    my $id = 0;

    for($i = 1; $i <=$num_lines; $i++) {

                my $line = $w->get("${i}.0", "${i}.1000");

                next if not defined $line or $line !~ /($string)/;

                my $l = length $1;

                my $stringRegexp=$1;

                my $offset = 0;

                while (1) {

                    my $tmpoffset=0;

                    my $index = index $line, $stringRegexp, $tmpoffset;

                    last if $index == -1;

                    $offset += $index;

                    $w->tag('add', $tag, sprintf("%d.%d", $i, $offset), sprintf("%d.%d", $i, $offset+$l));

                    $seenElt[$id] =[$i, $offset, $i, $offset+$l];

                    $id++;

                    $offset += $l;

                    $line = substr $line, $index+$l;

                    if ($line=~/($string)/) { $stringRegexp=$1;

                                                                     $l = length $1;}

                } # whilend

    } # forend

 

    for ($i = $#seenElt; $i >= 0; $i--) {

                $w->delete(sprintf("%d.%d",$seenElt[$i][0],$seenElt[$i][1]),sprintf("%d.%d",$seenElt[$i][2],$seenElt[$i][3]));

    }

    @seenElt=();

}

 

 

 

###---- Variable pour le Bouton "Annuler"

sub remove_mark_search {

    $texte->tagDelete('search','1.0','end');

}

 

###---- 2)MENU EDITION : recherche des occurences.

 

##--- a) RECHERCHE GLOBALE.

sub search_in_fic {

 

$info="Recherche dans le fichier < $nom_fic >...";

&text_search($texte, $search_string, 'search');

if ($mw->depth > 1) {

    text_toggle($texte, ['configure', 'search', -background => 'SeaGreen4', -foreground => 'white'], 800,

                               ['configure', 'search', -background => undef, -foreground => undef], 200);

} else {

    text_toggle($texte, ['configure', 'search', -background => 'black', -foreground => 'white'], 800,

                               ['configure', 'search', -background => undef, -foreground => undef], 200);

}

$info= "Recherche dans Fichier < $nom_fic > terminée.";

}

 

##-------b) RECHERCHE INCREMENTALE SIMPLE.

sub i_search {

    if ($search_string eq "") {

                &mkPrintErreur("ERREUR : Aucune sélection de chaîne de recherche donnée\n");

                return;

    }

    $info="Recherche dans le fichier < $nom_fic >...";

    $texte->tag('remove', 'search', '0.0', 'end');

    my $resultat=$texte->search(-regexp, "$search_string",'1.0','end');

    if ($resultat eq "") {

                &mkPrintMsgInfo("Aucune chaîne correspondante pour le motif de recherche donné\n");

                return;

    }

    my $lenght = length $search_string;

    $resultat=~/([0-9]+)\.([0-9]+)/;

    $i=$1;

    $offset=$2;

    $texte->tag('add', 'search', sprintf("%d.%d", $i, $offset), sprintf("%d.%d", $i, $offset+$lenght));

    $texte->see($resultat);

    if ($mw->depth > 1) {

                text_toggle($texte, ['configure', 'search', -background => 'SeaGreen4', -foreground => 'white'], 800,

                                   ['configure', 'search', -background => undef, -foreground => undef], 200);

    } else {

                text_toggle($texte, ['configure', 'search', -background => 'black', -foreground => 'white'], 800,

                                   ['configure', 'search', -background => undef, -foreground => undef], 200);

    }

$info= "Recherche dans Fichier < $nom_fic > terminée.";

$position_search= sprintf("%d.%d", $i, $offset+$lenght);

}

###---N.B. : LES PROCEDURES MKPRINT SE TROUVENT A LA FIN.

 

 

###------c) Repeter la Recherche individuelle de l'occurence donnée.

sub i_search2 {

    if ($search_string eq "") {

                &mkPrintErreur("ERREUR : Aucune slection de chaîne de recherche donnée\n");

                return;

    }

    $texte->tag('remove', 'search', '0.0', 'end');

    if ($position_search !~/[0-9]+\.[0-9]+/) {

                &mkPrintMsgInfo("On vous a déjà dit qu'il n\'existe aucune chaîne correspondante pour le motif de recherche donné\n...");

                return;

    }

    $info="Recherche dans le fichier < $nom_fic >...";

    $resultat=$texte->search(-regexp, "$search_string",$position_search,'end');

    print $resultat,"<<<<<<<\n";

    if ($resultat eq "") {

                &mkPrintMsgInfo("Aucune chaîne correspondante pour le motif de recherche donné\n");

                return;

    }

    my $lenght = length $search_string;

    $resultat=~/([0-9]+)\.([0-9]+)/;

    $i=$1;

    $offset=$2;

    $texte->tag('add', 'search', sprintf("%d.%d", $i, $offset), sprintf("%d.%d", $i, $offset+$lenght));

    $texte->see($resultat);

    if ($pnDraw->depth > 1) {

                text_toggle($texte, ['configure', 'search', -background => 'SeaGreen4', -foreground => 'white'], 800,

                                   ['configure', 'search', -background => undef, -foreground => undef], 200);

    } else {

                text_toggle($texte, ['configure', 'search', -background => 'black', -foreground => 'white'], 800,

                                   ['configure', 'search', -background => undef, -foreground => undef], 200);

    }

    $info= "Recherche dans Fichier < $nom_fic > terminée.";

    $position_search= sprintf("%d.%d", $i, $offset+$lenght);

}

 

 

#--------d) REMPLACEMENT INCREMENTAL D'UNE OCCURENCE PAR UNE AUTRE.

sub i_replace {

    if ($search_string eq "") {

                &mkPrintErreur("ERREUR : Aucune sélection de chaîne de recherche donnée\n");

                return;

    }

    $info="Recherche dans le fichier < $nom_fic >...";

    $texte->tag('remove', 'search', '0.0', 'end');

    $resultat=$texte->search(-regexp, "$search_string",'1.0','end');

    if ($resultat eq "") {

                &mkPrintMsgInfo("Aucune chaîne correspondante pour le motif de recherche donné\n");

                return;

    }

    my $lenght = length $search_string;

    $resultat=~/([0-9]+)\.([0-9]+)/;

    $i=$1;

    $offset=$2;

    $texte->tag('add', 'search', sprintf("%d.%d", $i, $offset), sprintf("%d.%d", $i, $offset+$lenght));

    $texte->delete(sprintf("%d.%d",$i,$offset),sprintf("%d.%d",$i,$offset + $lenght));

    $texte->insert(sprintf("%d.%d", $i, $offset),$replace_string);

    $lenght = length $replace_string;

    $texte->tag('add', 'search', sprintf("%d.%d", $i, $offset), sprintf("%d.%d", $i, $offset+$lenght));

    $texte->see($resultat);

    if ($mw->depth > 1) {

                text_toggle($texte, ['configure', 'search', -background => 'SeaGreen4', -foreground => 'white'], 800,

                                   ['configure', 'search', -background => undef, -foreground => undef], 200);

    } else {

                text_toggle($texte, ['configure', 'search', -background => 'black', -foreground => 'white'], 800,

                                   ['configure', 'search', -background => undef, -foreground => undef], 200);

    }

    $info= "Recherche dans Fichier < $nom_fic > terminée.";

    $position_search= sprintf("%d.%d", $i, $offset+$lenght);

}

 

 

#-----------e) Repeter le  remplacement individuel de l'occurence donnee.

sub i_replace2 {

    if ($search_string eq "") {

                &mkPrintErreur("ERREUR : Aucune sélection de chaîne de recherche donnée\n");

                return;

    }

    if ($position_search !~/[0-9]+\.[0-9]+/) {

                &mkPrintMsgInfo("On vous a déjà dit qu'il n\'existe aucune chaîne correspondante pour le motif de recherche donné\n...");

                return;

    }

    $info="Recherche dans le fichier < $nom_fic >...";

    $texte->tag('remove', 'search', '0.0', 'end');

    $resultat=$texte->search(-regexp, "$search_string",$position_search,'end');

    if ($resultat eq "") {

                &mkPrintMsgInfo("Aucune chaîne correspondante pour le motif de recherche donné\n");

                return;

    }

    my $lenght = length $search_string;

    $resultat=~/([0-9]+)\.([0-9]+)/;

    $i=$1;

    $offset=$2;

    $texte->tag('add', 'search', sprintf("%d.%d", $i, $offset), sprintf("%d.%d", $i, $offset+$lenght));

    $texte->delete(sprintf("%d.%d",$i,$offset),sprintf("%d.%d",$i,$offset + $lenght));

    $texte->insert(sprintf("%d.%d", $i, $offset),$replace_string);

    $lenght = length $replace_string;

    $texte->tag('add', 'search', sprintf("%d.%d", $i, $offset), sprintf("%d.%d", $i, $offset+$lenght));

    $texte->see($resultat);

    if ($mw->depth > 1) {

                text_toggle($texte, ['configure', 'search', -background => 'SeaGreen4', -foreground => 'white'], 800,

                                   ['configure', 'search', -background => undef, -foreground => undef], 200);

    } else {

                text_toggle($texte, ['configure', 'search', -background => 'black', -foreground => 'white'], 800,

                                   ['configure', 'search', -background => undef, -foreground => undef], 200);

    }

    $info= "Recherche dans Fichier < $nom_fic > terminée.";

    $position_search= sprintf("%d.%d", $i, $offset+$lenght);

}

 

 

#---------f) Remplacement de toutes les occurences.

sub replace {

    $info="Recherche et remplacement dans le fichier < $nom_fic >...";

    &text_replace($texte, $search_string, $replace_string, 'search');

    if ($mw->depth > 1) {

                text_toggle($texte, ['configure', 'search', -background => 'SeaGreen4', -foreground => 'white'], 800,

                                   ['configure', 'search', -background => undef, -foreground => undef], 200);

    } else {

                text_toggle($texte, ['configure', 'search', -background => 'black', -foreground => 'white'], 800,

                                   ['configure', 'search', -background => undef, -foreground => undef], 200);

    }

    $info= "Recherche et remplacement dans Fichier < $nom_fic > terminée.";

    $saisie2->delete(0,'end');

    $saisie3->delete(0,'end');

}

 

 

 

 

#------------3) MENU BALISES.

#-----a) Effacer des balises.

sub del_balise {

$search_string="<[^>]+>";

$info="Recherche et suppression dans le fichier '$nom_fic'...";

&text_delete($texte, $search_string, 'search');

$info= "Suppression dans Fichier '$nom_fic' terminée.";

$saisie2->delete(0,'end');

}

#--b) Voir les balises.

sub list_balise {

$search_string="<[^>]+>";

$info="Recherche dans le fichier '$nom_fic'...";

&text_balise($texte, $search_string, 'search');

$info= "Affichage balises dans Fichier '$nom_fic' terminée.";

$saisie2->delete(0,'end');

}

#--- c) Rechercher les balises.

sub search_balise {

$search_string="<[^>]+>";

$info="Recherche balises le fichier '$nom_fic'...";

&text_search($texte, $search_string, 'search');

if ($mw->depth > 1) {

text_toggle($texte, ['configure', 'search', -background => 'SeaGreen4', -foreground => 'white'], 800,

['configure', 'search', -background => undef, -foreground => undef], 200);

} else {

text_toggle($texte, ['configure', 'search', -background => 'black', -foreground => 'white'], 800,

['configure', 'search', -background => undef, -foreground => undef], 200);

}

$info= "Recherche dans Fichier '$nom_fic' terminée.";

$saisie2->delete(0,'end');

}

#--d) Extraire le texte entre les balises.

sub query_search_text_in_balise {

if (! Exists ($pn7)) {

$pn7 = $mw ->Toplevel();

$pn7->title("Text-Extractor");

my $cadre = $pn7->Frame->pack(-side => 'top',

-fill => 'x');

$cadre->Label(-text => "Search : ",-background => '#FFCC00',  -foreground => 'black',

-relief => 'raised')->pack(-side => 'left',

-anchor => 'w');

my $search="";

my $saisie_1=$cadre->Entry(-textvariable => \$search)->pack(-side => 'left',

-anchor => 'w',

-fill => 'x',

-expand => 1);

$cadre->Button(-text => "Extract Text",-background => '#CCCC00',  -foreground => 'black',

-command => sub {&extract_balise_i($search)})->pack(-side => 'right',

-anchor => 'e');

$pn7->Button(-text => "Fermer",-background => '#CC9900', -foreground => 'black',

-command => sub {$pn7->destroy()})->pack;

}

else {

$pn7->deiconify();

$pn7->raise();

}

}

#--------------------------------------------- Autres programmes :

sub extract_balise_i {

my ($balise_d) = @_;

$balise_d=~/<([^>]+)>/;

my $tmp=$1;

my $ind=0;

if ($balise_d=~/<([^ ]+) [^>]*>/) {$tmp=$1}

my $balise_f="<\/$tmp>";

my $balise_name = $tmp;

my @chars = unpack("A1" x length($balise_name), $balise_name);

my $tmp_string="[^<]*[^\/]*";

foreach $ch (@chars) {

$tmp_string .= "[^".$ch."]*";

}

$tmp_string .= "[^>]*";

my $resultat=$texte->search(-regexp, "$balise_f",'1.0','end');

if ($resultat eq "") {

&mkPrintErreur("ERREUR : Pas de balise fermante '$balise_f' pour cette balise\n");

return;

}

$nom_fic2="tmp-ExtractText_".$balise_name.".txt";

$info="Lecture du fichier '$nom_fic'...";

if (!open(TMPFILE,("$nom_fic"))) {

&mkPrintErreur("ERREUR : Impossible d\'ouvrir le fichier '$nom_fic'\n");

return;

}

if (!open(TMPFILE2,(">$nom_fic2"))) {

&mkPrintErreur("ERREUR : Impossible d\'ouvrir le fichier '$nom_fic2'\n");

return;

}

$info="Création du fichier '$nom_fic2'...";

while ($ligne = <TMPFILE>) {

if ($ligne =~ /$balise_d(.*)$balise_f/i)

{

$ind++;

print TMPFILE2 "<$balise_name=NUM$ind>\n";

print TMPFILE2 "$1\n";

}

if (($ligne=~/$balise_d(.*)/i) && ($ligne!~/$balise_f/i)){

my $tmp="$1";

$ind++;

print TMPFILE2 "<$balise_name=NUM$ind>\n";

print TMPFILE2 "$tmp";

$ligne=<TMPFILE>;

until ($ligne=~/$balise_f/i){

print TMPFILE2 "$ligne";

$ligne=<TMPFILE>;

break if $ligne == EOF;

}

$ligne=~/(.*)$balise_f/;

print TMPFILE2 "$1";

}

}

print TMPFILE2 "\n";

close(TMPFILE);

close(TMPFILE2);

my $tmpfile="tmp-ExtractText_".$balise_name.".txt";

$mkExtractTextInMarkup->destroy if Exists($mkExtractTextInMarkup);

$mkExtractTextInMarkup = $mw->Toplevel();

my $w = $mkExtractTextInMarkup;

$w->title('Extract Text');

$w->iconname('Extract');

my $w_ok = $w->Button(-text => 'OK', -width => 8, -command => ['destroy', $w]);

my $w_t = $w->TextUndo(-setgrid => 'true', -width => '60', -height => '28',

-font => '-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*');

my $w_save = $w->Button(-text => "Save",

-command => sub {$w_t->FileSaveAsPopup()})->pack(-side => 'top', -pady => 5, -padx => 10);

my $w_s = $w->Scrollbar(-command => ['yview', $w_t]);

$w_t->configure(-yscrollcommand => ['set', $w_s]);

$w_ok->pack(-side => 'top', -pady => 5, -padx => 10);

$w_s->pack(-side => 'right', -fill => 'y');

$w_t->pack(-expand => 'yes', -fill => 'both');

# Set up display styles

my(@bold, @normal, $tags);

if ($mkExtractTextInMarkup->depth > 1) {

@bold = (-foreground => 'red');

@normal = (-foreground => undef);

} else {

@bold = (-foreground => 'white', -background => 'black');

@normal = (-foreground => undef, -background => undef);

}

$w_t->insert('0.0', 'Extract Results...');

$w_t->insert("end","\n\n");

$w_t->IncludeFile($tmpfile);

$info = "Recherche Markups sur '$nom_fic' terminée.";

}

 

 

 

 

#-- Variable pour

sub text_toggle {

 

    # The procedure below is invoked repeatedly to invoke two commands at periodic intervals.  It normally reschedules itself

    # after each execution but if an error occurs (e.g. because the window was deleted) then it doesn't reschedule itself.

    # Arguments:

        # w -           Text widget reference.

        # cmd1 -        Reference to a list of tag options.

        # sleep1 -      Ms to sleep after executing cmd1 before executing cmd2.

        # cmd2 -        Reference to a list of tag options.

        # sleep2 -      Ms to sleep after executing cmd2 before executing cmd1 again.

 

    my($w, $cmd1, $sleep1, $cmd2, $sleep2) = @_;

 

    # return if not Exists $w;

    $w->tag(@{$cmd1});

    $w->after($sleep1, [sub {text_toggle(@_)}, $w, $cmd2, $sleep2, $cmd1, $sleep1]);

 

} # end text_toggle

 

 

 

#-------------------------Extract from Tag---------------------------------

#-- Ce programme extrait le texte d'une balise donnee (une balise simple

# comme <BODY> ou une balise avec attribut comme <FONT COLOR="white">)

 

sub extract  {

    open (FIC, $nom_fic);

    open (res2,">res2.txt");

    $balise_d ="<$extract_tag";

    $balise_f = "<\/$extract_tag>";

    $listeCompteur=0;

    while ($ligne = <FIC>) {

 

            if ($ligne =~ /($balise_d)[^>]*>(.*)($balise_f)/i)

                  {

                      $balise_name=$1;

                      $balise_name=~s/[\<\>]//g;

                      $ligne =~ /<$balise_name[^>]*>(.*)<\/$balise_name>/;

 

                      my $tmp=$1;

                      $listeCompteur++;

 

                      print res2 "<$balise_name=NUM $listeCompteur>\n";

                      print res2 "$tmp\n";

                  }

 

            if (($ligne=~/($balise_d)[^>]*>(.*)/i) && ($ligne!~/$balise_f/i)){

                $balise_name=$1;

                $balise_name=~s/[\<\>]//g;

                $ligne=~/<$balise_name[^>]*>(.*)/;

 

                my $tmp=$1;

                print res2 "<$balise_name=NUM".$listeCompteur{$balise_name}++.">\n";

                print res2 "$tmp\n";

 

                $ligne=<FIC>;

                until ($ligne=~/<\/$balise_name>/i){

                  print res2 "$ligne\n";

                  $ligne=<FIC>;

                  break if $ligne == EOF;

                }

 

                $ligne=~/(.*)<\/$balise_name>/;

                print res2 "$1\n";

            }

          }

    print res2 "\n";

    close (FIC);

    close (res2);

    my $tmpfile = "res2.txt";

 

    &IncludedFileInWindow($tmpfile);

 

}

 

 

#-------------------------- Module FILE (nouvelle fenetre resultat)-------------

 

sub IncludedFileInWindow {

 

    my ($tmpfile) = @_;

    my $mkWindowForIncludingFile->destroy if Exists($mkWindowForIncludingFile);

    $mkWindowForIncludingFile = $mw->Toplevel();

    my $w = $mkWindowForIncludingFile;

 

    $w->title('Results');

    $w->iconname('Results');

 

    my $w_t = $w->TextUndo(-setgrid => 'true', -width => '60', -height => '28');

    my $w_ok = $w->Button(-text => 'OK', -width => 8, -background => '#669900',

                       -foreground => 'white', -command => ['destroy', $w]);

    my $w_save = $w->Button(-text => "Save",  -background => '#FF6600',

 

             -command => sub {$w_t->FileSaveAsPopup()})->pack(-side => 'top', -pady => 5, -padx => 10);

 

    my $w_s = $w->Scrollbar(-command => ['yview', $w_t]);

    $w_t->configure(-yscrollcommand => ['set', $w_s]);

    $w_ok->pack(-side => 'top', -pady => 5, -padx => 10);

    $w_s->pack(-side => 'right', -fill => 'y');

    $w_t->pack(-expand => 'yes', -fill => 'both');

    $w_t->insert('0.0', '');

    $w_t->IncludeFile($tmpfile);

 

}

 

 

#-------------------------------Concordance-------------------------------------

#programme construit les concordances de tous les mots du fichier

 

sub concordance {

 

    $mkTextConcordance->destroy if Exists($mkTextConcordance);

    $mkTextConcordance = $mw->Toplevel();

    my $w = $mkTextConcordance;

    $w->title('Concordance');

    $w->iconname('Text Concordance');

 

    my $w_ok = $w->Button(-text => 'OK', -width => 8, -background => '#99CC99',

                       -foreground => '#FF6600', -command => ['destroy', $w]);

    my $w_t = $w->TextUndo(-setgrid => 'true', -width => '60', -height => '28',

 

                  -font => '-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*');

 

    my $w_save = $w->Button(-text => "Save",  -background => '#669900',

                       -foreground => 'white',

 

             -command => sub {$w_t->FileSaveAsPopup()})->pack(-side => 'top', -pady => 5, -padx => 10);

 

    my $w_s = $w->Scrollbar(-command => ['yview', $w_t]);

    $w_t->configure(-yscrollcommand => ['set', $w_s]);

    $w_ok->pack(-side => 'top', -pady => 5, -padx => 10);

    $w_s->pack(-side => 'right', -fill => 'y');

    $w_t->pack(-expand => 'yes', -fill => 'both');

 

# Set up display styles

 

    my(@bold, @normal, $tags);

    if ($mkTextConcordance->depth > 1) {

      @bold = (-foreground => 'red');

      @normal = (-foreground => undef);

    } else {

 

      @bold = (-foreground => 'white', -background => 'black');

      @normal = (-foreground => undef, -background => undef);

    }

 

    if (!open(FIC,"$nom_fic")) {

      $w_t->insert("end","ERREUR : Impossible d\'ouvrir '$nom_fic'\n");

      return;

    }

 

 

    $w_t->insert('0.0', 'Résultats Concordance...');

    $w_t->insert("end","\n\n");

 

    my %Lignes=();

    my %Concord=();

    my $Ligne = 0;

    my @Mots=();

 

  READ: while(<FIC>)

  { 

 

#saute les lignes vides

 

      next READ if (/^$/);

      s/[ ]+/ /g;

      chop;

      $Ligne++;

      $Lignes[$Ligne] = $_ ;

      @Mots = split(/\W+/);

      for $Mot (@Mots) {

        $Mot =~ /\D/ or next ;

        push(@{$Concord{$Mot}},$Ligne);

      }

  }

 

 

    for $Mot (sort keys %Concord) {

 

      $w_t->insert("end","-------------------------------------------------\n");

      $w_t->insert("end","Mot : $Mot \n");

      for $Ligne (@{$Concord{$Mot}})

      {

            $w_t->insert("end","\tLigne n°$Ligne: $Lignes[$Ligne]\n");

      }

    }

 

    close(FIC);

    $info = "Concordance sur '$nom_fic' terminee.";

}

 

 

#--------------------------------------Count_words_lines------------------------

 

#programme qui compte le nombre des mots et de lignes (excepte les lignes vides)

#du fichier passe en argument 

 

sub count_words_lines {

 

    $mkTextCount_words_lines->destroy if Exists($mkTextCount_words_lines);

    $mkTextCount_words_lines = $mw->Toplevel();

    my $w = $mkTextCount_words_lines;

 

    $w->title('count-words/lines');

    $w->iconname('Text count-words/lines');

 

    my $w_ok = $w->Button(-text => 'OK', -width => 8, -command => ['destroy', $w]);

    my $w_t = $w->TextUndo(-setgrid => 'true', -width => '60', -height => '28',

 

                  -font => '-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*');

 

    my $w_save = $w->Button(-text => "Save",

 

             -command => sub {$w_t->FileSaveAsPopup()})->pack(-side => 'top', -pady => 5, -padx => 10);

 

    my $w_s = $w->Scrollbar(-command => ['yview', $w_t]);

    $w_t->configure(-yscrollcommand => ['set', $w_s]);

    $w_ok->pack(-side => 'top', -pady => 5, -padx => 10);

    $w_s->pack(-side => 'right', -fill => 'y');

    $w_t->pack(-expand => 'yes', -fill => 'both');

 

 

 

    my(@bold, @normal, $tags);

    if ($mkTextCount_words_lines->depth > 1) {

      @bold = (-foreground => 'red');

      @normal = (-foreground => undef);

    } else {

      @bold = (-foreground => 'white', -background => 'black');

      @normal = (-foreground => undef, -background => undef);

    }

 

    if (!open(FIC,"$nom_fic")) {

      $w_t->insert("end","ERREUR : Impossible d\'ouvrir '$nom_fic'\n");

      return;

    }

 

     $w_t->insert('0.0', 'Résultats Count_words_lines...');

    my @tab = ();   

    my $i = 0;

    my $mot = 0;

  READ: while(<FIC>){

      #saute les lignes vides

     next READ if (/^$/);

 

     $ligne =~ s/[\-\.\,\;\:\+\?\!\(\)\/]+/ /g;

 

#suppression de ponctuation

     $ligne =~ s/\s+/ /g;

 

#suppression de double blancs

      chop;

      @tab = split (/\s+/);

      $#tab++;

      $mot = $mot + $#tab;

     print $mot,"\n";

       $i++;

 }

 

    $w_t->insert('end',"\nNombres de mots :  '$mot' \nNombre de lignes : '$i'\n");

 

    close(FIC);

    $info = "Count-words/lines  sur '$nom_fic' terminée.";

}

 

 

 

#---------------------------------------------DICO------------------------------

 

#programme qui lit le fichier donne en argument et construit

# un dico contenant toutes les formes graphiques de ce fichier

 

sub dico {

 

    $mkTextdictionnaire->destroy if Exists($mkTextdictionnaire);

    $mkTextdictionnaire = $mw->Toplevel();

    my $w = $mkTextdictionnaire;

    $w->title('dictionnaire');

    $w->iconname('Text dictionnaire');

 

    my $w_ok = $w->Button(-text => 'OK', -width => 8,-background => '#FF9966',

                       -foreground => 'black', -command => ['destroy', $w]);

    my $w_t = $w->TextUndo(-setgrid => 'true', -width => '60', -height => '28',

 

                  -font => '-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*');

 

    my $w_save = $w->Button(-text => "Save", -background => '#CCCC00',

                       -foreground => 'black',

 

 

             -command => sub {$w_t->FileSaveAsPopup()})->pack(-side => 'top', -pady => 5, -padx => 10);

 

    my $w_s = $w->Scrollbar(-command => ['yview', $w_t]);

    $w_t->configure(-yscrollcommand => ['set', $w_s]);

    $w_ok->pack(-side => 'top', -pady => 5, -padx => 10);

    $w_s->pack(-side => 'right', -fill => 'y', -background => 'red');

    $w_t->pack(-expand => 'yes', -fill => 'both');

 

    my(@bold, @normal, $tags);

    if ($mkTextdictionnaire->depth > 1) {

      @bold = (-foreground => 'red');

      @normal = (-foreground => undef);

    } else {

      @bold = (-foreground => 'white', -background => 'black');

      @normal = (-foreground => undef, -background => undef);

    }

 

    if (!open(FIC,"$nom_fic")) {

      $w_t->insert("end","ERREUR : Impossible d\'ouvrir '$nom_fic'\n");

      return;

    }

 

     $w_t->insert('0.0','Dictionnaire par ordre lexigraphique:');

    open (FIC, $nom_fic);

    %TAB = ();

    $i = 0;

    while($ligne=<FIC>){

                if ($ligne =~ s/<[^>]*>|<[^>]*$|^[^>]*>|^$|\&nbsp\;|\d//g){

 

 

 

#1/balises 2/balise ouvrante fin de ligne, balise fermante sur deuxieme ligne

#3/&nbsp; 4/tous les numeros  --- remplacer par rien 

 

}

 if ($ligne =~ s/&eacute;|&egrave;/e/g){

 

#remplacement des &--- par e

  }

  if ($ligne =~ s/[\-\.\,\;\:\+\?\!\(\)\/]+/ /g){

 

#ponctuation remplacer par un blanc

  }

  if ($ligne =~ s/[  ]+/ /g){

 

#suppression des blancs successifs

 

  }

 @tab = split (/\s+/,$ligne); 

 

foreach $mot(@tab){

if (!exists ($TAB{$mot})){

    $TAB{$mot}=1;

}

 

else{

    $TAB{$mot}++;

}

}

    }

 

foreach $mot (sort(keys%TAB)){

 

#print dico  "$mot\n"; # les mots classes par ordre alphabetique

 

$w_t->insert('end',"'$mot'\n");

 

}

 

close(FIC);

$info = "Dico  sur '$nom_fic' terminée.";

close(dico);

}

 

 

########### MODULE Tools XML ###############

#introduction de la fonction XPath

 

 

#----------------------------- MODULE XML ----------------------------------#

 

#-------XPATH

sub xmlXpath {

 

    $mkTextXpath->destroy if Exists($mkTextXpath);

    $mkTextXpath = $mw->Toplevel();

    my $w = $mkTextXpath;

    $w->title('XPATH');

    $w->iconname('XPATH');

    my $w_ok = $w->Button(-text => 'OK', -background => '#FFCCCC',

                       -foreground => 'black', -width => 8, -command => ['destroy', $w]);

    my $w_t = $w->TextUndo(-setgrid => 'true', -width => '60', -height => '28',

                                               -font => '-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*');

    my $w_save = $w->Button(-text => "Save",

                                                   -image => $imageSave,-background =>'#FF99CC',

                                                   -command => sub {$w_t->FileSaveAsPopup()})->pack(-side => 'top', -pady => 5, -padx => 10);

    $winBalloon->attach($w_save,

                  -balloonmsg => "Save"

               );

 

 

    my $w_s = $w->Scrollbar(-command => ['yview', $w_t]);

    $w_t->configure(-yscrollcommand => ['set', $w_s]);

    $w_ok->pack(-side => 'top', -pady => 5, -padx => 10);

    $w_s->pack(-side => 'right', -fill => 'y');

    $w_t->pack(-expand => 'yes', -fill => 'both');

 

    # Set up display styles

 

    my(@bold, @normal, $tags);

    if ($mkTextXpath->depth > 1) {

                @bold = (-foreground => 'red');

                @normal = (-foreground => undef);

    } else {

                @bold = (-foreground => 'white', -background => 'black');

                @normal = (-foreground => undef, -background => undef);

    }

 

    $w_t->insert('0.0', 'Résultats XPATH...');

    $w_t->insert("end","\n\n");

 

    my $xpath;

 

    my $xmlp = XML::XPath::XMLParser->new( filename => $nom_fic);

 

    my $time = time;

    my $context = $xmlp->parse;

 

   

    $xpath = XML::XPath->new(filename => $nom_fic);

 

    my $nodes = $xpath->find($search_string,$context);

    print $search_string , "\n";

    print $nodes->size , "\n";

    unless ($nodes->isa('XML::XPath::NodeSet')) {

      NOTNODES:

                $w_t->insert("end","Query didn't return a nodeset. Value: ");

                $w_t->insert("end","".print $nodes->value."\n");

                return;

    }

 

                $nodes = find_more($nodes);

                goto NOTNODES unless $nodes->isa('XML::XPath::NodeSet');

 

    if ($nodes->size) {

                $w_t->insert("end","Found "." ".$nodes->size." nodes:\n");

                foreach my $node ($nodes->get_nodelist) {

                               $w_t->insert("end","-- NODE --\n");

                               $w_t->insert("end",$node->toString);

                }

    }

    else {

                $w_t->insert("end","No nodes found");

    }

 

    $w_t->insert("end","\n");

 

 

}

###---------------------------------------------------------

sub xmlXpath2 {

 

    $mkTextXpath->destroy if Exists($mkTextXpath);

    $mkTextXpath = $mw->Toplevel();

    my $w = $mkTextXpath;

    $w->title('XPATH');

    $w->iconname('XPATH');

    my $w_ok = $w->Button(-text => 'OK', -background =>'#CCCCFF', -width => 8, -command => ['destroy', $w]);

    my $w_t = $w->TextUndo(-setgrid => 'true', -width => '60', -height => '28',

                                               -font => '-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*');

    my $w_save = $w->Button(-text => "Save",

                                                   -image => $imageSave,

                             -background => '#FF99FF',

                                                    -foreground => 'white',

                                                   -command => sub {$w_t->FileSaveAsPopup()})->pack(-side => 'top', -pady => 5, -padx => 10);

    $winBalloon->attach($w_save,

                  -balloonmsg => "Save"

               );

 

 

    my $w_s = $w->Scrollbar(-command => ['yview', $w_t]);

    $w_t->configure(-yscrollcommand => ['set', $w_s]);

    $w_ok->pack(-side => 'top', -pady => 5, -padx => 10);

    $w_s->pack(-side => 'right', -fill => 'y');

    $w_t->pack(-expand => 'yes', -fill => 'both');

 

    # Set up display styles

 

    my(@bold, @normal, $tags);

    if ($mkTextXpath->depth > 1) {

                @bold = (-foreground => 'red');

                @normal = (-foreground => undef);

    } else {

                @bold = (-foreground => 'white', -background => 'black');

                @normal = (-foreground => undef, -background => undef);

    }

 

    $w_t->insert('0.0', 'Résultats XPATH...');

    $w_t->insert("end","\n\n");

 

    my $p = XML::DOM::Parser->new;

 

 

    my $time = time;

    my $doc = $p->parsefile($nom_fic);

    $w_t->insert("end","Parsed in ".(time - $time)." seconds\n");

 

    my $time = time;

    my @results;

    for (1..100) {

                @results = ();

                for my $gutbook ($doc->getElementsByTagName('gutbook')) {

                    for my $book ($gutbook->getElementsByTagName('book')) {

                               for my $bookbody ($book->getElementsByTagName('bookbody')) {

                                   for my $chapter ($bookbody->getElementsByTagName('chapter')) {

                                               for my $chapheader ($chapter->getElementsByTagName('chapheader')) {

                                                   for my $title ($chapheader->getElementsByTagName('title')) {

                                                               push @results, $title;

                                                   }

                                               }

                                   }

                               }

                    }

                }

    }

 

    $w_t->insert("end","found ", scalar(@results), " titles in ".(time - $time)." seconds\n");

 

}

 

sub find_more {

                my ($nodes) = @_;

                if (!@ARGV) {

                               return $nodes;

                }

               

                my $newnodes = XML::XPath::NodeSet->new;

               

                my $find = shift @ARGV;

               

                foreach my $node ($nodes->get_nodelist) {

                               my $new = $xpath->find($find, $node);

                               if ($new->isa('XML::XPath::NodeSet')) {

                                               $newnodes->append($new);

                               }

                               else {

                                               warn "Not a nodeset: ", $new->value, "\n";

                               }

                }

               

                return find_more($newnodes);

}

 

###---- FIN XPATH----

 

 

 

 

 

 

-----------------------------------------> Résultat : Affichage de l'interface graphique

 

 

 


> Retour au Perl et XML - Maitrise Tal 2002 <