Автодок: выводится красивый ХТМЛ-код

src/Autodoc/Autodoc.Mod

@@ -8,18 +8,6 @@ CONST
 TYPE
   Module* = P.Module;
 
-PROCEDURE SaveHtml*(module: Module; fname: ARRAY OF CHAR): BOOLEAN;
-VAR T: Texts.Text;
-  W: Texts.Writer;
-BEGIN
-  NEW(T); Texts.Open(T, '');
-  Texts.OpenWriter(W);
-  Texts.WriteString(W, '<h1>'); Texts.WriteString(W, fname);
-  Texts.WriteString(W, '</h1>'); Texts.WriteLn(W);
-  Texts.Append(T, W.buf);
-  Texts.Close(T, fname);
-RETURN TRUE END SaveHtml;
-
 PROCEDURE OpenFile(fname: ARRAY OF CHAR; VAR r: Files.Rider): BOOLEAN;
 VAR F: Files.File;
 BEGIN F := Files.Old(fname);

src/Autodoc/AutodocHtml.Mod

@@ -0,0 +1,294 @@
+MODULE AutodocHtml;
+IMPORT Texts, Out, Strings, P := AutodocParser;
+
+VAR
+  PrintObject: PROCEDURE (o: P.Object; indent: INTEGER; inlined: BOOLEAN);
+  W: Texts.Writer;
+  
+  preventSemicol: BOOLEAN;
+
+(** Printing **)
+
+PROCEDURE Write(s: ARRAY OF CHAR);
+BEGIN Texts.WriteString(W, s)
+END Write;
+
+PROCEDURE WriteLn(s: ARRAY OF CHAR);
+BEGIN Write(s); Texts.WriteLn(W)
+END WriteLn;
+
+PROCEDURE WriteLn2(a, b: ARRAY OF CHAR);
+BEGIN Write(a); WriteLn(b)
+END WriteLn2;
+
+PROCEDURE WriteLn3(a, b, c: ARRAY OF CHAR);
+BEGIN Write(a); Write(b); WriteLn(c)
+END WriteLn3;
+
+PROCEDURE WriteParagraphs(s: ARRAY OF CHAR; marks: BOOLEAN);
+VAR i: INTEGER;
+  c: CHAR;
+BEGIN
+  i := 0; c := s[0];
+  IF c # 0X THEN
+    WriteLn('<p>');
+    IF marks THEN Write('<span class="mark">(*</span> ') END;
+    WHILE c # 0X DO
+      IF c = 0AX THEN WriteLn(''); WriteLn('</p>'); WriteLn('<p>')
+      ELSE Texts.Write(W, c)
+      END;
+      INC(i); c := s[i]
+    END;
+    WriteLn('');
+    IF marks THEN Write(' <span class="mark">*)</span>') END;
+    WriteLn('</p>')
+  END
+END WriteParagraphs;
+
+PROCEDURE OpenGroup(title: ARRAY OF CHAR);
+BEGIN
+  WriteLn('<article class="group">');
+  WriteLn3('<h3 class="group-title">', title, '</h3>');
+  WriteLn('<div class="group-content">');
+END OpenGroup;
+
+PROCEDURE CloseGroup;
+BEGIN WriteLn('</div>'); WriteLn('</article>')
+END CloseGroup;
+
+PROCEDURE PrintIndent(n: INTEGER);
+BEGIN
+  WHILE n > 0 DO Write('&nbsp; '); DEC(n) END
+END PrintIndent;
+
+PROCEDURE PrintComment(o: P.Object; marks: BOOLEAN);
+BEGIN
+  Write('<section class="comment">');
+  WriteParagraphs(o.comment, marks);
+  WriteLn('</section>')
+END PrintComment;
+
+PROCEDURE PrintList(L: P.List; indent: INTEGER; inlined: BOOLEAN);
+VAR o: P.Object;
+BEGIN
+  IF (L # NIL) & (L.first # NIL) THEN
+    IF L.comment[0] # 0X THEN OpenGroup(L.comment) END;
+    o := L.first;
+    WHILE o # NIL DO
+      PrintObject(o, indent, FALSE);
+      o := o.next
+    END;
+    IF L.comment[0] # 0X THEN CloseGroup END
+  END
+END PrintList;
+
+PROCEDURE PrintConst(C: P.Const; indent: INTEGER; inlined: BOOLEAN);
+BEGIN
+  WriteLn ('<article class="object const">');
+  WriteLn ('  <div class="def">');
+  WriteLn3('    <span class="name">', C.name, '</span> =');
+  WriteLn3('    <span class="value">', C.value, '</span>;');
+  WriteLn ('  </div>');
+  PrintComment(C, FALSE);
+  WriteLn ('</article>');
+END PrintConst;
+
+PROCEDURE PrintParam(par: P.Param; indent: INTEGER; inlined: BOOLEAN);
+BEGIN
+  IF par.passed = P.byVar THEN Out.String('Variable')
+  ELSIF par.passed = P.byValue THEN Out.String('Value')
+  END;
+  Out.String(' parameter '); Out.String(par.name);
+  Out.String(' of '); PrintObject(par.type, indent, TRUE)
+END PrintParam;
+
+PROCEDURE PrintVar(v: P.Var; indent: INTEGER; inlined: BOOLEAN);
+VAR tmp: BOOLEAN;
+BEGIN tmp := preventSemicol; preventSemicol := FALSE;
+  IF inlined THEN
+    Write('<span class="var">');
+    PrintIndent(indent);
+    Write('<span class="name">'); Write(v.name);
+    Write('</span>: <span class="type">');
+    PrintObject(v.type, indent, TRUE);
+    IF ~tmp THEN Write('; &nbsp;') END;
+    Write('</span></span>');
+    PrintComment(v, TRUE);
+  ELSE
+    WriteLn ('<article class="object var">');
+    WriteLn ('  <div class="def">');
+    WriteLn3('    <span class="name">', v.name, '</span>:');
+    WriteLn ('    <span class="type">');
+    PrintObject(v.type, indent, TRUE); WriteLn('</span>;');
+    WriteLn ('  </div>');
+    PrintComment(v, FALSE);
+    WriteLn ('</article>')
+  END
+END PrintVar;
+
+PROCEDURE PrintType(T: P.Type; indent: INTEGER; inlined: BOOLEAN);
+VAR x: P.Object;
+BEGIN
+  IF inlined THEN
+    IF T.form = P.namedType THEN Write(T.name)
+    ELSIF T.form = P.arrayType THEN Write('ARRAY ');
+      IF T.len[0] # 0X THEN Write(T.len); Write(' ') END;
+      Write('OF '); PrintObject(T.base, indent + 1, TRUE)
+    ELSIF T.form = P.recordType THEN Write('RECORD');
+      IF T.base # NIL THEN Write('(<span class="record-base">');
+        Write(T.base.name); Write('</span>)')
+      END;
+      x := T.fields.first;
+      IF x # NIL THEN WriteLn('<span class="record-fields">') END;
+      WHILE x # NIL DO
+        IF x = T.fields.last THEN preventSemicol := TRUE END;
+        PrintObject(x, indent + 1, TRUE);
+        x := x.next
+      END;
+      IF T.fields.first # NIL THEN WriteLn('</span>') END;
+      Write(' END')
+    END
+  ELSE
+    WriteLn ('<article class="object type">');
+    WriteLn ('  <div class="def">');
+    WriteLn3('    <span class="name">', T.name, '</span> =');
+    WriteLn ('    <span class="typedef">');
+    PrintObject(T.base, indent, TRUE); WriteLn('</span>;');
+    WriteLn ('  </div>');
+    PrintComment(T, FALSE);
+    WriteLn ('</article>');
+  END
+END PrintType;
+
+PROCEDURE PrintType2(T: P.Type; indent: INTEGER; inlined: BOOLEAN);
+VAR x: P.Object;
+BEGIN
+  PrintIndent(indent);
+  IF T = NIL THEN Out.String('NIL')
+  ELSIF T.form = P.namedType THEN
+    Out.String('type '); Out.String(T.name);
+    IF T.base # NIL THEN
+      Out.String(' is '); PrintType(T.base, indent, TRUE)
+    END
+  ELSIF T.form = P.arrayType THEN
+    IF T.len[0] = 0X THEN Out.String('open ') END;
+    Out.String('array type ');
+    IF T.len[0] # 0X THEN Out.String('with length ');
+      Out.String(T.len); Out.Char(' ')
+    END;
+    Out.String('of '); PrintObject(T.base, indent, TRUE)
+  ELSIF T.form = P.recordType THEN Out.String('record type ');
+    IF T.base # NIL THEN Out.String('that extends ');
+      Out.String(T.base.name); Out.Char(' ')
+    END;
+    IF T.fields.first # NIL THEN Out.String('with fields:'); Out.Ln;
+      PrintList(T.fields, indent + 1, FALSE)
+    ELSE Out.String('with no fields')
+    END
+  ELSIF T.form = P.procedureType THEN Out.String('procedure type ');
+    IF T.fields.first # NIL THEN
+      PrintIndent(indent); Out.Char('(');
+      PrintList(T.fields, indent + 1, TRUE);
+      Out.String(') ')
+    END;
+    IF T.base # NIL THEN
+      Out.String('that returns '); PrintObject(T.base, indent, TRUE)
+    END
+  ELSIF T.form = P.pointerType THEN Out.String('pointer type to ');
+    PrintObject(T.base, indent, TRUE)
+  ELSE Out.String('?')
+  END;
+  IF ~inlined THEN Out.Ln; PrintComment(T, FALSE) END
+END PrintType2;
+
+PROCEDURE PrintProcedure(p: P.Procedure; indent: INTEGER; inlined: BOOLEAN);
+BEGIN
+  PrintIndent(indent);
+  Out.String('P.Procedure '); Out.String(p.name);
+  IF p.returnType # NIL THEN
+    Out.String(' returns '); PrintType(p.returnType, indent, TRUE)
+  END;
+  IF p.params.first # NIL THEN
+    Out.String(', parameters:'); Out.Ln;
+    PrintList(p.params, indent + 1, FALSE)
+  ELSE Out.Ln
+  END;
+  IF ~inlined THEN Out.Ln; PrintComment(p, FALSE) END
+END PrintProcedure;
+
+PROCEDURE BigTitle(text: ARRAY OF CHAR);
+BEGIN WriteLn3('<h2>', text, '</h2>')
+END BigTitle;
+
+PROCEDURE Header(modName: ARRAY OF CHAR);
+BEGIN
+  WriteLn('<!DOCTYPE html>');
+  WriteLn('<html>');
+  WriteLn('<head>');
+  WriteLn('<meta charset="utf-8">');
+  WriteLn('<title>'); Write(modName);
+  WriteLn(' Module Reference</title>');
+  WriteLn('<meta name="viewport" content="width=device-width,initial-scale=1.0">');
+  WriteLn('<link rel="stylesheet" href="style.css">');
+  WriteLn('</head>');
+  WriteLn('<body>');
+  WriteLn('<header class="header"><div class="inner">');
+  Write('<h1>Module <span class="module-name">'); Write(modName);
+  WriteLn('</span> <span class="subtitle">Reference</span></h1>');
+  WriteLn('</div></header>');
+  WriteLn('<main class="main"><div class="inner">');
+END Header;
+
+PROCEDURE Footer;
+BEGIN
+  WriteLn('</div></main><footer class="footer"><div class="inner">');
+  WriteLn('<p>Generated automatically by Free Oberon Autodoc</p>');
+ 
+  WriteLn('</div></footer>');
+  WriteLn('</body></html>')
+END Footer;
+
+PROCEDURE PrintModule(M: P.Module; indent: INTEGER; inlined: BOOLEAN);
+BEGIN
+  Header(M.name);
+  PrintComment(M, FALSE);
+  BigTitle('Constants');
+  PrintList(M.consts, 0, FALSE);
+  BigTitle('Types');
+  PrintList(M.types, 0, FALSE);
+  BigTitle('Variables');
+  PrintList(M.vars, 0, FALSE);
+  BigTitle('Procedures');
+  PrintList(M.procedures, 0, FALSE);
+  Footer
+END PrintModule;
+
+PROCEDURE PrintObject0(o: P.Object; indent: INTEGER; inlined: BOOLEAN);
+BEGIN
+  IF o = NIL THEN WriteLn('NIL')
+  ELSIF o IS P.Module THEN PrintModule(o(P.Module), indent, inlined)
+  ELSIF o IS P.Var THEN PrintVar(o(P.Var), indent, inlined)
+  ELSIF o IS P.Const THEN PrintConst(o(P.Const), indent, inlined)
+  ELSIF o IS P.Type THEN PrintType(o(P.Type), indent, inlined)
+  ELSIF o IS P.Procedure THEN PrintProcedure(o(P.Procedure), indent, inlined)
+  ELSIF o IS P.Param THEN PrintParam(o(P.Param), indent, inlined)
+  ELSIF o IS P.List THEN PrintList(o(P.List), indent, inlined)
+  ELSE Out.String('?')
+  END;
+  IF ~inlined THEN Out.Ln END
+END PrintObject0;
+
+(** - **)
+
+PROCEDURE Save*(module: P.Module; fname: ARRAY OF CHAR): BOOLEAN;
+VAR T: Texts.Text;
+BEGIN
+  NEW(T); Texts.Open(T, ''); Texts.OpenWriter(W);
+  preventSemicol := FALSE;
+  PrintObject(module, 0, FALSE);
+  Texts.Append(T, W.buf); Texts.Close(T, fname)
+RETURN TRUE END Save;
+
+BEGIN
+  PrintObject := PrintObject0
+END AutodocHtml.

src/Autodoc/AutodocParser.Mod

@@ -74,12 +74,12 @@ TYPE
     name*: Str;
     comment*: LongStr;
     exported*: BOOLEAN;
-    next: Object
+    next*: Object
   END;
 
   List* = POINTER TO ListDesc;
   ListDesc* = RECORD(ObjectDesc)
-    first*, last: Object
+    first*, last*: Object
   END;
 
   Group* = POINTER TO GroupDesc;
@@ -631,7 +631,7 @@ BEGIN
       Out.String(') ')
     END;
     IF T.base # NIL THEN
-      Out.String('that returns '); PrintObject(T.base, ident, TRUE)
+      Out.String('that returns '); PrintObject(T.base, indent, TRUE)
     END
   ELSIF T.form = pointerType THEN Out.String('pointer type to ');
     PrintObject(T.base, indent, TRUE)

src/Autodoc/Test/style.css

@@ -0,0 +1,128 @@
+@font-face {
+  font-family: 'Inconsolata-LGC';
+  src: url(inconsolatalgcbold.ttf);
+}
+
+body, p, h1, h2, h3, h4, h5, h6 {
+  margin: 0;
+  padding: 0;
+}
+
+body {
+  font-family: 'Inconsolata-LGC', monospace, sans-serif;
+  font-size: 14px;
+  background: #FBC5AA;
+  color: #12365D;
+}
+
+a {
+  color: #D95D27;
+  text-decoration: none;
+}
+
+a:hover {
+  color: #FF4D00;
+}
+
+.inner {
+  max-width: 1160px;
+  padding: 0 20px;
+  margin: 0 auto;
+}
+
+.header {
+  padding: 30px 0;
+  background: #12365D;
+  color: #93B2D3;
+}
+
+.header h1 .module-name {
+  color: #FFF;
+}
+
+.header h1 .subtitle {
+  display: block;
+  font-size: 16px;
+  color: #4D89C7;
+}
+
+.footer {
+  padding: 50px 0;
+  background: #2D5E90;
+  color: #FFF;
+}
+
+.footer p {
+  text-align: center;
+}
+
+.main {
+  padding: 20px 0;
+}
+
+.main h2, .main h3, .main h4, .main h5, .main h6 {
+  margin: 1.2em 0 0.5em;
+}
+
+.group {
+
+}
+
+.group-content {
+
+}
+
+.object {
+  background: #FFF;
+  border: 1px solid #808080;
+  padding: 2px;
+  margin: 6px 0;
+  box-shadow: 0 1px 3px rgba(1, 0, 0, 0.1);
+}
+
+.object .def {
+  background: #FFBF44;
+  border: 1px solid #F8BA42;
+  padding: 2px 5px;
+}
+
+.object .name,
+.object .record-base {
+  color: #C91E0C;
+}
+
+.const .value {
+  color: #000;
+}
+
+.comment {
+  padding: 10px 6px;
+  color: #2D5E90;
+}
+
+.comment:empty {
+  display: none;
+}
+
+.record-fields .comment {
+  color: #C91E0C;
+}
+
+.comment .mark {
+  color: #D1702C;
+}
+
+.record-fields {
+  display: grid;
+  grid-template-columns: auto 1fr;
+}
+
+.record-fields .var {
+}
+
+.record-fields .comment {
+  padding: 0;
+}
+
+.record-field .comment p {
+}