diff --git a/utils/fpdoc/unitdiff.pp b/utils/fpdoc/unitdiff.pp new file mode 100644 index 0000000000..bd0cc72028 --- /dev/null +++ b/utils/fpdoc/unitdiff.pp @@ -0,0 +1,380 @@ +{ + $Id$ + + FPDoc - Free Pascal Documentation Tool + Copyright (C) 2000 - 2003 by + Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org + + * Skeleton XML description file generator + + 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 MakeSkel; + +uses + SysUtils, Classes, Gettext, + dGlobals, PasTree, PParser,PScanner; + +resourcestring + SIdentifiersIn = 'Identifiers in file "%s"'; + SCmdLineInvalidOption = 'Ignoring unknown option "%s"'; + SErrNoInputFile = 'No input file specified'; + SWarnAssumingList = 'Only one input file specified. Assuming --list option.'; + SExtraIdentifier = 'Extra identifier in file "%s" : Name: %s'; + SExtraTypedIdentifier = 'Extra identifier in file "%s" : Type %s, Name: %s'; + SIdenticalUnits = 'Unit interfaces are identical.'; + +type + TCmdLineAction = (actionHelp, actionDiff,ActionList); + + TSkelEngine = class(TFPDocEngine) + public + FList: TStringList; + Constructor Create; + Destructor Destroy;override; + function CreateElement(AClass: TPTreeElement; const AName: String; + AParent: TPasElement; AVisibility :TPasMemberVisibility; + const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement; override; + end; + +Constructor TSkelEngine.Create; +begin + Inherited Create; + FList:=TStringList.Create; + FList.Sorted:=True; +end; + +Destructor TSkelEngine.Destroy; + +begin + FreeAndNil(FList); + Inherited; +end; + +const + CmdLineAction: TCmdLineAction = actionDiff; + OSTarget: String = {$I %FPCTARGETOS%}; + CPUTarget: String = {$I %FPCTARGETCPU%}; + +var + InputFile1, + InputFile2 : String; + DocLang: String; + Engine1, + Engine2: TSkelEngine; + SparseList, + DisableArguments, + DisableProtected, + DisablePrivate, + DisableFunctionResults: Boolean; + + OutputName: String; + f: Text; + + +function TSkelEngine.CreateElement(AClass: TPTreeElement; const AName: String; + AParent: TPasElement; AVisibility : TPasMemberVisibility; + const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement; + + Function ExamineThisNode(APasElement : TPasElement) : Boolean; + + begin + Result:=Assigned(AParent) and (Length(AName) > 0) and + (not DisableArguments or (APasElement.ClassType <> TPasArgument)) and + (not DisableFunctionResults or (APasElement.ClassType <> TPasResultElement)) and + (not DisablePrivate or (AVisibility<>visPrivate)) and + (not DisableProtected or (AVisibility<>visProtected)); + end; + +begin + Result := AClass.Create(AName, AParent); + if AClass.InheritsFrom(TPasModule) then + CurModule := TPasModule(Result) + else if ExamineThisNode(Result) then + Flist.AddObject(Result.FullName,Result); +end; + + +Procedure Usage; + +begin + Writeln('Usage : ',ExtractFileName(Paramstr(0)),' [options] file1 file2'); + Writeln('Where [options] is one or more of :'); + Writeln(' --disable-arguments Do not check function arguments.'); + Writeln(' --disable-private Do not check class private fields.'); + Writeln(' --disable-protected Do not check class protected fields.'); + Writeln(' --help Emit help.'); + Writeln(' --input=cmdline Input file to create skeleton for.'); + Writeln(' Use options are as for compiler.'); + Writeln(' --lang=language Use selected language.'); + Writeln(' --list List identifiers instead of making a diff'); + Writeln(' --output=filename Send output to file.'); + Writeln(' --sparse Sparse list/diff (skip type identification)'); +end; + +procedure ParseOption(const s: String); + +var + i: Integer; + Cmd, Arg: String; +begin + if (s = '-h') or (s = '--help') then + CmdLineAction := actionHelp + else if s = '--disable-arguments' then + DisableArguments := True + else if s = '--disable-private' then + DisablePrivate := True + else if s = '--sparse' then + SparseList := True + else if s = '--disable-protected' then + begin + DisableProtected := True; + DisablePrivate :=True; + end + 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 = '-l') or (Cmd = '--lang') then + DocLang := Arg + else if (Cmd = '-o') or (Cmd = '--output') then + OutputName := Arg + else + if (length(cmd)>0) and (cmd[1]='-') then + WriteLn(StdErr, Format(SCmdLineInvalidOption, [s])) + else if (InputFile1='') then + InputFile1:=Cmd + else if (InputFile2='') then + InputFile2:=Cmd + else + WriteLn(StdErr, Format(SCmdLineInvalidOption, [s])); + end; +end; + +procedure ParseCommandLine; + +Const +{$IFDEF Unix} + MoFileTemplate = '/usr/local/share/locale/%s/LC_MESSAGES/makeskel.mo'; +{$ELSE} + MoFileTemplate ='intl/makeskel.%s.mo'; +{$ENDIF} + +var + MOFilename: string; + i: Integer; +begin + CmdLineAction := actionDiff; + DocLang:=''; + SparseList:=False; + for i := 1 to ParamCount do + ParseOption(ParamStr(i)); + If (DocLang<>'') then + begin + MOFilename:=Format(MOFileTemplate,[DocLang]); + if FileExists(MOFilename) then + gettext.TranslateResourceStrings(MoFileName) + else + writeln('NOTE: unable to find tranlation file ',MOFilename); + // Translate internal documentation strings + TranslateDocStrings(DocLang); + end; + if (cmdLineAction<>ActionHelp) and (InputFile1='') and (InputFile2='') then + Writeln(StdErr,SErrNoInputFile) + else if (InputFile2='') and (CmdLineAction<>ActionList) then + begin + Writeln(StdErr,SWarnAssumingList); + CmdLineAction:=ActionList; + end; +end; + +Function GetTypeDescription(El : TPasElement) : String; + +begin + If Assigned(El) then + Result:=El.ElementTypeName + else + Result:='(unknown)'; +end; + +Procedure ListIdentifiers(Fn : String; List : TStrings); + +Var + I : Integer; + +begin + Writeln(f,Format(SIdentifiersIn,[FN])); + For I:=0 to List.Count-1 do + begin + If Not SparseList then + Write(GetTypeDescription(TPasElement(List.Objects[i])),' : '); + Writeln(List[i]); + end; +end; + +Procedure WriteExtra(FN,Id : String; El: TPaselement); + +begin + If SparseList then + Writeln(F,Format(SExtraIdentifier,[FN,ID])) + else + Writeln(F,Format(SExtraTypedIdentifier,[FN,GetTypeDescription(El),ID])); +end; + +Procedure DoExtra(FN : String; L : TStrings); + +Var + I,Len : Integer; + S : String; + +begin + I:=0; + While (IList1.Count then + begin + L1:=List2; + L2:=List1; + end; + // Remove all common elements. + For I:=L1.Count-1 downto 0 do + begin + J:=L2.IndexOf(L1[i]); + If (J<>-1) then + begin + L1.Delete(I); + L2.Delete(J); + end; + end; + If (List1.Count=0) and (List2.Count=0) then + Writeln(F,SIdenticalUnits) + else + begin + DoExtra(InputFile1,List1); + DoExtra(InputFile2,List2); + end; +end; + + +begin + ParseCommandLine; + if CmdLineAction = actionHelp then + Usage + else + begin + Assign(f, OutputName); + Rewrite(f); + Try + Engine1:=TSkelEngine.Create; + Try + Engine1.SetPackageName('diff'); // do not localize + ParseSource(Engine1, InputFile1, OSTarget, CPUTarget); + if (InputFile2<>'') then + begin + Engine2:=TSkelEngine.Create; + Try + Engine2.SetPackageName('diff'); // do not localize + ParseSource(Engine2, InputFile2, OSTarget, CPUTarget); + If cmdLineAction=ActionList then + begin + ListIdentifiers(InputFile1,Engine1.FList); + ListIdentifiers(InputFile2,Engine2.FList); + end + else + DiffIdentifiers(Engine1.Flist,Engine2.Flist); + finally + Engine2.Free; + end; + end + else + ListIdentifiers(InputFile1,Engine1.FList); + Finally + Engine1.Free; + end; + Finally + Close(f); + end; + end; +end. + + +{ + $Log$ + Revision 1.1 2004-11-14 21:18:58 michael + + Initial check-in + + Revision 1.13 2004/09/13 16:04:52 peter + * fix nested for-loop with same index + + Revision 1.12 2004/08/29 15:32:41 michael + + More intelligent handling of nodes. Do not write unused nodes. + + Revision 1.11 2004/08/28 18:18:59 michael + + Do not write descr nodes for module when updating + + Revision 1.10 2004/08/28 18:15:14 michael + + Check whether outputfile not in inputfilenames + + Revision 1.9 2004/08/28 18:04:06 michael + + Added update mode + + Revision 1.8 2004/08/25 07:16:43 michael + + Improved translation handling + + Revision 1.7 2004/08/24 14:48:25 michael + + Translate now called correctly... + + Revision 1.6 2004/05/01 20:13:40 marco + * got fed up with exceptions on file not found. Fileresolver now raises a + EFileNotFound error, and makeskel catches and exists gracefully + + Revision 1.5 2003/11/28 12:51:37 sg + * Added support for source references + + Revision 1.4 2003/09/02 13:26:47 mattias + MG: makeskel now ignores missing translation file + + Revision 1.3 2003/05/07 16:31:32 sg + * Fixed a severe memory corruption problem on termination + + Revision 1.2 2003/03/28 13:01:36 michael + + Patch from Charlie/iNQ to work with new scanner/parser + + Revision 1.1 2003/03/17 23:03:20 michael + + Initial import in CVS +} \ No newline at end of file