mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 04:59:26 +02:00
* obsolete and broken programs
git-svn-id: trunk@9190 -
This commit is contained in:
peter
parent
a5ccf16016
commit
232f0d2941
6
.gitattributes
vendored
6
.gitattributes
vendored
@ -2191,12 +2191,6 @@ packages/extra/graph/win32/winmouse.pp svneol=native#text/plain
|
||||
packages/extra/gtk/Makefile svneol=native#text/plain
|
||||
packages/extra/gtk/Makefile.fpc svneol=native#text/plain
|
||||
packages/extra/gtk/README -text
|
||||
packages/extra/gtk/conv/fixexmcdecl.pp svneol=native#text/plain
|
||||
packages/extra/gtk/conv/fixgdk.pp svneol=native#text/plain
|
||||
packages/extra/gtk/conv/fixgdkcdecl.pp svneol=native#text/plain
|
||||
packages/extra/gtk/conv/fixglibcdecl.pp svneol=native#text/plain
|
||||
packages/extra/gtk/conv/fixgtk.pp svneol=native#text/plain
|
||||
packages/extra/gtk/conv/fixgtkcdecl.pp svneol=native#text/plain
|
||||
packages/extra/gtk/examples/Makefile svneol=native#text/plain
|
||||
packages/extra/gtk/examples/Makefile.fpc svneol=native#text/plain
|
||||
packages/extra/gtk/examples/clist.pp svneol=native#text/plain
|
||||
|
||||
7
.gitignore
vendored
7
.gitignore
vendored
@ -881,13 +881,6 @@ packages/extra/gtk/*.exe
|
||||
packages/extra/gtk/*.o
|
||||
packages/extra/gtk/*.ppu
|
||||
packages/extra/gtk/*.s
|
||||
packages/extra/gtk/conv/*.bak
|
||||
packages/extra/gtk/conv/*.exe
|
||||
packages/extra/gtk/conv/*.o
|
||||
packages/extra/gtk/conv/*.ppu
|
||||
packages/extra/gtk/conv/*.s
|
||||
packages/extra/gtk/conv/fpcmade.*
|
||||
packages/extra/gtk/conv/units
|
||||
packages/extra/gtk/examples/*.bak
|
||||
packages/extra/gtk/examples/*.exe
|
||||
packages/extra/gtk/examples/*.o
|
||||
|
||||
@ -1,193 +0,0 @@
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
|
||||
uses
|
||||
sysutils;
|
||||
|
||||
Function PosIdx (Const Substr : AnsiString; Const Source : AnsiString;i:longint) : Longint;
|
||||
var
|
||||
S : String;
|
||||
begin
|
||||
PosIdx:=0;
|
||||
if Length(SubStr)=0 then
|
||||
exit;
|
||||
while (i <= length (Source) - length (substr)) do
|
||||
begin
|
||||
inc (i);
|
||||
S:=copy(Source,i,length(Substr));
|
||||
if S=SubStr then
|
||||
exit(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function trimspace(const s:string):string;
|
||||
var
|
||||
i,j : longint;
|
||||
begin
|
||||
i:=length(s);
|
||||
while (i>0) and (s[i] in [#9,' ']) do
|
||||
dec(i);
|
||||
j:=1;
|
||||
while (j<i) and (s[j] in [#9,' ']) do
|
||||
inc(j);
|
||||
trimspace:=Copy(s,j,i-j+1);
|
||||
end;
|
||||
|
||||
function trimbegin(const s:string):string;
|
||||
var
|
||||
i,j : longint;
|
||||
begin
|
||||
i:=length(s);
|
||||
j:=1;
|
||||
while (j<i) and (s[j] in [#9,' ']) do
|
||||
inc(j);
|
||||
trimbegin:=Copy(s,j,i-j+1);
|
||||
end;
|
||||
|
||||
procedure Replace(var s:string;const s1,s2:string);
|
||||
var
|
||||
last,
|
||||
i : longint;
|
||||
begin
|
||||
last:=0;
|
||||
repeat
|
||||
i:=posidx(s1,uppercase(s),last);
|
||||
if (i>0) then
|
||||
begin
|
||||
Delete(s,i,length(s1));
|
||||
Insert(s2,s,i);
|
||||
last:=i+1;
|
||||
end;
|
||||
until (i=0);
|
||||
end;
|
||||
|
||||
procedure Conv(const fn: string);
|
||||
var
|
||||
t,f : text;
|
||||
lasts,funcname,
|
||||
s,ups : string;
|
||||
k,i,j : integer;
|
||||
gotisfunc,
|
||||
impl : boolean;
|
||||
begin
|
||||
writeln('processing ',fn);
|
||||
assign(t,fn);
|
||||
assign(f,'fixgdk.tmp');
|
||||
reset(t);
|
||||
rewrite(f);
|
||||
funcname:='';
|
||||
gotisfunc:=false;
|
||||
impl:=false;
|
||||
while not eof(t) do
|
||||
begin
|
||||
readln(t,s);
|
||||
|
||||
Replace(s,'PROCEDURE','procedure');
|
||||
Replace(s,'FUNCTION','function');
|
||||
Replace(s,'FUNCTION ','function ');
|
||||
Replace(s,'PPG','PPG');
|
||||
Replace(s,'PG','PG');
|
||||
Replace(s,'GCHAR','gchar');
|
||||
Replace(s,'GUCHAR','guchar');
|
||||
Replace(s,'GINT','gint');
|
||||
Replace(s,'GUINT','guint');
|
||||
Replace(s,'GBOOL','gbool');
|
||||
Replace(s,'GSHORT','gshort');
|
||||
Replace(s,'GUSHORT','gushort');
|
||||
Replace(s,'GLONG','glong');
|
||||
Replace(s,'GULONG','gulong');
|
||||
Replace(s,'GFLOAT','gfloat');
|
||||
Replace(s,'GDOUBLE','gdouble');
|
||||
Replace(s,'GPOINTER','gpointer');
|
||||
Replace(s,'GCONSTPOINTER','gconstpointer');
|
||||
Replace(s,'GDK','Gdk');
|
||||
Replace(s,'GDK_','gdk_');
|
||||
Replace(s,'GTK','Gtk');
|
||||
Replace(s,'GTK_','gtk_');
|
||||
|
||||
ups:=UpperCase(s);
|
||||
|
||||
if Pos('IMPLEMENTATION',ups)>0 then
|
||||
impl:=true;
|
||||
|
||||
i:=Pos('PROCEDURE',ups);
|
||||
if i>0 then
|
||||
if Pos('_PROCEDURE',ups)>0 then
|
||||
i:=0;
|
||||
if i=0 then
|
||||
begin
|
||||
i:=Pos('FUNCTION',ups);
|
||||
if Pos('_FUNCTION',ups)>0 then
|
||||
i:=0;
|
||||
end;
|
||||
if i<>0 then
|
||||
begin
|
||||
{ Remove Spaces }
|
||||
j:=PosIdx(' ',s,i);
|
||||
while (j>0) do
|
||||
begin
|
||||
Delete(s,j,1);
|
||||
i:=j-1;
|
||||
j:=PosIdx(' ',s,i);
|
||||
end;
|
||||
ups:=UpperCase(s);
|
||||
{ Fix Cdecl }
|
||||
if (Pos('g_',s)<>0) or
|
||||
((i>2) and (s[i-2] in [':','='])) then
|
||||
begin
|
||||
j:=Pos('CDECL;',ups);
|
||||
if j=0 then
|
||||
j:=Length(s)+1
|
||||
else
|
||||
begin
|
||||
k:=Pos('{$IFNDEF WIN32}CDECL;{$ENDIF}',ups);
|
||||
if k>0 then
|
||||
begin
|
||||
j:=k;
|
||||
k:=29;
|
||||
end
|
||||
else
|
||||
begin
|
||||
k:=Pos('{$IFDEF WIN32}STDCALL;{$ELSE}CDECL;{$ENDIF}',ups);
|
||||
if k>0 then
|
||||
begin
|
||||
j:=k;
|
||||
k:=43;
|
||||
end
|
||||
else
|
||||
k:=6;
|
||||
end;
|
||||
Delete(s,j,k);
|
||||
end;
|
||||
Insert('cdecl;',s,j);
|
||||
end;
|
||||
ups:=UpperCase(s);
|
||||
end;
|
||||
|
||||
{ Align function with procedure }
|
||||
if Copy(s,1,8)='function' then
|
||||
Insert(' ',s,9);
|
||||
|
||||
lasts:=s;
|
||||
writeln(f,s);
|
||||
end;
|
||||
close(f);
|
||||
close(t);
|
||||
erase(t);
|
||||
rename(f,fn);
|
||||
end;
|
||||
|
||||
var
|
||||
i : integer;
|
||||
dir : tsearchrec;
|
||||
begin
|
||||
for i:=1to paramcount do
|
||||
begin
|
||||
if findfirst(paramstr(i),$20,dir)=0 then
|
||||
repeat
|
||||
Conv(dir.name);
|
||||
until findnext(dir)<>0;
|
||||
findclose(dir);
|
||||
end;
|
||||
end.
|
||||
@ -1,173 +0,0 @@
|
||||
function lower(const s : string) : string;
|
||||
{
|
||||
return lowercased string of s
|
||||
}
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
for i:=1 to length(s) do
|
||||
if s[i] in ['A'..'Z'] then
|
||||
lower[i]:=char(byte(s[i])+32)
|
||||
else
|
||||
lower[i]:=s[i];
|
||||
lower[0]:=s[0];
|
||||
end;
|
||||
|
||||
function upper(const s : string) : string;
|
||||
{
|
||||
return lowercased string of s
|
||||
}
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
for i:=1 to length(s) do
|
||||
if s[i] in ['a'..'z'] then
|
||||
upper[i]:=char(byte(s[i])-32)
|
||||
else
|
||||
upper[i]:=s[i];
|
||||
upper[0]:=s[0];
|
||||
end;
|
||||
|
||||
function trimspace(const s:string):string;
|
||||
var
|
||||
i,j : longint;
|
||||
begin
|
||||
i:=length(s);
|
||||
while (i>0) and (s[i] in [#9,' ']) do
|
||||
dec(i);
|
||||
j:=1;
|
||||
while (j<i) and (s[j] in [#9,' ']) do
|
||||
inc(j);
|
||||
trimspace:=Copy(s,j,i-j+1);
|
||||
end;
|
||||
|
||||
function trimbegin(const s:string):string;
|
||||
var
|
||||
i,j : longint;
|
||||
begin
|
||||
i:=length(s);
|
||||
j:=1;
|
||||
while (j<i) and (s[j] in [#9,' ']) do
|
||||
inc(j);
|
||||
trimbegin:=Copy(s,j,i-j+1);
|
||||
end;
|
||||
|
||||
procedure Replace(var s:string;const s1,s2:string;single:boolean);
|
||||
var
|
||||
last,
|
||||
i : longint;
|
||||
begin
|
||||
last:=0;
|
||||
repeat
|
||||
i:=pos(s1,upper(s));
|
||||
if i=last then
|
||||
i:=0;
|
||||
if (i>0) then
|
||||
begin
|
||||
Delete(s,i,length(s1));
|
||||
Insert(s2,s,i);
|
||||
last:=i;
|
||||
end;
|
||||
until single or (i=0);
|
||||
end;
|
||||
|
||||
procedure fixreplace(var s:string);
|
||||
begin
|
||||
replace(s,'P_GDK','PGdk',false);
|
||||
replace(s,'= ^T_GDK','= ^TGdk',false);
|
||||
replace(s,'^T_GDK','PGdk',false);
|
||||
replace(s,'T_GDK','TGdk',false);
|
||||
replace(s,'^GDK','PGdk',false);
|
||||
replace(s,'EXTERNAL_LIBRARY','gdkdll',false);
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
t,f : text;
|
||||
ssmall : string[20];
|
||||
hs,
|
||||
s : string;
|
||||
name : string;
|
||||
i : word;
|
||||
func,
|
||||
impl : boolean;
|
||||
begin
|
||||
impl:=false;
|
||||
assign(t,paramstr(1));
|
||||
assign(f,'fixgdk.tmp');
|
||||
reset(t);
|
||||
rewrite(f);
|
||||
writeln(f,'{');
|
||||
writeln(f,'}');
|
||||
writeln(f,'');
|
||||
writeln(f,'{$ifndef gdk_include_files}');
|
||||
writeln(f,' {$define read_interface}');
|
||||
writeln(f,' {$define read_implementation}');
|
||||
writeln(f,'{$endif not gdk_include_files}');
|
||||
writeln(f,'');
|
||||
writeln(f,'{$ifndef gdk_include_files}');
|
||||
writeln(f,'');
|
||||
writeln(f,' unit ',Copy(paramstr(1),1,pos('.',paramstr(1))-1),';');
|
||||
writeln(f,' interface');
|
||||
writeln(f,'');
|
||||
writeln(f,' uses');
|
||||
writeln(f,' glib,gdkmain,');
|
||||
writeln(f,' gtkobjects;');
|
||||
writeln(f,'');
|
||||
writeln(f,' {$ifdef win32}');
|
||||
writeln(f,' const');
|
||||
writeln(f,' gtkdll=''gdk-1.1.dll''; { leave the .dll else .1.1 -> .1 !! }');
|
||||
writeln(f,' {$else}');
|
||||
writeln(f,' const');
|
||||
writeln(f,' gtkdll=''gdk.so'';');
|
||||
writeln(f,' {$linklib c}');
|
||||
writeln(f,' {$endif}');
|
||||
writeln(f,'');
|
||||
writeln(f,' Type');
|
||||
writeln(f,' PLongint = ^Longint;');
|
||||
writeln(f,' PByte = ^Byte;');
|
||||
writeln(f,' PWord = ^Word;');
|
||||
writeln(f,' PINteger = ^Integer;');
|
||||
writeln(f,' PCardinal = ^Cardinal;');
|
||||
writeln(f,' PReal = ^Real;');
|
||||
writeln(f,' PDouble = ^Double;');
|
||||
writeln(f,'');
|
||||
writeln(f,'{$endif not gdk_include_files}');
|
||||
writeln(f,'');
|
||||
writeln(f,'{$ifdef read_interface}');
|
||||
writeln(f,'');
|
||||
while not eof(t) do
|
||||
begin
|
||||
read(t,ssmall);
|
||||
fixreplace(ssmall);
|
||||
|
||||
if (not impl) and (copy(trimspace(ssmall),1,14)='implementation') then
|
||||
begin
|
||||
impl:=true;
|
||||
readln(t,s);
|
||||
writeln(f,'{$endif read_interface}');
|
||||
writeln(f,'');
|
||||
writeln(f,'');
|
||||
writeln(f,'{$ifndef gdk_include_files}');
|
||||
writeln(f,' implementation');
|
||||
writeln(f,'{$endif not gdk_include_files}');
|
||||
writeln(f,'');
|
||||
writeln(f,'{$ifdef read_implementation}');
|
||||
writeln(f,'');
|
||||
continue;
|
||||
end;
|
||||
if (impl) and (copy(trimspace(ssmall),1,4)='end.') then
|
||||
begin
|
||||
writeln(f,'{$endif read_implementation}');
|
||||
writeln(f,'');
|
||||
writeln(f,'');
|
||||
writeln(f,'{$ifndef gdk_include_files}');
|
||||
writeln(f,'end.');
|
||||
writeln(f,'{$endif not gdk_include_files}');
|
||||
writeln(f,'');
|
||||
writeln(f,'{');
|
||||
|
||||
Revision 1.3 2005/02/14 17:13:20 peter
|
||||
* truncate log
|
||||
|
||||
}
|
||||
@ -1,114 +0,0 @@
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
|
||||
uses
|
||||
sysutils;
|
||||
|
||||
Function PosIdx (Const Substr : AnsiString; Const Source : AnsiString;i:longint) : Longint;
|
||||
var
|
||||
S : String;
|
||||
begin
|
||||
PosIdx:=0;
|
||||
if Length(SubStr)=0 then
|
||||
exit;
|
||||
while (i <= length (Source) - length (substr)) do
|
||||
begin
|
||||
inc (i);
|
||||
S:=copy(Source,i,length(Substr));
|
||||
if S=SubStr then
|
||||
exit(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function trimspace(const s:string):string;
|
||||
var
|
||||
i,j : longint;
|
||||
begin
|
||||
i:=length(s);
|
||||
while (i>0) and (s[i] in [#9,' ']) do
|
||||
dec(i);
|
||||
j:=1;
|
||||
while (j<i) and (s[j] in [#9,' ']) do
|
||||
inc(j);
|
||||
trimspace:=Copy(s,j,i-j+1);
|
||||
end;
|
||||
|
||||
function trimbegin(const s:string):string;
|
||||
var
|
||||
i,j : longint;
|
||||
begin
|
||||
i:=length(s);
|
||||
j:=1;
|
||||
while (j<i) and (s[j] in [#9,' ']) do
|
||||
inc(j);
|
||||
trimbegin:=Copy(s,j,i-j+1);
|
||||
end;
|
||||
|
||||
procedure Replace(var s:string;const s1,s2:string);
|
||||
var
|
||||
last,
|
||||
i : longint;
|
||||
begin
|
||||
last:=0;
|
||||
repeat
|
||||
i:=posidx(s1,uppercase(s),last);
|
||||
if (i>0) then
|
||||
begin
|
||||
Delete(s,i,length(s1));
|
||||
Insert(s2,s,i);
|
||||
last:=i+1;
|
||||
end;
|
||||
until (i=0);
|
||||
end;
|
||||
|
||||
procedure Conv(const fn: string);
|
||||
var
|
||||
t,f : text;
|
||||
lasts,funcname,
|
||||
s,ups : string;
|
||||
k,i,j : integer;
|
||||
gotisfunc,
|
||||
impl : boolean;
|
||||
begin
|
||||
writeln('processing ',fn);
|
||||
assign(t,fn);
|
||||
assign(f,'fixgdk.tmp');
|
||||
reset(t);
|
||||
rewrite(f);
|
||||
funcname:='';
|
||||
gotisfunc:=false;
|
||||
impl:=false;
|
||||
while not eof(t) do
|
||||
begin
|
||||
readln(t,s);
|
||||
{ Remove unit part }
|
||||
if s='{$ifndef gdk_include_files}' then
|
||||
begin
|
||||
while not eof(t) do
|
||||
begin
|
||||
readln(t,s);
|
||||
if Pos('{$ifdef read_interface}',s)>0 then
|
||||
begin
|
||||
writeln(f,'{****************************************************************************');
|
||||
writeln(f,' Interface');
|
||||
writeln(f,'****************************************************************************}');
|
||||
writeln(f,'');
|
||||
writeln(f,s);
|
||||
break;
|
||||
end;
|
||||
if Pos('{$ifdef read_implementation}',s)>0 then
|
||||
begin
|
||||
writeln(f,'{****************************************************************************');
|
||||
writeln(f,' Implementation');
|
||||
writeln(f,'****************************************************************************}');
|
||||
writeln(f,'');
|
||||
writeln(f,s);
|
||||
impl:=true;
|
||||
break;
|
||||
end;
|
||||
|
||||
Revision 1.3 2005/02/14 17:13:20 peter
|
||||
* truncate log
|
||||
|
||||
}
|
||||
@ -1,189 +0,0 @@
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
|
||||
uses
|
||||
sysutils;
|
||||
|
||||
Function PosIdx (Const Substr : AnsiString; Const Source : AnsiString;i:longint) : Longint;
|
||||
var
|
||||
S : String;
|
||||
begin
|
||||
PosIdx:=0;
|
||||
if Length(SubStr)=0 then
|
||||
exit;
|
||||
while (i <= length (Source) - length (substr)) do
|
||||
begin
|
||||
inc (i);
|
||||
S:=copy(Source,i,length(Substr));
|
||||
if S=SubStr then
|
||||
exit(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function trimspace(const s:string):string;
|
||||
var
|
||||
i,j : longint;
|
||||
begin
|
||||
i:=length(s);
|
||||
while (i>0) and (s[i] in [#9,' ']) do
|
||||
dec(i);
|
||||
j:=1;
|
||||
while (j<i) and (s[j] in [#9,' ']) do
|
||||
inc(j);
|
||||
trimspace:=Copy(s,j,i-j+1);
|
||||
end;
|
||||
|
||||
function trimbegin(const s:string):string;
|
||||
var
|
||||
i,j : longint;
|
||||
begin
|
||||
i:=length(s);
|
||||
j:=1;
|
||||
while (j<i) and (s[j] in [#9,' ']) do
|
||||
inc(j);
|
||||
trimbegin:=Copy(s,j,i-j+1);
|
||||
end;
|
||||
|
||||
procedure Replace(var s:string;const s1,s2:string);
|
||||
var
|
||||
last,
|
||||
i : longint;
|
||||
begin
|
||||
last:=0;
|
||||
repeat
|
||||
i:=posidx(s1,uppercase(s),last);
|
||||
if (i>0) then
|
||||
begin
|
||||
Delete(s,i,length(s1));
|
||||
Insert(s2,s,i);
|
||||
last:=i+1;
|
||||
end;
|
||||
until (i=0);
|
||||
end;
|
||||
|
||||
procedure Conv(const fn: string);
|
||||
var
|
||||
t,f : text;
|
||||
lasts,funcname,
|
||||
s,ups : string;
|
||||
k,i,j : integer;
|
||||
gotisfunc,
|
||||
impl : boolean;
|
||||
begin
|
||||
writeln('processing ',fn);
|
||||
assign(t,fn);
|
||||
assign(f,'fixgdk.tmp');
|
||||
reset(t);
|
||||
rewrite(f);
|
||||
funcname:='';
|
||||
gotisfunc:=false;
|
||||
impl:=false;
|
||||
while not eof(t) do
|
||||
begin
|
||||
readln(t,s);
|
||||
|
||||
Replace(s,'PROCEDURE','procedure');
|
||||
Replace(s,'FUNCTION','function');
|
||||
Replace(s,'FUNCTION ','function ');
|
||||
Replace(s,'PPG','PPG');
|
||||
Replace(s,'PG','PG');
|
||||
Replace(s,'GCHAR','gchar');
|
||||
Replace(s,'GUCHAR','guchar');
|
||||
Replace(s,'GINT','gint');
|
||||
Replace(s,'GUINT','guint');
|
||||
Replace(s,'GBOOL','gbool');
|
||||
Replace(s,'GSHORT','gshort');
|
||||
Replace(s,'GUSHORT','gushort');
|
||||
Replace(s,'GLONG','glong');
|
||||
Replace(s,'GULONG','gulong');
|
||||
Replace(s,'GFLOAT','gfloat');
|
||||
Replace(s,'GDOUBLE','gdouble');
|
||||
Replace(s,'GPOINTER','gpointer');
|
||||
Replace(s,'GCONSTPOINTER','gconstpointer');
|
||||
|
||||
ups:=UpperCase(s);
|
||||
|
||||
if Pos('IMPLEMENTATION',ups)>0 then
|
||||
impl:=true;
|
||||
|
||||
i:=Pos('PROCEDURE',ups);
|
||||
if i>0 then
|
||||
if Pos('_PROCEDURE',ups)>0 then
|
||||
i:=0;
|
||||
if i=0 then
|
||||
begin
|
||||
i:=Pos('FUNCTION',ups);
|
||||
if Pos('_FUNCTION',ups)>0 then
|
||||
i:=0;
|
||||
end;
|
||||
if i<>0 then
|
||||
begin
|
||||
{ Remove Spaces }
|
||||
j:=PosIdx(' ',s,i);
|
||||
while (j>0) do
|
||||
begin
|
||||
Delete(s,j,1);
|
||||
i:=j-1;
|
||||
j:=PosIdx(' ',s,i);
|
||||
end;
|
||||
ups:=UpperCase(s);
|
||||
{ Fix Cdecl }
|
||||
if (Pos('g_',s)<>0) or
|
||||
((i>2) and (s[i-2] in [':','='])) then
|
||||
begin
|
||||
j:=Pos('CDECL;',ups);
|
||||
if j=0 then
|
||||
j:=Length(s)+1
|
||||
else
|
||||
begin
|
||||
k:=Pos('{$IFNDEF WIN32}CDECL;{$ENDIF}',ups);
|
||||
if k>0 then
|
||||
begin
|
||||
j:=k;
|
||||
k:=29;
|
||||
end
|
||||
else
|
||||
begin
|
||||
k:=Pos('{$IFDEF WIN32}STDCALL;{$ELSE}CDECL;{$ENDIF}',ups);
|
||||
if k>0 then
|
||||
begin
|
||||
j:=k;
|
||||
k:=43;
|
||||
end
|
||||
else
|
||||
k:=6;
|
||||
end;
|
||||
Delete(s,j,k);
|
||||
end;
|
||||
Insert('cdecl;',s,j);
|
||||
end;
|
||||
ups:=UpperCase(s);
|
||||
end;
|
||||
|
||||
{ Align function with procedure }
|
||||
if Copy(s,1,8)='function' then
|
||||
Insert(' ',s,9);
|
||||
|
||||
lasts:=s;
|
||||
writeln(f,s);
|
||||
end;
|
||||
close(f);
|
||||
close(t);
|
||||
erase(t);
|
||||
rename(f,fn);
|
||||
end;
|
||||
|
||||
var
|
||||
i : integer;
|
||||
dir : tsearchrec;
|
||||
begin
|
||||
for i:=1to paramcount do
|
||||
begin
|
||||
if findfirst(paramstr(i),$20,dir)=0 then
|
||||
repeat
|
||||
Conv(dir.name);
|
||||
until findnext(dir)<>0;
|
||||
findclose(dir);
|
||||
end;
|
||||
end.
|
||||
@ -1,195 +0,0 @@
|
||||
function lower(const s : string) : string;
|
||||
{
|
||||
return lowercased string of s
|
||||
}
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
for i:=1 to length(s) do
|
||||
if s[i] in ['A'..'Z'] then
|
||||
lower[i]:=char(byte(s[i])+32)
|
||||
else
|
||||
lower[i]:=s[i];
|
||||
lower[0]:=s[0];
|
||||
end;
|
||||
|
||||
function upper(const s : string) : string;
|
||||
{
|
||||
return lowercased string of s
|
||||
}
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
for i:=1 to length(s) do
|
||||
if s[i] in ['a'..'z'] then
|
||||
upper[i]:=char(byte(s[i])-32)
|
||||
else
|
||||
upper[i]:=s[i];
|
||||
upper[0]:=s[0];
|
||||
end;
|
||||
|
||||
function trimspace(const s:string):string;
|
||||
var
|
||||
i,j : longint;
|
||||
begin
|
||||
i:=length(s);
|
||||
while (i>0) and (s[i] in [#9,' ']) do
|
||||
dec(i);
|
||||
j:=1;
|
||||
while (j<i) and (s[j] in [#9,' ']) do
|
||||
inc(j);
|
||||
trimspace:=Copy(s,j,i-j+1);
|
||||
end;
|
||||
|
||||
function trimbegin(const s:string):string;
|
||||
var
|
||||
i,j : longint;
|
||||
begin
|
||||
i:=length(s);
|
||||
j:=1;
|
||||
while (j<i) and (s[j] in [#9,' ']) do
|
||||
inc(j);
|
||||
trimbegin:=Copy(s,j,i-j+1);
|
||||
end;
|
||||
|
||||
procedure Replace(var s:string;const s1,s2:string;single:boolean);
|
||||
var
|
||||
last,
|
||||
i : longint;
|
||||
begin
|
||||
last:=0;
|
||||
repeat
|
||||
i:=pos(s1,upper(s));
|
||||
if i=last then
|
||||
i:=0;
|
||||
if (i>0) then
|
||||
begin
|
||||
Delete(s,i,length(s1));
|
||||
Insert(s2,s,i);
|
||||
last:=i;
|
||||
end;
|
||||
until single or (i=0);
|
||||
end;
|
||||
|
||||
procedure ReplaceCase(var s:string;const s1,s2:string;single:boolean);
|
||||
var
|
||||
last,
|
||||
i : longint;
|
||||
begin
|
||||
last:=0;
|
||||
repeat
|
||||
i:=pos(s1,s);
|
||||
if i=last then
|
||||
i:=0;
|
||||
if (i>0) then
|
||||
begin
|
||||
Delete(s,i,length(s1));
|
||||
Insert(s2,s,i);
|
||||
last:=i;
|
||||
end;
|
||||
until single or (i=0);
|
||||
end;
|
||||
|
||||
procedure fixreplace(var s:string);
|
||||
begin
|
||||
replace(s,'P_GTK','PGtk',false);
|
||||
replace(s,'= ^T_GTK','= ^TGtk',false);
|
||||
replace(s,'^T_GTK','PGtk',false);
|
||||
replace(s,'T_GTK','TGtk',false);
|
||||
replace(s,'^GTK','PGtk',false);
|
||||
replace(s,'EXTERNAL_LIBRARY','gtkdll',false);
|
||||
replacecase(s,' Gtk',' TGtk',false);
|
||||
replacecase(s,':Gtk',':TGtk',false);
|
||||
replace(s,'^G','PG',false);
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
t,f : text;
|
||||
ssmall : string[20];
|
||||
hs,
|
||||
s : string;
|
||||
name : string;
|
||||
i : word;
|
||||
func,
|
||||
impl : boolean;
|
||||
begin
|
||||
impl:=false;
|
||||
assign(t,paramstr(1));
|
||||
assign(f,'fixgtk.tmp');
|
||||
reset(t);
|
||||
rewrite(f);
|
||||
writeln(f,'{');
|
||||
writeln(f,'}');
|
||||
writeln(f,'');
|
||||
writeln(f,'{$ifndef gtk_include_files}');
|
||||
writeln(f,' {$define read_interface}');
|
||||
writeln(f,' {$define read_implementation}');
|
||||
writeln(f,'{$endif not gtk_include_files}');
|
||||
writeln(f,'');
|
||||
writeln(f,'{$ifndef gtk_include_files}');
|
||||
writeln(f,'');
|
||||
writeln(f,' unit ',Copy(paramstr(1),1,pos('.',paramstr(1))-1),';');
|
||||
writeln(f,' interface');
|
||||
writeln(f,'');
|
||||
writeln(f,' uses');
|
||||
writeln(f,' glib,gdkmain,');
|
||||
writeln(f,' gtkobjects;');
|
||||
writeln(f,'');
|
||||
writeln(f,' {$ifdef win32}');
|
||||
writeln(f,' const');
|
||||
writeln(f,' gtkdll=''gtk-1.1.dll''; { leave the .dll else .1.1 -> .1 !! }');
|
||||
writeln(f,' {$else}');
|
||||
writeln(f,' const');
|
||||
writeln(f,' gtkdll=''gtk.so'';');
|
||||
writeln(f,' {$linklib c}');
|
||||
writeln(f,' {$endif}');
|
||||
writeln(f,'');
|
||||
writeln(f,' Type');
|
||||
writeln(f,' PLongint = ^Longint;');
|
||||
writeln(f,' PByte = ^Byte;');
|
||||
writeln(f,' PWord = ^Word;');
|
||||
writeln(f,' PINteger = ^Integer;');
|
||||
writeln(f,' PCardinal = ^Cardinal;');
|
||||
writeln(f,' PReal = ^Real;');
|
||||
writeln(f,' PDouble = ^Double;');
|
||||
writeln(f,'');
|
||||
writeln(f,'{$endif not gtk_include_files}');
|
||||
writeln(f,'');
|
||||
writeln(f,'{$ifdef read_interface}');
|
||||
writeln(f,'');
|
||||
while not eof(t) do
|
||||
begin
|
||||
read(t,ssmall);
|
||||
fixreplace(ssmall);
|
||||
|
||||
if (not impl) and (copy(trimspace(ssmall),1,14)='implementation') then
|
||||
begin
|
||||
impl:=true;
|
||||
readln(t,s);
|
||||
writeln(f,'{$endif read_interface}');
|
||||
writeln(f,'');
|
||||
writeln(f,'');
|
||||
writeln(f,'{$ifndef gtk_include_files}');
|
||||
writeln(f,' implementation');
|
||||
writeln(f,'{$endif not gtk_include_files}');
|
||||
writeln(f,'');
|
||||
writeln(f,'{$ifdef read_implementation}');
|
||||
writeln(f,'');
|
||||
continue;
|
||||
end;
|
||||
if (impl) and (copy(trimspace(ssmall),1,4)='end.') then
|
||||
begin
|
||||
writeln(f,'{$endif read_implementation}');
|
||||
writeln(f,'');
|
||||
writeln(f,'');
|
||||
writeln(f,'{$ifndef gtk_include_files}');
|
||||
writeln(f,'end.');
|
||||
writeln(f,'{$endif not gtk_include_files}');
|
||||
writeln(f,'');
|
||||
writeln(f,'{');
|
||||
|
||||
Revision 1.3 2005/02/14 17:13:20 peter
|
||||
* truncate log
|
||||
|
||||
}
|
||||
@ -1,114 +0,0 @@
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
|
||||
uses
|
||||
sysutils;
|
||||
|
||||
Function PosIdx (Const Substr : AnsiString; Const Source : AnsiString;i:longint) : Longint;
|
||||
var
|
||||
S : String;
|
||||
begin
|
||||
PosIdx:=0;
|
||||
if Length(SubStr)=0 then
|
||||
exit;
|
||||
while (i <= length (Source) - length (substr)) do
|
||||
begin
|
||||
inc (i);
|
||||
S:=copy(Source,i,length(Substr));
|
||||
if S=SubStr then
|
||||
exit(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function trimspace(const s:string):string;
|
||||
var
|
||||
i,j : longint;
|
||||
begin
|
||||
i:=length(s);
|
||||
while (i>0) and (s[i] in [#9,' ']) do
|
||||
dec(i);
|
||||
j:=1;
|
||||
while (j<i) and (s[j] in [#9,' ']) do
|
||||
inc(j);
|
||||
trimspace:=Copy(s,j,i-j+1);
|
||||
end;
|
||||
|
||||
function trimbegin(const s:string):string;
|
||||
var
|
||||
i,j : longint;
|
||||
begin
|
||||
i:=length(s);
|
||||
j:=1;
|
||||
while (j<i) and (s[j] in [#9,' ']) do
|
||||
inc(j);
|
||||
trimbegin:=Copy(s,j,i-j+1);
|
||||
end;
|
||||
|
||||
procedure Replace(var s:string;const s1,s2:string);
|
||||
var
|
||||
last,
|
||||
i : longint;
|
||||
begin
|
||||
last:=0;
|
||||
repeat
|
||||
i:=posidx(s1,uppercase(s),last);
|
||||
if (i>0) then
|
||||
begin
|
||||
Delete(s,i,length(s1));
|
||||
Insert(s2,s,i);
|
||||
last:=i+1;
|
||||
end;
|
||||
until (i=0);
|
||||
end;
|
||||
|
||||
procedure Conv(const fn: string);
|
||||
var
|
||||
t,f : text;
|
||||
lasts,funcname,
|
||||
s,ups : string;
|
||||
k,i,j : integer;
|
||||
gotisfunc,
|
||||
impl : boolean;
|
||||
begin
|
||||
writeln('processing ',fn);
|
||||
assign(t,fn);
|
||||
assign(f,'fixgtk.tmp');
|
||||
reset(t);
|
||||
rewrite(f);
|
||||
funcname:='';
|
||||
gotisfunc:=false;
|
||||
impl:=false;
|
||||
while not eof(t) do
|
||||
begin
|
||||
readln(t,s);
|
||||
{ Remove unit part }
|
||||
if s='{$ifndef gtk_include_files}' then
|
||||
begin
|
||||
while not eof(t) do
|
||||
begin
|
||||
readln(t,s);
|
||||
if Pos('{$ifdef read_interface}',s)>0 then
|
||||
begin
|
||||
writeln(f,'{****************************************************************************');
|
||||
writeln(f,' Interface');
|
||||
writeln(f,'****************************************************************************}');
|
||||
writeln(f,'');
|
||||
writeln(f,s);
|
||||
break;
|
||||
end;
|
||||
if Pos('{$ifdef read_implementation}',s)>0 then
|
||||
begin
|
||||
writeln(f,'{****************************************************************************');
|
||||
writeln(f,' Implementation');
|
||||
writeln(f,'****************************************************************************}');
|
||||
writeln(f,'');
|
||||
writeln(f,s);
|
||||
impl:=true;
|
||||
break;
|
||||
end;
|
||||
|
||||
Revision 1.3 2005/02/14 17:13:20 peter
|
||||
* truncate log
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user