summaryrefslogtreecommitdiff
path: root/web/glasgow/lit2x-0.16/literate/lit-2pgm.lprl
blob: 5ce12b7a04f6e0c52f7fb39924f7873cc58e2ccd (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
\section[lit2pgm_only]{Code only for \tr{lit2pgm}}

\begin{code}
sub spit_out_ribbons_code {
    local(@Ribbons_to_get) = @_;
    local($r);
    print STDERR "spitting code for ribbons @Ribbons_to_get\n" if $Debugging;

    foreach $r (@Ribbons_to_get) {
        local(@ribbon_blk_nos) = split(/,/,$Ribbon_blks{$r});
        local($b);
        foreach $b (@ribbon_blk_nos) {
	    print &mk_line_directive($Blk_srcfile_name[$b],$Blk_srcfile_lineno[$b]);

	    if ($Blk_txt[$b] !~ /\\insertribbon/) {
		# safe to just go "dump"...
		# de-Birdize the code block; urgh
		$* = 1; # multiline matches...
		$Blk_txt[$b] =~ s/^>//g;
		$* = 0; # back to one-line matches...
		print $Blk_txt[$b];

	    } else { # gotta look around...
		local(@blk_txt_lns) = split(/\n/,$Blk_txt[$b]);
		local($l, $called_ribbon);

		local($i) = 0;
		foreach $l (@blk_txt_lns) {
		    if ($l =~ /^\s*\\insertribbon\{(.*)\}\s*$/) { # must be alone on line
			$called_ribbon = $1;
			if (! $Ribbon_blks{$called_ribbon}) {
			    &not_OK($Blk_srcfile_name[$b],($Blk_srcfile_lineno[$b]+$i),
				"no code found for ribbon: $called_ribbon\n");

			} else { # recurse...
			    &spit_out_ribbons_code($called_ribbon);
			}
		    } else {
			# de-Birdize the code line...
			$l =~ s/^>//;
			print "$l\n";
		    }
		    $i++;
		}
	    }
        }
    }
}

# a trailing 1 seems to be the habit for inc'd perl files
1;
\end{code}