MODULE DevSubTool;
(**

   project   = "BlackBox"
   organization   = "www.oberon.ch"
   contributors   = "Oberon microsystems"
   version   = "System/Rsrc/About"
   copyright   = "System/Rsrc/About"
   license   = "Docu/BB-License"
   changes   = ""
   issues   = ""

**)

   IMPORT Files, Fonts, Views, TextModels, TextMappers, TextViews, StdCmds, StdLog, DevCommanders;

   CONST

      textCmds* = 0; formCmds* = 1; otherCmds = 2;
      noModelView* = 3; modelView* = 4; complexView* = 5;
      wrapper = 6; specialContainer = 7; generalContainer = 8;
   VAR

      create*: RECORD
         subsystem*: ARRAY 9 OF CHAR;
         kind*: INTEGER;
         Create*: PROCEDURE
      END;
   PROCEDURE TranslateText (t: TextModels.Model; s: ARRAY OF CHAR);

      VAR r: TextModels.Reader; w: TextModels.Writer; from, to: INTEGER; i: INTEGER; ch: CHAR;
   BEGIN
      r := t.NewReader(NIL); w := t.NewWriter(NIL);
      r.ReadChar(ch);
      WHILE ~r.eot DO
         WHILE ~r.eot & ~(Fonts.strikeout IN r.attr.font.style) DO
            r.ReadChar(ch);
         END;
         IF ~r.eot THEN
            from := r.Pos() - 1;
            WHILE ~r.eot & (Fonts.strikeout IN r.attr.font.style) DO
               r.ReadChar(ch);
            END;
            IF ~r.eot THEN
               to := r.Pos() - 1;
               t.Delete(from, to);
               w.SetPos(from);
               w.SetAttr(TextModels.NewStyle(r.attr, r.attr.font.style - {Fonts.strikeout}));
               i := 0; ch := s[0]; WHILE ch # 0X DO w.WriteChar(ch); INC(i); INC(from); ch := s[i] END;
               r.SetPos(from); r.ReadChar(ch);
            END
         END
      END
   END TranslateText;
   PROCEDURE TranslateFile (floc: Files.Locator; fname: Files.Name; tloc: Files.Locator; tname: Files.Name;

                                 string: ARRAY OF CHAR; VAR res: INTEGER);
      VAR v: Views.View;
   BEGIN
      v := Views.OldView(floc, fname);
      IF v # NIL THEN
         IF v IS TextViews.View THEN
            TranslateText(v(TextViews.View).ThisModel(), string);
            tloc.res := 76;   (* don't ask whether directory should be created *)
            Views.RegisterView(v, tloc, tname);
            res := tloc.res
         ELSE res := 101
         END
      ELSE res := 100
      END
   END TranslateFile;
   PROCEDURE TranslateSubsystem (kind: INTEGER; string: ARRAY OF CHAR);

      VAR loc, new: Files.Locator; t: TextModels.Model; res: INTEGER; f: TextMappers.Formatter;
         v: Views.View;
      PROCEDURE Message (sub, dir, old: ARRAY OF CHAR);

      BEGIN
         IF res = 0 THEN
            f.WriteString(sub); f.WriteString(dir); f.WriteLn
         ELSE
            StdLog.String(old); StdLog.Msg("#Dev:CannotTranslate"); StdLog.Ln
         END
      END Message;
   BEGIN

      t := TextModels.dir.New(); f.ConnectTo(t);
      loc := Files.dir.This("Dev"); loc := loc.This("Rsrc"); loc := loc.This("New");
      new := Files.dir.This(string); new := new.This("Mod");
      IF kind = textCmds THEN
         TranslateFile(loc, "Cmds0", new, "Cmds", string, res);
         Message(string, "Cmds", "Cmds0")
      ELSIF kind = formCmds THEN
         TranslateFile(loc, "Cmds1", new, "Cmds", string, res);
         Message(string, "Cmds", "Cmds1")
      ELSIF kind = otherCmds THEN
         TranslateFile(loc, "Cmds2", new, "Cmds", string, res);
         Message(string, "Cmds", "Cmds2")
      ELSIF kind = noModelView THEN
         TranslateFile(loc, "Views3", new, "Views", string, res);
         Message(string, "Views", "Views3");
         f.WriteLn;
         f.WriteView(DevCommanders.dir.New());
         f.WriteString(' "'); f.WriteString(string); f.WriteString('Views.Deposit; StdCmds.Open"'); f.WriteLn
      ELSIF kind = modelView THEN
         TranslateFile(loc, "Views4", new, "Views", string, res);
         Message(string, "Views", "Views4");
         f.WriteLn;
         f.WriteView(DevCommanders.dir.New());
         f.WriteString(' "'); f.WriteString(string); f.WriteString('Views.Deposit; StdCmds.Open"'); f.WriteLn
      ELSIF kind = complexView THEN
         TranslateFile(loc, "Models5", new, "Models", string, res);
         Message(string, "Models", "Models5");
         TranslateFile(loc, "Views5", new, "Views", string, res);
         Message(string, "Views", "Views5");
         TranslateFile(loc, "Cmds5", new, "Cmds", string, res);
         Message(string, "Cmds", "Cmds5");
         f.WriteLn;
         f.WriteView(DevCommanders.dir.New());
         f.WriteString(' "'); f.WriteString(string); f.WriteString('Views.Deposit; StdCmds.Open"'); f.WriteLn
      ELSIF kind = wrapper THEN
         TranslateFile(loc, "Views6", new, "Views", string, res);
         Message(string, "Views", "Views6");
         f.WriteLn;
         f.WriteView(DevCommanders.dir.New());
         f.WriteString(' "'); f.WriteString(string); f.WriteString('Views.Deposit; StdCmds.Open"'); f.WriteLn
      ELSIF kind = specialContainer THEN
         TranslateFile(loc, "Views7", new, "Views", string, res);
         Message(string, "Views", "Views7");
         f.WriteLn;
         f.WriteView(DevCommanders.dir.New());
         f.WriteString(' "'); f.WriteString(string); f.WriteString('Views.Deposit; StdCmds.Open"'); f.WriteLn
      ELSIF kind = generalContainer THEN
         TranslateFile(loc, "Models8", new, "Models", string, res);
         Message(string, "Models", "Models8");
         TranslateFile(loc, "Views8", new, "Views", string, res);
         Message(string, "Views", "Views8");
         TranslateFile(loc, "Controllers8", new, "Controllers", string, res);
         Message(string, "Controllers", "Controllers8");
         TranslateFile(loc, "Cmds8", new, "Cmds", string, res);
         Message(string, "Cmds", "Cmds8");
         f.WriteLn;
         f.WriteView(DevCommanders.dir.New());
         f.WriteString(' "'); f.WriteString(string); f.WriteString('Views.Deposit; StdCmds.Open"'); f.WriteLn
      ELSE HALT(20)
      END;
      v := TextViews.dir.New(t);
      Views.Open(v, new, "List", NIL);
      IF t.Length() > 0 THEN Views.RegisterView(v, new, "List") END
   END TranslateSubsystem;
   PROCEDURE Len (s: ARRAY OF CHAR): INTEGER;

      VAR n: INTEGER;
   BEGIN
      n := 0; WHILE s[n] # 0X DO INC(n) END;
      RETURN n
   END Len;
   PROCEDURE SyntaxOK (s: ARRAY OF CHAR): BOOLEAN;

      VAR i: INTEGER; ch: CHAR;
   BEGIN
      i := 0; ch := s[0];
      WHILE (ch >= "A") & (ch <= "Z") DO INC(i); ch := s[i] END;
      WHILE (i # 0) & (ch >= "a") & (ch <= "z") OR (ch >= "0") & (ch <= "9") DO INC(i); ch := s[i] END;
      RETURN (i # 0) & (ch = 0X)
   END SyntaxOK;
   PROCEDURE Create;

   BEGIN
      IF Len(create.subsystem) >= 3 THEN
         IF (create.kind >= textCmds) & (create.kind <= generalContainer) THEN
            IF SyntaxOK(create.subsystem) THEN
               StdCmds.CloseDialog;
               TranslateSubsystem(create.kind, create.subsystem);
               create.subsystem := ""
            ELSE StdLog.Msg("#Dev:IllegalSyntax")
            END
         ELSE StdLog.Msg("#Dev:IllegalKind")
         END
      ELSE StdLog.Msg("#Dev:PrefixTooShort")
      END
   END Create;
BEGIN

   create.Create := Create; create.kind := textCmds
END DevSubTool.