JezK
Edit File: makedtx
#!/usr/bin/perl # File : makedtx # Author : Nicola L. C. Talbot # Date : 29 Oct 2004 # Last Modified : 2017-04-08 # Version : 1.2 # usage : makedtx [options] -src <expr>=><expr> -doc <filename> <basename> # # -h : help message # -src <expr>=><expr> : e.g. -src "(foo)src\.(bar)=>$1.$2" will add foosrc.bar to <basename>.dtx to be extracted to foo.bar # -doc <filename> : file containing documentation. # -prefinale <string> : text to add to dtx file just before \Finale (added to version 0.91b) # <basename> : create <basename>.dtx and <basename>.ins use Getopt::Long; $version = "1.2"; # process command line options %optctl = (); # v1.1 added section switch &GetOptions(\%optctl, "h", "help", "v", "src=s@", "doc=s", "dir=s", "op=s", "askforoverwrite!", "ins!", "preamble=s", "postamble=s", "setambles=s@", "testmode", "macrocode=s@", "author=s", "date=s", "stopeventually=s", "prefinale=s", "codetitle=s", "comment=s@", "version", "license=s", "section=s") or &syntaxerror(); $srcdir = "."; $patternop = "="; $verbose = 0; $noins = 0; $testmode = 0; $askforoverwrite = 0; $preamble = ""; $postamble = ""; my $author; if ($^O =~ m/MSWin/) { $author = $ENV{"USERNAME"}; if ($author eq ""){ $author = 'Unknown';} } else { $author = (getpwuid($<))[6] || 'Unknown'; } $stopeventually = ""; $prefinale = ""; $codetitle = "The Code"; $section = "section"; $license = "lppl"; ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time); $year = $year + 1900; $copyright_date = $year; $creation_date = "$year/" . ($mon+1) . "/$mday $hour:" . ($min<10?"0$min" : $min); foreach $setting (keys %optctl) { if (($setting eq "h") || ($setting eq "help")) { &help(); } elsif ($setting eq "version") { print "makedtx version $version\n"; exit 0; } elsif ($setting eq "doc") { $docsrc = $optctl{$setting}; } elsif ($setting eq "src") { @source = @{ $optctl{$setting} }; } elsif ($setting eq "dir") { $srcdir = $optctl{$setting}; } elsif ($setting eq "op") { $patternop = $optctl{$setting}; } elsif ($setting eq "v") { $verbose = 1; } elsif ($setting eq "ins") { $noins = 1-$optctl{$setting}; } elsif ($setting eq "askforoverwrite") { $askforoverwrite = $optctl{$setting}; } elsif ($setting eq "preamble") { $preamble = $optctl{$setting}; } elsif ($setting eq "postamble") { $postamble = $optctl{$setting}; } elsif ($setting eq "setambles") { @setambles = @{ $optctl{$setting} }; } elsif ($setting eq "macrocode") { @macrocode = @{ $optctl{$setting} }; } elsif ($setting eq "author") { $author = $optctl{$setting}; } elsif ($setting eq "date") { $copyright_date = $optctl{$setting}; } elsif ($setting eq "stopeventually") { $stopeventually = $optctl{$setting}; } elsif ($setting eq "prefinale") { $prefinale = $optctl{$setting}; } elsif ($setting eq "codetitle") { $codetitle = $optctl{$setting}; } elsif ($setting eq "section") { $section = $optctl{$setting}; } elsif ($setting eq "testmode") { $testmode = $optctl{$setting}; if($testmode) { $version = "x.y"; $copyright_date = "YYYY"; $creation_date = "YYYY/MM/DD hh:mm"; } } elsif ($setting eq "comment") { @comment = @{ $optctl{$setting} }; } elsif ($setting eq "license") { $license = $optctl{$setting}; } } if ($#ARGV != 0) { print "No basename specified\n"; &syntaxerror(); } $basename = $ARGV[0]; if ($docsrc eq "") { print "No document source specified (missing -doc)\n"; &syntaxerror(); } if ($#source == -1) { print "No source code specified (missing -src)\n"; &syntaxerror(); } open DTX, ">:unix","$basename.dtx" or die "Can't open '$basename.dtx'\n"; if ($verbose) { print "Documentation source : " . $docsrc . "\n"; } # work out the derived files @srcdirfile = glob("$srcdir/*"); @derivedfiles = (); @outputfiles = (); $numoutput = 0; foreach $source (@source) { ($infile, $outfile, $remainder) = split /=>/, $source; if ($outfile eq "") { print "-src $source argument invalid (no output file specified)\n"; &syntaxerror(); } if (not ($remainder eq "")) { print "-src $source argument invalid (too many => specified)\n"; &syntaxerror(); } foreach $srcdirfile (@srcdirfile) { $fileexp = $srcdir . "/" . $infile; $_ = $srcdirfile; $expr = "s$patternop$fileexp$patternop$outfile$patternop"; if (eval($expr)) { $thisoutfile = $_; $thisinfile = $srcdirfile; $file{$thisinfile} = $thisoutfile; $derivedfiles[$numoutput]{'in'} = $thisinfile; $derivedfiles[$numoutput]{'out'} = $thisoutfile; $outputfiles[$numoutput] = $thisoutfile; $numoutput++; } } } if ($preamble eq "") { if ($license eq "lppl") { # v1.2 fixed typo in preamble $preamble = <<_END_LICENSE; $basename.dtx Copyright $copyright_date $author This work may be distributed and/or modified under the conditions of the LaTeX Project Public License, either version 1.3 of this license or (at your option) any later version. The latest version of this license is in http://www.latex-project.org/lppl.txt and version 1.3 or later is part of all distributions of LaTeX version 2005/12/01 or later. This work has the LPPL maintenance status `maintained'. The Current Maintainer of this work is $author. _END_LICENSE } elsif ($license eq 'bsd') { $preamble = <<_END_LICENSE; $basename.dtx Copyright (c) $copyright_date $author All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. _END_LICENSE } elsif ($license eq 'gpl') { $preamble = <<_END_LICENSE; $basename.dtx Copyright (c) $copyright_date $author This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA _END_LICENSE } else { die "Unknown license '$license'\n". "Known licenses: lppl, bsd, gpl"; } $preamble .= " This work consists of the files " . "$basename.dtx and $basename.ins and the derived " . ($numoutput > 1 ? "files" : "file") . " " . join(', ', @outputfiles) . ".\n"; } open DOC, '<:crlf',$docsrc or die "Can't open '$docsrc'\n"; print DTX "\%\\iffalse\n"; print DTX "\% $basename.dtx generated using makedtx version $version (c) Nicola Talbot\n"; print DTX "\% Command line args:\n"; @cmdline_args = (); foreach $setting (keys %optctl) { if ($setting eq "src") { foreach $source (@source) { push @cmdline_args ,"-src \"$source\""; } } elsif ($setting eq "setambles") { foreach $setamble (@setambles) { push @cmdline_args ,"-setambles \"$setamble\""; } } elsif ($setting eq "macrocode") { foreach $macrocode (@macrocode) { push @cmdline_args ,"-macrocode \"$macrocode\""; } } elsif ($setting eq "comment") { foreach $comment (@comment) { push @cmdline_args ,"-comment \"$comment\""; } } else { $val = $optctl{$setting}; $val=~s/\\/\\\\/g; push @cmdline_args ,("-" . $setting . " \"" . $val . "\""); } } if($testmode){ @cmdline_args = sort @cmdline_args; } foreach $arg (@cmdline_args){ print DTX "\% ", $arg , "\n"; } print DTX "\% $basename\n"; print DTX "\% Created on $creation_date\n"; print DTX "\%\\fi\n"; print DTX "\%\\iffalse\n"; print DTX "\%<*package>\n"; print DTX "\%\% \\CharacterTable\n"; print DTX "\%\% {Upper-case \\A\\B\\C\\D\\E\\F\\G\\H\\I\\J\\K\\L\\M\\N\\O\\P\\Q\\R\\S\\T\\U\\V\\W\\X\\Y\\Z\n"; print DTX "\%\% Lower-case \\a\\b\\c\\d\\e\\f\\g\\h\\i\\j\\k\\l\\m\\n\\o\\p\\q\\r\\s\\t\\u\\v\\w\\x\\y\\z\n"; print DTX "\%\% Digits \\0\\1\\2\\3\\4\\5\\6\\7\\8\\9\n"; print DTX "\%\% Exclamation \\! Double quote \\\" Hash (number) \\#\n"; print DTX "\%\% Dollar \\\$ Percent \\\% Ampersand \\&\n"; print DTX "\%\% Acute accent \\\' Left paren \\( Right paren \\)\n"; print DTX "\%\% Asterisk \\* Plus \\+ Comma \\,\n"; print DTX "\%\% Minus \\- Point \\. Solidus \\/\n"; print DTX "\%\% Colon \\: Semicolon \\; Less than \\<\n"; print DTX "\%\% Equals \\= Greater than \\> Question mark \\?\n"; print DTX "\%\% Commercial at \\\@ Left bracket \\[ Backslash \\\\\n"; print DTX "\%\% Right bracket \\] Circumflex \\^ Underscore \\_\n"; print DTX "\%\% Grave accent \\\` Left brace \\{ Vertical bar \\|\n"; print DTX "\%\% Right brace \\} Tilde \\~}\n"; print DTX "\%</package>\n"; print DTX "\%\\fi\n"; print DTX "\% \\iffalse\n"; print DTX "\% Doc-Source file to use with LaTeX2e\n"; print DTX "\% Copyright (C) $copyright_date $author, all rights reserved.\n"; print DTX "\% \\fi\n"; # driver print DTX "\% \\iffalse\n"; print DTX "\%<*driver>\n"; $indoc=0; while (<DOC>) { s/\\usepackage\{creatdtx}//; $restofline = $_; $beginline = ""; $line = $restofline; while ($restofline =~ /(.*)\\ifmakedtx(.*)/) { $beginline = $1; ($group,$restofline,$done) = &getnextgroup($2); $startline = $.; while (!$done) { if ($nextline = <DOC>) { $line = $line . $nextline; $restofline = $restofline . $nextline; ($group,$restofline,$done) = &getnextgroup($restofline); } else { die "EOF found whilst scanning first argument to \\ifmakedtx on line $startline\n"; } } # print first arg, ignore second $beginline = $beginline . $group; ($group,$restofline,$done) = &getnextgroup($restofline); while (!$done) { if ($nextline = <DOC>) { $line = $line . $nextline; $restofline = $restofline . $nextline; ($group,$restofline,$done) = &getnextgroup($restofline); } else { die "EOF found whilst scanning second argument to \\ifmakedtx on line $startline\n"; } } $line = $restofline; } $line = $beginline . $restofline; print DTX $line; if ($line=~/\\begin\{document}/) { $indoc = 1; last; } } print DTX "\\DocInput{$basename.dtx}\n"; print DTX "\\end{document}\n"; print DTX "\%</driver>\n"; print DTX "\%\\fi\n"; $inverb=0; $stopfound=0; print DTX "\%"; while (<DOC>) { if (/\\begin\{verbatim}/) { $inverb=1; } if (/\\end\{verbatim}/) { $inverb=0; } if (/\\StopEventually/ && ($inverb==0)) { $stopfound=1; } $restofline = $_; $beginline = ""; $line = $restofline; while ($restofline =~ /(.*)\\ifmakedtx(.*)/) { $beginline = $1; ($group,$restofline,$done) = &getnextgroup($2); $startline = $.; while (!$done) { if ($nextline = <DOC>) { $line = $line . $nextline; $restofline = $restofline . $nextline; ($group,$restofline,$done) = &getnextgroup($restofline); } else { die "EOF found whilst scanning first argument to \\ifmakedtx on line $startline\n"; } } # print first arg, ignore second $beginline = $beginline . $group; ($group,$restofline,$done) = &getnextgroup($restofline); while (!$done) { if ($nextline = <DOC>) { $line = $line . $nextline; $restofline = $restofline . $nextline; ($group,$restofline,$done) = &getnextgroup($restofline); } else { die "EOF found whilst scanning second argument to \\ifmakedtx on line $startline\n"; } } $line = $restofline; } $line = $beginline . $restofline; if (($line=~/\\end\{document}/) and not $inverb) { $indoc=0; $line=~s/\\end\{document}//; } $line=~s/\n/\n\%/mg; print DTX "$line"; } close DOC; print DTX "\n"; if ($stopfound==0) { print DTX "\%\\StopEventually{$stopeventually}\n"; } # v1.0 added check if ($codetitle) { # v1.1 added section print DTX "\%\\$section\{$codetitle\}\n"; } for (my $idx = 0; $idx <= $#derivedfiles; $idx++) { $thisinfile = $derivedfiles[$idx]{'in'}; $thisoutfile = $derivedfiles[$idx]{'out'}; if ($verbose) { print "$srcdirfile -> $_ \n"; } open SRC, "<:crlf", $thisinfile or die "Can't open $thisinfile\n"; print DTX "\%\\iffalse\n"; print DTX "\% \\begin{macrocode}\n"; print DTX "\%<*$thisoutfile>\n"; print DTX "\% \\end{macrocode}\n"; print DTX "\%\\fi\n"; $macrocode = 0; $comment = 0; foreach $expr (@comment) { if ($thisoutfile =~ m/$expr/) { print DTX "\%\\iffalse\n"; $comment = 1; } } foreach $expr (@macrocode) { if ($thisoutfile =~ m/$expr/) { print DTX "\% \\begin{macrocode}\n"; $macrocode = 1; } } while (<SRC>) { print DTX "$_"; } if ($macrocode == 1) { print DTX "\% \\end{macrocode}\n"; } if ($comment == 1) { print DTX "\%\\fi\n"; } print DTX "\%\\iffalse\n"; print DTX "\% \\begin{macrocode}\n"; print DTX "\%</$thisoutfile>\n"; print DTX "\% \\end{macrocode}\n"; print DTX "\%\\fi\n"; close SRC; } print DTX "\%$prefinale\n" if ($prefinale); print DTX "\%\\Finale\n"; print DTX "\\endinput\n"; close DTX; if (!$noins) { open INS, ">:unix","$basename.ins" or die "Can't open '$basename.ins'\n"; print INS "\% $basename.ins generated using makedtx version $version $creation_date\n"; print INS "\\input docstrip\n\n"; print INS "\\preamble\n"; print INS "$preamble\n"; print INS "\\endpreamble\n\n"; if ($postamble ne "") { print INS "\\postamble\n"; print INS "$postamble\n"; print INS "\\endpostamble\n\n"; } if ($askforoverwrite) { print INS "\\askforoverwritetrue\n\n"; } else { print INS "\\askforoverwritefalse\n\n"; } print INS "\\generate{"; for (my $idx = 0; $idx <= $#derivedfiles; $idx++) { $file = $derivedfiles[$idx]{'in'}; $outfile = $derivedfiles[$idx]{'out'}; print INS "\\file{$outfile}{"; $ambleset = 0; $noamble = 0; foreach $setamble (@setambles) { ($fileexp, $amble, $remainder) = split /=>/, $setamble; if (not ($remainder eq "")) { die "-setambles $setamble argument invalid (too many => specified)\n"; } if ($outfile =~ m/$fileexp/) { if ($verbose) { print "$fileexp matches $outfile -> setting \"$amble\"\n"; } print INS $amble; $ambleset = 1; if ($amble =~ m/\\nopreamble/) { $noamble = 1; } } } if (!$ambleset) { print INS "\\usepreamble\\defaultpreamble\n\\usepostamble\\defaultpostamble"; } print INS "\\from{$basename.dtx}{$outfile"; if ($noamble == 0) { # this will add the character table to all files except those that use \nopreamble print INS ",package"; } print INS "}}\n"; } print INS "}\n\n"; print INS "\\endbatchfile\n"; close INS; } sub syntaxerror { die "Syntax : makedtx [options] <basename>\nUse -h for help\n"; } sub help { print "makedtx Help\n\n"; print "Current Version : $version\n\n"; print "usage : makedtx [options] -src \"<expr>=><expr>\" -doc <filename> <basename>\n\n"; print "makedtx can be used to construct a LaTeX2e dtx and ins file from\n"; print "the specified source code. The final command line argument\n"; print "<basename> should be used to specify the basename of the dtx\n"; print "and ins files.\n\n"; print "-src \"<expr1>=><expr2>\"\n"; print "The command line switch -src identifies the original source code and the name\n"; print "of the file to which it will utimately be extracted on latexing the ins file\n"; print "<expr1> can be a Perl expression, such as (foo)src.(sty), and <expr2> can\n"; print "a Perl substitution style expression, such as $1.$2\n"; print "Note that double quotes must be used to prevent shell expansion\n"; print "Multiple invocations of -src are permitted\n"; print "See examples below.\n\n"; print "-doc <filename>\n"; print "The name of the documentation source code. This should be a LaTeX2e document\n\n"; print "Optional Arguments:\n\n"; print "-dir <directory> : search for source files in <directory>\n"; print "-op <character> : set the pattern matching operator (default '$patternop')\n"; print "-askforoverwrite : set askforoverwrite switch in INS file to true\n"; print "-noaskforoverwrite : set askforoverwrite switch in INS file to false (default)\n"; print "-preamble <text> : set the preamble. Standard one inserted if omitted\n"; print "-postamble <text> : set the postamble.\n"; print "-setambles \"<pattern>=><text>\" : set pre- and postambles to <text> if file matches pattern\n"; print "-author <text> : name of author (inserted into standard preamble. User name inserted if omitted)\n"; print "-date <text> : copyright date\n"; print "-ins : create the ins file (default)\n"; print "-noins : don't create the ins file\n"; print "-prefinale <text> : add <text> immediately prior to \\Finale\n"; print "-macrocode <expr> : surround any file which matches <expr> in a macrocode environment\n"; print "-comment <expr> : surround any file which matches <expr> with \\iffalse \\fi pair\n"; print "-codetitle <text> : The title for the documented code section (default: The Code)\n"; print "-section <cs> : The sectioning command to use for the documented code section (default: 'section')\n"; print "-license <license> : use the given license for the preamble.\n"; print " Known licenses: lppl (default), bsd, gpl.\n"; print "-h : help message\n"; print "-v : verbose\n\n"; print "Examples:\n\n"; print "Example 1:\n"; print "Documenation is in foodoc.tex\n"; print "Source code is in foosrc.sty. The final extracted version should be \n"; print "called foo.sty. The dtx file should be called foo.dtx and the ins file\n"; print " should be called foo.ins\n\n"; print "makedtx -src \"foosrc\\.sty=>foo.sty\" -doc foodoc.tex foo\n\n"; print "Example 2:\n"; print "Documenation is in bardoc.tex\n"; print "Source code is in barsrc.sty. The final extracted version should be\n"; print "called bar.sty. Source code is also in barsrc.bst. The final extracted\n"; print "version should be called bar.bst. The dtx file should be called bar.dtx and\n"; print "the ins file should be called bar.ins\n\n"; print "makedtx -src \"barsrc\\.sty=>bar.sty\" -src \"barsrc\\.bst=>bar.bst\" -doc bardoc.tex bar\n\n"; print "Or\n\n"; print "makedtx -src \"barsrc\\.(bst|sty)=>bar.\$1\" -doc bardoc.tex bar\n\n"; die; } sub eatinitialspaces { my ($STR) = @_; while (substr($STR,0,1) eq "\s") { $STR = substr($STR,1); } return $STR; } sub getnextgroup { my($curline) = @_; $curline = &eatinitialspaces($curline); # check to see if current string is blank if ($curline!~/[^\s]+/m) { return ("","",0); } if (($group = substr($curline,0,1)) ne "{") { # next group hasn't been delimited with braces # return first non-whitespace character $curline = substr($curline,1); # unless it's a backslash, in which case get command name if ($group eq "\\") { if ($curline=~/([a-zA-Z]+)(^[a-zA-Z].*)/m) { $group = $1; $curline = $2; } else { # command is made up of backslash followed by symbol $curline=~/([\W_0-9\s\\])(.*)/m; $group = $1; $curline = $2; } } return ($group,$curline,1); } my $pos=index($curline, "{"); my $startpos=$pos; my $posopen=0; my $posclose=0; my $bracelevel = 1; my $done=0; while (!$done) { $pos++; $posopen = index($curline, "{", $pos); # check to make sure it's not a \{ while ((substr($curline, $posopen-1,1) eq "\\") and ($posopen > 0)) { # count how many backlashes come before it. $i = $posopen-1; $numbs = 1; while ((substr($curline, $i-1,1) eq "\\") and ($i > 0)) { $numbs++; $i--; } # is $numbs is odd, we have a \{, otherwise we have \\{ if ($numbs%2 == 0) { last; } else { $posopen = index($curline, "{", $posopen+1); } } $posclose= index($curline, "}", $pos); # check to make sure it's not a \} while ((substr($curline, $posclose-1,1) eq "\\") and ($posclose > 0)) { # count how many backlashes come before it. $i = $posclose-1; $numbs = 1; while ((substr($curline, $i-1,1) eq "\\") and ($i > 0)) { $numbs++; $i--; } # is $numbs is odd, we have a \}, otherwise we have \\} if ($numbs%2 == 0) { last; } else { $posclose = index($curline, "}", $posclose+1); } } if (($posopen==-1) and ($posclose==-1)) { $done=1; } elsif ($posopen==-1) { $pos=$posclose; $bracelevel--; if ($bracelevel==0) { $group = substr($curline, $startpos+1, $pos-$startpos-1); $curline = substr($curline, $pos+1); return ($group,$curline,1); } } elsif ($posclose==-1) { $pos=$posopen; $bracelevel++; } elsif ($posopen<$posclose) { $pos=$posopen; $bracelevel++; } elsif ($posclose<$posopen) { $pos=$posclose; $bracelevel--; if ($bracelevel==0) { $group = substr($curline, $startpos+1, $pos-$startpos-1); $curline = substr($curline, $pos+1); return ($group,$curline,1); } } } # closing brace must be on another line return ("", $curline, 0); } 1;