diff options
Diffstat (limited to 'compiler/utils/msg2inc.pp')
| -rw-r--r-- | compiler/utils/msg2inc.pp | 815 |
1 files changed, 815 insertions, 0 deletions
diff --git a/compiler/utils/msg2inc.pp b/compiler/utils/msg2inc.pp new file mode 100644 index 0000000000..905d530952 --- /dev/null +++ b/compiler/utils/msg2inc.pp @@ -0,0 +1,815 @@ +{ + This program is part of the Free Pascal run time library. + Copyright (c) 1998-2002 by Peter Vreman + + Convert a .msg file to an .inc file with a const array of char + And for the lazy docwriters it can also generate some TeX output + + 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. + + **********************************************************************} +program msg2inc; +uses + strings; + +{$ifdef unix} + {$define EOL_ONE_CHAR} +{$endif unix} +{$ifdef amiga} + {$define EOL_ONE_CHAR} +{$endif amiga} +{$ifdef morphos} + {$define EOL_ONE_CHAR} +{$endif} +{$ifdef macos} + {$define EOL_ONE_CHAR} +{$endif} + +const + version='1.00'; +{$ifdef EOL_ONE_CHAR} + eollen=1; +{$else} + eollen=2; +{$endif} + msgparts = 20; + +type + TMode=(M_Char,M_Tex,M_Intel,M_String,M_Renumber); +var + InFile, + OutFile, + OutName : string; + Mode : TMode; + TexHeader : boolean; + + MsgTxt : pchar; + EnumTxt : pchar; + enumsize, + msgsize : longint; + + msgidxmax : array[1..msgparts] of longint; + msgs : array[0..msgparts,0..999] of boolean; + +procedure LoadMsgFile(const fn:string); +var + f : text; + error, + multiline : boolean; + code : word; + numpart,numidx, + line,i,j,num : longint; + ptxt, + penum : pchar; + number, + s,s1 : string; + + procedure err(const msgstr:string); + begin + writeln('error in line ',line,': ',msgstr); + error:=true; + end; + +begin + Writeln('Loading messagefile ',fn); +{Read the message file} + assign(f,fn); + {$I-} + reset(f); + {$I+} + if ioresult<>0 then + begin + WriteLn('fatal error: '+fn+' not found'); + halt(1); + end; +{ First parse the file and count bytes needed } + fillchar(msgidxmax,sizeof(msgidxmax),0); + fillchar(msgs,sizeof(msgs),0); + error:=false; + line:=0; + multiline:=false; + msgsize:=0; + while not eof(f) do + begin + readln(f,s); + inc(line); + if multiline then + begin + if s=']' then + multiline:=false + else + inc(msgsize,length(s)+1); { +1 for linebreak } + end + else + begin + if (s<>'') and not(s[1] in ['#',';','%']) then + begin + i:=pos('=',s); + if i>0 then + begin + j:=i+1; + if not(s[j] in ['0'..'9']) then + err('no number found') + else + begin + while (s[j] in ['0'..'9']) do + inc(j); + end; + if j-i-1<>5 then + err('number length is not 5'); + number:=Copy(s,i+1,j-i-1); + { update the max index } + val(number,num,code); + numpart:=num div 1000; + if numpart=0 then + err('number should be > 1000'); + numidx:=num mod 1000; + { duplicate ? } + if msgs[numpart,numidx] then + err('duplicate number found'); + msgs[numpart,numidx]:=true; + { check range } + if numpart > msgparts then + err('number is to large') + else + if numidx > msgidxmax[numpart] then + msgidxmax[numpart]:=numidx; + if s[j+1]='[' then + begin + inc(msgsize,j-i); + multiline:=true + end + else + inc(msgsize,length(s)-i+1); + inc(enumsize,j); + end + else + err('no = found'); + end; + end; + end; + if multiline then + err('still in multiline mode'); + if error then + begin + close(f); + writeln('aborting'); + halt(1); + end; +{ alloc memory } + getmem(msgtxt,msgsize); + ptxt:=msgtxt; + getmem(enumtxt,enumsize); + penum:=enumtxt; +{ now read the buffer in mem } + reset(f); + while not eof(f) do + begin + readln(f,s); + if multiline then + begin + if s=']' then + begin + multiline:=false; + { overwrite last eol } + dec(ptxt); + ptxt^:=#0; + inc(ptxt); + end + else + begin + move(s[1],ptxt^,length(s)); + inc(ptxt,length(s)); + ptxt^:=#10; + inc(ptxt); + end; + end + else + begin + if (s<>'') and not(s[1] in ['#',';','%']) then + begin + i:=pos('=',s); + if i>0 then + begin + j:=i+1; + while (s[j] in ['0'..'9']) do + inc(j); + {enum} + move(s[1],penum^,i-1); + inc(penum,i-1); + penum^:='='; + inc(penum); + number:=Copy(s,i+1,j-i-1); + move(number[1],penum^,length(number)); + inc(penum,length(number)); + penum^:=#0; + inc(penum); + { multiline start then no txt } + if s[j+1]='[' then + begin + s1:=Copy(s,i+1,j-i); + move(s1[1],ptxt^,length(s1)); + inc(ptxt,length(s1)); + multiline:=true; + end + else + begin + { txt including number } + s1:=Copy(s,i+1,255); + move(s1[1],ptxt^,length(s1)); + inc(ptxt,length(s1)); + ptxt^:=#0; + inc(ptxt); + end; + end; + end; + end; + end; + close(f); +end; + + +{***************************************************************************** + WriteEnumFile +*****************************************************************************} + +procedure WriteEnumFile(const fn,typename:string); +var + t : text; + i : longint; + p : pchar; + start : boolean; +begin + writeln('Writing enumfile '+fn); +{Open textfile} + assign(t,fn); + rewrite(t); + writeln(t,'const'); +{Parse buffer in msgbuf and create indexs} + p:=enumtxt; + start:=true; + for i:=1 to enumsize do + begin + if start then + begin + write(t,' '); + start:=false; + end; + if p^=#0 then + begin + writeln(t,';'); + start:=true; + end + else + begin + write(t,p^); + end; + inc(p); + end; + writeln(t,''); + { msgtxt size } + writeln(t,' MsgTxtSize = ',msgsize,';'); + writeln(t,''); + { max msg idx table } + writeln(t,' MsgIdxMax : array[1..20] of longint=('); + write(t,' '); + for i:=1 to 20 do + begin + write(t,msgidxmax[i]+1); + if i<20 then + write(t,','); + if i=10 then + begin + writeln(t,''); + write(t,' '); + end; + end; + writeln(t,''); + writeln(t,' );'); + close(t); +end; + + +{***************************************************************************** + WriteStringFile +*****************************************************************************} + +procedure WriteStringFile(const fn,constname:string); +const + maxslen=240; { to overcome aligning problems } + + function l0(l:longint):string; + var + s : string[16]; + begin + str(l,s); + while (length(s)<5) do + s:='0'+s; + l0:=s; + end; + +var + t : text; + f : file; + slen, + len,i : longint; + p : pchar; + s : string; + start, + quote : boolean; +begin + writeln('Writing stringfile ',fn); +{Open textfile} + assign(t,fn); + rewrite(t); + writeln(t,'{$ifdef Delphi}'); + writeln(t,'const '+constname+' : array[0..000000] of string[',maxslen,']=('); + writeln(t,'{$else Delphi}'); + writeln(t,'const '+constname+' : array[0..000000,1..',maxslen,'] of char=('); + write(t,'{$endif Delphi}'); +{Parse buffer in msgbuf and create indexs} + p:=msgtxt; + slen:=0; + len:=0; + quote:=false; + start:=true; + for i:=1 to msgsize do + begin + if slen>=maxslen then + begin + if quote then + begin + write(t,''''); + quote:=false; + end; + write(t,','); + slen:=0; + inc(len); + end; + if (len>70) or (start) then + begin + if quote then + begin + write(t,''''); + quote:=false; + end; + if slen>0 then + writeln(t,'+') + else + writeln(t); + len:=0; + start:=false; + end; + if (len=0) then + write(t,' '); + if (ord(p^)>=32) and (p^<>#39) then + begin + if not quote then + begin + write(t,''''); + quote:=true; + inc(len); + end; + write(t,p^); + inc(len); + end + else + begin + if quote then + begin + write(t,''''); + inc(len); + quote:=false; + end; + write(t,'#'+chr(ord(p^) div 100+48)+chr((ord(p^) mod 100) div 10+48)+chr(ord(p^) mod 10+48)); + inc(len,3); + end; + if p^ in [#0,#10] then + start:=true; + inc(slen); + inc(p); + end; + if quote then + write(t,''''); + writeln(t,''); + writeln(t,');'); + close(t); +{update arraysize} + s:=l0(msgsize div maxslen); { we start with 0 } + assign(f,fn); + reset(f,1); + seek(f,34+eollen+length(constname)); + blockwrite(f,s[1],5); + seek(f,90+3*eollen+2*length(constname)); + blockwrite(f,s[1],5); + close(f); +end; + + +{***************************************************************************** + WriteCharFile +*****************************************************************************} + +procedure WriteCharFile(const fn,constname:string); + + function l0(l:longint):string; + var + s : string[16]; + begin + str(l,s); + while (length(s)<5) do + s:='0'+s; + l0:=s; + end; + + function createconst(b:byte):string; + begin + if (b in [32..127]) and (b<>39) then + createconst:=''''+chr(b)+'''' + else + createconst:='#'+chr(b div 100+48)+chr((b mod 100) div 10+48)+chr(b mod 10+48) + end; + +var + t : text; + f : file; + cidx,i : longint; + p : pchar; + s : string; +begin + writeln('Writing charfile '+fn); +{Open textfile} + assign(t,fn); + rewrite(t); + writeln(t,'const ',constname,' : array[1..00000] of char=('); +{Parse buffer in msgbuf and create indexs} + p:=msgtxt; + cidx:=0; + for i:=1to msgsize do + begin + if cidx=15 then + begin + if cidx>0 then + writeln(t,',') + else + writeln(t,''); + write(t,' '); + cidx:=0; + end + else + if cidx>0 then + write(t,',') + else + write(t,' '); + write(t,createconst(ord(p^))); + inc(cidx); + inc(p); + end; + writeln(t,');'); + close(t); +{update arraysize} + s:=l0(msgsize); + assign(f,fn); + reset(f,1); + seek(f,18+length(constname)); + blockwrite(f,s[1],5); + close(f); +end; + + +{***************************************************************************** + WriteIntelFile +*****************************************************************************} + +procedure WriteIntelFile(const fn,constname:string); +var + t : text; + len,i : longint; + p : pchar; + start, + quote : boolean; +begin + writeln('Writing Intelfile ',fn); +{Open textfile} + assign(t,fn); + rewrite(t); + writeln(t,'procedure '+constname+';assembler;'); + writeln(t,'asm'); +{Parse buffer in msgbuf and create indexs} + p:=msgtxt; + len:=0; + start:=true; + quote:=false; + for i:=1to msgsize do + begin + if len>70 then + begin + if quote then + begin + write(t,''''); + quote:=false; + end; + writeln(t,''); + start:=true; + end; + if start then + begin + write(t,' db '''); + len:=0; + quote:=true; + end; + if (ord(p^)>=32) and (p^<>#39) then + begin + if not quote then + begin + write(t,','''); + quote:=true; + inc(len); + end; + write(t,p^); + inc(len); + end + else + begin + if quote then + begin + write(t,''''); + inc(len); + quote:=false; + end; + write(t,','+chr(ord(p^) div 100+48)+chr((ord(p^) mod 100) div 10+48)+chr(ord(p^) mod 10+48)); + inc(len,4); + end; + inc(p); + end; + if quote then + write(t,''''); + writeln(t,''); + writeln(t,'end;'); + close(t); +end; + + +{***************************************************************************** + RenumberFile +*****************************************************************************} + +procedure RenumberFile(const fn,name:string); +var + f,t : text; + i : longint; + s,s1 : string; +begin + Writeln('Renumbering ',fn); +{Read the message file} + assign(f,fn); + {$I-} + reset(f); + {$I+} + if ioresult<>0 then + begin + WriteLn('*** message file '+fn+' not found ***'); + exit; + end; + assign(t,'msg2inc.$$$'); + rewrite(t); + i:=0; + while not eof(f) do + begin + readln(f,s); + if (copy(s,1,length(Name))=Name) and (s[3] in ['0'..'9']) then + begin + inc(i); + str(i,s1); + while length(s1)<3 do + s1:='0'+s1; + writeln(t,Name+s1+Copy(s,6,255)); + end + else + writeln(t,s); + end; + close(t); + close(f); +{ rename new file } + erase(f); + rename(t,fn); +end; + + +{***************************************************************************** + WriteTexFile +*****************************************************************************} + +Function EscapeString (Const S : String) : String; +Var + I : longint; + hs : string; +begin + hs:=''; + for i:=1 to length(s) do + if (S[i]='$') then + begin + if (s[i+1] in ['0'..'9']) then + hs:=hs+'arg' + else + hs:=hs+'\$'; + end + else + hs:=hs+s[i]; + EscapeString:=hs; +end; + +procedure WriteTexFile(const infn,outfn:string); +var + t,f : text; + line, + i,k : longint; + s,s1 : string; + texoutput : boolean; +begin + Writeln('Loading messagefile ',infn); + writeln('Writing TeXfile ',outfn); +{ Open infile } + assign(f,infn); + {$I-} + reset(f); + {$I+} + if ioresult<>0 then + begin + WriteLn('*** message file '+infn+' not found ***'); + exit; + end; +{ Open outfile } + assign(t,outfn); + rewrite(t); + If texheader then + begin + writeln (t,'\documentclass{article}'); + writeln (t,'\usepackage{html}'); + writeln (t,'\usepackage{fpc}'); + writeln (t,'\begin{document}'); + end; +{ Parse } + line:=0; + TexOutput:=False; + while not eof(f) do + begin + readln(f,s); + inc(line); + If Pos ('# BeginOfTeX',S)=1 then + TexOutPut:=True + else if pos ('# EndOfTeX',S)=1 then + TexOutPut:=False; + if (s<>'') and not(s[1] in ['#',';']) and TeXOutPut then + begin + if s[1]='%' then + begin + Delete(s,1,1); + writeln(t,s); + end + else + begin + i:=pos('=',s); + if i>0 then + begin + inc(i); + while s[i] in ['0'..'9'] do + inc(i); + inc(i); + s1:=''; + k:=0; + while (k<5) and (s[i+k]<>'_') do + begin + case s[i+k] of + 'W' : s1:='Warning: '; + 'E' : s1:='Error: '; + 'F' : s1:='Fatal: '; + 'N' : s1:='Note: '; + 'I' : s1:='Info: '; + 'H' : s1:='Hint: '; + end; + inc(k); + end; + if s[i+k]='_' then + inc(i,k+1); + writeln(t,'\item ['+s1+escapestring(Copy(s,i,255))+']'); + end + else + writeln('error in line: ',line,' skipping'); + end; + end; + end; + If TexHeader then + writeln (t,'\end{document}'); + close(t); + close(f); +end; + + +{***************************************************************************** + Main Program +*****************************************************************************} + +procedure getpara; +var + ch : char; + para : string; + files,i : word; + + procedure helpscreen; + begin + writeln('usage : msg2inc [Options] <msgfile> <incfile> <constname>'); + writeln('<Options> can be : -T Create .doc TeX file'); + writeln(' -TS Create .doc TeX file (stand-alone)'); + writeln(' -I Intel style asm output'); + writeln(' -S array of string'); + writeln(' -C array of char'); + writeln(' -R renumber section <incfile>'); + writeln(' -V Show version'); + writeln(' -? or -H This HelpScreen'); + halt(1); + end; + +begin + Mode:=M_String; + FIles:=0; + for i:=1to paramcount do + begin + para:=paramstr(i); + if (para[1]='-') then + begin + ch:=upcase(para[2]); + delete(para,1,2); + case ch of + 'T' : begin + case upcase(para[1]) of + 'S' : TexHeader:=True; + end; + Mode:=M_Tex; + end; + 'I' : Mode:=M_Intel; + 'S' : Mode:=M_String; + 'C' : Mode:=M_Char; + 'R' : Mode:=M_Renumber; + 'V' : begin + Writeln('Msg2Inc ',version,' for Free Pascal (C) 1998-2002 Peter Vreman'); + Writeln; + Halt; + end; + '?','H' : helpscreen; + end; + end + else + begin + inc(Files); + if Files>3 then + HelpScreen; + case Files of + 1 : InFile:=Para; + 2 : OutFile:=Para; + 3 : OutName:=Para; + end; + end; + end; + case Mode of + M_Renumber, + M_Tex : if Files<2 then + Helpscreen; + else + if FIles<3 then + HelpScreen; + end; +end; + + +begin + GetPara; + case Mode of + M_Renumber : begin + Renumberfile(Infile,OutFile); + end; + M_Tex : begin + WriteTexFile(InFile,Outfile); + end; + M_Intel : begin + Loadmsgfile(InFile); + WriteEnumFile(OutFile+'idx.inc',OutName+'const'); + WriteIntelFile(OutFile+'txt.inc',OutName+'txt'); + end; + M_String : begin + Loadmsgfile(InFile); + WriteEnumFile(OutFile+'idx.inc',OutName+'const'); + WriteStringFile(OutFile+'txt.inc',OutName+'txt'); + end; + M_Char : begin + Loadmsgfile(InFile); + WriteEnumFile(OutFile+'idx.inc',OutName+'const'); + WriteCharFile(OutFile+'txt.inc',OutName+'txt'); + end; + end; +end. |