#!/usr/bin/perl # re -- reference-based literate programming system use strict; use warnings; use POSIX::Regex qw/:all/; my $bytes; my $count; my %bytes; # file => current byte my %file_locations; # file => [location, ...] my %files; # byte => file my %handles; # file => handle my %lines; # file => current line my %locations; # byte => location (i.e. byte in source file) my @references; die "usage: $0 file\n" if @ARGV != 1; open my $fh, '<', $ARGV[0] or die "could not open $ARGV[0]: $!\n"; # collect references $bytes = 0; while (<$fh>) { $bytes += length($_); push @references, [$bytes, $1] if /^\.\s*Re\s+(.*)/; } # find referenced locations for (@references) { my ($bytes, $ref) = @$_; my $loc = -1; goto invalid if not $ref =~ /^([^:]+):(.*)/; my ($file, $ident) = ($1, $2); if (not exists $handles{$file}) { open my $fh, '<', $file or die "could not open $file: $!\n"; $handles{$file} = $fh; $bytes{$file} = 0; $lines{$file} = 0; } if ($ident =~ /^(\d+)$/) { my $line = $1; if ($ident <= $lines{$file}) { seek $handles{$file}, 0, 0; $bytes{$file} = 0; $lines{$file} = 0; } local $_; while ($_ = readline $handles{$file}) { $lines{$file}++; if ($lines{$file} == $line) { $loc = $bytes{$file}; last; } $bytes{$file} += length($_); } } elsif ($ident =~ m{^/(.*)/$}) { my $rx = new POSIX::Regex($1); seek $handles{$file}, 0, 0; $bytes{$file} = 0; $lines{$file} = 0; local $_; while ($_ = readline $handles{$file}) { $lines{$file}++; if ($rx->match($_)) { $loc = $bytes{$file}; last; } $bytes{$file} += length($_); } } else { goto invalid; } die "could not find location $ident in $file\n" if $loc == -1; $locations{$bytes} = $loc; $files{$bytes} = $file; if (exists $file_locations{$file}) { push @{$file_locations{$file}}, $loc; } else { $file_locations{$file} = []; } next; invalid: die "invalid syntax: $ref at $bytes\n"; } # intertwine seek $fh, 0, 0; $bytes = 0; $count = 0; while (<$fh>) { $bytes += length($_); goto normal if not @references; my $ref_bytes = $references[0][0]; if ($bytes == $ref_bytes) { shift @references; my $file = $files{$bytes}; my $end = shift @{$file_locations{$file}} || ''; my $loc = $locations{$bytes}; print ".Sr $file $loc-$end\n"; seek $handles{$file}, $loc, 0; local $_; my $bytes = $loc; while ($_ = readline $handles{$file}) { $bytes += length($_); last if $end and $bytes > $end; /^(\s+)/; my $indent = $1; my $max = 64; for (split //, $indent) { $max -= 7 if /\t/; } s/(.{$max})(.{6,})/$1\\fR...\\fP\n$indent\t$2/g; s/\\/\\\\/g; s/\\\\fR...\\\\fP/\\fR...\\fP/g; s/^\./\\&./m; print; } print ".Se\n"; next; } normal: print; } close $_ for values %handles; close $fh;