1program update_lcl_docs;
2
3{ Runs FPC's fpdoc document generator to generate LCL documentation,
4  e.g. in CHM format }
5
6{$mode objfpc}{$H+}
7{$IFDEF MSWINDOWS}
8{$APPTYPE console}
9{$ENDIF}
10
11uses
12  Classes, Sysutils, GetOpts, LazFileUtils, FileUtil, UTF8Process, LazUtilities,
13  LazStringUtils, Process;
14
15var
16  DefaultFPDocExe: string = 'fpdoc';
17  DefaultCSSFile: string = 'fpdoc.css';
18  WarningsCount: Integer;
19  Verbosity: integer;
20  ShowCmd: Boolean;
21  EnvParams: String;
22  DefaultXCTDir: String;
23  DefaultFPDocParams: string = '';
24  DefaultOutFormat: string = 'html';
25  DefaultFooterFilename: string = 'locallclfooter.xml'; // ToDo
26
27type
28  TFPDocRunStep = (
29    frsCreated,
30    frsVarsInitialized,
31    frsFilesGathered,
32    frsOutDirCreated,
33    frsFPDocExecuted,
34    frsCopiedToXCTDir,
35    frsComplete
36    );
37  TFPDocRunOption = (
38    foCopyToXCTDir  // copy the created chm and xct file to the xct directory
39    );
40  TFPDocRunOptions = set of TFPDocRunOption;
41const
42  DefaultFPDocRunOptions = [foCopyToXCTDir];
43
44type
45
46  { TFPDocRun }
47
48  TFPDocRun = class
49  private
50    FCSSFile: String;
51    FFooterFilename: String;
52    FFPDocExe: String;
53    FIncludePath: string;
54    FInputFile: string;
55    FOptions: TFPDocRunOptions;
56    FOutDir: string;
57    FOutFormat: String;
58    FPackageName: string;
59    FPasSrcDir: string;
60    FStep: TFPDocRunStep;
61    FUsedPkgs: TStringList;
62    FXCTDir: string;
63    FXCTFile: string;
64    FXMLSrcDir: string;
65    FExtraOptions : String;
66    procedure SetCSSFile(AValue: String);
67    procedure SetFooterFilename(AValue: String);
68    procedure SetIncludePath(AValue: string);
69    procedure SetInputFile(AValue: string);
70    procedure SetOutDir(AValue: string);
71    procedure SetPasSrcDir(AValue: string);
72    procedure SetXCTDir(AValue: string);
73    procedure SetXMLSrcDir(AValue: string);
74  public
75    Params: TStringList;
76    ParseParams: string;
77    constructor Create(aPackageName: string);
78    destructor Destroy; override;
79    procedure InitVars;
80    procedure AddFilesToList(Dir: String; List: TStrings);
81    procedure FindSourceFiles;
82    procedure CreateOuputDir;
83    procedure RunFPDoc;
84    procedure CopyToXCTDir;
85    procedure Execute;
86    property Options: TFPDocRunOptions read FOptions write FOptions default DefaultFPDocRunOptions;
87    property CSSFile: String read FCSSFile write SetCSSFile;
88    property FooterFilename: String read FFooterFilename write SetFooterFilename;
89    property FPDocExe: String read FFPDocExe write FFPDocExe;
90    property IncludePath: string read FIncludePath write SetIncludePath;// semicolon separated search path
91    property InputFile: string read FInputFile write SetInputFile; // relative to OutDir, automatically created
92    property OutDir: string read FOutDir write SetOutDir;
93    property OutFormat: String read FOutFormat write FOutFormat;
94    property PackageName: string read FPackageName;
95    property PasSrcDir: string read FPasSrcDir write SetPasSrcDir;
96    property Step: TFPDocRunStep read FStep;
97    property UsedPkgs: TStringList read FUsedPkgs; // e.g. 'rtl','fcl', 'lazutils'
98    property XCTDir: string read FXCTDir write SetXCTDir;
99    property XMLSrcDir: string read FXMLSrcDir write SetXMLSrcDir;
100    property XCTFile: string read FXCTFile;
101    property ExtraOptions : string read FExtraOptions write FExtraOptions;
102  end;
103
104procedure GetEnvDef(var S: String; DefaultValue: String; EnvName: String);
105begin
106  S := GetEnvironmentVariable(EnvName);
107  if S = '' then
108    S := DefaultValue;
109end;
110
111function FileInEnvPATH(FileName: String): Boolean;
112var
113  FullFilename: String;
114begin
115  FullFilename:=FindDefaultExecutablePath(Filename);
116  Result:=(FullFilename<>'') and not DirectoryExistsUTF8(FullFilename);
117end;
118
119procedure PrintHelp;
120begin
121  WriteLn('Usage for '+ ExtractFileName(ParamStr(0)), ':');
122  WriteLn;
123  Writeln('    --css-file <value> (CHM format only) CSS file to be used by fpdoc');
124  Writeln('                       for the layout of the help pages. Default is "',DefaultCSSFile,'"');
125  WriteLn('    --fpdoc <value>    The full path to fpdoc to use. Default is "',DefaultFPDocExe,'"');
126  WriteLn('    --fpcdocs <value>  The directory that contains the required .xct files.');
127  WriteLn('                       Use this to make help that contains links to rtl and fcl');
128  WriteLn('    --footer <value>   Filename of a file to use a footer used in the generated pages.');
129  WriteLn('                       Default is "'+DefaultFooterFilename+'"');
130  WriteLn('    --help             Show this message');
131  WriteLn('    --arg <value>      Passes value to fpdoc as an arg. Use this option as');
132  WriteLn('                       many times as needed.');
133  WriteLn('    --outfmt html|chm  Use value as the format fpdoc will use. Default is "'+DefaultOutFormat+'"');
134  WriteLn('    --showcmd          Print the command that would be run instead if running it.');
135  WriteLn('    --warnings         Show warnings while working.');
136  WriteLn('    --verbose          be more verbose');
137  WriteLn;
138  WriteLn('The following are environment variables that will override the above params if set:');
139  WriteLn('     FPDOCFORMAT, FPDOCPARAMS, FPDOC, FPDOCFOOTER, FPCDOCS, RTLLINKPREFIX, FCLLINKPREFIX, <Pkg>LINKPREFIX, ...');
140  WriteLn;
141  Halt(0);
142end;
143
144procedure ReadOptions;
145var
146  c: char;
147  Options: array of TOption;
148  OptIndex: Longint;
149begin
150  ShowCmd := False;
151  WarningsCount:=-1;
152  SetLength(Options, 10);
153
154  Options[0].Name:='help';
155  Options[1].Name:='arg';
156  Options[1].Has_arg:=1;
157  Options[2].Name:='fpdoc';
158  Options[2].Has_arg:=1;
159  Options[3].Name:='outfmt';
160  Options[3].Has_arg:=1;
161  Options[4].Name:='showcmd';
162  Options[5].Name:='fpcdocs';
163  Options[5].Has_arg:=1;
164  Options[6].Name:='footer';
165  Options[6].Has_arg:=1;
166  Options[7].Name:='warnings';
167  Options[8].Name:='css-file';
168  Options[8].Has_arg:=1;
169  Options[9].Name:='verbose';
170  OptIndex:=0;
171  repeat
172    c := GetLongOpts('help arg: fpdoc: outfmt: showcmd fpcdocs: footer: warnings css-file verbose', @Options[0], OptIndex);
173    case c of
174      #0:
175         begin
176           //WriteLn(Options[OptIndex-1].Name, ' = ', OptArg);
177           case OptIndex-1 of
178             0:  PrintHelp;
179             1:  DefaultFPDocParams := DefaultFPDocParams + ' ' + OptArg;
180             2:  DefaultFPDocExe := OptArg;
181             3:  DefaultOutFormat := OptArg;
182             4:  ShowCmd := True;
183             5:  DefaultXCTDir := OptArg;
184             6:  DefaultFooterFilename := OptArg;
185             7:  WarningsCount:=0;
186             8:  DefaultCssFile := OptArg;
187             9:  inc(Verbosity);
188           else
189             WriteLn('Unknown Value: ', OptIndex);
190           end;
191         end;
192      '?': PrintHelp;
193      EndOfOptions: Break;
194    else
195      WriteLn('Unknown option -',c,' ',OptArg);
196      PrintHelp;
197    end;
198  until c = EndOfOptions;
199
200  GetEnvDef(DefaultOutFormat, DefaultOutFormat, 'FPDOCFORMAT');
201  GetEnvDef(EnvParams, '', 'FPDOCPARAMS');
202  GetEnvDef(DefaultFPDocExe, DefaultFPDocExe, 'FPDOC');
203  GetEnvDef(DefaultFooterFilename, DefaultFooterFilename, 'FPDOCFOOTER');
204  GetEnvDef(DefaultXCTDir, DefaultXCTDir, 'FPCDOCS');
205
206  if DefaultOutFormat = '' then
207  begin
208    writeln('Error: Param outfmt wrong');
209    PrintHelp;
210  end;
211end;
212
213{ TFPDocRun }
214
215procedure TFPDocRun.SetInputFile(AValue: string);
216begin
217  AValue:=TrimFilename(AValue);
218  if FInputFile=AValue then Exit;
219  FInputFile:=AValue;
220end;
221
222procedure TFPDocRun.SetOutDir(AValue: string);
223begin
224  AValue:=TrimAndExpandFilename(AValue);
225  if FOutDir=AValue then Exit;
226  FOutDir:=AValue;
227end;
228
229procedure TFPDocRun.SetIncludePath(AValue: string);
230begin
231  if FIncludePath=AValue then Exit;
232  FIncludePath:=AValue;
233end;
234
235procedure TFPDocRun.SetCSSFile(AValue: String);
236begin
237  AValue:=TrimAndExpandFilename(AValue);
238  if FCSSFile=AValue then Exit;
239  FCSSFile:=AValue;
240end;
241
242procedure TFPDocRun.SetFooterFilename(AValue: String);
243begin
244  AValue:=TrimAndExpandFilename(AValue);
245  if FFooterFilename=AValue then Exit;
246  FFooterFilename:=AValue;
247end;
248
249procedure TFPDocRun.SetPasSrcDir(AValue: string);
250begin
251  AValue:=TrimAndExpandFilename(AValue);
252  if FPasSrcDir=AValue then Exit;
253  FPasSrcDir:=AValue;
254end;
255
256procedure TFPDocRun.SetXCTDir(AValue: string);
257begin
258  AValue:=TrimAndExpandFilename(AValue);
259  if FXCTDir=AValue then Exit;
260  FXCTDir:=AValue;
261end;
262
263procedure TFPDocRun.SetXMLSrcDir(AValue: string);
264begin
265  AValue:=TrimAndExpandFilename(AValue);
266  if FXMLSrcDir=AValue then Exit;
267  FXMLSrcDir:=AValue;
268end;
269
270constructor TFPDocRun.Create(aPackageName: string);
271begin
272  FPackageName:=aPackageName;
273  FOptions:=DefaultFPDocRunOptions;
274  fUsedPkgs:=TStringList.Create;
275  InputFile := 'inputfile.txt';
276  OutDir:=PackageName;
277  FPDocExe:=TrimFilename(DefaultFPDocExe);
278  CSSFile:=DefaultCSSFile;
279  Params:=TStringList.Create;
280  SplitCmdLineParams(DefaultFPDocParams,Params);
281  OutFormat:=DefaultOutFormat;
282  FooterFilename:=DefaultFooterFilename;
283  XCTDir:=DefaultXCTDir;
284
285  FStep:=frsCreated;
286end;
287
288destructor TFPDocRun.Destroy;
289begin
290  FreeAndNil(fUsedPkgs);
291  inherited Destroy;
292end;
293
294procedure TFPDocRun.InitVars;
295var
296  Pkg, Prefix, IncludeDir, Param: String;
297  p: Integer;
298begin
299  if ord(Step)>=ord(frsVarsInitialized) then
300    raise Exception.Create('TFPDocRun.InitVars not again');
301
302  // add IncludePath to ParseParams
303  p:=1;
304  while p<=length(IncludePath) do begin
305    IncludeDir:=GetNextDelimitedItem(IncludePath,';',p);
306    if IncludeDir='' then continue;
307    IncludeDir:=TrimAndExpandFilename(ChompPathDelim(IncludeDir));
308    ParseParams+=' -Fi'+CreateRelativePath(IncludeDir,OutDir);
309  end;
310
311  FXCTFile:=AppendPathDelim(OutDir)+PackageName+'.xct';
312
313  Params.Add('--content='+CreateRelativePath(XCTFile,OutDir));
314  Params.Add('--package='+PackageName);
315  Params.Add('--descr='+CreateRelativePath(AppendPathDelim(XMLSrcDir)+PackageName+'.xml',OutDir));
316  Params.Add('--format='+OutFormat);
317  if FilenameIsAbsolute(InputFile) then
318    Params.Add('--input=@'+CreateRelativePath(InputFile,OutDir))
319  else
320    Params.Add('--input=@'+InputFile);
321
322  if XCTDir <> '' then
323  begin
324    for Pkg in UsedPkgs do
325    begin
326      Prefix:='';
327      if OutFormat = 'html' then
328        Prefix:='../'+Lowercase(Pkg)+'/'
329      else if OutFormat = 'chm' then
330        Prefix:='ms-its:'+LowerCase(Pkg)+'.chm::/'
331      else
332        Prefix:='';
333      GetEnvDef(Prefix, Prefix, UpperCase(Pkg)+'LINKPREFIX');
334
335      Param:='--import='+CreateRelativePath(AppendPathDelim(XCTDir)+LowerCase(Pkg)+'.xct',OutDir);
336      if Prefix<>'' then
337        Param+=','+Prefix;
338      Params.Add(Param);
339    end;
340  end;
341
342  if OutFormat='chm' then
343  begin
344    Params.Add('--output='+ ChangeFileExt(PackageName, '.chm'));
345    Params.Add('--auto-toc');
346    Params.Add('--auto-index');
347    Params.Add('--make-searchable');
348    if CSSFile<>'' then
349      Params.Add('--css-file='+ExtractFileName(CSSFile)); // the css file is copied to the OutDir
350  end;
351
352  if (FooterFilename<>'') and FileExistsUTF8(FooterFilename) then
353    Params.Add('--footer='+FooterFilename);
354
355  if EnvParams<>'' then
356    SplitCmdLineParams(EnvParams,Params);
357
358  if Verbosity>0 then
359  begin
360    writeln('Verbose Params: ------------------');
361    writeln('FPDocExe=',FPDocExe);
362    writeln('OutFormat=',OutFormat);
363    writeln('CSSFile=',CSSFile);
364    writeln('FooterFilename=',FooterFilename);
365    writeln('InputFile=',InputFile);
366    writeln('OutDir=',OutDir);
367    writeln('ParseParams=');
368    writeln(ParseParams);
369    writeln('FPDocParams=');
370    writeln(Params.Text);
371    writeln('----------------------------------');
372  end;
373
374  FStep:=frsVarsInitialized;
375end;
376
377procedure TFPDocRun.AddFilesToList(Dir: String; List: TStrings);
378var
379  FRec: TSearchRec;
380begin
381  Dir:=AppendPathDelim(TrimFilename(Dir));
382  if FindFirstUTF8(Dir+AllFilesMask, faAnyFile, FRec)=0 then
383    repeat
384      //WriteLn('Checking file ' +FRec.Name);
385      if (FRec.Name='') or (FRec.Name='.') or (FRec.Name='..') then continue;
386      if (FRec.Name='fpmake.pp') then continue;
387      if ((FRec.Attr and faDirectory) <> 0) then
388      begin
389        AddFilesToList(Dir+FRec.Name, List);
390        //WriteLn('Checking Subfolder ',Dir+ FRec.Name);
391      end
392      else if FilenameHasPascalExt(FRec.Name) then
393      begin
394        List.Add(Dir+FRec.Name);
395      end;
396    until FindNextUTF8(FRec)<>0;
397  FindCloseUTF8(FRec);
398end;
399
400procedure TFPDocRun.FindSourceFiles;
401var
402  FileList: TStringList;
403  InputList: TStringList;
404  I: Integer;
405  XMLFile, Filename: String;
406begin
407  if ord(Step)>=ord(frsFilesGathered) then
408    raise Exception.Create('TFPDocRun.FindSourceFiles not again');
409  if ord(Step)<ord(frsVarsInitialized) then
410    InitVars;
411
412  if Verbosity>0 then
413    writeln('PasSrcDir="',PasSrcDir,'"');
414  FileList := TStringList.Create;
415  InputList := TStringList.Create;
416  AddFilesToList(PasSrcDir, FileList);
417
418  FileList.Sort;
419  for I := 0 to FileList.Count-1 do
420  begin
421    XMLFile := AppendPathDelim(XMLSrcDir)+ExtractFileNameOnly(FileList[I])+'.xml';
422    if FileExistsUTF8(XMLFile) then
423    begin
424      InputList.Add(CreateRelativePath(FileList[I],OutDir) + ParseParams);
425      Params.Add('--descr='+CreateRelativePath(XMLFile,OutDir));
426    end
427    else
428    begin
429      if WarningsCount >= 0 then
430        WriteLn('Warning! No corresponding xml file for unit ' + FileList[I])
431      else
432        Dec(WarningsCount);
433    end;
434  end;
435  FileList.Free;
436
437  Filename:=InputFile;
438  if not FilenameIsAbsolute(Filename) then
439    Filename:=TrimFilename(AppendPathDelim(OutDir)+Filename);
440  if ExtraOptions<>'' then
441     for i:=0 to InputList.count-1 do
442       InputList[i]:=ExtraOptions+' '+InputList[i];
443  InputList.SaveToFile(Filename);
444  InputList.Free;
445
446  FStep:=frsFilesGathered;
447end;
448
449procedure TFPDocRun.CreateOuputDir;
450var
451  TargetCSSFile: String;
452begin
453  if ord(Step)>=ord(frsOutDirCreated) then
454    raise Exception.Create('TFPDocRun.CreateOuputDir not again');
455
456  if Not DirectoryExistsUTF8(OutDir) then
457  begin
458    writeln('Creating directory "',OutDir,'"');
459    if not CreateDirUTF8(OutDir) then
460      raise Exception.Create('unable to create directory "'+OutDir+'"');
461  end;
462
463  if ord(Step)<ord(frsFilesGathered) then
464    FindSourceFiles;
465
466  if (OutFormat='chm') and (CSSFile<>'') then
467  begin
468    TargetCSSFile:=AppendPathDelim(OutDir)+ExtractFileName(CSSFile);
469    if CompareFilenames(TargetCSSFile,CSSFile)<>0 then
470    begin
471      if not CopyFile(CSSFile,TargetCSSFile) then
472        raise Exception.Create('unable to copy css file: CSSfile="'+CSSFile+'" to "'+TargetCSSFile+'"');
473    end;
474  end;
475
476  FStep:=frsOutDirCreated;
477end;
478
479procedure TFPDocRun.RunFPDoc;
480var
481  Process: TProcess;
482  CmdLine: String;
483begin
484  if ord(Step)>=ord(frsFPDocExecuted) then
485    raise Exception.Create('TFPDocRun.Run not again');
486  if ord(Step)<ord(frsOutDirCreated) then
487    CreateOuputDir;
488
489  if ShowCmd then
490  begin
491    Writeln('WorkDirectory:',OutDir);
492    WriteLn('Exe:',FPDocExe);
493    WriteLn(Params.Text);
494    exit;
495  end;
496  {$IFDEF MSWINDOWS}FPDocExe := ChangeFileExt(FPDocExe,'.exe');{$ENDIF}
497  if not FileInEnvPATH(FPDocExe) then
498  begin
499    WriteLn('Error: fpdoc ('+FPDocExe+') cannot be found. Please add its location to the PATH ',
500            'or set it with --fpdoc path',PathDelim,'to',PathDelim,'fpdoc'{$IFDEF MSWINDOWS},'.exe'{$ENDIF});
501    Halt(1);
502  end;
503  Process := TProcessUTF8.Create(nil);
504  try
505    Process.Options := Process.Options + [poWaitOnExit];
506    Process.CurrentDirectory := OutDir;
507    Process.Executable:=FPDocExe;
508    Process.Parameters.Assign(Params);
509    CmdLine:=Process.Executable+' '+MergeCmdLineParams(Params);
510    if Verbosity>0 then
511      writeln('CmdLine: ',CmdLine);
512    try
513      Process.Execute;
514      if Process.ExitCode<>0 then
515        raise Exception.Create('fpdoc failed with code '+IntToStr(Process.ExitCode));
516    except
517      if WarningsCount >= 0 then
518      begin
519        WriteLn('Error running fpdoc, command line: '+CmdLine)
520      end
521      else
522        Dec(WarningsCount);
523    end;
524    if WarningsCount < -1 then
525      WriteLn(abs(WarningsCount+1), ' Warnings hidden. Use --warnings to see them all.');
526    if not FileExistsUTF8(XCTFile) then
527      raise Exception.Create('File not found: '+XCTFile);
528  finally
529    Process.Free;
530  end;
531
532  FStep:=frsFPDocExecuted;
533end;
534
535procedure TFPDocRun.CopyToXCTDir;
536var
537  TargetXCTFile, SrcCHMFile, TargetCHMFile: String;
538begin
539  if ord(Step)>=ord(frsCopiedToXCTDir) then
540    raise Exception.Create('TFPDocRun.CopyToXCTDir not again');
541  if ord(Step)<ord(frsFPDocExecuted) then
542    RunFPDoc;
543
544  if (foCopyToXCTDir in Options)
545  and (CompareFilenames(ChompPathDelim(OutDir),ChompPathDelim(XCTDir))<>0) then
546  begin
547    TargetXCTFile:=AppendPathDelim(XCTDir)+ExtractFileName(XCTFile);
548    if ShowCmd then
549      writeln('cp ',XCTFile,' ',TargetXCTFile)
550    else if not CopyFile(XCTFile,TargetXCTFile) then
551      raise Exception.Create('unable to copy xct file: "'+XCTFile+'" to "'+TargetXCTFile+'"');
552    writeln('Created ',TargetXCTFile);
553    if OutFormat='chm' then
554    begin
555      SrcCHMFile:=AppendPathDelim(OutDir)+PackageName+'.chm';
556      TargetCHMFile:=AppendPathDelim(XCTDir)+PackageName+'.chm';
557      if ShowCmd then
558        writeln('cp ',SrcCHMFile,' ',TargetCHMFile)
559      else if not CopyFile(SrcCHMFile,TargetCHMFile) then
560        raise Exception.Create('unable to copy chm file: "'+SrcCHMFile+'" to "'+TargetCHMFile+'"');
561      writeln('Created ',TargetCHMFile);
562    end;
563  end;
564
565  FStep:=frsCopiedToXCTDir;
566end;
567
568procedure TFPDocRun.Execute;
569begin
570  writeln('===================================================================');
571  if ord(Step)>=ord(frsComplete) then
572    raise Exception.Create('TFPDocRun.Execute not again');
573  if ord(Step)<ord(frsCopiedToXCTDir) then
574    CopyToXCTDir;
575
576  FStep:=frsComplete;
577end;
578
579var
580  Run: TFPDocRun;
581begin
582  ReadOptions;
583
584  Run:=TFPDocRun.Create('lazutils');
585  Run.ExtraOptions:='-MObjFPC -Scghi'; // extra options from in lazutils makefile.
586  Run.UsedPkgs.Add('rtl');
587  Run.UsedPkgs.Add('fcl');
588  Run.XMLSrcDir := '..'+PathDelim+'xml'+PathDelim+'lazutils';
589  Run.PasSrcDir := '..'+PathDelim+'..'+PathDelim+'components'+PathDelim+'lazutils';
590  Run.Execute;
591  Run.Free;
592
593  Run:=TFPDocRun.Create('lcl');
594  Run.ExtraOptions:='-MObjFPC -Sic'; // extra options from in LCL makefile.
595  Run.UsedPkgs.Add('rtl');
596  Run.UsedPkgs.Add('fcl');
597  Run.UsedPkgs.Add('lazutils');
598  Run.XMLSrcDir := '..'+PathDelim+'xml'+PathDelim+'lcl'+PathDelim;
599  Run.PasSrcDir := '..'+PathDelim+'..'+PathDelim+'lcl'+PathDelim;
600  Run.IncludePath := Run.PasSrcDir+PathDelim+'include';
601  Run.Execute;
602  Run.Free;
603
604  if ShowCmd then
605    writeln('Not executing, simulation ended. Stop');
606end.
607
608