PrettyPattern:
PROC[
pps: PPS, t: Tree.Link, pattern: Rope.Text, level, pos: NAT𡤀, enable: BOOL←TRUE]
RETURNS[NAT] ~ {
This procedure takes care of expanding formatting patterns
The '% character is used to denote the start of an expansion
The characters following the % character are decoded specially, as follows:
(the following options are interpreted regardless of the enable flag)
(n: start a new recursion level, saving context, using son n
[n: start iteration over son n (wants separator character before n)
): return from current level, should pair with '(
]: end of iteration, should pair with '[
(the following options are interpreted only when enable is true)
0..9: expand the Nth son (where NthSon[t, 0] = t)
,n: expand list using son n, ', separator, default no break
;n: expand list using son n, '; separator, default break
.n: expand list using son n, ', separator, default break
:n: expand list using son n, '; separator, default no break
?n: enable ← Nth son # NIL
~?n: enable ← Nth son = NIL
|: break if remainder of pattern will exceed margin
*: same as %+2%|%@
^n: break if break hint between t and son n, or remainder exceeds margin
+n: pps.indent ← MIN[original indent + n, position]
/n: flush comments before son n, then break
@: indent ← position
!: exit entire pattern
all other characters following % are written literally
size: Index ~ (IF pattern = NIL THEN 0 ELSE pattern.Length);
GetSon:
PROC
RETURNS[Tree.Link] ~ {
n: NAT ~ GetNum[];
RETURN [
SELECT n
FROM
0 => t,
> nSons => Tree.null,
ENDCASE => TreeOps.NthSon[t, n]]
};
GetChar:
PROC
RETURNS[c:
CHAR] ~
INLINE {
IF pos >= size THEN RETURN['%];
c ← pattern[pos];
GetNum:
PROC
RETURNS[
NAT] ~
INLINE {
IF pos >= size THEN RETURN[0]
ELSE {
nc: CHAR ~ pattern[pos];
IF nc IN ['0..'9] THEN {pos ← pos+1; RETURN[nc.ORD - '0.ORD]};
RETURN[0]};
};
nSons: NAT ← 0;
oldIndent: NAT ~ pps.indent;
oldLevel: NAT ~ level;
oldLine: INT ~ pps.line;
WITH t
SELECT
FROM
node: Tree.Handle => nSons ← node.sonLimit-1;
ENDCASE;
WHILE pos < size
DO
c: CHAR ← GetChar[];
IF c # '% THEN {IF enable THEN WriteChar[pps, c]}
ELSE
SELECT (c ← GetChar[])
FROM
'), '] => EXIT;
'( => pos ← PrettyPattern[pps, GetSon[], pattern, level, pos, enable];
'[ => {
-- looping construct
term: CHAR ~ GetChar[];
link: Tree.Link ← GetSon[];
lenb: BOOL ~ (enable AND link # Tree.null);
IF lenb
-- AND TreeOps.Opname[link] = $list--
THEN {
node: Tree.Handle ~ NARROW[link];
nls: NAT ~ node.sonLimit - 1;
FOR i:
NAT
IN [1 .. nls-1]
DO
[] ← PrettyPattern[pps, node[i], pattern, 0, pos];
WriteChar[pps, term]
ENDLOOP;
link ← node[nls]};
pos ← PrettyPattern[pps, link, pattern, 0, pos, lenb]};
ENDCASE =>
IF enable
THEN
SELECT c
FROM
'0, '1, '2, '3, '4, '5, '6, '7, '8, '9 => {
pos ← pos - 1; PrettyLink[pps, GetSon[], 0, level]};
'?, '~ => {
IF c = '~ THEN {c ← GetChar[]; enable ← FALSE};
SELECT c
FROM
'? => IF GetSon[] = Tree.null THEN enable ← ~enable;
ENDCASE => enable ← FALSE
};
';, ',, '., ': => PrettyList[pps, GetSon[], c];
'| =>
IF pps.position > pps.indent
AND WillExceed[pps, t, pattern, level, pos, TRUE] THEN Break[pps];
'* => {
pps.indent ← MIN[oldIndent + 2, pps.position];
IF pps.position > pps.indent
AND WillExceed[pps, t, pattern, level, pos, TRUE] THEN Break[pps];
pps.indent ← pps.position};
'^ =>
IF pps.position > pps.indent
THEN {
link: Tree.Link ← GetSon[];
IF link # Tree.null
THEN {
start: Index ~ GetInfo[t];
next: Index ~ GetInfo[link];
IF pps.position > pps.earlyTrigger
OR (start # 0
AND next > start
AND (pps.comments # NIL AND (pps.comments).TestBreakHint[start, next]))
OR WillExceed[pps, t, pattern, level, pos,
TRUE]
THEN {
FlushCommentsBefore[pps, next]; Break[pps]}
}
};
'/, '= => {FlushCommentsBefore[pps, GetInfo[GetSon[]]]; IF c = '/ THEN Break[pps]};
'$ => level ← GetNum[];
'! => {pos ← pos - 2; EXIT};
'@ => pps.indent ← MAX[pps.position, pps.indent];
'+ => pps.indent ← MIN[oldIndent + GetNum[], pps.position];
ENDCASE => WriteChar[pps, c];
ENDLOOP;
pps.indent ← oldIndent;
level ← oldLevel;