development/autotests/lyxStatus.pm

   1 #! /usr/bin/env perl
   2 # -*- mode: perl; -*-
   3
   4 package lyxStatus;
   5
   6 use strict;
   7
   8 our(@EXPORT, @ISA);
   9
  10 BEGIN {
  11   use Exporter   ();
  12   @ISA       = qw(Exporter);
  13   @EXPORT    = qw(initLyxStack checkLyxLine closeLyxStack diestack);
  14 }
  15
  16 # Prototypes
  17 sub initLyxStack($$$);
  18 sub diestack($);
  19 sub closeLyxStack();
  20 sub setMatching($);
  21 sub getMatching();
  22 sub checkForEndBlock($);
  23 sub newMatch(%);
  24 sub getSearch($);
  25 sub getFileType($);
  26 sub getFileIdx($);
  27 sub getExt($);
  28 sub getResult($);
  29 sub checkForHeader($);
  30 sub checkForPreamble($);
  31 sub checkForLayoutStart($);
  32 sub checkForInsetStart($);
  33 sub checkForLatexCommand($);
  34 sub checkLyxLine($);
  35
  36 my @stack = ();                 # list of HASH-Arrays
  37 my $rFont = {};
  38 my $useNonTexFont = "true";
  39 my $inputEncoding = undef;
  40
  41 # The elements are:
  42 # type (layout, inset, header, preamble, ...)
  43 # name
  44 # matching list of matching spes
  45 #      search: regular expression
  46 #      ext: list of extensions needed for the full path of the file spec
  47 #      filetype: one of prefix_only,replace_only,copy_only,prefix_for_list,interpret
  48 #      fileidx: index into the resulting array, defining the filename
  49 #      result: conatenation of the elements should reflect the parsed line
  50 #              but first set the modified value into $result->[$fileidx]
  51 #              numerical value will be replaced with appropriate matching group value
  52
  53 sub initLyxStack($$$)
  54 {
  55   $rFont = $_[0];
  56   if ($_[1] eq "systemF") {
  57     $useNonTexFont = "true";
  58   }
  59   else {
  60     $useNonTexFont = "false";
  61     $inputEncoding = $_[2];
  62   }
  63   $stack[0] = { type => "Starting"};
  64 }
  65
  66 sub diestack($)
  67 {
  68   my ($msg) = @_;
  69   # Print stack
  70   print "Called stack\n";
  71   my @call_stack = ();
  72   for my $depth ( 0 .. 100) {
  73     #my ($pkg, $file, $line, $subname, $hasargs, $wantarray) = caller($depth)
  74     my @stack = caller($depth);
  75     last if ($stack[0] ne "main");
  76     push(@call_stack, \@stack);
  77   }
  78   for my $depth ( 0 .. 100) {
  79     last if (! defined($call_stack[$depth]));
  80     my $subname = $call_stack[$depth]->[3];
  81     my $line = $call_stack[$depth]->[2];
  82     print "($depth) $subname()";
  83     if ($depth > 0) {
  84       my $oldline = $call_stack[$depth-1]->[2];
  85       print ":$oldline";
  86     }
  87     print " called from ";
  88     if (defined($call_stack[$depth+1])) {
  89       my $parent = $call_stack[$depth+1]->[3];
  90       print "$parent():$line\n";
  91     }
  92     else {
  93       my $file = $call_stack[$depth]->[1];
  94       print "\"$file\":$line\n";
  95     }
  96   }
  97   die($msg);
  98 }
  99
 100 sub closeLyxStack()
 101 {
 102   diestack("Stack not OK") if ($stack[0]->{type} ne "Starting");
 103 }
 104
 105 sub setMatching($)
 106 {
 107   my ($match) = @_;
 108
 109   $stack[0]->{"matching"} = $match;
 110 }
 111
 112 sub getMatching()
 113 {
 114   return($stack[0]->{"matching"});
 115 }
 116
 117 ###########################################################
 118 #
 119 sub checkForEndBlock($)
 120 {
 121   my ($l) = @_;
 122
 123   for my $et ( qw( layout inset preamble header)) {
 124     if ($l =~ /^\\end_$et$/) {
 125       diestack("Not in $et") if ($stack[0]->{type} ne "$et");
 126       #print "End $et\n";
 127       shift(@stack);
 128       return(1);
 129     }
 130   }
 131   return(0);
 132 }
 133
 134 sub newMatch(%)
 135 {
 136   my %elem = @_;
 137
 138   if (! defined($elem{"ext"})) {
 139     $elem{"ext"} = "";
 140   }
 141   if (! defined($elem{"filetype"})) {
 142     $elem{"filetype"} = "prefix_only";
 143   }
 144   if (! defined($elem{"fileidx"})) {
 145     $elem{"fileidx"} = 1;
 146   }
 147   diestack("No result defined") if (! defined($elem{"result"}));
 148   return(\%elem);
 149 }
 150
 151 sub getSearch($)
 152 {
 153   my ($m) = @_;
 154
 155   return($m->{"search"});
 156 }
 157
 158 sub getFileType($)
 159 {
 160   my ($m) = @_;
 161
 162   return($m->{"filetype"});
 163 }
 164
 165 sub getFileIdx($)
 166 {
 167   my ($m) = @_;
 168
 169   return($m->{"fileidx"});
 170 }
 171
 172 sub getExt($)
 173 {
 174   my ($m) = @_;
 175
 176   return($m->{"ext"});
 177 }
 178
 179 sub getResult($)
 180 {
 181   my ($m) = @_;
 182
 183   return($m->{"result"});
 184 }
 185
 186 sub checkForHeader($)
 187 {
 188   my ($l) = @_;
 189
 190   if ($l =~ /^\\begin_header\s*$/) {
 191     my %selem = ();
 192     $selem{type} = "header";
 193     $selem{name} = $1;
 194     unshift(@stack, \%selem);
 195     my @rElems = ();
 196     $rElems[0] = newMatch("search" => '^\\\\master\s+(.*\.lyx)',
 197                            "filetype" => "prefix_only",
 198                            "result" => ["\\master ", ""]);
 199     if (keys %{$rFont}) {
 200       for my $ff ( keys %{$rFont}) {
 201         # fontentry of type '\font_roman default'
 202         my $elem = newMatch("search" => '^\\\\font_' . $ff . '\s+[^"]*\s*$',
 203                              "filetype" => "replace_only",
 204                              "result" => ["\\font_$ff ", $rFont->{$ff}]);
 205         # fontentry of type '\font_roman "default"'
 206         my $elem1 = newMatch("search" => '^\\\\font_' . $ff . '\s+"[^"]*"\s*$',
 207                              "filetype" => "replace_only",
 208                              "result" => ["\\font_$ff \"", $rFont->{$ff}, '"']);
 209         # fontentry of type '\font_roman "default" "default"'
 210         my $elem2 = newMatch("search" => '^\\\\font_' . $ff . '\s+"(.*)"\s+"default"\s*$',
 211                              "filetype" => "replace_only",
 212                              "result" => ["\\font_$ff ", '"', "1", '" "', $rFont->{$ff}, '"']);
 213         push(@rElems, $elem, $elem1, $elem2);
 214       }
 215     }
 216     my $elemntf = newMatch("search" => '^\\\\use_non_tex_fonts\s+(false|true)',
 217                             "filetype" => "replace_only",
 218                             "result" => ["\\use_non_tex_fonts $useNonTexFont"]);
 219     push(@rElems, $elemntf);
 220     if (defined($inputEncoding)) {
 221       my $inputenc = newMatch("search" =>  '^\\\\inputencoding\s+(' . $inputEncoding->{search} . ')',
 222                               "filetype" => "replace_only",
 223                               "result" => ["\\inputencoding " . $inputEncoding->{out}]);
 224       push(@rElems, $inputenc);
 225     }
 226     setMatching(\@rElems);
 227     return(1);
 228   }
 229   return(0);
 230 }
 231
 232 sub checkForPreamble($)
 233 {
 234   my ($l) = @_;
 235
 236   if ($l =~ /^\\begin_preamble\s*$/) {
 237     my %selem = ();
 238     $selem{type} = "preamble";
 239     $selem{name} = $1;
 240     unshift(@stack, \%selem);
 241     my $rElem = newMatch("ext" => [".eps", ".png"],
 242                           "search" => '^\\\\(photo|ecvpicture)(.*\{)(.*)\}',
 243                           "fileidx" => 3,
 244                           "result" => ["\\", "1", "2", "3", "}"]);
 245     #
 246     # Remove comments from preamble
 247     my $comments = newMatch("search" => '^([^%]*)([%]+)([^%]*)$',
 248                             "filetype" => "replace_only",
 249                             "result" => ["1", "2"]);
 250     setMatching([$rElem, $comments]);
 251     return(1);
 252   }
 253   return(0);
 254 }
 255
 256 sub checkForLayoutStart($)
 257 {
 258   my ($l) = @_;
 259
 260   if ($l =~ /^\\begin_layout\s+(.*)$/) {
 261     #print "started layout\n";
 262     my %selem = ();
 263     $selem{type} = "layout";
 264     $selem{name} = $1;
 265     unshift(@stack, \%selem);
 266     if ($selem{name} =~ /^(Picture|Photo)$/ ) {
 267       my $rElem = newMatch("ext" => [".eps", ".png"],
 268                             "search" => '^(.+)',
 269                             "result" => ["", "", ""]);
 270       setMatching([$rElem]);
 271     }
 272     return(1);
 273   }
 274   return(0);
 275 }
 276
 277 sub checkForInsetStart($)
 278 {
 279   my ($l) = @_;
 280
 281   if ($l =~ /^\\begin_inset\s+(.*)$/) {
 282     #print "started inset\n";
 283     my %selem = ();
 284     $selem{type} = "inset";
 285     $selem{name} = $1;
 286     unshift(@stack, \%selem);
 287     if ($selem{name} =~ /^(Graphics|External)$/) {
 288       my $rElem = newMatch("search" => '^\s+filename\s+(.+)$',
 289                             "filetype" => "copy_only",
 290                             "result" => ["\tfilename ", "", ""]);
 291       setMatching([$rElem]);
 292     }
 293     return(1);
 294   }
 295   return(0);
 296 }
 297
 298 sub checkForLatexCommand($)
 299 {
 300   my ($l) = @_;
 301
 302   if ($stack[0]->{type} eq "inset") {
 303     if ($l =~ /^LatexCommand\s+([^\s]+)\s*$/) {
 304       my $param = $1;
 305       if ($stack[0]->{name} =~ /^CommandInset\s+bibtex$/) {
 306         if ($param eq "bibtex") {
 307           my $rElem1 = newMatch("ext" => ".bib",
 308                                  "filetype" => "prefix_for_list",
 309                                  "search" => '^bibfiles\s+\"(.+)\"',
 310                                  "result" => ["bibfiles \"", "1", "\""]);
 311           my $rElem2 = newMatch("ext" => ".bst",
 312                                  "filetype" => "prefix_for_list",
 313                                  "search" => '^options\s+\"(.+)\"',
 314                                  "result" => ["options \"", "1", "\""]);
 315           setMatching([$rElem1, $rElem2]);
 316         }
 317       }
 318       elsif ($stack[0]->{name} =~ /^CommandInset\s+include$/) {
 319         if ($param =~ /^(verbatiminput\*?|lstinputlisting)$/) {
 320           my $rElem = newMatch("search" => '^filename\s+\"(.+)\"',
 321                                 "filetype" => "copy_only",
 322                                 "result" => ["filename \"", "", "\""]);
 323           setMatching([$rElem]);
 324         }
 325         elsif ($param =~ /^(include|input)$/) {
 326           my $rElem = newMatch("search" => '^filename\s+\"(.+)\"',
 327                                 "filetype" => "interpret",
 328                                 "result" => ["filename \"", "", "\""]);
 329           setMatching([$rElem]);
 330         }
 331       }
 332     }
 333   }
 334   return(0);
 335 }
 336
 337 #
 338 # parse the given line
 339 # returns a hash with folloving values
 340 #    found:  1 if line matched some regex
 341 #    fileidx: index into result
 342 #    ext: list of possible extensions to use for a valid file
 343 #    filelist: list of found file-pathes (may be more then one, e.g. in bibfiles spec)
 344 #    separator: to be used while concatenating the filenames
 345 #    filetype: prefix_only,replace_only,copy_only,interpret
 346 #              same as before, but without 'prefix_for_list'
 347 sub checkLyxLine($)
 348 {
 349   my ($l) = @_;
 350
 351   return({"found" => 0}) if (checkForHeader($l));
 352   return({"found" => 0}) if (checkForPreamble($l));
 353   return({"found" => 0}) if (checkForEndBlock($l));
 354   return({"found" => 0}) if (checkForLayoutStart($l));
 355   return({"found" => 0}) if (checkForInsetStart($l));
 356   return({"found" => 0}) if (checkForLatexCommand($l));
 357   if (defined($stack[0])) {
 358     my $rMatch = getMatching();
 359     for my $m ( @{$rMatch}) {
 360       my $search = getSearch($m);
 361       if ($l =~ /$search/) {
 362         my @matches = ($1, $2, $3, $4);
 363         my $filetype = getFileType($m);
 364         my @result2 = @{getResult($m)};
 365
 366         for my $r (@result2) {
 367           if ($r =~ /^\d$/) {
 368             $r = $matches[$r-1];
 369           }
 370         }
 371         if ($filetype eq "replace_only") {
 372           # No filename needed
 373           my %result = ("found" => 1,
 374                         "filetype" => $filetype,
 375                         "result" => \@result2);
 376           return(\%result);
 377         }
 378         else {
 379           my $fileidx = getFileIdx($m);
 380           my $filename = $matches[$fileidx-1];
 381           if ($filename !~ /^\.*$/) {
 382             my %result = ("found" => 1,
 383                           "fileidx" => $fileidx,
 384                           "ext" => getExt($m),
 385                           "result" => \@result2);
 386             if ($filetype eq "prefix_for_list") {
 387               # bibfiles|options in CommandInset bibtex
 388               my @filenames = split(',', $filename);
 389               $result{"separator"} = ",";
 390               $result{"filelist"} = \@filenames;
 391               $result{"filetype"} = "prefix_only";
 392             }
 393             else {
 394               $result{"separator"} = "";
 395               $result{"filelist"} = [$filename];
 396               $result{"filetype"} = $filetype;
 397             }
 398             return(\%result);
 399           }
 400         }
 401       }
 402     }
 403   }
 404   return({"found" => 0});
 405 }
 406
 407 1;