← Back to branch summary

~ubuntu-branches/ubuntu/lucid/fpc/lucid-proposed

« back to all changes in this revision

Viewing changes to fpcsrc/packages/extra/gtk/conv/fixgdk.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-10-09 23:29:00 UTC
  • mfrom: (4.1.1 sid)
  • Revision ID: james.westby@ubuntu.com-20081009232900-553f61m37jkp6upv
Tags: 2.2.2-4
http://bugs.debian.org/498882
[ Torsten Werner ]
* Update ABI version in fpc-depends automatically.
* Remove empty directories from binary package fpc-source.

[ Mazen Neifer ]
* Removed leading path when calling update-alternatives to remove a Linitian
  error.
* Fixed clean target.
* Improved description of packages. (Closes: #498882)

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/packages/extra/gtk/conv/fixgdk.pp
1
 
    function lower(const s : string) : string;
2
 
    {
3
 
      return lowercased string of s
4
 
    }
5
 
      var
6
 
         i : longint;
7
 
      begin
8
 
         for i:=1 to length(s) do
9
 
          if s[i] in ['A'..'Z'] then
10
 
           lower[i]:=char(byte(s[i])+32)
11
 
          else
12
 
           lower[i]:=s[i];
13
 
         lower[0]:=s[0];
14
 
      end;
15
 
 
16
 
    function upper(const s : string) : string;
17
 
    {
18
 
      return lowercased string of s
19
 
    }
20
 
      var
21
 
         i : longint;
22
 
      begin
23
 
         for i:=1 to length(s) do
24
 
          if s[i] in ['a'..'z'] then
25
 
           upper[i]:=char(byte(s[i])-32)
26
 
          else
27
 
           upper[i]:=s[i];
28
 
         upper[0]:=s[0];
29
 
      end;
30
 
 
31
 
   function trimspace(const s:string):string;
32
 
     var
33
 
       i,j : longint;
34
 
     begin
35
 
       i:=length(s);
36
 
       while (i>0) and (s[i] in [#9,' ']) do
37
 
        dec(i);
38
 
       j:=1;
39
 
       while (j<i) and (s[j] in [#9,' ']) do
40
 
        inc(j);
41
 
       trimspace:=Copy(s,j,i-j+1);
42
 
     end;
43
 
 
44
 
   function trimbegin(const s:string):string;
45
 
     var
46
 
       i,j : longint;
47
 
     begin
48
 
       i:=length(s);
49
 
       j:=1;
50
 
       while (j<i) and (s[j] in [#9,' ']) do
51
 
        inc(j);
52
 
       trimbegin:=Copy(s,j,i-j+1);
53
 
     end;
54
 
 
55
 
    procedure Replace(var s:string;const s1,s2:string;single:boolean);
56
 
      var
57
 
         last,
58
 
         i  : longint;
59
 
      begin
60
 
        last:=0;
61
 
        repeat
62
 
          i:=pos(s1,upper(s));
63
 
          if i=last then
64
 
           i:=0;
65
 
          if (i>0) then
66
 
           begin
67
 
             Delete(s,i,length(s1));
68
 
             Insert(s2,s,i);
69
 
             last:=i;
70
 
           end;
71
 
        until single or (i=0);
72
 
      end;
73
 
 
74
 
    procedure fixreplace(var s:string);
75
 
      begin
76
 
        replace(s,'P_GDK','PGdk',false);
77
 
        replace(s,'= ^T_GDK','= ^TGdk',false);
78
 
        replace(s,'^T_GDK','PGdk',false);
79
 
        replace(s,'T_GDK','TGdk',false);
80
 
        replace(s,'^GDK','PGdk',false);
81
 
        replace(s,'EXTERNAL_LIBRARY','gdkdll',false);
82
 
      end;
83
 
 
84
 
 
85
 
var
86
 
  t,f : text;
87
 
  ssmall : string[20];
88
 
  hs,
89
 
  s   : string;
90
 
  name : string;
91
 
  i    : word;
92
 
  func,
93
 
  impl : boolean;
94
 
begin
95
 
  impl:=false;
96
 
  assign(t,paramstr(1));
97
 
  assign(f,'fixgdk.tmp');
98
 
  reset(t);
99
 
  rewrite(f);
100
 
  writeln(f,'{');
101
 
  writeln(f,'}');
102
 
  writeln(f,'');
103
 
  writeln(f,'{$ifndef gdk_include_files}');
104
 
  writeln(f,'  {$define read_interface}');
105
 
  writeln(f,'  {$define read_implementation}');
106
 
  writeln(f,'{$endif not gdk_include_files}');
107
 
  writeln(f,'');
108
 
  writeln(f,'{$ifndef gdk_include_files}');
109
 
  writeln(f,'');
110
 
  writeln(f,'  unit ',Copy(paramstr(1),1,pos('.',paramstr(1))-1),';');
111
 
  writeln(f,'  interface');
112
 
  writeln(f,'');
113
 
  writeln(f,'  uses');
114
 
  writeln(f,'    glib,gdkmain,');
115
 
  writeln(f,'    gtkobjects;');
116
 
  writeln(f,'');
117
 
  writeln(f,'  {$ifdef win32}');
118
 
  writeln(f,'    const');
119
 
  writeln(f,'      gtkdll=''gdk-1.1.dll''; { leave the .dll else .1.1 -> .1 !! }');
120
 
  writeln(f,'  {$else}');
121
 
  writeln(f,'    const');
122
 
  writeln(f,'      gtkdll=''gdk.so'';');
123
 
  writeln(f,'    {$linklib c}');
124
 
  writeln(f,'  {$endif}');
125
 
  writeln(f,'');
126
 
  writeln(f,'  Type');
127
 
  writeln(f,'    PLongint  = ^Longint;');
128
 
  writeln(f,'    PByte     = ^Byte;');
129
 
  writeln(f,'    PWord     = ^Word;');
130
 
  writeln(f,'    PINteger  = ^Integer;');
131
 
  writeln(f,'    PCardinal = ^Cardinal;');
132
 
  writeln(f,'    PReal     = ^Real;');
133
 
  writeln(f,'    PDouble   = ^Double;');
134
 
  writeln(f,'');
135
 
  writeln(f,'{$endif not gdk_include_files}');
136
 
  writeln(f,'');
137
 
  writeln(f,'{$ifdef read_interface}');
138
 
  writeln(f,'');
139
 
  while not eof(t) do
140
 
   begin
141
 
     read(t,ssmall);
142
 
     fixreplace(ssmall);
143
 
 
144
 
     if (not impl) and (copy(trimspace(ssmall),1,14)='implementation') then
145
 
      begin
146
 
        impl:=true;
147
 
        readln(t,s);
148
 
        writeln(f,'{$endif read_interface}');
149
 
        writeln(f,'');
150
 
        writeln(f,'');
151
 
        writeln(f,'{$ifndef gdk_include_files}');
152
 
        writeln(f,'  implementation');
153
 
        writeln(f,'{$endif not gdk_include_files}');
154
 
        writeln(f,'');
155
 
        writeln(f,'{$ifdef read_implementation}');
156
 
        writeln(f,'');
157
 
        continue;
158
 
      end;
159
 
     if (impl) and (copy(trimspace(ssmall),1,4)='end.') then
160
 
      begin
161
 
        writeln(f,'{$endif read_implementation}');
162
 
        writeln(f,'');
163
 
        writeln(f,'');
164
 
        writeln(f,'{$ifndef gdk_include_files}');
165
 
        writeln(f,'end.');
166
 
        writeln(f,'{$endif not gdk_include_files}');
167
 
        writeln(f,'');
168
 
        writeln(f,'{');
169
 
 
170
 
  Revision 1.3  2005/02/14 17:13:20  peter
171
 
    * truncate log
172
 
 
173
 
}