FIX: Ui

ADD: recursive .inc files

Author: PascalCorpsman

src/unit1.lfm

@@ -39,9 +39,9 @@ object Form1: TForm1
   end
   object Label1: TLabel
     Left = 304
-    Height = 16
+    Height = 15
     Top = 160
-    Width = 140
+    Width = 122
     Caption = 'Nothing loaded, please'
   end
   object Button1: TButton
@@ -64,9 +64,9 @@ object Form1: TForm1
   end
   object Label2: TLabel
     Left = 368
-    Height = 16
+    Height = 15
     Top = 208
-    Width = 13
+    Width = 11
     Caption = 'or'
   end
   object MainMenu1: TMainMenu

src/unit1.pas

@@ -1,7 +1,7 @@
 (******************************************************************************)
 (* FPC Understand                                                  30.03.2023 *)
 (*                                                                            *)
-(* Version     : 0.25                                                         *)
+(* Version     : 0.27                                                         *)
 (*                                                                            *)
 (* Author      : Uwe Schächterle (Corpsman)                                   *)
 (*                                                                            *)
@@ -64,6 +64,8 @@
 (*               0.25 - ADD: Code preview / review feature                    *)
 (*                      ADD: Mark nodes with comments                         *)
 (*               0.26 - FIX: Line index after {$I ...}                        *)
+(*               0.27 - ADD: Support recursive {$I ...}                       *)
+(*                      FIX: Set carety when showing code editor              *)
 (*                                                                            *)
 (* Known Bugs  : - if a project holds 2 units with the same name              *)
 (*                 the dependency graph will merge them to one                *)

src/unit13.lfm

@@ -10,6 +10,7 @@ object Form13: TForm13
   LCLVersion = '3.99.0.0'
   OnCloseQuery = FormCloseQuery
   OnCreate = FormCreate
+  OnShow = FormShow
   object Button1: TButton
     Left = 717
     Height = 25

src/unit13.pas

@@ -44,6 +44,7 @@
     Procedure Button2Click(Sender: TObject);
     Procedure FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
     Procedure FormCreate(Sender: TObject);
+    Procedure FormShow(Sender: TObject);
     Procedure MenuItem1Click(Sender: TObject);
     Procedure MenuItem2Click(Sender: TObject);
     Procedure ScrollBox1Resize(Sender: TObject);
@@ -55,6 +56,7 @@
     frelativeFilename: String;
     fAbsoluteFilename: String;
     fFrameNameCounter: integer;
+    fformShowOnce: Boolean;
     Procedure RepositionAllComments;
     Function AddLineMark(Line: Integer): TCommentFrame;
     Procedure RemoveLineMark(Line: integer);
@@ -96,6 +98,15 @@
   Splitter1.Align := alRight;
   SynEdit1.Align := alClient;
   fFrameNameCounter := 0;
+  fformShowOnce := true;
+End;
+
+Procedure TForm13.FormShow(Sender: TObject);
+Begin
+  If fformShowOnce Then Begin
+    fformShowOnce := false;
+    SynEdit1.SetFocus;
+  End;
 End;
 
 Procedure TForm13.MenuItem1Click(Sender: TObject);
@@ -114,6 +125,7 @@
     showmessage('Error, nothing to export.');
     exit;
   End;
+  c := Nil;
   setlength(c, ScrollBox1.ComponentCount);
   For i := 0 To high(c) Do Begin
     c[i].Line := (ScrollBox1.Components[i] As TCommentFrame).Line;
@@ -320,6 +332,8 @@
       SynEdit1.TopLine := SynEdit1.Lines.Count - 1;
       SynEdit1.Invalidate;
       SynEdit1.TopLine := aLine;
+      SynEdit1.CaretY := aLine;
+      fformShowOnce := true; // Synedit1.setfocus triggern
     End;
     caption := 'File preview: ' + ExtractFileName(frelativeFilename);
     ShowModal;

src/upascallexer.pas

@@ -1,7 +1,7 @@
 (******************************************************************************)
 (* upascallexer                                                    19.04.2023 *)
 (*                                                                            *)
-(* Version     : 0.05                                                         *)
+(* Version     : 0.06                                                         *)
 (*                                                                            *)
 (* Author      : Uwe Schächterle (Corpsman)                                   *)
 (*                                                                            *)
@@ -27,6 +27,7 @@
 (*               0.03 - Start with unittests, fix "invalid" ( * Parsing       *)
 (*               0.04 - Berücksichtigen von {$I ...}                          *)
 (*               0.05 - Fix Linecounting von {$I ...}                         *)
+(*               0.06 - Support recursive includes                            *)
 (*                                                                            *)
 (******************************************************************************)
 Unit upascallexer;
@@ -357,17 +358,18 @@
 Procedure TPascalLexer.DoLex(Const Stream: TStream);
 
 Var
-  BlockLineCounting: Boolean; // Wenn True, dann werden die ZeilenNummern nicht "Erhöht" wenn CRT gelesen wird.
+  BlockLineCounting: integer; // Wenn True, dann werden die ZeilenNummern nicht "Erhöht" wenn CRT gelesen wird.
 
   Procedure HToken(); //Inline;
   Begin
     If atoken = '~DisableLineCounter~' Then Begin
-      BlockLineCounting := true;
+      inc(BlockLineCounting);
       atoken := '';
       exit;
     End;
     If atoken = '~EnableLineCounter~' Then Begin
-      BlockLineCounting := false;
+      dec(BlockLineCounting);
+      If BlockLineCounting < 0 Then BlockLineCounting := 0;
       atoken := '';
       exit;
     End;
@@ -404,7 +406,7 @@
   i, mSize: Int64;
 Begin
   aToken := '';
-  BlockLineCounting := false;
+  BlockLineCounting := 0;
   State := sCollectToken;
   CommentDetphCounter := 0;
   pc := #0;
@@ -672,7 +674,7 @@
       inc(aEmptyLine);
     End;
     If (c = LB) Then Begin
-      If (Not BlockLineCounting) Then Begin
+      If (BlockLineCounting = 0) Then Begin
         inc(aLine);
       End;
       inc(aParsedLine);
@@ -690,20 +692,16 @@
 End;
 
 Procedure TPascalLexer.LexFile(Const Filename: String);
-Var
-  m: TMemoryStream;
-  sl2, sl: TStringList;
-  i: integer;
-  s, t: String;
-Begin
-  sl := TStringList.Create;
-  Try
-    sl.LoadFromFile(Filename);
-    // Auflösen der Includierten Dateien, ja das ist ein Böser Hack ..
-    If assigned(OnResolveFileRequest) And (pos('{$I ', sl.text) <> 0) Then Begin
-      For i := 0 To sl.Count - 1 Do Begin
-        If pos('{$I ', sl[i]) <> 0 Then Begin
-          s := sl[i];
+  Procedure IncludeIncludes(Const Content: TStringList);
+  Var
+    sl2: TStringList;
+    i: integer;
+    s, t: String;
+  Begin
+    If (pos('{$I ', content.text) <> 0) Then Begin
+      For i := content.Count - 1 Downto 0 Do Begin
+        If pos('{$I ', content[i]) <> 0 Then Begin
+          s := content[i];
           s := copy(s, pos('{$I ', s) + 4, length(s));
           t := copy(s, pos('}', s) + 1, length(s)); // Retten dessen was nach dem Include kommt.
           s := copy(s, 1, pos('}', s) - 1);
@@ -712,12 +710,27 @@
           If s <> '' Then Begin
             sl2 := TStringList.Create;
             sl2.LoadFromFile(s);
-            sl[i] := ' ~DisableLineCounter~ ' + sl2.Text + ' ~EnableLineCounter~ ' + t;
+            IncludeIncludes(sl2); // Falls includes, includes machen ..
+            content[i] := ' ~DisableLineCounter~ ' + sl2.Text + ' ~EnableLineCounter~ ' + t;
             sl2.free;
           End;
         End;
       End;
     End;
+  End;
+
+Var
+  m: TMemoryStream;
+  sl: TStringList;
+
+Begin
+  sl := TStringList.Create;
+  Try
+    sl.LoadFromFile(Filename);
+    // Rekursives Auflösen der Includierten Dateien
+    If assigned(OnResolveFileRequest) Then Begin
+      IncludeIncludes(sl);
+    End;
     m := TMemoryStream.Create;
     sl.SaveToStream(m);
     Try