doc/info/update_examples

   1 #!/usr/bin/env perl
   2
   3 use File::Temp qw/ :POSIX /;
   4
   5 use Text::Tabs;
   6
   7 use warnings;
   8 use strict;
   9
  10 my $topdir = substr(`pwd`, 0, -1);
  11
  12 if (index($topdir, "/maxima/doc/info") != -1) {
  13     $topdir =~ s/\/maxima\/doc\/info//;
  14 }
  15 else {
  16     $topdir = '';
  17 }
  18
  19 my $strip_topdir = $ENV{"STRIP_TOPDIR"} || $topdir;
  20
  21 # Set maxima command to MAXIMA_EXAMPLE_COMMAND if set.  Otherwise use
  22 # maxima-local.  We use --no-init to make sure no init files are
  23 # loaded that could change the output.  But we need ./maxima-init.lisp
  24 # to set up things to work properly for the update. (Hence the -p.)
  25 my $maxima_command = $ENV{"MAXIMA_EXAMPLE_COMMAND"} || "../../maxima-local --no-init -p maxima-init.lisp";
  26
  27 my $line_cnt    = 0;
  28 my $error_cnt   = 0;
  29 my $warning_cnt = 0;
  30
  31 my $example_input_beg = '^@c ===beg===';
  32 my $example_input_end = '^@c ===end===';
  33
  34 #my $example_output_beg = '^@example[ \t]*\n';
  35 my $example_output_end = '^@end[ \t]+example[ \t]*\n';
  36
  37 my $in_example_input  = 0;
  38 my $in_example_output = 0;
  39
  40 my @example_input_buf  = ();
  41 my @example_output_buf = ();
  42 my @example_result_buf = ();
  43
  44 sub rem_codes {
  45     my $res;
  46
  47     $res = $_[0];
  48
  49     $res =~ s/\cB//g;
  50     $res =~ s/\cE//g;
  51
  52     $res =~ s/$strip_topdir//g;
  53
  54     # Escape "@" to "@@", as an unescaped at-sign might be interpreted as the
  55     # beginning of a command.
  56     $res =~s/\@/\@\@/g;
  57
  58     $res =~ s/\{/\@\{/g;
  59     $res =~ s/\}/\@\}/g;
  60
  61     $res = expand($res);
  62
  63     return $res;
  64 }
  65
  66 sub r_trim {
  67     my $res;
  68     $res = $_[0];
  69     $res =~ s/\s+$/\n/;
  70     return $res;
  71 }
  72
  73 while (<>) {
  74     $line_cnt++;
  75
  76     if ($in_example_input) {
  77         if ($_ =~ $example_input_end) {
  78             print $_;
  79             $in_example_input  = 0;
  80             $in_example_output = 1;
  81         }
  82         elsif ($_ =~ /\@c */) {
  83             my $fixed;
  84             if (/^\@c input:/) {
  85                 $fixed = substr($_, 9);
  86             }
  87             else {
  88                 $fixed = substr($_, 3);
  89             }
  90             print $_;
  91             push @example_input_buf, r_trim($fixed);
  92         }
  93         else {
  94             $warning_cnt++;
  95             print STDERR "Warning: line $line_cnt - example input lines must begin with \'\@c \'.\n";
  96             print $_;
  97         }
  98     }
  99     elsif ($in_example_output) {
 100         if (/$example_output_end/) {
 101             my $tempf = tmpnam();
 102
 103             my $com = "$maxima_command > $tempf << \\EOF\n";
 104             foreach my $l (@example_input_buf) {
 105                 $com .= $l;
 106             }
 107             $com .= "EOF";
 108
 109             if (system($com)) {
 110                 $error_cnt++;
 111                 print STDERR
 112                   "Error: line $line_cnt - maxima invocation failed.\n";
 113                 print @example_output_buf;
 114                 print "\@end example\n";
 115             }
 116             else {
 117                 if (open(RESULT, $tempf)) {
 118                     @example_result_buf = <RESULT>;
 119
 120                     close RESULT;
 121
 122                     if (!unlink($tempf)) {
 123                         $error_cnt++;
 124                         print STDERR "Error: line $line_cnt - can't delete temp file $tempf\n";
 125                     }
 126
 127                     print "\@example\n";
 128
 129                     until ($#example_result_buf == -1 or $example_result_buf[0] =~ /^\cB/) {
 130                         shift @example_result_buf;
 131                     }
 132
 133                     until ($#example_result_buf == -1 or $#example_input_buf == -1) {
 134                         my @group;
 135
 136                         until ($#example_result_buf == -1 or $example_result_buf[0] =~ /\cE/) {
 137                             push @group, rem_codes($example_result_buf[0]);
 138                             shift @example_result_buf;
 139                         }
 140
 141                         if ($#example_input_buf != -1) {
 142                             push @group, rem_codes(substr(substr($example_result_buf[0], 0, index($example_result_buf[0], "\cE") + 1), 0, -1)) . rem_codes(substr($example_input_buf[0], 0, -1)) . "\n";
 143                             shift @example_input_buf;
 144                             if ($example_result_buf[0] =~ /\cE/ and not $example_result_buf[0] =~ /\cE$/) {
 145                                 $example_result_buf[0] = substr($example_result_buf[0], index($example_result_buf[0], "\cE"));
 146                             }
 147                             else {
 148                                 shift @example_result_buf;
 149                             }
 150                         }
 151
 152                         until ($#example_input_buf == -1 or $example_input_buf[0] =~ /^[\S]/) {
 153                             push @group, rem_codes(substr($example_input_buf[0], 0, -1)) . "\n";
 154                             shift @example_input_buf;
 155                         }
 156                         until ($#example_result_buf == -1 or $example_result_buf[0] =~ /^\cB/) {
 157                             push @group, rem_codes($example_result_buf[0]);
 158                             shift @example_result_buf;
 159                         }
 160
 161                         print "\@group\n" if scalar @group >= 2;
 162                         print @group;
 163                         print "\@end group\n" if scalar @group >= 2;
 164                     }
 165
 166                     print "\@end example\n";
 167                 }
 168                 else {
 169                     $error_cnt++;
 170                     print STDERR "Error: line $line_cnt - can't open temp file $tempf\n";
 171                     print @example_output_buf;
 172                     print "\@end example\n";
 173                 }
 174             }
 175
 176             close RESULT;
 177
 178             @example_result_buf = ();
 179             @example_input_buf  = ();
 180             @example_output_buf = ();
 181             $in_example_output  = 0;
 182         }
 183         else {
 184             push @example_output_buf, $_;
 185         }
 186     }
 187     elsif (/$example_input_beg/) {
 188         print $_;
 189         $in_example_input = 1;
 190     }
 191     else {
 192         print $_;
 193     }
 194 }
 195
 196 if ($in_example_input) {
 197     $error_cnt++;
 198     print STDERR "Error: line $line_cnt - EOF while end of example input is expected.\n";
 199 }
 200 elsif ($in_example_output) {
 201     $error_cnt++;
 202     print STDERR "Error: line $line_cnt - EOF while end of example is expected.\n";
 203     print @example_output_buf;
 204 }
 205
 206 exit $error_cnt;