From 4289e4647ab448dbce672649f32f107dda45c4aa Mon Sep 17 00:00:00 2001
From: Karl Berry <karl@freefriends.org>
Date: Sat, 5 Feb 2011 00:20:15 +0000
Subject: sty2dtx (2feb11)

git-svn-id: svn://tug.org/texlive/trunk@21295 c570f23f-e606-0410-a88d-b1316a301751
---
 Master/texmf-dist/scripts/sty2dtx/sty2dtx.pl | 310 ++++++++++++++++-----------
 1 file changed, 183 insertions(+), 127 deletions(-)

(limited to 'Master/texmf-dist/scripts/sty2dtx')

diff --git a/Master/texmf-dist/scripts/sty2dtx/sty2dtx.pl b/Master/texmf-dist/scripts/sty2dtx/sty2dtx.pl
index f439ece2378..5c0730ca5bb 100755
--- a/Master/texmf-dist/scripts/sty2dtx/sty2dtx.pl
+++ b/Master/texmf-dist/scripts/sty2dtx/sty2dtx.pl
@@ -2,7 +2,7 @@
 use strict;
 use warnings;
 ################################################################################
-# $Id: sty2dtx.pl 2114 2011-01-31 00:54:57Z martin $
+# $Id: sty2dtx.pl 2125 2011-02-02 15:25:40Z martin $
 ################################################################################
 my $COPYRIGHT = << 'EOT';
   Copyright (c) 2010-2011 Martin Scharrer <martin@scharrer-online.de>
@@ -58,7 +58,7 @@ my $DESCRIPTION = << 'EOT';
 
 EOT
 ################################################################################
-my $VERSION = "v2.0 " . substr('$Date: 2011-01-31 00:54:57 +0000 (Mon, 31 Jan 2011) $', 7, 10);
+my $VERSION = "v2.1 " . substr( '$Date: 2011-02-02 15:25:40 +0000 (Wed, 02 Feb 2011) $', 7, 10 );
 $VERSION =~ tr/-/\//;
 my $TITLE = << "EOT";
   sty2dtx -- Converts a LaTeX .sty file to a documented .dtx file
@@ -93,6 +93,7 @@ Options:
   -O            : Overwrite already existing output file(s)
   -B            : Use basename of single input file for output file
   -I            : Also create .ins (install) file
+  -c            : Only use code section (like v1.0)
   -i <ins file> : Create .ins file with given name
   -t <template> : Use this file as template instead of the default one
   -T <template> : Use this file as template for the .ins file
@@ -124,20 +125,22 @@ Examples:
     sty2dtx.pl --type class mycls.sty mycls.dtx
 
 EOT
-    exit (0);
+    exit(0);
 }
 
 my $ERROR = "sty2dtx: Error:";
 
 # Used as format string of printf so that the '%' must be doubled:
 my $macrostart = <<'EOT';
+%%
 %% \begin{macro}{\%s}
-%%    \begin{macrocode}
+%s%%    \begin{macrocode}
 EOT
 
 my $environmentstart = <<'EOT';
+%%
 %% \begin{environment}{%s}
-%%    \begin{macrocode}
+%s%%    \begin{macrocode}
 EOT
 
 my $macrodescription = <<'EOT';
@@ -171,21 +174,21 @@ EOT
 
 my $macrocodestop = <<'EOT';
 %    \end{macrocode}
-%
 EOT
 
-my $USAGE = '';  # Store macro names for usage section
-my $IMPL  = '';   # Store implementation section
+my $USAGE = '';    # Store macro names for usage section
+my $IMPL  = '';    # Store implementation section
 
 my $mode = 0;
 # 0 = outside of macro or macrocode environments
-# 1 = inside macro environment
-# 2 = inside macrocode environment
+# 1 = inside 'macrocode' environment
+# 2 = inside 'macro' environment
+# 3 = inside 'environment' environment
 
 # RegExs for macro names and defintion:
 my $rmacroname = qr/[a-zA-Z\@:]+/;    # Add ':' for LaTeX3 style macros
 my $rusermacro = qr/[a-zA-Z]+/;       # Macros intended for users
-my $rmacrodef = qr/
+my $rmacrodef  = qr/
     ^                                                        # Begin of line (no whitespaces!)
      (
        (?:(?:\\global|\\long|\\protected|\\outer)\s*)*       # Prefixes (maybe with whitespace between them)
@@ -210,30 +213,32 @@ my $renvdef = qr/
      (.*)                                                    # Rest of line
     /xms;
 
+my $comments = '';
 
 # Print end of environment, if one is open
-sub close_env {
+sub close_environment {
     if ( $mode == 1 ) {
-        # Happens only if closing brace is not on a line by its own.
-        $IMPL .= $macrostop;
+        $IMPL .= $macrocodestop;
     }
     elsif ( $mode == 2 ) {
-        $IMPL .= $macrocodestop;
+        # Happens only if closing brace is not on a line by its own.
+        $IMPL .= $macrostop;
     }
     elsif ( $mode == 3 ) {
         $IMPL .= $environmentstop;
     }
 }
 
-my ($mday,$mon,$year) = (localtime(time))[3..5];
-$mon = sprintf("%02d", $mon + 1);
+my ( $mday, $mon, $year ) = ( localtime(time) )[ 3 .. 5 ];
+$mon = sprintf( "%02d", $mon + 1 );
 $year += 1900;
 
 my @files;
-my $outfile = '';
-my $verbose = 0;
-my $install = 0;
-my $usebase = 0;
+my $outfile   = '';
+my $verbose   = 0;
+my $codeonly  = 0;
+my $install   = 0;
+my $usebase   = 0;
 my $overwrite = 0;
 my $installfile;
 my $templfile;
@@ -250,40 +255,47 @@ my %vars = (
 # Handle options
 sub option {
     my $opt = shift;
-    if ($opt eq 'h') {
+    if ( $opt eq 'h' ) {
         usage();
     }
-    elsif ($opt eq 'H') {
+    elsif ( $opt eq 'H' ) {
         print $TITLE;
         print "\n";
         print $DESCRIPTION;
-        exit (0);
+        exit(0);
+    }
+    elsif ( $opt eq 'c' ) {
+        $codeonly = 1;
     }
-    elsif ($opt eq 'B') {
+    elsif ( $opt eq 'B' ) {
         $usebase = 1;
     }
-    elsif ($opt eq 't') {
-        close (DATA);
+    elsif ( $opt eq 't' ) {
+        close(DATA);
         $templfile = shift @ARGV;
-        open (DATA, '<', $templfile) or die "$ERROR Couldn't open template file '$templfile'\n";
+        open( DATA, '<', $templfile )
+          or die "$ERROR Couldn't open template file '$templfile'\n";
     }
-    elsif ($opt eq 'e') {
+    elsif ( $opt eq 'e' ) {
         my $templ = shift @ARGV;
-        if ($templ ne '-') {
-            open (STDOUT, '>', $templ) or die "$ERROR Couldn't open new template file '$templ'\n";
+        if ( $templ ne '-' ) {
+            open( STDOUT, '>', $templ )
+              or die "$ERROR Couldn't open new template file '$templ'\n";
         }
         while (<DATA>) {
             last if /^__INS__$/;
             print;
         }
-        print STDERR "Exported default template for .dtx files to file '$templ'\n"
-            if $verbose;
-        exit (0);
+        print STDERR
+          "Exported default template for .dtx files to file '$templ'\n"
+          if $verbose;
+        exit(0);
     }
-    elsif ($opt eq 'E') {
+    elsif ( $opt eq 'E' ) {
         my $templ = shift @ARGV;
-        if ($templ ne '-') {
-            open (STDOUT, '>', $templ) or die "$ERROR Couldn't open new template file '$templ'\n";
+        if ( $templ ne '-' ) {
+            open( STDOUT, '>', $templ )
+              or die "$ERROR Couldn't open new template file '$templ'\n";
         }
         while (<DATA>) {
             last if /^__INS__$/;
@@ -291,38 +303,45 @@ sub option {
         while (<DATA>) {
             print;
         }
-        print STDERR "Exported default template for .ins files to file '$templ'\n"
-            if $verbose;
-        exit (0);
+        print STDERR
+          "Exported default template for .ins files to file '$templ'\n"
+          if $verbose;
+        exit(0);
     }
-    elsif ($opt eq 'v') {
-        $verbose ++;
+    elsif ( $opt eq 'v' ) {
+        $verbose++;
     }
-    elsif ($opt eq 'I') {
+    elsif ( $opt eq 'I' ) {
         $install = 1;
     }
-    elsif ($opt eq 'i') {
+    elsif ( $opt eq 'i' ) {
         $installfile = shift @ARGV;
-        $install = 1;
+        $install     = 1;
     }
-    elsif ($opt eq 'T') {
+    elsif ( $opt eq 'T' ) {
         $installtempl = shift @ARGV;
     }
-    elsif ($opt eq 'V') {
+    elsif ( $opt eq 'V' ) {
         print $TITLE;
         print "\n";
         print $COPYRIGHT;
-        exit (0);
+        exit(0);
     }
-    elsif ($opt eq 'F') {
+    elsif ( $opt eq 'F' ) {
         my $optfile = shift @ARGV;
+
         # Read more options and variables from file
-        open(my $OPT, '<', $optfile) or die ("Couldn't open options file '$optfile'!\n");
-        while (my $line = <$OPT>) {
+        open( my $OPT, '<', $optfile )
+          or die("Couldn't open options file '$optfile'!\n");
+        while ( my $line = <$OPT> ) {
             chomp $line;
+
+            # Skip comment lines
+            next if $line =~ /^\s*[#%]/;
+
             # Split variable lines without equal sign into name and value
-            if (substr($line, 0, 2) eq '--' and index($line, '=') == -1) {
-                my ($var, $val) = split (/\s+/, $line, 2);
+            if ( substr( $line, 0, 2 ) eq '--' and index( $line, '=' ) == -1 ) {
+                my ( $var, $val ) = split( /\s+/, $line, 2 );
                 $val =~ s/^["']|["']$//g;
                 unshift @ARGV, $var, $val;
             }
@@ -330,20 +349,20 @@ sub option {
                 unshift @ARGV, $line;
             }
         }
-        close ($OPT);
+        close($OPT);
     }
-    elsif ($opt eq 'D') {
+    elsif ( $opt eq 'D' ) {
         $vars{date} = "$year/$mon/$mday";
     }
-    elsif ($opt eq 'o') {
+    elsif ( $opt eq 'o' ) {
         $outfile = shift @ARGV;
     }
-    elsif ($opt eq 'O') {
+    elsif ( $opt eq 'O' ) {
         $overwrite = 1;
     }
     else {
         print STDERR "sty2dtx: unknown option '-$opt'!\n";
-        exit (2);
+        exit(2);
     }
 }
 
@@ -357,18 +376,21 @@ sub addtochecksum {
 # Parse arguments
 while (@ARGV) {
     my $arg = shift;
+
     # '--' Marks rest of arguments as files
-    if ($arg eq '--' ) {
+    if ( $arg eq '--' ) {
         push @files, @ARGV;
         last;
     }
+
     # Options and variables
-    elsif ($arg =~ /^(-+)(.+)$/ ) {
+    elsif ( $arg =~ /^(-+)(.+)$/ ) {
         my $dashes = $1;
         my $name   = $2;
+
         # Single dash => option
-        if (length($dashes) == 1) {
-            foreach my $opt (split //, $name) {
+        if ( length($dashes) == 1 ) {
+            foreach my $opt ( split //, $name ) {
                 option($opt);
             }
         }
@@ -379,7 +401,7 @@ while (@ARGV) {
         }
         # Form "--var value"
         else {
-            $vars{lc($name)} = shift;
+            $vars{ lc($name) } = shift;
         }
     }
     # Files
@@ -390,22 +412,26 @@ while (@ARGV) {
 
 
 # Last (but not only) argument is output file, except if it is '-' (=STDOUT)
-if ($outfile || @files > 1) {
+if ( $outfile || @files > 1 ) {
     $outfile = pop @files unless $outfile;
-    $vars{filebase} = substr($outfile, 0, rindex($outfile, '.')) if not exists $vars{filebase};
+    $vars{filebase} = substr( $outfile, 0, rindex( $outfile, '.' ) )
+      if not exists $vars{filebase};
 }
-elsif (@files == 1) {
+elsif ( @files == 1 ) {
     my $infile = $files[0];
-    $vars{filebase} = substr($infile, 0, rindex($infile, '.')) if not exists $vars{filebase};
+    $vars{filebase} = substr( $infile, 0, rindex( $infile, '.' ) )
+      if not exists $vars{filebase};
     if ($usebase) {
         $outfile = $vars{filebase} . '.dtx';
     }
 }
-if ($outfile && $outfile ne '-') {
-    if (!$overwrite && -e $outfile && $outfile ne '/dev/null') {
-        die ("$ERROR output file '$outfile' does already exists! Use the -O option to overwrite.\n");
+if ( $outfile && $outfile ne '-' ) {
+    if ( !$overwrite && -e $outfile && $outfile ne '/dev/null' ) {
+        die(    "$ERROR output file '$outfile' does already exists!"
+              . " Use the -O option to overwrite.\n" );
     }
-    open (OUTPUT, '>', $outfile) or die ("$ERROR Could not open output file '$outfile'!");
+    open( OUTPUT, '>', $outfile )
+      or die("$ERROR Could not open output file '$outfile'!");
     select OUTPUT;
 }
 
@@ -422,19 +448,20 @@ while (<>) {
         my $rest = $4;          # rest of line
 
         # Add to usage section if it is a user level macro
-        if ($name =~ /^$rusermacro$/i) {
-            $USAGE .= sprintf ($macrodescription, $name);
+        if ( $name =~ /^$rusermacro$/i ) {
+            $USAGE .= sprintf( $macrodescription, $name );
         }
 
-        close_env();
+        close_environment();
 
         # Print 'macro' environment with current line.
-        $IMPL .= sprintf( $macrostart, $name );
+        $IMPL .= sprintf( $macrostart, $name, $comments );
         addtochecksum($_);
         $IMPL .= $_;
+        $comments = '';
 
         # Inside macro mode
-        $mode = 1;
+        $mode = 2;
 
         # Test for one line definitions.
         # $pre is tested to handle '{\somecatcodechange\gdef\name{short}}' lines
@@ -447,66 +474,79 @@ while (<>) {
     }
     # Test for environment definition command
     elsif (/$renvdef/) {
-        my $cmd  = $1;          # definition command
-        my $name = $2;          # macro name
-        my $rest = $3;          # rest of line
+        my $cmd  = $1;    # definition command
+        my $name = $2;    # macro name
+        my $rest = $3;    # rest of line
 
         # Add to usage section if it is a user level environment
         # Can use the same RegEx as for macro names
-        if ($name =~ /^$rusermacro$/i) {
-            $USAGE .= sprintf ($envdescription, $name);
+        if ( $name =~ /^$rusermacro$/i ) {
+            $USAGE .= sprintf( $envdescription, $name );
         }
 
-        close_env();
+        close_environment();
 
         # Print 'environment' environment with current line.
-        $IMPL .= sprintf( $environmentstart, $name );
+        $IMPL .= sprintf( $environmentstart, $name, $comments );
         addtochecksum($_);
         $IMPL .= $_;
+        $comments = '';
 
         # Inside environment mode
         $mode = 3;
 
         # Test for one line definitions.
-        my $nopen  = ($rest =~ tr/{/{/);
-        if ( $nopen >= 2 && $nopen == ($rest =~ tr/}/}/) ) {
+        my $nopen = ( $rest =~ tr/{/{/ );
+        if ( $nopen >= 2 && $nopen == ( $rest =~ tr/}/}/ ) ) {
             $IMPL .= $environmentstop;
             # Outside mode
             $mode = 0;
         }
     }
-    # A single '}' on a line ends a 'macro' environment in macro mode
-    elsif ($mode == 1 && /^}\s*$/) {
-        addtochecksum($_);
-        $IMPL .= $_ . $macrostop;
-        $mode = 0;
-    }
-    # A single '}' on a line ends a 'environemnt' environment in environment
-    # mode
-    elsif ($mode == 3 && /^}\s*$/) {
-        addtochecksum($_);
-        $IMPL .= $_ . $environmentstop;
-        $mode = 0;
+    # Collect comment lines, might be inserted as macro or environment description
+    # Real comments are either: 1) starting with a '%' at SOL or 2) are followed
+    # by at least one whitespace. This exclude (most) commented out code.
+    elsif (/^%|^\s*%\s/) {
+        $_ =~ s/^\s*//;
+        $comments .= $_;
+        if ( $mode == 1 ) {
+            $IMPL .= $macrocodestop;
+            $mode = 0;
+        }
     }
     # Remove empty lines (mostly between macros)
     elsif (/^$/) {
+        if ($comments) {
+            # Flush collected outside comments
+            $IMPL .= $comments . "%\n";
+            $comments = '';
+        }
     }
     else {
+        addtochecksum($_);
         # If inside an environment
         if ($mode) {
-            addtochecksum($_);
+            if ($comments) {
+                $IMPL .= $macrocodestop . $comments . $macrocodestart;
+                $comments = '';
+            }
             $IMPL .= $_;
+            # A single '}' on a line ends a 'macro' or 'environment' environment
+            if ( $mode > 1 && /^\}\s*$/ ) {
+                $IMPL .= ( $mode == 2 ) ? $macrostop : $environmentstop;
+                $mode = 0;
+            }
         }
         else {
             # Start macrocode environment
-            $IMPL .= $macrocodestart . $_;
-            addtochecksum($_);
-            $mode = 2;
+            $IMPL .= $comments . $macrocodestart . $_;
+            $mode     = 1;
+            $comments = '';
         }
     }
 }
 
-close_env();
+close_environment();
 
 ################################################################################
 # Set extra/auto variables
@@ -517,50 +557,63 @@ $vars{Type}       = "\L\u$vars{type}";
 $vars{extension}  = $vars{type} eq 'class' ? 'cls' : 'sty';
 $vars{checksum}   = $checksum if not exists $vars{checksum}; # Allow user to overwrite
 $vars{maintainer} = $vars{author}
-    if not exists $vars{maintainer} and exists $vars{author};
+  if not exists $vars{maintainer} and exists $vars{author};
 
 ################################################################################
 # Write DTX file
-$vars{IMPLEMENTATION} = $IMPL;
-$vars{USAGE}          = $USAGE;
-$vars{type}           = "\L$vars{type}";
-$vars{Type}           = "\L\u$vars{type}";
-$vars{extension}      = $vars{type} eq 'class' ? 'cls' : 'sty';
-$vars{maintainer}     = $vars{author}
-    if not exists $vars{maintainer} and exists $vars{author};
-
-while (<DATA>) {
-    last if /^__INS__$/;
-    # Substitute template variables
-    s/<\+([^+]+)\+>\n?/exists $vars{$1} ? $vars{$1} : "<+$1+>"/eg;
-    print;
+if ($codeonly) {
+    print $IMPL;
+    if ($verbose) {
+        print STDERR "Generated DTX file";
+        print STDERR " '$outfile'" if $outfile and $outfile ne '-';
+        print STDERR " (code only).\n";
+    }
 }
+else {
+    while (<DATA>) {
+        last if /^__INS__$/;
+        # Substitute template variables
+        s/<\+([^+]+)\+>\n?/exists $vars{$1} ? $vars{$1} : "<+$1+>"/eg;
+        print;
+    }
 
-if ($verbose) {
-    print STDERR "Generated DTX file";
-    print STDERR " '$outfile'" if $outfile and $outfile ne '-';
-    print STDERR " using template '$templfile'" if $templfile;
-    print STDERR ".\n";
+    if ($verbose) {
+        print STDERR "Generated DTX file";
+        print STDERR " '$outfile'" if $outfile and $outfile ne '-';
+        print STDERR " using template '$templfile'" if $templfile;
+        print STDERR ".\n";
+    }
 }
 
 ################################################################################
 # Write INS file if requested
 exit(0) unless $install;
 
-if ( ( !$outfile || $outfile eq '-' ) && !$installfile) {
-    print STDERR "Warning: Did not generate requested .ins file because main file\n";
+if ( ( !$outfile || $outfile eq '-' ) && !$installfile ) {
+    print STDERR
+      "Warning: Did not generate requested .ins file because main file\n";
     print STDERR "         was written to STDOUT and no -i option was given.\n";
     exit(1);
 }
 
 if ($installtempl) {
-    open (DATA, '<', $installtempl) or die "$ERROR Could't open template '$installtempl' for .ins file.";
+    open( DATA, '<', $installtempl )
+      or die "$ERROR Could't open template '$installtempl' for .ins file.";
+}
+elsif ($codeonly) {
+    # If DATA template was not used for main file go forward to correct position
+    while (<DATA>) {
+        last if /^__INS__$/;
+    }
 }
+
 $installfile = $vars{filebase} . '.ins' unless defined $installfile;
-if (!$overwrite && -e $installfile && $installfile ne '/dev/null') {
-    die ("$ERROR Output file '$installfile' does already exists! Use the -O option to overwrite.\n");
+if ( !$overwrite && -e $installfile && $installfile ne '/dev/null' ) {
+    die(    "$ERROR Output file '$installfile' does already exists!"
+          . " Use the -O option to overwrite.\n" );
 }
-open (INS, '>', $installfile) or die "$ERROR Could't open new .ins file '$installfile'.";
+open( INS, '>', $installfile )
+  or die "$ERROR Could't open new .ins file '$installfile'.";
 
 while (<DATA>) {
     # Substitute template variables
@@ -581,6 +634,9 @@ if ($verbose) {
 # Therfore all variables which are not expanded are easily accessible to the
 # user using a certain feature in the latex suite.
 #
+# Perl modules like 'Template' were not used to support minimal Perl installation
+# for typical LaTeX installations.
+#
 __DATA__
 % \iffalse meta-comment
 %
-- 
cgit v1.2.3