← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to fcl/classes/twriter.inc

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fcl/classes/twriter.inc
1
 
{
2
 
    $Id: twriter.inc,v 1.2 2005/02/14 17:13:11 peter Exp $
3
 
    This file is part of the Free Component Library (FCL)
4
 
    Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
5
 
 
6
 
    See the file COPYING.FPC, included in this distribution,
7
 
    for details about the copyright.
8
 
 
9
 
    This program is distributed in the hope that it will be useful,
10
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
11
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12
 
 
13
 
 **********************************************************************}
14
 
 
15
 
(*Procedure TTextWriter.WriteLn(Const Msg : String);
16
 
 
17
 
Const CRLF = #10;
18
 
 
19
 
begin
20
 
  Write(Msg+CRLF);
21
 
end;
22
 
 
23
 
Procedure TTextWriter.Write(Const Msg : String);
24
 
 
25
 
Var S : String;
26
 
 
27
 
begin
28
 
  S:=FPrefix+Msg;
29
 
  FStream.Write(Pointer(S)^,Length(S));
30
 
end;
31
 
 
32
 
 
33
 
Procedure TTextWriter.WriteFmt(Fmt : String; Args :  Array of const);
34
 
 
35
 
begin
36
 
  Writeln(Format(Fmt,Args));
37
 
end;
38
 
 
39
 
Procedure TTextWriter.StartObject(Const AClassName, AName : String);
40
 
 
41
 
begin
42
 
  WriteFmt('Object %s %s',[AName,AClassName]);
43
 
  FPrefix:=FPrefix+'  ';
44
 
end;
45
 
 
46
 
Procedure TTextWriter.EndObject;
47
 
 
48
 
Var L : longint;
49
 
 
50
 
begin
51
 
  L:=Length(FPrefix);
52
 
  If L>2 Then
53
 
    SetLength(FPrefix,L-2);
54
 
  Writeln('end');
55
 
end;
56
 
 
57
 
Procedure TTextWriter.StartCollection(Const AName : String);
58
 
 
59
 
begin
60
 
  WriteFmt('%s = (',[AName]);
61
 
  FPrefix:=FPrefix+'  ';
62
 
end;
63
 
 
64
 
Procedure TTextWriter.StartCollectionItem;
65
 
 
66
 
begin
67
 
end;
68
 
 
69
 
Procedure TTextWriter.EndCollectionItem;
70
 
 
71
 
begin
72
 
end;
73
 
 
74
 
Procedure TTextWriter.EndCollection;
75
 
 
76
 
Var L : longint;
77
 
 
78
 
begin
79
 
  L:=Length(FPrefix);
80
 
  If L>2 Then
81
 
    SetLength(FPrefix,L-2);
82
 
  Writeln(')');
83
 
end;
84
 
 
85
 
 
86
 
Procedure TTextWriter.WritePropName(const PropName: string);
87
 
 
88
 
begin
89
 
  Writeln(PropName);
90
 
end;
91
 
 
92
 
Constructor TTextWriter.Create(S : TStream);
93
 
 
94
 
begin
95
 
  Inherited Create;
96
 
  FStream:=S;
97
 
  FPrefix:='';
98
 
end;
99
 
 
100
 
Destructor TTextWriter.Destroy;
101
 
 
102
 
begin
103
 
end;
104
 
 
105
 
Procedure TTextWriter.WriteIntegerProperty(Const Name : Shortstring;Value : Longint);
106
 
 
107
 
begin
108
 
  WriteFmt('%s = %d',[Name,Value]);
109
 
end;
110
 
 
111
 
Procedure TTextWriter.WriteSetProperty (Const Name : ShortString;Value : longint; BaseType : TTypeInfo);
112
 
 
113
 
begin
114
 
  //!! needs implementing.
115
 
  WriteFmt('%s = []',[Name]);
116
 
end;
117
 
 
118
 
Procedure TTextWriter.WriteEnumerationProperty (Const Name : ShortString;Value : Longint; Const EnumName : ShortSTring);
119
 
 
120
 
begin
121
 
  WriteFmt('%s = %s',[Name,EnumName])
122
 
end;
123
 
 
124
 
Procedure TTextWriter.WriteStringProperty(Const Name : ShortString; Const Value : String);
125
 
 
126
 
Type
127
 
  TMode = (quoted,unquoted);
128
 
 
129
 
Var
130
 
  Mode : TMode;
131
 
  S : String;
132
 
  I,L : Longint;
133
 
  c : char;
134
 
 
135
 
   Procedure Add (A : String);
136
 
 
137
 
   begin
138
 
     S:=S+A;
139
 
   end;
140
 
 
141
 
begin
142
 
  L:=Length(Value);
143
 
  Mode:=unquoted;
144
 
  S:=Name+' = ';
145
 
  For I:=1 to L do
146
 
    begin
147
 
    C:=Value[i];
148
 
    If (ord(C)>31) and (Ord(c)<=128) and (c<>'''') then
149
 
      begin
150
 
      If mode=Quoted then
151
 
        Add(c)
152
 
      else
153
 
        begin
154
 
        Add(''''+c);
155
 
        mode:=quoted
156
 
        end
157
 
      end
158
 
    else
159
 
      begin
160
 
      If Mode=quoted then
161
 
        begin
162
 
        Add('''');
163
 
        mode:=unquoted;
164
 
        end;
165
 
      Add(Format('#%d',[ord(c)]));
166
 
      end;
167
 
    If Length(S)>72 then
168
 
      begin
169
 
      if mode=quoted then
170
 
        Add ('''');
171
 
      Add('+');
172
 
      Writeln(S);
173
 
      Mode:=unQuoted;
174
 
      end;
175
 
    end;
176
 
 if mode=quoted then Add('''');
177
 
 Writeln(S);
178
 
end;
179
 
 
180
 
Procedure TTextWriter.WriteFloatProperty(Const Name : ShortString; Value : Extended);
181
 
 
182
 
begin
183
 
  WriteFmt('%s = %e',[Name,Value])
184
 
end;
185
 
 
186
 
Procedure TTextWriter.WriteCollectionProperty(Const Name : ShortString;Value : TCollection);
187
 
 
188
 
begin
189
 
 
190
 
end;
191
 
 
192
 
Procedure TTextWriter.WriteClassProperty(Instance : TPersistent;Propinfo :PPropInfo);
193
 
 
194
 
begin
195
 
end;
196
 
 
197
 
Procedure TTextWriter.WriteComponentProperty(Const Name : ShortSTring; Value : TComponent);
198
 
 
199
 
begin
200
 
  WriteFmt ('%s = %s',[Name,Value.Name]);
201
 
end;
202
 
 
203
 
Procedure TTextWriter.WriteNilProperty(Const Name : Shortstring);
204
 
 
205
 
begin
206
 
  system.Writeln(stderr,'Nil : ',Name);
207
 
  WriteFmt ('%s = Nil',[Name])
208
 
end;
209
 
 
210
 
Procedure TTextWriter.WriteMethodProperty(Const Name,AMethodName : ShortString);
211
 
 
212
 
begin
213
 
  WriteFmt ('%s = %s',[Name,AMethodName]);
214
 
end;*)
215
 
 
216
 
{
217
 
  $Log: twriter.inc,v $
218
 
  Revision 1.2  2005/02/14 17:13:11  peter
219
 
    * truncate log
220
 
 
221
 
}