MODULE------------------------------------------------ package root nodes ---; 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 Roots 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; PROCEDURERootClass (<*UNUSED*> self: Node.T): Node.Class = BEGIN RETURN Node.Class.Root; END RootClass; PROCEDUREGenScanWarning (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; PROCEDURETableIterate (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; PROCEDURETableNext (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; PROCEDURENameTableNext (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; PROCEDURETableEnumerate (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; PROCEDUREGenTable (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;
TYPE RootRoot = Node.Named_T OBJECT OVERRIDES class := RootClass; iterate := RootRootIterate; next := RootRootNext; gen_page := RootRootPage; END; PROCEDURE------------------------------------------------ package root nodes ---RootRootIterate (<*UNUSED*> self: RootRoot; VAR s: Node.IteratorState) = BEGIN s.d := PkgRoot.First (); END RootRootIterate; PROCEDURERootRootNext (<*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; PROCEDURERootRootPage (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;
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-------------------------------------------------- fixed root nodes ---PkgRootIterate (<*UNUSED*> self: PkgRoots; VAR s: Node.IteratorState) = BEGIN TableIterate (BrowserDB.db.packages, s); s.a := 0; (* phase *) s.f := NIL; END PkgRootIterate; PROCEDUREPkgRootNext (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; PROCEDUREPkgRootPage (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; PROCEDUREGenButton (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;
TYPE FixedRoot = Node.Named_T OBJECT OVERRIDES class := RootClass; iterate := FixedRootIterate; next := FixedRootNext; gen_page := FixedRootPage; END; PROCEDURE-------------------------------------------------- user root nodes ---FixedRootIterate (<*UNUSED*> self: FixedRoot; VAR s: Node.IteratorState) = BEGIN s.d := RegExpr.SimpleString (s.pattern); END FixedRootIterate; PROCEDUREFixedRootNext (<*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; PROCEDUREFixedRootPage (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;
TYPE UserRoot = Node.Named_T OBJECT home : TEXT; root : FileDir.T := NIL; OVERRIDES class := RootClass; iterate := UserRootIterate; next := UserRootNext; gen_page := UserRootPage; END; PROCEDURE---------------------------------------------- type name root nodes ---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; PROCEDUREUserRootNext (self: UserRoot; VAR s: Node.IteratorState): BOOLEAN = BEGIN IF (self.root # NIL) THEN RETURN self.root.next (s); ELSE RETURN FALSE; END; END UserRootNext; PROCEDUREUserRootPage (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 TNameRoot = Node.Named_T OBJECT OVERRIDES class := RootClass; iterate := TNameRootIterate; next := TNameRootNext; gen_page := TNameRootPage; END; PROCEDURE----------------------------------------------- type UID root nodes ---TNameRootIterate (<*UNUSED*> self: TNameRoot; VAR s: Node.IteratorState) = BEGIN TableIterate (BrowserDB.db.type_names, s); END TNameRootIterate; PROCEDURETNameRootNext (self: TNameRoot; VAR s: Node.IteratorState): BOOLEAN = BEGIN RETURN TableNext (self, s, NIL); END TNameRootNext; PROCEDURETNameRootPage (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 TUIDRoot = Node.Named_T OBJECT OVERRIDES class := RootClass; iterate := TUIDRootIterate; next := TUIDRootNext; gen_page := TUIDRootPage; END; PROCEDURE------------------------------------------------- source root nodes ---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; PROCEDURETUIDRootNext (<*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; PROCEDURETUIDRootPage (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;
TYPE SourceRoot = Node.Named_T OBJECT kind : Node.Class; OVERRIDES class := RootClass; iterate := SourceRootIterate; next := SourceRootNext; gen_page := SourceRootPage; END; PROCEDURE--------------------------------------------------- unit root nodes ---SourceRootIterate (<*UNUSED*> self: SourceRoot; VAR s: Node.IteratorState) = BEGIN TableIterate (BrowserDB.db.units, s); END SourceRootIterate; PROCEDURESourceRootNext (self: SourceRoot; VAR s: Node.IteratorState): BOOLEAN = BEGIN RETURN TableNext (self, s, SourceFilter); END SourceRootNext; PROCEDURESourceFilter (root, node: Node.T): BOOLEAN = VAR self: SourceRoot := root; BEGIN RETURN (self.kind = node.class ()); END SourceFilter; PROCEDURESourceRootPage (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;
TYPE UnitRoot = Node.Named_T OBJECT pgm : BOOLEAN; OVERRIDES class := RootClass; iterate := UnitRootIterate; next := UnitRootNext; gen_page := UnitRootPage; END; PROCEDURE------------------------------------------------- import root nodes ---UnitRootIterate (<*UNUSED*> self: UnitRoot; VAR s: Node.IteratorState) = BEGIN TableIterate (BrowserDB.db.units, s); END UnitRootIterate; PROCEDUREUnitRootNext (self: UnitRoot; VAR s: Node.IteratorState): BOOLEAN = BEGIN RETURN TableNext (self, s, NIL); END UnitRootNext; PROCEDUREUnitRootPage (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;
TYPE ImportRoot = Node.Named_T OBJECT OVERRIDES class := RootClass; iterate := ImportRootIterate; next := ImportRootNext; gen_page := ImportRootPage; END; PROCEDURE------------------------------------------------- export root nodes ---ImportRootIterate (<*UNUSED*> self: ImportRoot; VAR s: Node.IteratorState) = BEGIN TableIterate (BrowserDB.db.importers, s); END ImportRootIterate; PROCEDUREImportRootNext (<*UNUSED*> self: ImportRoot; VAR s: Node.IteratorState): BOOLEAN = BEGIN RETURN NameTableNext (s); END ImportRootNext; PROCEDUREImportRootPage (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; PROCEDUREImportFilter (<*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;
TYPE ExportRoot = Node.Named_T OBJECT OVERRIDES class := RootClass; iterate := ExportRootIterate; next := ExportRootNext; gen_page := ExportRootPage; END; PROCEDURE------------------------------------------------ derived root nodes ---ExportRootIterate (<*UNUSED*> self: ExportRoot; VAR s: Node.IteratorState) = BEGIN TableIterate (BrowserDB.db.exporters, s); END ExportRootIterate; PROCEDUREExportRootNext (<*UNUSED*> self: ExportRoot; VAR s: Node.IteratorState): BOOLEAN = BEGIN RETURN NameTableNext (s); END ExportRootNext; PROCEDUREExportRootPage (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; PROCEDUREExportFilter (<*UNUSED*> root: Node.T; node: Node.T): BOOLEAN = BEGIN RETURN node.class () = Node.Class.Module; END ExportFilter;
TYPE DerivedRoot = Node.Named_T OBJECT pgm : BOOLEAN; OVERRIDES class := RootClass; iterate := DerivedRootIterate; next := DerivedRootNext; gen_page := DerivedRootPage; END; PROCEDURE-------------------------------------------- build cache root nodes ---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; PROCEDUREDerivedRootNext (self: DerivedRoot; VAR s: Node.IteratorState): BOOLEAN = BEGIN RETURN TableNext (self, s, NIL); END DerivedRootNext; PROCEDUREDerivedRootPage (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;
TYPE CacheRoot = Node.Named_T OBJECT OVERRIDES class := RootClass; iterate := CacheRootIterate; next := CacheRootNext; gen_page := CacheRootPage; END; PROCEDURE------------------------------------------ documentation root nodes ---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; PROCEDURECacheRootNext (self: CacheRoot; VAR s: Node.IteratorState): BOOLEAN = BEGIN IF (s.a # 0) THEN RETURN TableNext (self, s, NIL); END; RETURN FALSE; END CacheRootNext; PROCEDURECacheRootPage (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;
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----------------------------------------------- example root nodes ---DocumentRootIterate (self: DocumentRoot; VAR s: Node.IteratorState) = BEGIN IF self.tbl = NIL THEN ScanDocDir (self); END; TableIterate (self.tbl, s); END DocumentRootIterate; PROCEDUREDocumentRootNext (self: DocumentRoot; VAR s: Node.IteratorState): BOOLEAN = BEGIN RETURN TableNext (self, s, NIL); END DocumentRootNext; PROCEDUREDocumentRootPage (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; PROCEDUREScanDocDir (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; PROCEDUREScanDir (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;
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------------------------------------------------- console log node ---ExamplesRootIterate (self: ExamplesRoot; VAR s: Node.IteratorState) = BEGIN IF self.root = NIL THEN ScanExamples (self); END; s.d := self.contents; END ExamplesRootIterate; PROCEDUREExamplesRootNext (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; PROCEDUREExamplesRootPage (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; PROCEDUREScanExamples (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; PROCEDUREFindExamplePkg (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;
TYPE LogRoot = Node.Named_T OBJECT OVERRIDES class := RootClass; iterate := LogRootIterate; next := LogRootNext; gen_page := LogRootPage; END; PROCEDURELogRootIterate (<*UNUSED*> self: LogRoot; <*UNUSED*> VAR s: Node.IteratorState) = BEGIN END LogRootIterate; PROCEDURELogRootNext (<*UNUSED*> self: LogRoot; <*UNUSED*> VAR s: Node.IteratorState): BOOLEAN = BEGIN RETURN FALSE; END LogRootNext; PROCEDURELogRootPage (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.