MODULE DevCommanders;
(**

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

**)

   IMPORT

      Kernel, Fonts, Ports, Stores, Models, Views, Controllers, Properties, Dialog, Controls,
      TextModels, TextSetters, TextMappers, Services, StdLog;
   CONST

      (* additional Scan types *)
      ident = 19; qualident = 20; execMark = 21;
      point = Ports.point;

      minVersion = 0; maxVersion = 0; maxStdVersion = 0;

   TYPE


      View* = POINTER TO ABSTRACT RECORD (Views.View)
      END;
      EndView* = POINTER TO ABSTRACT RECORD (Views.View)
      END;
      Par* = POINTER TO RECORD

         text*: TextModels.Model;
         beg*, end*: INTEGER
      END;
      Directory* = POINTER TO ABSTRACT RECORD END;

      StdView = POINTER TO RECORD (View) END;


      StdEndView = POINTER TO RECORD (EndView) END;
      StdDirectory = POINTER TO RECORD (Directory) END;

      Scanner = RECORD

         s: TextMappers.Scanner;
         ident: ARRAY LEN(Kernel.Name) OF CHAR;
         qualident: ARRAY LEN(Kernel.Name) * 2 - 1 OF CHAR
      END;
      
      TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
   VAR

      par*: Par;
      dir-, stdDir-: Directory;
      
      cleaner: TrapCleaner;
      cleanerInstalled: BOOLEAN;
   (** Cleaner **)


   PROCEDURE (c: TrapCleaner) Cleanup;

   BEGIN
      par := NIL;
      cleanerInstalled := FALSE;
   END Cleanup;
   
   (** View **)
   PROCEDURE (v: View) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;

   BEGIN
      v.Externalize^(wr);
      wr.WriteVersion(maxVersion);
      wr.WriteXInt(execMark)
   END Externalize;
   PROCEDURE (v: View) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;

      VAR thisVersion, type: INTEGER;
   BEGIN
      v.Internalize^(rd);
      IF rd.cancelled THEN RETURN END;
      rd.ReadVersion(minVersion, maxVersion, thisVersion);
      IF rd.cancelled THEN RETURN END;
      rd.ReadXInt(type)
   END Internalize;
   (** Directory **)


   PROCEDURE (d: Directory) New* (): View, NEW, ABSTRACT;

   PROCEDURE (d: Directory) NewEnd* (): EndView, NEW, ABSTRACT;
   (* auxilliary procedures *)


   PROCEDURE IsIdent (VAR s: ARRAY OF CHAR): BOOLEAN;

      VAR i: INTEGER; ch: CHAR;
   BEGIN
      ch := s[0]; i := 1;
      IF ("A" <= CAP(ch)) & (CAP(ch) <= "Z") OR (ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR (ch = "_") THEN
         REPEAT
            ch := s[i]; INC(i)
         UNTIL ~( ("0" <= ch) & (ch <= "9") OR ("A" <= CAP(ch)) & (CAP(ch) <= "Z")
                  OR (ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR (ch = "_") );
         RETURN (ch = 0X) & (i <= LEN(Kernel.Name))
      ELSE
         RETURN FALSE
      END
   END IsIdent;
   PROCEDURE Scan (VAR s: Scanner);

      VAR done: BOOLEAN;
   BEGIN
      s.s.Scan;
      IF (s.s.type = TextMappers.view) THEN
         IF Properties.ThisType(s.s.view, "DevCommanders.View") # NIL THEN s.s.type := execMark END
      ELSIF (s.s.type = TextMappers.string) & TextMappers.IsQualIdent(s.s.string) THEN
         s.s.type := qualident; s.qualident := s.s.string$
      ELSIF (s.s.type = TextMappers.string) & IsIdent(s.s.string) THEN
         s.ident := s.s.string$;
         TextMappers.ScanQualIdent(s.s, s.qualident, done);
         IF done THEN s.s.type := qualident ELSE s.s.type := ident END
      END
   END Scan;
   PROCEDURE GetParExtend (r: TextModels.Reader; VAR end: INTEGER);

      VAR v, v1: Views.View;
   BEGIN
      REPEAT r.ReadView(v);
         IF v # NIL THEN
            v1 := v;
            v := Properties.ThisType(v1, "DevCommanders.View") ;
            IF v = NIL THEN v := Properties.ThisType(v1, "DevCommanders.EndView")END
         END
      UNTIL r.eot OR (v # NIL);
      end := r.Pos(); IF ~r.eot THEN DEC(end) END
   END GetParExtend;
   PROCEDURE Unload (cmd: Dialog.String);

      VAR modname: Kernel.Name; str: Dialog.String; i: INTEGER; ch: CHAR; mod: Kernel.Module;
   BEGIN
      i := 0; ch := cmd[0];
      WHILE (ch # 0X) & (ch # ".") DO modname[i] := SHORT(ch); INC(i); ch := cmd[i] END;
      modname[i] := 0X;
      mod := Kernel.ThisLoadedMod(modname);
      IF mod # NIL THEN
         Kernel.UnloadMod(mod);
         IF mod.refcnt < 0 THEN
            str := modname$;
            Dialog.MapParamString("#Dev:Unloaded", str, "", "", str);
            StdLog.String(str); StdLog.Ln;
            Controls.Relink
         ELSE
            str := modname$;
            Dialog.ShowParamMsg("#Dev:UnloadingFailed", str, "", "")
         END
      END
   END Unload;
   PROCEDURE Execute (t: TextModels.Model; pos: INTEGER; VAR end: INTEGER; unload: BOOLEAN);

      VAR s: Scanner; beg, res: INTEGER; cmd: Dialog.String;
   BEGIN
      end := t.Length();
      s.s.ConnectTo(t); s.s.SetPos(pos); s.s.SetOpts({TextMappers.returnViews});
      Scan(s); ASSERT(s.s.type = execMark, 100);
      Scan(s);
      IF s.s.type IN {qualident, TextMappers.string} THEN
         beg := s.s.Pos() - 1; GetParExtend(s.s.rider, end);
         ASSERT(~cleanerInstalled, 101);
         Kernel.PushTrapCleaner(cleaner); cleanerInstalled := TRUE;
         NEW(par); par.text := t; par.beg := beg; par.end := end;
         IF s.s.type = qualident THEN cmd := s.qualident$ ELSE cmd := s.s.string$ END;
         IF unload (* & (s.s.type = qualident)*) THEN Unload(cmd) END;
         Dialog.Call(cmd, " ",res);
         par := NIL;
         Kernel.PopTrapCleaner(cleaner); cleanerInstalled := FALSE;
      END
   END Execute;
   PROCEDURE Track (v: View; f: Views.Frame; x, y: INTEGER; buttons: SET);

      VAR c: Models.Context; w, h, end: INTEGER; isDown, in, in0: BOOLEAN; m: SET;
   BEGIN
      c := v.context; c.GetSize(w, h); in0 := FALSE; in := TRUE;
      REPEAT
         IF in # in0 THEN
            f.MarkRect(0, 0, w, h, Ports.fill, Ports.invert, Ports.show); in0 := in
         END;
         f.Input(x, y, m, isDown);
         in := (0 <= x) & (x < w) & (0 <= y) & (y < h)
      UNTIL ~isDown;
      IF in0 THEN
         f.MarkRect(0, 0, w, h, Ports.fill, Ports.invert, Ports.hide);
         WITH c:TextModels.Context DO
            Execute(c.ThisModel(), c.Pos(), end,Controllers.modify IN buttons)
         ELSE Dialog.Beep
         END
      END
   END Track;
   (* StdView *)

   PROCEDURE (v: StdView) Externalize (VAR wr: Stores.Writer);

   BEGIN
      v.Externalize^(wr);
      wr.WriteVersion(maxStdVersion)
   END Externalize;
   PROCEDURE (v: StdView) Internalize (VAR rd: Stores.Reader);

      VAR thisVersion: INTEGER;
   BEGIN
      v.Internalize^(rd);
      IF rd.cancelled THEN RETURN END;
      rd.ReadVersion(minVersion, maxStdVersion, thisVersion)
   END Internalize;
   PROCEDURE (v: StdView) Restore (f: Views.Frame; l, t, r, b: INTEGER);

      CONST u = point;
      VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; color: Ports.Color;
         size, d, w, asc, dsc, fw: INTEGER; s: ARRAY 2 OF CHAR;
   BEGIN
      ASSERT(v.context # NIL, 20);
      c := v.context;
      WITH c: TextModels.Context DO a := c.Attr(); font := a.font; color := a.color
      ELSE font := Fonts.dir.Default(); color := Ports.defaultColor
      END;
      font.GetBounds(asc, dsc, fw);
      size := asc + dsc; d := size DIV 2;
      f.DrawOval(u, 0, u + size, size, Ports.fill, color);
      s := "!";
      w := font.StringWidth(s);
      f.DrawString(u + d - w DIV 2, size - dsc, Ports.background, s, font)
   END Restore;
   PROCEDURE (v: StdView) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;

                                                      VAR focus: Views.View);
   BEGIN
      WITH msg: Controllers.TrackMsg DO
         Track(v, f, msg.x, msg.y, msg.modifiers)
      | msg: Controllers.PollCursorMsg DO
         msg.cursor := Ports.refCursor
      ELSE
      END
   END HandleCtrlMsg;
   PROCEDURE (v: StdView) HandlePropMsg (VAR msg: Properties.Message);

      VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; asc, dsc, fw: INTEGER;
   BEGIN
      WITH msg: Properties.Preference DO
         WITH msg: Properties.SizePref DO
            c := v.context;
            IF (c # NIL) & (c IS TextModels.Context) THEN
               a := c(TextModels.Context).Attr(); font := a.font
            ELSE font := Fonts.dir.Default()
            END;
            font.GetBounds(asc, dsc, fw);
            msg.h := asc + dsc; msg.w := msg.h + 2 * point
         | msg: Properties.ResizePref DO
            msg.fixed := TRUE
         | msg: Properties.FocusPref DO
            msg.hotFocus := TRUE
         | msg: TextSetters.Pref DO
            c := v.context;
            IF (c # NIL) & (c IS TextModels.Context) THEN
               a := c(TextModels.Context).Attr(); font := a.font
            ELSE font := Fonts.dir.Default()
            END;
            font.GetBounds(asc, msg.dsc, fw)
         | msg: Properties.TypePref DO
            IF Services.Is(v, msg.type) THEN msg.view := v END
         ELSE
         END
      ELSE
      END
   END HandlePropMsg;
   
   
   (* StdEndView *)
   PROCEDURE (v: StdEndView) Restore (f: Views.Frame; l, t, r, b: INTEGER);

      CONST u = point;
      VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; color: Ports.Color;
         size, w, asc, dsc, fw: INTEGER; s: ARRAY 2 OF CHAR;
         points: ARRAY 3 OF Ports.Point;
   BEGIN
      ASSERT(v.context # NIL, 20);
      c := v.context;
      WITH c: TextModels.Context DO a := c.Attr(); font := a.font; color := a.color
      ELSE font := Fonts.dir.Default(); color := Ports.defaultColor
      END;
      font.GetBounds(asc, dsc, fw);
      size := asc + dsc;
      points[0].x := 0; points[0].y := size;
      points[1].x := u + (size DIV 2); points[1].y := size DIV 2;
      points[2].x := u + (size DIV 2); points[2].y := size;
      f.DrawPath(points, 3, Ports.fill, color, Ports.closedPoly)
   END Restore;
   
   PROCEDURE (v: StdEndView) HandlePropMsg (VAR msg: Properties.Message);
      VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; asc, dsc, fw: INTEGER;
   BEGIN
      WITH msg: Properties.Preference DO
         WITH msg: Properties.SizePref DO
            c := v.context;
            IF (c # NIL) & (c IS TextModels.Context) THEN
               a := c(TextModels.Context).Attr(); font := a.font
            ELSE font := Fonts.dir.Default()
            END;
            font.GetBounds(asc, dsc, fw);
            msg.h := asc + dsc; msg.w := (msg.h + 2 * point) DIV 2
         | msg: Properties.ResizePref DO
            msg.fixed := TRUE
         | msg: Properties.FocusPref DO
            msg.hotFocus := TRUE
         | msg: TextSetters.Pref DO
            c := v.context;
            IF (c # NIL) & (c IS TextModels.Context) THEN
               a := c(TextModels.Context).Attr(); font := a.font
            ELSE font := Fonts.dir.Default()
            END;
            font.GetBounds(asc, msg.dsc, fw)
         | msg: Properties.TypePref DO
            IF Services.Is(v, msg.type) THEN msg.view := v END
         ELSE
         END
      ELSE
      END
   END HandlePropMsg;
   (* StdDirectory *)

   PROCEDURE (d: StdDirectory) New (): View;

      VAR v: StdView;
   BEGIN
      NEW(v); RETURN v
   END New;
   
   PROCEDURE (d: StdDirectory) NewEnd (): EndView;
      VAR v: StdEndView;
   BEGIN
      NEW(v); RETURN v
   END NewEnd;
   PROCEDURE Deposit*;

   BEGIN
      Views.Deposit(dir.New())
   END Deposit;
   PROCEDURE DepositEnd*;

   BEGIN
      Views.Deposit(dir.NewEnd())
   END DepositEnd;
   PROCEDURE SetDir* (d: Directory);

   BEGIN
      dir := d
   END SetDir;
   PROCEDURE Init;

      VAR d: StdDirectory;
   BEGIN
      NEW(d); dir := d; stdDir := d;
      NEW(cleaner); cleanerInstalled := FALSE;
   END Init;
BEGIN

   Init
END DevCommanders.