MODULE DevMarkers;
(**

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

**)

   IMPORT

      Kernel, Files, Stores, Fonts, Ports, Models, Views, Controllers, Properties, Dialog,
      TextModels, TextSetters, TextViews, TextControllers, TextMappers;
   CONST

      (** View.mode **)
      undefined* = 0; mark* = 1; message* = 2;
      firstMode = 1; lastMode = 2;
      (** View.err **)

      noCode* = 9999;
      errFile = "Errors"; point = Ports.point;

   TYPE

      View* = POINTER TO ABSTRACT RECORD (Views.View)
         mode-: INTEGER;
         err-: INTEGER;
         msg-: POINTER TO ARRAY OF CHAR;
         era: INTEGER
      END;
      Directory* = POINTER TO ABSTRACT RECORD END;

      StdView = POINTER TO RECORD (View) END;


      StdDirectory = POINTER TO RECORD (Directory) END;

      SetModeOp = POINTER TO RECORD (Stores.Operation)

         view: View;
         mode: INTEGER
      END;
      
   VAR

      dir-, stdDir-: Directory;
      globR: TextModels.Reader; globW: TextModels.Writer;   (* recycling done in Load, Insert *)

      
      thisEra: INTEGER;
   (** View **)


   PROCEDURE (v: View) CopyFromSimpleView- (source: Views.View), EXTENSIBLE;

   BEGIN
      (* v.CopyFrom^(source); *)
      WITH source: View DO
         v.err := source.err; v.mode := source.mode;
         IF source.msg # NIL THEN
            NEW(v.msg, LEN(source.msg^)); v.msg^ := source.msg^$
         END
      END
   END CopyFromSimpleView;
(*

   PROCEDURE (v: View) InitContext* (context: Models.Context), EXTENSIBLE;
   BEGIN
      ASSERT(v.mode # undefined, 20);
      v.InitContext^(context)
   END InitContext;
*)
   PROCEDURE (v: View) InitErr* (err: INTEGER), NEW, EXTENSIBLE;

   BEGIN
      ASSERT(v.msg = NIL, 20);
      IF v.err # err THEN v.err := err; v.mode := mark END;
      IF v.mode = undefined THEN v.mode := mark END
   END InitErr;
   PROCEDURE (v: View) InitMsg* (msg: ARRAY OF CHAR), NEW, EXTENSIBLE;

      VAR i: INTEGER; str: ARRAY 1024 OF CHAR;
   BEGIN
      ASSERT(v.msg = NIL, 20);
      Dialog.MapString(msg, str);
      i := 0; WHILE str[i] # 0X DO INC(i) END;
      NEW(v.msg, i + 1); v.msg^ := str$;
      v.mode := mark
   END InitMsg;
   PROCEDURE (v: View) SetMode* (mode: INTEGER), NEW, EXTENSIBLE;

      VAR op: SetModeOp;
   BEGIN
      ASSERT((firstMode <= mode) & (mode <= lastMode), 20);
      IF v.mode # mode THEN
         NEW(op); op.view := v; op.mode := mode;
         Views.Do(v, "#System:ViewSetting", op)
      END
   END SetMode;
   (** Directory **)


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

   PROCEDURE (d: Directory) NewMsg* (msg: ARRAY OF CHAR): View, NEW, ABSTRACT;
   (* SetModeOp *)


   PROCEDURE (op: SetModeOp) Do;

      VAR v: View; mode: INTEGER;
   BEGIN
      v := op.view;
      mode := v.mode; v.mode := op.mode; op.mode := mode;
      Views.Update(v, Views.keepFrames);
      IF v.context # NIL THEN v.context.SetSize(Views.undefined, Views.undefined) END
   END Do;
   PROCEDURE ToggleMode (v: View);

      VAR mode: INTEGER;
   BEGIN
      IF ABS(v.err) # noCode THEN
         IF v.mode < lastMode THEN mode := v.mode + 1 ELSE mode := firstMode END
      ELSE
         IF v.mode < message THEN mode := v.mode + 1 ELSE mode := firstMode END
      END;
      v.SetMode(mode)
   END ToggleMode;
   (* primitives for StdView *)


   PROCEDURE NumToStr (x: INTEGER; VAR s: ARRAY OF CHAR; VAR i: INTEGER);

      VAR j: INTEGER; m: ARRAY 32 OF CHAR;
   BEGIN
      ASSERT(x >= 0, 20);
      j := 0; REPEAT m[j] := CHR(x MOD 10 + ORD("0")); x := x DIV 10; INC(j) UNTIL x = 0;
      i := 0; REPEAT DEC(j); s[i] := m[j]; INC(i) UNTIL j = 0;
      s[i] := 0X
   END NumToStr;
   PROCEDURE Load (v: StdView);

      VAR view: Views.View; t: TextModels.Model; s: TextMappers.Scanner;
         err: INTEGER; i: INTEGER; ch: CHAR; loc: Files.Locator;
         msg: ARRAY 1024 OF CHAR;
   BEGIN
      err := ABS(v.err); NumToStr(err, msg, i);
      loc := Files.dir.This("Dev"); IF loc = NIL THEN RETURN END;
      loc := loc.This("Rsrc"); IF loc = NIL THEN RETURN END;
      view := Views.OldView(loc, errFile);
      IF (view # NIL) & (view IS TextViews.View) THEN
         t := view(TextViews.View).ThisModel();
         IF t # NIL THEN
            s.ConnectTo(t);
            REPEAT
               s.Scan
            UNTIL ((s.type = TextMappers.int) & (s.int = err)) OR (s.type = TextMappers.eot);
            IF s.type = TextMappers.int THEN
               s.Skip(ch); i := 0;
               WHILE (ch >= " ") & (i < LEN(msg) - 1) DO
                  msg[i] := ch; INC(i); s.rider.ReadChar(ch)
               END;
               msg[i] := 0X
            END
         END
      END;
      NEW(v.msg, i + 1); v.msg^ := msg$
   END Load;
   PROCEDURE DrawMsg (v: StdView; f: Views.Frame; font: Fonts.Font; color: Ports.Color);

      VAR w, h, asc, dsc: INTEGER;
   BEGIN
      CASE v.mode OF
      mark:
         v.context.GetSize(w, h);
         f.DrawLine(point, 0, w - 2 * point, h, 0, color);
         f.DrawLine(w - 2 * point, 0, point, h, 0, color)
      | message:
         font.GetBounds(asc, dsc, w);
         f.DrawString(2 * point, asc, color, v.msg^, font)
      END
   END DrawMsg;
   
   PROCEDURE ShowMsg (v: StdView);
   BEGIN
      IF v.msg = NIL THEN Load(v) END;
      Dialog.ShowStatus(v.msg^)
   END ShowMsg;
   PROCEDURE Track (v: StdView; f: Views.Frame; x, y: INTEGER; buttons: SET);

      VAR c: Models.Context; t: TextModels.Model; u, w, h: INTEGER; isDown, in, in0: BOOLEAN; m: SET;
   BEGIN
      v.context.GetSize(w, h); u := f.dot; in0 := FALSE;
      in := (0 <= x) & (x < w) & (0 <= y) & (y < h);
      REPEAT
         IF in # in0 THEN
            f.MarkRect(u, 0, w - u, 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(u, 0, w - u, h, Ports.fill, Ports.invert, Ports.hide);
         IF Dialog.showsStatus & ~(Controllers.modify IN buttons) & ~(Controllers.doubleClick IN buttons) THEN
            ShowMsg(v)
         ELSE
            ToggleMode(v)
         END;
         c := v.context;
         WITH c: TextModels.Context DO
            t := c.ThisModel();
            TextControllers.SetCaret(t, c.Pos() + 1)
         ELSE
         END
      END
   END Track;
   PROCEDURE SizePref (v: StdView; VAR p: Properties.SizePref);

      VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; asc, dsc, w: INTEGER;
   BEGIN
      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, w);
      p.h := asc + dsc;
      CASE v.mode OF
      mark:
         p.w := p.h + 2 * point
      | message:
         IF v.msg = NIL THEN Load(v) END;
         p.w := font.StringWidth(v.msg^) + 4 * point
      END
   END SizePref;
   (* StdView *)


   PROCEDURE (v: StdView) ExternalizeAs (VAR s1: Stores.Store);

   BEGIN
      s1 := NIL
   END ExternalizeAs;
   PROCEDURE (v: StdView) SetMode(mode: INTEGER);

   BEGIN v.SetMode^(mode); ShowMsg(v)
   END SetMode;
   PROCEDURE (v: StdView) Restore (f: Views.Frame; l, t, r, b: INTEGER);

      VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; color: Ports.Color;
         w, h: INTEGER;
   BEGIN
      c := v.context; c.GetSize(w, h);
      WITH c: TextModels.Context DO a := c.Attr(); font := a.font ELSE font := Fonts.dir.Default() END;
      IF TRUE (*f.colors >= 4*) THEN color := Ports.grey50 ELSE color := Ports.defaultColor END;
      IF v.err >= 0 THEN
         f.DrawRect(point, 0, w - point, h, Ports.fill, color);
         DrawMsg(v, f, font, Ports.background)
      ELSE
         f.DrawRect(point, 0, w - point, h, 0, color);
         DrawMsg(v, f, font, Ports.defaultColor)
      END
   END Restore;
   PROCEDURE (v: StdView) GetBackground (VAR color: Ports.Color);

   BEGIN
      color := Ports.background
   END GetBackground;
   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)
      ELSE
      END
   END HandleCtrlMsg;
   PROCEDURE (v: StdView) HandlePropMsg (VAR msg: Properties.Message);

      VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; asc, w: INTEGER;
   BEGIN
      WITH msg: Properties.Preference DO
         WITH msg: Properties.SizePref DO
            SizePref(v, msg)
         | msg: Properties.ResizePref DO
            msg.fixed := TRUE
         | msg: Properties.FocusPref DO
            msg.hotFocus := TRUE
(*
         | msg: Properties.StorePref DO
            msg.view := NIL
*)
         | 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, w)
         ELSE
         END
      ELSE
      END
   END HandlePropMsg;
   (* StdDirectory *)


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

      VAR v: StdView;
   BEGIN
      NEW(v); v.InitErr(err); RETURN v
   END New;
   PROCEDURE (d: StdDirectory) NewMsg (msg: ARRAY OF CHAR): View;

      VAR v: StdView;
   BEGIN
      NEW(v); v.InitErr(noCode); v.InitMsg(msg); RETURN v
   END NewMsg;
   (** Cleaner **)


   PROCEDURE Cleanup;

   BEGIN
      globR := NIL; globW := NIL
   END Cleanup;
   
   (** miscellaneous **)

   PROCEDURE Insert* (text: TextModels.Model; pos: INTEGER; v: View);

      VAR w: TextModels.Writer; r: TextModels.Reader;
   BEGIN
      ASSERT(v.era = 0, 20);
      Models.BeginModification(Models.clean, text);
      v.era := thisEra;
      IF pos > text.Length() THEN pos := text.Length() END;
      globW := text.NewWriter(globW); w := globW; w.SetPos(pos);
      IF pos > 0 THEN DEC(pos) END;
      globR := text.NewReader(globR); r := globR; r.SetPos(pos); r.Read;
      IF r.attr # NIL THEN w.SetAttr(r.attr) END;
      w.WriteView(v, Views.undefined, Views.undefined);
      Models.EndModification(Models.clean, text);
   END Insert;
   PROCEDURE Unmark* (text: TextModels.Model);

      VAR r: TextModels.Reader; v: Views.View; pos: INTEGER;
         script: Stores.Operation;
   BEGIN
      Models.BeginModification(Models.clean, text);
      Models.BeginScript(text, "#Dev:DeleteMarkers", script);
      r := text.NewReader(NIL); r.ReadView(v);
      WHILE ~r.eot DO
         IF r.view IS View THEN
            pos := r.Pos() - 1; text.Delete(pos, pos + 1); r.SetPos(pos)
         END;
         r.ReadView(v)
      END;
      INC(thisEra);
      Models.EndScript(text, script);
      Models.EndModification(Models.clean, text);
   END Unmark;
   PROCEDURE ShowFirstError* (text: TextModels.Model; focusOnly: BOOLEAN);

      VAR v1: Views.View; pos: INTEGER;
   BEGIN
      globR := text.NewReader(globR); globR.SetPos(0);
      REPEAT globR.ReadView(v1) UNTIL globR.eot OR (v1 IS View);
      IF ~globR.eot THEN
         pos := globR.Pos();
         TextViews.ShowRange(text, pos, pos, focusOnly);
         TextControllers.SetCaret(text, pos);
         v1(View).SetMode(v1(View).mode)
      END
   END ShowFirstError;
   (** commands **)


   PROCEDURE UnmarkErrors*;

      VAR t: TextModels.Model;
   BEGIN
      t := TextViews.FocusText();
      IF t # NIL THEN Unmark(t) END
   END UnmarkErrors;
   PROCEDURE NextError*;

      VAR c: TextControllers.Controller; t: TextModels.Model; v1: Views.View;
         beg, pos: INTEGER;
   BEGIN
      c := TextControllers.Focus();
      IF c # NIL THEN
         t := c.text;
         IF c.HasCaret() THEN pos := c.CaretPos()
         ELSIF c.HasSelection() THEN c.GetSelection(beg, pos)
         ELSE pos := 0
         END;
         TextControllers.SetSelection(t, TextControllers.none, TextControllers.none);
         globR := t.NewReader(globR); globR.SetPos(pos);
         REPEAT globR.ReadView(v1) UNTIL globR.eot OR (v1 IS View);
         IF ~globR.eot THEN
            pos := globR.Pos(); v1(View).SetMode(v1(View).mode);
            TextViews.ShowRange(t, pos, pos, TextViews.focusOnly)
         ELSE
            pos := 0; Dialog.Beep
         END;
         TextControllers.SetCaret(t, pos);
         globR := NIL
      END
   END NextError;
   PROCEDURE ToggleCurrent*;

      VAR c: TextControllers.Controller; t: TextModels.Model; v: Views.View; pos: INTEGER;
   BEGIN
      c := TextControllers.Focus();
      IF (c # NIL) & c.HasCaret() THEN
         t := c.text; pos := c.CaretPos();
         globR := t.NewReader(globR); globR.SetPos(pos); globR.ReadPrev;
         v := globR.view;
         IF (v # NIL) & (v IS View) THEN ToggleMode(v(View)) END;
         TextViews.ShowRange(t, pos, pos, TextViews.focusOnly);
         TextControllers.SetCaret(t, pos);
         globR := NIL
      END
   END ToggleCurrent;
   PROCEDURE SetDir* (d: Directory);


   BEGIN
      dir := d
   END SetDir;
   PROCEDURE Init;


      VAR d: StdDirectory;
   BEGIN
      thisEra := 1;
      NEW(d); dir := d; stdDir := d
   END Init;
BEGIN

   Init; Kernel.InstallCleaner(Cleanup)
CLOSE
   Kernel.RemoveCleaner(Cleanup)
END DevMarkers.