<> <> <> <> <> <> <> <> <> <> <> <> <> <<>> DIRECTORY Ascii USING [Lower], BasicTime USING [earliestGMT, GMT, Update], Convert, IO, IOUtils, RefText, Real, RealOps USING [RoundLI], Rope; IOPrintImpl: CEDAR MONITOR IMPORTS Ascii, BasicTime, Convert, IO, IOUtils, RefText, Real, RealOps, Rope EXPORTS IO, IOUtils = BEGIN ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; Value: TYPE = IO.Value; Format: TYPE = IOUtils.Format; PFCodeProc: TYPE = IOUtils.PFCodeProc; PFErrorProc: TYPE = IOUtils.PFErrorProc; defaultTextSize: NAT _ 64; <> <> PutRope: PUBLIC PROC [self: STREAM, r: ROPE] = { len: INT _ Rope.InlineLength[r]; WITH r SELECT FROM t: Rope.Text => self.streamProcs.putBlock[self, RefText.TrustTextRopeAsText[t], 0, len]; ENDCASE => { scratch: REF TEXT = RefText.ObtainScratch[defaultTextSize]; pos: INT _ 0; WHILE len > 0 DO moved: NAT _ scratch.length _ 0; moved _ Rope.AppendChars[scratch, r, pos, len]; self.streamProcs.putBlock[self, scratch, 0, moved]; len _ len - moved; pos _ pos + moved; ENDLOOP; RefText.ReleaseScratch[scratch]; }; }; PutText: PUBLIC PROC [self: STREAM, t: REF READONLY TEXT] = { IF t # NIL THEN self.streamProcs.putBlock[self, t, 0, t.length]; }; Put: PUBLIC PROC [stream: STREAM, v1, v2, v3: Value] = { scratch: REF TEXT = RefText.ObtainScratch[defaultTextSize]; InnerPut1[stream, v1, scratch]; InnerPut1[stream, v2, scratch]; InnerPut1[stream, v3, scratch]; RefText.ReleaseScratch[scratch]; }; Put1: PUBLIC PROC [stream: STREAM, value: Value] = { scratch: REF TEXT = RefText.ObtainScratch[defaultTextSize]; InnerPut1[stream, value, scratch]; RefText.ReleaseScratch[scratch]; }; PutR1: PUBLIC PROC [value: Value] RETURNS [ROPE] = { stream: STREAM = IO.ROS[]; scratch: REF TEXT = RefText.ObtainScratch[defaultTextSize]; InnerPut1[stream, value, scratch]; RefText.ReleaseScratch[scratch]; RETURN[IO.RopeFromROS[stream]]; }; PutR: PUBLIC PROC [v1, v2, v3: Value] RETURNS [ROPE] = { stream: STREAM = IO.ROS[]; scratch: REF TEXT = RefText.ObtainScratch[defaultTextSize]; InnerPut1[stream, v1, scratch]; InnerPut1[stream, v2, scratch]; InnerPut1[stream, v3, scratch]; RefText.ReleaseScratch[scratch]; RETURN[IO.RopeFromROS[stream]]; }; PutL: PUBLIC PROC [stream: STREAM, list: LIST OF Value] = { scratch: REF TEXT = RefText.ObtainScratch[defaultTextSize]; FOR l: LIST OF READONLY Value _ list, l.rest UNTIL l = NIL DO InnerPut1[stream, l.first, scratch]; ENDLOOP; RefText.ReleaseScratch[scratch]; }; PutLR: PUBLIC PROC [list: LIST OF Value] RETURNS [ROPE] = { stream: STREAM = IO.ROS[]; scratch: REF TEXT = RefText.ObtainScratch[defaultTextSize]; FOR l: LIST OF READONLY Value _ list, l.rest UNTIL l = NIL DO InnerPut1[stream, l.first, scratch]; ENDLOOP; RefText.ReleaseScratch[scratch]; RETURN[IO.RopeFromROS[stream]]; }; InnerPut1: PROC [stream: STREAM, v: Value, scratch: REF TEXT] = { scratch.length _ 0; { WITH v SELECT FROM null: Value.null => NULL; atom: Value.atom => PutRope[stream, Convert.RopeFromAtom[from: atom.value, quote: FALSE]]; bool: Value.boolean => PutRope[stream, Convert.RopeFromBool[bool.value]]; char: Value.character => stream.streamProcs.putChar[stream, char.value]; card: Value.cardinal => { scratch _ Convert.AppendCard[scratch, card.value]; GO TO putBlock}; int: Value.integer => { scratch _ Convert.AppendInt[scratch, int.value]; GO TO putBlock}; real: Value.real => { scratch _ Convert.AppendG[scratch, real.value]; GO TO putBlock}; refAny: Value.refAny => PrintRef[stream, scratch, refAny.value]; rope: Value.rope => PutRope[stream, rope.value]; text: Value.text => PutText[stream, text.value]; time: Value.time => { scratch _ Convert.AppendTime[to: scratch, from: time.value, start: $years, end: $seconds]; GO TO putBlock; }; ENDCASE => ERROR; EXITS putBlock => stream.streamProcs.putBlock[stream, scratch, 0, scratch.length]; }; }; <> globalPrintRefAny: IOUtils.PrintRefAnyProc _ NIL; RegisterPrintRefAny: PUBLIC ENTRY PROC [printRefAnyProc: IOUtils.PrintRefAnyProc] = { globalPrintRefAny _ printRefAnyProc; }; GetPrintRefAny: ENTRY PROC [] RETURNS [IOUtils.PrintRefAnyProc] = { RETURN [globalPrintRefAny] }; PrintRef: PROC [stream: STREAM, scratch: REF TEXT, ref: REF READONLY ANY] = { printRefAnyProc: IOUtils.PrintRefAnyProc = GetPrintRefAny[]; IF printRefAnyProc = NIL THEN { scratch _ RefText.AppendTextRope[scratch, "[REF: "]; scratch _ Convert.AppendCard[ to: scratch, from: LOOPHOLE[ref, LONG CARDINAL], base: 8, showRadix: TRUE]; scratch _ RefText.AppendChar[scratch, ']]; stream.streamProcs.putBlock[stream, scratch, 0, scratch.length]; } ELSE { printRefAnyProc[stream, ref, 4, 32, FALSE]; } }; <> PFProcs: TYPE = REF PFProcsRecord; PFProcsRecord: PUBLIC TYPE = RECORD [ procArray: ARRAY CHAR ['a..'z] OF PFCodeProc _ ALL[NIL], errorProc: PFErrorProc _ NIL ]; globalPFProcs: PFProcs _ NIL; GetDefaultPFProcs: ENTRY PROC [] RETURNS [PFProcs] = INLINE { RETURN [globalPFProcs]; }; GetPFProcs: PROC [stream: STREAM] RETURNS [pfProcs: PFProcs] = INLINE { pfProcs _ NARROW[IOUtils.LookupData[stream, $SetPFCode]]; IF pfProcs = NIL THEN pfProcs _ GetDefaultPFProcs[]; }; SetDefaultPFCodeProc: PUBLIC ENTRY PROC [char: CHAR, codeProc: PFCodeProc] RETURNS [previous: PFCodeProc] = { char _ Ascii.Lower[char]; IF char NOT IN ['a..'z] THEN ERROR IO.Error[PFInvalidCode, NIL]; previous _ globalPFProcs.procArray[char]; globalPFProcs.procArray[char] _ codeProc; }; SetDefaultPFErrorProc: PUBLIC ENTRY PROC [errorProc: PFErrorProc] RETURNS [previous: PFErrorProc] = { previous _ globalPFProcs.errorProc; globalPFProcs.errorProc _ errorProc; }; CopyPFProcs: PUBLIC PROC [stream: STREAM] RETURNS [new: PFProcs] = { pfProcs: PFProcs _ IF stream = NIL THEN NIL ELSE NARROW[IOUtils.LookupData[stream, $SetPFCode]]; IF pfProcs = NIL THEN pfProcs _ GetDefaultPFProcs[]; RETURN [NEW[PFProcsRecord _ pfProcs^]]; }; SetPFProcs: PUBLIC PROC [stream: STREAM, pfProcs: PFProcs] RETURNS [previous: PFProcs] = { previous _ NARROW[IOUtils.LookupData[stream, $SetPFCode]]; IOUtils.StoreData[stream, $SetPFCode, pfProcs]; }; SetPFCodeProc: PUBLIC PROC [pfProcs: PFProcs, char: CHAR, codeProc: PFCodeProc] RETURNS [previous: PFCodeProc] = { IF pfProcs = NIL THEN ERROR IO.Error[PFInvalidPFProcs, NIL]; char _ Ascii.Lower[char]; IF char NOT IN ['a..'z] THEN ERROR IO.Error[PFInvalidCode, NIL]; previous _ pfProcs.procArray[char]; pfProcs.procArray[char] _ codeProc; }; SetPFErrorProc: PUBLIC PROC [pfProcs: PFProcs, errorProc: PFErrorProc] RETURNS [previous: PFErrorProc] = { IF pfProcs = NIL THEN ERROR IO.Error[PFInvalidPFProcs, NIL]; previous _ pfProcs.errorProc; pfProcs.errorProc _ errorProc; }; <> PutF: PUBLIC PROC [stream: STREAM, format: ROPE, v1, v2, v3, v4, v5: Value] = { pfProcs: PFProcs = GetPFProcs[stream]; fp: INT _ 0; IF v1.type#null THEN fp _ PFInternal[stream, format, fp, v1, pfProcs]; IF v2.type#null THEN fp _ PFInternal[stream, format, fp, v2, pfProcs]; IF v3.type#null THEN fp _ PFInternal[stream, format, fp, v3, pfProcs]; IF v4.type#null THEN fp _ PFInternal[stream, format, fp, v4, pfProcs]; IF v5.type#null THEN fp _ PFInternal[stream, format, fp, v5, pfProcs]; [] _ PFInternal[stream, format, fp, [null[]], pfProcs]; }; PutF1: PUBLIC PROC [stream: STREAM, format: ROPE, value: Value] = { pfProcs: PFProcs = GetPFProcs[stream]; fp: INT _ 0; IF value.type#null THEN fp _ PFInternal[stream, format, fp, value, pfProcs]; [] _ PFInternal[stream, format, fp, [null[]], pfProcs]; }; PutFR: PUBLIC PROC [format: ROPE, v1, v2, v3, v4, v5: Value] RETURNS [ROPE] = { stream: STREAM = IO.ROS[]; PutF[stream, format, v1, v2, v3, v4, v5]; RETURN [IO.RopeFromROS[stream]]; }; PutFR1: PUBLIC PROC [format: ROPE, value: Value] RETURNS [ROPE] = { stream: STREAM = IO.ROS[]; pfProcs: PFProcs = GetPFProcs[stream]; fp: INT _ 0; IF value.type#null THEN fp _ PFInternal[stream, format, fp, value, pfProcs]; [] _ PFInternal[stream, format, fp, [null[]], pfProcs]; RETURN [IO.RopeFromROS[stream]]; }; PutFL: PUBLIC PROC [stream: STREAM, format: ROPE, list: LIST OF Value] = { pfProcs: PFProcs = GetPFProcs[stream]; fp: INT _ 0; FOR l: LIST OF READONLY Value _ list, l.rest UNTIL l = NIL DO fp _ PFInternal[stream, format, fp, l.first, pfProcs]; ENDLOOP; [] _ PFInternal[stream, format, fp, [null[]], pfProcs]; }; PutFLR: PUBLIC PROC [format: ROPE, list: LIST OF Value] RETURNS [ROPE] = { stream: STREAM = IO.ROS[]; PutFL[stream, format, list]; RETURN [IO.RopeFromROS[stream]]; }; <> PFInternal: PROC [stream: STREAM, format: ROPE, formatPtr: INT, arg: Value, pfProcs: PFProcs] RETURNS [--advancedFormatPtr--INT] = { <> error: IO.ErrorCode _ $Null; c: CHAR; GetNextFromFormat: PROC[] = INLINE { c _ format.InlineFetch[formatPtr]; formatPtr _ formatPtr.SUCC; }; formatSize: INT _ format.InlineLength[]; IF formatSize = 0 THEN { IF arg.type = null THEN GOTO Done ELSE { format _ "%g"; formatSize _ 2; formatPtr _ 0 } }; DO { -- EXITS PutC, HandleError IF formatPtr >= formatSize THEN { IF arg.type = null THEN GOTO Done ELSE { --ran out of format while looking for '% error _ PFFormatSyntaxError; GOTO HandleError } }; GetNextFromFormat[]; IF c # '% THEN GOTO PutC; { savedFormatPointer: INT = formatPtr; DO { IF formatPtr >= formatSize THEN { --ran out of format while looking for code error _ PFFormatSyntaxError; GOTO HandleError }; GetNextFromFormat[]; IF c IN ['a..'z] OR c IN ['A..'Z] THEN GOTO FoundCode; IF c = '% THEN GOTO FoundPercent; EXITS FoundCode => EXIT; FoundPercent => { --found '% while looking for code IF formatPtr = savedFormatPointer.SUCC THEN GOTO PutC; error _ PFFormatSyntaxError; GOTO HandleError }; } ENDLOOP; IF arg.type = null THEN { --no Value corresponding to '% in format error _ PFFormatSyntaxError; GOTO HandleError }; c _ Ascii.Lower[c]; { <> <> <> <> val: Value = WITH arg SELECT FROM ref: Value.refAny => WITH ref.value SELECT FROM refBool: REF READONLY BOOL => IO.bool[refBool^], refChar: REF READONLY CHAR => IO.char[refChar^], refCard: REF READONLY CARDINAL => IO.card[refCard^], refLongCard: REF READONLY LONG CARDINAL => IO.card[refLongCard^], refInteger: REF READONLY INTEGER => IO.int[refInteger^], refInt: REF READONLY INT => IO.int[refInt^], refNat: REF READONLY NAT => IO.int[refNat^], refReal: REF READONLY REAL => IO.real[refReal^], refText: REF READONLY TEXT => IO.text[refText], < IO.atom[atom],>> < IO.rope[rope],>> <> < time[pi^],>> <> ENDCASE => arg ENDCASE => arg; p: PFCodeProc _ pfProcs.procArray[c]; IF p = NIL THEN { error _ PFCantBindConversionProc; GOTO HandleError }; p[stream, val, [format, savedFormatPointer], c ! IO.Error => IF ec IN [PFCantBindConversionProc .. PFUnprintableValue] THEN { error _ ec; GOTO HandleError }]; GOTO Done; } } EXITS PutC => stream.streamProcs.putChar[stream, c]; HandleError => { ep: PFErrorProc _ pfProcs.errorProc; IF ep = NIL THEN ep _ PFErrorPrintPounds; ep[error, stream]; GOTO Done; }; } ENDLOOP; EXITS Done => RETURN [formatPtr]; }; ParseFormat: PROC [form: ROPE, start: INT] RETURNS [leadingMinus: BOOL _ FALSE, leadingZero: BOOL _ FALSE, fieldWidth: INTEGER _ -1, numDigits: INTEGER _ -1] = { <<... parses a standard format specification.>> <> <> <> <> <<= -1 if there was no number present>> <<= LAST[INTEGER] if the number overflows>> <> <> <<= -1 if there was no such number>> <<= LAST[INTEGER] if said number overflows>> len: INT _ Rope.Length[form]; IF start < len THEN SELECT Rope.Fetch[form, start] FROM '0 => {leadingZero _ TRUE; start _ start + 1}; '- => {leadingMinus _ TRUE; start _ start + 1}; ENDCASE; WHILE start < len DO c: CHAR _ Rope.Fetch[form, start]; SELECT c FROM IN ['0..'9] => { digit: [0..9] _ (c-'0); IF fieldWidth < 0 THEN fieldWidth _ 0; IF fieldWidth >= (LAST[INTEGER] - digit)/10 THEN { fieldWidth _ LAST[INTEGER]; RETURN}; fieldWidth _ fieldWidth*10 + digit; }; ENDCASE => EXIT; start _ start + 1; ENDLOOP; IF start < len AND Rope.Fetch[form, start] = '. THEN { start _ start + 1; WHILE start < len DO c: CHAR _ Rope.Fetch[form, start]; SELECT c FROM IN ['0..'9] => { digit: [0..9] _ (c-'0); IF numDigits < 0 THEN numDigits _ 0; IF numDigits >= (LAST[INTEGER] - digit)/10 THEN { numDigits _ LAST[INTEGER]; RETURN}; numDigits _ numDigits*10 + digit; }; ENDCASE => RETURN; start _ start + 1; ENDLOOP; }; }; PFErrorPrintPounds: PUBLIC PROC [error: IO.ErrorCode, stream: STREAM] = { PutRope[stream, "#####"]; }; PFErrorNoop: PUBLIC PROC [error: IO.ErrorCode, stream: STREAM] = { }; PFErrorError: PUBLIC PROC [error: IO.ErrorCode, stream: STREAM] = { ERROR IO.Error[error, stream]; }; <> StringRoutine: PROC [stream: STREAM, val: Value, format: Format, char: CHAR] = TRUSTED { <> <> <> < for ctrl-char.>> <> r: REF TEXT _ NIL; rp: ROPE _ NIL; WITH v: val SELECT FROM atom => rp _ Convert.RopeFromAtom[from: v.value, quote: FALSE]; boolean => rp _ Convert.RopeFromBool[v.value]; character => { r _ RefText.ObtainScratch[defaultTextSize]; r[0] _ v.value; r.length _ 1; }; cardinal => r _ Convert.AppendCard[RefText.ObtainScratch[defaultTextSize], v.value]; integer => r _ Convert.AppendInt[RefText.ObtainScratch[defaultTextSize], v.value]; real => r _ Convert.AppendG[RefText.ObtainScratch[defaultTextSize], v.value]; refAny => { stream: STREAM = IO.ROS[]; stream.Put[val]; rp _ IO.RopeFromROS[stream]; }; rope => rp _ v.value; text => rp _ RefText.TrustTextAsRope[v.value]; time => r _ Convert.AppendTime[ to: RefText.ObtainScratch[defaultTextSize], from: v.value, start: $years, end: $seconds]; ENDCASE => ERROR; PrintText[r, rp, format, stream, IF char = 'h THEN TRUE ELSE FALSE]; }; FixnumRoutine: PROC [stream: STREAM, val: Value, format: Format, char: CHAR] = TRUSTED { <> <> <> <> <> base: Convert.Base _ SELECT char FROM 'b => 8, 'x => 16, ENDCASE => 10; r: REF TEXT = WITH v: val SELECT FROM boolean => Convert.AppendCard[RefText.ObtainScratch[defaultTextSize], IF v.value THEN 1 ELSE 0, base, FALSE], cardinal => Convert.AppendCard[RefText.ObtainScratch[defaultTextSize], v.value, base, FALSE], integer => Convert.AppendInt[RefText.ObtainScratch[defaultTextSize], v.value, base, FALSE], real => Convert.AppendInt[RefText.ObtainScratch[defaultTextSize], RealOps.RoundLI[v.value ! Real.RealException => ERROR IO.Error[PFUnprintableValue, stream]], base, FALSE], ENDCASE => ERROR IO.Error[PFTypeMismatch, stream]; PrintText[r, NIL, format, stream, FALSE]; }; LooksRoutine: PROC [stream: STREAM, val: Value, format: Format, char: CHAR] = { <> <> <> <> WITH val SELECT FROM ropeVal: Value.rope => { <> back: STREAM _ stream.backingStream; WHILE back # NIL DO WITH IOUtils.LookupData[back, $SetPFCode] SELECT FROM pfProcs: PFProcs => { pp: PFCodeProc = pfProcs.procArray[char]; IF pp # NIL THEN { IO.Flush[stream]; <> pp[back, val, format, char]; RETURN; }; }; ENDCASE; back _ back.backingStream; ENDLOOP; }; ENDCASE => ERROR IO.Error[PFTypeMismatch, stream]; }; RopeLiteralRoutine: PROC [stream: STREAM, val: Value, format: Format, char: CHAR] = { <> <> <> <> PutEscape: PROC [c: CHAR] RETURNS [BOOL] = { <> IF c IN [40C .. 177C] THEN { IF c = '\\ OR c = '\" THEN stream.streamProcs.putChar[stream, '\\]; stream.streamProcs.putChar[stream, c]; } ELSE { stream.streamProcs.putChar[stream, '\\]; SELECT c FROM '\n => stream.streamProcs.putChar[stream, 'n]; '\t => stream.streamProcs.putChar[stream, 't]; '\b => stream.streamProcs.putChar[stream, 'b]; '\f => stream.streamProcs.putChar[stream, 'f]; '\l => stream.streamProcs.putChar[stream, 'l]; ENDCASE => { stream.streamProcs.putChar[stream, '0 + (c - 0C) / 64]; stream.streamProcs.putChar[stream, '0 + (c - 0C) MOD 64 / 8]; stream.streamProcs.putChar[stream, '0 + (c - 0C) MOD 8] } ; }; RETURN [FALSE]; }; WITH val SELECT FROM ropeVal: Value.rope => [] _ Rope.Map[base: ropeVal.value, action: PutEscape]; ENDCASE => ERROR IO.Error[PFTypeMismatch, stream]; }; TimeIntervalRoutine: PROC [stream: STREAM, val: Value, format: Format, char: CHAR] = TRUSTED { <> <> <> <> et, hours1, minutes, seconds: LONG CARDINAL; li: INT; r: REF TEXT; han: STREAM; WITH v: val SELECT FROM cardinal => et _ v.value; integer => et _ LOOPHOLE[v.value]; real => TRUSTED { li _ RealOps.RoundLI[v.value ! Real.RealException => ERROR IO.Error[PFUnprintableValue, stream]]; IF li < 0 THEN ERROR IO.Error[PFUnprintableValue, stream]; et _ li; }; ENDCASE => ERROR IO.Error[PFTypeMismatch, stream]; seconds _ et MOD 60; et _ et/60; minutes _ et MOD 60; et _ et/60; hours1 _ et MOD 100; et _ et/100; r _ RefText.ObtainScratch[defaultTextSize]; han _ IO.TOS[r]; IO.PutF[han, "%g%02g:%02g:%02g", IF et # 0 THEN IO.int[et] ELSE IO.rope[NIL], IO.card[hours1], IO.card[minutes], IO.card[seconds]]; r _ han.TextFromTOS[]; han.Close[]; PrintText[r, NIL, format, stream, FALSE]; }; TimeRoutine: PROC [stream: STREAM, val: Value, format: Format, char: CHAR] = TRUSTED { <> <> <> <> t: BasicTime.GMT; li: INT; WITH v: val SELECT FROM integer => t _ BasicTime.Update[base: BasicTime.earliestGMT, period: v.value]; cardinal => t _ BasicTime.Update[base: BasicTime.earliestGMT, period: v.value]; real => { li _ RealOps.RoundLI[v.value ! Real.RealException => ERROR IO.Error[PFUnprintableValue, stream]]; IF li < 0 THEN ERROR IO.Error[PFUnprintableValue, stream]; t _ BasicTime.Update[base: BasicTime.earliestGMT, period: li]; }; time => t _ v.value; ENDCASE => ERROR IO.Error[PFTypeMismatch, stream]; PrintText[ Convert.AppendTime[ to: RefText.ObtainScratch[defaultTextSize], from: t, start: $years, end: $seconds], NIL, format, stream, FALSE]; }; <> FlonumRoutine: IOUtils.PFCodeProc = { <<[stream: STREAM, val: IO.Value, format: IOUtils.Format, char: CHAR]>> leadingMinus: BOOL _ FALSE; leadingZero: BOOL _ FALSE; fieldWidth: INT _ -1; numDigits: INT _ -1; [leadingMinus, leadingZero, fieldWidth, numDigits] _ ParseFormat[format.form, format.first]; SELECT numDigits FROM < 0 => numDigits _ 2; > Real.MaxSinglePrecision => numDigits _ Real.MaxSinglePrecision; ENDCASE; WITH val SELECT FROM r: real IO.Value => { proc: PROC [REF TEXT, REAL, [0..Real.MaxSinglePrecision]] RETURNS [REF TEXT] _ SELECT char FROM 'e => Convert.AppendE, 'f => Convert.AppendF, ENDCASE => ERROR; scratch: REF TEXT _ RefText.ObtainScratch[defaultTextSize]; buffer: REF TEXT _ proc[scratch, r.value, numDigits]; rLen: NAT _ buffer.length; diff: INTEGER _ fieldWidth - rLen; IF diff > 0 AND NOT leadingMinus THEN PutChars[stream, diff, ' ]; IO.PutText[stream, buffer]; IF diff > 0 AND leadingMinus THEN PutChars[stream, diff, ' ]; RefText.ReleaseScratch[scratch]; }; ENDCASE => PutChars[stream, fieldWidth, '!]; }; <> PutChars: PROC [st: STREAM, chars: NAT, char: CHAR] = { THROUGH [0..chars) DO IO.PutChar[st, char]; ENDLOOP; }; AppendChars: PROC [text: REF TEXT, chars: NAT, char: CHAR] RETURNS [REF TEXT] = { THROUGH [0..chars) DO text _ RefText.AppendChar[text, char]; ENDLOOP; RETURN [text]; }; <> PrintText: PROC [text: REF TEXT, rp: ROPE, format: Format, stream: STREAM, visiblecc: BOOL] = { <> <> MyPut: PROC [c: CHAR] RETURNS [BOOL] = { stream.streamProcs.putChar[stream, c]; RETURN[FALSE] }; ladj, fill0: BOOL _ FALSE; w, k, tlength: CARDINAL; -- w is field width, k is # chars to fill c: CHAR; formatPtr: INT _ format.first; GetNextFromFormat: PROC[] = INLINE { c _ format.form.InlineFetch[formatPtr]; formatPtr _ formatPtr.SUCC }; IF text#NIL THEN tlength _ text.length ELSE tlength _ rp.InlineLength[]; GetNextFromFormat[]; SELECT c FROM '0 => { fill0 _ TRUE; GetNextFromFormat[] }; '- => { ladj _ TRUE; GetNextFromFormat[] }; ENDCASE; w _ 0; DO SELECT c FROM IN ['0 .. '9] => { w _ w*10 + (c - '0); GetNextFromFormat[] }; ENDCASE => EXIT; ENDLOOP; SELECT Ascii.Lower[c] FROM '., IN ['a .. 'z] => NULL; ENDCASE => IO.Error[PFFormatSyntaxError, stream]; IF w < tlength THEN { w _ tlength; k _ 0} ELSE { k _ w - tlength }; IF NOT ladj THEN THROUGH [1..k] DO stream.streamProcs.putChar[stream, IF fill0 THEN '0 ELSE ' ]; ENDLOOP; IF visiblecc THEN FOR j: NAT IN [0..tlength) DO c _ IF text#NIL THEN text[j] ELSE rp.Fetch[j]; IF c < 40C THEN { stream.streamProcs.putChar[stream, '^]; stream.streamProcs.putChar[stream, c + LOOPHOLE['@, CARDINAL]]; } ELSE stream.streamProcs.putChar[stream, c]; ENDLOOP ELSE { IF text#NIL THEN stream.streamProcs.putBlock[stream, text, 0, text.length] ELSE [] _ Rope.Map[base: rp, action: MyPut]; }; IF ladj THEN THROUGH [1..k] DO stream.streamProcs.putChar[stream, ' ] ENDLOOP; IF text#NIL THEN RefText.ReleaseScratch[text]; }; <> Create: ENTRY PROC [] = { globalPFProcs _ NEW[PFProcsRecord _ []]; globalPFProcs.errorProc _ PFErrorPrintPounds; globalPFProcs.procArray['a] _ StringRoutine; globalPFProcs.procArray['b] _ FixnumRoutine; globalPFProcs.procArray['c] _ StringRoutine; globalPFProcs.procArray['d] _ FixnumRoutine; globalPFProcs.procArray['e] _ FlonumRoutine; globalPFProcs.procArray['f] _ FlonumRoutine; globalPFProcs.procArray['g] _ StringRoutine; globalPFProcs.procArray['h] _ StringRoutine; globalPFProcs.procArray['l] _ LooksRoutine; globalPFProcs.procArray['q] _ RopeLiteralRoutine; globalPFProcs.procArray['r] _ TimeIntervalRoutine; globalPFProcs.procArray['s] _ StringRoutine; globalPFProcs.procArray['t] _ TimeRoutine; globalPFProcs.procArray['x] _ FixnumRoutine; }; Create[]; END.