Программа форматирования Паскаль-программ, Помогите пожалуйста... Опции

[Галина М.]

Пришла сессия.... А я за семестр Паскаль в глаза не видела.... Препод сказал если решу 1 задачу, то поставит мне зачет.
Если кто-то может, помогите.
Такая задача:

Программа предназначена для форматирования текста Паскаль-программ.
Требования к программе:
- в одной строке должен быть один оператор или описание переменных одного типа;
- ключевые слова REPEAT, BEGIN, END, THEN, ELSE должны быть размещены по одному в строке;
- ключевые слова IF, WHILE, UNTIL, CASE, FOR, WITH должны быть размещены по одному в строке с условиями;
- для групп связаных операторов и описаний должны быть сделаны отступы от начала строки;
- ключевые слова, что составляют пару должны начинаться с одной позиции, величина отступа должна задаваться оператором.

Вот и все условие. Буду очень благодарна, всем кто поможет.

[volvo]

Галина М.
Проверьте вот этот код... Я думаю, это должно подойти... Если где-то не работает, пишите, исправим...

const
  s_name = 'TEST.PAS';
  d_name = 'AFTER.PAS';
var
  fin, fout: text;
  part_before, s: string;
  autoTab: integer;

const
  ToTab = 2;

  lookCount = 9;
  looking: array[1 .. lookCount] of string =
    ('var', 'const', 'do', 'repeat', 'begin', 'then', 'else', 'of', ';');

  oneStrCount = 4;
  oneStr: array[1 .. oneStrCount] of string =
    ('for', 'while', 'then', 'else');

  tabCount = 4;
  dec_tab: array[1 .. tabCount] of string =
    ('var', 'const', 'end', 'until');

  tabulator: array[1 .. lookCount] of integer =
    (2, 2, 2, 2, 2, 2, 2, 2, 0);

function UpString(s: String): String;
  var i: byte;
  begin
    for i := 1 to length(s) do
      s[i] := UpCase(s[i]);
    UpString := s
  end;
function noLeadSpace(s: string): string;
  begin
    while (s <> '') and (s[1] = ' ') do
      delete(s, 1, 1);
    noLeadSpace := s
  end;

function getString(var s: string;
         var found: integer): string;
  var
    up_str: string;
    i, p: integer;
  begin
    for i := 1 to lookCount do
      begin
        up_str := UpString(s);
        p := pos(UpString(looking[i]), up_str);
        if p > 0 then
          begin
            {inc(autoTab, tabulator[i]);}
            getString := Copy(s, 1, p+length(looking[i])-1);
            delete(s, 1, p+length(looking[i])-1);
            found := i mod LookCount; exit
          end;
      end;
    getString := s; s := ''; found := 0
  end;

var
  i, was_detected: integer;
  oneStringCounter: integer;

begin
  assign(fin, s_name);
  {$i-} reset(fin); {$i+}
  if ioresult <> 0 then
    begin
      writeln( 'cannot open source file ', s_name );
      halt(100);
    end;

  assign(fout, d_name);
  {$i-} rewrite(fout); {$i+}
  if ioresult <> 0 then
    begin
      writeln( 'cannot create destination file ', d_name );
      halt(101)
    end;

  autoTab := 0;
  oneStringCounter := -1;
  while not seekeof(fin) do
    begin
      readln(fin, s);
      while s <> '' do
        begin
          part_before := noLeadSpace( getString(s, was_detected) );

          for i := 1 to oneStrCount do
            if pos(UpString(oneStr[i]), UpString(part_before)) > 0 then
              begin
                oneStringCounter := 1; break
              end;

          for i := 1 to tabCount do
            if pos(UpString(dec_tab[i]), UpString(part_before)) > 0 then
              begin
                if autoTab >= ToTab then dec(autoTab, ToTab);
                break;
              end;
          for i := 1 to autoTab do
            part_before := ' ' + part_before;

          writeln(fout, part_before);
          if oneStringCounter = 0 then
            begin
              dec(autoTab, ToTab);
            end;
          if oneStringCounter <> -1 then dec(oneStringCounter);

          if was_detected > 0 then
            inc(autoTab, tabulator[was_detected]);
        end;
    end;

  close(fout);
  close(fin);
end.

P.S. Попробуйте протестировать на каком-нибудь простом примере (что-то типа):

for i:=1 to 10 do x := x+1;

function FromDec(n, radix:longint):string;
var s: String;
const digit: string[16]='0123456789ABCDEF';
begin
s:='';
repeat
s:=digit[(n mod radix)+1]+s;
n:=n div radix;
until n=0;
FromDec:=s;
end;