cm3ide/src/nodes/Roots.m3


 Copyright 1996 Critical Mass, Inc. All rights reserved.    

MODULE Roots;

IMPORT FmtTime, FS, IntList, IntRefTbl, OSError, Pathname, Text, Thread, Wr;
IMPORT BrowserDB, BuildCache, (**ClassDir,**) ConfigItem, Default, Dir, ErrLog, FileDir;
IMPORT FileNode, Fixed, HTML, ID, LexMisc, Node, OS, Pkg, PkgRoot, RegExpr, Type;
IMPORT WebServer, Wx;

TYPE NC = Node.Class;

VAR
  viewID   := ID.Add ("view");
  rescanID := ID.Add ("rescan");

PROCEDURE Init () =
  BEGIN
    PkgRootRoot := NEW (RootRoot, name := ID.Add ("root"));
    WebServer.RegisterRoot ("root", PkgRootRoot);

    AnyPkgRoot := NEW (PkgRoots, name := ID.Add ("package"));
    (** AddClassEntries (AnyPkgRoot); **)
    WebServer.RegisterRoot ("package", AnyPkgRoot);
    WebServer.RegisterRoot ("pkg", AnyPkgRoot);

    ResourceRoot := NEW (FixedRoot, name := ID.Add ("rsrc"));
    WebServer.RegisterRoot ("rsrc", ResourceRoot);

    TypeRoot := NEW (TNameRoot, name := ID.Add ("type"));
    WebServer.RegisterRoot ("type", TypeRoot);

    TypeUIDRoot := NEW (TUIDRoot, name := ID.Add ("type-uid"));
    WebServer.RegisterRoot ("type-uid", TypeUIDRoot);
    WebServer.RegisterRoot ("type uid", TypeUIDRoot);
    WebServer.RegisterRoot ("uid", TypeUIDRoot);

    InterfaceRoot := NEW (SourceRoot, name := ID.Add ("interface"),
                        kind := NC.Interface);
    WebServer.RegisterRoot ("interface", InterfaceRoot);
    WebServer.RegisterRoot ("intf", InterfaceRoot);

    ModuleRoot :=  NEW (SourceRoot, name := ID.Add ("module"),
                        kind := NC.Module);
    WebServer.RegisterRoot ("module", ModuleRoot);
    WebServer.RegisterRoot ("implementation", ModuleRoot);
    WebServer.RegisterRoot ("impl", ModuleRoot);

    GenIntfRoot :=  NEW (SourceRoot, name := ID.Add ("generic-interface"),
                        kind := NC.GenericInterface);
    WebServer.RegisterRoot ("generic-interface", GenIntfRoot);
    WebServer.RegisterRoot ("generic interface", GenIntfRoot);
    WebServer.RegisterRoot ("generic-intf", GenIntfRoot);
    WebServer.RegisterRoot ("generic intf", GenIntfRoot);
    WebServer.RegisterRoot ("gen-interface", GenIntfRoot);
    WebServer.RegisterRoot ("gen interface", GenIntfRoot);
    WebServer.RegisterRoot ("gen-intf", GenIntfRoot);
    WebServer.RegisterRoot ("gen intf", GenIntfRoot);

    GenImplRoot := NEW (SourceRoot, name := ID.Add ("generic-module"),
                        kind := NC.GenericModule);
    WebServer.RegisterRoot ("generic-module", GenImplRoot);
    WebServer.RegisterRoot ("generic module", GenImplRoot);
    WebServer.RegisterRoot ("generic-implementation", GenImplRoot);
    WebServer.RegisterRoot ("generic implementation", GenImplRoot);
    WebServer.RegisterRoot ("generic-impl", GenImplRoot);
    WebServer.RegisterRoot ("generic impl", GenImplRoot);
    WebServer.RegisterRoot ("gen-module", GenImplRoot);
    WebServer.RegisterRoot ("gen module", GenImplRoot);
    WebServer.RegisterRoot ("gen-implementation", GenImplRoot);
    WebServer.RegisterRoot ("gen implementation", GenImplRoot);
    WebServer.RegisterRoot ("gen-impl", GenImplRoot);
    WebServer.RegisterRoot ("gen impl", GenImplRoot);

    CsourceRoot := NEW (SourceRoot, name := ID.Add ("c-source"),
                        kind := NC.CSource);
    WebServer.RegisterRoot ("c-source", CsourceRoot);
    WebServer.RegisterRoot ("c source", CsourceRoot);

    HsourceRoot := NEW (SourceRoot, name := ID.Add ("h-source"),
                        kind := NC.HSource);
    WebServer.RegisterRoot ("h-source", HsourceRoot);
    WebServer.RegisterRoot ("h source", HsourceRoot);

    AnyUnitRoot := NEW (UnitRoot, name := ID.Add ("unit"));
    WebServer.RegisterRoot ("unit", AnyUnitRoot);
    WebServer.RegisterRoot ("source", AnyUnitRoot);

    ImporterRoot := NEW (ImportRoot, name := ID.Add ("importer"));
    WebServer.RegisterRoot ("importer", ImporterRoot);

    ExporterRoot := NEW (ExportRoot, name := ID.Add ("exporter"));
    WebServer.RegisterRoot ("exporter", ExporterRoot);

    LibraryRoot := NEW (DerivedRoot, name := ID.Add ("library"), pgm := FALSE);
    WebServer.RegisterRoot ("library", LibraryRoot);
    WebServer.RegisterRoot ("lib", LibraryRoot);

    ProgramRoot := NEW (DerivedRoot, name := ID.Add ("program"), pgm := TRUE);
    WebServer.RegisterRoot ("program", ProgramRoot);
    WebServer.RegisterRoot ("pgm", ProgramRoot);

    BuildCacheRoot := NEW (CacheRoot, name := ID.Add ("build-cache"));
    WebServer.RegisterRoot ("build-cache", BuildCacheRoot);

    TutorialRoot := NEW (DocumentRoot, name := ID.Add ("tutorial"),
                         base := "tutorial", title := "Modula-3 Tutorial");
    WebServer.RegisterRoot ("tutorial", TutorialRoot);

    HelpRoot := NEW (DocumentRoot,  name := ID.Add ("help"),
                     base := "help",  title := "CM3-IDE Help");
    WebServer.RegisterRoot ("help", HelpRoot);

    RefManualRoot := NEW (DocumentRoot, name := ID.Add ("reference"),
                          base := "reference",
                          title := "Critical Mass Modula-3 Reference Manual");
    WebServer.RegisterRoot ("ref", RefManualRoot);
    WebServer.RegisterRoot ("reference", RefManualRoot);

    SRCReportRoot := NEW (DocumentRoot, name := ID.Add ("SRC_report"),
                          base := "src_reports", title := "SRC Research Reports");
    WebServer.RegisterRoot ("SRC_report", SRCReportRoot);
    WebServer.RegisterRoot ("src_report", SRCReportRoot);

    ExampleRoot := NEW (ExamplesRoot, name := ID.Add ("example"));
    WebServer.RegisterRoot ("example", ExampleRoot);

    ConsoleLogRoot := NEW (LogRoot, name := ID.Add ("log"));
    WebServer.RegisterRoot ("log", ConsoleLogRoot);

    UserHomeDir := NEW (UserRoot, name := ID.Add ("user"));
    WebServer.RegisterRoot ("user", UserHomeDir);
  END Init;

PROCEDURE RootClass (<*UNUSED*> self: Node.T): Node.Class =
  BEGIN
    RETURN Node.Class.Root;
  END RootClass;

PROCEDURE GenScanWarning (wx: Wx.T)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    IF BrowserDB.n_updates < 1 THEN
      wx.put ("<P>\n<STRONG>Initial package scan is still underway...</STRONG>\n");
      wx.put ("<META HTTP-EQUIV=\"Refresh\" CONTENT=2>\n");
    ELSE
      wx.put ("<P>\nLast scanned: ",
              FmtTime.Short (OS.FileToM3Time (BrowserDB.last_update)),
              "\n");
    END;
  END GenScanWarning;

PROCEDURE TableIterate (tbl: IntRefTbl.T;  VAR s: Node.IteratorState) =
  VAR nm := RegExpr.SimpleString (s.pattern);  ref: REFANY;
  BEGIN
    s.d := NIL;
    s.e := NIL;
    s.f := NIL;

    (* try a direct hit instead of a full scan! *)
    IF (nm # NIL) AND (tbl # NIL) AND tbl.get (ID.Add (nm), ref)
      THEN s.d := ref;
      ELSE s.e := tbl.iterate ();
    END;
  END TableIterate;

TYPE FilterProc = PROCEDURE (root, node: Node.T): BOOLEAN;

PROCEDURE TableNext (root: Node.T;  VAR s: Node.IteratorState;
                     filter: FilterProc): BOOLEAN =
  VAR
    nd   : Node.List;
    n    : Node.T;
    iter : IntRefTbl.Iterator;
    nm   : INTEGER;
    ref  : REFANY;
  BEGIN
    IF (s.d # NIL) THEN
      (* try the direct hits first *)
      nd := s.d;  s.d := nd.tail;
      WHILE (nd # NIL) DO
        n := nd.head;  nd := nd.tail;  s.d := nd;
        IF (filter = NIL) OR filter (root, n) THEN
          s.match := n;
          RETURN TRUE;
        END;
      END;
    END;

    WHILE (s.e # NIL) DO
      nd := s.f;
      WHILE (nd # NIL) DO
        n := nd.head;  nd := nd.tail;  s.f := nd;
        IF ((filter = NIL) OR filter (root, n)) AND n.match (s.pattern) THEN
          s.match := n;
          RETURN TRUE;
        END;
      END;

      iter := s.e;
      IF NOT iter.next (nm, ref) THEN EXIT; END;
      s.f := ref;
    END;

    (* failed... *)
    s.d := NIL;
    s.e := NIL;
    s.f := NIL;
    RETURN FALSE;
  END TableNext;

PROCEDURE NameTableNext (VAR s: Node.IteratorState): BOOLEAN =
  VAR
    nd   : Node.List;
    iter : IntRefTbl.Iterator;
    nms  : IntList.T;
    nm   : INTEGER;
    ref  : REFANY;
  BEGIN
    WHILE (s.f # NIL) OR (s.e # NIL) OR (s.d # NIL) DO
      IF (s.f # NIL) THEN
        (* return the next unit *)
        nd := s.f;  s.f := nd.tail;
        s.match := nd.head;
        RETURN TRUE;
      END;

      IF (s.d # NIL) THEN
        (* try the current name list *)
        nms := s.d;
        WHILE (nms # NIL) AND (s.f = NIL) DO
          nm := nms.head;  nms := nms.tail;  s.d := nms;
          IF BrowserDB.db.units.get (nm, ref) THEN
            s.f := ref;
          END;
        END;
      END;

      WHILE (s.e # NIL) AND (s.d = NIL) AND (s.f = NIL) DO
        iter := s.e;
        IF NOT iter.next (nm, ref) THEN s.e := NIL; EXIT; END;
        IF RegExpr.Match (s.pattern, ID.ToText (nm)) THEN
          s.d := ref;
        END;
      END;

    END; (*WHILE*)
    RETURN FALSE;
  END NameTableNext;

PROCEDURE TableEnumerate (root: Node.T;  tbl: IntRefTbl.T;
                          filter: FilterProc): Node.Set =
  VAR
    results : Node.Set;
    iter    := tbl.iterate ();
    nm      : INTEGER;
    ref     : REFANY;
    nd      : Node.List;
  BEGIN
    WHILE iter.next (nm, ref) DO
      nd := ref;
      WHILE (nd # NIL) DO
        IF (filter = NIL) OR filter (root, nd.head) THEN
          Node.Append (results, nd.head);
        END;
        nd := nd.tail;
      END;
    END;
    RETURN results;
  END TableEnumerate;

PROCEDURE GenTable (root: Node.T;  tbl: IntRefTbl.T;
                    filter: FilterProc;  wx: Wx.T)
  RAISES {Wr.Failure, Thread.Alerted} =
  VAR results := TableEnumerate (root, tbl, filter);
  BEGIN
    HTML.GenChoices (results, wx);
  END GenTable;
------------------------------------------------ package root nodes ---

TYPE
  RootRoot = Node.Named_T OBJECT
  OVERRIDES
    class      := RootClass;
    iterate    := RootRootIterate;
    next       := RootRootNext;
    gen_page   := RootRootPage;
  END;

PROCEDURE RootRootIterate (<*UNUSED*> self: RootRoot;  VAR s: Node.IteratorState) =
  BEGIN
    s.d := PkgRoot.First ();
  END RootRootIterate;

PROCEDURE RootRootNext (<*UNUSED*> self: RootRoot;
                        VAR s: Node.IteratorState): BOOLEAN =
  VAR nd: PkgRoot.T;
  BEGIN
    nd := s.d;
    WHILE (nd # NIL) DO
      s.d := nd.sibling;
      IF nd.match (s.pattern) THEN
        s.match := nd;
        RETURN TRUE;
      END;
      nd := nd.sibling;
    END;
    RETURN FALSE;
  END RootRootNext;

PROCEDURE RootRootPage (self: RootRoot;  wx: Wx.T;
                       action: ID.T;  data: Node.FormData)
  RAISES {Wr.Failure, Thread.Alerted} =
  VAR nd: PkgRoot.T;  results: Node.Set;
  BEGIN
    HTML.BeginXX (self, wx, "Package roots");
    GenScanWarning (wx);

    wx.put ("<P>\n<TABLE><TR>\n");
    GenButton ("./[rescan]", "Rescan", wx);
    GenButton ("/form/new-pkg/", "Create package", wx);
    wx.put ("</TR></TABLE>\n");

    IF (action = rescanID) THEN
      BrowserDB.Refresh (wx);
      action := viewID;
    ELSE
      nd := PkgRoot.First ();
      WHILE (nd # NIL) DO
        Node.Append (results, nd);
        nd := nd.sibling;
      END;
      HTML.GenChoices (results, wx);
    END;

    HTML.ViewOnly (action, data, wx);
    HTML.End (wx);
  END RootRootPage;
------------------------------------------------ package root nodes ---

TYPE
  PkgRoots = Node.Named_T OBJECT
** build_class : ClassDir.T; browse_class : ClassDir.T; *
  OVERRIDES
    class      := RootClass;
    iterate    := PkgRootIterate;
    next       := PkgRootNext;
    gen_page   := PkgRootPage;
  END;
** PROCEDURE AddClassEntries (t: PkgRoots) = BEGIN t.build_class := NEW (ClassDir.T, name := Node.ClassID[Node.Class.BuildPackage], kind := Node.Class.BuildPackage, parent := t); t.browse_class := NEW (ClassDir.T, name := Node.ClassID[Node.Class.BrowsePackage], kind := Node.Class.BrowsePackage, parent := t); END AddClassEntries; **

PROCEDURE PkgRootIterate (<*UNUSED*> self: PkgRoots;  VAR s: Node.IteratorState) =
  BEGIN
    TableIterate (BrowserDB.db.packages, s);
    s.a := 0; (* phase *)
    s.f := NIL;
  END PkgRootIterate;

PROCEDURE PkgRootNext (self: PkgRoots;  VAR s: Node.IteratorState): BOOLEAN =
  VAR root: Node.Named_T;
  BEGIN
    IF (s.a = 0) THEN
      IF TableNext (self, s, NIL) THEN RETURN TRUE; END;
      s.f := PkgRoot.First ();
      INC (s.a);
    END;
    IF (s.a = 1) THEN
      WHILE (s.f # NIL) DO
        root := s.f;  s.f := root.sibling;
        IF root.match (s.pattern) THEN
          s.match := root;
          RETURN TRUE;
        END;
      END;
      INC (s.a);
    END;
    RETURN FALSE;
  END PkgRootNext;

PROCEDURE PkgRootPage (self: PkgRoots;  wx: Wx.T;
                       action: ID.T;  data: Node.FormData)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    HTML.BeginXX (self, wx, "Packages");
    GenScanWarning (wx);

    wx.put ("<P>\n<TABLE><TR>\n");
    GenButton ("./[rescan]", "Rescan", wx);
    GenButton ("/form/new-pkg/", "Create package", wx);
    wx.put ("</TR></TABLE>\n");

    IF (action = rescanID) THEN
      BrowserDB.Refresh (wx);
      action := viewID;
    ELSE
      GenTable (self, BrowserDB.db.packages, NIL, wx);
    END;

    HTML.ViewOnly (action, data, wx);
    HTML.End (wx);
  END PkgRootPage;

PROCEDURE GenButton (url, label: TEXT;  wx: Wx.T)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    wx.put ("<TD><FORM method=get action=\"", url, "\">");
    wx.put ("<INPUT TYPE=submit VALUE=\"", label, "\"></FORM></TD>\n");
  END GenButton;
-------------------------------------------------- fixed root nodes ---

TYPE
  FixedRoot = Node.Named_T OBJECT
  OVERRIDES
    class      := RootClass;
    iterate    := FixedRootIterate;
    next       := FixedRootNext;
    gen_page   := FixedRootPage;
  END;

PROCEDURE FixedRootIterate (<*UNUSED*> self: FixedRoot;
                            VAR s: Node.IteratorState) =
  BEGIN
    s.d := RegExpr.SimpleString (s.pattern);
  END FixedRootIterate;

PROCEDURE FixedRootNext (<*UNUSED*> self: FixedRoot;
                         VAR s: Node.IteratorState): BOOLEAN =
  BEGIN
    IF (s.d # NIL) THEN
      s.match := Fixed.Find (s.d);
      s.d := NIL;
      IF (s.match # NIL) THEN RETURN TRUE; END;
    END;
    RETURN FALSE;
  END FixedRootNext;

PROCEDURE FixedRootPage (self: FixedRoot;  wx: Wx.T;
                         action: ID.T;  data: Node.FormData)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    HTML.BeginXX (self, wx, "Fixed resources");
    HTML.ViewOnly (action, data, wx);
    HTML.End (wx);
  END FixedRootPage;
-------------------------------------------------- user root nodes ---

TYPE
  UserRoot = Node.Named_T OBJECT
    home  : TEXT;
    root  : FileDir.T := NIL;
  OVERRIDES
    class      := RootClass;
    iterate    := UserRootIterate;
    next       := UserRootNext;
    gen_page   := UserRootPage;
  END;

PROCEDURE UserRootIterate (self: UserRoot;
                           VAR s: Node.IteratorState) =
  VAR user_home := ConfigItem.X [ConfigItem.T.Homepage].text;
  BEGIN
    IF (user_home # NIL) AND Text.Length (user_home) > 0 THEN
      IF (self.home = NIL) OR NOT OS.FileNameEq (user_home, self.home) THEN
        (* we have a new root *)
        self.home := user_home;
        self.root := NEW (FileDir.T, name := ID.Add ("user"),
                           path := Pathname.Prefix (user_home));
      END;
    ELSE
      self.root := NIL;
    END;
    IF (self.root # NIL) THEN self.root.iterate (s); END;
  END UserRootIterate;

PROCEDURE UserRootNext (self: UserRoot;
                        VAR s: Node.IteratorState): BOOLEAN =
  BEGIN
    IF (self.root # NIL)
      THEN RETURN self.root.next (s);
      ELSE RETURN FALSE;
    END;
  END UserRootNext;

PROCEDURE UserRootPage (self: UserRoot;  wx: Wx.T;
                         action: ID.T;  data: Node.FormData)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    IF (self.root # NIL) THEN
      self.root.gen_page (wx, action, data);
    ELSE
      HTML.BeginXX (self, wx, "User pages");
      HTML.ViewOnly (action, data, wx);
      HTML.End (wx);
    END;
  END UserRootPage;
---------------------------------------------- type name root nodes ---

TYPE
  TNameRoot = Node.Named_T OBJECT
  OVERRIDES
    class      := RootClass;
    iterate    := TNameRootIterate;
    next       := TNameRootNext;
    gen_page   := TNameRootPage;
  END;

PROCEDURE TNameRootIterate (<*UNUSED*> self: TNameRoot;
                            VAR s: Node.IteratorState) =
  BEGIN
    TableIterate (BrowserDB.db.type_names, s);
  END TNameRootIterate;

PROCEDURE TNameRootNext (self: TNameRoot;  VAR s: Node.IteratorState): BOOLEAN =
  BEGIN
    RETURN TableNext (self, s, NIL);
  END TNameRootNext;

PROCEDURE TNameRootPage (self: TNameRoot;  wx: Wx.T;
                         action: ID.T;  data: Node.FormData)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    HTML.BeginXX (self, wx, "Types");
    GenScanWarning (wx);
    GenTable (self, BrowserDB.db.type_names, NIL, wx);
    HTML.ViewOnly (action, data, wx);
    HTML.End (wx);
  END TNameRootPage;
----------------------------------------------- type UID root nodes ---

TYPE
  TUIDRoot = Node.Named_T OBJECT
  OVERRIDES
    class      := RootClass;
    iterate    := TUIDRootIterate;
    next       := TUIDRootNext;
    gen_page   := TUIDRootPage;
  END;

PROCEDURE TUIDRootIterate (<*UNUSED*> self: TUIDRoot;  VAR s: Node.IteratorState) =
  VAR txt := RegExpr.SimpleString (s.pattern);
  BEGIN
    IF (txt # NIL) THEN
      IF NOT BrowserDB.db.types.get (LexMisc.ScanUID (txt), s.d) THEN
        s.d := NIL;
      END;
      s.e := NIL;
    ELSE
      s.d := NIL;
      s.e := BrowserDB.db.types.iterate ();
    END;
  END TUIDRootIterate;

PROCEDURE TUIDRootNext (<*UNUSED*> self: TUIDRoot;
                        VAR s: Node.IteratorState): BOOLEAN =
  VAR
    iter : IntRefTbl.Iterator;
    uid  : INTEGER;
    ref  : REFANY;
    info : Type.Info;
  BEGIN
    IF (s.d # NIL) THEN
      info := s.d;  s.d := NIL;
      IF (info.names # NIL)
        THEN s.match := info.names;
        ELSE s.match := NEW (Type.T, uid := info.uid);
      END;
      RETURN TRUE;
    END;

    IF (s.e # NIL) THEN
      iter := s.e;
      WHILE iter.next (uid, ref) DO
        IF RegExpr.Match (s.pattern, LexMisc.FmtUID (uid)) THEN
          info := ref;
          IF (info.names # NIL) THEN
            s.match := info.names;
            RETURN TRUE;
          END;
        END;
      END;
      s.e := NIL;
    END;

    RETURN FALSE;
  END TUIDRootNext;

PROCEDURE TUIDRootPage (self: TUIDRoot;  wx: Wx.T;
                        action: ID.T;  data: Node.FormData)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    HTML.BeginXX (self, wx, "Types");
    GenScanWarning (wx);
    GenTable (self, BrowserDB.db.type_names, NIL, wx);
    HTML.ViewOnly (action, data, wx);
    HTML.End (wx);
  END TUIDRootPage;
------------------------------------------------- source root nodes ---

TYPE
  SourceRoot = Node.Named_T OBJECT
    kind : Node.Class;
  OVERRIDES
    class      := RootClass;
    iterate    := SourceRootIterate;
    next       := SourceRootNext;
    gen_page   := SourceRootPage;
  END;

PROCEDURE SourceRootIterate (<*UNUSED*> self: SourceRoot;
                             VAR s: Node.IteratorState) =
  BEGIN
    TableIterate (BrowserDB.db.units, s);
  END SourceRootIterate;

PROCEDURE SourceRootNext (self: SourceRoot;  VAR s: Node.IteratorState): BOOLEAN =
  BEGIN
    RETURN TableNext (self, s, SourceFilter);
  END SourceRootNext;

PROCEDURE SourceFilter (root, node: Node.T): BOOLEAN =
  VAR self: SourceRoot := root;
  BEGIN
    RETURN (self.kind = node.class ());
  END SourceFilter;

PROCEDURE SourceRootPage (self: SourceRoot;  wx: Wx.T;
                          action: ID.T;  data: Node.FormData)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    HTML.BeginXX (self, wx, Node.ClassPlural [self.kind]);
    GenScanWarning (wx);
    GenTable (self, BrowserDB.db.units, SourceFilter, wx);
    HTML.ViewOnly (action, data, wx);
    HTML.End (wx);
  END SourceRootPage;
--------------------------------------------------- unit root nodes ---

TYPE
  UnitRoot = Node.Named_T OBJECT
    pgm : BOOLEAN;
  OVERRIDES
    class      := RootClass;
    iterate    := UnitRootIterate;
    next       := UnitRootNext;
    gen_page   := UnitRootPage;
  END;

PROCEDURE UnitRootIterate (<*UNUSED*> self: UnitRoot;
                           VAR s: Node.IteratorState) =
  BEGIN
    TableIterate (BrowserDB.db.units, s);
  END UnitRootIterate;

PROCEDURE UnitRootNext (self: UnitRoot;  VAR s: Node.IteratorState): BOOLEAN =
  BEGIN
    RETURN TableNext (self, s, NIL);
  END UnitRootNext;

PROCEDURE UnitRootPage (self: UnitRoot;  wx: Wx.T;
                        action: ID.T;  data: Node.FormData)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    HTML.BeginXX (self, wx, "Source units");
    GenScanWarning (wx);
    GenTable (self, BrowserDB.db.units, NIL, wx);
    HTML.ViewOnly (action, data, wx);
    HTML.End (wx);
  END UnitRootPage;
------------------------------------------------- import root nodes ---

TYPE
  ImportRoot = Node.Named_T OBJECT
  OVERRIDES
    class      := RootClass;
    iterate    := ImportRootIterate;
    next       := ImportRootNext;
    gen_page   := ImportRootPage;
  END;

PROCEDURE ImportRootIterate (<*UNUSED*> self: ImportRoot;
                             VAR s: Node.IteratorState) =
  BEGIN
    TableIterate (BrowserDB.db.importers, s);
  END ImportRootIterate;

PROCEDURE ImportRootNext (<*UNUSED*> self: ImportRoot;
                          VAR s: Node.IteratorState): BOOLEAN =
  BEGIN
    RETURN NameTableNext (s);
  END ImportRootNext;

PROCEDURE ImportRootPage (self: ImportRoot;  wx: Wx.T;
                          action: ID.T;  data: Node.FormData)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    HTML.BeginXX (self, wx, "Interface importers");
    GenScanWarning (wx);
    GenTable (self, BrowserDB.db.units, ImportFilter, wx);
    HTML.ViewOnly (action, data, wx);
    HTML.End (wx);
  END ImportRootPage;

PROCEDURE ImportFilter (<*UNUSED*> root: Node.T;  node: Node.T): BOOLEAN =
  VAR c := node.class ();
  BEGIN
    (* assume any M3 source is an importer *)
    RETURN (Node.Class.Interface <= c)
       AND (c <= Node.Class.GenericModule);
  END ImportFilter;
------------------------------------------------- export root nodes ---

TYPE
  ExportRoot = Node.Named_T OBJECT
  OVERRIDES
    class      := RootClass;
    iterate    := ExportRootIterate;
    next       := ExportRootNext;
    gen_page   := ExportRootPage;
  END;

PROCEDURE ExportRootIterate (<*UNUSED*> self: ExportRoot;
                             VAR s: Node.IteratorState) =
  BEGIN
    TableIterate (BrowserDB.db.exporters, s);
  END ExportRootIterate;

PROCEDURE ExportRootNext (<*UNUSED*> self: ExportRoot;
                          VAR s: Node.IteratorState): BOOLEAN =
  BEGIN
    RETURN NameTableNext (s);
  END ExportRootNext;

PROCEDURE ExportRootPage (self: ExportRoot;  wx: Wx.T;
                          action: ID.T;  data: Node.FormData)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    HTML.BeginXX (self, wx, "Interface exporters");
    GenScanWarning (wx);
    GenTable (self, BrowserDB.db.units, ExportFilter, wx);
    HTML.ViewOnly (action, data, wx);
    HTML.End (wx);
  END ExportRootPage;

PROCEDURE ExportFilter (<*UNUSED*> root: Node.T;  node: Node.T): BOOLEAN =
  BEGIN
    RETURN node.class () = Node.Class.Module;
  END ExportFilter;
------------------------------------------------ derived root nodes ---

TYPE
  DerivedRoot = Node.Named_T OBJECT
    pgm : BOOLEAN;
  OVERRIDES
    class      := RootClass;
    iterate    := DerivedRootIterate;
    next       := DerivedRootNext;
    gen_page   := DerivedRootPage;
  END;

PROCEDURE DerivedRootIterate (self: DerivedRoot;  VAR s: Node.IteratorState) =
  BEGIN
    IF self.pgm
      THEN TableIterate (BrowserDB.db.pgms, s);
      ELSE TableIterate (BrowserDB.db.libs, s);
    END;
  END DerivedRootIterate;

PROCEDURE DerivedRootNext (self: DerivedRoot;  VAR s: Node.IteratorState): BOOLEAN =
  BEGIN
    RETURN TableNext (self, s, NIL);
  END DerivedRootNext;

PROCEDURE DerivedRootPage (self: DerivedRoot;  wx: Wx.T;
                           action: ID.T;  data: Node.FormData)
  RAISES {Wr.Failure, Thread.Alerted} =
  CONST Map = ARRAY BOOLEAN OF NC { NC.Library, NC.Program };
  BEGIN
    HTML.BeginXX (self, wx, Node.ClassPlural [Map [self.pgm]]);
    GenScanWarning (wx);
    IF self.pgm
      THEN GenTable (self, BrowserDB.db.pgms, NIL, wx);
      ELSE GenTable (self, BrowserDB.db.libs, NIL, wx);
    END;
    HTML.ViewOnly (action, data, wx);
    HTML.End (wx);
  END DerivedRootPage;
-------------------------------------------- build cache root nodes ---

TYPE
  CacheRoot = Node.Named_T OBJECT
  OVERRIDES
    class      := RootClass;
    iterate    := CacheRootIterate;
    next       := CacheRootNext;
    gen_page   := CacheRootPage;
  END;

PROCEDURE CacheRootIterate (<*UNUSED*> self: CacheRoot;
                            VAR s: Node.IteratorState) =
  VAR c := BuildCache.cache;
  BEGIN
    IF (c # NIL)
      THEN s.a := 1; TableIterate (c, s);
      ELSE s.a := 0;
    END;
  END CacheRootIterate;

PROCEDURE CacheRootNext (self: CacheRoot;  VAR s: Node.IteratorState): BOOLEAN =
  BEGIN
    IF (s.a # 0) THEN RETURN TableNext (self, s, NIL); END;
    RETURN FALSE;
  END CacheRootNext;

PROCEDURE CacheRootPage (self: CacheRoot;  wx: Wx.T;
                         action: ID.T;  data: Node.FormData)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    HTML.BeginXX (self, wx, "Build cache");
    GenScanWarning (wx);
    IF (BuildCache.cache # NIL) THEN
      GenTable (self, BuildCache.cache, NIL, wx);
    END;
    HTML.ViewOnly (action, data, wx);
    HTML.End (wx);
  END CacheRootPage;
------------------------------------------ documentation root nodes ---

TYPE
  DocumentRoot = Dir.T OBJECT
    base  : TEXT;
    title : TEXT;
    tbl   : IntRefTbl.T := NIL;
  OVERRIDES
    class      := RootClass;
    iterate    := DocumentRootIterate;
    next       := DocumentRootNext;
    gen_page   := DocumentRootPage;
  END;

PROCEDURE DocumentRootIterate (self: DocumentRoot;
                            VAR s: Node.IteratorState) =
  BEGIN
    IF self.tbl = NIL THEN ScanDocDir (self); END;
    TableIterate (self.tbl, s);
  END DocumentRootIterate;

PROCEDURE DocumentRootNext (self: DocumentRoot;
                            VAR s: Node.IteratorState): BOOLEAN =
  BEGIN
    RETURN TableNext (self, s, NIL);
  END DocumentRootNext;

PROCEDURE DocumentRootPage (self: DocumentRoot;  wx: Wx.T;
                         action: ID.T;  data: Node.FormData)
  RAISES {Wr.Failure, Thread.Alerted} =
  VAR ref: REFANY;
  BEGIN
    IF self.tbl = NIL THEN ScanDocDir (self); END;
    IF self.tbl.get (ID.Add ("index.html"), ref) THEN
      NARROW (ref, Node.List).head.gen_page (wx, action, data);
    ELSE
      HTML.BeginXX (self, wx, self.title);
      GenTable (self, self.tbl, NIL, wx);
      HTML.ViewOnly (action, data, wx);
      HTML.End (wx);
    END;
  END DocumentRootPage;

PROCEDURE ScanDocDir (self: DocumentRoot) =
  VAR
    root := OS.MakePath (Default.doc_root, self.base);
    d: Dir.T;
    n: Node.Named_T;
  BEGIN
    self.scanned  := OS.Now ();
    self.contents := NIL;
    self.tbl      := NEW (IntRefTbl.Default).init ();

    IF OS.IsDirectory (root) THEN
      d := ScanDir (self.base, root);
      self.contents := d.contents;
    END;

    (* steal the directory's contents away & build the table *)
    n := self.contents;
    WHILE (n # NIL) DO
      n.parent := self;
      EVAL self.tbl.put (n.name, NEW (Node.List, head := n, tail := NIL));
      n := n.sibling;
    END;
  END ScanDocDir;

PROCEDURE ScanDir (dir_name, dir_path: TEXT): Dir.T =
  VAR iter: FS.Iterator;  nm, path: TEXT;   self: Dir.T;  n: Node.Named_T;
  BEGIN
    self := NEW (Dir.T, name := ID.Add (dir_name), contents := NIL);
    TRY
      iter := FS.Iterate (dir_path);
      TRY
        WHILE iter.next (nm) DO
          path := OS.MakePath (dir_path, nm);
          IF OS.IsDirectory (path)
            THEN n := ScanDir (nm, path);
            ELSE n := NEW (FileNode.T, name := ID.Add (nm), path := path);
          END;
          n.parent := self;
          n.sibling := self.contents;
          self.contents := n;
        END;
      FINALLY
        iter.close ();
      END;
    EXCEPT OSError.E (ec) =>
      ErrLog.Msg ("trouble scanning document directory: ",
                   dir_path, OS.Err (ec));
    END;
    RETURN self;
  END ScanDir;
----------------------------------------------- example root nodes ---

TYPE
  ExamplesRoot = Node.Named_T OBJECT
    root     : TEXT    := NIL;
    contents : Example := NIL;
  OVERRIDES
    class      := RootClass;
    iterate    := ExamplesRootIterate;
    next       := ExamplesRootNext;
    gen_page   := ExamplesRootPage;
  END;

  Example = REF RECORD
    name : TEXT    := NIL;
    node : Node.T  := NIL;
    next : Example := NIL;
  END;

PROCEDURE ExamplesRootIterate (self: ExamplesRoot;
                            VAR s: Node.IteratorState) =
  BEGIN
    IF self.root = NIL THEN ScanExamples (self); END;
    s.d := self.contents;
  END ExamplesRootIterate;

PROCEDURE ExamplesRootNext (self: ExamplesRoot;
                            VAR s: Node.IteratorState): BOOLEAN =
  VAR ex: Example;
  BEGIN
    WHILE s.d # NIL DO
      ex := s.d;  s.d := ex.next;
      IF RegExpr.Match (s.pattern, ex.name) THEN
        IF (ex.node # NIL)
          THEN s.match := ex.node;
          ELSE s.match := FindExamplePkg (self.root, ex);
        END;
        RETURN TRUE;
      END;
    END;
    RETURN FALSE;
  END ExamplesRootNext;

PROCEDURE ExamplesRootPage (self: ExamplesRoot;  wx: Wx.T;
                         action: ID.T;  data: Node.FormData)
  RAISES {Wr.Failure, Thread.Alerted} =
  VAR ex: Example;
  BEGIN
    IF self.root = NIL THEN ScanExamples (self); END;
    ex := self.contents;
    WHILE (ex # NIL)
      AND (NOT OS.FileNameEq (ex.name, "index.html"))
      AND (NOT OS.FileNameEq (ex.name, "index.htm")) DO
      ex := ex.next;
    END;
    IF (ex # NIL) THEN
      ex.node.gen_page (wx, action, data);
    ELSE
      HTML.BeginXX (self, wx, "CM3-IDE examples");
      wx.put ("<STRONG>The CM3-IDE examples are missing.</STRONG>\n");
      HTML.ViewOnly (action, data, wx);
      HTML.End (wx);
    END;
  END ExamplesRootPage;

PROCEDURE ScanExamples (self: ExamplesRoot) =
  VAR ex: Example;  iter: FS.Iterator;  nm, path: TEXT;
  BEGIN
    self.root := Default.example_root;
    TRY
      iter := FS.Iterate (self.root);
      TRY
        WHILE iter.next (nm) DO
          path := OS.MakePath (self.root, nm);
          ex := NEW (Example, next := self.contents, name := nm);
          self.contents := ex;
          IF NOT OS.IsDirectory (path) THEN
            (* convert non-directories into simple file nodes *)
            ex.node := NEW (FileNode.T, name := ID.Add (nm), path := path,
                            parent := self);
          END;
        END;
      FINALLY
        iter.close ();
      END;
    EXCEPT OSError.E (ec) =>
      ErrLog.Msg ("trouble scanning example directory: ",
                   self.root, OS.Err (ec));
    END;
  END ScanExamples;

PROCEDURE FindExamplePkg (root: TEXT;  ex: Example): Node.T =
  VAR pkg_root: PkgRoot.T;  n: Node.Named_T;
  BEGIN
    IF (Default.user_home = NIL) THEN
      (* There's no HOME root.  We can't auto-clone examples. *)
      ex.node := ScanDir (ex.name, OS.MakePath (root, ex.name));
      RETURN ex.node;
    END;

    (* find the package root that corresponds to the user's "home" *)
    pkg_root := PkgRoot.First ();
    LOOP
      IF (pkg_root = NIL) THEN
        (* didn't find it!  We can't auto-clone examples. *)
        ex.node := ScanDir (ex.name, OS.MakePath (root, ex.name));
        RETURN ex.node;
      END;
      IF OS.FileNameEq (pkg_root.path, Default.user_home) THEN
        EXIT;
      END;
      pkg_root := pkg_root.sibling;
    END;

    (* find the named package in that root *)
    n := pkg_root.contents;
    WHILE (n # NIL) DO
      TYPECASE n OF
      | Pkg.T (pkg) =>
          IF OS.FileNameEq (ID.ToText (pkg.name), ex.name) THEN
            RETURN pkg;
          END;
      ELSE (* skip *)
      END;
      n := n.sibling;
    END;

    (* no matching package found => clone the example directory
       and return it as a newly created package.  *)
    OS.CopyDirectory (OS.MakePath (root, ex.name),
                      OS.MakePath (pkg_root.path, ex.name));
    TRY
      RETURN Pkg.Rescan (NEW (Pkg.T, name := ID.Add (ex.name), parent := pkg_root));
    EXCEPT Thread.Alerted =>
      RETURN ExampleRoot;
    END;
  END FindExamplePkg;
------------------------------------------------- console log node ---

TYPE
  LogRoot = Node.Named_T OBJECT
  OVERRIDES
    class      := RootClass;
    iterate    := LogRootIterate;
    next       := LogRootNext;
    gen_page   := LogRootPage;
  END;

PROCEDURE LogRootIterate (<*UNUSED*> self: LogRoot;
                          <*UNUSED*> VAR s: Node.IteratorState) =
  BEGIN
  END LogRootIterate;

PROCEDURE LogRootNext (<*UNUSED*> self: LogRoot;
                       <*UNUSED*> VAR s: Node.IteratorState): BOOLEAN =
  BEGIN
    RETURN FALSE;
  END LogRootNext;

PROCEDURE LogRootPage (self: LogRoot;  wx: Wx.T;
                         action: ID.T;  data: Node.FormData)
  RAISES {Wr.Failure, Thread.Alerted} =
  CONST Title = "CM3-IDE console log: ";
  VAR now := "<TT>" & FmtTime.Short (OS.FileToM3Time (OS.Now ())) & "</TT>";
  BEGIN
    HTML.BeginXX (self, wx, Title, now);
    wx.put ("<A NAME=\"HEAD\"><HR></A>\n<PRE>\n");
    LOCK ErrLog.log_mu DO
      FOR i := ErrLog.log_head - ErrLog.log_len TO ErrLog.log_head - 1 DO
        IF (i < 0)
          THEN wx.put (ErrLog.log[i + NUMBER (ErrLog.log)], "\n");
          ELSE wx.put (ErrLog.log[i], "\n");
        END;
      END;
    END;
    wx.put ("</PRE>\n<A NAME=\"TAIL\"><HR></A>\n");
    wx.put ("<H2>", Title, now, "</H2>\n");
    HTML.ViewOnly (action, data, wx);
    HTML.End (wx);
  END LogRootPage;

BEGIN
END Roots.

interface ErrLog is in:


interface HTML is in:


interface ID is in:


interface OS is in:


interface Type is in:


interface Wx is in: