mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-12 21:29:43 +02:00
368 lines
7.3 KiB
ObjectPascal
368 lines
7.3 KiB
ObjectPascal
program FixTab;
|
|
uses Dos;
|
|
|
|
const
|
|
{Files}
|
|
InputExt='';
|
|
OutputExt='*';
|
|
|
|
|
|
var
|
|
{General}
|
|
InFile,
|
|
OutFile : string[80];
|
|
ParaFile : word;
|
|
{Specific}
|
|
const
|
|
TabSize : longint=8;
|
|
DosEol : boolean=false;
|
|
Verbose : boolean=false;
|
|
|
|
{****************************************************************************
|
|
Routines
|
|
****************************************************************************}
|
|
|
|
const
|
|
{$IFDEF LINUX}
|
|
PathCh='/';
|
|
{$ELSE}
|
|
PathCh='\';
|
|
{$ENDIF}
|
|
|
|
Function SplitPath(Const HStr:String):String;
|
|
var
|
|
i : byte;
|
|
begin
|
|
i:=Length(Hstr);
|
|
while (i>0) and (Hstr[i]<>PathCh) do
|
|
dec(i);
|
|
SplitPath:=Copy(Hstr,1,i);
|
|
end;
|
|
|
|
|
|
|
|
Function SplitFileName(Const HStr:String):String;
|
|
var
|
|
i : byte;
|
|
begin
|
|
i:=Length(Hstr);
|
|
while (i>0) and (Hstr[i]<>PathCh) do
|
|
dec(i);
|
|
SplitFileName:=Copy(Hstr,i+1,255);
|
|
end;
|
|
|
|
|
|
|
|
Function SplitName(Const HStr:String):String;
|
|
var
|
|
i,j : byte;
|
|
begin
|
|
i:=Length(Hstr);
|
|
j:=i;
|
|
while (i>0) and (Hstr[i]<>PathCh) do
|
|
dec(i);
|
|
while (j>0) and (Hstr[j]<>'.') do
|
|
dec(j);
|
|
if j<=i then
|
|
j:=255;
|
|
SplitName:=Copy(Hstr,i+1,j-(i+1));
|
|
end;
|
|
|
|
|
|
|
|
Function SplitExtension(Const HStr:String):String;
|
|
var
|
|
j,i : byte;
|
|
begin
|
|
i:=Length(Hstr);
|
|
j:=i;
|
|
while (i>0) and (Hstr[i]<>PathCh) do
|
|
dec(i);
|
|
while (j>0) and (Hstr[j]<>'.') do
|
|
dec(j);
|
|
if j<=i then
|
|
j:=254;
|
|
SplitExtension:=Copy(Hstr,j+1,255);
|
|
end;
|
|
|
|
|
|
|
|
Function ChangeFileExt(Const HStr,ext:String):String;
|
|
begin
|
|
if (Ext<>'') and (SplitExtension(HStr)='') then
|
|
ChangeFileExt:=Hstr+'.'+Ext
|
|
else
|
|
ChangeFileExt:=Hstr;
|
|
end;
|
|
|
|
|
|
|
|
Function ForceExtension(Const HStr,ext:String):String;
|
|
var
|
|
j : byte;
|
|
begin
|
|
j:=length(Hstr);
|
|
while (j>0) and (Hstr[j]<>'.') do
|
|
dec(j);
|
|
if j=0 then
|
|
j:=255;
|
|
ForceExtension:=Copy(Hstr,1,j-1)+'.'+Ext;
|
|
end;
|
|
|
|
|
|
function UCase(Const Hstr:string):string;
|
|
var
|
|
i : byte;
|
|
begin
|
|
for i:=1to Length(Hstr) do
|
|
UCase[i]:=Upcase(Hstr[i]);
|
|
UCase[0]:=chr(Length(Hstr));
|
|
end;
|
|
|
|
|
|
|
|
Function ESpace(HStr:String;len:byte):String;
|
|
begin
|
|
while length(Hstr)<Len do
|
|
begin
|
|
inc(byte(Hstr[0]));
|
|
Hstr[Length(Hstr)]:=' ';
|
|
end;
|
|
ESpace:=Hstr;
|
|
end;
|
|
|
|
{****************************************************************************
|
|
Main Stuff
|
|
****************************************************************************}
|
|
|
|
var
|
|
Done : array[0..1023] of string[32];
|
|
Total : word;
|
|
Function FileDone(const fn:string):boolean;
|
|
var
|
|
i : word;
|
|
begin
|
|
i:=0;
|
|
while (i<Total) and (Done[i]<>fn) do
|
|
inc(i);
|
|
if Done[i]=fn then
|
|
FileDone:=true
|
|
else
|
|
begin
|
|
Done[Total]:=fn;
|
|
inc(Total);
|
|
FileDone:=false;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
procedure Convert(fn,nfn:string);
|
|
type
|
|
inbuftype=array[0..31999] of char;
|
|
outbuftype=array[0..63999] of char;
|
|
var
|
|
f,g : file;
|
|
inbuf : ^inbuftype;
|
|
outbuf : ^outbuftype;
|
|
Curr,
|
|
TabCol,
|
|
col,
|
|
i,last,
|
|
innum,
|
|
outnum : longint;
|
|
|
|
procedure WriteBuf;
|
|
begin
|
|
if i>last then
|
|
begin
|
|
move(InBuf^[last],OutBuf^[OutNum],i-last);
|
|
inc(OutNum,(i-last));
|
|
end;
|
|
Last:=i+1;
|
|
end;
|
|
|
|
begin
|
|
{Create New FileName}
|
|
if SplitExtension(nfn)='*' then
|
|
nfn:=ChangeFileExt(SplitPath(nfn)+SplitName(nfn),SplitExtension(fn));
|
|
if SplitName(nfn)='*' then
|
|
begin
|
|
if SplitPath(nfn)='' then
|
|
nfn:=ChangeFileExt(SplitPath(fn)+SplitName(fn),SplitExtension(nfn))
|
|
else
|
|
nfn:=ChangeFileExt(SplitPath(nfn)+SplitName(fn),SplitExtension(nfn));
|
|
end;
|
|
{Done?}
|
|
if FileDone(nfn) then
|
|
exit;
|
|
{Open Files}
|
|
Write('Converting '+ESpace(fn,30)+' ');
|
|
if fn=nfn then
|
|
assign(g,ForceExtension(fn,'$T$'))
|
|
else
|
|
begin
|
|
Write('-> '+ESpace(nfn,30)+' ');
|
|
assign(g,nfn);
|
|
end;
|
|
new(inbuf);
|
|
new(outbuf);
|
|
assign(f,fn);
|
|
{$push}{$I-}
|
|
reset(f,1);
|
|
{$pop}
|
|
if ioresult<>0 then
|
|
exit;
|
|
{$push}{$I-}
|
|
rewrite(g,1);
|
|
{$pop}
|
|
if ioresult<>0 then
|
|
begin
|
|
close(f);
|
|
exit;
|
|
end;
|
|
Curr:=0;
|
|
col:=1;
|
|
last:=0;
|
|
repeat
|
|
blockread(f,InBuf^,sizeof(InBufType),innum);
|
|
outnum:=0;
|
|
if innum>0 then
|
|
begin
|
|
i:=0;
|
|
while (i<innum) do
|
|
begin
|
|
case InBuf^[i] of
|
|
#9 : begin
|
|
WriteBuf;
|
|
OutBuf^[OutNum]:=' ';
|
|
inc(OutNum);
|
|
inc(Col);
|
|
TabCol:=(((Col-1) div TabSize)+1)*TabSize;
|
|
while (Col<TabCol) do
|
|
begin
|
|
OutBuf^[OutNum]:=' ';
|
|
inc(OutNum);
|
|
inc(Col);
|
|
end;
|
|
end;
|
|
#13 : begin
|
|
WriteBuf;
|
|
while (outnum>0) and (outbuf^[outnum-1] in [' ',#9]) do
|
|
dec(outnum);
|
|
end;
|
|
#10 : begin
|
|
WriteBuf;
|
|
while (outnum>0) and (outbuf^[outnum-1] in [' ',#9]) do
|
|
dec(outnum);
|
|
if DosEol then
|
|
begin
|
|
OutBuf^[OutNum]:=#13;
|
|
inc(OutNum);
|
|
end;
|
|
OutBuf^[OutNum]:=#10;
|
|
inc(OutNum);
|
|
col:=0;
|
|
inc(Curr);
|
|
if (curr and 31)=0 then
|
|
Write(Curr:5,#8#8#8#8#8);
|
|
end;
|
|
else
|
|
inc(col);
|
|
end;
|
|
inc(i);
|
|
end;
|
|
WriteBuf;
|
|
last:=0;
|
|
end;
|
|
blockwrite(g,OutBuf^,outnum);
|
|
until innum=0;
|
|
WriteLn(Curr,' Lines');
|
|
close(g);
|
|
close(f);
|
|
if fn=nfn then
|
|
begin
|
|
erase(f);
|
|
rename(g,fn);
|
|
end;
|
|
dispose(outbuf);
|
|
dispose(inbuf);
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
General Stuff
|
|
****************************************************************************}
|
|
|
|
procedure getpara;
|
|
var
|
|
ch : char;
|
|
para : string[128];
|
|
i,j : word;
|
|
|
|
procedure helpscreen;
|
|
begin
|
|
writeln('Usage : '+SplitName(ParamStr(0))+' [Options] <InFile(s)>'#10);
|
|
writeln('<Options> can be : -O<OutFile> Specify OutFile Mask');
|
|
WriteLn(' -D Use MsDos #13#10 Eols');
|
|
writeln(' -T<size> Set Size of Tabs');
|
|
writeln(' -V be more verbose');
|
|
writeln(' -? or -H This HelpScreen');
|
|
halt(1);
|
|
end;
|
|
|
|
begin
|
|
for i:=1to paramcount do
|
|
begin
|
|
para:=ucase(paramstr(i));
|
|
if (para[1]='-') then
|
|
begin
|
|
ch:=para[2];
|
|
delete(para,1,2);
|
|
case ch of
|
|
'O' : OutFile:=ChangeFileExt(Para,OutputExt);
|
|
'D' : DosEol:=true;
|
|
'T' : Val(Para,TabSize,j);
|
|
'V' : verbose:=true;
|
|
'?','H' : helpscreen;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if ParaFile=0 then
|
|
ParaFile:=i;
|
|
end;
|
|
end;
|
|
if (ParaFile=0) then
|
|
HelpScreen;
|
|
if OutFile='' then
|
|
OutFile:=ForceExtension('*',OutPutExt);
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
Dir : SearchRec;
|
|
i : word;
|
|
begin
|
|
GetPara;
|
|
{Main}
|
|
if Verbose then
|
|
begin
|
|
Writeln('fixtab v1.01 (C) 1999-2002 Peter Vreman');
|
|
Writeln('TabSize ',TabSize);
|
|
if DosEol then
|
|
WriteLn('Using MsDos Eols');
|
|
end;
|
|
for i:=ParaFile to ParamCount do
|
|
begin
|
|
InFile:=ChangeFileExt(ParamStr(i),InputExt);
|
|
FindFirst(InFile,$20,Dir);
|
|
while (DosError=0) do
|
|
begin
|
|
Convert(SplitPath(InFile)+Dir.Name,OutFile);
|
|
FindNext(Dir);
|
|
end;
|
|
end;
|
|
end.
|