X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;f=gpt;h=6bb3a4ea7ac11519531373ad72368d72d6f14b16;hb=fa7c784e4c52cf706b0abe47faf51a8dc33b7d53;hp=c50443ad910460820896cf4758290a40d896ce07;hpb=4fd494a89f036948677ae8ed3b4ea9ad1f1ad90f;p=ian-dotfiles.git

diff --git a/gpt b/gpt
index c50443a..6bb3a4e 100755
--- a/gpt
+++ b/gpt
@@ -1,5 +1,56 @@
 #!/usr/bin/perl
 
+#
+#                          =====deeper=nesting===>>
+#
+#                     end of Perl fragment
+#                      \n@@ \_@@  ;@@ )@@ }@@  \w@@
+#                   <------------------------------------
+#
+#                   ------------------------------------>
+#                      if    eval    eval+     eval+
+#                       @@?   @@\_   ignore    include
+#                             @@$     @@-      file
+#    ___                      @@\n              @@<
+#  ,'   `
+#  |      processing                                       processing
+#  `--->  as TEXT                                          as PERL
+#  endif
+#   @@;     vA      <------------------------------------
+#           ||         then
+#   comment ||          ?@@
+#       @@# ||
+#           ||       included text fragment as
+#      else ||         string value    code to write out
+#       @@: ||          (@@             {@@
+#           ||      <------------------------------------
+#           `'
+#                   ------------------------------------>
+#                     end of included text fragment
+#                       @@)  @@}
+#
+#                          <<====deeper=nesting====
+#
+
+# gpt - a generic preprocessing tool
+#  
+#  This file is
+#    Copyright (C) 2001 Ian Jackson <ian@davenant.greenend.org.uk>
+#  
+#  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, 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 
+
 package GenericPrepTemplate;
 
 #BEGIN {
@@ -19,7 +70,7 @@ use IO::File;
 
 open DEBUG, ">/dev/null" or die "gpt: /dev/null: $!\n";
 
-while (@main::ARGV =~ m/^-/) {
+while ($main::ARGV[0] =~ m/^-/) {
     $_= shift @main::ARGV;
     next if m/^--$/;
     while (m/^-./) {
@@ -41,15 +92,19 @@ if (!@main::ARGV) {
 } else {
     for ($i=0; $i<@main::ARGV; $i++) {
 	$lno= '<arg#'.($i+1).'>';
-	$value= $main::ARGV[$i];
-	$fh= new IO::File $value,'r' or err("cannot open file \`$value': $!");
-	process_fh($fh,$value);
-	$fh->close or err("gpt: cannot close file \`$value': $!");
+	process_file($main::ARGV[$i]);
     }
 }
 close STDOUT or die "gpt: close stdout: $!\n";
 exit 0;
 
+sub process_file ($) {
+    my ($value) = @_;
+    $fh= new IO::File $value,'r' or err("cannot open file \`$value': $!");
+    process_fh($fh,$value);
+    $fh->close or err("gpt: cannot close file \`$value': $!");
+}
+
 sub err ($) { die "gpt: $fn:$lno: $_[0]\n"; }
 
 sub add_perl ($) {
@@ -82,17 +137,22 @@ sub eval_expr () {
 sub process_input () {
     my ($esc,$top,$want,$fh,$value,$wasyes);
     while (length $l) {
-	print DEBUG "L $fn:$lno:",join('',@oplist),
-	            ":`$l' e\`$expr' s\`$substr'\n";
+	print DEBUG "L $fn:${lno}_",join('',@oplist),
+	            "_`$l' e\`$expr' s\`$substr'\n";
 	if (@oplist & 1) { # scanning perl
-	    if ($l =~ m/(.)\@\@/m || $l =~ m/^()\@\@/m) {
+	    if ($l =~ m/^()\@\@/ || $l =~ m/([^\000])\@\@/) {
 		($to,$op,$esc,$l) = ($`,$1,$&,$');
 		add_perl($to);
-		if ($op =~ m/[ 0-9a-zA-Z_\;\)\}?]/ || $op eq '') {
+		if ($op =~ m/[ \t\n0-9a-zA-Z_\;\)\}?]/ || $op eq '') {
 		    $top= pop @oplist;
+		    if ($top eq '?') {
+			$op eq '?' or err("expected ?\@\@, got \@\@");
+		    } else {
+			$op ne '?' or err("found ?\@\@ not after \@\@?");
+		    }
 		    if (!@oplist) {
 			# And evaluate.
-			$expr.= $op unless $op =~ m/[?]/;
+			$expr.= $op unless $op eq '?';
 			$value= eval_expr();
 			if ($top eq '<') {
 			    process_file($value);
@@ -119,8 +179,12 @@ sub process_input () {
 	    if ($l =~ m/\@\@(.|\n)/) {
 		($to,$op,$esc,$l) = ($`,$1,$&,$');
 		add_text($to);
-		if ($op =~ m/[-< \$?]/) {
-		    $substr.= $esc if @oplist;
+		if ($op =~ m/[-< \$?\n]/) {
+		    if (!@oplist) {
+			add_perl($op) if $op =~ m/[\$]/;
+		    } else {
+			$substr.= $esc;
+		    }
 		    push @oplist, $op;
 		} elsif ($op =~ m/[\)\}\;\:]/) {
 		    err("unmatched closing \@\@$op") unless @oplist;
@@ -160,6 +224,8 @@ sub process_input () {
 		    } else {
 			$substr.= $esc;
 		    }
+		} elsif ($op eq '#') {
+		    $l =~ s/^[^\n]*//; $l =~ s/^\n//;
 		} else {
 		    err("bad escape sequence \@\@$op in text part");
 		}
@@ -171,6 +237,26 @@ sub process_input () {
     }
 }
 
+sub close_nesteds () {
+    my ($op);
+    while (@oplist) {
+	$op= $oplist[$#oplist];
+	if (@oplist & 1) {
+	    err("unterminated \@\@?") if $op eq '?';
+	    $l=' @@';
+	} else {
+	    if ($op =~ y/({/)}/) {
+		$l= '@@'.$op;
+	    } elsif ($op =~ m/^[;:]+/) {
+		$l= '@@;';
+	    } else {
+		die "intern /@oplist/";
+	    }
+	}
+	process_input();
+    }
+}
+
 sub process_fh ($$) {
     local ($fh,$fn) = @_;
     local ($l,$lno, @oplist,$substr,$expr,$to,$op);
@@ -180,7 +266,9 @@ sub process_fh ($$) {
 	$lno= $.;
 	process_input();
     }
+    
     die "gpt: $fn: read error: $!" if $fh->error;
+    close_nesteds();
 }
 
 sub output ($) {
@@ -199,5 +287,6 @@ sub process_i ($) {
     local ($outbuf, @oplist,$substr,$expr,$to,$op);
     $outbuf='';
     process_input();
+    close_nesteds();
     return $outbuf;
 }