MODULE XhtmlStdFileWriters;
(**

   project   = "BlackBox"
   organization   = "www.oberon.ch"
   contributors   = "Oberon microsystems"
   version   = "System/Rsrc/About"
   copyright   = "System/Rsrc/About"
   license   = "Docu/BB-License"
   changes   = ""
   issues   = ""

**)

   IMPORT Files, XhtmlWriters;

   CONST tab = 09X; line = 0AX;

   TYPE

      Writer = POINTER TO RECORD (XhtmlWriters.Writer)
         level: INTEGER;   (* indentation level *)
         current: Tag;   (* top of tag stack *)
         rider: Files.Writer;
         afterData: BOOLEAN   (* allows delayed newline after data contents *)
      END;
      Tag = POINTER TO RECORD

         up: Tag;
         inContent: BOOLEAN;   (* subtag was entered, or text data written *)
         preserve: BOOLEAN;   (* write complete element on one line, no prettyprinting white space *)
         name: ARRAY 256 OF CHAR
      END;
   (* generic output procedures *)

   PROCEDURE Char (wr:Writer; ch: CHAR);

   BEGIN   (* UTF-8 format *)
      IF ch <= 7FX THEN
         wr.rider.WriteByte(SHORT(SHORT(ORD(ch))))
      ELSIF ch <= 7FFX THEN
         wr.rider.WriteByte(SHORT(SHORT(-64 + ORD(ch) DIV 64)));
         wr.rider.WriteByte(SHORT(SHORT(-128 + ORD(ch) MOD 64)))
      ELSE
         wr.rider.WriteByte(SHORT(SHORT(-32 + ORD(ch) DIV 4096)));
         wr.rider.WriteByte(SHORT(SHORT(-128 + ORD(ch) DIV 64 MOD 64)));
         wr.rider.WriteByte(SHORT(SHORT(-128 + ORD(ch) MOD 64)))
      END
   END Char;
   PROCEDURE String (wr: Writer; IN str: ARRAY OF CHAR);

      VAR i: INTEGER; ch: CHAR;
   BEGIN
      i := 0; ch := str[0];
      WHILE ch # 0X DO Char(wr, ch); INC(i); ch := str[i] END
   END String;
   PROCEDURE Tabs (wr: Writer);

      VAR i: INTEGER;
   BEGIN
      IF ~wr.current.preserve THEN
         i := 0; WHILE i # wr.level DO Char(wr, tab); INC(i) END
      END
   END Tabs;
   PROCEDURE StartElemContent (wr: Writer);

   BEGIN   (* complete start tag *)
      String(wr, ">"); wr.Ln;
      wr.current.inContent := TRUE
   END StartElemContent;
   (* methods *)


   PROCEDURE (wr: Writer) Error (): XhtmlWriters.Error;

   BEGIN
      RETURN NIL
   END Error;
   PROCEDURE (wr: Writer) Ln;

   BEGIN
      IF ~wr.current.preserve THEN
         Char(wr, line)
      END
   END Ln;
   PROCEDURE (wr: Writer) Instruction (IN piTarget, instruction: ARRAY OF CHAR);

   BEGIN
      Tabs(wr); String(wr, "<?" + piTarget + " " + instruction + "?>")
   END Instruction;
   PROCEDURE (wr: Writer) Comment (IN comment: ARRAY OF CHAR);

   BEGIN
      Tabs(wr); String(wr, "<!--" + comment + "-->")
   END Comment;
   PROCEDURE (wr: Writer) DocType (IN rootName, pubidLiteral, sysidLiteral: ARRAY OF CHAR);

   BEGIN
      ASSERT(wr.level = 0, 100);
      ASSERT(rootName # "", 101);
      ASSERT((pubidLiteral = "") OR (sysidLiteral # ""), 102);
      IF pubidLiteral # "" THEN
         String(wr, '<!DOCTYPE ' + rootName + ' PUBLIC "' + pubidLiteral + '" "' + sysidLiteral + '">')
      ELSIF sysidLiteral # "" THEN
         String(wr, '<!DOCTYPE ' + rootName + ' SYSTEM "' + sysidLiteral + '">')
      ELSE
         String(wr, '<!DOCTYPE ' + rootName)
      END;
      wr.Ln
   END DocType;
   PROCEDURE (wr: Writer) StartTag (IN elem: ARRAY OF CHAR; preserve: BOOLEAN);

      VAR t: Tag;
   BEGIN
      IF ~wr.current.inContent & (wr.current.up # NIL) THEN StartElemContent(wr) END;
      Tabs(wr); String(wr, "<" + elem); wr.afterData := FALSE;
      INC(wr.level);
      NEW(t); t.name := elem$; t.up := wr.current; t.preserve := preserve OR wr.current.preserve; wr.current := t
   END StartTag;
   PROCEDURE (wr: Writer) Attr (IN name, value: ARRAY OF CHAR);

   BEGIN
      ASSERT(wr.level >= 1, 100);
      String(wr, ' ' + name + '="' + value + '"')
   END Attr;
   PROCEDURE (wr: Writer) Data (IN data: ARRAY OF CHAR);

   BEGIN
      ASSERT(wr.level >= 1, 100);
      IF data # "" THEN
         IF ~wr.current.inContent THEN
            StartElemContent(wr);
            Tabs(wr)
         END;
         String(wr, data); wr.afterData := TRUE
      END
   END Data;
   PROCEDURE (wr: Writer) EndTag;

   BEGIN
      ASSERT(wr.level >= 1, 100);
      DEC(wr.level);
      IF wr.current.inContent THEN
         IF wr.afterData THEN wr.Ln END;
         Tabs(wr); String(wr, "</" + wr.current.name + ">")
      ELSE
         (* note that StartElemContents is NOT called! *)
         String(wr, "/>")
      END;
      wr.current := wr.current.up;
      wr.Ln; wr.afterData := FALSE;
      IF wr.level = 0 THEN wr.rider.Base().Flush END
   END EndTag;
   (* factory functions *)


   PROCEDURE MakeFileSpec (IN path: ARRAY OF CHAR; OUT loc: Files.Locator; OUT file: Files.Name);

      VAR i, j: INTEGER; ch: CHAR; s: Files.Name;
   BEGIN
      loc := Files.dir.This(""); IF loc = NIL THEN RETURN END;
      j := 0; i := 0; ch := path[0];
      WHILE ch # 0X DO
         IF ch = "/" THEN
            s[j] := 0X;   (* s contains next path element *)
            loc := loc.This(s); IF loc = NIL THEN RETURN END;
            j := 0
         ELSE
            s[j] := ch; INC(j)
         END;
         INC(i); ch := path[i]
      END;
      s[j] := 0X;   (* s contains file name *)
      file := s$
   END MakeFileSpec;
   PROCEDURE New* (f: Files.File): XhtmlWriters.Writer;

      VAR wr: Writer;
   BEGIN
      ASSERT(f # NIL, 20);
      NEW(wr);
      NEW(wr.current); wr.current.name := ""; wr.current.up := NIL;
      wr.rider := f.NewWriter(NIL);
      ASSERT(wr # NIL, 100); ASSERT(wr.rider # NIL, 101); ASSERT(wr.level >= 0, 102);
      String(wr, '<?xml version="1.0" encoding="UTF-8"?>'); wr.Ln;
      RETURN wr
   END New;
   PROCEDURE NewForPath* (IN path: ARRAY OF CHAR): XhtmlWriters.Writer;

      VAR loc: Files.Locator; f: Files.File; name: Files.Name; wr: XhtmlWriters.Writer;
   BEGIN
      ASSERT(path # "", 20);
      MakeFileSpec(path, loc, name);
      f := Files.dir.New(loc, Files.dontAsk);
      IF f # NIL THEN wr := New(f) ELSE wr := NIL END;
      RETURN wr
   END NewForPath;
END XhtmlStdFileWriters.