jclparseuses.pas

East make Tray Icon in delphi

        Inc(P);
        SkipCommentsAndBlanks(P);
      end;

      case P^ of
        ',':
          Inc(P);
        ';':
          begin
            System.Insert(Format(', %s', [UnitName]), FText, P - PChar(FText) + 1);
            Result := IndexOf(UnitName);
            Break;
          end;
        else
          raise EUsesListError.Create(SInvalidUses);
      end;
    end;
  end;
end;

//----------------------------------------------------------------------------

function TUsesList.IndexOf(const UnitName: string): Integer;
var
  P, PIdentifier: PChar;
  Identifier: string;
  I: Integer;
begin
  Result := -1;

  if FText = '' then
    Exit;

  P := PChar(FText);
  if not CheckKeyword(P, SUses) then
    raise EUsesListError.Create(SInvalidUses);

  I := -1;
  while P^ <> #0 do
  begin
    SkipCommentsAndBlanks(P);
    PIdentifier := P;
    if not CheckIdentifier(P) then
      raise EUsesListError.Create(SInvalidUses);
    SetString(Identifier, PIdentifier, P - PIdentifier);

    Inc(I);
    if AnsiCompareText(UnitName, Identifier) = 0 then
    begin
      Result := I;
      Exit;
    end;
    SkipCommentsAndBlanks(P);

    if PeekKeyword(P, 'in') then
    begin
      Inc(P, 2);
      SkipCommentsAndBlanks(P);
      if P^ <> '''' then
        raise EUsesListError.Create(SInvalidUses);
      Inc(P);

      while not (P^ in [#0, '''']) do
        Inc(P);
      if P^ <> '''' then
        raise EUsesListError.Create(SInvalidUses);
      Inc(P);
      SkipCommentsAndBlanks(P);
    end;

    case P^ of
      ',':
        Inc(P);
      ';':
        Break;
      else
        raise EUsesListError.Create(SInvalidUses);
    end;
  end;
end;

//----------------------------------------------------------------------------

procedure TUsesList.Insert(Index: Integer; const UnitName: string);
var
  I: Integer;
  P: PChar;
begin
  if (Index < 0) or (Index > Count - 1) then
    raise EUsesListError.CreateFmt(SListIndexError, [Index]);
  I := IndexOf(UnitName);
  if I <> -1 then
    raise EUsesListError.CreateFmt(SDuplicateUnit, [UnitName]);

  if FText = '' then
  begin
    FText := Format('%s'#13#10'  %s;'#13#10#13#10, [SUses, UnitName]);
    try
      if Index <> IndexOf(UnitName) then
        Exit;
    except
      FText := '';
      raise;
    end;
  end
  else
  begin
    P := PChar(FText);
    if not CheckKeyword(P, SUses) then
      raise EUsesListError.Create(SInvalidUses);

    I := -1;
    while P^ <> #0 do
    begin
      SkipCommentsAndBlanks(P);
      Inc(I);
      if I = Index then
      begin
        System.Insert(Format('%s, ', [UnitName]), FText, P - PChar(FText) + 1);
        Exit;
      end;

      if not CheckIdentifier(P) then
        raise EUsesListError.Create(SInvalidUses);
      SkipCommentsAndBlanks(P);

      if PeekKeyword(P, 'in') then
      begin
        Inc(P, 2);
        SkipCommentsAndBlanks(P);
        if P^ <> '''' then
          raise EUsesListError.Create(SInvalidUses);
        Inc(P);

        while not (P^ in [#0, '''']) do
          Inc(P);
        if P^ <> '''' then
          raise EUsesListError.Create(SInvalidUses);
        Inc(P);
        SkipCommentsAndBlanks(P);
      end;

      case P^ of
        ',':
          Inc(P);
        else
          raise EUsesListError.Create(SInvalidUses);
      end;
    end;
  end;
end;

//----------------------------------------------------------------------------

procedure TUsesList.Remove(Index: Integer);
var
  Count, I, DelPos: Integer;
  P, PIdentifier: PChar;
begin
  Count := GetCount;
  if (Index < 0) or (Index > Count - 1) then
    raise EUsesListError.CreateFmt(SListIndexError, [Index]);

  P := PChar(FText);
  if not CheckKeyword(P, SUses) then
    raise EUsesListError.Create(SInvalidUses);

  if (Count = 1) and (Index = 0) then
  begin
    Delete(FText, 1, Length(SUses));
    P := PChar(FText);
  end;

  I := -1;
  while P^ <> #0 do
  begin
    SkipCommentsAndBlanks(P);
    Inc(I);

    if I = Index then
    begin
      // remove unit
      PIdentifier := P;
      if not CheckIdentifier(P) then
        raise EUsesListError.Create(SInvalidUses);
      DelPos := PIdentifier - PChar(FText) + 1;
      Delete(FText, DelPos, P - PIdentifier);
      // skip comments and blanks
      P := PChar(FText) + DelPos - 1;
      PIdentifier := P;
      SkipCommentsAndBlanks(P);
      // check <unitname> in <filename> syntax
      if PeekKeyword(P, 'in') then
      begin
        Inc(P, 2);
        SkipCommentsAndBlanks(P);
        if P^ <> '''' then
          raise EUsesListError.Create(SInvalidUses);
        Inc(P);

        while not (P^ in [#0, '''']) do
          Inc(P);
        if P^ <> '''' then
          raise EUsesListError.Create(SInvalidUses);
        Inc(P);
        SkipCommentsAndBlanks(P);
        DelPos := PIdentifier - PChar(FText) + 1;
        Delete(FText, DelPos, P - PIdentifier);
        P := PChar(FText) + DelPos - 1;
      end;

      // remove separator
      case P^ of
        ',', ';':
          begin
            DelPos := P - PChar(FText) + 1;
            Delete(FText, DelPos, 1);
          end;
        else
          raise EUsesListError.Create(SInvalidUses);
      end;
      // remove trailing spaces, if any
      PIdentifier := PChar(FText) + DelPos - 1;
      P := PIdentifier;
      SkipChars(P, Blanks);
      DelPos := PIdentifier - PChar(FText) + 1;
      Delete(FText, DelPos, P - PIdentifier);
      // skip further comments and blanks
      P := PChar(FText) + DelPos - 1;
      SkipCommentsAndBlanks(P);
      Exit;
    end;
    if not CheckIdentifier(P) then
      raise EUsesListError.Create(SInvalidUses);

    SkipCommentsAndBlanks(P);
    if PeekKeyword(P, 'in') then
    begin
      Inc(P, 2);
      SkipCommentsAndBlanks(P);
      if P^ <> '''' then
        raise EUsesListError.Create(SInvalidUses);
      Inc(P);

      while not (P^ in [#0, '''']) do
        Inc(P);
      if P^ <> '''' then
        raise EUsesListError.Create(SInvalidUses);
      Inc(P);
      SkipCommentsAndBlanks(P);
    end;

    case P^ of
      ',', ';':
        begin
          // make sure semicolon is the last separator in case the last unit is going to be removed
          if (Index = Count - 1) and (I = Index - 1) then
            P^ := ';';
          Inc(P);
        end;
      else
        raise EUsesListError.Create(SInvalidUses);
    end;
  end;
end;

//----------------------------------------------------------------------------
{ TProgramGoal public }
//----------------------------------------------------------------------------

constructor TProgramGoal.Create(Text: PChar);
var
  P, PStart: PChar;
begin
  FTextBeforeUses := '';
  FTextAfterUses := '';

  PStart := Text;
  P := PStart;
  
  // check 'program' label
  SkipCommentsAndBlanks(P);
  if not CheckKeyword(P, SProgram) then
    raise EUsesListError.Create(SInvalidProgram);
  SkipCommentsAndBlanks(P);
  if not CheckIdentifier(P) then
    raise EUsesListError.Create(SInvalidProgram);
  SkipCommentsAndBlanks(P);
  if P^ <> ';' then
    raise EUsesListError.Create(SInvalidProgram);
  Inc(P);
  SkipCommentsAndBlanks(P);

  // remember text before uses
  SetString(FTextBeforeUses, PStart, P - PStart);

  if PeekKeyword(P, SUses) then
  begin
    FUsesList := TUsesList.Create(P);
    PStart := P + Length(FUsesList.Text);
  end
  else // empty uses list
  begin
    FUsesList := TUsesList.Create(nil);
    PStart := P;
  end;
  // remember text after uses
  P := StrEnd(PStart);
  SetString(FTextAfterUses, PStart, P - PStart);
end;

//----------------------------------------------------------------------------

destructor TProgramGoal.Destroy;
begin
  FUsesList.Free;
  inherited Destroy;
end;

//----------------------------------------------------------------------------
{ TLibraryGoal public }
//----------------------------------------------------------------------------

constructor TLibraryGoal.Create(Text: PChar);
var
  P, PStart: PChar;
begin
  FTextBeforeUses := '';
  FTextAfterUses := '';

  PStart := Text;
  P := PStart;

  // check 'library' label
  SkipCommentsAndBlanks(P);
  if not CheckKeyword(P, SLibrary) then
    raise EUsesListError.Create(SInvalidLibrary);
  SkipCommentsAndBlanks(P);
  if not CheckIdentifier(P) then
    raise EUsesListError.Create(SInvalidLibrary);
  SkipCommentsAndBlanks(P);
  if P^ <> ';' then
    raise EUsesListError.Create(SInvalidLibrary);
  Inc(P);
  SkipCommentsAndBlanks(P);

  // remember text before uses
  SetString(FTextBeforeUses, PStart, P - PStart);

  if PeekKeyword(P, SUses) then
  begin
    FUsesList := TUsesList.Create(P);
    PStart := P + Length(FUsesList.Text);
  end
  else // empty uses list
  begin
    FUsesList := TUsesList.Create(nil);
    PStart := P;
  end;
  // remember text after uses
  P := StrEnd(PStart);
  SetString(FTextAfterUses, PStart, P - PStart);
end;

//----------------------------------------------------------------------------

destructor TLibraryGoal.Destroy;
begin
  FUsesList.Free;
  inherited Destroy;
end;

//----------------------------------------------------------------------------
{ TUnitGoal public }
//----------------------------------------------------------------------------

constructor TUnitGoal.Create(Text: PChar);
var
  P, PStart: PChar;
begin
  FTextBeforeIntf := '';
  FTextAfterIntf := '';
  FTextAfterImpl := '';

  PStart := Text;
  P := PStart;

  // check 'unit' label
  SkipCommentsAndBlanks(P);
  if not CheckKeyword(P, SUnit) then
    raise EUsesListError.Create(SInvalidUnit);
  SkipCommentsAndBlanks(P);
  if not CheckIdentifier(P) then
    raise EUsesListError.Create(SInvalidUnit);
  SkipCommentsAndBlanks(P);
  if P^ <> ';' then
    raise EUsesListError.Create(SInvalidUnit);
  Inc(P);
  // check 'interface' label
  SkipCommentsAndBlanks(P);
  if not CheckKeyword(P, 'interface') then
    raise EUsesListError.Create(SInvalidUnit);
  SkipCommentsAndBlanks(P);

  // remember text before interface uses
  SetString(FTextBeforeIntf, PStart, P - PStart);
  if PeekKeyword(P, SUses) then
  begin
    FUsesIntf := TUsesList.Create(P);
    PStart := P + Length(FUsesIntf.Text);
  end
  else
  begin
    FUsesIntf := TUsesList.Create(nil);
    PStart := P;
  end;
  // locate implementation
  while (P^ <> #0) and not PeekKeyword(P, 'implementation') do
  begin
    SkipChars(P, [#1..#255] - Blanks);
    SkipCommentsAndBlanks(P);
  end;
  if not CheckKeyword(P, 'implementation') then
    raise EUsesListError.Create(SInvalidUnit);
  SkipCommentsAndBlanks(P);

  // remember text after interface uses
  SetString(FTextAfterIntf, PStart, P - PStart);
  if PeekKeyword(P, SUses) then
  begin
    FUsesImpl := TUsesList.Create(P);
    PStart := P + Length(FUsesImpl.Text);
  end
  else
  begin
    FUsesImpl := TUsesList.Create(nil);
    PStart := P;
  end;
  // remember text after implementation uses
  P := StrEnd(PStart);
  SetString(FTextAfterImpl, PStart, P - PStart);
end;

//----------------------------------------------------------------------------

destructor TUnitGoal.Destroy;
begin
  FUsesIntf.Free;
  FUsesImpl.Free;
  inherited Destroy;
end;

end.