mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 16:09:17 +02:00
- removed directory with non-working sources as well with copyrighted sources
git-svn-id: trunk@11019 -
This commit is contained in:
florian
parent
3d17adaeeb
commit
c9433c0b1f
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -705,8 +705,6 @@ ide/test1.pas svneol=native#text/plain
|
|||||||
ide/test2.pas svneol=native#text/plain
|
ide/test2.pas svneol=native#text/plain
|
||||||
ide/tpgrep.tdf -text
|
ide/tpgrep.tdf -text
|
||||||
ide/unit.pt -text
|
ide/unit.pt -text
|
||||||
ide/utils/grep2msg.pas svneol=native#text/plain
|
|
||||||
ide/utils/tphc.pas svneol=native#text/plain
|
|
||||||
ide/vesa.pas svneol=native#text/plain
|
ide/vesa.pas svneol=native#text/plain
|
||||||
ide/wansi.pas svneol=native#text/plain
|
ide/wansi.pas svneol=native#text/plain
|
||||||
ide/wcedit.pas svneol=native#text/plain
|
ide/wcedit.pas svneol=native#text/plain
|
||||||
|
|||||||
7
.gitignore
vendored
7
.gitignore
vendored
@ -187,13 +187,6 @@ ide/fakegdb/fpcmade.*
|
|||||||
ide/fakegdb/units
|
ide/fakegdb/units
|
||||||
ide/fpcmade.*
|
ide/fpcmade.*
|
||||||
ide/units
|
ide/units
|
||||||
ide/utils/*.bak
|
|
||||||
ide/utils/*.exe
|
|
||||||
ide/utils/*.o
|
|
||||||
ide/utils/*.ppu
|
|
||||||
ide/utils/*.s
|
|
||||||
ide/utils/fpcmade.*
|
|
||||||
ide/utils/units
|
|
||||||
installer/*.bak
|
installer/*.bak
|
||||||
installer/*.exe
|
installer/*.exe
|
||||||
installer/*.o
|
installer/*.o
|
||||||
|
|||||||
@ -1,101 +0,0 @@
|
|||||||
{************************************************}
|
|
||||||
{ }
|
|
||||||
{ Grep message filter example }
|
|
||||||
{ Copyright (c) 1992 by Borland International }
|
|
||||||
{ }
|
|
||||||
{************************************************}
|
|
||||||
|
|
||||||
program Grep2Msg;
|
|
||||||
|
|
||||||
{ Message filters read input from the target program (in this case, GREP)
|
|
||||||
by way of StdIn (by using Read or ReadLn), filter the input, then write
|
|
||||||
output back to StdOut (using Write or WriteLn). The IDE takes care of
|
|
||||||
redirecting the transfer program's output to the filter program, as well
|
|
||||||
as redirecting the filter program's output back to the IDE itself.
|
|
||||||
}
|
|
||||||
|
|
||||||
{$I-,S-}
|
|
||||||
|
|
||||||
var
|
|
||||||
LineNo, E: Word;
|
|
||||||
P1,P2: integer;
|
|
||||||
Line: String;
|
|
||||||
InputBuffer: array[0..4095] of Char;
|
|
||||||
OutputBuffer: array[0..4095] of Char;
|
|
||||||
|
|
||||||
|
|
||||||
{ The first data passed back to the IDE by a message filter must always
|
|
||||||
be the string 'BI#PIP#OK', followed by a null terminator.
|
|
||||||
}
|
|
||||||
procedure WriteHeader;
|
|
||||||
begin
|
|
||||||
Write('BI#PIP#OK'#0);
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ The beginning of a new file is marked by a #0, the file's name, terminated
|
|
||||||
by a #0 character.
|
|
||||||
}
|
|
||||||
procedure WriteNewFile(const FileName: String);
|
|
||||||
begin
|
|
||||||
Write(#0, FileName, #0);
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ Each message line begins with a #1, followed the line number (in low/high
|
|
||||||
order), followed by the column number (in low/high order), then the
|
|
||||||
message text itself, terminated with a #0 character.
|
|
||||||
}
|
|
||||||
procedure WriteMessage(Line, Col: Word; const Message: String);
|
|
||||||
begin
|
|
||||||
Write(#1, Chr(Lo(Line)), Chr(Hi(Line)), Chr(Lo(Col)), Chr(Hi(Col)),
|
|
||||||
Message, #0);
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ The end of the input stream is marked by a #127 character }
|
|
||||||
procedure WriteEnd;
|
|
||||||
begin
|
|
||||||
Write(#127);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TrimLeft(S:String): String;
|
|
||||||
var
|
|
||||||
i: Integer;
|
|
||||||
n: String;
|
|
||||||
begin
|
|
||||||
i := 1;
|
|
||||||
while (i <= Length(s)) and (s[i] = #32) do Inc(i);
|
|
||||||
if i <= Length(s) then
|
|
||||||
begin
|
|
||||||
Move(s[i], n[1], Length(s) - i + 1);
|
|
||||||
n[0] := Char(Length(s) - i + 1);
|
|
||||||
end
|
|
||||||
else n[0] := #0;
|
|
||||||
TrimLeft := n;
|
|
||||||
end;
|
|
||||||
|
|
||||||
const LastFileName: string = '';
|
|
||||||
|
|
||||||
begin
|
|
||||||
SetTextBuf(Input, InputBuffer);
|
|
||||||
SetTextBuf(Output, OutputBuffer);
|
|
||||||
WriteHeader;
|
|
||||||
while not Eof do
|
|
||||||
begin
|
|
||||||
ReadLn(Line);
|
|
||||||
if Line <> '' then
|
|
||||||
begin
|
|
||||||
P1:=Pos(':',Line);
|
|
||||||
if copy(Line, 1, P1)<>LastFileName then
|
|
||||||
begin
|
|
||||||
LastFileName:=copy(Line,1,P1-1);
|
|
||||||
WriteNewFile(LastFileName);
|
|
||||||
end;
|
|
||||||
P2:=Pos(':',copy(Line,P1+1,255));
|
|
||||||
if P2>0 then
|
|
||||||
begin
|
|
||||||
Val(Copy(Line, P1+1, P2-1), LineNo, E);
|
|
||||||
if E = 0 then WriteMessage(LineNo, 1, TrimLeft(Copy(Line, P1+1+P2, 132)));
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
WriteEnd;
|
|
||||||
end.
|
|
||||||
@ -1,208 +0,0 @@
|
|||||||
{
|
|
||||||
!!! Someone please fix DRIVERS.PAS, so it doesn't clears the screen on exit
|
|
||||||
when we didn't use any of it's functions, just had it in 'uses'
|
|
||||||
|
|
||||||
Then we can delete GetDosTicks() from WHelp...
|
|
||||||
}
|
|
||||||
|
|
||||||
uses Objects,WUtils,WHelp,WTPHWriter;
|
|
||||||
|
|
||||||
const
|
|
||||||
SrcExt = '.txt';
|
|
||||||
HelpExt = '.fph';
|
|
||||||
TokenPrefix = '.';
|
|
||||||
CommentPrefix = ';';
|
|
||||||
TokenIndex = 'INDEX';
|
|
||||||
TokenTopic = 'TOPIC';
|
|
||||||
TokenCode = 'CODE';
|
|
||||||
|
|
||||||
FirstTempTopic = 1000000;
|
|
||||||
|
|
||||||
CR = #$0D;
|
|
||||||
LF = #$0A;
|
|
||||||
|
|
||||||
type
|
|
||||||
THCIndexEntry = record
|
|
||||||
Tag : PString;
|
|
||||||
TopicName: PString;
|
|
||||||
end;
|
|
||||||
|
|
||||||
THCTopic = record
|
|
||||||
Name : PString;
|
|
||||||
Topic : PTopic;
|
|
||||||
end;
|
|
||||||
|
|
||||||
PHCIndexEntryCollection = ^THCIndexEntryCollection;
|
|
||||||
THCIndexEntryCollection = object(T
|
|
||||||
|
|
||||||
var SrcName, DestName: string;
|
|
||||||
HelpFile : THelpFileWriter;
|
|
||||||
|
|
||||||
procedure Print(const S: string);
|
|
||||||
begin
|
|
||||||
writeln(S);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure Abort; forward;
|
|
||||||
|
|
||||||
procedure Help;
|
|
||||||
begin
|
|
||||||
Print('Syntax : TPHC <helpsource>[.TXT] <helpfile>[.FPH]');
|
|
||||||
Abort;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure Fatal(const S: string);
|
|
||||||
begin
|
|
||||||
Print('Fatal: '+S);
|
|
||||||
Abort;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure Warning(const S: string);
|
|
||||||
begin
|
|
||||||
Print('Warning: '+S);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure ProcessParams;
|
|
||||||
begin
|
|
||||||
if (ParamCount<1) or (ParamCount>2) then Help;
|
|
||||||
SrcName:=ParamStr(1);
|
|
||||||
if ExtOf(SrcName)='' then SrcName:=SrcName+SrcExt;
|
|
||||||
if ParamCount=1 then
|
|
||||||
DestName:=DirAndNameOf(SrcName)+HelpExt
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
DestName:=ParamStr(2);
|
|
||||||
if ExtOf(DestName)='' then DestName:=DestName+HelpExt;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure Compile(SrcS, DestS: PStream);
|
|
||||||
var CurLine: string;
|
|
||||||
CurLineNo: longint;
|
|
||||||
CurTopic : PTopic;
|
|
||||||
HelpFile: PHelpFileWriter;
|
|
||||||
InCode: boolean;
|
|
||||||
NextTempTopic: longint;
|
|
||||||
procedure AddLine(const S: string);
|
|
||||||
begin
|
|
||||||
if CurTopic<>nil then
|
|
||||||
HelpFile^.AddLineToTopic(CurTopic,S);
|
|
||||||
end;
|
|
||||||
procedure ProcessToken(S: string);
|
|
||||||
var P: byte;
|
|
||||||
Token: string;
|
|
||||||
TopicName: string;
|
|
||||||
TopicContext: THelpCtx;
|
|
||||||
Text: string;
|
|
||||||
begin
|
|
||||||
S:=Trim(S);
|
|
||||||
P:=Pos(' ',S); if P=0 then P:=length(S)+1;
|
|
||||||
Token:=UpcaseStr(copy(S,1,P-1)); Delete(S,1,P); S:=Trim(S);
|
|
||||||
if Token=TokenIndex then
|
|
||||||
begin
|
|
||||||
if InCode then AddLine(hscCode);
|
|
||||||
if copy(S,1,1)<>'{' then
|
|
||||||
Fatal('"{" expected at line '+IntToStr(CurLineNo));
|
|
||||||
if copy(S,length(S),1)<>'}' then
|
|
||||||
Fatal('"}" expected at line '+IntToStr(CurLineNo));
|
|
||||||
S:=copy(S,2,length(S)-2);
|
|
||||||
P:=Pos(':',S); if P=0 then P:=length(S)+1;
|
|
||||||
Text:=copy(S,1,!!
|
|
||||||
end else
|
|
||||||
if Token=TokenTopic then
|
|
||||||
begin
|
|
||||||
if InCode then AddLine(hscCode);
|
|
||||||
P:=Pos(' ',S); if P=0 then P:=length(S)+1;
|
|
||||||
TopicName:=UpcaseStr(copy(S,1,P-1)); Delete(S,1,P); S:=Trim(S);
|
|
||||||
if TopicName='' then
|
|
||||||
Fatal('Topic name missing at line '+IntToStr(CurLineNo));
|
|
||||||
if S='' then
|
|
||||||
TopicContext:=0
|
|
||||||
else
|
|
||||||
if copy(S,1,1)<>'=' then
|
|
||||||
begin
|
|
||||||
Fatal('"=" expected at line '+IntToStr(CurLineNo));
|
|
||||||
TopicContext:=0;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
S:=Trim(copy(S,2,255));
|
|
||||||
TopicContext:=StrToInt(S);
|
|
||||||
if LastStrToIntResult<>0 then
|
|
||||||
Fatal('Error interpreting context number at line '+IntToStr(CurLineNo));
|
|
||||||
end;
|
|
||||||
if TopicContext=0 then
|
|
||||||
begin
|
|
||||||
TopicContext:=NextTempTopic;
|
|
||||||
Inc(NextTempTopic);
|
|
||||||
end;
|
|
||||||
CurTopic:=HelpFile^.CreateTopic(TopicContext);
|
|
||||||
end else
|
|
||||||
if Token=TokenCode then
|
|
||||||
begin
|
|
||||||
AddLine(hscCode);
|
|
||||||
InCode:=not InCode;
|
|
||||||
end else
|
|
||||||
Warning('Uknown token "'+Token+'" encountered at line '+IntToStr(CurLineNo));
|
|
||||||
end;
|
|
||||||
procedure ProcessLine(const S: string);
|
|
||||||
begin
|
|
||||||
AddLine(S);
|
|
||||||
end;
|
|
||||||
function ReadNextLine: boolean;
|
|
||||||
var C: char;
|
|
||||||
begin
|
|
||||||
Inc(CurLineNo);
|
|
||||||
CurLine:='';
|
|
||||||
repeat
|
|
||||||
SrcS^.Read(C,1);
|
|
||||||
if (C in[CR,LF])=false then
|
|
||||||
CurLine:=CurLine+C;
|
|
||||||
until (C=LF) or (SrcS^.Status<>stOK);
|
|
||||||
ReadNextLine:=(SrcS^.Status=stOK);
|
|
||||||
end;
|
|
||||||
var OK: boolean;
|
|
||||||
begin
|
|
||||||
New(HelpFile, InitStream(DestS,0));
|
|
||||||
CurTopic:=nil; CurLineNo:=0;
|
|
||||||
NextTempTopic:=FirstTempTopic;
|
|
||||||
InCode:=false;
|
|
||||||
repeat
|
|
||||||
OK:=ReadNextLine;
|
|
||||||
if OK then
|
|
||||||
if copy(CurLine,1,length(CommentPrefix))=CommentPrefix then
|
|
||||||
{ comment }
|
|
||||||
else
|
|
||||||
if copy(CurLine,1,length(TokenPrefix))=TokenPrefix then
|
|
||||||
ProcessToken(copy(CurLine,2,255))
|
|
||||||
else
|
|
||||||
{ normal help-text }
|
|
||||||
begin
|
|
||||||
ProcessLine(CurLine);
|
|
||||||
end;
|
|
||||||
until OK=false;
|
|
||||||
if HelpFile^.WriteFile=false then
|
|
||||||
Fatal('Error writing help file.');
|
|
||||||
Dispose(HelpFile, Done);
|
|
||||||
end;
|
|
||||||
|
|
||||||
const SrcS : PBufStream = nil;
|
|
||||||
DestS : PBufStream = nil;
|
|
||||||
|
|
||||||
procedure Abort;
|
|
||||||
begin
|
|
||||||
if SrcS<>nil then Dispose(SrcS, Done); SrcS:=nil;
|
|
||||||
if DestS<>nil then Dispose(DestS, Done); DestS:=nil;
|
|
||||||
end;
|
|
||||||
|
|
||||||
BEGIN
|
|
||||||
Print('þ Help Compiler Version 0.9 Copyright (c) 1999 by B‚rczi G bor');
|
|
||||||
ProcessParams;
|
|
||||||
New(SrcS, Init(SrcName, stOpenRead, 4096));
|
|
||||||
if (SrcS=nil) or (SrcS^.Status<>stOK) then
|
|
||||||
Fatal('Error opening source file.');
|
|
||||||
New(DestS, Init(DestName, stCreate, 4096));
|
|
||||||
if (DestS=nil) or (DestS^.Status<>stOK) then
|
|
||||||
Fatal('Error creating destination file.');
|
|
||||||
Compile(SrcS,DestS);
|
|
||||||
END.
|
|
||||||
Loading…
Reference in New Issue
Block a user