blackbox-linux-console/BlackBox/Dev/Mod/Markers.txt

MODULE DevMarkers;

	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/Markers.odc *)
	(* DO NOT EDIT *)

	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.