path: root/mystringlistunit.pas

unit mystringlistunit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, RegExpr, Process, protokollunit, matheunit;

type
  tMyStringList = class (tStringList)
  private
    line:          longint;
    prot:          tProtokollant;
    srNoGo,srBuff: tMyStringList; // Liste der in SubRoutinen verbotenen Zeilenanfänge, sowie der aufgeschobenen Zeilen
    procedure gibAus(s: string; ausgaben: byte);
  public
    constructor create; overload;
    constructor create(protokollant: tProtokollant; name: string); overload;
    destructor destroy; override;
    procedure loadFromFile(const s: ansiString); override;
    procedure loadFromGz(const s: ansiString);
    procedure loadFromPipe(s: ansiString);
    procedure loadFromResource(const s: ansiString);
    procedure saveToGz(const s: ansiString);
    function readln(out s: string): boolean; inline;
    function metaReadln(out s: string; subRoutine: boolean): boolean; inline;
    procedure grep(expr: string; invert: boolean = false);
    function grepFirst(expr: string; invert: boolean = false): string;
    procedure replace(von,nach: string);
    procedure uniq(c: char);
    procedure append(sl: tMyStringList); overload;
    function hatZeile(zeile: string; regex: boolean = true): boolean; // invers zu "grep -c"
    function eof: boolean;
    procedure rewind;
    procedure stepBack;
    function stillNeed(bez: string): boolean;
    function needInLine(bez: string; lin: longint): boolean;
    procedure insert(index: longint; const s: ansiString); override;
    function unfoldMacros(kvs: tKnownValues = nil; cbgv: tCallBackGetValue = nil): boolean;
    procedure subst(regex,ersatz: string);
    procedure splitLines(before,after: string);
    procedure dump(pro: tProtokollant; prefix: string);
    procedure nichtInSubRoutine(s: string);
    procedure addWithLineBreaks(s: string);
    function last: string;
    procedure appendTo(wen: tStringList; maxLen: int64; praeludium,fuge,coda: string);
  end;

procedure _del(var s: string; p,c: longint); inline;  // identisch zu delete(s,p,c) -- lediglich um delete innerhalb von tMyStringList verfügbar zu haben
procedure _mov(const source;var dest;count:sizeInt);  // identisch zu move(source,dest,count) -- lediglich um move innerhalb von tMyStringList verfügbar zu haben
function numerischerVergleich(list: tStringList; index1,index2: integer): integer;
function istDasBefehl(befehl: string; var s: string; var bekannteBefehle: tMyStringList; hatParameter: boolean): boolean;

implementation

uses Math, lowlevelunit, systemunit, fileUnit;

// tMyStringList ***************************************************************

constructor tMyStringList.create;
begin
  create(nil,'');
end;

constructor tMyStringList.create(protokollant: tProtokollant; name: string);
begin
  inherited create;
  if assigned(protokollant) then
    prot:=tProtokollant.create(protokollant,name)
  else
    prot:=nil;
  srNoGo:=nil;
  srBuff:=nil;
  line:=0;
end;

destructor tMyStringList.destroy;
begin
  srNoGo.free;
  srBuff.free;
  inherited destroy;
end;

procedure tMyStringList.gibAus(s: string; ausgaben: byte);
begin
  if assigned(prot) then
    prot.schreibe(s,odd(ausgaben shr 1))
  else
    lowlevelunit.gibAus(s,ausgaben);
end;

procedure tMyStringList.loadFromFile(const s: ansiString);
var
  i: longint;
begin
  inherited loadFromFile(s);
  for i:=0 to count-1 do
    self[i]:=trim(self[i]);
  line:=0;
  gibAus(intToStr(count)+' Zeilen eingelesen',1);
end;

procedure tMyStringList.loadFromGz(const s: ansiString);
var
  len: longint;
  pt:  pointer;
  buf: ansiString;
begin
  fileunit.loadFromGz(s,pt,len);
  setLength(buf,len);
  _mov(pt^,buf[1],len);
  text:=buf;
  setLength(buf,0);
  for len:=0 to count-1 do
    self[len]:=trim(self[len]);
  line:=0;
  gibAus(intToStr(count)+' Zeilen eingelesen',1);
end;

procedure tMyStringList.loadFromPipe(s: ansiString);
var
  len: longint;
  pt:  pointer;
  buf: ansiString;
  pr:  tProcess;
begin
  while max(pos(#13,s),pos(#10,s))>0 do
    s[max(pos(#13,s),pos(#10,s))]:=' ';
  pr:=tProcess.create(nil);
  pr.executable:=erstesArgument(s);
  while s<>'' do
    pr.parameters.add(erstesArgument(s));
  fileunit.loadFromProcess(pr,pt,len);
  setLength(buf,len);
  _mov(pt^,buf[1],len);
  text:=buf;
  setLength(buf,0);
  for len:=0 to count-1 do
    self[len]:=trim(self[len]);
  line:=0;
  gibAus(intToStr(count)+' Zeilen eingelesen',1);
end;

procedure tMyStringList.loadFromResource(const s: ansiString);
var
  st:  tResourceStream;
  buf: ansiString;
  i:   longint;
begin
  st:=tResourceStream.create(hInstance,s,RT_RCDATA);
  setLength(buf,st.size);
  st.readBuffer(buf[1],length(buf));
  st.free;
  text:=buf;
  for i:=0 to count-1 do
    self[i]:=trim(self[i]);
end;

procedure tMyStringList.saveToGz(const s: ansiString);
begin
  fileunit.saveToGz(s,@(text[1]),length(text));
end;

function tMyStringList.readln(out s: string): boolean;
begin
  result:=not eof;
  if not result then begin
    s:='';
    exit;
  end;
  s:=self[line];
  inc(line);
end;

function tMyStringList.metaReadln(out s: string; subRoutine: boolean): boolean;
begin
  if assigned(srNoGo) then begin
    if subRoutine then begin
      repeat
        result:=readln(s);
        if not srNoGo.hatZeile(s) then exit;
        srBuff.add(s);
      until false;
    end
    else if srBuff.count>0 then begin
      result:=true;
      s:=srBuff[0];
      srBuff.delete(0);
      exit;
    end;
  end;
  result:=readln(s);
end;

procedure tMyStringList.grep(expr: string; invert: boolean);
var
  tl: tMyStringList;
  re: tRegExpr;
  i:  longint;
begin
  re:=tRegExpr.create;
  re.expression:=expr;
  re.compile;

  tl:=tMyStringList.create;

  for i:=0 to count-1 do
    if invert xor re.exec(self[i]) then
      tl.add(self[i]);
  re.free;

  clear;
  for i:=0 to tl.count-1 do
    add(tl[i]);
  tl.free;
end;

function tMyStringList.grepFirst(expr: string; invert: boolean = false): string;
var
  re: tRegExpr;
  i:  longint;
begin
  re:=tRegExpr.create;
  re.expression:=expr;
  for i:=count-1 downto 0 do
    if invert xor re.exec(self[i]) then begin
      result:=self[i];
      re.free;
      exit;
    end;
  re.free;
  result:='';
end;

procedure tMyStringList.replace(von,nach: string);
var
  tl: tMyStringList;
  re: tRegExpr;
  i:  longint;
begin
  tl:=tMyStringList.create;
  re:=tRegExpr.create;
  re.expression:=von;
  re.compile;
  for i:=0 to count-1 do
    tl.add(re.replace(self[i],nach,true));

  clear;
  for i:=0 to tl.count-1 do
    add(tl[i]);
  tl.free;
end;

procedure tMyStringList.uniq(c: char);
var
  i:   longint;
  tl:  tMyStringList;
  dup: boolean;
begin
  tl:=tMyStringList.create;
  case c of
    '-': begin // only keep one line for each group
      i:=0;
      while i<count do begin
        while (i<count-1) and (self[i]=self[i+1]) do
          inc(i);
        tl.add(self[i]);
        inc(i);
      end;
    end;
    'd': begin // only keep duplicate lines, one for each group
      i:=0;
      while i<count do begin
        dup:=false;
        while (i<count-1) and (self[i]=self[i+1]) do begin
          dup:=true;
          inc(i);
        end;
        if dup then
          tl.add(self[i]);
        inc(i);
      end;
    end;
    else fehler('Unbekannte Option '''+c+''' für tMyStringList.uniq!');
  end{of case};

  clear;
  for i:=0 to tl.count-1 do
    add(tl[i]);

  tl.free;
end;

procedure tMyStringList.append(sl: tMyStringList);
var
  i: longint;
begin
  for i:=0 to sl.count-1 do
    add(sl[i]);
end;

function tMyStringList.hatZeile(zeile: string; regex: boolean = true): boolean;
var
  re: tRegExpr;
  i:  longint;
begin
  result:=true;
  if regex then begin
    re:=tRegExpr.create;
    for i:=0 to count-1 do begin
      re.expression:=self[i];
      if re.exec(zeile) then begin
        re.free;
        exit;
      end;
    end;
    re.free;
  end
  else
    for i:=0 to count-1 do
      if self[i]=zeile then
        exit;
  result:=false;
end;

function tMyStringList.eof: boolean;
begin
  result:=line>=count;
end;

procedure tMyStringList.rewind;
begin
  line:=0;
end;

procedure tMyStringList.stepBack;
begin
  dec(line);
  if line<0 then line:=0;
end;

function tMyStringList.stillNeed(bez: string): boolean;
var
  i:   longint;
begin
  result:=true;
  for i:=max(0,line-1) to count-1 do
    if needInLine(bez,i) then
      exit;
  result:=false;
end;

function tMyStringList.needInLine(bez: string; lin: longint): boolean;
var
  s,t: string;
begin
  result:=true;
  s:=' '+self[lin]+' ';
  while pos(bez,s)>0 do begin
    t:=copy(s,1,pos(bez,s)+length(bez));
    _del(s,1,pos(bez,s)+length(bez)-1);
    _del(t,1,length(t)-length(bez)-2);
    if (t[1] in [' ',#9,':','[']) and (t[length(t)] in [' ',#9,':',']']) and (copy(t,2,length(bez))=bez) then
      exit;
  end;
  result:=false;
end;

procedure tMyStringList.insert(index: longint; const s: ansiString);
begin
  inherited insert(index,s);
  if index<=line then inc(line);
end;

function tMyStringList.unfoldMacros(kvs: tKnownValues; cbgv: tCallBackGetValue): boolean;
var
  i,j,k,l,ebene:   longint;
  s,t,u,v:         string;
  schleifenInhalt: tMyStringList;
  wasGefunden:     boolean;
const
  kommentarKlammern: array[0..2,boolean] of string = (
    ('(*','*)'),
    ('/*','*/'),
    ('{','}')
  );
begin
  result:=false;

  i:=0;
  while i<count do begin  // Kommentare löschen
    s:=self[i];
    s:=erstesArgument(s,'#');
    if length(s)=0 then begin
      delete(i);
      continue;
    end;
    self[i]:=s;
    inc(i);
  end;

  i:=0;
  while i<count do begin  // mehrzeilige Kommentare löschen
    for j:=0 to length(kommentarKlammern)-1 do
      if self[i]=kommentarKlammern[j,false] then begin
        ebene:=0;
        delete(i);
        while (i<count) and (ebene>=0) do begin
          if self[i]=kommentarKlammern[j,false] then
            inc(ebene);
          if self[i]=kommentarKlammern[j,true] then
            dec(ebene);
          delete(i);
        end;
        if ebene>=0 then begin
          gibAus('Klammern '''+kommentarKlammern[j,false]+'''-'''+kommentarKlammern[j,true]+''' nicht ausgeglichen!',3);
          exit;
        end;
        dec(i);
        break;
      end;
    inc(i);
  end;

  i:=0;
  while i<count-1 do // "\Zeilenumbruch" löschen
    if rightStr(self[i],1)='\' then begin
      s:=self[i];
      self[i]:=trim(leftStr(s,length(s)-1))+' '+self[i+1];
      delete(i+1);
    end
    else inc(i);

  repeat
    wasGefunden:=false;

    for i:=0 to count-1 do begin   // Gleichungen auswerten
      s:=formelnAuswerten(self[i],kvs,cbgv);
      if s<>self[i] then begin
        wasGefunden:=true;
        self[i]:=s;
      end;
    end;
    if wasGefunden then continue;

    i:=0;
    while i<count do begin  // Übersprünge überspringen, alles nach 'Dateiende' löschen
      s:=self[i];
      if startetMit('!überspringe:',s) then begin
        for j:=0 to strToInt(s) do
          delete(i);
        continue;
      end;

      if s='Dateiende' then begin
        inc(i);
        while i<count do
          delete(i);
        continue;
      end;
      inc(i);
    end;

    for i:=0 to count-1 do begin   // Shellvariablen auswerten
      s:=shellExpand(self[i]);
      if s<>self[i] then begin
        wasGefunden:=true;
        self[i]:=s;
      end;
    end;

    i:=count-1;
    while i>=0 do begin   // Substitutionen auswerten
      s:=self[i];
      if startetMit('!setze',s) then begin
        wasGefunden:=true;
        t:=erstesArgument(s,':');
        if pos('$',t)<>1 then begin
          gibAus('ungültiger Variablenname '''+t+''' für Ersetzung!',3);
          exit;
        end;
        delete(i);
        for j:=i to count-1 do begin
          u:=self[j];
          k:=length(u);
          while (pos(t,u)>0) and (k>0) do begin       // ... nach Ersetzung ...
            u:=copy(u,1,pos(t,u)-1)+s+copy(u,pos(t,u)+length(t),length(u));
            dec(k);
          end;
          self[j]:=u;
        end;
      end
      else
        dec(i);
    end;
    if wasGefunden then continue;

    for i:=0 to count-1 do begin   // Shellvariablen auswerten
      s:=shellSubst(self[i]);
      if s<>self[i] then begin
        wasGefunden:=true;
        self[i]:=s;
      end;
    end;

    i:=0;
    while i<count do begin  // Schleifen ausrollen
      s:=self[i];
      if startetMit('!Schleife:',s) then begin
        wasGefunden:=true;
        l:=i;
        delete(i);
        t:=erstesArgument(s,':');
        if (length(t)=0) or (t[1]<>'$') then begin
          gibAus('Schleifenvariable muss mit ''$'' beginnen ,'''+t+''' tut das nicht!',3);
          exit;
        end;

        schleifenInhalt:=tMyStringList.create(nil,''); // Schleifenkörper merken
        ebene:=0;
        while (i<count) and ((ebene<>0) or (self[i]<>'!Schleifenende')) do begin
          schleifenInhalt.add(self[i]);
          if self[i]='!Schleifenende' then dec(ebene);
          if pos('!Schleife:',self[i])=1 then inc(ebene);
          delete(i);
        end;
        if i>=count then begin
          gibAus('Ich kann kein zugehöriges Schleifenende zu Schleife über Variable '''+t+''' finden!',3);
          gibAus(' ich habe hier noch:',3);
          for i:=0 to schleifenInhalt.count-1 do
            gibAus(schleifenInhalt[i],3);
          exit;
        end;

        delete(i);

        u:=s;
        s:='';
        while length(u)>0 do begin
          v:=erstesArgument(u);
          if pos('..',v)<>0 then v:=intervallAusrollen(v);
          s:=s+' '+v;
        end;
        s:=trim(s);

        while length(s)>0 do begin  // Schleifenzähler laufen lassen
          u:=unEscape(erstesArgument(s));
          for j:=0 to schleifenInhalt.count-1 do begin  // Schleifenkörper ...
            v:=schleifenInhalt[j];
            k:=length(v);
            while (pos(t,v)>0) and (k>0) do begin       // ... nach Ersetzung ...
              v:=copy(v,1,pos(t,v)-1)+u+copy(v,pos(t,v)+length(t),length(v));
              dec(k);
            end;
            insert(i,v);                                // ... kopieren
            inc(i);
          end;
        end;

        schleifenInhalt.free;
        i:=l;
        continue;
      end;
      self[i]:=s;
      inc(i);
    end;
    if wasGefunden then continue;

    i:=0;
    while i<count do begin   // Bedingungen auswerten
      s:=self[i];
      if startetMit('?',s) then begin
        wasGefunden:=true;
        if exprToBool(false,erstesArgument(s,':'),kvs,cbgv) then
          self[i]:=s
        else
          delete(i);
      end
      else
        inc(i);
    end;

  until not wasGefunden;

  result:=true;
end;

procedure tMyStringList.subst(regex,ersatz: string);
var
  i,cnt: longint;
  re:    tRegExpr;
begin
  re:=tRegExpr.create;
  re.expression:='^(.*)('+regex+')(.*)$';
  cnt:=3;
  for i:=1 to length(regex) do
    if (regex[i]='(') and
       ((i=1) or (regex[i-1]<>'\')) then
      inc(cnt);
  for i:=0 to count-1 do begin
    re.exec(self[i]);
    self[i]:=re.substitute('$1'+ersatz+'$'+intToStr(cnt));
  end;
  re.free;
end;

procedure tMyStringList.splitLines(before,after: string);
var
  i: longint;
begin
  i:=0;
  while i<count do begin
    while (before<>'') and (pos(before,rightStr(self[i],length(self[i])-1))>1) do begin
      insert(i,leftStr(self[i],1+pos(before,rightStr(self[i],length(self[i])-1))-1));
      inc(i);
      self[i]:=rightStr(self[i],length(self[i])-length(self[i-1]));
    end;
    inc(i);
  end;
  i:=0;
  while i<count do begin
    while (after<>'') and (pos(after,leftStr(self[i],length(self[i])-1))>1) do begin
      insert(i,leftStr(self[i],pos(after,leftStr(self[i],length(self[i])-1))-1+length(after)));
      inc(i);
      self[i]:=rightStr(self[i],length(self[i])-length(self[i-1]));
    end;
    inc(i);
  end;
end;

procedure tMyStringList.dump(pro: tProtokollant; prefix: string);
var
  i: longint;
begin
  for i:=0 to count-1 do
    pro.schreibe(prefix+self[i]);
end;

procedure tMyStringList.nichtInSubRoutine(s: string);
begin
  if not assigned(srNoGo) then begin
    srNoGo:=tMyStringList.create;
    srBuff:=tMyStringList.create;
  end;
  srNoGo.add(s);
end;

procedure tMyStringList.addWithLineBreaks(s: string);
begin
  while s<>'' do
    add(erstesArgument(s,#13,false));
end;

function tMyStringList.last: string;
begin
  result:=self[count-1];
end;

procedure tMyStringList.appendTo(wen: tStringList; maxLen: int64; praeludium,fuge,coda: string);
var
  habIchSchon,bisherLaenge,i,j: longint;
  s:                            string;
begin
  if count=0 then
    exit;
  habIchSchon:=-1;
  bisherLaenge:=length(praeludium)+length(coda);
  s:=praeludium;
  for i:=0 to count do begin
    if (i=count) or (bisherLaenge+length(self[i])+byte(i>habIchSchon+1)*length(fuge) > maxLen) then begin
      wen.append(s+coda);
      habIchSchon:=i;
      bisherLaenge:=length(praeludium)+length(coda);
      s:=praeludium;
    end;
    if i<count then begin
      bisherLaenge:=bisherLaenge+length(self[i]);
      s:=s+self[i];
      if i>habIchSchon+1 then begin
        s:=s+fuge;
        bisherLaenge:=bisherLaenge+length(fuge);
      end;
    end;
  end;
end;

// allgemeine Funktionen *******************************************************

procedure _del(var s: string; p,c: longint);
begin
  delete(s,p,c);
end;

procedure _mov(const source;var dest;count:sizeInt);
begin
  move(source,dest,count);
end;

function numerischerVergleich(list: tStringList; index1,index2: integer): integer;
var
  neg: boolean;
  i:   longint;
begin
  if (leftStr(list[index1],1)='-') xor (leftStr(list[index2],1)='-') then begin
    result:=2*byte(leftStr(list[index2],1)='-')-1;
    exit;
  end;
  neg:=leftStr(list[index1],1)='-';
  result:=length(list[index1])-length(list[index2]);
  if result=0 then begin
    for i:=1 to length(list[index1]) do begin
      if list[index1][i]<list[index2][i] then begin
        result:=-1;
        break;
      end;
      if list[index1][i]>list[index2][i] then begin
        result:=1;
        break;
      end;
    end;
  end;
  result:=result*(1-2*byte(neg));
end;

function istDasBefehl(befehl: string; var s: string; var bekannteBefehle: tMyStringList; hatParameter: boolean): boolean;
begin
  if hatParameter then begin
    bekannteBefehle.add(''''+befehl+' ...''');
    result:=startetMit(befehl+' ',s);
  end
  else begin
    bekannteBefehle.add(''''+befehl+'''');
    result:=s=befehl;
  end;
end;

end.