MODULE; IMPORT Fmt, Text, Thread, Wr; IMPORT BrowserDB, ConfigItem, Default, Display, Form, HTML, ID; IMPORT LexMisc, Node, PkgRoot, Text2, UserState, WebServer, Wx; IMPORT ErrLog; TYPE CI = ConfigItem.T; PROCEDURE Config Init () = BEGIN Form.Register ("configure", DoConfig); END Init; PROCEDUREDoConfig (self: Node.T; data: Node.FormData; wx: Wx.T) RAISES {Wr.Failure, Thread.Alerted} = VAR item_handled: BOOLEAN; changed: ARRAY CI OF BOOLEAN; pre, post: TEXT; root_info := NewRootTable (); restart := NEW (RestartClosure); BEGIN FOR i := FIRST (changed) TO LAST (changed) DO changed [i] := FALSE; END; HTML.BeginXX (self, wx, "CM3-IDE Configuration"); (* process any new data *) WHILE (data # NIL) DO item_handled := FALSE; IF (data.field # NIL) THEN (* try the predefined configuration items first *) FOR ci := FIRST (CI) TO LAST (CI) DO IF Text.Equal (data.field, ConfigItem.Desc[ci].name) THEN pre := ConfigItem.ToText (ci); ConfigItem.Set (ci, data.value); post := ConfigItem.ToText (ci); IF (pre = NIL) # (post = NIL) THEN changed[ci] := TRUE; ELSIF (pre # NIL) AND NOT Text.Equal (pre, post) THEN changed[ci] := TRUE; END; item_handled := TRUE; EXIT; END; END; IF NOT item_handled THEN item_handled := AddRootInfo (root_info, data.field, data.value); END; IF NOT item_handled THEN wx.put ("<STRONG>Unrecognized field: ", data.field, "</STRONG><BR>\n"); END; END; data := data.next; END; (* recompute any derived configuration items *) IF changed[CI.Server_machine] OR changed[CI.IP_address] OR changed[CI.Server_port] THEN Default.server_href := "http://" & ConfigItem.ToText (CI.Server_machine) & ":" & ConfigItem.ToText (CI.Server_port) & "/"; restart.server := TRUE; END; IF changed[CI.Start_browser] THEN restart.browser := TRUE; END; IF NOT CompareRoots (root_info) THEN ResetRoots (root_info); root_info := NewRootTable (); restart.scan := TRUE; END; wx.put ("<FORM action=\"/form/configure\" method=\"get\">\n"); wx.put ("<PRE>\n"); wx.put ("<INPUT TYPE=submit VALUE=\"Save and apply changes\">\n"); (*---*) GenHeader (wx, "Display", "display"); GenForm (wx, "Home page", CI.Homepage); GenForm (wx, "Max display items", CI.Max_display_items); GenForm (wx, "Max display width (chars)", CI.Max_display_width); GenForm (wx, "Max display width (columns)", CI.Max_display_columns); GenForm (wx, "Multiple windows", CI.Use_multiple_windows); (*---*) GenHeader (wx, "Package roots", "package-roots"); FOR i := 0 TO LAST (root_info^) DO WITH z = root_info[i].old DO GenRoot (wx, i, z.name, z.path, z.build); END; END; (*---*) GenHeader (wx, "Communication", "communication"); GenForm (wx, "Host name", CI.Server_machine); GenForm (wx, "IP address", CI.IP_address); GenForm (wx, "Server port", CI.Server_port); (*---*) GenHeader (wx, "Misc", "misc"); GenForm (wx, "Verbose log", CI.Verbose_log); GenForm (wx, "Automatic package scans", CI.Auto_pkg_scan); GenForm (wx, "Server threads", CI.Num_server_threads); GenForm (wx, "Refresh interval (minutes)", CI.Refresh_interval); wx.put (" <B>CM3-IDE URL: </B>", Default.server_href, "\n"); wx.put (" <B>System package root: </B>", Default.system_root, "\n"); wx.put (" <B>Build directory: </B>", Default.build_dir, "\n"); (*---*) GenHeader (wx, "Helper procedures", "helper-procs"); GenForm (wx, "Browser", CI.Start_browser); GenForm (wx, "Build", CI.Build_package); GenForm (wx, "Ship", CI.Ship_package); GenForm (wx, "Clean", CI.Clean_package); GenForm (wx, "Run", CI.Run_program); GenForm (wx, "Edit", CI.Edit_file); wx.put ("</PRE>\n"); wx.put ("<INPUT TYPE=submit VALUE=\"Save and apply changes\">\n"); wx.put ("</FORM>\n"); HTML.NoData (data, wx); HTML.End (wx); wx.flush (); IF (restart.server) OR (restart.browser) OR (restart.scan) THEN EVAL Thread.Fork (restart); END; END DoConfig; TYPE RestartClosure = Thread.Closure OBJECT server : BOOLEAN := FALSE; browser : BOOLEAN := FALSE; scan : BOOLEAN := FALSE; OVERRIDES apply := Restart; END; PROCEDURERestart (cl: RestartClosure): REFANY = BEGIN IF (cl.server) THEN ErrLog.Msg ("restarting server and browser because of configuration change"); WebServer.Restart (); Display.Start (); ELSIF (cl.browser) THEN ErrLog.Msg ("restarting browser because of configuration change"); Display.Start (); END; IF (cl.scan) THEN ErrLog.Msg ("rescanning packages because of configuration change"); TRY BrowserDB.Refresh (); EXCEPT Thread.Alerted => (* ignore *) END; END; RETURN NIL; END Restart; PROCEDUREGenForm (wx: Wx.T; title: TEXT; ci: CI) RAISES {Wr.Failure, Thread.Alerted} = VAR nm := ConfigItem.Desc[ci].name; val := ConfigItem.ToText (ci); BEGIN wx.put (" <B>", title, ": </B>"); CASE ConfigItem.Desc[ci].kind OF | ConfigItem.Kind.Bool => wx.put ("<INPUT TYPE=RADIO NAME=\"", nm, "\" VALUE=\"FALSE\""); IF NOT ConfigItem.X[ci].bool THEN wx.put (" CHECKED=TRUE"); END; wx.put (">off</INPUT> "); wx.put ("<INPUT TYPE=RADIO NAME=\"", nm, "\" VALUE=\"TRUE\""); IF ConfigItem.X[ci].bool THEN wx.put (" CHECKED=TRUE"); END; wx.put (">on</INPUT>\n"); | ConfigItem.Kind.Int => wx.put ("<INPUT TYPE=TEXT NAME=\"", nm, "\" SIZE=10"); wx.put (" VALUE=\"", val, "\">\n"); | ConfigItem.Kind.Text => wx.put ("<INPUT TYPE=TEXT NAME=\"", nm, "\" SIZE=50"); wx.put (" VALUE=\"", val, "\">\n"); | ConfigItem.Kind.Proc => wx.put ("\n <TEXTAREA ROWS=5 COLS=70 NAME=\"", nm, "\">"); wx.put (val, "</TEXTAREA>\n"); | ConfigItem.Kind.IPAddr => wx.put ("<INPUT TYPE=TEXT NAME=\"", nm, "\" SIZE=20"); wx.put (" VALUE=\"", val, "\">\n"); END; END GenForm; PROCEDUREGenRoot (wx: Wx.T; n: INTEGER; name: ID.T; path: TEXT; build: BOOLEAN) RAISES {Wr.Failure, Thread.Alerted} = VAR key := Fmt.Int (n); BEGIN wx.put (" <INPUT TYPE=TEXT NAME=\"root-", key, "-name\" SIZE=12"); IF (name # ID.NoID) THEN wx.put (" VALUE=\"", ID.ToText(name), "\""); END; wx.put (">"); wx.put (" <INPUT TYPE=TEXT NAME=\"root-", key, "-path\" SIZE=50"); wx.put (" VALUE=\"", path, "\">"); wx.put (" <INPUT TYPE=RADIO NAME=\"root-", key, "-build\" VALUE=FALSE"); IF NOT build THEN wx.put (" CHECKED=TRUE"); END; wx.put (">browse</INPUT>"); wx.put (" <INPUT TYPE=RADIO NAME=\"root-", key, "-build\" VALUE=TRUE"); IF build THEN wx.put (" CHECKED=TRUE"); END; wx.put (">build</INPUT>\n"); END GenRoot; PROCEDUREGenHeader (wx: Wx.T; title, tag: TEXT) RAISES {Wr.Failure, Thread.Alerted} = BEGIN wx.put ("\n<B>", title, ":</B> ");
** wx.put (<A HREF=\
/rsrc/confighelp.html#, tag,
\>
); wx.put (<IMG SRC=\
/rsrc/help.gif\height=24 width=24 align=\
bottom\); wx.put (
border=0></A>
); ***
wx.put (" <A HREF=\"/rsrc/confighelp.html#", tag, "\">[Help]</A>\n\n"); END GenHeader;------------------------------------------------ package root table ---
TYPE RootInfo = REF ARRAY OF RootPair; RootPair = RECORD new, old: RootDesc; root: PkgRoot.T := NIL; END; RootDesc = RECORD name : ID.T := ID.NoID; path : TEXT := NIL; build : BOOLEAN := FALSE; END; PROCEDURENewRootTable (): RootInfo = (* initialize a table with the current package roots *) CONST MaxRoots = ORD (Node.LastPkgRoot) - ORD (Node.FirstPkgRoot) + 1; VAR info: RootInfo; cnt := 0; r := PkgRoot.First (); n_pre, n_post: INTEGER; BEGIN (*count'em first *) WHILE (r # NIL) DO INC (cnt); r := r.sibling; END; IF cnt + 4 <= MaxRoots THEN n_pre := 2; n_post := 2; ELSIF cnt + 3 <= MaxRoots THEN n_pre := 2; n_post := 1; ELSIF cnt + 2 <= MaxRoots THEN n_pre := 1; n_post := 1; ELSIF cnt + 1 <= MaxRoots THEN n_pre := 1; n_post := 0; ELSE n_pre := 0; n_post := 0; END; info := NEW (RootInfo, cnt + n_pre + n_post); (* map the existing roots, leaving 2 holes at the top and bottom *) r := PkgRoot.First (); FOR i := n_pre TO n_pre + cnt-1 DO WITH z = info[i] DO z.old.name := r.name; z.new.name := r.name; z.old.path := r.path; z.new.path := r.path; z.old.build := r.buildable; z.new.build := r.buildable; z.root := r; END; r := r.sibling; END; RETURN info; END NewRootTable; PROCEDUREAddRootInfo (info: RootInfo; nm, value: TEXT): BOOLEAN = VAR buf: ARRAY [0..19] OF CHAR; cursor, val: INTEGER; tail: TEXT; BEGIN IF (nm = NIL) OR (value = NIL) THEN RETURN FALSE; END; IF NOT Text2.PrefixMatch ("root-", nm, 5) THEN RETURN FALSE; END; Text.SetChars (buf, nm); cursor := 5; val := LexMisc.ReadInt (buf, cursor); IF (val < 0) OR (val > LAST (info^)) THEN RETURN FALSE; END; tail := Text.Sub (nm, cursor); IF (tail = NIL) THEN RETURN FALSE; ELSIF Text.Equal (tail, "-name") THEN IF (value = NIL) OR Text.Length (value) <= 0 THEN info[val].new.name := ID.NoID; ELSE info[val].new.name := ID.Add (value); END; RETURN TRUE; ELSIF Text.Equal (tail, "-path") THEN info[val].new.path := value; RETURN TRUE; ELSIF Text.Equal (tail, "-build") THEN info[val].new.build := (value # NIL) AND Text.Equal (value, "TRUE"); RETURN TRUE; ELSE RETURN FALSE; END; END AddRootInfo; PROCEDURECompareRoots (info: RootInfo): BOOLEAN = VAR x_old := 2; root: PkgRoot.T; BEGIN FOR x_new := 0 TO LAST (info^) DO WITH z = info[x_new].new DO IF (z.name # ID.NoID) AND (z.path # NIL) AND Text.Length (z.path) > 0 THEN (* we've got a live one, see if it matches the next old one *) WITH zz = info[x_old].old DO IF (z.name = zz.name) AND (zz.path # NIL) AND Text.Equal (z.path, zz.path) THEN (* it's a match *) root := info[x_old].root; IF (root # NIL) THEN IF (z.build # root.buildable) THEN zz.build := z.build; root.buildable := z.build; UserState.Put ("root-" & Fmt.Int (x_old-2) & "-build", Fmt.Bool (z.build)); END; END; INC (x_old); ELSE RETURN FALSE; END; END; END; END; END; RETURN x_old = (NUMBER (info^) - 2); END CompareRoots; PROCEDUREResetRoots (info: RootInfo) = VAR cnt := 0; key: TEXT; BEGIN PkgRoot.Reset (); FOR x_new := 0 TO LAST (info^) DO WITH z = info[x_new].new DO IF (z.name # ID.NoID) AND (z.path # NIL) AND Text.Length (z.path) > 0 THEN PkgRoot.Add (ID.ToText (z.name), z.path, z.build); key := "root-" & Fmt.Int (cnt); UserState.Put (key & "-name", ID.ToText (z.name)); UserState.Put (key & "-path", z.path); UserState.Put (key & "-build", Fmt.Bool (z.build)); INC (cnt); END; END; END; PkgRoot.Init (); END ResetRoots; BEGIN END Config.