Reverted back to state as of r1062. The template haskell changes

are more trouble than they're worth.


git-svn-id: https://pandoc.googlecode.com/svn/trunk@1064 788f1e2b-df1e-0410-8736-df70ead52e1b

1 files changed, 131 insertions, 0 deletions

diff --git a/src/templates/fillTemplates.pl b/src/templates/fillTemplates.pl
new file mode 100755
index 000000000..85e6eaa18
--- /dev/null
+++ b/src/templates/fillTemplates.pl
@@ -0,0 +1,131 @@
+#!/usr/bin/env perl
+# Fills templates with haskell-escaped strings slurped from input files.
+# Takes two arguments, the first specifying the pathname of the target
+# relative to the root directory, the second specifying the root directory
+# (defaulting to ..).  The template is assumed to have the same base name
+# as the target and to reside in the templates subdirectory of the root
+# directory.
+
+use strict;
+use warnings;
+
+# Utility routines:
+
+sub slurp {
+    open FILE, $_[0] or die "couldn't open file '$_[0]': $!";
+    my $contents = do { local $/; <FILE>;};
+    close FILE;
+    return $contents;
+}
+
+sub escape_for_haskell {
+    my ($contents) = @_;
+
+    $contents =~ s/\\/\\\\/g;
+    $contents =~ s/\t/\\t/g;
+    $contents =~ s/"/\\"/g;
+    $contents =~ s/\n/\\n/g;
+    return $contents;
+}
+
+# Template processors.
+
+my %processor = (
+    # --------------------------------------------------------------------------
+    'Text/Pandoc/Writers/S5.hs' => {
+    # --------------------------------------------------------------------------
+	proc     => sub {
+	    my ($template) = @_;
+
+        my (@files) = qw(slides.js s5-core.css framing.css pretty.css 
+                         opera.css outline.css print.css);
+
+        foreach my $file (@files) {
+	        my $replacement = escape_for_haskell(slurp "ui/default/$file");
+            my $escapedfile = $file;
+            $escapedfile =~ s/\./\\./g;
+            $template =~ s/\@$escapedfile\@/$replacement/;
+        } 
+	    return $template;
+	},
+    },
+    # --------------------------------------------------------------------------
+    'Text/Pandoc/ASCIIMathML.hs' => {
+    # --------------------------------------------------------------------------
+	proc     => sub {
+	    my ($template) = @_;
+
+	    my $script = escape_for_haskell(slurp "ASCIIMathML.js"); 
+	    my $acknowledgements =
+		" ASCIIMathML.js - copyright Peter Jipsen,".
+		" released under the GPL\\nSee ".
+		"http://www1.chapman.edu/~jipsen/mathml/asciimath.html/ ";
+	    $script =~ s/\/\*.*?\*\//\/\*$acknowledgements\*\//g; # strip comments
+	    $template =~ s/\@ASCIIMathML\.js@/$script/;
+
+	    return $template;
+	},
+    },
+    # --------------------------------------------------------------------------
+    'Text/Pandoc/Writers/DefaultHeaders.hs' => {
+    # --------------------------------------------------------------------------
+	proc     => sub {
+	    my ($template) = @_;
+
+        my (@headers) = split(/\s/,`ls headers`);
+        foreach my $header (@headers) {
+           my ($replacement) = escape_for_haskell(slurp "headers/$header");
+           $template =~ s/\@$header\@/$replacement/;
+        }
+	    
+	    return $template;
+	},
+    },
+    # --------------------------------------------------------------------------
+    # 'foo/bar/baz' => {
+    # --------------------------------------------------------------------------
+    #    template => 'optional-template-filename-defaults-to-baz'
+    #    proc     => sub {
+    # 	    my ($template) = @_;
+    # 	    # Process.
+    # 	    return $template;
+    #    },
+    #},
+);
+
+# Main.
+
+my $target = shift @ARGV;
+if (!defined $target || !length $target) {
+	print STDERR "Available targets:\n\n" . join "\n", keys %processor;
+	die "\n\nYou must supply a target!\n";
+}
+
+die "No processor exists for '$target'!\n" if ! exists $processor{$target};
+
+my $rootdir = shift @ARGV || '..';
+chdir $rootdir or die "Couldn't chdir to '$rootdir': $!";
+
+my $template;
+if (exists $processor{$target}->{template}) {
+   $template = $processor{$target}->{template};
+}
+else {
+    ($template = $target) =~ s!.*/+!!;
+}
+$template = "templates/$template";
+die "No template exists for '$target'!\n" if ! -f "$template";
+
+open OUTFILE, ">$target" or die "couldn't open file '$target': $!";
+print OUTFILE <<END;
+----------------------------------------------------
+-- Do not edit this file by hand.  Edit 
+-- '$template'
+-- and run $0 $target
+----------------------------------------------------
+
+END
+
+print OUTFILE $processor{$target}->{proc}->(slurp($template));
+print OUTFILE "\n";
+close OUTFILE;