Oberon/A2/Oberon.QuotedPrintable.Mod

(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich. Refer to the "General ETH Oberon System Source License" contract available at&#58; http&#58;//www.oberon.ethz.ch/ *) MODULE QuotedPrintable IN Oberon; (* ejz, *) &#9;IMPORT Files, Fonts, Strings, Texts, Oberon; &#9;VAR &#9;&#9;W&#58; Texts.Writer; &#9;PROCEDURE HexVal(ch&#58; CHAR)&#58; SIGNED32; &#9;BEGIN &#9;&#9;IF (ch &#62;&#61; "0") &#38; (ch &#60;&#61; "9") THEN &#9;&#9;&#9;RETURN ORD(ch)-ORD("0") &#9;&#9;ELSIF (ch &#62;&#61; "A") &#38; (ch &#60;&#61; "F") THEN &#9;&#9;&#9;RETURN ORD(ch)-ORD("A")+10 &#9;&#9;ELSIF (ch &#62;&#61; "a") &#38; (ch &#60;&#61; "f") THEN &#9;&#9;&#9;RETURN ORD(ch)-ORD("a")+10 &#9;&#9;END &#9;END HexVal; &#9;PROCEDURE decodeText*(T&#58; Texts.Text; beg&#58; SIGNED32; F&#58; Files.File; binary&#58; BOOLEAN)&#58; BOOLEAN; &#9;&#9;VAR &#9;&#9;&#9;R&#58; Texts.Reader; &#9;&#9;&#9;Ri&#58; Files.Rider; &#9;&#9;&#9;ch, ch1, ch2&#58; CHAR; &#9;&#9;PROCEDURE ReadWrite(c&#58; CHAR); &#9;&#9;BEGIN &#9;&#9;&#9;Texts.Read(R, ch); &#9;&#9;&#9;IF &#126;R.eot &#38; (R.lib IS Fonts.Font) THEN &#9;&#9;&#9;&#9;Files.Write(Ri, c) &#9;&#9;&#9;END &#9;&#9;END ReadWrite; &#9;BEGIN &#9;&#9;Files.Set(Ri, F, 0); &#9;&#9;Texts.OpenReader(R, T, beg); &#9;&#9;Texts.Read(R, ch); &#9;&#9;WHILE &#126;R.eot &#38; (ch &#60;&#61; " ") &#38; (R.lib IS Fonts.Font) DO &#9;&#9;&#9;Texts.Read(R, ch) &#9;&#9;END; &#9;&#9;WHILE &#126;R.eot &#38; (R.lib IS Fonts.Font) DO &#9;&#9;&#9;IF ch &#61; "&#61;" THEN &#9;&#9;&#9;&#9;Texts.Read(R, ch1); Texts.Read(R, ch2); &#9;&#9;&#9;&#9;IF Strings.IsHexDigit(ch1) &#38; Strings.IsHexDigit(ch2) THEN &#9;&#9;&#9;&#9;&#9;ch &#58;&#61; CHR(HexVal(ch1)*16+HexVal(ch2)); &#9;&#9;&#9;&#9;&#9;IF &#126;binary THEN &#9;&#9;&#9;&#9;&#9;&#9;ch &#58;&#61; Strings.ISOToOberon&#91;ORD(ch)&#93; &#9;&#9;&#9;&#9;&#9;END; &#9;&#9;&#9;&#9;&#9;ReadWrite(ch) &#9;&#9;&#9;&#9;ELSIF ch1 &#61; Strings.CR THEN &#9;&#9;&#9;&#9;&#9;ch &#58;&#61; ch2 &#9;&#9;&#9;&#9;ELSE &#9;&#9;&#9;&#9;&#9;Files.Write(Ri, "&#61;"); Files.Write(Ri, ch1); &#9;&#9;&#9;&#9;&#9;ReadWrite(ch2) &#9;&#9;&#9;&#9;END &#9;&#9;&#9;ELSE &#9;&#9;&#9;&#9;ReadWrite(ch) &#9;&#9;&#9;END &#9;&#9;END; &#9;&#9;RETURN TRUE &#9;END decodeText; &#9;PROCEDURE Decode(binary&#58; BOOLEAN); &#9;&#9;VAR &#9;&#9;&#9;S&#58; Texts.Scanner; &#9;&#9;&#9;F&#58; Files.File; &#9;&#9;&#9;T&#58; Texts.Text; &#9;&#9;&#9;beg, end, time&#58; SIGNED32; &#9;BEGIN &#9;&#9;Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); &#9;&#9;Texts.Scan(S); &#9;&#9;IF S.class IN &#123;Texts.Name, Texts.String&#125; THEN &#9;&#9;&#9;Texts.WriteString(W, S.s); &#9;&#9;&#9;F &#58;&#61; Files.New(S.s); &#9;&#9;&#9;Texts.Scan(S); &#9;&#9;&#9;IF (S.class &#61; Texts.Char) &#38; ((S.c &#61; "@") OR (S.c &#61; "^")) THEN &#9;&#9;&#9;&#9;T &#58;&#61; NIL; &#9;&#9;&#9;&#9;time &#58;&#61; -1; &#9;&#9;&#9;&#9;Oberon.GetSelection(T, beg, end, time); &#9;&#9;&#9;&#9;IF T &#61; NIL THEN &#9;&#9;&#9;&#9;&#9;RETURN &#9;&#9;&#9;&#9;END &#9;&#9;&#9;ELSIF S.class IN &#123;Texts.Name, Texts.String&#125; THEN &#9;&#9;&#9;&#9;NEW(T); &#9;&#9;&#9;&#9;Texts.Open(T, S.s); &#9;&#9;&#9;&#9;beg &#58;&#61; 0 &#9;&#9;&#9;ELSE &#9;&#9;&#9;&#9;beg &#58;&#61; Texts.Pos(S); &#9;&#9;&#9;&#9;T &#58;&#61; Oberon.Par.text &#9;&#9;&#9;END; &#9;&#9;&#9;IF decodeText(T, beg, F, binary) THEN &#9;&#9;&#9;&#9;Files.Register(F); &#9;&#9;&#9;&#9;Texts.WriteString(W, " done") &#9;&#9;&#9;ELSE &#9;&#9;&#9;&#9;Texts.WriteString(W, " failed") &#9;&#9;&#9;END; &#9;&#9;&#9;Texts.WriteLn(W); &#9;&#9;&#9;Texts.Append(Oberon.Log, W.buf) &#9;&#9;END &#9;END Decode; &#9;PROCEDURE DecodeText*; &#9;BEGIN &#9;&#9;Decode(FALSE) &#9;END DecodeText; &#9;PROCEDURE DecodeFile*; &#9;BEGIN &#9;&#9;Decode(TRUE) &#9;END DecodeFile; BEGIN &#9;Texts.OpenWriter(W) END QuotedPrintable.