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