paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 12:07:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

- removed directory with non-working sources as well with copyrighted sources

Browse Source 
git-svn-id: trunk@11019 -
This commit is contained in:
florian 2008-05-19 20:20:01 +00:00
parent 3d17adaeeb
commit c9433c0b1f
4 changed files with 0 additions and 318 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -705,8 +705,6 @@ ide/test1.pas svneol=native#text/plain
ide/test2.pas svneol=native#text/plain
ide/tpgrep.tdf -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/wansi.pas svneol=native#text/plain
ide/wcedit.pas svneol=native#text/plain

7
.gitignore vendored
View File

@ -187,13 +187,6 @@ ide/fakegdb/fpcmade.*
ide/fakegdb/units
ide/fpcmade.*
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/*.exe
installer/*.o

101
ide/utils/grep2msg.pas
View File

@ -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.

208
ide/utils/tphc.pas
View File

@ -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.