MODULE DevMarkers;
(**
	project	= "BlackBox 2.0, diffs vs 1.7.2 are marked by green"
	organizations	= "Oberon microsystems, BBWFC, OberonCore, BBCP Team"
	contributors	= "Oberon microsystems, A.A. Dmitriev, I.A. Denisov, Ketmar Dark"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "The 2-Clause BSD License"
	changes	= "
	- 20070301, bh, helper strings enlarged to 1024 characters
	- 20161216, center #144, inconsistent docu and usage of Files.Locator error codes
	- 20170215, center #139, localization support for error messages
	-20200605, adimetrius, introduce View.CopyFromSimpleView2 to really enable extensions https://forum.oberoncore.ru/viewtopic.php?f=29&t=6621
	-20211123, dia, toggle first error & and unmark errors on right click
	-20230307, dia, make toogle does not mark document as dirty
	-20230324, k8, unmark with care to caret
	"
	issues	= "
	- ...
	"

**)

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

	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) CopyFromSimpleView2- (source: View), NEW, EMPTY;

	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;
			v.CopyFromSimpleView2(source)
		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, langLoc: Files.Locator;
			msg: ARRAY 1024 OF CHAR;
	BEGIN
		view := NIL;
		err := ABS(v.err); NumToStr(err, msg, i);
		loc := Files.dir.This("Dev"); IF loc.res # 0 THEN RETURN END;
		loc := loc.This("Rsrc"); IF loc.res # 0 THEN RETURN END;
		IF (Dialog.language # "") & (Dialog.language # Dialog.defaultLanguage) THEN
			langLoc := loc.This(Dialog.language);
			IF langLoc.res = 0 THEN
				view := Views.OldView(langLoc, errFile)
			END
		END;
		IF (view = NIL) OR ~ (view IS TextViews.View) THEN
			view := Views.OldView(loc, errFile)
		END;
		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 - f.dot, h, 0, color);
			f.DrawLine(0, h + f.dot, w, - 2 * f.dot,  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;

	(** 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 FindController (text: TextModels.Model): TextControllers.Controller;
	VAR
		w: Windows.Window;
		tc: TextControllers.Controller;
		c: Controllers.Controller;
		v: Views.View;
	BEGIN
		ASSERT(text # NIL, 20);
		tc := TextControllers.Focus();
		IF (tc = NIL) OR (tc.text # text) THEN
			tc := NIL; w := Windows.dir.First();
			WHILE (tc = NIL) & (w # NIL) DO
				IF w.doc # NIL THEN
					v := w.doc.OriginalView();
					IF (v # NIL) & (v IS TextViews.View) THEN
						c := v(TextViews.View).ThisController();
						IF (c # NIL) & (c IS TextControllers.Controller) THEN
							tc := c(TextControllers.Controller);
							IF tc.text # text THEN tc := NIL END
						END
					END
				END;
				w := Windows.dir.Next(w)
			END
		END;
		RETURN tc
	END FindController;

   PROCEDURE UnmarkWithCareToCaret (text: TextModels.Model; c: TextControllers.Controller);
   VAR
      r: TextModels.Reader;
      v: Views.View;
      pos: INTEGER;
      script: Stores.Operation;
      oldpos, obeg, oend: INTEGER;
   BEGIN
      IF c # NIL THEN
         oldpos := c.CaretPos();
         c.GetSelection(obeg, oend);
      ELSE oldpos := 0; obeg := 0; oend := 0
      END;
      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;
            IF oldpos > pos THEN DEC(oldpos) END;
            IF obeg < oend THEN
               IF obeg > pos THEN DEC(obeg) END;
               IF oend > pos THEN DEC(oend) END;
               IF obeg >= oend THEN oldpos := obeg END
            END;
            text.Delete(pos, pos + 1);
            r.SetPos(pos)
         END;
         r.ReadView(v)
      END;
      IF c # NIL THEN
         IF obeg < oend THEN c.SetSelection(obeg, oend)
         ELSIF (oldpos >= 0) & (oldpos <= text.Length()) THEN c.SetCaret(oldpos)
         END
      END;
      INC(thisEra);
      Models.EndScript(text, script);
      Models.EndModification(Models.clean, text);
   END UnmarkWithCareToCaret;

   PROCEDURE Unmark* (text: TextModels.Model);
   BEGIN UnmarkWithCareToCaret(text, FindController(text))
   END Unmark;


	(** command **)

	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();
			Models.BeginModification(Models.clean, t);
			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);
			Models.EndModification(Models.clean, t);
			globR := NIL
		END
	END ToggleCurrent;
	
	(** miscellaneous **)

	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);
			ToggleCurrent
		END
	END ShowFirstError;


	(** commands **)

	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 UnmarkErrors*;
		VAR tv: TextViews.View; c: Controllers.Controller; tc: TextControllers.Controller;
	BEGIN
		tv := TextViews.Focus();
		c := tv.ThisController();
		IF (c # NIL) & (c IS TextControllers.Controller) THEN
			tc := c(TextControllers.Controller)
		END;
		IF tv # NIL THEN UnmarkWithCareToCaret(tv.ThisModel(), tc) END
	END UnmarkErrors;


	(* 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
			IF Controllers.popup IN msg.modifiers THEN
				UnmarkErrors
			ELSE
				Track(v, f, msg.x, msg.y, msg.modifiers)
			END
		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;


	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.
