MODULE; IMPORT Env, Pathname, Text, Thread, Wr; IMPORT BrowserDB, Builder, ClassDir, Default, Dir, ErrLog, ID; IMPORT Node, HTML, OS, Pkg, RegExpr, Source, UserState, Wx; REVEAL T = Tx BRANDED "Derived.T" OBJECT OVERRIDES class := Class; printname := PrintName; match := Match; iterate := Iterate; next := Next; gen_page := GenPage; END; VAR PreChop : ARRAY BOOLEAN OF CARDINAL; PostChop : ARRAY BOOLEAN OF CARDINAL; viewID := ID.Add ("view"); runID := ID.Add ("run"); PROCEDURE Derived Class (t: T): Node.Class = TYPE NC = Node.Class; CONST Map = ARRAY BOOLEAN OF NC { NC.Library, NC.Program }; BEGIN RETURN Map [t.is_pgm]; END Class; PROCEDUREPrintName (t: T): TEXT = VAR nm := ID.ToText (t.name); pre := PreChop [t.is_pgm]; post := PostChop [t.is_pgm]; BEGIN RETURN Text.Sub (nm, pre, Text.Length (nm) - pre - post); END PrintName; PROCEDUREMatch (t: T; re: RegExpr.T): BOOLEAN = VAR nm := ID.ToText (t.name); pre := PreChop [t.is_pgm]; post := PostChop [t.is_pgm]; BEGIN RETURN RegExpr.Match (re, nm) OR RegExpr.MatchSubstring (re, nm, pre, post); END Match; PROCEDUREIterate (t: T; VAR s: Node.IteratorState) = VAR x := GenContents (t); BEGIN s.a := 0; s.b := x.cnt; s.d := x.elts; END Iterate; PROCEDURENext (<*UNUSED*> t: T; VAR s: Node.IteratorState): BOOLEAN = VAR n: Node.T; elts: Node.Array := s.d; BEGIN WHILE (s.a < s.b) DO n := elts [s.a]; INC (s.a); IF n.match (s.pattern) THEN s.match := n; RETURN TRUE; END; END; RETURN FALSE; END Next; PROCEDUREGenPage (t: T; wx: Wx.T; action: ID.T; data: Node.FormData) RAISES {Wr.Failure, Thread.Alerted} = BEGIN IF (action = runID) THEN GenRun (t, wx, data); ELSE GenView (t, wx, action, data); END; END GenPage; PROCEDUREPgmPath (t: T): TEXT = VAR file, path: TEXT; BEGIN IF NOT t.is_pgm THEN RETURN NIL END; file := Node.FullPath (t); IF OS.IsExecutable (file) THEN RETURN file; END; (* but, public programs are usually shipped to the BIN directory! *) path := OS.FindExecutable (Pathname.Last (file)); IF (path # NIL) THEN RETURN path; END; (* but, if it's not there, give up. *) RETURN file; END PgmPath; PROCEDUREGenView (t: T; wx: Wx.T; action: ID.T; data: Node.FormData) RAISES {Wr.Failure, Thread.Alerted} = VAR path := Node.FullPath (t); x : Node.Set; BEGIN GenHeader (t, path, wx); IF (action = viewID) THEN Pkg.GenActionButtons (t, wx); x := GenContents (t); HTML.GenChoices (x, wx); ELSE HTML.NoAction (action, wx); END; HTML.NoData (data, wx); HTML.End (wx); END GenView; PROCEDUREGenRun (t: T; wx: Wx.T; data: Node.FormData) RAISES {Wr.Failure, Thread.Alerted} = VAR path := Node.FullPath (t); cmdkey := "RUNCMD|" & path; dirkey := "RUNDIR|" & path; cmd := UserState.Get (cmdkey); dir := UserState.Get (dirkey); BEGIN (* process the incoming form data *) WHILE (data # NIL) DO IF Text.Equal (data.field, "run-cmd") THEN cmd := data.value; ELSIF Text.Equal (data.field, "run-dir") THEN dir := data.value; ELSE wx.put ("<STRONG>Unrecognized field: ", data.field, "</STRONG><BR>\n"); END; data := data.next; END; (* try to ensure there's some sort of reasonable values *) IF (cmd = NIL) THEN cmd := PgmPath (t); END; IF (dir = NIL) THEN dir := Env.Get ("HOME"); END; IF (dir = NIL) THEN dir := Node.FullPath (t.parent); END; (* and record them for posterity *) UserState.Put (cmdkey, cmd); UserState.Put (dirkey, dir); GenHeader (t, path, wx); Builder.Run (Pkg.Home (t), cmd, dir, wx); HTML.End (wx); END GenRun; PROCEDUREGenHeader (t: T; path: TEXT; wx: Wx.T) RAISES {Wr.Failure, Thread.Alerted} = BEGIN HTML.Begin (t, wx); Pkg.GenFileNote (path, wx, is_dir := FALSE); Pkg.GenBuildNote (t, wx); wx.put ("\n"); END GenHeader; PROCEDUREFixName (t: T) = VAR nm := ID.ToText (t.name); BEGIN CASE ORD (t.is_pgm) + 2 * ORD (Default.on_unix) OF | 0 => t.name := ID.Add (nm & ".lib"); (* Win32 library: foo.lib *) | 1 => t.name := ID.Add (nm & ".exe"); (* Win32 program: foo.exe *) | 2 => t.name := ID.Add ("lib" & nm & ".a"); (* Unix library: libfoo.a *) ELSE (*skip*) (* Unix program: foo *) END; END FixName; PROCEDUREInit () = BEGIN IF (Default.on_unix) THEN (* assume Unix naming conventions *) PreChop [FALSE] := 3; PostChop [FALSE] := 2; (* Unix library: libfoo.a *) PreChop [TRUE] := 0; PostChop [TRUE] := 0; (* Unix program: foo *) ELSE (* assume Win32 naming conventions *) PreChop [FALSE] := 0; PostChop [FALSE] := 4; (* Win32 library: foo.lib *) PreChop [TRUE] := 0; PostChop [TRUE] := 4; (* Win32 program: foo.exe *) END; END Init; PROCEDUREGenContents (t: T): Node.Set = VAR x: Node.Set; c: Node.Class; pkg: Pkg.T; path : NamePath; n: Node.T; BEGIN (* scan and build the node class virtual directories *) FOR k := FIRST (t.seen) TO LAST (t.seen) DO IF (t.seen[k]) THEN c := Source.NodeClass [k]; IF (Node.ClassID[c] # ID.NoID) THEN Node.Append (x, NEW (ClassDir.T, name := Node.ClassID [c], parent := t, kind := c)); END; END; END; pkg := Pkg.Home (t); FOR i := 0 TO t.n_elts-1 DO WITH z = t.contents [i] DO path.len := 0; AddArcs (path, z.loc.subdir); path.arcs [path.len] := z.file; INC (path.len); n := FindSource (z.loc.pkg, path, pkg); IF (n # NIL) THEN Node.Append (x, n); ELSE ErrLog.Msg ("Unable to locate source: ", PathToText (z.loc.pkg, path), " for ", Node.FullPath (t)); END; END; END; RETURN x; END GenContents; TYPE NamePath = RECORD len : INTEGER; arcs : ARRAY [0..19] OF ID.T; END; PROCEDUREAddArcs (VAR path: NamePath; x: ID.T) = CONST BackSlash = '\134'; VAR txt := ID.ToText (x); len := Text.Length (txt); s0, s1: INTEGER; buf: ARRAY [0..99] OF CHAR; BEGIN <*ASSERT len <= NUMBER (buf) *> Text.SetChars (buf, txt); s0 := 0; WHILE (s0 < len) DO s1 := s0; WHILE (s1 < len) AND (buf[s1] # '/') AND (buf[s1] # BackSlash) DO INC (s1); END; IF (s0 < s1) THEN path.arcs [path.len] := ID.FromStr (SUBARRAY (buf, s0, s1 - s0)); INC (path.len); END; s0 := s1 + 1; END; END AddArcs; PROCEDUREFindSource (pkg_nm: ID.T; READONLY path: NamePath; hint: Pkg.T): Node.T = VAR n: Node.T; pkgs: Node.List; ref: REFANY; BEGIN (* try the hint *) IF (hint # NIL) AND (hint.name = pkg_nm) THEN n := FindFile (path, hint); IF (n # NIL) THEN RETURN n; END; END; (* search all the packages with the same name *) IF NOT BrowserDB.db.packages.get (pkg_nm, ref) THEN RETURN NIL; END; pkgs := ref; WHILE (pkgs # NIL) DO n := FindFile (path, pkgs.head); IF (n # NIL) THEN RETURN n; END; pkgs := pkgs.tail; END; (* failed... *) RETURN NIL; END FindSource; PROCEDUREFindFile (READONLY path: NamePath; dir: Dir.T): Node.T = VAR n: Node.Named_T; nm: ID.T; BEGIN (* walk through the subdirectories *) FOR i := 0 TO path.len-1 DO (* find the next subdirectory *) nm := path.arcs [i]; n := dir.contents; LOOP IF (n = NIL) THEN RETURN NIL; END; IF (n.name = nm) THEN IF (i = path.len-1) THEN RETURN n; END; IF NOT ISTYPE (n, Dir.T) THEN RETURN NIL; END; dir := n; EXIT; END; n := n.sibling; END; END; (* failed... *) RETURN NIL; END FindFile; PROCEDUREPathToText (pkg: ID.T; READONLY path: NamePath): TEXT = VAR p := ID.ToText (pkg); BEGIN FOR i := 0 TO path.len - 1 DO p := HTML.MakeURL (p, ID.ToText (path.arcs[i])); END; RETURN p; END PathToText; BEGIN END Derived.