diff options
Diffstat (limited to 'compiler/utils/msgdif.pp')
| -rw-r--r-- | compiler/utils/msgdif.pp | 529 |
1 files changed, 529 insertions, 0 deletions
diff --git a/compiler/utils/msgdif.pp b/compiler/utils/msgdif.pp new file mode 100644 index 0000000000..1052f30bc8 --- /dev/null +++ b/compiler/utils/msgdif.pp @@ -0,0 +1,529 @@ +{ + This program is part of the Free Pascal run time library. + Copyright (c) 1998-2002 by Peter Vreman + + Show the differences between two .msg files + + See the file COPYING.FPC, 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. + + **********************************************************************} + +{ May be we need to compare a prefixes of option_help_pages too? + Currently this is not performed } + +Program messagedif; + +{$h+} {Huge strings} + +Uses + Strings; + +Type + TEnum = String; + TText = String; + + PMsg = ^TMsg; + TMsg = Record + Line, ctxt, cnb : Longint; + enum : TEnum; + text : TText; + comment : pchar; + Next,Prev : PMsg; + FileNext, + Equivalent : PMsg; + end; +Var + OrgFileName,DiffFileName : String; + OrgRoot,DiffRoot : PMsg; + OrgFirst,DiffFirst : PMsg; + Last : PMsg; + +const + NewFileName = 'new.msg'; + Is_interactive : boolean = false; + Auto_verbosity : boolean = false; + + +Procedure GetTranslation( p : PMsg); +var + s : string; + i,j,k : longint; +begin + i:=pos('_',p^.text); + if i>0 then + for j:=i+1 to Length(p^.text) do + if p^.text[j]='_' then + begin + i:=j; + break; + end; + if (i>0) and (i<=15) then + Writeln(P^.Enum,' type "',copy(p^.text,1,i-1),'" "',copy(p^.text,i+1,255),'"') + else + Writeln(P^.enum,' "',p^.text,'"'); + Writeln('Type translated error message in,'); + Writeln('Press return to keep it unchanged, or "q" to finish interactive mode'); + Readln(s); + if s='' then + exit; + if s='q' then + begin + Is_interactive:=false; + exit; + end; + j:=pos('_',s); + if j>0 then + for k:=j+1 to Length(s) do + if s[j]='_' then + begin + j:=k; + break; + end; + if (j>0) then + begin + if copy(p^.text,1,i)<>copy(s,1,j) then + Writeln('Warning : different verbosity !!'); + p^.text:=s; + end + else + p^.text:=copy(p^.text,1,i)+s; +end; + +Function NewMsg (Var RM : PMsg; L : Longint; Const E : TEnum;Const T : TText;C : pchar;NbLn,TxtLn : longint) : PMsg; + +Var + P,R : PMsg; + +begin + New(P); + with P^ do + begin + Line:=L; + Text:=T; + enum:=E; + comment:=c; + cnb:=NbLn; + ctxt:=TxtLn; + next:=Nil; + prev:=Nil; + filenext:=nil; + equivalent:=nil; + if assigned(last) then + last^.FileNext:=P; + last:=P; + end; + R:=RM; + While (R<>Nil) and (UpCase(R^.enum)>UpCase(P^.Enum)) do + begin + P^.Prev:=R; + R:=R^.next; + end; + if assigned(R) and (UpCase(R^.Enum)=UpCase(P^.Enum)) then + Writeln('Error ',R^.Enum,' duplicate'); + P^.Next:=R; + If R<>Nil then + R^.Prev:=P; + If P^.Prev<>Nil then + P^.Prev^.Next:=P + else + RM:=P; + NewMsg:=P; +end; + +Procedure PrintList(const name : string;R : PMsg); +var + P : PMsg; + f : text; +begin + P:=R; + Assign(f,name); + Rewrite(f); + while assigned(P) do + begin + Writeln(f,UpCase(P^.Enum)); + P:=P^.Next; + end; + Close(f); +end; + +Procedure Usage; + +begin + Writeln('Usage : msgdif [options] <org-file> <dif-file>'); + Writeln('Options:'); + Writeln(' -i allow to enter translated messages interactively'); + Writeln(' -y1 use <org-file> verbosity (do not query acknowledge)'); + Writeln(''); + Writeln('Generates "',NewFileName,'" that contain the messages from <dif-file>'); + Writeln('with a new messages from <org-file>'); + Writeln(''); + Writeln('Example:'); + Writeln(' msgdif errore.msg errorr.msg'); + halt(1) +end; + +Procedure ProcessOptions; +var + i,count : longint; +begin + Is_interactive:=false; + Auto_verbosity:=false; + + count:=paramcount; i:=1; + while (count>0) and (Paramstr(i)[1]='-') do + case UpCase(Paramstr(i)[2]) of + 'I': begin + Is_interactive:=true; + dec(count); Inc(i); + end; + 'Y': case Paramstr(i)[3] of + '1': begin + Auto_verbosity:=true; + dec(count); Inc(i); + end; + else + Writeln ('Error: unknown option ', Paramstr(i)); + Usage; + end; + else + Writeln ('Error: unknown option ', Paramstr(i)); + Usage; + end; + If Count<>2 then begin + Writeln ('Error: there must be exactly two message files'); + Usage; + end; + + OrgfileName:=Paramstr(i); + DiffFileName:=Paramstr(i+1); + if (OrgFileName=NewFileName) or (DiffFileName=NewFileName) then + begin + Writeln('The file names must be different from ',NewFileName); + Halt(1); + end; +end; + +Procedure ProcessFile (FileName : String; Var Root,First : PMsg); + +Const + ArrayLength = 65500; +Var F : Text; + S,prevS : String; + J,LineNo,Count,NbLn,TxtLn : Longint; + chararray : array[0..ArrayLength] of char; + currentindex : longint; + c : pchar; + multiline : boolean; +begin + Assign(F,FileName); + Reset(F); + Write ('Processing: ',Filename,'...'); + LineNo:=0; + NbLn:=0; + TxtLn:=0; + Count:=0; + currentindex:=0; + Root:=Nil; + First:=nil; + Last:=nil; + PrevS:=''; + multiline:=false; + While not eof(f) do + begin + Readln(F,S); + Inc(LineNo); + If multiline then + begin + PrevS:=PrevS+#10+S; Inc(TxtLn); + if (Length(S)<>0) and (S[1]=']') then + multiline:=false; + end + else + if (length(S)>0) and Not (S[1] in ['%','#']) Then + begin + J:=Pos('=',S); + If j<1 then + writeln (Filename,'(',LineNo,') : Invalid entry') + else + begin + chararray[currentindex]:=#0; + c:=strnew(@chararray); + if PrevS<>'' then + NewMsg(Root,LineNo,Copy(PrevS,1,Pos('=',PrevS)-1), + Copy(PrevS,Pos('=',PrevS)+1,Length(PrevS)),c,NbLn,TxtLn) + else + StrDispose(c); + currentindex:=0; + NbLn:=0; TxtLn:=0; + PrevS:=S; Inc(TxtLn); + if S[j+7]='[' then multiline:=true; + if First=nil then + First:=Root; + Inc(Count); + end; + end + else + begin + if currentindex+length(s)+1>ArrayLength then + Writeln('Comment too long : over ',ArrayLength,' chars') + else + begin + strpcopy(@chararray[currentindex],s+#10); + inc(currentindex,length(s)+1); + inc(NbLn); + end; + end; + end; + chararray[currentindex]:=#0; + c:=strnew(@chararray); + if PrevS<>'' then + NewMsg(Root,LineNo,Copy(PrevS,1,Pos('=',PrevS)-1), + Copy(PrevS,Pos('=',PrevS)+1,Length(PrevS)),c,NbLn,TxtLn); + Writeln (' Done. Read ',LineNo,' lines, got ',Count,' constants.'); + Close(f); +end; + +Procedure ShowDiff (POrg,PDiff : PMsg); + +Var + count,orgcount,diffcount : longint; + +Procedure NotFound (Org : Boolean; P : PMsg); + +begin + With P^ do + If Org Then + Writeln ('Not found in ',DiffFileName,' : ',Enum,' ',OrgFileName,'(',Line,')') + else + Writeln ('Extra in ',DiffFileName,'(',line,') : ',enum); + if org then + inc(orgcount) + else + inc(diffcount); +end; + +begin + orgcount:=0; + diffcount:=0; + count:=0; + While (Porg<>Nil) and (PDiff<>Nil) do + begin +// Writeln (POrg^.enum,'<=>',PDiff^.Enum); + If UpCase(Porg^.Enum)>UpCase(PDiff^.Enum) then + begin + NotFound (True,Porg); + POrg:=POrg^.Next + end + else If UpCase(POrg^.enum)=UpCase(PDiff^.Enum) then + begin + inc(count); + POrg^.Equivalent:=PDiff; + PDiff^.Equivalent:=POrg; + POrg:=POrg^.Next; + PDiff:=PDiff^.Next; + end + else + begin + NotFound (False,PDiff); + PDiff:=PDiff^.Next + end; + end; + While POrg<>Nil do + begin + NotFound(True,Porg); + POrg:=pOrg^.Next; + end; + While PDiff<>Nil do + begin + NotFound(False,PDiff); + PDiff:=PDiff^.Next; + end; + Writeln(count,' messages found in common to both files'); + Writeln(orgcount,' messages only in ',OrgFileName); + Writeln(diffcount,' messages only in ',DiffFileName); +end; + +type TArgSet = set of 0..31; + +function MsgToSet(const Msg, FileName: string; var R: TArgSet): Boolean; + var + i, j, num : integer; + code : word; + begin + R:=[]; + MsgToSet:=false; + for i:=1 to Length(Msg) do + if Msg[i]='$' then + begin + j:=i+1; + while Msg[j] in ['0'..'9'] do Inc(j); + if j > i+1 then + begin + val(copy(Msg,i+1,j-i-1),num,code); + if num > high(TArgSet) then begin + WriteLn('Error in ', FileName,': ', Msg); + WriteLn(' number at position ', i); + WriteLn(' must be LE ', high(TArgSet)); + Exit; + end; + R:=R+[num]; + end; + end; + MsgToSet:=true; + end; + + +procedure CheckParm(const s1, s2: string); + var + R1, R2: TArgSet; + begin + if MsgToSet(s1,OrgFileName, R1) <> true then Exit; + if MsgToSet(s2,DiffFileName,R2) <> true then Exit; + if R1<>R2 then begin + WriteLn('Error: set of arguments is different'); + WriteLn(' ',s1); + WriteLn(' ',s2); + end; + end; + +procedure WriteReorderedFile(FileName : string;orgnext,diffnext : PMsg); + var t,t2,t3 : text; + i,ntcount : longint; + j : integer; + s,s2,s3 : string; + is_msg : boolean; + nextdiffkept : pmsg; + begin + ntcount:=0; + Assign(t,FileName); + Rewrite(t); + Writeln(t,'%%% Reordering of ',DiffFileName,' respective to ',OrgFileName); + Writeln(t,'%%% Contains all comments from ',DiffFileName); + Assign(t2,DiffFileName); + Reset(t2); + Assign(t3,OrgFileName); + Reset(t3); + i:=2; + s:='';s3:=''; + nextdiffkept:=diffnext; + while assigned(nextdiffkept) and (nextdiffkept^.equivalent=nil) do + nextdiffkept:=nextdiffkept^.filenext; + { First write the header of diff } + repeat + Readln(t2,s); + is_msg:=(pos('=',s)>1) and (s[1]<>'%') and (s[1]<>'#'); + if not is_msg then + begin + Writeln(t,s); + inc(i); + end; + until is_msg; + { Write all messages in Org order } + while assigned(orgnext) do + begin + if not assigned(orgnext^.equivalent) then + begin + { Insert a new error msg with the english comments } + Writeln('New error ',orgnext^.enum,' added'); + If Is_interactive then + GetTranslation(orgnext); + Writeln(t,orgnext^.enum,'=',orgnext^.text); + inc(i,orgnext^.ctxt); + Write(t,orgnext^.comment); + inc(i,orgnext^.cnb); + end + else + begin + inc(i); + if orgnext^.text=orgnext^.equivalent^.text then + begin + Writeln(FileName,'(',i,') ',orgnext^.enum,' not translated'); + If Is_interactive then + GetTranslation(orgnext^.equivalent); + if orgnext^.text=orgnext^.equivalent^.text then + inc(ntcount); + end; + s2:=orgnext^.text; + j:=pos('_',copy(s2,7,20)) + 6; + s2:=upcase(copy(s2,1,j)); + s3:=orgnext^.equivalent^.text; + j:=pos('_',copy(s3,7,20)) + 6; + s3:=upcase(copy(s3,1,j)); + { that are the conditions in verbose unit } + if (length(s3)<12) and (s2<>s3) then + begin + Writeln('Warning: different options for ',orgnext^.enum); + Writeln(' ',orgnext^.text); + Writeln(' ',orgnext^.equivalent^.text); + s:='N'; + if Auto_verbosity then + s:='Y' + else + If Is_interactive then + begin + Write('Use ',s2,' verbosity ? [y/n] '); + Readln(s); + end; + if UpCase(s[1])='Y' then + begin + orgnext^.equivalent^.text:=s2+copy(orgnext^.equivalent^.text, + length(s3)+1,Length(orgnext^.equivalent^.text)); + WriteLn(' Using ', s2); + end; + end; + + CheckParm(orgnext^.text, orgnext^.equivalent^.text); + + Writeln(t,orgnext^.enum,'=',orgnext^.equivalent^.text); + Dec(i); Inc(i,orgnext^.equivalent^.ctxt); + if assigned(orgnext^.equivalent^.comment) and + (strlen(orgnext^.equivalent^.comment)>0) then + begin + Write(t,orgnext^.equivalent^.comment); + inc(i,orgnext^.equivalent^.cnb); + end + else if assigned(orgnext^.comment) and + (strlen(orgnext^.comment)>0) then + begin + Writeln('Comment from ',OrgFileName,' for enum ',orgnext^.enum,' added'); + Write(t,orgnext^.comment); + inc(i,orgnext^.cnb); + end; + end; + orgnext:=orgnext^.filenext; + end; + + while assigned(diffnext) do + begin + if not assigned(diffnext^.Equivalent) then + begin + { Skip removed enum in errore.msg} + { maybe a renaming of an enum !} + Writeln(diffnext^.enum,' commented out'); + Writeln(t,'%%% ',diffnext^.enum,'=',diffnext^.text); + inc(i,diffnext^.ctxt); + Write(t,diffnext^.comment); + inc(i,diffnext^.cnb); + end; + diffnext:=diffnext^.filenext; + end; + Close(t); + Close(t2); + Close(t3); + Writeln(ntcount,' not translated items found'); + end; + +begin + ProcessOptions; + ProcessFile(OrgFileName,orgroot,orgfirst); + ProcessFile(DiffFileName,diffRoot,difffirst); + PrintList('org.lst',OrgRoot); + PrintList('diff.lst',DiffRoot); + ShowDiff (OrgRoot,DiffRoot); + WriteReorderedFile(NewFileName,orgfirst,difffirst); +end. |