i21sys/Mod/Compiler.odc

MODULE  i21sysCompiler;
(**
	project	= "Информатика-21 / Informatika-21"
	contributors	= "F.V.Tkachov, E.E.Temirgaleev"
	changes	= "
	- 20121106, F.V.Tkachov, Models.BeginScript EndScript added
	- 20111212, F.V.Tkachov, a different separation into modules
	- 20090309, F.V.Tkachov, a piece of advice by E.E.Temirgaleev
	- YYYYMMDD, nn, ...
	"
	issues	= "
	- ...
	"

**)
	IMPORT  Log := StdLog,  Files,  Converters,  Views,  Stores,  Models,
		M := TextModels,  TextViews,  TextControllers,  TextMappers,  DevMarkers,  Dialog,
		Kernel,  DevCompiler,  DevCPT,  DevCPS,  V := i21sysVocabulary;
	
	VAR
		error-: BOOLEAN;
		off-, indentGuard: BOOLEAN;
	
	PROCEDURE NextMarker ( rd: M.Reader;  OUT v: Views.View ); (* продвинуть rd до след. маркера ошибок в t *)
	(* употребить ReadView -- совет Е.Э.Темиргалеева 2009-03-11 *)
	BEGIN
		rd.ReadView( v );
		WHILE ~rd.eot & ~( v IS DevMarkers.View ) DO  rd.ReadView( v )  END;
	END NextMarker;
	

	PROCEDURE InsertErrorMarkers ( c: TextControllers.Controller;  t: M.Model );
		VAR
			rd: M.Reader;  m, copy, first: Views.View;
			n: INTEGER; (* число уже вставленных маркеров ошибок -- доп. сдвиг *)
			pos0, pos, pos1: INTEGER;  wr: M.Writer;
	BEGIN
		n := 0;
		pos1 := -1;
		wr := c.text.NewWriter( NIL ); (* объект записи ("писатель"), через который идет запись в оригинальный текст *)
		rd := t.NewReader( NIL );
		NextMarker( rd, m );
		WHILE  ~rd.eot  DO
			pos := rd.Pos() - 1 - n; (* позиция данного маркера, как если бы предыдущих маркеров не было *)
			(* вставить маркер m из позиции pos в тексте t в позицию pos0 в c.text *)
			(* сначала найти позицию pos0 в c.text, соответствующую pos в t *)
			pos0 := V.OriginalPos( pos );  (* без учета маркеров ошибок *)
			pos0 := pos0 + n; (* т.к. было вставлено n маркеров *)
			(* вставка копии маркера: *)
			wr.SetPos( pos0 ); (* установили писателя в правильную позицию в оригинальном тексте *)
			copy := Views.CopyOf( m, Views.deep ); (* новая полная ("глубокая") копия маркера *)
			wr.WriteView( copy, rd.w, rd.h ); (* писатель вставляет копию маркера в своей текущей позиции *)
			(* маркер вставлен! *)
			IF  n = 0  THEN
				first := copy; (* запомним первый маркер, чтобы показать в окне именно его *)
				pos1 := wr.Pos(); (* чтобы в конце поставить курсор на первый маркер *)
			END; 
			INC( n );
			NextMarker( rd, m );
		END;
		IF  pos1 >= 0  THEN  c.SetCaret( pos1 ) (* поставили курсов в pos1 *) END;
		c.MakeViewVisible( first ); (* требуем показать в окне маркер first -- он соответствует первой ошибке *)
	END InsertErrorMarkers;
	
	PROCEDURE Compile*;
		VAR  c: TextControllers.Controller;  t: M.Model;  script: Stores.Operation;
	BEGIN
		DevMarkers.UnmarkErrors;
		(* взять текст в фокусе *)
		c := TextControllers.Focus();
		IF  c # NIL  THEN
			ASSERT( c.text # NIL ); (* c.text = нужный текст *)
			IF  V.language # 'en'  THEN
				(* преобразовать c.text в t, заменяя ключевые слова *)
				V.ConvertText( c.text, t );
			ELSE
				t := c.text
			END;
			(* компилировать t: *)
			DevCompiler.CompileText( t, 0, error );
			IF error & ( V.language # 'en' ) THEN (* вставить маркеры ошибок в c.text *)
				Models.BeginScript (c.text, "Insert compile error markers", script); (* все действия до EndScript будут отменяться как целое при нажатии Ctrl+Z *)
				InsertErrorMarkers( c, t );
				Models.EndScript (c.text, script);
			END;
		END;
	END Compile;
	
	PROCEDURE CompileAndReload*; (* указал И.А.Дехтяренко (Trurl) *)
		VAR  
	BEGIN
		DevCompiler.CompileAndUnload;
		Kernel.LoadMod( DevCPT.SelfName$ );
	END CompileAndReload;

	PROCEDURE ConvertCompileAndReload*;
		VAR  res: INTEGER;
	BEGIN
		Compile;
		IF ~error THEN
			Dialog.Call( 'DevDebug.Unload', '', res );
			Kernel.LoadMod( DevCPT.SelfName$ );  (* указал указал И.А.Дехтяренко (Trurl) *)
		END;
	END ConvertCompileAndReload;
	
	PROCEDURE LogMessage( res: INTEGER;  in: ARRAY OF CHAR );
		VAR out: ARRAY 100 OF CHAR;
	BEGIN
		IF res = 0 THEN
			Dialog.MapString( in, out );
			Log.String( out );  Log.Ln;
			indentGuard := TRUE
		ELSE
			Log.String('Indentation checks are not possible with this version of DevCPP, DevCPS');  Log.Ln;
			indentGuard := FALSE
		END;
	END LogMessage;
	
	PROCEDURE ToggleIndentChecks*;
		CONST dev0 = 'DevCPS.IndentChecks'; msg0 = '#i21sys:IndentChecks';
		VAR res: INTEGER; app, dev, msg: ARRAY 100 OF CHAR;
	BEGIN
		IF off THEN
			app := 'On';
		ELSE
			app := 'Off';
		END;
		dev := dev0 + app;
		msg := msg0 + app;
		off := ~off;
		Dialog.Call( dev, '', res );  (* вызов через Dialog.Call обходит проблему с переключением на оригинальный DevCPS, в котором нет этой команды *)
		LogMessage( res, msg )
	END ToggleIndentChecks;
	
	PROCEDURE IndentGuard* ( VAR par: Dialog.Par );
		VAR
	BEGIN
		par.disabled := ~indentGuard;
		IF off THEN
			par.label := '#i21sys:IndentMenuOn'
		ELSE
			par.label := '#i21sys:IndentMenuOff'
		END;
	END IndentGuard;
	
	PROCEDURE Init;
		VAR res: INTEGER;
	BEGIN
		off := TRUE;
		indentGuard := TRUE;
		Dialog.Call( 'DevCPS.IndentChecksOff', '', res );  (* вызов через Dialog.Call обходит проблему с переключением на оригинальный DevCPS, в котором нет этой команды *)
		indentGuard := ( res = 0 )
	END Init;

BEGIN Init
END i21sysCompiler.

i21sysCompiler.Compile

(*на себе должно ломаться: *)
i21sysCompiler.CompileAndReload
i21sysCompiler.ConvertCompileAndReload

DevDebug