#!/usr/bin/env perl # # Author : Devdatta Akhawe http://www.cs.berkeley.edu/~devdatta # From https://github.com/devd/Academic-Writing-Check # # Original Idea and list of words by Matthew Might # http://matt.might.net/articles/shell-scripts-for-passive-voice-weasel-words-duplicates/ use strict ; use warnings; use Getopt::Long; use List::Util qw(sum); use utf8; my @switch_list = ('passive','dups','weasel','abbr','typography','strunk','user'); my %options= map {$_=>1} @switch_list; my $vimmode = 0; Getopt::Long::Configure('pass_through'); GetOptions( \%options, 'd','v'); if($options{'v'}){ $vimmode=1; } if($options{'d'}){ $_ = 0 foreach values %options; delete $options{'d'}; } Getopt::Long::Configure('no_pass_through'); GetOptions( \%options, 'wordfile=s', 'def_color=s',map {("$_!",$_."_color=s")} @switch_list); my ($passive_color,$typography_color,$weasel_color,$dup_color,$abbr_color,$strunk_color,$user_color,$def_color) = ( getBashColor($options{'passive_color'},'red'), getBashColor($options{'typography_color'},'yellow'), getBashColor($options{'weasel_color'},'green'), getBashColor($options{'dup_color'},'purple'), getBashColor($options{'abbr_color'},'blue'), getBashColor($options{'strunk_color'},'cyan'), getBashColor($options{'user_color'},'darkyellow'), getBashColor($options{'def_color'},'def'), ); if ($vimmode) { ($passive_color,$typography_color,$weasel_color,$dup_color,$abbr_color,$strunk_color,$user_color,$def_color) = ( '**', '**', '**', '**', '**', '**', '**', '**', ); } #intialize default color print $def_color unless $vimmode; my $filename=""; my @files=@ARGV; $options{'diffmode'}=0; if(not @files){ #There are no files. Switch to diff output handling $options{'diffmode'}=1; } if($#files==0 and -d $files[0]){ my $dirname=shift @files; $dirname =~ s/\/$//; @files= glob("$dirname/*tex $dirname/*bbl"); } my $str=''; #use stdin if no file available @files=("/dev/stdin") unless @files; #HACK for <5.10 my $LevelN; if($] < 5.010){ $LevelN = qr/ (?> [^{}]+ | \{ (??{ $LevelN }) \} )* /x; } my @user_words=(); foreach my $filename ( $ENV{'HOME'}.'/.awc_wordlist', 'awc_wordlist' , $options{'wordfile'} ){ next unless $filename; if(-e $filename){ open my $fh,'<',$filename or die "Error opening $filename"; while(<$fh>){ next if m/^#/; chomp; next unless $_; s/\s+/\\s+/g; push @user_words,$_; } }else{ if($options{'wordfile'} and ($filename eq $options{'wordfile'})){ die "Couldn't find user defined wordfile ".$options{'wordfile'}; } } } while(($filename=shift @files)){ { open my $fh,'<',$filename or die "Error opening $filename"; local $/; $str=<$fh>; close($fh); } #remove lstlistings from the check #TODO: remove lstlistings, but replace each line with a blank line # so that line numbers don't get screwed up #$str =~ s/\\begin\{lstlisting\}.*?\\end\{lstlisting\}//sg; if($options{'diffmode'}){ $str=~ s/^(?:(?:[^\+].*)|(?:\+(?:(?:\+.*)|(.*))))$/$1||''/meg; $filename='diff_additions'; } $str =~ s/([^\\])%.*$/$1/mg ; my %count=(); if($filename =~ m/bbl$/){ #for bbl files only look for URL errors $count{'typography'} += fixURL() if $options{'typography'}; }else{ #TODO there is a much better way to do this dispatch #by keeping the function refs keyed by the same key as #options and count. $count{'typography'} = fixTypography() if $options{'typography'}; $count{'passive'} = fixPassive() if $options{'passive'}; $count{'dups'} = fixDups() if $options{'dups'}; $count{'weasel'} = fixWeasel() if $options{'weasel'}; $count{'strunk'} = fixStrunk() if $options{'strunk'}; $count{'abbr'} = fixAbbr() if $options{'abbr'}; $count{'user'} = fixUserWords() if $options{'user'} and @user_words; } next unless sum(values %count); my $linenum=0; if($filename =~ m/([^\/]*)$/){ $filename = $1 ; } my $extra=""; utf8::encode($str); open my $fh,'<:encoding(utf8)',\$str or die $!; while(my $line= <$fh>){ $linenum++; next unless $line =~ m/\x{EFFF}/; $line =~ s/\x{EFFF}//g; # we can't do this while setting str since that messes up line numbers # I am pretty sure this is ok since the % would prevent match across lines # this is moot if ignorecomment is turned on next if $line =~ m/^\s*%/; print "$filename:$linenum: $line"; $extra =1 ; } close $fh; unless ($vimmode) { print "\n"; print $passive_color,$count{'passive'}||0,' PASSIVE VOICE'," " if $options{'passive'}; print $typography_color,$count{'typography'}||0,' TYPOGRAPHY ERRORS'," " if $options{'typography'}; print $weasel_color,$count{'weasel'}||0,' WEASEL WORDS'," " if $options{'weasel'}; print $dup_color,$count{'dups'}||0,' DUPLICATES'," " if $options{'dups'}; print $strunk_color,$count{'strunk'}||0,' STRUNK AND WHITE'," " if $options{'strunk'}; print $abbr_color,$count{'abbr'}||0,' ABBR'," " if $options{'abbr'}; print $user_color,$count{'user'}||0,' USER' if $options{'user'}; print $def_color,"\n"; } # some spacing from the new file print "\n" if @files and $extra; } #reset to terminal default print getBashColor('def'); sub fixPassive{ my @irregulars=( "awoken", "been","born","beat", "become","begun","bent", "beset","bet","bid", "bidden","bound","bitten", "bled","blown","broken", "bred","brought","broadcast", "built","burnt","burst", "bought","cast","caught", "chosen","clung","come", "cost","crept","cut", "dealt","dug","dived", "done","drawn","dreamt", "driven","drunk","eaten","fallen", "fed","felt","fought","found", "fit","fled","flung","flown", "forbidden","forgotten", "foregone","forgiven", "forsaken","frozen", "gotten","given","gone", "ground","grown","hung", "heard","hidden","hit", "held","hurt","kept","knelt", "knit","known","laid","led", "leapt","learnt","left", "lent","let","lain","lighted", "lost","made","meant","met", "misspelt","mistaken","mown", "overcome","overdone","overtaken", "overthrown","paid","pled","proven", "put","quit","read","rid","ridden", "rung","risen","run","sawn","said", "seen","sought","sold","sent", "set","sewn","shaken","shaven", "shorn","shed","shone","shod", "shot","shown","shrunk","shut", "sung","sunk","sat","slept", "slain","slid","slung","slit", "smitten","sown","spoken","sped", "spent","spilt","spun","spit", "split","spread","sprung","stood", "stolen","stuck","stung","stunk", "stridden","struck","strung", "striven","sworn","swept", "swollen","swum","swung","taken", "taught","torn","told","thought", "thrived","thrown","thrust", "trodden","understood","upheld", "upset","woken","worn","woven", "wed","wept","wound","won", "withheld","withstood","wrung", "written"); my $regex = '\b(am|are|were|being|is|been|was|be)\b(\s+)(\w+ed|('.join('|',@irregulars).'))\b'; return $str =~ s/$regex/\x{EFFF}$def_color$passive_color$1$def_color$2$passive_color$3$def_color\x{EFFF}/goi; } sub fixWeasel{ #TODO add better support for wordfile my $regex ='\b(might|appears\s+to\s+be|it\s+is\s+easy\s+to\s+see|theoretically|actual|In\s+this\s+paper|almost|many|various|very|fairly|several|extremely|exceedingly|quite|remarkably|few|surprisingly|mostly|largely|huge|tiny|((are|is) a number)|excellent|interestingly|significantly|substantially|clearly|vast|relatively|completely)\b'; return $str =~ s/$regex/\x{EFFF}$weasel_color$1$def_color\x{EFFF}/goi; } sub fixDups{ return $str =~ s/\b(\w+)(\s+)(\1)\b/\x{EFFF}$dup_color$1$def_color$2$dup_color$3$def_color\x{EFFF}/iog; } sub fixAbbr{ my $c = ($str =~ s/\b(et\.\s+al|i\.e(?!\.)|et\s+al(?!\.))\b/\x{EFFF}$abbr_color$1$def_color\x{EFFF}/og); $c += ($str =~ s/\b(e\.g\.(?!,)|e\.g(?!\.))/\x{EFFF}$abbr_color$1$def_color\x{EFFF}/og); return $c; } sub fixStrunk{ my $count=0; $count += fixStrunkWords(); return $count; } sub fixTypography{ my $c= 0; #footnotes look better if started after punctuations if($] >= 5.010){ my $regex = '(\\\\footnote)(\{(?:(?>[^{}]+)|(?2))+\})([.,:=;-])'; $c += ($str =~ s/$regex/\x{EFFF}$typography_color$1$def_color\x{EFFF}$2\x{EFFF}$typography_color$3$def_color\x{EFFF}/og); }else{ $c+=($str =~ s/(\\footnote)(\{$LevelN\})([.,:=;-])/\x{EFFF}$typography_color$1$def_color\x{EFFF}$2\x{EFFF}$typography_color$3$def_color\x{EFFF}/og); } #Latex assumes a '.' ends a sentence unless its after a uppercase letter #http://www.ece.ucdavis.edu/~jowens/commonerrors.html $c += ($str =~ s/\b((?:et\sal\.|i\.e\.|etc\.|vs\.) )/\x{EFFF}$typography_color$1$def_color\x{EFFF}/og); $c += ($str =~ s/([^\s]*[A-Z]\.)(?=\s|$)/\x{EFFF}$typography_color$1$def_color\x{EFFF}/og); $c += ($str =~ s/\b(,\set\sal\.)/\x{EFFF}$typography_color$1$def_color\x{EFFF}/og); $c += ($str =~ s/(\s\d{4,}\b)/\x{EFFF}$typography_color$1$def_color\x{EFFF}/go) if $options{'number'}; #URLs should be typeset with \url $c += fixURL(); return $c; } sub fixStrunkWords{ my $regex=qr{ #initially from the chapter IV ( and\/or | anticipate | as \s good \s or \s better \s than | as \s yet | as \s to \s whether | certainly | factor | feature | finalize | importantly | insightful | in[ ]terms[ ]off | interesting(?:ly)? | irregardless | meaningful(?:ly)? | nice(?:ly)? | one \s of \s the \s most| respective(?:ly)? | (?:most|very) \s unique | utilize | very | the fact that | rather | little | pretty #from the last chapter }x; my $c = $str =~ s/\b($regex)\b/\x{EFFF}$strunk_color$1$def_color\x{EFFF}/g; $c += $str =~ s/([.?]\s*However)/\x{EFFF}$strunk_color$1$def_color\x{EFFF}/g; return $c; } sub fixStrunkRule2{ #broken broken broken my $word = qr/[a-z]{2,}/; my $words = qr/$word(?:\s+$word)*/; return $str =~ s/(,\s*$words\s*)(?=\s+and\s*$words)/\x{EFFF}$dup_color$1$def_color\x{EFFF}/goi; } sub fixURL{ #http://daringfireball.net/2010/07/improved_regex_for_matching_urls my $regex=qr{ \b ( # Capture 1: entire matched URL (?: (ht|f)tps?:\/\/ # http or https protocol | # or www\d{0,3}[.] # "www.", "www1.", "www2." … "www999." | # or [a-z0-9.\-]+[.][a-z]{2,4}\/ # looks like domain name followed by a slash ) (?: # One or more: [^\s()<>]+ # Run of non-space, non-()<> | # or \(([^\s()<>]+|(\([^\s()<>]+\)))*\) # balanced parens, up to 2 levels )+ (?: # End with: \(([^\s()<>]+|(\([^\s()<>]+\)))*\) # balanced parens, up to 2 levels | # or [^\s`!()\[\]{};:'".,<>?«»“”‘’] # not a space or one of these punct chars ) )}x; return $str =~ s/(\\url\{[^}]*\})|($regex)/$1 || "\x{EFFF}$typography_color$2$def_color\x{EFFF}"/eog; } sub getBashColor{ # Color codes are at http://www.cyberciti.biz/faq/bash-shell-change-the-color-of-my-shell-prompt-under-linux-or-unix/ my $color=lc($_[0]||''); my $shade='light'; $shade= 'dark' if $color =~ s/^dark//; $color =~ s/^light//; return "\e[00m" if $color =~ m/^def/; my $i=0; my %color_hash=map {$_ => $i++} ('black','red','green','yellow','blue','purple','cyan','white'); return getBashColor($_[1]||'def') unless exists $color_hash{$color}; return "\e[".($shade eq "dark" ? '0' : '1').';3'.$color_hash{$color}.'m'; } sub fixUserWords{ my $regex = '\b((?:'.join(')|(?:',@user_words).'))\b'; #non case-sensitive return $str =~ s/$regex/\x{EFFF}$user_color$1$def_color\x{EFFF}/go; }