API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Dec 14th, 2011
68
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 13.17 KB | None | 0 0
raw download clone embed print report
  1. #!/usr/bin/perl
  2. # vim:set fdm=marker:
  3.  
  4. use strict;
  5. use warnings;
  6.  
  7. use feature 'say';
  8. use feature 'switch';
  9.  
  10. {
  11.     package TexToken;
  12.     use strict;
  13.     use warnings;
  14.     # sub new(file,line,col,type,content) {{{
  15.     sub new {
  16.         my($class,$file,$line,$col,$type,$str) = @_;
  17.         my $self = {
  18.             file => $file,
  19.             line => $line,
  20.             column => $col,
  21.             type => $type,
  22.             content => $str
  23.         };
  24.         bless $self, $class;
  25.         return $self;
  26.     }
  27.     # }}}
  28.     # sub first() {{{
  29.     sub first {
  30.         my $self = shift;
  31.         return lc(substr($self->{content},0,1));
  32.     }
  33.     # }}}
  34. }
  35.  
  36. {
  37.     package TexStream;
  38.     use FileHandle;
  39.     use strict;
  40.     use warnings;
  41.     my @disabledWarnings = ();
  42.     my @enabledErrors = ();
  43.     my @enabledWarnings = ();
  44.     my @enabledMessages = ();
  45.     my $logType = 3;
  46.     my @files = ();
  47.     sub nextFile {
  48.         pop @files;
  49.     }
  50.     # sub parseOpts {{{
  51.     sub parseOpts() {
  52.         my $last = undef;
  53.         foreach my $arg(@ARGV) {
  54.             given($arg) {
  55.                 when(/^-n/) {
  56.                     @disabledWarnings = (@disabledWarnings, substr($_,2));
  57.                 }
  58.                 when(/^-e/) {
  59.                     @enabledErrors = (@enabledErrors, substr($_,2));
  60.                 }
  61.                 when(/^-w/) {
  62.                     @enabledWarnings = (@enabledWarnings, substr($_,2));
  63.                 }
  64.                 when(/^-w/) {
  65.                     @enabledMessages = (@enabledMessages, substr($_,2));
  66.                 }
  67.                 when(/^-v/) {
  68.                     $logType = substr($_,2);
  69.                 }
  70.             }
  71.             given($last) {
  72.                 when("-x") {
  73.                     push @files, $arg;
  74.                 }
  75.                 when("-o") {
  76.                     open LOGFILE, "> $arg";
  77.                     select LOGFILE;
  78.                 }
  79.             }
  80.             $last = $arg;
  81.         }
  82.     }
  83.     # }}}
  84.     # @SilenceSpace {{{
  85.     my @SilenceSpace = qw(
  86.         \rm \em \bf \it \sl \sf \sc \tt \selectfont
  87.         \rmfamily \sffamily \ttfamily \mdseries \bfseries
  88.         \slshape \scshape \relax
  89.         \vskip \pagebreak \nopagebreak
  90.  
  91.         \textrm \textem \textbf \textit \textsl \textsf \textsc \texttt
  92.  
  93.         \clearpage \ddots \dotfill \flushbottom \fussy \indent \linebreak
  94.         \onecolumn \pagebreak \pushtabs \poptabs \scriptsize \sloppy
  95.         \twocolumn \vdots
  96.         \today \kill \newline \thicklines \thinlines
  97.  
  98.         \columnsep \space \item \tiny \footnotesize \small \normalsize
  99.         \normal \large \Large \LARGE \huge \Huge \printindex
  100.  
  101.         \newpage \listoffigures \listoftables \tableofcontents
  102.         \maketitle \makeindex
  103.  
  104.         \hline \hrule \vrule
  105.  
  106.         \centering
  107.  
  108.         \bigskip \medskip \smallskip
  109.  
  110.         \noindent \expandafter
  111.  
  112.         \makeatletter \makeatother
  113.  
  114.         \columnseprule
  115.  
  116.         \textwidth \textheight \hsize \vsize
  117.  
  118.         \if \fi
  119.  
  120.         \csname \endcsname
  121.  
  122.         \z@ \p@ \@warning \typeout
  123.  
  124.         \dots \ldots \input \endinput \nextline \leavevmode \cdots
  125.         \vfill \vfil \hfill \hfil \topmargin \oddsidemargin
  126.         \frenchspacing \nonfrenchspacing
  127.         \begingroup \endgroup \par
  128.  
  129.         \vrefwarning \upshape \headheight \headsep \hoffset \voffset
  130.         \cdot \qquad
  131.         \left \right
  132.         \rm \em \bf \it \sl \sf \sc \tt \selectfont
  133.         \rmfamily \sffamily \ttfamily \mdseries \bfseries
  134.         \slshape \scshape \relax
  135.         \vskip \pagebreak \nopagebreak
  136.  
  137.         \textrm \textem \textbf \textit \textsl \textsf \textsc \texttt
  138.  
  139.         \clearpage \ddots \dotfill \flushbottom \fussy \indent \linebreak
  140.         \onecolumn \pagebreak \pushtabs \poptabs \scriptsize \sloppy
  141.         \twocolumn \vdots
  142.         \today \kill \newline \thicklines \thinlines
  143.  
  144.         \columnsep \space \item \tiny \footnotesize \small \normalsize
  145.         \normal \large \Large \LARGE \huge \Huge \printindex
  146.  
  147.         \newpage \listoffigures \listoftables \tableofcontents
  148.         \maketitle \makeindex
  149.  
  150.         \hline \hrule \vrule
  151.  
  152.         \centering
  153.  
  154.         \bigskip \medskip \smallskip
  155.  
  156.         \noindent \expandafter
  157.  
  158.         \makeatletter \makeatother
  159.  
  160.         \columnseprule
  161.  
  162.         \textwidth \textheight \hsize \vsize
  163.  
  164.         \if \fi
  165.  
  166.         \csname \endcsname
  167.  
  168.         \z@ \p@ \@warning \typeout
  169.  
  170.         \dots \ldots \input \endinput \nextline \leavevmode \cdots
  171.         \vfill \vfil \hfill \hfil \topmargin \oddsidemargin
  172.         \frenchspacing \nonfrenchspacing
  173.         \begingroup \endgroup \par
  174.  
  175.         \vrefwarning \upshape \headheight \headsep \hoffset \voffset
  176.         \cdot \qquad
  177.         \left \right
  178.     );
  179.     # }}}
  180.     # @ProtectSpace {{{
  181.     my @ProtectSpace;
  182.     foreach( qw( 1st. 2nd. 3rd. 4th.  Mr. Mrs. Miss. Ms. Dr. Prof. St. ) ) {
  183.         push @ProtectSpace, lc $_;
  184.     }
  185.     # }}}
  186.     # sub new(filename) {{{
  187.     sub new {
  188.         my($class,$filename) = @_;
  189.         my $self = {
  190.             isAtLetter => 1,
  191.             isMathMode => 0,
  192.             filename => $filename,
  193.             filehandle => FileHandle->new(),
  194.             tokens => [],
  195.             tokenIdx => 0,
  196.             currentLine => "",
  197.             processingLine => "",
  198.             envStack => []
  199.         };
  200.         $self->{filehandle}->open("< " . $filename) or die("Cannot open $filename: $!");
  201.         bless $self, $class;
  202.         return $self;
  203.     }
  204.     # }}}
  205.     # sub getLtxCommand(type) {{{
  206.     sub getLtxCommand {
  207.         my($self,$type) = @_;
  208.         my $letter = $self->{isAtLetter} ? "|@" : "";
  209.         $self->{processingLine} =~ /^(\\([[:alpha:]]$letter)+)/;
  210.         my $str = $1 // substr($self->{processingLine},0,1);
  211.         return $self->extractChars($type, length $str);
  212.     }
  213.     # }}}
  214.     # sub getLtxToken(type) {{{
  215.     sub getLtxToken {
  216.         my($self,$type) = @_;
  217.         my $tok = $self->getLtxCommand($type);
  218.         given($tok->{content}) {
  219.             $self->{isAtLetter} = 1 when("\\makeatletter");
  220.             $self->{isAtLetter} = 0 when("\\makeatother");
  221.             $self->{isMathMode} = 1 when("\\[");
  222.             $self->{isMathMode} = 0 when("\\]");
  223.             $self->{isMathMode} = !$self->{isMathMode} when('$');
  224.         }
  225.         say $tok->{content};
  226.         return $tok;
  227.     }
  228.     # }}}
  229.     # sub extractChars(type,len) {{{
  230.     sub extractChars {
  231.         my($self,$type,$len) = @_;
  232.         my $str = substr($self->{processingLine}, 0, $len);
  233.         my $res = TexToken->new($self, $., length($self->{currentLine})-length($self->{processingLine}), $type, $str);
  234.         $self->{processingLine} = substr($self->{processingLine}, length $str);
  235.         return $res;
  236.     }
  237.     # }}}
  238.     # sub parseLine() {{{
  239.     sub parseLine {
  240.         my $self = shift;
  241.         TOKEN: while(length $self->{processingLine}) {
  242.             study $self->{processingLine};
  243.             my $c = substr($self->{processingLine},0,1);
  244.             given($c) {
  245.                 when("%") {
  246.                     # skip comments
  247.                     $self->{processingLine} = "";
  248.                     last TOKEN;
  249.                 }
  250.                 when('\\') {
  251.                     # backslash, open bracket, open brace, closing bracket, closing brace
  252.                     my $t = $self->getLtxToken($c);
  253.                     #say $t->{content}, $t->{type} if ($t->{type} eq "\\" or $t->{content} =~ /begin/);
  254.                     push $self->{tokens}, $t;
  255.                 }
  256.                 when($_ ~~ ["[","]","{","}"]) {
  257.                     push $self->{tokens}, $self->extractChars($_, 1);
  258.                 }
  259.                 when(/[[:alpha:]]/) {
  260.                     # word (character a-z)
  261.                     $self->{processingLine} =~ /^([[:alpha:]]+)/;
  262.                     push $self->{tokens}, $self->extractChars('w', length $1);
  263.                 }
  264.                 when(/[[:digit:]]/) {
  265.                     # number
  266.                     $self->{processingLine} =~ /^([[:digit:]]+)/;
  267.                     push $self->{tokens}, $self->extractChars('d', length $1);
  268.                 }
  269.                 when(".") {
  270.                     # dot(s)
  271.                     $self->{processingLine} =~ /^(\.+)/;
  272.                     push $self->{tokens}, $self->extractChars('.', length $1);
  273.                 }
  274.                 when(/\h/) {
  275.                     # whitespace(s)
  276.                     $self->{processingLine} =~ /^(\h+)/;
  277.                     push $self->{tokens}, $self->extractChars('s', length $1);
  278.                 }
  279.                 when(/\v/) {
  280.                     # newline(s)
  281.                     $self->{processingLine} =~ /^(\v+)/;
  282.                     push $self->{tokens}, $self->extractChars('n', length $1);
  283.                 }
  284.                 when("-") {
  285.                     # dash(es)
  286.                     $self->{processingLine} =~ /^(\-+)/;
  287.                     push $self->{tokens}, $self->extractChars('-', length $1);
  288.                 }
  289.                 when("`") {
  290.                     # quote begin
  291.                     $self->{processingLine} =~ /^(`+)/;
  292.                     push $self->{tokens}, $self->extractChars('qb', length $1);
  293.                 }
  294.                 when("'") {
  295.                     # quote end
  296.                     $self->{processingLine} =~ /^('+)/;
  297.                     push $self->{tokens}, $self->extractChars('qe', length $1);
  298.                 }
  299.                 default {
  300.                     # all others
  301.                     push $self->{tokens}, $self->extractChars('?', length $c);
  302.                 }
  303.             }
  304.         }
  305.     }
  306.     # }}}
  307.     # sub relTokenAt(idx) {{{
  308.     sub relTokenAt {
  309.         my($self,$idx) = @_;
  310.         $idx += $self->{tokenIdx};
  311.         return undef if 0>$idx || $idx>=$self->{tokens};
  312.         return $self->{tokens}[$idx];
  313.     }
  314.     # }}}
  315.     # sub nextToken() {{{
  316.     sub nextToken {
  317.         my $self = shift;
  318.         ++$self->{tokenIdx};
  319.         return $self->relTokenAt(-1);
  320.     }
  321.     # }}}
  322.     # sub getTokensUntil(str) {{{
  323.     sub getTokensUntil {
  324.         my($self,$str) = @_;
  325.         my $res = "";
  326.         while(my $tok = $self->nextToken()) {
  327.             last if($tok->{content} eq $str);
  328.             $res .= $tok->{content};
  329.         }
  330.         return $res;
  331.     }
  332.     # }}}
  333.     # sub hint(num,msg) {{{
  334.     sub hint {
  335.         my($self,$num,$msg) = @_;
  336.         if($num ~~ @disabledWarnings) {
  337.             return;
  338.         }
  339.         my $col = length($self->{currentLine}) - length($self->{processingLine}) + 1;
  340.         given($logType) {
  341.             when(0) {
  342.                 say "$self->{filename}:$.:$col:$num:$msg";
  343.             }
  344.             when(3) {
  345.                 say "Warning $num in $self->{filename} line $. $msg";
  346.                 say $self->{currentLine};
  347.                 say " " x ($col - 1) . "^";
  348.             }
  349.         }
  350.     }
  351.     # }}}
  352.     # sub process() {{{
  353.     sub process {
  354.         my $self = shift;
  355.         $self->{tokenIdx} = 0;
  356.         while($self->{currentLine} = $self->{filehandle}->getline()) {
  357.             $self->{processingLine} = $self->{currentLine};
  358.             $self->parseLine();
  359.             $self->{processingLine} = $self->{currentLine};
  360.             my $punctWord = undef;
  361.             while(my $tok = $self->nextToken()) {
  362.                 $self->{processingLine} = substr($self->{processingLine}, length($tok->{content}));
  363.                 study $tok->{content};
  364.                 #say $tok->{content}, " ", $tok->{type} if $tok->{content} =~ /begin/;
  365.                 given($tok->{type}) {
  366.                     when('w') {
  367.                         $punctWord = $tok->{content};
  368.                         # number followed by x
  369.                         if('x' eq lc($tok->{content}) && $self->relTokenAt(-1)->{type} eq 'd') {
  370.                             $self->hint(1, "Consider replacing 'x' after a number with '\\times'");
  371.                         }
  372.                     }
  373.                     when('d') {
  374.                         $punctWord = $tok->{content};
  375.                     }
  376.                     when('\\') {
  377.                         #say $tok->{content} if $tok->{content} ne "\\ldots";
  378.                         given($tok->{content}) {
  379.                             when([ '\\include', '\\input' ]) {
  380.                                 say "SKIP: ", $self->getTokensUntil("{");
  381.                                 my $fn = $self->getTokensUntil("}");
  382.                                 $fn =~ s/\{(.+)\}/$1/;
  383.                                 $fn =~ s/\\string"(.*)\\string"/$1/;
  384.                                 if(not -f $fn) {
  385.                                     $self->hint(7, "Include file does not exist: $fn");
  386.                                 }
  387.                                 else {
  388.                                     my $stream = TexStream->new($fn);
  389.                                     $stream->process();
  390.                                 }
  391.                             }
  392.                             when( '\\begin' ) {
  393.                                 say "SKIP: ", $self->getTokensUntil("{");
  394.                                 my $e = $self->getTokensUntil("}");
  395.                                 say "ENV: $e";
  396.                                 push $self->{envStack}, $e;
  397.                             }
  398.                             when( '\\end' ) {
  399.                                 say "SKIP: ", $self->getTokensUntil("{");
  400.                                 my $top = pop $self->{envStack};
  401.                                 my $cur = $self->getTokensUntil("}");
  402.                                 $self->hint(6, "Mismatching environment - Expected $top, found $cur!") if $cur ne $top;
  403.                             }
  404.                             $self->hint(9, "Consider replacing '$_' with '``'") when ('\\textquotedblleft');
  405.                             $self->hint(10, "Consider replacing '$_' with '`'") when ('\\textquoteleft');
  406.                             $self->hint(11, "Consider replacing '$_' with `''`") when ('\\textquotedblright');
  407.                             $self->hint(12, "Consider replacing '$_' with `'`") when ('\\textquoteright');
  408.                             $self->hint(13, "Consider replacing '$_' with '``' or `''`") when ('\\textquotedbl');
  409.                         }
  410.                     }
  411.                     when('.') {
  412.                         $punctWord .= $tok->{content};
  413.                         given(length $tok->{content}) {
  414.                             when(1) { }
  415.                             when(2) {
  416.                                 $self->hint(2, "Did you mean . or \\ldots{}?");
  417.                             }
  418.                             when(3) {
  419.                                 $self->hint(3, "Replace ... with \\ldots{}");
  420.                             }
  421.                             default {
  422.                                 $self->hint(4, "Replace ... with \\ldots{} and remove trailing dots");
  423.                             }
  424.                         }
  425.                     }
  426.                     when('s') {
  427.                         if($self->relTokenAt(-1)->{type} eq '\\') {
  428.                             $self->hint(5, "Command terminated by space") unless $self->relTokenAt(-1)->{content} ~~ @SilenceSpace;
  429.                         }
  430.                         $self->hint(6, "Multiple spaces") if length($tok->{content})>1;
  431.                         if($punctWord && lc($punctWord) ~~ @ProtectSpace) {
  432.                             my $t = chop $punctWord;
  433.                             $self->hint(14, "Insert protected space here after '$punctWord'") if '.' eq $t;
  434.                         }
  435.                     }
  436.                 }
  437.                 if($tok->{type} ne "-") {
  438.                     $punctWord = undef;
  439.                 }
  440.                 if(defined $punctWord) {
  441.                     my $prev = $self->relTokenAt(-1);
  442.                     if($punctWord =~ /^[A-Z]/ && $tok->{type} eq "w" && $tok->{content} =~ /^[A-Z]/ && $prev->{type} eq "-") {
  443.                         # word - word
  444.                         if(length $prev->{content} < 2) {
  445.                             # issue a special value when both are uppercase
  446.                             my $bothupper = $punctWord eq uc $punctWord && $tok->{content} eq uc $tok->{content};
  447.                             $self->hint($bothupper ? 16 : 15, "Consider inserting 3 dashes before '$tok->{content}'");
  448.                         }
  449.                     }
  450.                     elsif($punctWord =~ /^[0-9]/ && $tok->{type} eq "d" && $tok->{content} =~ /^[0-9]/ && $prev->{type} eq "-") {
  451.                         # number - number
  452.                         if(length $prev->{content} != 2) {
  453.                             $self->hint(17, "Consider inserting 2 dashes before '$tok->{content}'");
  454.                         }
  455.                     }
  456.                     elsif($punctWord =~ /^[0-9]/ && $tok->{type} eq "w" && $prev->{type} eq "-") {
  457.                         # number - word
  458.                         if(length $prev->{content} != 1) {
  459.                             $self->hint(18, "Consider inserting 1 dash before '$tok->{content}'");
  460.                         }
  461.                     }
  462.                     elsif($punctWord =~ /^[[:alpha:]]/ && $tok->{type} eq "d" && $prev->{type} eq "-") {
  463.                         # word - number
  464.                         if(length $prev->{content} != 1) {
  465.                             $self->hint(19, "Consider inserting 1 dash before '$tok->{content}'");
  466.                         }
  467.                     }
  468.                 }
  469.             }
  470.         };
  471.     }
  472.     # }}}
  473. }
  474.  
  475. &TexStream::parseOpts();
  476. while(my $fn = TexStream::nextFile()) {
  477.     my $p = TexStream->new($fn);
  478.     $p->process();
  479. }
  480.  
  481.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!