mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 05:39:29 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			296 lines
		
	
	
		
			6.9 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			296 lines
		
	
	
		
			6.9 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
{
 | 
						|
 | 
						|
    FPDoc  -  Free Pascal Documentation Tool
 | 
						|
    Copyright (C) 2000 - 2003 by
 | 
						|
      Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org
 | 
						|
 | 
						|
    See the file COPYING, included in this distribution,
 | 
						|
    for details about the copyright.
 | 
						|
 | 
						|
    This program is distributed in the hope that it will be useful,
 | 
						|
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
						|
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
program FPDoc;
 | 
						|
 | 
						|
uses
 | 
						|
  SysUtils, Classes, Gettext, DOM, XMLWrite, PasTree, PParser,
 | 
						|
  dGlobals,  // GLobal definitions, constants.
 | 
						|
  dwriter,   // TFPDocWriter definition.
 | 
						|
  dwlinear,  // Linear (abstract) writer
 | 
						|
  dw_LaTeX,  // TLaTex writer
 | 
						|
  dw_XML,    // XML writer
 | 
						|
  dw_HTML,   // HTML writer
 | 
						|
  dw_ipf,    // IPF writer
 | 
						|
  dw_man,    // Man page writer
 | 
						|
  dw_linrtf, // lineair RTF writer
 | 
						|
  dw_txt;    // TXT writer
 | 
						|
 | 
						|
const
 | 
						|
  OSTarget: String = {$I %FPCTARGETOS%};
 | 
						|
  CPUTarget: String = {$I %FPCTARGETCPU%};
 | 
						|
  FPCVersion: String = {$I %FPCVERSION%};
 | 
						|
  FPCDate: String = {$I %FPCDATE%};
 | 
						|
 | 
						|
var
 | 
						|
  Backend : String;
 | 
						|
  BackendOptions : TStrings;
 | 
						|
  InputFiles, DescrFiles: TStringList;
 | 
						|
  PackageName, DocLang, ContentFile : String;
 | 
						|
  Engine: TFPDocEngine;
 | 
						|
  StopOnParserError : Boolean;
 | 
						|
 | 
						|
Procedure Usage(AnExitCode : Byte);
 | 
						|
 | 
						|
Var
 | 
						|
  I,P : Integer;
 | 
						|
  S : String;
 | 
						|
  L : TStringList;
 | 
						|
  C : TFPDocWriterClass;
 | 
						|
 | 
						|
begin
 | 
						|
  Writeln(Format(SCmdLineHelp,[ExtractFileName(Paramstr(0))]));
 | 
						|
  Writeln(SUsageOption010);
 | 
						|
  Writeln(SUsageOption020);
 | 
						|
  Writeln(SUsageOption030);
 | 
						|
  Writeln(SUsageOption040);
 | 
						|
  Writeln(SUsageOption050);
 | 
						|
  Writeln(SUsageOption060);
 | 
						|
  Writeln(SUsageOption070);
 | 
						|
  Writeln(SUsageOption080);
 | 
						|
  Writeln(SUsageOption090);
 | 
						|
  Writeln(SUsageOption100);
 | 
						|
  Writeln(SUsageOption110);
 | 
						|
  Writeln(SUsageOption120);
 | 
						|
  Writeln(SUsageOption130);
 | 
						|
  Writeln(SUsageOption140);
 | 
						|
  Writeln(SUsageOption150);
 | 
						|
  Writeln(SUsageOption160);
 | 
						|
  Writeln(SUsageOption170);
 | 
						|
  Writeln(SUsageOption180);
 | 
						|
  L:=TStringList.Create;
 | 
						|
  Try
 | 
						|
    If (Backend='') then
 | 
						|
      begin
 | 
						|
      Writeln;
 | 
						|
      Writeln(SUsageFormats);
 | 
						|
      EnumWriters(L);
 | 
						|
      For I:=0 to L.Count-1 do
 | 
						|
        begin
 | 
						|
        S:=L[i];
 | 
						|
        P:=Pos('=',S);
 | 
						|
        Writeln(Format(' %s - %s',[Copy(S,1,P-1)+Space(10-p),Copy(S,P+1,Length(S))]));
 | 
						|
        end;
 | 
						|
      Writeln(SUsageBackendHelp);
 | 
						|
      end
 | 
						|
    else
 | 
						|
      begin
 | 
						|
      Writeln;
 | 
						|
      Writeln(Format(SUsageFormatSpecific,[Lowercase(Backend)]));
 | 
						|
      C:=GetWriterClass(backend);
 | 
						|
      C.Usage(L);
 | 
						|
      If L.Count>0 then
 | 
						|
        For I:=0 to (L.Count-1) div 2 do
 | 
						|
          begin
 | 
						|
          S:=L[i*2];
 | 
						|
          Writeln(Format('%s %s',[S+Space(30-Length(S)),L[(i*2)+1]]));
 | 
						|
          end;
 | 
						|
      end;
 | 
						|
  Finally
 | 
						|
    L.Free;
 | 
						|
  end;
 | 
						|
  Halt(AnExitCode);
 | 
						|
end;
 | 
						|
 | 
						|
procedure InitOptions;
 | 
						|
begin
 | 
						|
  InputFiles := TStringList.Create;
 | 
						|
  DescrFiles := TStringList.Create;
 | 
						|
  BackendOptions := TStringList.Create;
 | 
						|
  Engine := TFPDocEngine.Create;
 | 
						|
  StopOnParserError:=False;
 | 
						|
end;
 | 
						|
 | 
						|
procedure FreeOptions;
 | 
						|
begin
 | 
						|
  Engine.Free;
 | 
						|
  BackendOptions.Free;
 | 
						|
  DescrFiles.Free;
 | 
						|
  InputFiles.Free;
 | 
						|
end;
 | 
						|
 | 
						|
procedure ReadContentFile(const AParams: String);
 | 
						|
var
 | 
						|
  i: Integer;
 | 
						|
begin
 | 
						|
  i := Pos(',', AParams);
 | 
						|
  Engine.ReadContentFile(Copy(AParams, 1, i - 1),
 | 
						|
    Copy(AParams, i + 1, Length(AParams)));
 | 
						|
end;
 | 
						|
 | 
						|
procedure ParseOption(const s: String);
 | 
						|
 | 
						|
  procedure AddToFileList(List: TStringList; const FileName: String);
 | 
						|
  var
 | 
						|
    f: Text;
 | 
						|
    s: String;
 | 
						|
  begin
 | 
						|
    if Copy(FileName, 1, 1) = '@' then
 | 
						|
    begin
 | 
						|
      Assign(f, Copy(FileName, 2, Length(FileName)));
 | 
						|
      Reset(f);
 | 
						|
      while not EOF(f) do
 | 
						|
      begin
 | 
						|
        ReadLn(f, s);
 | 
						|
        List.Add(s);
 | 
						|
      end;
 | 
						|
      Close(f);
 | 
						|
    end else
 | 
						|
      List.Add(FileName);
 | 
						|
  end;
 | 
						|
 | 
						|
var
 | 
						|
  i: Integer;
 | 
						|
  Cmd, Arg: String;
 | 
						|
 | 
						|
begin
 | 
						|
  if (s = '-h') or (s = '--help') then
 | 
						|
    Usage(0)
 | 
						|
  else if s = '--hide-protected' then
 | 
						|
    Engine.HideProtected := True
 | 
						|
  else if s = '--warn-no-node' then
 | 
						|
    Engine.WarnNoNode := True
 | 
						|
  else if s = '--show-private' then
 | 
						|
    Engine.HidePrivate := False
 | 
						|
  else if s = '--stop-on-parser-error' then
 | 
						|
    StopOnParserError := True
 | 
						|
  else
 | 
						|
    begin
 | 
						|
    i := Pos('=', s);
 | 
						|
    if i > 0 then
 | 
						|
      begin
 | 
						|
      Cmd := Copy(s, 1, i - 1);
 | 
						|
      Arg := Copy(s, i + 1, Length(s));
 | 
						|
      end
 | 
						|
    else
 | 
						|
      begin
 | 
						|
      Cmd := s;
 | 
						|
      SetLength(Arg, 0);
 | 
						|
      end;
 | 
						|
    if Cmd = '--descr' then
 | 
						|
      AddToFileList(DescrFiles, Arg)
 | 
						|
    else if (Cmd = '-f') or (Cmd = '--format') then
 | 
						|
      begin
 | 
						|
      Arg:=UpperCase(Arg);
 | 
						|
      If FindWriterClass(Arg)=-1 then
 | 
						|
        WriteLn(StdErr, Format(SCmdLineInvalidFormat, [Arg]))
 | 
						|
      else
 | 
						|
        BackEnd:=Arg;
 | 
						|
      end
 | 
						|
    else if (Cmd = '-l') or (Cmd = '--lang') then
 | 
						|
      DocLang := Arg
 | 
						|
    else if (Cmd = '-i') or (Cmd = '--input') then
 | 
						|
      AddToFileList(InputFiles, Arg)
 | 
						|
    else if (Cmd = '-o') or (Cmd = '--output') then
 | 
						|
      Engine.Output := Arg
 | 
						|
    else if Cmd = '--content' then
 | 
						|
      ContentFile := Arg
 | 
						|
    else if Cmd = '--import' then
 | 
						|
      ReadContentFile(Arg)
 | 
						|
    else if Cmd = '--package' then
 | 
						|
      PackageName := Arg
 | 
						|
    else if Cmd = '--ostarget' then
 | 
						|
      OSTarget := Arg
 | 
						|
    else if Cmd = '--cputarget' then
 | 
						|
      CPUTarget := Arg
 | 
						|
    else if Cmd = '--mo-dir' then
 | 
						|
      modir := Arg
 | 
						|
    else
 | 
						|
      begin
 | 
						|
      BackendOptions.Add(Cmd);
 | 
						|
      BackendOptions.Add(Arg);
 | 
						|
      end;
 | 
						|
    end;
 | 
						|
end;
 | 
						|
 | 
						|
procedure ParseCommandLine;
 | 
						|
 | 
						|
var
 | 
						|
  i: Integer;
 | 
						|
 | 
						|
begin
 | 
						|
  for i := 1 to ParamCount do
 | 
						|
    ParseOption(ParamStr(i));
 | 
						|
  If (BackEnd='') then
 | 
						|
    BackEnd:='html';
 | 
						|
  if (PackageName='') then
 | 
						|
    begin
 | 
						|
    Writeln(SNeedPackageName);
 | 
						|
    Usage(1);
 | 
						|
    end;
 | 
						|
end;
 | 
						|
 | 
						|
procedure CreateDocumentation;
 | 
						|
 | 
						|
var
 | 
						|
  i: Integer;
 | 
						|
  WriterClass : TFPDocWriterClass;
 | 
						|
  Writer : TFPDocWriter;
 | 
						|
 | 
						|
begin
 | 
						|
  for i := 0 to DescrFiles.Count - 1 do
 | 
						|
    Engine.AddDocFile(DescrFiles[i]);
 | 
						|
  Engine.SetPackageName(PackageName);
 | 
						|
  if Length(DocLang) > 0 then
 | 
						|
    TranslateDocStrings(DocLang);
 | 
						|
  for i := 0 to InputFiles.Count - 1 do
 | 
						|
    try
 | 
						|
      ParseSource(Engine, InputFiles[i], OSTarget, CPUTarget);
 | 
						|
    except
 | 
						|
      on e: EParserError do
 | 
						|
        If StopOnParserError then
 | 
						|
          Raise
 | 
						|
        else 
 | 
						|
          WriteLn(StdErr, Format('%s(%d,%d): %s',
 | 
						|
                  [e.Filename, e.Row, e.Column, e.Message]));
 | 
						|
    end;
 | 
						|
  WriterClass:=GetWriterClass(Backend);
 | 
						|
  Writer:=WriterClass.Create(Engine.Package,Engine);
 | 
						|
  With Writer do
 | 
						|
    Try
 | 
						|
      If BackendOptions.Count>0 then
 | 
						|
        for I:=0 to ((BackendOptions.Count-1) div 2) do
 | 
						|
          If not InterPretOption(BackendOptions[I*2],BackendOptions[I*2+1]) then
 | 
						|
            WriteLn(StdErr, Format(SCmdLineInvalidOption,[BackendOptions[I*2]+' '+BackendOptions[I*2+1]]));
 | 
						|
      WriteDoc;
 | 
						|
    Finally
 | 
						|
      Free;
 | 
						|
    end;
 | 
						|
  if Length(ContentFile) > 0 then
 | 
						|
    Engine.WriteContentFile(ContentFile);
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
 | 
						|
begin
 | 
						|
{$IFDEF Unix}
 | 
						|
  gettext.TranslateResourceStrings('/usr/local/share/locale/%s/LC_MESSAGES/fpdoc.mo');
 | 
						|
{$ELSE}
 | 
						|
  gettext.TranslateResourceStrings('intl/fpdoc.%s.mo');
 | 
						|
{$ENDIF}
 | 
						|
  WriteLn(STitle);
 | 
						|
  WriteLn(Format(SVersion, [FPCVersion, FPCDate]));
 | 
						|
  WriteLn(SCopyright);
 | 
						|
  WriteLn;
 | 
						|
  InitOptions;
 | 
						|
  Try
 | 
						|
    ParseCommandLine;
 | 
						|
    CreateDocumentation;
 | 
						|
    WriteLn(SDone);
 | 
						|
  Finally
 | 
						|
    FreeOptions;
 | 
						|
  end;
 | 
						|
end.
 |