mathspic (7jun11 and earlier)

git-svn-id: svn://tug.org/texlive/trunk@23640 c570f23f-e606-0410-a88d-b1316a301751

4 files changed, 120 insertions, 114 deletions

diff --git a/Build/source/texk/texlive/linked_scripts/Makefile.am b/Build/source/texk/texlive/linked_scripts/Makefile.am
index 0891b7cd457..d9b69a2f2e9 100644
--- a/Build/source/texk/texlive/linked_scripts/Makefile.am
+++ b/Build/source/texk/texlive/linked_scripts/Makefile.am
@@ -96,7 +96,7 @@ texmf_dist_other_scripts = \
 	latexmk/latexmk.pl \
 	luaotfload/mkluatexfontdb.lua \
 	match_parens/match_parens \
-	mathspic/mathspic.pl \
+	mathspic/mathspic113.pl \
 	mf2pt1/mf2pt1.pl \
 	mkjobtexmf/mkjobtexmf.pl \
 	mkgrkindex/mkgrkindex \
diff --git a/Build/source/texk/texlive/linked_scripts/Makefile.in b/Build/source/texk/texlive/linked_scripts/Makefile.in
index 7e8fb94fc84..643edb57a2e 100644
--- a/Build/source/texk/texlive/linked_scripts/Makefile.in
+++ b/Build/source/texk/texlive/linked_scripts/Makefile.in
@@ -234,7 +234,7 @@ texmf_dist_other_scripts = \
 	latexmk/latexmk.pl \
 	luaotfload/mkluatexfontdb.lua \
 	match_parens/match_parens \
-	mathspic/mathspic.pl \
+	mathspic/mathspic113.pl \
 	mf2pt1/mf2pt1.pl \
 	mkjobtexmf/mkjobtexmf.pl \
 	mkgrkindex/mkgrkindex \
diff --git a/Build/source/texk/texlive/linked_scripts/mathspic/mathspic.pl b/Build/source/texk/texlive/linked_scripts/mathspic/mathspic113.pl
index 132517b0b17..5c3ed4ec1f9 100644..100755
--- a/Build/source/texk/texlive/linked_scripts/mathspic/mathspic.pl
+++ b/Build/source/texk/texlive/linked_scripts/mathspic/mathspic113.pl
@@ -1,8 +1,8 @@
 #!/usr/bin/perl
 #
-#(c) Copyright 2005  Apostolos Syropoulos       & R.W.D. Nickalls
-#                    apostolo@ocean1.ee.duth.gr   dicknickalls@compuserve.com
-#                    apostolo@obelix.ee.duth.gr
+#(c) Copyright 2005-2010  VERSION 1.13 April 26, 2010  
+#                    Apostolos Syropoulos   &  R.W.D. Nickalls
+#                    asyropoulos@yahoo.com     dick@nickalls.org
 #
 # This program can be redistributed and/or modified under the terms
 # of the LaTeX Project Public License Distributed from CTAN
@@ -30,7 +30,7 @@ sub READLINE {
 
 package main;
 use Math::Trig;
-our $version_number = "1.00 Feb 14, 2005";
+our $version_number = "1.13 Apr 26, 2010";
 our $commandLineArgs = join(" ", @ARGV);
 our $command  = "";
 our $curr_in_file = "";
@@ -128,47 +128,59 @@ our $LineThickness = 0.4;
     }
     else {
       my $comment = $2 if $in_line =~ s/([^%]+)(%.+)/$1/;
-      for(my $i = $#Macros; $i >= 0; $i--) {
-        my $macro_name = $Macros[$i]->{'macro_name'};
-        if ($in_line =~ /&$macro_name/) {       ############################
-          my $num_of_macro_args = @{$Macros[$i]->{'macro_param'}};
-          if ( $num_of_macro_args > 0 ) { 
-           my $pattern = "&$macro_name\\(";
-           foreach my $p ( 1..$num_of_macro_args ) {
-             my $comma = ($p == $num_of_macro_args) ? "\\s*" : "\\s*,\\s*";
-             $pattern .= "\\s*[^\\s\\)]+$comma";
-           }
-           $pattern .= "\\)";
-           while($in_line =~ /\W*&$macro_name\W+/) {
-             if ($in_line =~ /$pattern/) {   
-               my $before = $`;
-                my $after = $';
-                my $match = $&;
-                my $new_code = $Macros[$i]->{'macro_code'};
-                $match =~ s/^&$macro_name\(\s*//;
-               $match =~ s/\)$//; 
-                foreach my $arg ( 0..($num_of_macro_args - 1) ) {
-                 my $old = $Macros[$i]->{'macro_param'}->[$arg];
-                 my $comma = ($arg == ($num_of_macro_args - 1)) ? "" : ",";
-                 $match =~ s/^\s*([^\s,]+)\s*$comma//;
-                 my $new = $1; 
-                 $new_code =~ s/$old/$new/;
-               }
-                $in_line = "$before$new_code$after"; 
-             }
-             else {
-                PrintErrorMessage("Usage of macro &$macro_name does not " .
-                                  "match its definition", $LC); 
-                return "";
+      EXPANSIONLOOP: while () {
+        my $org_in_line = $in_line;
+        for(my $i = $#Macros; $i >= 0; $i--) {
+          my $macro_name = $Macros[$i]->{'macro_name'};
+          if ($in_line =~ /&$macro_name\b/) {       ############################
+            my $num_of_macro_args = @{$Macros[$i]->{'macro_param'}};
+            if ( $num_of_macro_args > 0 ) { 
+            # Macro with parameters
+              my $pattern = "&$macro_name\\(";
+              foreach my $p ( 1..$num_of_macro_args ) {
+                my $comma = ($p == $num_of_macro_args) ? "\\s*" : "\\s*,\\s*";
+                $pattern .= "\\s*[^\\s\\)]+$comma";
+              }
+              $pattern .= "\\)";
+              while($in_line =~ /&$macro_name\b/) {
+                if ($in_line =~ /$pattern/) {   
+                  my $before = $`;
+                  my $after = $';
+                  my $match = $&;
+                  my $new_code = $Macros[$i]->{'macro_code'};
+                  $match =~ s/^&$macro_name\(\s*//;
+                  $match =~ s/\)$//; 
+                  foreach my $arg ( 0..($num_of_macro_args - 1) ) {
+                    my $old = $Macros[$i]->{'macro_param'}->[$arg];
+                    my $comma = ($arg == ($num_of_macro_args - 1)) ? "" : ",";
+                    $match =~ s/^\s*([^\s,]+)\s*$comma//;
+                    my $new = $1; 
+                    # 'g': Parameter may occur several times
+                    # in $new_code.
+                    # '\b': Substitute only whole words
+                    # not x in xA
+                    $new_code =~ s/\b$old\b/$new/g;
+                  }
+                  $in_line = "$before$new_code$after"; 
+                }
+                else {
+                  PrintErrorMessage("Usage of macro &$macro_name does not " .
+                                    "match its definition", $LC); 
+                  return "";
+                }
+              }
+            }
+            else {
+              # Macro without parameters
+              my $replacement = $Macros[$i]->{'macro_code'};
+              # '\b': Substitute only whole words
+              # not x in xA
+              $in_line =~ s/&$macro_name\b/$replacement/g;
             }
-           }
-         }
-         else {
-          my $replacement = $Macros[$i]->{'macro_code'};
-          $in_line =~ s/&$macro_name/$replacement/g;
           }
-        }
-      } 
+        } 
+        last EXPANSIONLOOP if ( $org_in_line eq $in_line );
+      }
       return "$in_line$comment";   
     }
   }
@@ -333,7 +345,7 @@ our $LineThickness = 0.4;
        print OUT "%* -----------------------------------------------\n";
        print OUT "%* mathspic (Perl version $version_number)\n";
        print OUT "%* A filter program for use with PiCTeX\n";
-       print OUT "%* Copyright (c) 2005 A Syropoulos & RWD Nickalls \n";
+       print OUT "%* Copyright (c) 2005-2010 A Syropoulos & RWD Nickalls \n";
        print OUT "%* Command line: $0 $commandLineArgs\n";
        print OUT "%* Input filename : $source_file\n";
        print OUT "%* Output filename: $out_file\n";
@@ -343,7 +355,7 @@ our $LineThickness = 0.4;
        print LOG "----\n";
        print LOG "$now_string\n";
        print LOG "mathspic (Perl version $version_number)\n";
-       print LOG "Copyright (c) 2005 A Syropoulos & RWD Nickalls \n";
+       print LOG "Copyright (c) 2005-2010 A Syropoulos & RWD Nickalls \n";
        print LOG "Input file  = $source_file\n";
        print LOG "Output file = $out_file\n";
        print LOG "Log file    = $log_file\n";
@@ -355,7 +367,7 @@ our $LineThickness = 0.4;
          my ($lc) = $_[0];
          my ($PointName);
 
-         if (s/^([^\W\d_]\d{0,3})\s*//i) { #point name
+         if (s/^([^\W\d_]\d{0,4})\s*//i) { #point name
            $PointName = $1;
            if (!exists($PointTable{lc($PointName)})) {
              PrintErrorMessage("Undefined point $PointName",$lc);
@@ -538,20 +550,20 @@ our $LineThickness = 0.4;
        {
            return ($1, 1);
        }
-       elsif (/^[^\W\d_]\d{0,3}[^\W\d_]\d{0,3}/) #it is a pair of IDs?
+       elsif (/^[^\W\d_]\d{0,4}[^\W\d_]\d{0,4}/) #it is a pair of IDs?
        {
-          s/^([^\W\d_]\d{0,3})//i;
+          s/^([^\W\d_]\d{0,4})//i;
           $v1 = $1;
           if (!exists($PointTable{lc($v1)})) {  
              if (exists($VarTable{lc($v1)})) {
                 return ($VarTable{lc($v1)}, 1);
              }
              PrintErrorMessage("Point $v1 has not been defined", $lc);
-             s/^\s*[^\W\d_]\d{0,3}//i;
+             s/^\s*[^\W\d_]\d{0,4}//i;
              return (0,0);
           }
           $v1 = lc($v1);
-          s/^\s*([^\W\d_]\d{0,3})//i;
+          s/^\s*([^\W\d_]\d{0,4})//i;
           $v2 = $1;
           if (!exists($PointTable{lc($v2)}))
           {
@@ -563,7 +575,7 @@ our $LineThickness = 0.4;
           my ($x2,$y2,$pSV2,$pS2) = unpack("d3A*",$PointTable{$v2});
           return (Length($x1,$y1,$x2,$y2), 1);
        }
-       elsif (s/^([^\W\d_]\d{0,3})//i) # it is a single id
+       elsif (s/^([^\W\d_]\d{0,4})//i) # it is a single id
        {
          $v1 = $1;
          if (!exists($VarTable{lc($v1)})) #it isn't a variable
@@ -810,7 +822,7 @@ our $LineThickness = 0.4;
        DRAWLINES:while(1) {
          @PP = () ;
          while(1) {
-           if (s/^([^\W\d_]\d{0,3})\s*//i) { #point name
+           if (s/^([^\W\d_]\d{0,4})\s*//i) { #point name
              $P = $1;
              if (!exists($PointTable{lc($P)})) {
                PrintErrorMessage("Undefined point $P",$lc);
@@ -1217,7 +1229,7 @@ our $LineThickness = 0.4;
     elsif (s/^-//) { # is it a negated primitive
        $val = - primitive();
     }
-    elsif (s/^\+//) { # is it a negated primitive
+    elsif (s/^\+//) { # is it a positive primitive
        $val = primitive();
     }
     elsif (s/^angledeg//i) {
@@ -1250,7 +1262,7 @@ our $LineThickness = 0.4;
        chk_rparen("Missing right parenthesis", $lc);
     }
     elsif (s/^angle//i) {
-       chk_lparen("angle".$lc);
+       chk_lparen("angle",$lc);
        my $point_1 = get_point($lc);
        my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1});
        my $point_2 = get_point($lc);
@@ -1451,6 +1463,13 @@ our $LineThickness = 0.4;
      return $found;
   }
 
+  sub midpoint {
+    my ($x1, $y1, $x2, $y2)=@_;
+    return ($x1 + ($x2 - $x1)/2, 
+            $y1 + ($y2 - $y1)/2);
+  }
+
+
   sub tand {
     my $d = $_[0];
     $d = $d * PI / 180;
@@ -1709,7 +1728,7 @@ our $LineThickness = 0.4;
                   do{
                     s/\s*//;
                     PrintErrorMessage("no identifier found after token const",$lc)
-                      if $_ !~ s/^([^\W\d_]\d{0,3})//i;
+                      if $_ !~ s/^([^\W\d_]\d{0,4})//i;
                     my $Constname = $1;
                     my $constname = lc($Constname);
                     if (exists $ConstTable{$constname}) {
@@ -2062,7 +2081,7 @@ our $LineThickness = 0.4;
                     }
                     my(@PP);
                     DRAWPOINTS:while(1) {
-                      if (s/^([^\W\d_]\d{0,3})//i) { #point name
+                      if (s/^([^\W\d_]\d{0,4})//i) { #point name
                         $P = $1;
                         if (!exists($PointTable{lc($P)})) {
                           PrintErrorMessage("Undefined point $P",$lc);
@@ -2087,7 +2106,7 @@ our $LineThickness = 0.4;
               my ($cmd) = $1;
               print OUT "%% $cmd$_" if $comments_on;
               
-                   chk_lparen("drawRightAngle",lc);
+                   chk_lparen("drawRightAngle",$lc);
                    my $point1 = get_point($lc);
                    next LINE if $point1 eq "_undef_";
                    my $point2 = get_point($lc);
@@ -2104,34 +2123,23 @@ our $LineThickness = 0.4;
                    #
                    #actual computation
                    #
-                   my $lengthAC = Length($x1, $y1, $x3, $y3);
-                   my $angleBAC = Angle($x2, $y2, $x1, $y1, $x3, $y3);
-                   my $line1 = $lengthAC / (1 + tand($angleBAC));
-                   #
-                   # determine coordinates of point Q
-                   #
-                   my ($xQ, $yQ) = pointOnLine($x1, $y1, $x3, $y3, $line1);
-                   #
-                   # determine coordinates of point S
-                   #
-                   my $deltax = $xQ - $x2;
-                   my $deltay = $yQ - $y2;
-                   my $lengthBQ = sqrt($deltax * $deltax + $deltay * $deltay);
-                   my $xS = $x2 + ($dist * sqrt(2) * $deltax / $lengthBQ);
-                   my $yS = $y2 + ($dist * sqrt(2) * $deltay / $lengthBQ);
-                   #
-                   # determine coordinates of points S1 and S2
-                   #
-                   my ($xS1, $yS1) = pointOnLine($x2, $y2, $x3, $y3, $dist);
-                   ($xS2, $yS2) = ($xS, $yS);
-                   #
-                   # emit PiCTeX code
-                   #
-                   printf OUT "\\plot  %.5f %.5f    %.5f %.5f   /\n",
-                          $xS1, $yS1, $xS2, $yS2;
-                   ($xS1, $yS1) = pointOnLine($x2, $y2, $x1, $y1, $dist);
-                   printf OUT "\\plot  %.5f %.5f    %.5f %.5f   /\n",
-                          $xS1, $yS1, $xS2, $yS2;
+                   my ($Px, $Py) = pointOnLine($x2, $y2, $x1, $y1, $dist);
+                   my ($Qx, $Qy) = pointOnLine($x2, $y2, $x3, $y3, $dist);
+                   my ($Tx, $Ty) = midpoint($Px, $Py, $Qx, $Qy);
+                   my ($Ux, $Uy) = pointOnLine($x2, $y2, $Tx, $Ty, 2*Length($x2, $y2, $Tx, $Ty));
+                   if ($Px == $Ux || $Py == $Uy) {
+                     printf OUT "\\putrule from %.5f %.5f to %.5f %.5f \n", $Px,$Py,$Ux,$Uy;
+                   }
+                   else {
+                     printf OUT "\\plot %.5f %.5f\t%.5f %.5f / \n", $Px, $Py,$Ux,$Uy;
+                   }
+                   if ($Ux == $Qx || $Uy == $Qy) {
+                     printf OUT "\\putrule from %.5f %.5f to %.5f %.5f \n", $Ux,$Uy,$Qx,$Qy;
+                   }
+                   else {
+                     printf OUT "\\plot %.5f %.5f\t%.5f %.5f / \n", $Ux, $Uy,$Qx,$Qy;
+                   }
+
 
            }
            elsif (s/^\s*(drawsquare(?=\W))//i)
@@ -2626,7 +2634,7 @@ our $LineThickness = 0.4;
                    $pointStar = 0; # default value: he have a point command
                    $pointStar = 1 if s/^\*//;
                    chk_lparen("point" . (($pointStar)?"*":""),$lc);
-                   if (s/^([^\W\d_](?![^\W\d_])\d{0,3})//i) {
+                   if (s/^([^\W\d_](?![^\W\d_])\d{0,4})//i) {
                    #
                    # Note: the regular expression (foo)(?!bar) means that we are
                    # looking a foo not followed by a bar. Moreover, the regular
@@ -2693,8 +2701,7 @@ our $LineThickness = 0.4;
                                       chk_rparen("No closing parenthesis found",$lc);
                                       my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint});
                                       my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint});
-                                      $Px = $x1 + ($x2 - $x1)/2;
-                                      $Py = $y1 + ($y2 - $y1)/2;
+                                      ($Px, $Py) = midpoint($x1, $y1, $x2, $y2);
 
                           }
                           elsif (s/^pointonline(?=\W)//i) {
@@ -2773,8 +2780,8 @@ our $LineThickness = 0.4;
                                        chk_rparen("after coordinates part",$lc);
 
                           }
-                          elsif (/^[^\W\d_]\d{0,3}\s*[^,\w]/) {
-                            m/^([^\W\d_]\d{0,3})\s*/i;
+                          elsif (/^[^\W\d_]\d{0,4}\s*[^,\w]/) {
+                            m/^([^\W\d_]\d{0,4})\s*/i;
                             if (exists($PointTable{lc($1)})) {         
                               my $Tcoord = get_point($lc);
                               my ($x,$y,$pSV,$pS)=unpack("d3A*",$PointTable{$Tcoord});
@@ -2787,8 +2794,8 @@ our $LineThickness = 0.4;
                               $Py = expr();
                             }
                           }
-                          elsif (/[^\W\d_]\d{0,3}\s*,\s*shift|polar|rotate|vector/i) { #a point?
-                            s/^([^\W\d_]\d{0,3})//i;
+                          elsif (/[^\W\d_]\d{0,4}\s*,\s*shift|polar|rotate|vector/i) { #a point?
+                            s/^([^\W\d_]\d{0,4})//i;
                             my $PointA = $1;
                             if (exists($PointTable{lc($PointA)})) {
                               s/\s*//;
@@ -3082,14 +3089,14 @@ our $LineThickness = 0.4;
                       $pos="";
                       s/\s*//;
                       
-                        if (/^[^\W\d_]\d{0,3}\s*[^,\w]/) {
+                        if (/^[^\W\d_]\d{0,4}\s*[^,\w]/) {
                           my $Tcoord = get_point($lc);
                           my ($x,$y,$pSV,$pS)=unpack("d3A*",$PointTable{$Tcoord});
                           $Px = $x;
                           $Py = $y;
                         }
-                        elsif (/[^\W\d_]\d{0,3}\s*,\s*shift|polar/i) {
-                          s/^([^\W\d_]\d{0,3})//i;
+                        elsif (/[^\W\d_]\d{0,4}\s*,\s*shift|polar/i) {
+                          s/^([^\W\d_]\d{0,4})//i;
                           my $PointA = $1;
                           if (exists($PointTable{lc($PointA)})) {
                             s/\s*//;
@@ -3213,7 +3220,7 @@ our $LineThickness = 0.4;
                   do{
                     s/\s*//;
                     PrintErrorMessage("no identifier found after token var",$lc)
-                      if $_ !~ s/^([^\W\d_]\d{0,3})//i;
+                      if $_ !~ s/^([^\W\d_]\d{0,4})//i;
                     my $Varname = $1;
                     my $varname = lc($Varname);
                     if (exists $ConstTable{$varname}) {
@@ -3279,7 +3286,7 @@ else {
              "Usage:\tmathspic  [-h] [-b] [-c] [-o <out file>] <in file>\n" . 
              "\twhere,\n" . 
              "\t[-b]\tenables bell sound if error exists\n" .
-             "\t[-c]\tdisables comments in ouput file\n" .
+             "\t[-c]\tdisables comments in output file\n" .
              "\t[-h]\tgives this help listing\n" .
              "\t[-o]\tcreates specified output file\n\n"; 
        }
@@ -3300,7 +3307,7 @@ else {
        else {
          $file = $_;
        }
-     }
+     }my ($xA, $yA, $xB, $yB, $dist)=@_;
      die "No input file specified!\n" if $file eq "";
 
   print "This is mathspic version $version_number\n";
diff --git a/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl b/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl
index 8f0065442c8..f6cfb8ff1fc 100755
--- a/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl
+++ b/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl
@@ -1,12 +1,12 @@
 #!/usr/bin/env perl
-# $Id: tlmgr.pl 23420 2011-08-05 06:27:04Z preining $
+# $Id: tlmgr.pl 23514 2011-08-12 21:36:21Z karl $
 #
 # Copyright 2008, 2009, 2010, 2011 Norbert Preining
 # This file is licensed under the GNU General Public License version 2
 # or any later version.
 
-my $svnrev = '$Revision: 23420 $';
-my $datrev = '$Date: 2011-08-05 08:27:04 +0200 (Fri, 05 Aug 2011) $';
+my $svnrev = '$Revision: 23514 $';
+my $datrev = '$Date: 2011-08-12 23:36:21 +0200 (Fri, 12 Aug 2011) $';
 my $tlmgrrevision;
 if ($svnrev =~ m/: ([0-9]+) /) {
   $tlmgrrevision = $1;
@@ -5598,8 +5598,8 @@ postinstallation action code.  It is set by default, and again disabling
 is not likely to be of interest except perhaps to developers.
 
 The C<docfiles> and C<srcfiles> options control the installation of
-their respective files of a package. By default both are enabled.  This
-can be disabled if disk space is (very) limited.
+their respective files of a package. By default both are enabled (1).
+This can be disabled (set to 0) if disk space is (very) limited.
 
 The options C<autobackup> and C<backupdir> determine the defaults for
 the actions C<update>, C<backup> and C<restore>.  These three actions
@@ -5630,7 +5630,7 @@ The C<sys_bin>, C<sys_man>, and C<sys_info> options are used on
 Unix-like systems to control the generation of links for executables,
 info files and man pages. See the C<path> action for details.
 
-For the <generate_updmap> option, see the C<updmap> section in
+For the C<generate_updmap> option, see the C<updmap> section in
 L<generate|/"generate [I<option>]... I<what>">.
 
 The last three options control behaviour on Windows installations.  If
@@ -5644,14 +5644,13 @@ instead of only the current user.  All three options are on by default.
 
 =head2 conf [texmf|tlmgr [I<key> [I<value>]]]
 
-With only the C<conf>, show general configuration information for TeX
-Live, including active configuration files, path settings, and more.
-This is like the C<texconfig conf> call, but works on all supported
-platforms.
+With only C<conf>, show general configuration information for TeX Live,
+including active configuration files, path settings, and more.  This is
+like the C<texconfig conf> call, but works on all supported platforms.
 
-With either C<texmf> or C<tlmgr> given in addition, shows all key/value
-pairs (i.e., all settings) as saved in C<ROOT/texmf.cnf> or the tlmgr
-configuration file (see below), respectively.
+With either C<conf texmf> or C<conf tlmgr> given in addition, shows all
+key/value pairs (i.e., all settings) as saved in C<ROOT/texmf.cnf> or
+the tlmgr configuration file (see below), respectively.
 
 If I<key> is given in addition, shows the value of only that given
 I<key> in the respective file.
@@ -5665,7 +5664,7 @@ it afterwards:
   
   tlmgr conf texmf shell_escape 0
 
-B<WARNING:> The general facility is here, but tinkering with settings in
+Warning: The general facility is here, but tinkering with settings in
 this way is very strongly discouraged.  Again, no error checking is
 done, so any sort of breakage is possible.