TermCapsImpl:
CEDAR
PROGRAM
IMPORTS Ascii, BasicTime, Convert, FS, IO, OrderedSymbolTableRef, Real, Rope
EXPORTS TermCaps
= {OPEN TermCaps;
cancel: PUBLIC Val ¬ NEW [ROPE ¬ "cancel"];
Bitch: SIGNAL [fmt: ROPE, v1: IO.Value ¬ [null[]]] = CODE;
Busted: ERROR = CODE;
termCaps: SymbolTable ¬ NIL;
defaultTerm: Term ¬ NIL;
EnumerateCaps:
PUBLIC
PROC [term: Term, consume:
PROC [cap: Cap]
RETURNS [stop:
BOOL]] = {
ExceptNone: PROC [cap: Cap] RETURNS [e: BOOL] = {e ¬ FALSE};
Work:
PROC [term: Term, except:
PROC [cap: Cap]
RETURNS [
BOOL]] = {
ExceptMine:
PROC [cap: Cap]
RETURNS [e:
BOOL] = {
IF term.caps.Lookup[cap] # NIL THEN RETURN [TRUE];
e ¬ except[cap]};
PerCap:
PROC [ra:
REF
ANY]
RETURNS [stop:
BOOL] = {
cap: Cap ¬ NARROW[ra];
stop ¬ FALSE;
IF cap.val = cancel THEN RETURN;
IF except[cap] THEN RETURN;
stop ¬ consume[cap];
};
term.caps.EnumerateIncreasing[PerCap];
IF term.default # NIL THEN Work[term.default, ExceptMine];
};
Work[term, ExceptNone];
};
GetCap:
PUBLIC
PROC [term: Term, name:
ROPE, default: Val ¬
NIL]
RETURNS [val: Val] = {
cap: Cap ¬ NARROW[term.caps.Lookup[name]];
IF cap # NIL THEN RETURN [IF cap.val = cancel THEN default ELSE cap.val];
IF term.default # NIL THEN val ¬ GetCap[term.default, name, default] ELSE val ¬ default;
};
GetTerm:
PUBLIC
PROC [tc: TermCap, name:
ROPE]
RETURNS [term: Term] = {
term ¬ AntiAlias[tc.contents.Lookup[name]];
};
TCTerm:
PROC [tc: TermCap, name:
ROPE]
RETURNS [term: Term] = {
term ¬ AntiAlias[tc.contents.Lookup[name]];
IF term =
NIL
THEN {
a: Alias ¬
NEW [AliasRep ¬ [
name: name,
val: term ¬
NEW [TermRep ¬ [
names: LIST[name],
caps: OrderedSymbolTableRef.CreateTable[CompareCaps],
default: defaultTerm]]
]];
tc.contents.Insert[a];
};
};
EnumerateTerms:
PUBLIC
PROC [tc: TermCap, consume:
PROC [term: Term]
RETURNS [stop:
BOOL]] = {
PerAlias:
PROC [ra:
REF
ANY]
RETURNS [stop:
BOOL] = {
a: Alias ¬ NARROW[ra];
IF NOT (a.name = a.val.names.first) THEN RETURN [FALSE];
stop ¬ consume[a.val];
};
tc.contents.EnumerateIncreasing[PerAlias];
};
GetTermCap:
PUBLIC
PROC [fileName:
ROPE, wDir:
ROPE ¬
NIL]
RETURNS [tc: TermCap] = {
gName: ROPE;
created: GMT;
exists: BOOL ¬ TRUE;
rfi: REF FileID;
from: IO.STREAM;
[fullFName: gName, created: created] ¬ FS.FileInfo[name: fileName, wDir: wDir !FS.Error => {exists ¬ FALSE; CONTINUE}];
IF NOT exists THEN RETURN [NIL];
rfi ¬ NEW [FileID ¬ [gName, created]];
tc ¬ NARROW[termCaps.Lookup[rfi]];
IF tc # NIL THEN RETURN [tc];
tc ¬
NEW [TermCapRep ¬ [
fileID: rfi,
contents: OrderedSymbolTableRef.CreateTable[CompareTerms]
]];
from ¬ FS.StreamOpen[gName];
termCaps.Insert[tc];
ParseTermCap[from, tc !
Bitch => {
tc.complaints ¬ tc.complaints.Cat[
IO.PutFR[
Rope.Cat["At %g[%g]: ", fmt, "\n"],
IO.rope[gName],
IO.int[from.GetIndex[]],
v1]
];
RESUME;
};
IO.EndOfStream => CONTINUE;
];
};
ParseTermCap:
PROC [from:
IO.
STREAM, tc: TermCap] = {
atStart: BOOL ¬ TRUE;
DO
ENABLE Busted => {Bitch["busted"]; LOOP};
term: Term ¬ NIL;
names: RopeList ¬ NIL;
nameCount: NAT ¬ 0;
bestName: ROPE ¬ NIL;
First, look for begin of entry: a line starting with alphabetic
DO
char: CHAR;
IF atStart THEN atStart ¬ FALSE ELSE [] ¬ from.GetLineRope[];
char ¬ from.PeekChar[];
SELECT char
FROM
IN ['a .. 'z], IN ['A .. 'Z] => EXIT;
ENDCASE;
ENDLOOP;
Next, parse names
DO
name, sep: ROPE;
namedTerm: Term;
name ¬ from.GetTokenRope[TermNameBuster].token;
IF name.Equal["|"] THEN {Bitch["empty name"]; LOOP};
IF name.Equal[":"] THEN {Bitch["empty name"]; EXIT};
nameCount ¬ nameCount + 1;
IF nameCount <= 2 THEN bestName ¬ name;
namedTerm ¬ GetTerm[tc, name];
IF namedTerm = term THEN NULL
ELSE IF term = NIL THEN term ¬ namedTerm
ELSE IF namedTerm # NIL THEN Bitch["term name collision on %g", IO.rope[name]];
IF namedTerm = NIL THEN names ¬ CONS[name, names];
sep ¬ from.GetTokenRope[TermNameBuster].token;
IF sep.Equal[":"] THEN EXIT;
IF NOT sep.Equal["|"] THEN ERROR;
ENDLOOP;
IF term =
NIL
THEN term ¬
NEW [TermRep ¬ [
caps: OrderedSymbolTableRef.CreateTable[CompareCaps],
default: defaultTerm
]];
term.bestName ¬ bestName;
FOR names ¬ names, names.rest
WHILE names #
NIL
DO
a: Alias ¬ NEW [AliasRep ¬ [names.first, term]];
term.names ¬ CONS[names.first, term.names];
tc.contents.Insert[a !OrderedSymbolTableRef.DuplicateKey => {
CONTINUE--can only collide with same term--}];
ENDLOOP;
Finally, parse capabilities
DO
capName: ROPE;
cap: Cap;
cancelIt: BOOL ¬ FALSE;
char: CHAR;
Ignore end-of-line?
IF from.PeekChar[] = '\\
THEN {
char: CHAR;
IF (char ¬ from.GetChar[]) # '\\ THEN ERROR;
IF NOT White[from.PeekChar[]] THEN Busted[];
[] ¬ from.SkipWhitespace[];
IF (char ¬ from.GetChar[]) # ': THEN Busted[];
LOOP;
};
IF White[from.PeekChar[]] THEN EXIT--done with caps--;
capName ¬ from.GetTokenRope[CapNameBuster].token;
IF capName.Length[] = 1 THEN Busted[];
cap ¬ NEW [CapRep ¬ [capName, NIL]];
char ¬ from.GetChar[];
IF char = '@
THEN {
cancelIt ¬ TRUE;
char ¬ from.GetChar[];
};
SELECT char
FROM
': => cap.val ¬ NEW [BOOL ¬ TRUE];
'# => {
cap.val ¬ NEW [INT ¬ from.GetInt[!IO.Error => Busted[]]];
IF from.GetChar[] # ': THEN Busted[];
};
'= => cap.val ¬ ParseString[from];
ENDCASE => Busted[];
IF cancelIt THEN cap.val ¬ cancel;
IF cap.name.Equal["tc"]
THEN {
defName: String ¬ NIL;
default: Term;
WITH cap.val
SELECT
FROM
s: String => defName ¬ s;
ENDCASE => defName ¬ NIL;
IF defName = NIL THEN Bitch["tc not a string"]
ELSE {
default ¬ defaultTerm;
IF defName.str.Length[] > 0 THEN default ¬ TCTerm[tc, defName.str]
ELSE {
i: INT ¬ Real.RoundLI[defName.pad];
IF i # 0
THEN {
name: ROPE ¬ Convert.RopeFromInt[i];
default ¬ TCTerm[tc, name]
};
};
term.default ¬ default
};
}
ELSE {
term.caps.Insert[cap !OrderedSymbolTableRef.DuplicateKey =>
CONTINUE --left value overrides right--];
};
ENDLOOP;
ENDLOOP;
};
TermNameBuster:
PROC [char:
CHAR]
RETURNS [cc:
IO.CharClass]
--IO.BreakProc-- = {
cc ¬
SELECT char
FROM
'|, ': => break,
ENDCASE => other};
CapNameBuster:
PROC [char:
CHAR]
RETURNS [cc:
IO.CharClass]
--IO.BreakProc-- = {
cc ¬
SELECT char
FROM
':, '#, '=, '@ => break,
IN [0C .. Ascii.SP] => sepr,
ENDCASE => other};
White:
PROC [c:
CHAR]
RETURNS [white:
BOOL] =
{white ¬ c IN [0C .. Ascii.SP]};
Numeric:
PROC [c:
CHAR]
RETURNS [numeric:
BOOL] =
{numeric ¬ (c IN ['0 .. '9]) OR (c = '.)};
ParseString:
PROC [from:
IO.
STREAM]
RETURNS [s: String] = {
padChars, strVal: ROPE ¬ NIL;
char: CHAR;
dotSeen, proportional: BOOL ¬ FALSE;
FOR char ¬ from.PeekChar[], from.PeekChar[]
WHILE Numeric[char]
DO
IF from.GetChar[] # char THEN ERROR;
IF char = '. THEN dotSeen ¬ TRUE;
padChars ¬ padChars.Cat[Rope.FromChar[char]];
ENDLOOP;
IF from.PeekChar[] = '*
THEN {
IF from.GetChar[] # '* THEN ERROR;
proportional ¬ TRUE};
DO
char ¬ from.GetChar[];
IF char = ': THEN EXIT;
SELECT char
FROM
'^ => {char ¬ from.GetChar[];
char ¬ Ascii.Control[char]};
'\\ => {char ¬ from.GetChar[];
SELECT char
FROM
'E => char ¬ Ascii.ESC;
'n => char ¬ '\012;
'r => char ¬ '\015;
't => char ¬ '\t;
'b => char ¬ '\010;
'f => char ¬ '\014;
IN ['0 .. '7] => {
octChars: ROPE ¬ Rope.FromChar[char];
IF from.PeekChar[]
IN ['0 .. '7]
THEN {
octChars ¬ octChars.Concat[Rope.FromChar[from.GetChar[]]];
IF from.PeekChar[]
IN ['0 .. '7]
THEN {
octChars ¬ octChars.Concat[Rope.FromChar[from.GetChar[]]];
};
};
char ¬ '\000 + Convert.CardFromRope[octChars, 8];
};
'^, '\\ => char ¬ char;
ENDCASE => char ¬ char --really should Bitch, but UNIX is so sloppy, this saves a lot of headaches--;
};
ENDCASE;
strVal ¬ strVal.Cat[Rope.FromChar[char]];
ENDLOOP;
s ¬
NEW [StringRep ¬ [
pad: IF padChars = NIL THEN 0.0 ELSE IF dotSeen THEN Convert.RealFromRope[padChars] ELSE REAL[Convert.IntFromRope[padChars]],
proportional: proportional,
str: strVal]];
};
CompareCaps:
PROC [r1, r2:
REF
ANY]
RETURNS [c: Basics.Comparison] = {
Key:
PROC [r:
REF
ANY]
RETURNS [name:
ROPE] = {
WITH r
SELECT
FROM
c: Cap => name ¬ c.name;
r: ROPE => name ¬ r;
ENDCASE => ERROR};
c ¬ Key[r1].Compare[Key[r2]];
};
CompareTerms:
PROC [r1, r2:
REF
ANY]
RETURNS [c: Basics.Comparison] = {
Key:
PROC [r:
REF
ANY]
RETURNS [name:
ROPE] = {
WITH r
SELECT
FROM
a: Alias => name ¬ a.name;
r: ROPE => name ¬ r;
ENDCASE => ERROR};
c ¬ Key[r1].Compare[Key[r2]];
};
CompareTermCaps:
PROC [r1, r2:
REF
ANY]
RETURNS [c: Basics.Comparison] = {
Key:
PROC [r:
REF
ANY]
RETURNS [fi: FileID] = {
WITH r
SELECT
FROM
tc: TermCap => fi ¬ tc.fileID;
rfi: REF FileID => fi ¬ rfi;
ENDCASE => ERROR};
fi1: FileID ¬ Key[r1];
fi2: FileID ¬ Key[r2];
c ¬ fi1.gName.Compare[fi2.gName, FALSE];
IF c = equal
THEN c ¬
SELECT BasicTime.Period[from: fi2.create, to: fi1.create]
FROM
<0 => less,
=0 => equal,
>0 => greater,
ENDCASE => ERROR;
};
AntiAlias:
PROC [ra:
REF
ANY]
RETURNS [t: Term] = {
IF ra = NIL THEN RETURN [NIL];
WITH ra
SELECT
FROM
a: Alias => RETURN [a.val];
ENDCASE => ERROR};
Add:
PROC [name:
ROPE, val: Val] = {
c: Cap¬ NEW [CapRep ¬ [name, val]];
defaultTerm.caps.Insert[c];
};
Start:
PROC = {
termCaps ¬ OrderedSymbolTableRef.CreateTable[CompareTermCaps];
defaultTerm ¬
NEW [TermRep ¬ [
names: NIL,
caps: OrderedSymbolTableRef.CreateTable[CompareCaps]
]];
Add["cr", NEW [StringRep ¬ [str: "\015"]]];
Add["ff", NEW [StringRep ¬ [str: "\014"]]];
Add["nl", NEW [StringRep ¬ [str: "\012"]]];
Add["pc", NEW [StringRep ¬ [str: "\000"]]];
};
Start[];
}.