added a range-based parser, experimented in the message parser

lazproj/coedit.lpi

@@ -137,7 +137,7 @@
         <PackageName Value="LCL"/>
       </Item6>
     </RequiredPackages>
-    <Units Count="46">
+    <Units Count="47">
       <Unit0>
         <Filename Value="coedit.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -380,6 +380,10 @@
         <Filename Value="..\src\ce_lcldragdrop.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit45>
+      <Unit46>
+        <Filename Value="..\src\ce_stringrange.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit46>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

lazproj/coedit.lpr

@@ -11,7 +11,7 @@ uses
   ce_writableComponent, ce_symstring, ce_staticmacro, ce_inspectors,
   ce_editoroptions, ce_dockoptions, ce_shortcutseditor, ce_mru, ce_processes,
   ce_dubproject, ce_dialogs, ce_dubprojeditor, ce_controls, ce_dfmt,
-  ce_lcldragdrop;
+  ce_lcldragdrop, ce_stringrange;
 
 {$R *.res}
 

src/ce_defines.inc

@@ -1,3 +1,4 @@
 {$MODE OBJFPC}{$H+}
 {$INTERFACES CORBA}
 {$MODESWITCH TYPEHELPERS}
+{$MODESWITCH ADVANCEDRECORDS}

src/ce_messages.pas

@@ -9,7 +9,7 @@ uses
   EditBtn, lcltype, ce_widget, ActnList, Menus, clipbrd, AnchorDocking, math,
   TreeFilterEdit, Buttons, process, GraphType, fgl,
   ce_writableComponent, ce_common, ce_synmemo, ce_dlangutils, ce_interfaces,
-  ce_observer, ce_symstring, ce_processes, ce_sharedres;
+  ce_observer, ce_symstring, ce_processes, ce_sharedres, ce_stringrange;
 
 type
 
@@ -975,8 +975,8 @@ end;
 
 function guessMessageKind(const aMessg: string): TCEAppMessageKind;
 var
-  pos: Integer = 1;
+  idt: string;
-  idt: string = '';
+  rng: TStringRange;
 function checkIdent: TCEAppMessageKind;
 begin
   case idt of
@@ -995,71 +995,35 @@ begin
       exit(amkBub);
   end;
 end;
+const
+  alp = ['a'..'z', 'A'..'Z'];
 begin
   result := amkBub;
-  while(true) do
+  rng.init(aMessg);
+  while true do
   begin
-    if pos > aMessg.length then
+    idt := rng.popUntil(alp)^.takeWhile(alp).yield;
+    if idt = '' then
       exit;
-    if aMessg[pos] in [#0..#32, ',', ':', ';'] then
-    begin
-      Inc(pos);
     result := checkIdent;
     if result <> amkBub then
       exit;
-      idt := '';
-      continue;
-    end;
-    if not (aMessg[pos] in ['a'..'z', 'A'..'Z']) then
-    begin
-      Inc(pos);
-      result := checkIdent;
-      if result <> amkBub then exit;
-      idt := '';
-      continue;
-    end;
-    idt += aMessg[pos];
-    Inc(pos);
   end;
 end;
 
 function getLineFromMessage(const aMessage: string): TPoint;
 var
-  i, j: Integer;
+  rng: TStringRange;
-  ident: string = '';
+  lne: string;
+  col: string = '';
 begin
-  result.x := 0;
+  rng.init(aMessage);
-  result.y := 0;
+  rng.popUntil(['('])^.popWhile(['(']);
-  i := 1;
+  lne := rng.takeUntil([',', ':', ')']).yield;
-  while (true) do
+  if rng.front in [',', ':'] then
-  begin
+    col := rng.popWhile([',', ':'])^.takeUntil([')']).yield;
-    if i > aMessage.length then exit;
+  result.y := strToIntDef(lne, -1);
-    if aMessage[i] = '(' then
+  result.x := strToIntDef(col, -1);
-    begin
-      inc(i);
-      if i > aMessage.length then exit;
-      while( isNumber(aMessage[i]) or (aMessage[i] = ',') or (aMessage[i] = ':')) do
-      begin
-        ident += aMessage[i];
-        inc(i);
-        if i > aMessage.length then exit;
-      end;
-      if aMessage[i] = ')' then
-      begin
-        j := Pos(',', ident);
-        if j = 0 then j := Pos(':', ident);
-        if j = 0 then
-          result.y := strToIntDef(ident, -1)
-        else
-        begin
-          result.y := strToIntDef(ident[1..j-1], -1);
-          result.x := strToIntDef(ident[j+1..ident.length], -1);
-        end;
-        exit;
-      end;
-    end;
-    inc(i);
-  end;
 end;
 
 function openFileFromDmdMessage(const aMessage: string): boolean;

src/ce_stringrange.pas

@@ -0,0 +1,290 @@
+unit ce_stringrange;
+
+{$I ce_defines.inc}
+
+interface
+
+uses
+  SysUtils;
+
+type
+
+  PStringRange = ^TStringRange;
+
+  (**
+   * Iterator specialized for strings.
+   *
+   * This structure allows to easily scan strings.
+   * Most of the operations can be chained because the functions
+   * return either a pointer to a TStringRange (in this case this is always
+   * the "Self") or a new TStringRange (in this case this is always a copy).
+   *
+   * This is based on a more generic work which tries to implement some kind
+   * of "D" ranges in Object Pascal (see https://github.com/BBasile/ArrayOps).
+   * Even if Object Pascal doesn't provide the expressivness required to mimic
+   * D ranges, a few good stuff are still possible.
+   *)
+  TStringRange = record
+  private
+    ptr: PChar;
+    pos: integer;
+    len: integer;
+
+  public
+
+    // returns a new range initialized with a string.
+    class function create(const str: string): TStringRange; static;
+    // returns a new range initialized from a pointer.
+    class function create(const pchr: PChar; length: integer): TStringRange; static;
+
+    // initializes the range with a string.
+    function init(const str: string): PStringRange; inline;
+    // initialized the range from a pointer.
+    function init(const pchr: PChar; length: integer): PStringRange; inline;
+
+    // advances.
+    procedure popFront; inline;
+    // returns the current element.
+    function front: char; inline;
+    // indicates wether the range is consumed.
+    function empty: boolean; inline;
+
+    // yields the state of the range to a string.
+    function yield: string; inline;
+    // returns a copy.
+    function save: TStringRange; inline;
+    // resets the range.
+    function reset: PStringRange; inline;
+
+    // advances the range while the front is in value, returns a copy.
+    function takeWhile(value: TSysCharSet): TStringRange; overload; inline;
+    function takeWhile(value: Char): TStringRange; overload; inline;
+    // advances the range until the front is in value, returns a copy.
+    function takeUntil(value: TSysCharSet): TStringRange; overload; inline;
+    function takeUntil(value: Char): TStringRange; overload; inline;
+    // advances the range while the front is in value.
+    function popWhile(value: TSysCharSet): PStringRange; overload; inline;
+    function popWhile(value: Char): PStringRange; overload; inline;
+    // advances the range until the front is in value.
+    function popUntil(value: TSysCharSet): PStringRange; overload; inline;
+    function popUntil(value: Char): PStringRange; overload; inline;
+
+    // returns the next word.
+    function nextWord: string; inline;
+    // returns the next line.
+    function nextLine: string; inline;
+    // indicates wether the range starts with value.
+    function startsWith(const value: string): boolean; inline;
+    // indicates wether the range starts with value.
+    function startsWith(var value: TStringRange): boolean; inline;
+  end;
+
+implementation
+
+class function TStringRange.create(const str: string): TStringRange;
+begin
+  result.ptr := @str[1];
+  result.pos := 0;
+  result.len := length(str);
+end;
+
+class function TStringRange.create(const pchr: PChar; length: integer): TStringRange;
+begin
+  result.ptr := pchr;
+  result.pos := 0;
+  result.len := length;
+end;
+
+function TStringRange.init(const str: string): PStringRange;
+begin
+  ptr := @str[1];
+  pos := 0;
+  len := length(str);
+  Result := @self;
+end;
+
+function TStringRange.init(const pchr: PChar; length: integer): PStringRange;
+begin
+  ptr := pchr;
+  pos := 0;
+  len := length;
+  Result := @self;
+end;
+
+procedure TStringRange.popFront;
+begin
+  pos += 1;
+end;
+
+function TStringRange.front: char;
+begin
+  result := (ptr + pos)^;
+end;
+
+function TStringRange.empty: boolean;
+begin
+  result := pos >= len;
+end;
+
+function TStringRange.yield: string;
+begin
+  Result := ptr[pos .. len-1];
+end;
+
+function TStringRange.save: TStringRange;
+begin
+  Result.len:= len;
+  Result.pos:= pos;
+  Result.ptr:= ptr;
+end;
+
+function TStringRange.reset: PStringRange;
+begin
+  pos := 0;
+  Result := @Self;
+end;
+
+function TStringRange.takeWhile(value: TSysCharSet): TStringRange;
+begin
+  Result.ptr := ptr + pos;
+  Result.pos := 0;
+  Result.len := 0;
+  while true do
+  begin
+    if empty or not (front in value) then
+      break;
+    Result.len += 1;
+    popFront;
+  end;
+end;
+
+function TStringRange.takeWhile(value: Char): TStringRange;
+begin
+  Result.ptr := ptr + pos;
+  Result.pos := 0;
+  Result.len := 0;
+  while true do
+  begin
+    if empty or not (front = value) then
+      break;
+    Result.len += 1;
+    popFront;
+  end;
+end;
+
+function TStringRange.takeUntil(value: TSysCharSet): TStringRange;
+begin
+  Result.ptr := ptr + pos;
+  Result.pos := 0;
+  Result.len := 0;
+  while true do
+  begin
+    if empty or (front in value) then
+      break;
+    Result.len += 1;
+    popFront;
+  end;
+end;
+
+function TStringRange.takeUntil(value: Char): TStringRange;
+begin
+  Result.ptr := ptr + pos;
+  Result.pos := 0;
+  Result.len := 0;
+  while true do
+  begin
+    if empty or (front = value) then
+      break;
+    Result.len += 1;
+    popFront;
+  end;
+end;
+
+function TStringRange.popWhile(value: TSysCharSet): PStringRange;
+begin
+  while true do
+  begin
+    if empty or not (front in value) then
+      break;
+    popFront;
+  end;
+  Result := @self;
+end;
+
+function TStringRange.popWhile(value: Char): PStringRange;
+begin
+  while true do
+  begin
+    if empty or not (front = value) then
+      break;
+    popFront;
+  end;
+  Result := @self;
+end;
+
+function TStringRange.popUntil(value: TSysCharSet): PStringRange;
+begin
+  while true do
+  begin
+    if empty or (front in value) then
+      break;
+    popFront;
+  end;
+  Result := @self;
+end;
+
+function TStringRange.popUntil(value: Char): PStringRange;
+begin
+  while true do
+  begin
+    if empty or (front = value) then
+      break;
+    popFront;
+  end;
+  Result := @self;
+end;
+
+function TStringRange.nextWord: string;
+const
+  blk = [#0 .. #32];
+begin
+  Result := popWhile(blk)^.takeUntil(blk).yield;
+end;
+
+function TStringRange.nextLine: string;
+const
+  lsp = [#10, #13];
+begin
+  Result := popWhile(lsp)^.takeUntil(lsp).yield;
+end;
+
+function TStringRange.startsWith(const value: string): boolean;
+begin
+  Result := false;
+  if len - pos <= length(value) then
+    Result := ptr[pos .. pos + length(value)] = value;
+end;
+
+function TStringRange.startsWith(var value: TStringRange): boolean;
+var
+  p0, p1: integer;
+begin
+  p0 := pos;
+  p1 := value.pos;
+  Result := true;
+  while not empty and not value.empty do
+  begin
+    if front <> value.front then
+    begin
+      Result := false;
+      break;
+    end;
+    popFront;
+    value.popFront;
+  end;
+  pos := p0;
+  value.pos := p1;
+end;
+
+end.
+