unit udscanner_fuentespascal;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, math, udirectoryscanner;

type

  { TDirectoryScanner_fuentespascal }

  TDirectoryScanner_fuentespascal = class(TDirectoryScanner)
    fsal: textfile;
    constructor Create(var xfsal: textfile);
    procedure scan(const carpeta_raiz: string); override;
    procedure procesar_archivo(const carpeta, nombre_archivo: string); override;
  end;


implementation

{ TDirectoryScanner_fuentespascal }

constructor TDirectoryScanner_fuentespascal.Create(var xfsal: textfile);
begin
  inherited Create;
  fsal := xfsal;
  add_ignore_carpeta('backup');
end;

procedure TDirectoryScanner_fuentespascal.scan(const carpeta_raiz: string);
begin
  procesar_carpeta(carpeta_raiz, '*.lpr');
  procesar_carpeta(carpeta_raiz, '*.dpr');
  procesar_carpeta(carpeta_raiz, '*.pp');
  procesar_carpeta(carpeta_raiz, '*.pas');
end;

function getlinea(var f: textfile; pal_inis, pal_term: array of string;
  terminador: char): string;
var
  res, r, rc: string;
  comentario_abierto: string;
  buscando_inicio: boolean;
  buscando_fin: boolean;
  ipos, ipos2, k: integer;
  iterm: integer;

begin
  comentario_abierto := '';
  buscando_inicio := True;
  buscando_fin := True;
  res := '';
  iterm := 0;

  while buscando_fin and (iterm = 0) and not EOF(f) do
  begin
    readln(f, rc);
    r := LowerCase(rc);
    ipos := pos('//', r);
    if ipos > 0 then
    begin
      Delete(r, ipos, length(r) - ipos + 1);
      Delete(rc, ipos, length(rc) - ipos + 1);
    end;

    if comentario_abierto <> '' then
    begin
      ipos := pos(comentario_abierto, r);
      if ipos > 0 then
      begin
        Delete(r, 1, ipos);
        Delete(rc, 1, ipos);
      end;
      comentario_abierto := '';
    end;

    if comentario_abierto = '' then
    begin
      ipos := pos('{', r);
      if ipos > 0 then
      begin
        ipos2 := pos('}', r);
        if ipos2 = 0 then
        begin
          comentario_abierto := '}';
          Delete(r, ipos, length(r) - ipos + 1);
          Delete(rc, ipos, length(rc) - ipos + 1);
        end
        else
        begin
          Delete(r, ipos, ipos2 - ipos + 1);
          Delete(rc, ipos, ipos2 - ipos + 1);
        end;
      end;

      ipos := pos('(*', r);
      if ipos > 0 then
      begin
        ipos2 := pos('*)', r);
        if ipos2 = 0 then
        begin
          comentario_abierto := '*)';
          Delete(r, ipos, length(r) - ipos + 1);
          Delete(rc, ipos, length(rc) - ipos + 1);
        end
        else
        begin
          Delete(r, ipos, ipos2 - ipos + 2);
          Delete(rc, ipos, ipos2 - ipos + 2);
        end;
      end;

      if (r <> '') then
      begin
        for k := 0 to high(pal_term) do
        begin
          ipos := pos(pal_term[k], r);
          if iterm > 0 then
            iterm := min(iterm, ipos)
          else
            iterm := ipos;
        end;
        if iterm > 0 then
        begin
          Delete(r, iterm, length(r) - iterm + 1);
          Delete(rc, iterm, length(rc) - iterm + 1);
        end;
      end;

      r := trim(r);
      rc := trim(rc);
      if (r <> '') and buscando_inicio then
      begin
        ipos := 0;
        k := 0;
        while (ipos = 0) and (k <= high(pal_inis)) do
        begin
          ipos := pos(pal_inis[k], r);
          if ipos = 0 then
            Inc(k);
        end;
        if ipos > 0 then
        begin
          res := copy(rc, 1, ipos + length(pal_inis[k]) - 1);
          Delete(r, 1, ipos + length(pal_inis[k]) - 1);
          Delete(rc, 1, ipos + length(pal_inis[k]) - 1);
          r := trim(r);
          rc := trim(rc);
          buscando_inicio := False;
        end;
      end;

      if (r <> '') and not buscando_inicio then
      begin
        ipos := pos(terminador, r);
        if ipos = 0 then
        begin
          res := trim(res + ' ' + rc);
        end
        else
        begin
          Delete(r, ipos, length(r) - ipos + 1);
          Delete(rc, ipos, length(rc) - ipos + 1);
          res := trim(res + ' ' + rc + terminador);
          buscando_fin := False;
        end;
      end;
    end;
  end;
  if not buscando_fin then
    Result := res
  else
    Result := '';
end;


procedure TDirectoryScanner_fuentespascal.procesar_archivo(
  const carpeta, nombre_archivo: string);
var
  f: textfile;
  r: string;
  sarchi: string;
begin
  sarchi := self.archi(carpeta, nombre_archivo);
  filemode := 0;
  assignfile(f, sarchi);
  reset(f);

  writeln(fsal, '**** archivo: ', sarchi);
  r := getlinea(f, ['program', 'unit'], ['implementation', 'begin'], ';');
  if r <> '' then
  begin
    while r <> '' do
    begin
      writeln(fsal, r);
      r := getlinea(f, ['class ', 'class('], ['implementation', 'begin'], ')');
    end;
  end
  else
    writeln(fsal, 'ojo no encontré ni "program" ni "unit"');

  writeln(fsal);
  closefile(f);
end;


end.

