diff --git a/lazproj/coedit.lpi b/lazproj/coedit.lpi
index 3f593c4c..6dee4eaf 100644
--- a/lazproj/coedit.lpi
+++ b/lazproj/coedit.lpi
@@ -137,7 +137,7 @@
-
+
@@ -380,6 +380,10 @@
+
+
+
+
diff --git a/lazproj/coedit.lpr b/lazproj/coedit.lpr
index d8940306..3e79e1e3 100644
--- a/lazproj/coedit.lpr
+++ b/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}
diff --git a/src/ce_defines.inc b/src/ce_defines.inc
index 2aed2614..a8ddbf59 100644
--- a/src/ce_defines.inc
+++ b/src/ce_defines.inc
@@ -1,3 +1,4 @@
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}
{$MODESWITCH TYPEHELPERS}
+{$MODESWITCH ADVANCEDRECORDS}
diff --git a/src/ce_messages.pas b/src/ce_messages.pas
index f4ff4b44..c8042993 100644
--- a/src/ce_messages.pas
+++ b/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;
+ result := checkIdent;
+ if result <> amkBub 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;
- ident: string = '';
+ rng: TStringRange;
+ lne: string;
+ col: string = '';
begin
- result.x := 0;
- result.y := 0;
- i := 1;
- while (true) do
- begin
- if i > aMessage.length then exit;
- if aMessage[i] = '(' then
- 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;
+ rng.init(aMessage);
+ rng.popUntil(['('])^.popWhile(['(']);
+ lne := rng.takeUntil([',', ':', ')']).yield;
+ if rng.front in [',', ':'] then
+ col := rng.popWhile([',', ':'])^.takeUntil([')']).yield;
+ result.y := strToIntDef(lne, -1);
+ result.x := strToIntDef(col, -1);
end;
function openFileFromDmdMessage(const aMessage: string): boolean;
diff --git a/src/ce_stringrange.pas b/src/ce_stringrange.pas
new file mode 100644
index 00000000..6c3ca0a8
--- /dev/null
+++ b/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.
+