Jedi Code Format: Improve formatting of a text selection in .inc files. Issue #37705, patch from Domingo Galmés.

git-svn-id: trunk@63872 -

components/jcf2/IdePlugin/lazarus/jcfidelazarus.lpk

@@ -1,8 +1,9 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
-  <Package Version="4">
+  <Package Version="5">
     <PathDelim Value="\"/>
     <Name Value="jcfidelazarus"/>
+    <Type Value="RunAndDesignTime"/>
     <AddToProjectUsesSection Value="True"/>
     <CompilerOptions>
       <Version Value="11"/>
@@ -20,7 +21,6 @@
       </Parsing>
       <Other>
         <CustomOptions Value="$(IDEBuildOptions)"/>
-        <CompilerPath Value="$(CompPath)"/>
       </Other>
     </CompilerOptions>
     <Description Value="JEDI Code Format IDE Plugin for Lazarus"/>
@@ -709,29 +709,24 @@
       </Item170>
       <Item171>
         <Filename Value="jcfuiconsts.pas"/>
-        <UnitName Value="jcfuiconsts"/>
+        <UnitName Value="JcfUIConsts"/>
       </Item171>
     </Files>
+    <CompatibilityMode Value="True"/>
     <i18n>
       <EnableI18N Value="True"/>
       <OutDir Value="languages"/>
     </i18n>
-    <Type Value="RunAndDesignTime"/>
-    <RequiredPkgs Count="2">
+    <RequiredPkgs Count="1">
       <Item1>
         <PackageName Value="IDEIntf"/>
       </Item1>
-      <Item2>
-        <PackageName Value="LCL"/>
-        <MinVersion Major="1" Valid="True"/>
-      </Item2>
     </RequiredPkgs>
     <UsageOptions>
       <UnitPath Value="$(PkgOutDir)"/>
     </UsageOptions>
     <PublishOptions>
       <Version Value="2"/>
-      <IgnoreBinaries Value="False"/>
     </PublishOptions>
   </Package>
 </CONFIG>

components/jcf2/IdePlugin/lazarus/jcfidemain.pas

@@ -66,8 +66,6 @@ type
     procedure ClearToolMessages;
     procedure ConvertEditor(const pciEditor: TSourceEditorInterface);
     function CanFormat(const AMsg: String): Boolean;
-
-  protected
   public
     constructor Create;
     destructor Destroy; override;
@@ -229,52 +227,6 @@ begin
   LazarusIDE.DoOpenIDEOptions(TfFiles);
 end;
 
-//offset in bytes of first char of the lines. 1 based.
-procedure FindLineOffsets(const aStr: string; aLineStart, aLineEnd: integer;
-                      out aLineStartOffset: integer; out aLineEndOffset:integer);
-var
-  lineCount:integer;
-  len:integer;
-  pC:PChar;
-  offset:integer;
-begin
-  len:=length(aStr);
-  pC:=@aStr[1];
-  lineCount:=1;
-  offset:=1;
-  aLineStartOffset:=0;
-  aLineEndOffset:=0;
-  if len<1 then
-    exit;
-  if aLineStart=1 then
-    aLineStartOffset:=offset;
-  if (aLineEnd=1) then
-    aLineEndOffset:=offset;
-  while (offset<=len) and (lineCount<=aLineEnd) do
-  begin
-    while (offset<=len) and (pC^<>#10) do
-    begin
-      inc(offset);
-      inc(pC);
-    end;
-    if (pC^=#10) and (offset<len) then
-    begin
-      inc(pC);
-      inc(offset);
-      inc(lineCount);
-      if lineCount=aLineStart then
-        aLineStartOffset:=offset;
-      if lineCount=aLineEnd then
-      begin
-        aLineEndOffset:=offset;
-        exit;
-      end;
-    end
-    else
-      exit;
-  end;
-end;
-
 procedure TJcfIdeMain.DoFormatSelection(Sender: TObject);
 var
   srcEditor: TSourceEditorInterface;
@@ -314,7 +266,7 @@ begin
   try
     fcConverter.OnStatusMessage := LogIDEMessage;
     fcConverter.InputCode := sourceCode;
-    fcConverter.GuiMessages := true;
+    fcConverter.GuiMessages := false; //true;
     FindLineOffsets(sourceCode,BlockBegin.Y,BlockEnd.Y,lineStartOffset,lineEndOffset);
     fcConverter.ConvertPart(lineStartOffset, lineEndOffset, True);
     if not fcConverter.ConvertError then
@@ -324,6 +276,22 @@ begin
         Dec(wI);
       outputstr := Copy(fcConverter.OutputCode, 1, wI);
       srcEditor.ReplaceLines(BlockBegin.Y, BlockEnd.Y, outputstr, false);
+    end
+    else
+    begin    //try formating wrapping selected code in fake unit.
+      ClearToolMessages;
+      BlockBegin := srcEditor.BlockBegin;
+      BlockBegin.X := 1;     // full lines.
+      BlockEnd := srcEditor.BlockEnd;
+      if BlockEnd.X > 1 then
+        BlockEnd.Y := BlockEnd.Y + 1;
+      BlockEnd.X := 1;
+      srcEditor.SelectText(BlockBegin, BlockEnd); //extend selection to full lines.
+      fcConverter.InputCode := srcEditor.GetText(True);  // only selected text.
+      fcConverter.GuiMessages := true;
+      fcConverter.ConvertUsingFakeUnit;
+      if not fcConverter.ConvertError then
+        srcEditor.ReplaceText(BlockBegin, BlockEnd, fcConverter.OutputCode);
     end;
   finally
     fcConverter.Free;

components/jcf2/ReadWrite/Converter.pas

@@ -92,6 +92,7 @@ type
     procedure Convert;
     procedure ConvertPart(const piStartIndex, piEndIndex: Integer;
                           aOnlyOutputSelection: boolean=false);
+    procedure ConvertUsingFakeUnit;
 
     procedure CollectOutput(const pcRoot: TParseTreeNode);
 
@@ -323,8 +324,7 @@ var
   leParseError:  TEParseError;
   leMessageType: TStatusMessageType;
 begin
-  lsMessage := 'Exception ' + pe.ClassName +
-    '  ' + pe.Message;
+  lsMessage := 'Exception ' + pe.ClassName + '  ' + pe.Message;
 
   if pe is TEParseError then
   begin
@@ -409,4 +409,100 @@ begin
   fsOutputCode := lsNewOutput;
 end;
 
+{ position on we insert selected CODE depending if the CODE contains interface
+  and/or implementation
+
+hasIterface     F      F      T      T
+hasImplemen.    F      T      F      T
+-----------------------------------------
+              +unit  +unit  +unit  +unit
+              +intf  +intf  CODE   CODE
+              +impl  CODE   +impl  +end.
+              CODE   +end.  +end.
+              +end.
+}
+
+// convert only formats complete units
+// so we wrap the selected code in a fake unit.
+// Only works if the inputCode include the full procedure,function,class or record declaration.
+// Needed for formating include files or part of a file with tokens not supported by
+// the jedi code format parser.
+// {$I %DATE%} for example.
+procedure TConverter.ConvertUsingFakeUnit;
+const
+  END_MARK_INTERFACE = 'tfaketjcf_intfc_end_mark;';        //<lower case required
+  END_MARK_IMPLEMENTATION = 'tfaketjcf_implm_end_mark;'; //<lower case required
+  FAKE_UNIT_NAME = 'fakeunitjcf;'; //<lower case required
+var
+  sourceCode: string;
+  sourceCodeLowerCase: string;
+  lcStartIndex, lcEndIndex: integer;
+  hasInterface, hasImplementation: boolean;
+
+  procedure AddFakeUnit;
+  begin
+    sourceCode := sourceCode + 'unit ' + FAKE_UNIT_NAME + #10;
+  end;
+
+  procedure AddFakeInterface;
+  begin
+    sourceCode := sourceCode + 'interface' + #10;
+    sourceCode := sourceCode + 'type' + #10;        // if there is only a class selected this is required
+    sourceCode := sourceCode + 'faketjcfifc=' + END_MARK_INTERFACE + #10;
+  end;
+
+  procedure AddFakeImplementation;
+  begin
+    sourceCode := sourceCode + 'implementation' + #10;
+    sourceCode := sourceCode + 'type' + #10;
+    sourceCode := sourceCode + 'faketjcfimpl=' + END_MARK_IMPLEMENTATION + #10;
+  end;
+
+  procedure AddFakeEnd;
+  begin
+    sourceCode := sourceCode + #10 + 'end.' + #10;
+  end;
+
+begin
+  //WRAPPING the inputCode in a fake unit
+  sourceCodeLowerCase := LowerCase(fsInputCode);
+  hasInterface := HasStringAtLineStart(sourceCodeLowerCase, 'interface');
+  hasImplementation := HasStringAtLineStart(sourceCodeLowerCase, 'implementation');
+  sourceCode := '';
+  AddFakeUnit;
+  if hasInterface = False then
+  begin
+    AddFakeInterface;
+    if hasImplementation = False then
+      AddFakeImplementation;
+  end;
+  sourceCode := sourceCode + fsInputCode;
+  if (hasInterface = True) and (hasImplementation = False) then
+    AddFakeImplementation;
+  AddFakeEnd;
+  fsInputCode:=sourceCode;
+  Convert;
+  if ConvertError = False then
+  begin
+    sourceCodeLowerCase := LowerCase(OutputCode);
+    //DELETE FAKE lines from output
+    if hasInterface then
+      lcStartIndex := Pos(FAKE_UNIT_NAME, sourceCodeLowerCase) + length(FAKE_UNIT_NAME)
+    else
+    begin
+      if hasImplementation then
+        lcStartIndex := Pos(END_MARK_INTERFACE, sourceCodeLowerCase) + length(END_MARK_INTERFACE)
+      else
+        lcStartIndex := Pos(END_MARK_IMPLEMENTATION, sourceCodeLowerCase) + length(END_MARK_IMPLEMENTATION);
+    end;
+    lcStartIndex := SkipToNextLine(sourceCodeLowerCase, lcStartIndex);
+    if hasInterface and not hasImplementation then
+      lcEndIndex := RPos('implementation', sourceCodeLowerCase)
+    else
+      lcEndIndex := RPos('end', sourceCodeLowerCase);
+    lcEndIndex := SkipLeftSpaces(sourceCodeLowerCase, lcEndIndex);
+    fsOutputCode:=Copy(OutputCode, lcStartIndex, lcEndIndex - lcStartIndex);
+  end;
+end;
+
 end.

components/jcf2/Utils/JcfStringUtils.pas

@@ -34,7 +34,7 @@ For use when the JCL string functions are not avaialable
 interface
 
 uses
-  SysUtils, Classes;
+  SysUtils, Classes, StrUtils;
 
 const
   NativeNull           = Char(#0);
@@ -91,12 +91,7 @@ const
   NativeDoubleQuote = Char('"');
   NativeSingleQuote = Char('''');
 
-
-{$IFNDEF DELPHI12}
-{$IFNDEF DELPHI14}
 function CharInSet(const C: Char; const testSet: TSysCharSet): Boolean;
-{$ENDIF}
-{$ENDIF}
 function CharIsAlpha(const C: Char): Boolean;
 function CharIsAlphaNum(const C: Char): Boolean;
 function CharIsWordChar(const c: Char): Boolean;
@@ -154,30 +149,24 @@ function PathExtractFileNameNoExt(const Path: string): string;
 function PadNumber(const pi: integer): string;
 function StrHasAlpha(const str: String): boolean;
 
+//offset in bytes of first char of the lines. 1 based.
+procedure FindLineOffsets(const aStr: string; aLineStart, aLineEnd: integer;
+                      out aLineStartOffset: integer; out aLineEndOffset:integer);
+function SkipLeftSpaces(const aStr: string; aPos: integer): integer;
+function SkipToNextLine(const aStr: string; aPos: integer): integer;
+function HasStringAtLineStart(const aSourceCode: string; const aStr: string): boolean;
+
 type
   EJcfConversionError = class(Exception)
   end;
 
 implementation
 
-uses
-{$ifdef MSWINDOWS}
-  //Windows, ShellApi
-{$endif}
-{$ifdef Unix}
-  //Unix
-{$endif}
-  LCLIntf, fileutil;
-
-{$IFNDEF DELPHI12}
-{$IFNDEF DELPHI14}
-// define  CharInSet for Delphi 2007 or earlier
+// define CharInSet
 function CharInSet(const C: Char; const testSet: TSysCharSet): Boolean;
 begin
   Result := C in testSet;
 end;
-{$ENDIF}
-{$ENDIF}
 
 function CharIsAlpha(const C: Char): Boolean;
 begin
@@ -603,6 +592,98 @@ begin
   end;
 end;
 
+//offset in bytes of first char of the lines. 1 based.
+procedure FindLineOffsets(const aStr: string; aLineStart, aLineEnd: integer;
+                      out aLineStartOffset: integer; out aLineEndOffset:integer);
+var
+  lineCount:integer;
+  len:integer;
+  pC:PChar;
+  offset:integer;
+begin
+  len:=length(aStr);
+  pC:=@aStr[1];
+  lineCount:=1;
+  offset:=1;
+  aLineStartOffset:=0;
+  aLineEndOffset:=0;
+  if len<1 then
+    exit;
+  if aLineStart=1 then
+    aLineStartOffset:=offset;
+  if (aLineEnd=1) then
+    aLineEndOffset:=offset;
+  while (offset<=len) and (lineCount<=aLineEnd) do
+  begin
+    while (offset<=len) and (pC^<>#10) do
+    begin
+      inc(offset);
+      inc(pC);
+    end;
+    if (pC^=#10) and (offset<len) then
+    begin
+      inc(pC);
+      inc(offset);
+      inc(lineCount);
+      if lineCount=aLineStart then
+        aLineStartOffset:=offset;
+      if lineCount=aLineEnd then
+      begin
+        aLineEndOffset:=offset;
+        exit;
+      end;
+    end
+    else
+      exit;
+  end;
+end;
+
+function SkipLeftSpaces(const aStr: string; aPos: integer): integer;
+begin
+  while (aPos > 1) do
+  begin
+    Dec(aPos);
+    if not (aStr[aPos] in [' ',#9]) then
+      break;
+  end;
+  Result := aPos;
+end;
+
+function SkipToNextLine(const aStr: string; aPos: integer): integer;
+begin
+  while (aPos > 1) and (aPos < Length(aStr)) do
+  begin
+    Inc(aPos);
+    if aStr[aPos] = #10 then
+    begin
+      Inc(aPos);
+      break;
+    end;
+  end;
+  Result := aPos;
+end;
+
+function HasStringAtLineStart(const aSourceCode: string; const aStr: string): boolean;
+var
+  index, stringStart: integer;
+begin
+  index := 1;
+  while (index > 0) and (index < length(aSourceCode)) do
+  begin
+    stringStart := PosEx(aStr, aSourceCode, index);
+    if (stringStart > 0) then
+    begin
+      index := SkipLeftSpaces(aSourceCode, stringStart);
+      if (index > 0) and ((index = 1) or (aSourceCode[index] in [#10, #13])) then
+        exit(True);
+      index := stringStart + length(aStr);
+    end
+    else
+      break;
+  end;
+  Result := False;
+end;
+
 {------------------------------------------------------
   functions to manipulate file paths in strings }