← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/ide/utils/tphc.pas

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/ide/utils/tphc.pas
 
1
{
 
2
 !!! Someone please fix DRIVERS.PAS, so it doesn't clears the screen on exit
 
3
     when we didn't use any of it's functions, just had it in 'uses'
 
4
 
 
5
     Then we can delete GetDosTicks() from WHelp...
 
6
}
 
7
 
 
8
uses Objects,WUtils,WHelp,WTPHWriter;
 
9
 
 
10
const
 
11
     SrcExt          = '.txt';
 
12
     HelpExt         = '.fph';
 
13
     TokenPrefix     = '.';
 
14
     CommentPrefix   = ';';
 
15
     TokenIndex      = 'INDEX';
 
16
     TokenTopic      = 'TOPIC';
 
17
     TokenCode       = 'CODE';
 
18
 
 
19
     FirstTempTopic  = 1000000;
 
20
 
 
21
     CR              = #$0D;
 
22
     LF              = #$0A;
 
23
 
 
24
type
 
25
     THCIndexEntry = record
 
26
       Tag      : PString;
 
27
       TopicName: PString;
 
28
     end;
 
29
 
 
30
     THCTopic = record
 
31
       Name     : PString;
 
32
       Topic    : PTopic;
 
33
     end;
 
34
 
 
35
     PHCIndexEntryCollection = ^THCIndexEntryCollection;
 
36
     THCIndexEntryCollection = object(T
 
37
 
 
38
var SrcName, DestName: string;
 
39
    HelpFile        : THelpFileWriter;
 
40
 
 
41
procedure Print(const S: string);
 
42
begin
 
43
  writeln(S);
 
44
end;
 
45
 
 
46
procedure Abort; forward;
 
47
 
 
48
procedure Help;
 
49
begin
 
50
  Print('Syntax : TPHC <helpsource>[.TXT] <helpfile>[.FPH]');
 
51
  Abort;
 
52
end;
 
53
 
 
54
procedure Fatal(const S: string);
 
55
begin
 
56
  Print('Fatal: '+S);
 
57
  Abort;
 
58
end;
 
59
 
 
60
procedure Warning(const S: string);
 
61
begin
 
62
  Print('Warning: '+S);
 
63
end;
 
64
 
 
65
procedure ProcessParams;
 
66
begin
 
67
  if (ParamCount<1) or (ParamCount>2) then Help;
 
68
  SrcName:=ParamStr(1);
 
69
  if ExtOf(SrcName)='' then SrcName:=SrcName+SrcExt;
 
70
  if ParamCount=1 then
 
71
    DestName:=DirAndNameOf(SrcName)+HelpExt
 
72
  else
 
73
    begin
 
74
      DestName:=ParamStr(2);
 
75
      if ExtOf(DestName)='' then DestName:=DestName+HelpExt;
 
76
    end;
 
77
end;
 
78
 
 
79
procedure Compile(SrcS, DestS: PStream);
 
80
var CurLine: string;
 
81
    CurLineNo: longint;
 
82
    CurTopic : PTopic;
 
83
    HelpFile: PHelpFileWriter;
 
84
    InCode: boolean;
 
85
    NextTempTopic: longint;
 
86
procedure AddLine(const S: string);
 
87
begin
 
88
  if CurTopic<>nil then
 
89
    HelpFile^.AddLineToTopic(CurTopic,S);
 
90
end;
 
91
procedure ProcessToken(S: string);
 
92
var P: byte;
 
93
    Token: string;
 
94
    TopicName: string;
 
95
    TopicContext: THelpCtx;
 
96
    Text: string;
 
97
begin
 
98
  S:=Trim(S);
 
99
  P:=Pos(' ',S); if P=0 then P:=length(S)+1;
 
100
  Token:=UpcaseStr(copy(S,1,P-1)); Delete(S,1,P); S:=Trim(S);
 
101
  if Token=TokenIndex then
 
102
    begin
 
103
      if InCode then AddLine(hscCode);
 
104
      if copy(S,1,1)<>'{' then
 
105
        Fatal('"{" expected at line '+IntToStr(CurLineNo));
 
106
      if copy(S,length(S),1)<>'}' then
 
107
        Fatal('"}" expected at line '+IntToStr(CurLineNo));
 
108
      S:=copy(S,2,length(S)-2);
 
109
      P:=Pos(':',S); if P=0 then P:=length(S)+1;
 
110
      Text:=copy(S,1,!!
 
111
    end else
 
112
  if Token=TokenTopic then
 
113
    begin
 
114
      if InCode then AddLine(hscCode);
 
115
      P:=Pos(' ',S); if P=0 then P:=length(S)+1;
 
116
      TopicName:=UpcaseStr(copy(S,1,P-1)); Delete(S,1,P); S:=Trim(S);
 
117
      if TopicName='' then
 
118
        Fatal('Topic name missing at line '+IntToStr(CurLineNo));
 
119
      if S='' then
 
120
        TopicContext:=0
 
121
      else
 
122
        if copy(S,1,1)<>'=' then
 
123
          begin
 
124
            Fatal('"=" expected at line '+IntToStr(CurLineNo));
 
125
            TopicContext:=0;
 
126
          end
 
127
        else
 
128
          begin
 
129
            S:=Trim(copy(S,2,255));
 
130
            TopicContext:=StrToInt(S);
 
131
            if LastStrToIntResult<>0 then
 
132
              Fatal('Error interpreting context number at line '+IntToStr(CurLineNo));
 
133
          end;
 
134
      if TopicContext=0 then
 
135
        begin
 
136
          TopicContext:=NextTempTopic;
 
137
          Inc(NextTempTopic);
 
138
        end;
 
139
      CurTopic:=HelpFile^.CreateTopic(TopicContext);
 
140
    end else
 
141
  if Token=TokenCode then
 
142
    begin
 
143
      AddLine(hscCode);
 
144
      InCode:=not InCode;
 
145
    end else
 
146
  Warning('Uknown token "'+Token+'" encountered at line '+IntToStr(CurLineNo));
 
147
end;
 
148
procedure ProcessLine(const S: string);
 
149
begin
 
150
  AddLine(S);
 
151
end;
 
152
function ReadNextLine: boolean;
 
153
var C: char;
 
154
begin
 
155
  Inc(CurLineNo);
 
156
  CurLine:='';
 
157
  repeat
 
158
    SrcS^.Read(C,1);
 
159
    if (C in[CR,LF])=false then
 
160
      CurLine:=CurLine+C;
 
161
  until (C=LF) or (SrcS^.Status<>stOK);
 
162
  ReadNextLine:=(SrcS^.Status=stOK);
 
163
end;
 
164
var OK: boolean;
 
165
begin
 
166
  New(HelpFile, InitStream(DestS,0));
 
167
  CurTopic:=nil; CurLineNo:=0;
 
168
  NextTempTopic:=FirstTempTopic;
 
169
  InCode:=false;
 
170
  repeat
 
171
    OK:=ReadNextLine;
 
172
    if OK then
 
173
    if copy(CurLine,1,length(CommentPrefix))=CommentPrefix then
 
174
      { comment }
 
175
    else
 
176
    if copy(CurLine,1,length(TokenPrefix))=TokenPrefix then
 
177
      ProcessToken(copy(CurLine,2,255))
 
178
    else
 
179
    { normal help-text }
 
180
    begin
 
181
      ProcessLine(CurLine);
 
182
    end;
 
183
  until OK=false;
 
184
  if HelpFile^.WriteFile=false then
 
185
    Fatal('Error writing help file.');
 
186
  Dispose(HelpFile, Done);
 
187
end;
 
188
 
 
189
const SrcS  : PBufStream = nil;
 
190
      DestS : PBufStream = nil;
 
191
 
 
192
procedure Abort;
 
193
begin
 
194
  if SrcS<>nil then Dispose(SrcS, Done); SrcS:=nil;
 
195
  if DestS<>nil then Dispose(DestS, Done); DestS:=nil;
 
196
end;
 
197
 
 
198
BEGIN
 
199
  Print('� Help Compiler  Version 0.9  Copyright (c) 1999 by B�rczi G�bor');
 
200
  ProcessParams;
 
201
  New(SrcS, Init(SrcName, stOpenRead, 4096));
 
202
  if (SrcS=nil) or (SrcS^.Status<>stOK) then
 
203
    Fatal('Error opening source file.');
 
204
  New(DestS, Init(DestName, stCreate, 4096));
 
205
  if (DestS=nil) or (DestS^.Status<>stOK) then
 
206
    Fatal('Error creating destination file.');
 
207
  Compile(SrcS,DestS);
 
208
END.