Subversion Repositories wimsdev

Rev

Rev 734 | Rev 766 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
23 reyssat 1
#!/usr/bin/perl
2
 
3
use strict "vars";
4
use strict "subs";
5
use locale;
6
use warnings;
7
use Text::Balanced qw (extract_bracketed extract_tagged);
8
 
9
$/ = undef; # slurp
10
#
11
###############################################################################
12
#
13
#    This file is part of latex2wims
14
#
15
#    latex2wims is free software; you can redistribute it and/or modify
16
#    it under the terms of the GNU General Public License as published by
17
#    the Free Software Foundation; either version 2 of the License, or
18
#    (at your option) any later version.
19
#
20
#    latex2wims is distributed in the hope that it will be useful,
21
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
22
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23
#    GNU General Public License for more details.
24
#
25
#    You should have received a copy of the GNU General Public License
26
#    along with latex2wims; if not, write to the Free Software
27
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
28
#
29
###############################################################################
30
#
31
my ($FILE, $MACRO, $EMBED, $NUMERO, $doc_DIR, $DIR, $author, $email, $worksheet, $SHEET,$ABOUT) ;
32
my $verbose = 0;
33
my $depth = 2 ;
34
my $INDEX = 0 ;
734 bpr 35
my $TOOLTIP = 0 ;
23 reyssat 36
my $STYLE = '' ;
37
my $OPTION = '' ;
743 bpr 38
my $tooltip_prompt = '<img src=gifs/picto.gif>' ;
39
my $linkout='' ;
23 reyssat 40
$worksheet= '';
41
$SHEET = '' ;
42
$DIR = '';
43
$doc_DIR = '';
44
 
45
#TODO biblio dans un fichier séparé si on a rencontré \begin{thebibliography} Non,
46
# on n'a qu'a mettre cet environnement de type link
47
#$doc_DIR=$ENV{'w_docdir'}; 
48
#$DIR=$ENV{'w_dir'};
49
#$DIR =~ s/ +//; 
50
push (@ARGV,split(' ', $ENV{'wims_exec_parm'})) if ($ENV{'wims_exec_parm'}) ;
51
 
52
while ($_ = shift (@ARGV))
53
{
54
  last if (!/^--/);
55
     if (/^--style=(.*)$/) { $STYLE   = $1; }  
56
  elsif (/^--macro=(.*)$/) { $MACRO   = $1; }
57
  elsif (/^--docdir=(.*)$/){ $doc_DIR = $1; }
58
  elsif (/^--dir=(.*)$/)   { $DIR     = $1; }
59
  elsif (/^--embed=(.*)$/) { $EMBED   = $1; }
60
  elsif (/^--verbose$/)    { $verbose = 1; }
61
  elsif (/^--author=(.*)$/){ $author  = $1; }
62
  elsif (/^--email=(.*)$/) { $email   = $1; }
63
  elsif (/^--worksheet=(.*)$/) { $worksheet   = $1; }
743 bpr 64
  elsif (/^--tooltip_prompt=(.*)$/) { $tooltip_prompt = $1; }
65
  elsif (/^--linkout=(.*)$/) { $linkout   = $1; }
23 reyssat 66
  elsif (/^--help$/) {
67
   usage(); # includes --help !
68
    exit 1;
69
  }
70
} ;
71
 
72
$FILE = $_;
73
 
74
$DIR = $DIR . '/' if ($DIR) ;
75
$doc_DIR = $doc_DIR . '/' if ($doc_DIR) ;
76
my $LOAD = '\reload{<img src="gifs/doc/etoile.gif" alt="rechargez" width="20" height="20" border=0>}';
77
my $FLECHE = '<img src="gifs/arrows/right3.32.gif" alt=" ---> " width="25" height="15" border=0 valign="bottom">';
743 bpr 78
$linkout = "\\doc{module=$linkout}" . $FLECHE if ($linkout) ;
79
 
23 reyssat 80
##################################
81
##Initialisation
82
#si je rajoute les listes : type=fold : signifierait que les item sont en fold [demande
83
#d'avoir des titres, ca serait du type description en latex
84
#pas de titre ? deb fin <ul ... >  </ul>
85
#type = 
86
#hash contenant les caractéristiques des environnements latex, voir \environmentwims
87
my %hash_environ = (
88
  titre  => {},
89
  style  => {},
90
  type   => {},
91
  deb    => {},
92
  fin    => {},
93
  parm   => {},
94
  origin => {},
734 bpr 95
  list   => {},
96
  tabular => {},
23 reyssat 97
);
98
 
99
 
100
#hash contenant les commandes venant de \defwims, \def & co ou par defaut
101
my %hash_command = (
102
  cnt_arg    => {},
103
  definition => {},
104
  origin     => {},
105
);
106
my @liste_env_list = ('itemize', 'description', 'enumerate', 'trivlist') ;
107
  $hash_environ{type}{'description_item'} = 'fold' ;
108
  $hash_environ{titre}{'description_item'} = ' ' ;
109
 
734 bpr 110
my @liste_env_tabular = ('tabular') ;
111
 
112
my @liste_env_spec = ('equation', 'multline', 'latexonly',
23 reyssat 113
  'pmatrix','smallmatrix', 'eqnarray', 'array', 'algorithmic', 'algorithm', 'align',
114
  'thebibliography', 'pspicture', 'picture', 'cases', 'gather',
115
  'displaymath', 'math', 'center');
116
 
117
my @liste_com_spec = ('paragraph', 'href', 'url', 'exercise', 'doc') ; #je ne m'en sers pas encore 
118
 
119
#commandes par défaut : sont écrasés par un \def ou un \defwims 
120
 
121
#$hash_command{cnt_arg}{text} = 1 ;
122
#$hash_command{definition}{text} = '\) #1 \(' ;
123
#$hash_command{origin}{text} = 'defaut' ;
124
 
125
$hash_command{cnt_arg}{paragraph} = 1 ;
126
$hash_command{definition}{paragraph} = '<p class="paragraph"> #1 </p>' ;
127
$hash_command{origin}{paragraph} = 'defaut' ;
128
 
129
$hash_command{cnt_arg}{href} = 2 ;
130
$hash_command{definition}{href} = '<a http:"#1" target="wims_external">#2</a>';
131
$hash_command{origin}{href} = 'defaut' ;
132
 
133
$hash_command{cnt_arg}{url} = 1 ;
134
$hash_command{definition}{url} = '<a http:"#1" target="wims_external">#1</a>';
135
$hash_command{origin}{url} = 'defaut' ;
136
 
137
$hash_command{cnt_arg}{exercise} = 2 ;
138
$hash_command{definition}{exercise} = "\\exercise\{\#1\}\{\#2\}";
139
$hash_command{origin}{exercise} = 'defwims' ;
140
 
141
$hash_command{cnt_arg}{doc} = 2 ;
142
$hash_command{definition}{doc} = '\doc{#1&cmd=new}{#2}';
143
$hash_command{origin}{doc} = 'defwims' ;
144
 
145
#a un label est associé son bloc [nom de fichier]
146
my %hash_bloc = (
147
  fichier  => {},
148
  titre    => {},
149
);
150
 
151
my %hash_index = (
152
  page    => {},
153
);
154
 
155
#type sert à repérer les fichiers embed ou fold. 
156
my %hash = (
157
  text   => {},
158
  prev   => {},
159
  next   => {},
160
  upbl   => {},
161
  titb   => {},
162
  tittoc => {},
163
  keyw   => {},
164
  datm   => {},
165
  label  => {},
166
  toc    => {},
167
  chemin => {},
168
  niveau => {},
169
  type   => {},
170
  author => {},
171
  title => {},
172
  email => {},
734 bpr 173
  toctip => {},
23 reyssat 174
);
175
 
176
my %hash_toc = ();
177
 
178
my %prefixe = ( fold => 'F_' , link => 'L_' );
179
my @SECTIONS = (
180
  'document', 'part', 'chapter', 'section', 'subsection', 'subsubsection'
181
);
182
my %hash_secinv;
183
for (my $i = 0; $i <= $#SECTIONS; $i++) { $hash_secinv{$SECTIONS[$i]} = $i; }
184
 
185
my (%errmsg); # empèche le ré-affichage d'un même warning.
186
$SIG{__WARN__} = sub { my ($x) = @_;
187
  return if $errmsg{$x};
188
  $errmsg{$x} = 1;
189
  print STDERR "### $x";
190
};
191
 
192
#imposé par wims
193
my $BASE = $doc_DIR . 'doc/1/src';
194
my $BASE0= $doc_DIR . 'doc/1';
195
 
196
system("mkdir -p $BASE0") if (!$ENV{'wims_exec_parm'});
197
system("mkdir -p $BASE") if (!$ENV{'wims_exec_parm'});
198
 
199
$hash{niveau}{'main'} = 0;
200
#pour algorithmic
201
#TODO récupérer les informations dans le fichier de l'utilisateur
202
 
203
my %hash_algo = (
204
  titre => {},
205
  apres => {},
206
  avant => {},
207
  suite => {}
208
) ;
209
my $algo_noend = 0 ;
210
my $voca = %{$hash_algo{titre}} ;
211
my @liste_voca = ('FOR', 'IF','WHILE','REPEAT','ELSE','ELSIF','ENDIF','DO',
212
 'ENDWHILE', 'REQUIRE','ENSURE','ENDFOR','STATE','UNTIL','THEN', 'RETURN') ;
213
 
214
$hash_command{definition}{algorithmicrequire}='<b>Require</b>';
215
$hash_command{origin}{algorithmicrequire}='defaut';
216
$hash_command{cnt_arg}{algorithmicrequire}= 0 ;
217
$hash_command{definition}{algorithmicensure}='<b>Ensure</b>';
218
$hash_command{definition}{algorithmicend}='<b>end</b>';
219
$hash_command{definition}{algorithmicif}='<b>if</b>';
220
$hash_command{definition}{algorithmicthen}='<b>then</b>';
221
$hash_command{definition}{algorithmicelse}='<b>else</b>';
222
$hash_command{definition}{algorithmicelsif}="<b>$hash_command{definition}{algorithmicelse} $hash_command{definition}{algorithmicif}</b>";
223
$hash_command{definition}{algorithmicendif}="<b>$hash_command{definition}{algorithmicend} $hash_command{definition}{algorithmicif}</b>";
224
$hash_command{definition}{algorithmicfor}='<b>for</b>';
225
$hash_command{definition}{algorithmicforall}='<b>for all</b>';
226
$hash_command{definition}{algorithmicdo}='<b>do</b>';
227
$hash_command{definition}{algorithmicendfor}="<b>$hash_command{definition}{algorithmicend} $hash_command{definition}{algorithmicfor}</b>";
228
$hash_command{definition}{algorithmicwhile}='<b>while</b>';
229
$hash_command{definition}{algorithmicendwhile}="<b>$hash_command{definition}{algorithmicend} $hash_command{definition}{algorithmicwhile}</b>";
230
$hash_command{definition}{algorithmicloop}='<b>loop</b>';
231
$hash_command{definition}{algorithmicendloop}="<b>$hash_command{definition}{algorithmicend} $hash_command{definition}{algorithmicloop}</b";
232
$hash_command{definition}{algorithmicrepeat}='<b>repeat</b>';
233
$hash_command{definition}{algorithmicuntil}='<b>until</b>';
234
$hash_command{definition}{algorithmicprint}='<b>print</b>';
235
$hash_command{definition}{algorithmicreturn}='<b>return</b>';
236
 
237
 
238
for my $cmd (@liste_voca) { $hash_command{origin}{"algorithmic\L$cmd\E"} = 'defaut' }
239
 
240
for my $cmd ('FOR','IF','WHILE','REPEAT','ELSE','ELSIF') {
241
          $hash_algo{apres}{$cmd} = 1 ;
242
} ;
243
for my $cmd ('IF') { $hash_algo{suite}{$cmd} = 'THEN' ;} ;
244
for my $cmd ('FOR','WHILE') { $hash_algo{suite}{$cmd} = 'DO' ;} ;
245
for my $cmd ('ENDFOR','ENDIF', 'ENDWHILE','UNTIL','ELSE','ELSIF') {
246
          $hash_algo{avant}{$cmd} = -1 ;
247
} ;
248
for my $cmd ('FOR','IF','WHILE','REQUIRE','ENSURE', 'STATE','UNTIL') {
249
          $hash_algo{avant}{$cmd} = 0 ;
250
} ;
251
for my $cmd ('ENDFOR','ENDIF','ENDWHILE','REQUIRE','ENSURE', 'STATE','UNTIL') {
252
          $hash_algo{apres}{$cmd} = 0 ;
253
}
254
 
255
 
256
# lit les fichiers wims.sty  puis les fichers .tex. pour éviter : un seul fichier tex, le premier ? 
257
 
258
my $TEXT = Init($FILE, \%hash_environ, \%hash_command, \%hash, \%hash_algo);
259
out1 ('sheet', $SHEET) ;
260
$ABOUT = $hash{about}{main} ;
261
out1 ('about.phtml', (($ABOUT)? $ABOUT :'') . '
262
<p>
263
Ce document a été créé par Latex2wims.<p>
264
 
265
!changeto docu/$module_language/about.phtml') ;
266
if (!($hash{author}{main})) {
267
  warn " ATTENTION : Vous devez mettre un nom d'auteur \\author{xxx}" ;
268
  $hash{author}{main}=$author } ;
269
if (!($hash{title}{main})) {
270
  warn " ATTENTION : Vous devez mettre un titre : \\title{xx} " ;
271
  $hash{title}{main} = '??' } ;
272
if (!($hash{email}{main})) {
273
  warn " ATTENTION : Vous devez mettre un email \\email{xxx}" ;
274
  $hash{email}{main}=$email } ;
275
 
276
 
277
# PASSE 2: ferme les \section & co
278
my $SEC_MIN_GLOBAL = 10; # = \infty
279
#$SEC_MIN_GLOBAL = 3 ; 
280
my @cnt = (0) x ($#SECTIONS + 1);
281
my ($secpattern) = join('|', @SECTIONS);
282
$TEXT =~ s/\\begin\s*{($secpattern)\s*}/cnt_section($1,\@cnt)/eg;
283
$TEXT =~ s/\\end\s*{\s*($secpattern)\s*}/<\/$1>/g;
284
$TEXT =~ s/\\(wimsentre)?($secpattern)\b\*?/open_close($2,\@cnt,$1)/eg;
285
$TEXT =~ s|</document>.*||s;
286
$TEXT =~ s|.*<document>||s;
287
if($SEC_MIN_GLOBAL == 10) {$SEC_MIN_GLOBAL = 0} ;
288
my ($NIVEAU, $NIVEAU_max) = ($SEC_MIN_GLOBAL, $SEC_MIN_GLOBAL + $depth - 1);
289
 
290
 
291
 
292
# PASSE 3: crée les blocs venant des sections et co
293
#  et renvoie une partie de la table des matières
294
my $toc = analyse_texte ($TEXT, \%hash, 'main', $NIVEAU, $NIVEAU_max, '');
295
# PASSE 4: création de tous les blocs ( environnements de type fold ou link)
296
{
297
  my ($ref, $ref_env)  = (\%hash, \%hash_environ);
298
  while (my ($Id, $TEXT) = each (%{$hash{text}})) {
299
    $TEXT = TraiteText ($TEXT, $ref, $ref_env, $Id);
300
#TODO non testé l'utilisation de prev etc
301
    $ref->{text}{$Id} = $TEXT;
302
  }
303
}
304
#récupération de tous les labels et rajout du titre en haut de la table dans la toc du tag
305
#On les traite pour que le label soit associé au nom du fichier créé automatiquement.
306
#$hash{toc}{$tag} contient les fichiers des sections en dessous de $tag
307
 
308
# PASSE 5
309
for my $tag (keys %{$hash{text}}) {
310
  my $T = $hash{text}{$tag};
311
  $T =~ s/\\label\s*\{([^}]+)\}/store_label($1, $tag, \%hash_bloc)/eg;
312
  $T =~ s/\\index\s*\{([^}]+)\}/store_index($1, $tag, \%hash_index)/eg;
313
  $hash{text}{$tag} = $T;
314
  my $tagupbl = $hash{upbl}{$tag};
315
  #plus utilisé, mais j'hésite !
316
#  $hash_toc{$tag} = "\\link{$tagupbl}\n\n" . $hash{toc}{$tagupbl};
317
}
318
 
319
 
320
# PASSE 6: sort l'index mis à jour des ref à l'aide des labels créés auparavant  et rajoute 
321
#TODO rajouter eqref mais ca dépend vraiment de la phrase !
322
for my $tag (keys %{$hash{text}}) {
323
  my $macro = '\\\\ref|\\\\cite|\\\\eqref';
324
  my $T = $hash{text}{$tag};
325
  my $cle = 'prev|next|upbl|titb|keyw|datm';
326
  $T =~ s/($macro)\{([^}]+)\}\{([^}]+)\}/store_ref($2, $3, $2, \%hash_bloc)/eg;
327
# repere toto~\cite{}
328
  $T =~ s/([^\s]+)\~($macro)\s*([.*])?\s*\{([^}]+)\}/store_ref($4, $1 .
329
    ($3||''), $4, \%hash_bloc)/eg;
330
  $T =~ s/($macro)\s*([.*])?\{([^}]+)\}/store_ref($3, ($2 ? "$3: $2" : $3), $3, \%hash_bloc)/eg;  
331
  $T =~ s/\\($cle)\s*\{(\w*)\}/store_tag($1, $2, $tag, \%hash, \%hash_bloc)/eg;
332
  $hash{text}{$tag} = $T;
333
}
334
my @L = sort {$a cmp $b} (keys %{$hash_index{page}}) ;
335
out('index', selection('<div class="index">' . makeindex (\%hash_index, 0, @L) . '</div>'
336
                         ,'left-selection','index')) if ($INDEX == 1 && makeindex (\%hash_index));
337
 
338
#crée les blocs [entourés de la table des matières]
339
 
340
#crée les deux sortes de fichiers demandés par wims .def (fichier de définition général) +
341
# nom.hd  qui gère les règles de navigation  pour chaque bloc
342
#attention : dans le cas où il y a un \\embed{toto}, il faut créer le fichier toto.hd ...
343
#TODO : \embed{toto} : je suppose ici que le contenu de toto est du wims à ne pas 
344
#interpréter
345
#pour l'instant je m'en suis servi pour stocker des programmes qui interviennent plusieurs fois. 
346
 
347
#Crée le vrai fichier qui est mis dans le dossier src
348
#On ne met pas de table de matières si le bloc est de type fold
349
#TODO option = chemin tout seul, toc à gauche + chemin, toc à gauche et à droite + chemin,  
350
#style selection droite, selection gauche
351
 
352
for my $tag (keys %{$hash{text}}) {
353
  complete ($tag, \%hash);
354
  out ("$tag.hd", hd($tag,\%hash));
355
  my $txt = traitement_final($hash{text}{$tag});
356
  my $tagupbl = $hash{upbl}{$tag};
357
  my $type = $hash{type}{$tag} ;
358
 #si type est non vide il est égal à embed ou fold
359
  my $dotoc_left = ($OPTION =~ /toc_left/ && !$type);
360
  my $dotoc_right = ($OPTION =~ /toc_right/ && !$type);
361
  my $dotoc_up = ($OPTION =~ /toc_up/ && !$type);
743 bpr 362
  my $dotoc_down = ($OPTION =~ /toc_down/ && !$type);
23 reyssat 363
  my $CHEMIN = chemin($tag, \%hash);
364
  #J'ai enlevé $LOAD
743 bpr 365
  $CHEMIN = ($dotoc_up || $dotoc_down)  && ($CHEMIN =~ $FLECHE) ? $CHEMIN : '';
366
  my $CHEMIN_up=($dotoc_up) ? $CHEMIN : '' ;
367
  my $CHEMIN_down=($dotoc_down) ? $CHEMIN : '' ;
23 reyssat 368
  my @Chemin = split(',', $hash{chemin}{$tag});
369
  my $TOCg = $dotoc_left ? selection($hash{toc}{main}, 'left_selection', @Chemin) : '';
370
  my $TOCd = ($dotoc_right && $tagupbl ne 'main') ? selection($hash{toc}{$tagupbl}, 'right_selection', @Chemin) : '';
371
  my $tit_index = ($hash{titb}{index})? $hash{titb}{index} : 'Index' ;
372
  my $index = ($INDEX == 1) ? "\n\n\\link{index}{$tit_index}" : '';
734 bpr 373
  my $tooltip = ($TOOLTIP == 1) ? "<script type=\"text/javascript\" src=\"scripts/js/wz_tooltip.js\"></script>" : '' ;
743 bpr 374
  out ($tag, $tooltip . toc_HTML ($txt, clean($TOCg,\%hash), clean($TOCd,\%hash), $CHEMIN_up, $CHEMIN_down, $index) );
23 reyssat 375
}
376
if ($INDEX == 1) { out ('index.hd', hd('index',\%hash) )};
377
my @style = sortuniq(split(',',$STYLE)) if ($STYLE) ;
378
out_def ('.def', def (\%hash, @style ));
379
 
380
##############
381
 
382
sub analyse_texte { my ($TEXT, $ref, $Id, $niveau, $niveau_max, $Toc) = @_;
383
  my $link = ($niveau <= $niveau_max);
384
  return $Toc if $niveau > $#SECTIONS ;
385
  my $section = $SECTIONS[$niveau];
386
  my $sectiontag = "<$section>";
387
  my @decoup = split (/$sectiontag/, $TEXT);
388
  my $text = $decoup[0];
389
  my $toc_titre ;
390
  my ($cnt, $id) = (1, "");
391
  #On parcourt un texte $Id : $text  et on enlève tous les niveaux inférieurs
392
 # (boucle while)
393
  while ( $decoup[$cnt]) {
394
  #tient compte des titres courts pour la toc
395
    my @u = extract_tagged ($decoup[$cnt],'\[','\]');
396
    $toc_titre = ($u[4]) ? $u[4] : '' ;
397
    @u = extract_tagged ($u[1],'{','}');
398
    if (!$u[4]) { $NUMERO = 1 ; warn " ATTENTION : section dans $Id sans titre ; l'option numerotation a été rajoutée"};
399
    my @extract = extract_tagged ($sectiontag . $u[1], $sectiontag);
400
 
401
    my $idold =  $id;
402
    $id = $Id . ($link? 'S': "$prefixe{fold}S") . $cnt;
403
    $cnt++;
404
    my $titre = $u[4];
405
    $toc_titre = $titre if (!$toc_titre) ;
406
    $titre =~ s/\n/ /g;
407
    $titre = Numero($id) . "  $titre" if ($NUMERO);
408
    $toc_titre = Numero($id) . "  $toc_titre" if ($NUMERO);
409
    $text .=  $link ?"\n\n\\link{$id}\n\n"
410
                    :"\n\n\\fold{$id}{<span class=\"$section\">$titre</span>}\n\n";
411
    if ($link) {
412
      $Toc .=  "\n\n<XXXX=$id>\\link{$id}{$toc_titre}</font><YYYY=$id>\n\n";
413
    }
414
    $text .= $extract[1];
415
    $ref->{titb}{$id} = $titre;
416
    $ref->{tittoc}{$id} = $toc_titre;
417
    $ref->{text}{$id} = $extract[4];
734 bpr 418
    $ref->{type}{$id} = 'fold' if !$link ;
23 reyssat 419
    $Toc = analyse_texte ($ref->{text}{$id}, $ref, $id, $niveau + 1, $niveau_max, $Toc) ;
420
    $ref->{upbl}{$id} = $Id;
421
    $ref->{prev}{$id} = $idold;
422
    $ref->{next}{$idold} = $id;
423
   #modifier avec selection
734 bpr 424
    my $tp = '' ;
425
    if ($TOOLTIP==1) {
426
    if (!$ref->{toctip}{$Id}) {$ref->{toctip}{$Id}=' ' ; } else {
427
      $ref->{toctip}{$Id} .= ($ref->{tittoc}{$id}) ?  '<br>': '' ;}
428
    $ref->{toctip}{$Id} .= $ref->{tittoc}{$id} ;
429
    $tp = "ZZZZZ$id" ; }
430
    $ref->{toc}{$Id} .= "\n<XXXX=$id>\\link{$id}{$ref->{tittoc}{$id}
431
    $tp }<YYYY=$id>\n";
23 reyssat 432
  }
433
 #maintenant, ce qui reste dans $text est exactement ce qu'on doit mettre dans le hash->{text}{$Id}
434
  $ref->{text}{$Id} = $text;
435
  $ref->{titb}{main} = $ref->{title}{main};
436
  $ref->{tittoc}{main} = $ref->{title}{main} if (!$ref->{tittoc}{main});
437
  $Toc;
438
}
439
 
440
sub store_tag { my ($cle, $label, $tag, $ref, $ref_bloc) = @_;
441
  $ref->{$cle}{$tag} = $ref_bloc->{fichier}{$label} ;
442
  '';
443
}
444
 
445
sub store_label { my ($label, $Id, $ref) = @_;
446
   $ref->{fichier}{$label} = $Id;
447
   "<a name=\"$label\">";
448
}
449
 
450
sub dbg { print STDERR "$_[0]\n" if ($verbose); }
451
 
452
sub store_index { my ($label, $Id, $ref_index) = @_;
453
   dbg("... index: \"$label\"");
454
   my $L = $ref_index->{page}{$label};
455
   $ref_index->{page}{$label} =  !$L ? $Id : "$L,$Id";
456
   "<a name=\"$label\">";
457
}
458
 
459
sub class_index { my ($index,$level) = @_ ;
460
     my @a = split('!', $index) ;
461
     ($a[$level])? $a[$level] : $index ;
462
 }
463
 #!(keys %{$ref_index->{page}}
464
 #sort keys %{$ref_index->{page}} ; 
465
 
466
sub makeindex { my ($ref_index, $level, @L ) = @_;
467
   return '' if (!$#L) ;
468
   my $dejavu = '' ;
469
   my $TEXT = "\n<ul class=\"index\">";
470
   for my $index (@L) {
471
      next if ($dejavu =~ /\b$index\b/) ;
472
      my @list = sort {$a cmp $b} grep {class_index($_, $level) eq class_index($index, $level)} @L ;
473
      my @l = split('!', $index) ;
474
      if ($l[$level]) {
475
          $TEXT .= "<li> " ;  
476
          for my $ind (split(',',$ref_index->{page}{$index})) {
477
             if ($ind && !($dejavu =~ /\b$ind\b/)) {
478
                 $TEXT .= "\\link{$ind}{".  $l[$level] . " }{$ind}" ;
479
             }
480
          }
481
          $dejavu .= ' ' . join (' , ', @list) ;
482
          $TEXT .= makeindex ($ref_index, $level + 1, @list) . "</li>" ;
483
      };
484
   }
485
   "$TEXT </ul>";
486
}
487
 
488
sub TraiteText {my ($TEXT, $ref, $ref_env, $Id) = @_;
489
  $TEXT =~ s/\s*$//; # strip trailing whitespace
490
 #0 ul et li sans rien
491
 #1 avec style
178 bpr 492
 $TEXT =~ s/\\(begin|end)\s*{wimsonly}/\n/g;
23 reyssat 493
 for my $rubrique (keys %{$ref_env->{list}}) {
494
     $TEXT = traite_list ($TEXT, $ref, $ref_env, $Id, $rubrique,1);
495
 }
496
 
497
 for my $rubrique (@liste_env_list) {
498
     $TEXT = traite_list ($TEXT, $ref, $ref_env, $Id, $rubrique,0);
499
 }
500
 
734 bpr 501
for my $rubrique (keys %{$ref_env->{tabular}}) {
502
     if ($TEXT =~ /\\begin{$rubrique}/) {
503
       $TEXT = traite_environ ($TEXT, $ref, $ref_env, $Id, $rubrique,0);
504
     }
505
 }
506
 
507
for my $rubrique (@liste_env_tabular) {
508
   if ($TEXT =~ /\\begin{$rubrique}/) {
509
     $TEXT = traite_environ ($TEXT, $ref, $ref_env, $Id, $rubrique,0);
510
   }
511
}
512
 
178 bpr 513
 for my $rubrique (@liste_env_spec) {
514
    if ($TEXT =~ /\\begin{$rubrique(\*)?}/) {
515
      $TEXT = traite_environ ($TEXT, $ref, $ref_env, $Id, $rubrique, 1);
516
    }
517
  }
23 reyssat 518
#le 1 et 0 servent à initialiser le compteur dans le cas ou on doit créer de nouveaux blocs dans la même page
178 bpr 519
 
23 reyssat 520
  for my  $rubrique (keys %{$ref_env->{titre}}) {
521
    if ($TEXT =~ /\\begin{$rubrique}/) {
522
      $TEXT = traite_environ ($TEXT, $ref, $ref_env, $Id, $rubrique,1);
523
    }
524
  }
525
  for my $rubrique (keys %{$ref_env->{list}}) {
526
     $TEXT = traite_environ ($TEXT, $ref, $ref_env, $Id, $rubrique,0);
527
     $TEXT = traite_environ ($TEXT, $ref, $ref_env, $Id, $rubrique . '_item',0);
528
  }
178 bpr 529
 
23 reyssat 530
  if ($TEXT =~ /\\begin\{\s*(\w*)\s*\}/g) {
531
     warn " ATTENTION : environnement non répertorié : $1" if $1 ne 'matrix';
532
  }
533
  $TEXT;
534
}
535
 
536
#on pourrait faire une boucle  while ; on pourrait avoir deux fois le meme environnement imbrique ?
537
#begin{proof} \begin{proof} \end{proof}\end{proof} Je crois que c'est pour cela que je fais ce truc
538
#tordu. En fait  split me sert uniquement à trouver le premier <$environ>
539
#$cnt sert à numéroter semi-globalement (création de blocs correspondant à un même environnement dans une meme page
540
#exemple mainS4S3F_proof1,mainS4S3F_proof2,mainS4S3F_proof3,mainS4S3F_proof4,mainS4S3F_proof5
734 bpr 541
 
23 reyssat 542
sub traite_list {my ($TEXT, $ref, $ref_env, $Id, $environ, $option) = @_;
734 bpr 543
 my ($e_item, $b_item , $b_class, $e_class) = (' ',' ', ' ', ' ');
23 reyssat 544
  if ( $option == 1 ) {
545
         $e_item = "\\end{$environ\_item}" ;
546
         $b_item = "\\begin{$environ\_item}" ;
547
      my $style = $ref_env->{style}{$environ} ;
548
      $style = ($style) ? $style : $environ;
549
      $b_class= "ul class=\"$style\"" ;
550
      $e_class= "\/ul" ;
551
      }
552
      {
743 bpr 553
        if    ($environ eq 'enumerate'){ $b_class = "ol class=\"enumerate\"" ; $e_class= "\/ol" ; }
554
        elsif ($environ eq 'itemize'){ $b_class = "ul class=\"itemize\"" ;  $e_class= "\/ul" ;}
23 reyssat 555
        elsif ($environ eq 'description'){
556
              $b_class = "ul style=\"list-style:none;\"" ;  
557
              $e_class= "\/ul" ;
558
              $e_item = "\\end{$environ\_item}" ;
559
              $b_item = "\\begin{$environ\_item}"
560
              }
561
        elsif ($environ eq 'trivlist') { $b_class = "ul style=\"list-style:none;\"" ;  
562
               $e_class= "\/ul" ;
563
        }
564
      };
565
  $TEXT =~ s/\\begin{$environ(\*)?}/<$environ>/g;
566
  $TEXT =~ s|\\end{$environ(\*)?}|<\/$environ>|g;
567
 
568
  my @decoup = split ("<$environ>", $TEXT);
569
 
570
  my $a = join ("<$environ>", @decoup[1..$#decoup]);
743 bpr 571
  return $TEXT if (!$a) ;
23 reyssat 572
  my @u = extract_tagged ("<$environ>$a", "<$environ>");
573
  my $milieu = "<$environ>" . $u[4] . "<\/$environ>"   ;
574
#FIXME pas de listes emboitées de type différent !
743 bpr 575
  $milieu =~ s|<$environ>\s*\\item|<$environ><li>$b_item|g ;
576
  $milieu =~ s|</$environ>|</li><$e_class>|g;
577
  $milieu =~ s|\\item|$e_item</li><li>$b_item|g;
578
  $milieu =~ s|</li><$e_class>|$e_item</li><$e_class>|g;
579
  $milieu =~ s|<$environ>|<$b_class>|g;
23 reyssat 580
  $decoup[0] . $milieu . traite_list ($u[1], $ref, $ref_env, $Id, $environ,$option);
581
}
582
 
583
sub traite_environ {my ($TEXT, $ref, $ref_env, $Id, $environ, $cnt) = @_;
584
  $TEXT =~ s/\\begin{$environ\*?}/<$environ>/g;
585
  $TEXT =~ s|\\end{$environ\*?}|</$environ>|g;
586
 
587
  my @decoup = split ("<$environ>", $TEXT);
588
 
589
  my $a = join ("<$environ>", @decoup[1..$#decoup]);
590
  return $TEXT if (!$a);
591
 
592
  my @u = extract_tagged ("<$environ>$a", "<$environ>");
593
  my $milieu = $u[4];
594
  return $TEXT if (!$milieu);
595
 
596
  my $pat_env = join('|', @liste_env_spec);
734 bpr 597
  my $patt_env = join('|', @liste_env_tabular);
23 reyssat 598
  if ($environ =~ /\b($pat_env)\b/) { $milieu = $1->($milieu) ; }
734 bpr 599
  elsif ($environ =~ /\b($patt_env)\b/) { $milieu = tabular->($milieu,$environ) ; }
600
  else { my @milieu1 = extract_bracketed ($milieu, '{}');
23 reyssat 601
    if ($milieu1[0]) { $milieu = $milieu1[4] ; };
602
    my $type = $ref_env->{type}{$environ};
603
 
604
    if ($type && ($type eq 'fold' || $type eq 'link')) {
605
      my $titre = $ref_env->{titre}{$environ};
606
      my $newtag = $Id . $prefixe{$type} . $environ . $cnt;
607
      $ref->{type}{$newtag} = 'fold' if $type eq 'fold' ;
608
      $cnt++;
609
      # LaTeX interdit des [ ] imbriqués.
610
      if ($milieu =~ s/^\s*\[([^\]]+)\]//) {
743 bpr 611
        $titre =  ($titre) ? "$titre [ $1 ]" :  $1 ;
23 reyssat 612
      }
613
      $ref->{titb}{$newtag} = $titre;
614
      $ref->{text}{$newtag} = encadrement("<$environ>$milieu<\/$environ>", $environ, $ref_env);
615
      $ref->{upbl}{$newtag} = $Id;
616
      $milieu = "\n\\$type\{$newtag\}\{"
617
        . encadr_defaut("<$environ>$titre<\/$environ>", $environ, $ref_env,'titre')
618
        . "\}\n\n" ;
619
    } else {  my $milieu1 = $milieu ;
734 bpr 620
      $milieu = encadrement("<$environ>$milieu<\/$environ>", $environ, $ref_env, 'full');
23 reyssat 621
    }
622
  }
623
  $decoup[0] . $milieu . traite_environ ($u[1], $ref, $ref_env, $Id, $environ, $cnt);
624
}
625
 
626
sub hd {my ($tag, $ref) = @_;
627
  my $txt = '';
628
  for  my $cle ('prev','next','upbl','titb','keyw','datm') {
629
    my $KEY = $ref->{$cle}{$tag};
630
    $txt .= "!set $cle=$KEY\n" if ($KEY);
631
  }
632
  $txt;
633
}
634
#rajoute un next aux section/subsection/ si cela n'existe pas [dernier] dernier sur index si il y a
635
#rajoute main pour ceux qui n'ont pas de parents. 
636
sub complete {my ($tag, $ref) = @_;
637
  $ref->{datm}{$tag} = isotime() if  !($ref->{datm}{$tag}) ;
638
  $ref->{upbl}{$tag} = 'main' if  !($ref->{upbl}{$tag}) ;
639
  my $upbl = $ref->{upbl}{$tag};
640
  if (!$ref->{next}{$tag}) {
641
    my $a = $ref->{next}{$upbl};
642
    $ref->{next}{$tag} = $a || 'main';
643
  };
644
  if (!$ref->{prev}{$tag}) {
645
    my $b = $ref->{prev}{$upbl};
646
    $ref->{prev}{$tag} = $b || 'main';
647
  };
648
  if ($INDEX == 1 && !($ref->{titb}{index})) { $ref->{titb}{index} = 'Index' ;}
649
}
650
 
651
#option full  <h2 class="defn">Définition [titre perso]</h2> <div class= "definition">  </div> si cela existe
652
#option bloc  <div class= "definition"> </div>  si cela existe (intérieur d'un fold ou d'un link)
653
#option titre  <h2 class="defn">Définition </h2>  si cela existe (titre d'un fold)
654
sub encadr_defaut { my ($TEXT, $rubrique, $ref_env, $option) = @_;
655
  my $a = $ref_env->{titre}{$rubrique};
656
  my $b = $ref_env->{style}{$rubrique};
657
  if (!$b) {
658
    $b = $rubrique;
659
    $ref_env->{style}{$rubrique} = $b;
660
    dbg("... environnement $rubrique sans style css, par defaut $rubrique")
661
  };
662
  my $div_d = "<div class=\"$b\">";
663
  my $div_f = '</div>';
664
  if ( $option eq 'titre') {
665
    $TEXT =~ s/<$rubrique>/<span class=\"$b\">/g;
666
    $TEXT =~ s/<\/$rubrique>/<\/span>\n\n/g;
667
  } elsif (!$a || $option eq 'bloc') {
668
    $TEXT =~ s/<$rubrique>\s*(\[[^\]]+\])?/$div_d/g;
669
    $TEXT =~ s/<\/$rubrique>/$div_f\n\n/g;
670
  } elsif ($option eq 'full') {
671
    $TEXT =~ s/<$rubrique>\s*(\[[^\]]+\])/<h2 class=\"$b\">$a $1<\/h2>$div_d/g;
672
    $TEXT =~ s/<$rubrique>/<h2 class=\"$b\">$a<\/h2>$div_d/g;
673
    $TEXT =~ s/<\/$rubrique>/$div_f\n\n/g;
674
  } else  {
675
    $TEXT =~ s/<$rubrique>/<span class=\"$b\">/g;
676
    $TEXT =~ s/<\/$rubrique>/<\/span>\n\n/g;
677
  }
678
  $TEXT;
679
}
680
sub encadrement {  my ($TEXT, $rubrique, $ref_env) = @_;
681
  my $debut = $ref_env->{deb}{$rubrique};
682
  my $fin   = $ref_env->{fin}{$rubrique};
743 bpr 683
  my $opt= ($ref_env->{type}{$rubrique} && $ref_env->{type}{$rubrique}=~ /fold/) ? 'bloc' : 'full' ;
684
  return encadr_defaut ($TEXT, $rubrique, $ref_env, $opt) if (!$debut && !$fin);
23 reyssat 685
 
686
  $TEXT =~ s/<$rubrique>//;
687
  my $cnt_arg = $ref_env->{cnt_arg}{$rubrique};
688
  my $d = join('   ', subst($TEXT, $cnt_arg, $debut, $rubrique, $ref_env));
689
  my ($com,$txt) = subst($TEXT, $cnt_arg, $fin);
690
  $d =~ s/<\/$rubrique>/$com/;
691
  $d;
692
}
693
 
734 bpr 694
 
695
sub tabular { my ( $b, $style ) = @_;
696
  my @v = extract_bracketed ($b, '{}') ;
697
  my $stylerow = $style . "_row";
698
  my $stylecell = $style . "_cell";
699
  $b =  "<table class=\"$style\"><tr class=\"$stylerow\"><td class=$stylecell>" . $v[1] . '</table>';
700
  $b =~ s|\&|&nbsp;</td><td class=$stylecell>&nbsp;|g;
23 reyssat 701
  $b =~ s/\\hline//g;
702
  $b =~ s|\\\\\s*</table>|</td></tr></table>|g;
743 bpr 703
  my $par="\\\\\\(|\\\\\\)" ;
704
  my @dectab = split(/$par/, $b) ;
705
  $b = $dectab[0] ;
734 bpr 706
  $b =~ s|\\\\|</td></tr><tr class=$stylerow><td class=$stylecell>|g;
743 bpr 707
  my $cnt = 0; $b = '' ;
708
  while ($cnt <= $#dectab/2) {
709
     my $c = $dectab[2*$cnt] ;
710
     $c =~ s|\\\\|</td></tr><tr class=$stylerow><td class=$stylecell>|g;
711
     $b .=  $c . (($dectab[2*$cnt+1]) ? "\\(" . $dectab[2*$cnt+1] .  "\\)" : '' )  ;
712
     $cnt ++ ;
713
 };
714
 $b ;
23 reyssat 715
}
716
 
743 bpr 717
 
23 reyssat 718
sub multline { my ( $b) = @_;
719
  $b =~ s/\\\\\s*=/\\)<br>\\(== /g;
720
  $b =~ s|\\\\|\\)<br>\\(|g;
721
  "<div class=\"math\">\\(" . $b . "\\)</div>\n";
722
}
723
 
724
sub equation { my ( $b) = @_;
725
  $b = "\\(  $b \\)";
726
  if ($b =~ s/\\label{([^\}]+)}//) { $b = "\\label{$1}" . $b };
727
  '<div class="math">' . $b . '</div>' ;
728
}
729
 
730
sub align1 { my ( $b) = @_;
731
  $b = "\\(\\begin{matrix}  $b  \\end{matrix} \\)";
732
  if ($b =~ s/\\label{([^\}])}//) { $b = "\\label{$1}" . $b };
733
  '<div class="math">' . $b . '</div>' ;
734
}
735
sub align { my ( $b) = @_;
736
  $b =  '<table border=0 align="center" class="tableau"><tr><td>\\(' . $b . '\\\\</table>';
737
  if ($b =~ s/\\label{([^\}])}//) { $b = "\\label{$1}" . $b };
738
  $b =~ s|\&|\\)&nbsp;</td><td>&nbsp;\\(|g;
739
  $b =~ s|\\\\\s*</table>|\\)</td></tr></table>|g;
740
  $b =~ s|\\\\|\\)</td></tr><tr><td>\\(|g;
741
  '<div class="math">' . $b . '</div>' ;
742
}
743
 
744
sub pmatrix {"\\left ( \\begin{matrix} " . $_[0] . "\\end{matrix} \\right )" ;}
745
sub smallmatrix {"\\left ( \\begin{matrix} " . $_[0] . "\\end{matrix} \\right )" ;}
746
sub eqnarray {" <div class=\"math\">\\(\\begin{matrix} " . $_[0] . "\\end{matrix})</div> " ;}
747
sub center {" <div class=\"center\">" . $_[0] . "</div>"}
748
 
749
sub array {my ( $b ) = @_ ;
750
  my @v = extract_bracketed ($b, '{}');
751
  "\\begin{matrix} " . $v[1] . "\\end{matrix} ";
752
}
753
#TODO pour l'instant
754
sub cases {"\\Biggl \\{\\begin{matrix} " . $_[0] . "\\end{matrix}" ; }
755
 
756
sub gather { my ($b) = @_;
757
  my @decoup = split ('\\\\intertext', $b);
758
  my $cnt = 1;
759
  $b = equation($decoup[0]);
760
  while ($cnt <= $#decoup) {
761
    my @a = extract_bracketed ( $decoup[$cnt], '{}' );
762
    my $c = $a[0];
763
    $c =~ s/\{(.*)\}/$1/;
764
    $b .= $c . equation($a[1]);
765
    $cnt ++;
766
  }
767
  $b;
768
}
769
 
770
sub displaymath {"<div class=\"math\">\\( " . $_[0]. "\\)</div>"; }
771
sub math {" \\( " . $_[0]. "\\) "; }
772
 
773
 
774
sub thebibliography { my ( $b ) = @_;
775
  $b =~ s/\\bibitem{([^}]+)}/<\/li>\n<li>\[$1\]\\label{$1} /g;
776
  $b =~ s/\{\d+\}\s*<\/li>//;
777
  '<h2 class="thebibliography">' . $hash{titb}{ref}
778
  . "</h2>\n<ul class=\"thebibliography\">$b </li></ul>\n";
779
}
780
sub pspicture { '<p>dessin à faire dans wims</p>' ; }
781
sub picture { '<p>dessin à faire dans wims</p>' ; }
782
 
783
#decoupe ce qui se trouve à l'intérieur de \begin{wims} \end{wims} pour ne pas y toucher.
784
#faire de même pour verbatim
785
sub traite_special { my ( $TEXT, $ref_spec, $ref, $environ ) = @_;
786
  $TEXT = recup_embed($TEXT, $ref) ;
787
  $TEXT =~ s/\\begin{$environ}/<$environ>/g;
788
  $TEXT =~ s/\\end{$environ}/<\/$environ>/g;
789
  $TEXT =~ s/\r\n/\n/gs ;
790
  my @decoup = split ("<$environ>", $TEXT);
791
  my $cnt = 1;
792
  if ($#decoup) {
793
    $TEXT = $decoup[0];
794
    while ($cnt <= $#decoup) {
795
      my @a = extract_tagged("<$environ>" . $decoup[$cnt], "<$environ>");
796
      die "Bug dans $environ insertion: $decoup[$cnt]" if (!defined($a[4]));
797
      $TEXT .= $environ . 'insertion' . $cnt . $a[1];
798
      $ref_spec->{$cnt} = $a[4];
799
      $cnt++;
800
    }
801
  }
802
  $TEXT;
803
}
804
 
805
sub latexonly { '' }
806
 
807
sub store_cmd { my ($def, $id, $narg, $val, $ref_command) = @_;
808
  if ($hash_secinv{$id}) {
809
    warn " ATTENTION : commande perso \"$id: argument invalide\n";
810
    return '';
811
  }
812
  my $origin = $ref_command->{origin}{$id};
813
  return '' if ($origin && $origin eq 'defwims' && $def ne 'defwims');
814
  $ref_command->{origin}{$id} = $def;
815
  $ref_command->{cnt_arg}{$id} = $narg;
816
  $ref_command->{definition}{$id} = $val;
817
  dbg("... commande perso \"$id\": argument: \"$narg\" definition: \"$val\"");
818
 '' ;
819
}
820
 
821
sub store_environ { my ($def, $cmd, $narg, $titre, $deb, $fin, $ref_env) = @_;
822
  my $origin = $ref_env->{origin}{$cmd};
823
  return '' if ($origin && $origin eq 'environmentwims' && $def ne 'environmentwims');
824
  $ref_env->{deb}{$cmd} = $deb;
825
  $ref_env->{fin}{$cmd} = $fin;
826
  $ref_env->{cnt_arg}{$cmd} = $narg;
827
  $ref_env->{titre}{$cmd} = $titre;
828
  $ref_env->{origin}{$cmd} = $def;
829
  my $style = $ref_env->{style}{$cmd} ;
830
  $style = ($style)? $style : $cmd ;
734 bpr 831
  #if (!$ref_env->{deb}{$cmd}) { $ref_env->{deb}{$cmd} = "<div class=\"$style\"> "; }
832
  #if (!$ref_env->{fin}{$cmd}) { $ref_env->{fin}{$cmd} = "</div> "; }
23 reyssat 833
  dbg("... environnement perso \"$cmd\" argument: \"$narg\" titre: \"$titre\" style: \"$style\" debut: \"$deb\"  fin: \"$fin\"");
834
  '';
835
}
836
 
837
 
838
sub recup_command {my ($TEXT, $ref_command) = @_;
839
  my $DEF = '(defwims|def|newcommand|renewcommand)';
840
  #FIXME ? mauvais pour def \def\toto#1#2 ... demander de le refaire avec defwims s'il y a plus de 3 arguments ? 
841
  $TEXT =~ s/\\$DEF\s*\\(\w*)#(\d)\{(.*)\}/store_cmd($1,$2,$3,$4,$ref_command)/eg;
842
  #2 arguments
843
  $TEXT =~ s/\\$DEF\s*\\(\w*)#(\d)#(\d)\{(.*)\}/store_cmd($1,$2,$4,$5,$ref_command)/eg;
844
  $TEXT =~ s/\\$DEF\s*\\(\w*)\s*\{(.*)\}/store_cmd($1,$2,0,$3,$ref_command)/eg;
845
  #3 arguments
846
  $TEXT =~ s/\\$DEF\s*\\(\w*)#(\d)#(\d)#(\d)\{(.*)\}/store_cmd($1,$2,$5,$6,$ref_command)/eg;
847
  # newcommand avec paramètres
848
  $TEXT =~ s/\\$DEF\s*\{\\(\w*)\}\s*\[(\d)\]\s*\{(.*)\}/store_cmd($1,$2,$3,$4,$ref_command)/eg;
849
  # newcommand sans paramètres
850
  $TEXT =~ s/\\$DEF\s*\{\\(\w*)\}\s*\{(.*)\}/store_cmd($1,$2,0,$3,$ref_command)/eg;
851
  $TEXT;
852
}
853
 
854
sub recup_config { my ($cmd, $arg, $ref_env) = @_;
855
  my @L = (split (',', $arg));
856
  my $style = $L[0];
857
  my $type = 'style';
858
  if ($cmd eq 'typefold') { $style = 'fold';  $type = 'type' };
859
  if ($cmd eq 'typelink') { $style = 'link' ; $type = 'type' };
734 bpr 860
  if ($cmd eq 'tablewims') { $type = 'tabular' ; };
23 reyssat 861
  if ($cmd eq 'listwims') {                   $type = 'list' };
862
  for my $rubrique (@L) {
863
    $ref_env->{$type}{$rubrique} = $style;
864
    dbg("... commande $rubrique de $type $style");
865
    if ($cmd eq 'listwims') { $ref_env->{'style'}{$rubrique . '_item'} = $style . '_item' ;
866
                              $ref_env->{'titre'}{$rubrique . '_item'} = '' }
867
  }
734 bpr 868
  push @liste_env_tabular, (keys %{$ref_env->{tabular}}) ;
23 reyssat 869
 '';
870
}
871
sub recup_environ {my ($TEXT, $ref_env) = @_;
872
  my $pat = '\s*\{(.*)\}';
734 bpr 873
  $TEXT =~ s/\\(typefold|typelink|samestyle|listwims|tablewims)\{([^\}]+)\}/recup_config($1,$2, $ref_env)/eg;
23 reyssat 874
  # {nom}[#param]{titre}{debut}{fin}
875
  $TEXT =~ s/\\(environmentwims|[re]?newenvironment)\s*\{(\w*)\}\[(\d)\]$pat$pat$pat/store_environ($1,$2,$3,$4,$5,$6,$ref_env)/eg;
876
  # {nom}{titre}{debut}{fin}
877
  $TEXT =~ s/\\(environmentwims|[re]?newenvironment)\s*\{(\w*)\}$pat$pat/store_environ($1,$2,0,'', $3,$4,$ref_env)/eg;
878
 #\newtheorem{nom}[]?{titre}[]?
879
  $TEXT =~ s /(\\newtheorem\*?)\s*\{(\w*)\}\s*(\[[^\]]*\])?\s*\{([^\}]*)\}\s*(\[[^\]]*\])?\s*/store_environ($1,$2,0,$4,'','',$ref_env)/ge;
880
  $TEXT;
881
}
882
 
883
#on suppose que le texte commence par \command{}{}{}{} avec le bon nombre d'arguments
884
 
885
sub traite_command {my ($TEXT, $command, $ref_command) = @_;
886
  my $cnt_arg = $ref_command->{cnt_arg}{$command};
887
  my $com = $ref_command->{definition}{$command};
888
  if ($cnt_arg) {
889
    $TEXT =~ s/\\$command\s*\{/\{/;
890
    $TEXT = join ( "  ", subst($TEXT, $cnt_arg, $com));
891
  } else {
892
    $TEXT =~ s/\\$command\_/$com . '_'/ge;
893
    $TEXT =~ s/\\$command\b/$com/ge;
894
  }
895
  $TEXT;
896
}
897
#Texte = {}{}{} ou []{}{} qui sont les arguments
898
sub subst { my ($TEXT, $cnt_arg, $com, $environ, $ref_env ) = @_;
899
  my (@a,$u,$v);
900
  my $cnt = 0;
901
  while ($cnt < $cnt_arg) {
902
    @a = extract_tagged($TEXT, '{','}');
903
    ($u,$v) = ($a[1],$a[4]);
904
    if (!$a[0]) {
734 bpr 905
      @a = extract_tagged($TEXT, '\[','\]');
906
      ($u,$v) = ($a[1],$a[4]);
23 reyssat 907
    }
908
    $TEXT = $u;
909
    $cnt ++;
910
     my $sub = $environ && $ref_env->{titre}{$environ} ? join (' ' , ( $ref_env->{titre}{$environ}, $v)) : $v;
743 bpr 911
     if (($com) && ($sub) && ("#$cnt")) { $com =~ s/#$cnt/$sub/ge ;  }  ;
23 reyssat 912
  }
913
  ($com, $TEXT);
914
}
915
 
916
sub Traite_command { my ($TEXT, $command, $ref_command) = @_;
917
  my $cnt_arg = $ref_command->{cnt_arg}{$command};
918
  if ($cnt_arg) {
919
    my @decoup = split ("\\\\$command\{", $TEXT );
920
    my $cnt = 1;
921
    $TEXT = $decoup[0];
922
    while ($cnt <= $#decoup) {
923
      $TEXT .= traite_command ('{' . $decoup[$cnt], $command, $ref_command);
924
      $cnt++;
925
    }
926
  } else {
927
    while( $TEXT =~ /\\$command\b/) {
928
      $TEXT = traite_command ($TEXT, $command, $ref_command);
929
    }
930
  }
931
  $TEXT;
932
}
933
 
934
my %outagain;
935
sub out { my ($bloc, $text) = @_;
936
  warn "Écrase $bloc" if ($outagain{$bloc});
937
  $outagain{$bloc} = 1;
938
  open  (OUT, ">$BASE/$bloc") || die "ne peut pas créer $BASE/$bloc";
939
  print OUT $text ; close OUT;
940
}
941
 
942
sub out1 { my ($bloc, $text) = @_;
943
  warn "Écrase $bloc" if ($outagain{$bloc});
178 bpr 944
  $outagain{$bloc} = 1;
23 reyssat 945
  open  (OUT, ">$doc_DIR$bloc") || die "ne peut pas créer $doc_DIR/$bloc";
946
  print OUT $text ; close OUT;
947
}
948
 
949
sub out_def { my ($bloc, $text) = @_;
950
  open  (OUT, ">$BASE0/$bloc") || die "peut pas créer $BASE0/$bloc";
951
  print OUT $text ; close OUT;
952
}
953
 
954
# PASSE 1: développe 'input/include'
955
sub find_expand { my ($file) = @_;
956
  if (!open(IN, $DIR . $file)) { warn "$DIR$file n'existe pas"; return; }
957
  dbg("... lecture de $file");
958
  my $text = <IN>; close(IN);
743 bpr 959
  $text =~ s/([^%]\s*\\end{document})[[:print:][:space:]]+/$1/;
960
  $text =~ s/([^%])\s*\\endinput[[:print:][:space:]]+/$1/;
961
  $text =~ s/\%\\(input|include|wimsinclude)([^\n]+)?//g;
962
  $text =~ s/\\(input|include|wimsinclude)\s*{?([a-zA-Z0-9\-_\/]+)\.(sty|tex)\s*}?/find_expand("$2.$3")/eg;
23 reyssat 963
  $text;
964
}
965
 
966
sub open_close { my ($sec, $cnt, $entre) = @_;
967
  my ($txt) = '';
968
  my ($ind) = $hash_secinv{$sec};
969
  #ferme
970
  for (my $i = $#SECTIONS; $i >= $ind; $i--)
971
  {
972
    if ($cnt->[$i]) { $txt .= "</$SECTIONS[$i]>\n"; $cnt->[$i] = 0; }
973
  }
974
  #ouvre
975
  if (!$entre) {
976
    $txt .= "<$sec>"; $cnt->[$ind] = 1;
977
    $SEC_MIN_GLOBAL = $ind if ($ind < $SEC_MIN_GLOBAL && $ind);
978
  }
979
  $txt;
980
}
981
 
982
sub cnt_section { my ($sec, $cnt) = @_ ;
983
  my ($txt) = '';
984
  my ($ind) = $hash_secinv{$sec};
985
  $SEC_MIN_GLOBAL = $ind if ($ind < $SEC_MIN_GLOBAL && $ind);
986
  "<$sec>"
987
 }
988
 
989
 
990
sub store { my ($ref, $cle, $id, $text, $court) = @_ ;
991
   $ref->{$cle}{$id}=$text ;
992
   if (defined($court)) { $court =~ s/\[|\]//g ; $ref->{tittoc}{$id} = $court ; } ;
993
   '';
994
 }
995
sub store_option { my ($A) = @_ ; $A = join(' ' , split(',', $A)) ;
734 bpr 996
    if ($A =~ s/numero//)  { $NUMERO = 1 ;} ;
23 reyssat 997
    if ($A =~ s/index//)   { $INDEX = 1 ;}
734 bpr 998
    if ($A =~ s/tooltip//) { $TOOLTIP = 1 ;}
23 reyssat 999
    if ($A =~ s/depth\s*=\s*([0-8])//) { $depth = $1 ; }
1000
    $OPTION .= $A ;
1001
   '' ;
1002
 }
1003
 
1004
sub store_include { my ($A) = @_ ; $A = join(' ' , split(',', $A)) ;
1005
    if ($A =~ s/(\w*)\.(tex|sty)//) {
1006
         if ($MACRO) {$MACRO .= ",$1.$2" } else {$MACRO = "$1.$2" }
1007
    };
1008
    if ($A =~ s/(\w*\.css)\b//) { if ($STYLE) {$STYLE .= ",$1" } else {$STYLE = $1 } };
1009
    if ($A =~ s/embed\s*=\s*([^}]+)//) { $EMBED = $1 ; }
1010
   '' ;
1011
 }
1012
 
1013
sub add { my ($a,$b)=@_ ;
1014
    if ($a) {$a .= ",$b" } else {$a = $b }
1015
 }
1016
 
1017
sub Init { my ($file, $ref_env, $ref_command, $ref, $ref_algo) = @_;
1018
  my ($total, $TEXT) = (0, find_expand($file));
1019
  my %hash_spec = (wims =>{}, verbatim =>{});
1020
  my $ref_spec = \%hash_spec;
1021
  $TEXT = traite_special ($TEXT, $ref_spec->{wims}, $ref,'wims');
1022
  $TEXT = traite_special ($TEXT, $ref_spec->{verbatim}, $ref,'verbatim');
1023
  $TEXT = traitement_initial ($TEXT);
1024
  $TEXT =~ s/\\wimsoption\s*\{([^\}]+)\}/store_option($1)/eg ;
1025
  $TEXT =~ s/\\makeindex/store_option('index')/eg ;
1026
  $TEXT =~ s/\\wimsinclude\s*\{([^\}]+)\}/store_include($1)/eg ;
1027
  $TEXT =~ s/\\(title|email|author|about)\s*(\[[^\]]+\])?\s*\{([^\}]+)\}/store($ref,$1,'main',$3,$2)/eg ;
1028
 
1029
  $TEXT = traite_preambule ($TEXT, $ref_env, $ref_command, $ref);
1030
  for my $command (keys %{$ref_command->{definition}}) {
1031
    $TEXT = Traite_command ($TEXT, $command, $ref_command);
1032
  }
1033
  for my $A (@liste_voca) {
1034
   $ref_algo->{titre}{$A} =  $ref_command->{definition}{"algorithmic\L$A\E"}  if ($ref_command->{definition}{"algorithmic\L$A\E"}) ;
1035
} ;
1036
  $TEXT =~ s/wimsinsertion(\d*)/$ref_spec->{wims}{$1}/g;
1037
  $TEXT =~ s/verbatiminsertion(\d*)/<pre class="verbatim">$ref_spec->{verbatim}{$1}<\/pre>/g;
1038
  $TEXT;
1039
}
1040
 
1041
#sub store_makeindex { my ($txt) = @_ ;
1042
#    $txt =~ s/\\printindex/\link{index}{Index}/ ;
1043
#   }
1044
sub traitement_final { my ($TEXT) = @_;
1045
 #FIXME : je ne peux pas faire ca à cause des exercices de développement dont l'adresse
1046
 #contienne un ~. De toute facon
1047
 #ca ne devrait pas exister, mais quand même. ou les wims only
1048
#   $TEXT =~ s/~/&nbsp;/g;
1049
   $TEXT;
1050
}
1051
 
1052
sub traitemath {my ($txt) = @_;
1053
  my $test = 0;
1054
  while ($txt =~ /\$\$/) {
1055
    $txt = $` . ($test == 0 ? '<div class="math">\\(' : '\\)</div>') . $';
1056
    $test = 1-$test;
1057
  }
1058
  $txt;
1059
}
1060
 
1061
sub traitement_initial { my ($TEXT) = @_;
1062
  $TEXT =~ s/\s*$//; # strip trailing whitespace
1063
  $TEXT =~ s/\r\n/\n/gs ;
1064
  $TEXT = traitemath($TEXT);
1065
  $TEXT =~ s/{\s*\\(bf|tt|it)\b/\\text$1\{/g;
1066
  $TEXT =~ s/\\begin\b\s*/\\begin/g;
1067
  $TEXT =~ s/\\end\b\s*/\\end/g;
1068
  #$TEXT =~ s/\\text\b/\\hbox/g;
1069
  $TEXT =~ s,\\\[,<p class="math">\\(,g;
1070
  $TEXT =~ s,\\\],\\)</p>,g;
1071
  $TEXT =~ s/\$([^\$]+)\$/\\( $1 \\)/g;
1072
 
1073
  $TEXT =~ s/\\`\s*{a}/à/g;
1074
  $TEXT =~ s/\\\^\s*{a}/â/g;
1075
  $TEXT =~ s/\\'\s*{a}/á/g;
1076
  $TEXT =~ s/\\'\s*{e}/é/g;
1077
  $TEXT =~ s/\\`\s*{e}/è/g;
1078
  $TEXT =~ s/\\\^\s*{e}/ê/g;
1079
  $TEXT =~ s/\\\^\s*{i}/î/g;
1080
  $TEXT =~ s/\\\`\s*{i}/ì/g;
1081
  $TEXT =~ s/\\\"\s*{i}/ï/g;
178 bpr 1082
  $TEXT =~ s/\\\"\s*{\\i}/ï/g;
23 reyssat 1083
  $TEXT =~ s/\\\^\s*{o}/ô/g;
1084
  $TEXT =~ s/\\\"\s*{o}/ö/g;
1085
  $TEXT =~ s/\\\`\s*{o}/ò/g;
1086
  $TEXT =~ s/\\\^\s*{u}/û/g;
1087
  $TEXT =~ s/\\`\s*{u}/ù/g;
1088
  $TEXT =~ s/\\c\s*\{c\}/ç/g;
1089
 
1090
  $TEXT =~ s/\\`\s*a/à/g;
1091
  $TEXT =~ s/\\\^\s*a/â/g;
1092
  $TEXT =~ s/\\'\s*a/á/g;
1093
  $TEXT =~ s/\\'\s*e/é/g;
1094
  $TEXT =~ s/\\`\s*e/è/g;
1095
  $TEXT =~ s/\\\^\s*e/ê/g;
1096
  $TEXT =~ s/\\\^\s*i/î/g;
1097
  $TEXT =~ s/\\\`\s*i/ì/g;
1098
  $TEXT =~ s/\\\"\s*i/ï/g;
1099
  $TEXT =~ s/\\\^\s*o/ô/g;
1100
  $TEXT =~ s/\\\"\s*o/ö/g;
1101
  $TEXT =~ s/\\\`\s*o/ò/g;
1102
  $TEXT =~ s/\\\^\s*u/û/g;
1103
  $TEXT =~ s/\\`\s*u/ù/g;
1104
  $TEXT =~ s/\\c \s*c/ç/g;
1105
 
1106
  $TEXT =~ s/{\s*\\`\s*a\s*}/à/g;
1107
  $TEXT =~ s/{\s*\\\^\s*a\s*}/â/g;
1108
  $TEXT =~ s/{\s*\\'\s*a\s*}/á/g;
1109
  $TEXT =~ s/{\s*\\'\s*e\s*}/é/g;
1110
  $TEXT =~ s/{\s*\\`\s*e\s*}/è/g;
1111
  $TEXT =~ s/{\s*\\\^\s*e\s*}/ê/g;
1112
  $TEXT =~ s/{\s*\\\^\s*i\s*}/î/g;
1113
  $TEXT =~ s/{\s*\\\`\s*i\s*}/ì/g;
1114
  $TEXT =~ s/{\s*\\\"\s*i\s*}/ï/g;
1115
  $TEXT =~ s/{\s*\\\^\s*o\s*}/ô/g;
1116
  $TEXT =~ s/{\s*\\\"\s*o\s*}/ö/g;
1117
  $TEXT =~ s/{\s*\\\`\s*o\s*}/ò/g;
1118
  $TEXT =~ s/{\s*\\\^\s*u\s*}/û/g;
1119
  $TEXT =~ s/{\s*\\`\s*u\s*}/ù/g;
1120
  $TEXT =~ s/{\s*\\c \s*c\s*}/ç/g;
1121
 
1122
 #$TEXT =~ s/([^\\])\%+/$1/g;
1123
  $TEXT =~ s/([^\\])\%.*/$1/g;
1124
  $TEXT =~ s/\n\%.*/\n/g;
1125
  $TEXT =~ s/\\\\\[\S*\]/\n\n/g;
1126
  $TEXT =~ s/\\(vspace|hspace|vskip|hskip)\**{\S*}//g;
1127
  $TEXT =~ s/\\parskip=*[a-z0-9 \.]+//g;
1128
  $TEXT =~ s/\\(vskip|hskip)\s*[a-z0-9 \.]+//g;
1129
  $TEXT =~ s/\\smallskip/\n/g;
1130
  $TEXT =~ s/\\(med|big)skip/\n\n/g;
1131
#  $TEXT =~ s/\\makebox\[(\w)cm\]{ }/\&nbsp\&nbsp\&nbsp/g;
1132
  $TEXT =~ s/~(:|;|\?|\!)/&nbsp;$1/g;
1133
 #utiliser verb uniquement dans le cas d'un mot
1134
#FIXME:  $TEXT =~ s/\verb"([^"]+)"/<tt class=verb>$1<\/tt>/g;
1135
  $TEXT =~ s/\\includegraphics\s*\[(.*)\]\s*{(.*)}/<img src=\\filedir\/$2 $1>/g;
743 bpr 1136
  $TEXT =~ s/\\includegraphics\s*{(.*)}/<img src=$1>/g;
23 reyssat 1137
  $TEXT =~ s/\\(begin|end){document}/\\document /g;
1138
  $TEXT =~ s/\\exercise{module=([^\&]+)\&([^}]+)}{([^}]+)}/store_sheet($1,$2,$3,$worksheet)/eg ;
734 bpr 1139
  $TEXT =~ s/\\xspace//g;
23 reyssat 1140
  $TEXT;
1141
}
1142
 
178 bpr 1143
sub store_sheet { my ($ad1,$ad2,$titre,$worksheet) = @_ ;
1144
   $ad2 =~ s/worksheet=(\d)+//g ;
1145
   $SHEET .= ":$ad1\n$ad2\n$titre\n\n" ;
23 reyssat 1146
   "\\exercise\{module=$ad1\&$ad2\&worksheet=$worksheet\}\{$titre\}" ;
1147
 }
1148
 
1149
sub traite_preambule { my ($TEXT, $ref_env, $ref_command, $ref) = @_;
1150
  if ($TEXT=~ s/\\usepackage\[([^]]+)\]\{algorithmic\}//) {
1151
       $algo_noend = 1  if ($1 =~ /noend/);
1152
 
1153
  } ;
1154
  $TEXT = recup_environ($TEXT, $ref_env);
1155
  $TEXT = recup_command($TEXT, $ref_command);
1156
  $TEXT = recup_embed($TEXT, $ref) ;
1157
  for my $cmd ('ref','index') {
1158
     $ref->{titb}{$cmd} = $ref_command->{definition}{$cmd . "name"}
1159
  }
1160
  $TEXT;
1161
}
1162
 
1163
sub store_embed { my ($id, $titre, $ref) = @_ ;
1164
     $ref->{titb}{$id} = $titre ; $ref->{text}{$id} = `cat $EMBED/$id` ;
1165
     $ref->{upbl}{$id}='main'; $ref->{type}{$id}='embed';
1166
     "\\embed{$id}{$titre}" ;
1167
}
1168
 
1169
sub recup_embed { my ($TEXT, $ref) = @_ ;
1170
     $TEXT =~ s /\\embed\s*{([^}]+)}\s*{(.*)}/store_embed ($1, $2, $ref)/eg ;
1171
     $TEXT ;
1172
 }
1173
 
1174
#FIXME on ne peut prendre qu'un seul fichier de style
1175
#crée le fichier 1/.def
1176
sub def { my ($ref, @style) = @_;
1177
  my $tit = $ref->{title}{main};
1178
  my $aut = $ref->{author}{main};
1179
  my $mail= $ref->{email}{main};
1180
  my $datm= $ref->{datm}{main};
1181
  my $header = '' ;
1182
  my $header_tmp ;
1183
  for my $file (@style){
1184
    if (!open(IN, $DIR . $file)) { die "le fichier $DIR$file n'existe pas";}
1185
    open (IN, $DIR . $file);
1186
    ($header_tmp = <IN>) =~ s/\n/\t/g;
1187
    $header .= "\t $header_tmp" ;
1188
  }
1189
  close IN;
1190
"copyright=gnu
1191
docopen=yes
1192
dlang=fr
1193
tit=$tit
1194
author=$aut
1195
email=$mail
1196
header=$header
1197
datm=$datm";
1198
}
1199
#TODO en fait il faudrait renvoyer dans le cas ou le fichier est de type fold à la page en dessus
1200
# dépliée. Je ne suis pas sure de savoir faire ! sinon, on perd la table des matières.
1201
 
1202
sub store_ref { my ($link, $titre, $anchor, $ref_bloc) = @_;
1203
  my $txt = '' ;
1204
  my @list = (split(',', $link)) ;
1205
  for my $l (@list) {
1206
  dbg("... référence fichier: \"$l\" titre \"$l\"");
1207
  my $page = $ref_bloc->{fichier}{$l} ;
1208
  warn  "label $link n'existe pas" if !($page) ;
1209
  $txt .= ($#list) ? " \\link{$page}{$l}{$anchor}":
1210
             " \\link{$page}{$titre}{$anchor}";
1211
 }
1212
 $txt ;
1213
};
1214
 
1215
 
1216
#crée la page
1217
 
743 bpr 1218
sub toc_HTML {my ($text, $toc_g, $toc_d, $CHEMIN_up, $CHEMIN_down, $index) = @_ ;
23 reyssat 1219
  if (($toc_g) || ($toc_d)) {
743 bpr 1220
    $CHEMIN_up . '<table class="doc_table"><tr>'
1221
   . (($toc_g) ? '<td valign=top><div class="left_toc"><p>' . $toc_g
23 reyssat 1222
   . $index . '</div></td>' : '')
1223
   . '<td valign=top align=left width=100%><div class="wimsdoc">'
1224
   . $text
743 bpr 1225
   . '</div>' .  $CHEMIN_down . ' </td>'
1226
   . (($toc_d) ? '<td valign=top align=right> <div class="right_toc"><p>'
23 reyssat 1227
   . $toc_d
1228
   . '</div><center>'
1229
   . $LOAD
1230
   . '</center></td>' : '')
743 bpr 1231
   . '</tr></table>'  }
1232
   else {$CHEMIN_up . $text . $CHEMIN_down };
23 reyssat 1233
 }
1234
 
1235
 #################################
1236
 
1237
sub store_algo { my ($txt, $acc, $cmd, $comment, $indent) = @_ ;
1238
  $txt .= " " . $acc ;
1239
  $txt .= $hash_algo{titre}{$hash_algo{suite}{$cmd}} if  ($hash_algo{suite}{$cmd}) ;
1240
  $indent = $indent + $hash_algo{avant}{$cmd} ;
1241
  $txt = "\n" . indent($indent) .  $hash_algo{titre}{$cmd} . $txt  if ( !($cmd =~ /END/) || $algo_noend == 0);
1242
  $txt .=  indent(3) . "{<i>$comment</i>}" if ($comment) ;
1243
  $txt .= "\n" ;
1244
  $txt =~ s/\n+/\n/ ;
1245
  $indent += $hash_algo{apres}{$cmd} ;
1246
  ($txt, $indent) ;
1247
}
1248
 
1249
sub algorithm { '<div class="algorithm">' . algorithmic (@_) . '</div>' } ;
1250
 
1251
sub algorithmic { my ($Text) = @_;
1252
  my $text ='' ; my $indent = 0 ;
1253
  my @T = split('\n', $Text);
1254
  for my $i (1..$#T) {
1255
    my $ligne = $T[$i];
1256
 #   $ligne =~ s/\$([^\$]+)\$/$1/g;
1257
  #  $ligne =~ s/\\\(//g;
1258
 #   $ligne =~ s/\\\)//g;
1259
    $ligne =~ s/\$([^\$]+)\$/\\( $1 \\)/g;
1260
    $ligne =~ s/^\[H\]//;
1261
    next if ($ligne =~ /\\begin\{algorithmic\}\[1\]/);
1262
    $ligne = "\n\n" if ($ligne =~ /\\end\{algorithmic\}/);
1263
    $ligne =~ s/\\caption\s*\{\s*([^\}]*)\}/<h4 class=\"algo_titre\"> $1 <\/h4>/;
1264
    $ligne =~ s/\\cdots/.../g;
1265
    $ligne =~ s/\\geq/>=/g;
1266
    $ligne =~ s/\\leq/<=/g;
1267
    $ligne =~ s/\\bmod/mod/g;
1268
#    $ligne =~ s/\[/<i>/g;
1269
#    $ligne =~ s/\]/<\/i>/g;
1270
    my $cle = 'FOR|WHILE|IF|UNTIL|ELSE|ELSIF|REQUIRE|ENSURE|STATE|ENDFOR|ENDWHILE|ENDIF' ;
1271
    if ($ligne =~ /\s*\\($cle)\s*(\[[^\]]+\]*)?\{([^\n]+)\}\s*([^\n]*)/) {
1272
         ($ligne,$indent) = store_algo($3, $4, $1, $2, $indent) ;
1273
    }    
1274
    if ($ligne =~ /\s*\\($cle)\s*(\[[^\]]+\]*)?\s*([^\n]*)/) {($ligne,$indent) = store_algo('',$3, $1, $2, $indent);}
1275
  #TODO accepter des commentaires de plusieurs lignes ; présentation
1276
    #des commentaires ?
1277
    if ($ligne =~ /^\s*\\COMMENT/) { $ligne = "<i>$ligne</i>\n" };
1278
    $text .= "\n" . $ligne;
1279
    $text =~ s/\n{2,}/\n/g ;
1280
    $text =~ s/\n+/<br>/g ;
1281
    $text =~ s/(<br>)+/<br>/g ;
1282
  }
1283
  $text ;
1284
}
1285
 
1286
sub indent { my $espace = "&nbsp;" x  6 ; $espace x $_[0]; }
1287
 
1288
sub Numero { my ($id) = @_;
1289
  return '' if ($id =~ /F_[^S]\d/)  || ($id =~ /L_/); #cela ne provient pas d'une section et co
1290
  $id =~ s /(F|L)_//g;
1291
  $id =~ s/mainS(\d+)/&Roman($1)/e;
1292
  $id =~ s/S(\d+)S(\d+)S(\d+)/-$1-$2-$3/;
1293
  $id =~ s/S(\d+)S(\d+)/-$1-$2/;
1294
  $id =~ s/S(\d+)/-$1/;
1295
  $id;
1296
}
1297
 
1298
# permet de faire modifier quelque chose dans la table pour un tag
1299
#TODO j'ai rajouté l'option couleur, du coup je ne sais plus faire fonctionner le shif
1300
sub selection { my ($text, $couleur, @tag) = @_ ;
1301
  return '' if !defined($text);
1302
  for my $ta (@tag) {
1303
    $text =~ s/XXXX=$ta>/div class="$couleur">/g;
1304
    $text =~ s/YYYY=$ta>/\/div>/g;
1305
  };
1306
  $text;
1307
}
1308
 
734 bpr 1309
sub clean { my ($text, $ref) = @_;
23 reyssat 1310
  return '' if !defined($text);
1311
   $text =~ s/<XXXX=\w*>//g;
1312
   $text =~ s/<YYYY=\w*>//g;
734 bpr 1313
   $text =~ s/ZZZZZ(\w+)/store_tip($1,$ref)/ge;
23 reyssat 1314
   $text;
1315
}
1316
 
734 bpr 1317
sub store_tip { my ($tag,$ref)=@_ ;
1318
  my $tip = $ref->{toctip}{$tag} ;
743 bpr 1319
  $tip =~ s/'/\\'/g if ($tip) ;
734 bpr 1320
  $ref->{toctip}{$tag} ?  "<span class=tip><a onmouseover=\"Tip('$tip')\">$tooltip_prompt<\/a><\/span>" : '' ;
1321
}
1322
 
23 reyssat 1323
sub chemin { my ($tag, $ref) = @_;
1324
  my $tagsup = $tag;
1325
  my $ch = $tag;
1326
  my $txt = ($ref->{tittoc}{$tagsup}) ? $ref->{tittoc}{$tagsup} : $ref->{titb}{$tagsup} ;
1327
  my $niv = 0;
1328
  while ($tagsup !~ /^main\b/) {
1329
    $niv++;
1330
    $tagsup = $ref->{upbl}{$tagsup};
1331
    $ch  = "$tagsup,$ch";
743 bpr 1332
    $txt = "\\link{$tagsup}{$ref->{tittoc}{$tagsup}} $FLECHE $txt" ; #if ($tagsup !~ /^main\b/);
23 reyssat 1333
  }
1334
  $ref->{chemin}{$tag} = $ch;
1335
  $ref->{niveau}{$tag} = $niv;
1336
  return $LOAD if (!$txt);
743 bpr 1337
  '<div class="wims_chemin">' . $LOAD . "$linkout  $txt" . '</div>';}
23 reyssat 1338
 
1339
sub sortuniq {
1340
  my $prev = "not $_[0]";
1341
  grep { $_ ne $prev && ($prev = $_, 1) } sort @_;
1342
}
1343
 
1344
 
1345
sub isotime {
178 bpr 1346
    my ($sec,$min,$hour,$mday,$mon,$year) = localtime(time);
23 reyssat 1347
    $year += 1900;
178 bpr 1348
    $mon += 1 ; $mday += 1 ;
23 reyssat 1349
    $mday = sprintf("%02d", $mday);
1350
    $mon  = sprintf("%02d", $mon);
1351
    "$year-$mon-$mday $hour:$min:$sec";
1352
}
1353
 
1354
 sub usage {
1355
  print STDERR << "EOT"
1356
latex2wims [--style=style.css] [--macro=wims.sty] [--dir=dossier1] [--docdir=dossier2] [--embed=dossier3] [--verbose] file
1357
 
1358
  --style=style.css : style.css fichier de style css à utiliser
1359
     (peut aussi être mis dans le fichier file : \\wimsinclude{style.css})
1360
  --macro=wims.sty : wims.sty fichier de style à utiliser
1361
     (peut aussi être mis dans le fichier file : \\wimsinclude{wims.sty})
1362
  --dir=dossier1 : dossier1 est le répertoire où se trouvent tous les fichiers dont le fichier file
1363
  --docdir=dossier2 : dossier2 est le répertoire dans lequel sera créé le document
1364
     (un dossier dans le compte Modtool par exemple)
1365
  --embed=dossier3 : les fichiers de dossier3 sont appelés dans file
1366
     par la commande \embed{} (pour expert)
1367
  --verbose : détails
1368
EOT
1369
;
1370
  exit 1;
1371
}
1372
 
1373
##======================================================================##
1374
## Adapted from work by OZAWA Sakuro <ozawa@prince.pe.u-tokyo.ac.jp>
1375
## Copyright (c) 1995 OZAWA Sakuro.  All rights reserved.  This
1376
## program is free software; you can redistribute it and/or modify
1377
## it under the same terms as Perl itself.
1378
##======================================================================##
1379
 
1380
sub Roman { my($arg) = shift;
1381
  my %roman_digit = qw(1 IV 10 XL 100 CD 1000 MMMMMM);
1382
  my @figure = reverse sort keys %roman_digit;
1383
  grep($roman_digit{$_} = [split(//, $roman_digit{$_}, 2)], @figure);
1384
 
1385
  my($x, $roman);
1386
  foreach (@figure) {
1387
    my($digit, $i, $v) = (int($arg / $_), @{$roman_digit{$_}});
1388
    if (1 <= $digit and $digit <= 3) {
1389
      $roman .= $i x $digit;
1390
    } elsif ($digit == 4) {
1391
      $roman .= "$i$v";
1392
    } elsif ($digit == 5) {
1393
      $roman .= $v;
1394
    } elsif (6 <= $digit and $digit <= 8) {
1395
      $roman .= $v . $i x ($digit - 5);
1396
    } elsif ($digit == 9) {
1397
      $roman .= "$i$x";
1398
    }
1399
    $arg -= $digit * $_;
1400
    $x = $i;
1401
  }
1402
  $roman
1403
 }