paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-24 13:32:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: Cleaned ifdefs related to Turbo Pascal and FPC 1.x

Browse Source 
git-svn-id: trunk@11423 -
This commit is contained in:
giulio 2008-07-20 21:37:48 +00:00
parent 22df9855d9
commit 157b00a44a
40 changed files with 165 additions and 1144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -694,11 +694,9 @@ ide/globdir.inc svneol=native#text/plain
ide/gplprog.pt -text
ide/gplunit.pt -text
ide/grep.tdf -text
ide/maketp.bat -text
ide/pmode.pas svneol=native#text/plain
ide/program.pt -text
ide/readme.ide -text
ide/realintr.inc svneol=native#text/plain
ide/test.pas svneol=native#text/plain
ide/test1.pas svneol=native#text/plain
ide/test2.pas svneol=native#text/plain

13
ide/fp.pas
View File

@ -25,7 +25,6 @@ program FP;
(**********************************************************************)
(* CONDITIONAL DEFINES *)
(* - NODEBUG No Debugging support *)
(* - TP Turbo Pascal mode *)
(* - i386 Target is an i386 IDE *)
(**********************************************************************)
@ -47,9 +46,7 @@ uses
{$ifdef go32v2}
dpmiexcp,
{$endif go32v2}
{$ifdef fpc}
keyboard,video,mouse,
{$endif fpc}
{$ifdef HasSignal}
fpcatch,
{$endif HasSignal}
@ -79,7 +76,6 @@ uses
systems,globtype,globals;
{$ifdef fpc}
Const
DummyMouseDriver : TMouseDriver = (
useDefaultQueue : true;
@ -96,7 +92,6 @@ Const
PollMouseEvent : nil;
PutMouseEvent : nil;
);
{$endif fpc}
{$ifdef useresstrings}
resourcestring
@ -192,13 +187,10 @@ begin
if Length(Param)=1 then
begin
UseMouse:=false;
{$ifdef fpc}
DoneMouse;
SetMouseDriver(DummyMouseDriver);
{$endif fpc}
ButtonCount:=0;
end;
{$ifdef fpc}
{ 'F' :
if Length(Param)=1 then
NoExtendedFrame:=true;}
@ -206,7 +198,6 @@ begin
'T' : DebuggeeTTY:=Copy(Param,2,High(Param));
{$endif Unix}
{ 'M' : TryToMaximizeScreen:=true;}
{$endif fpc}
{$ifdef DEBUG}
'Z' : UseOldBufStreamMethod:=true;
'X' : CloseImmediately:=true;
@ -219,7 +210,7 @@ begin
end;
end;
Procedure MyStreamError(Var S: TStream); {$ifndef FPC}far;{$endif}
Procedure MyStreamError(Var S: TStream);
var ErrS: string;
begin
case S.Status of
@ -553,13 +544,11 @@ BEGIN
DoneBreakpoints;
DoneWatches;
{$endif}
{$ifdef fpc}
{$ifdef unix}
Video.ClearScreen;
{$endif unix}
{ Video.DoneVideo;
Keyboard.DoneKeyboard;}
{$endif fpc}
{$ifdef VESA}
DoneVESAScreenModes;
{$endif}

12
ide/fpcalc.pas
View File

@ -101,12 +101,8 @@ implementation
uses
{$ifdef Unix}
{$ifdef VER1_0}
linux,
{$else}
baseunix,
unix,
{$endif}
baseunix,
unix,
{$endif}
{$ifdef go32v2}
dpmiexcp,
@ -297,7 +293,7 @@ begin
{$endif HasSignal}
begin
{$ifdef HasSignal}
StoreSigFPE:={$ifdef unix}{$ifdef ver1_0}Signal{$else}fpSignal{$endif}{$else}Signal{$endif}(SIGFPE,@CalcSigFPE);
StoreSigFPE:={$ifdef unix}fpSignal{$else}Signal{$endif}(SIGFPE,@CalcSigFPE);
{$endif HasSignal}
if (Status = csError) and (Key <> 'C') then Key := ' ';
if HexShown then
@ -396,7 +392,7 @@ begin
else CalcKey:=false;
end;
{$ifdef HasSignal}
{$ifdef unix}{$ifdef ver1_0}Signal{$else}fpSignal{$endif}{$else}Signal{$endif}(SIGFPE,StoreSigFPE);
{$ifdef unix}fpSignal{$else}Signal{$endif}(SIGFPE,StoreSigFPE);
{$endif HasSignal}
DrawView;
{$ifdef HasSignal}

30
ide/fpcatch.pas
View File

@ -19,12 +19,8 @@ interface
{$ifdef Unix}
uses
{$ifdef VER1_0}
linux;
{$else}
baseunix,
unix;
{$endif}
baseunix,
unix;
{$endif}
{$ifdef go32v2}
uses
@ -182,14 +178,12 @@ begin
IF NOT CtrlCPressed and Assigned(Application) then
begin
MustQuit:=false;
{$ifdef FPC}
if GetDosTicks>LastCtrlC+10 then
begin
CtrlCPressed:=true;
Keyboard.PutKeyEvent((kbCtrl shl 16) or kbCtrlC);
LastCtrlC:=GetDosTicks;
end;
{$endif FPC}
end
else
begin
@ -251,15 +245,11 @@ begin
}
{$endif go32v2}
{$ifdef HasSignal}
{$ifndef TP}
NewSignal:=@CatchSignal;
{$else TP}
NewSignal:=SignalHandler(CatchSignal);
{$endif TP}
OldSigSegm:={$ifdef unix}{$ifdef ver1_0}Signal{$else}fpSignal{$endif}{$else}Signal{$endif}(SIGSEGV,NewSignal);
OldSigInt:={$ifdef unix}{$ifdef ver1_0}Signal{$else}fpSignal{$endif}{$else}Signal{$endif}(SIGINT,NewSignal);
OldSigFPE:={$ifdef unix}{$ifdef ver1_0}Signal{$else}fpSignal{$endif}{$else}Signal{$endif}(SIGFPE,NewSignal);
OldSigILL:={$ifdef unix}{$ifdef ver1_0}Signal{$else}fpSignal{$endif}{$else}Signal{$endif}(SIGILL,NewSignal);
OldSigSegm:={$ifdef unix}fpSignal{$else}Signal{$endif}(SIGSEGV,NewSignal);
OldSigInt:={$ifdef unix}fpSignal{$else}Signal{$endif}(SIGINT,NewSignal);
OldSigFPE:={$ifdef unix}fpSignal{$else}Signal{$endif}(SIGFPE,NewSignal);
OldSigILL:={$ifdef unix}fpSignal{$else}Signal{$endif}(SIGILL,NewSignal);
CatchSignalsEnabled:=true;
{$endif}
end;
@ -269,10 +259,10 @@ begin
{$ifdef HasSignal}
if not CatchSignalsEnabled then
exit;
{$ifdef unix}{$ifdef ver1_0}Signal{$else}fpSignal{$endif}{$else}Signal{$endif}(SIGSEGV,OldSigSegm);
{$ifdef unix}{$ifdef ver1_0}Signal{$else}fpSignal{$endif}{$else}Signal{$endif}(SIGINT,OldSigInt);
{$ifdef unix}{$ifdef ver1_0}Signal{$else}fpSignal{$endif}{$else}Signal{$endif}(SIGFPE,OldSigFPE);
{$ifdef unix}{$ifdef ver1_0}Signal{$else}fpSignal{$endif}{$else}Signal{$endif}(SIGILL,OldSigILL);
{$ifdef unix}fpSignal{$else}Signal{$endif}(SIGSEGV,OldSigSegm);
{$ifdef unix}fpSignal{$else}Signal{$endif}(SIGINT,OldSigInt);
{$ifdef unix}fpSignal{$else}Signal{$endif}(SIGFPE,OldSigFPE);
{$ifdef unix}fpSignal{$else}Signal{$endif}(SIGILL,OldSigILL);
CatchSignalsEnabled:=false;
{$endif}
end;

2
ide/fpcodcmp.pas
View File

@ -221,7 +221,7 @@ var
Level : longint;
UpStandardUnits : string;
procedure InsertInS(P: PSymbol); {$ifndef FPC}far;{$endif}
procedure InsertInS(P: PSymbol);
procedure InsertItemsInS(P: PSymbolCollection);
var I: Sw_integer;

17
ide/fpcompil.pas
View File

@ -138,9 +138,7 @@ uses
fpcatch,
{ $endif HasSignal}
Dos,
{$ifdef fpc}
Video,
{$endif fpc}
globals,
StdDlg,App,tokens,
FVConsts,
@ -692,7 +690,7 @@ end;
const
lasttime : real = 0;
function CompilerStatus: boolean; {$ifndef FPC}far;{$endif}
function CompilerStatus: boolean;
var
event : tevent;
@ -735,7 +733,7 @@ begin
CompilerStatus:=false;
end;
Function CompilerGetNamedFileTime(const filename : string) : Longint; {$ifndef FPC}far;{$endif}
Function CompilerGetNamedFileTime(const filename : string) : Longint;
var t: longint;
W: PSourceWindow;
begin
@ -747,7 +745,7 @@ begin
CompilerGetNamedFileTime:=t;
end;
function CompilerOpenInputFile(const filename: string): tinputfile; {$ifndef FPC}far;{$endif}
function CompilerOpenInputFile(const filename: string): tinputfile;
var f: tinputfile;
W: PSourceWindow;
begin
@ -765,7 +763,7 @@ begin
CompilerOpenInputFile:=f;
end;
function CompilerComment(Level:Longint; const s:ansistring):boolean; {$ifndef FPC}far;{$endif}
function CompilerComment(Level:Longint; const s:ansistring):boolean;
begin
CompilerComment:=false;
if (status.verbosity and Level)<>0 then
@ -851,7 +849,7 @@ begin
end;
procedure ResetErrorMessages;
procedure ResetErrorLine(P: PView); {$ifndef FPC}far;{$endif}
procedure ResetErrorLine(P: PView);
begin
if assigned(P) and
(TypeOf(P^)=TypeOf(TSourceWindow)) then
@ -1004,14 +1002,9 @@ begin
ChangeRedirError(FPErrFileName,false);
{$endif}
{$ifdef Unix}
{$ifdef ver1_0}
Shell(GetExePath+PpasFile);
Error:=LinuxError;
{$else}
error:=0;
If Shell(GetExePath+PpasFile)=-1 Then
Error:=fpgeterrno;
{$endif}
{$else}
DosExecute(GetEnv('COMSPEC'),'/C '+GetExePath+PpasFile);
Error:=DosError;

38
ide/fpdebug.pas
View File

@ -330,9 +330,7 @@ implementation
uses
Dos,
{$ifdef fpc}
Video,
{$endif fpc}
{$ifdef DOS}
fpusrscr,
{$endif DOS}
@ -342,11 +340,7 @@ uses
Windebug,
{$endif Windows}
{$ifdef Unix}
{$ifdef VER1_0}
Linux,
{$else}
termio,
{$endif}
termio,
{$endif Unix}
Systems,Globals,
FPRegs,
@ -529,14 +523,6 @@ const
{$define FrameNameKnown}
{$endif powerpc}
{$ifdef TP}
function HexStr(Value: longint; Len: byte): string;
begin
HexStr:=IntToHex(Value,Len);
end;
{$endif}
function GDBFileName(st : string) : string;
{$ifndef Unix}
var i : longint;
@ -719,9 +705,7 @@ begin
Command('dir '+GDBFileName(GetShortName(s+Dir.Name)));
Dos.FindNext(Dir);
end;
{$ifdef FPC}
Dos.FindClose(Dir);
{$endif def FPC}
end;
until i=0;
end;
@ -861,7 +845,7 @@ begin
Assign(Debuggeefile,DebuggeeTTY);
system.Reset(Debuggeefile);
ResetOK:=IOResult=0;
If ResetOK and {$ifdef ver1_0}IsATTY(textrec(Debuggeefile).handle){$else}(IsATTY(textrec(Debuggeefile).handle)<>-1){$endif} then
If ResetOK and (IsATTY(textrec(Debuggeefile).handle)<>-1) then
begin
Command('tty '+DebuggeeTTY);
TTYUsed:=true;
@ -993,7 +977,7 @@ begin
end;
procedure TDebugController.ResetDebuggerRows;
procedure ResetDebuggerRow(P: PView); {$ifndef FPC}far;{$endif}
procedure ResetDebuggerRow(P: PView);
begin
if assigned(P) and
(TypeOf(P^)=TypeOf(TSourceWindow)) then
@ -1772,7 +1756,7 @@ end;
function TBreakpointCollection.GetGDB(index : longint) : PBreakpoint;
function IsNum(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
function IsNum(P : PBreakpoint) : boolean;
begin
IsNum:=P^.GDBIndex=index;
end;
@ -1786,14 +1770,14 @@ end;
procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow);
procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
procedure SetInSource(P : PBreakpoint);
begin
If assigned(P^.FileName) and
(OSFileName(P^.FileName^)=OSFileName(FExpand(PSourceWindow(W)^.Editor^.FileName))) then
PSourceWindow(W)^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
end;
procedure SetInDisassembly(P : PBreakpoint);{$ifndef FPC}far;{$endif}
procedure SetInDisassembly(P : PBreakpoint);
var
PDL : PDisasLine;
S : string;
@ -1838,7 +1822,7 @@ end;
procedure TBreakpointCollection.AdaptBreakpoints(Editor : PSourceEditor; Pos, Change : longint);
procedure AdaptInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
procedure AdaptInSource(P : PBreakpoint);
begin
If assigned(P^.FileName) and
(P^.FileName^=OSFileName(FExpand(Editor^.FileName))) then
@ -1876,7 +1860,7 @@ end;
function TBreakpointCollection.FindBreakpointAt(Editor : PSourceEditor; Line : longint) : PBreakpoint;
function IsAtLine(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
function IsAtLine(P : PBreakpoint) : boolean;
begin
If assigned(P^.FileName) and
(P^.FileName^=OSFileName(FExpand(Editor^.FileName))) and
@ -1892,7 +1876,7 @@ end;
procedure TBreakpointCollection.ShowAllBreakpoints;
procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
procedure SetInSource(P : PBreakpoint);
var
W : PSourceWindow;
begin
@ -1910,7 +1894,7 @@ end;
function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
function IsThis(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
function IsThis(P : PBreakpoint) : boolean;
begin
IsThis:=(P^.typ=typ) and (GetStr(P^.Name)=S);
end;
@ -1922,7 +1906,7 @@ end;
function TBreakpointCollection.ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
function IsThere(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
function IsThere(P : PBreakpoint) : boolean;
begin
IsThere:=(P^.typ=bt_file_line) and assigned(P^.FileName) and
(OSFileName(P^.FileName^)=FileName) and (P^.Line=LineNr);

2
ide/fpdesk.pas
View File

@ -585,7 +585,7 @@ end;
function WriteOpenWindows(F: PResourceFile): boolean;
var S: PMemoryStream;
procedure CollectInfo(P: PView); {$ifndef FPC}far;{$endif}
procedure CollectInfo(P: PView);
var W: PWindow;
SW: PSourceWindow absolute W;
WI: TWindowInfo;

4
ide/fphelp.pas
View File

@ -68,7 +68,7 @@ uses Objects,Views,App,MsgBox,
FPConst,FPVars,FPUtils;
const
MaxStatusLevel = {$ifdef FPC}10{$else}1{$endif};
MaxStatusLevel = 10;
var StatusStack : array[0..MaxStatusLevel] of string[MaxViewWidth];
@ -658,7 +658,7 @@ begin
end;
procedure CloseHelpWindows;
procedure CloseIfHelpWindow(P: PView); {$ifndef FPC}far;{$endif}
procedure CloseIfHelpWindow(P: PView);
begin
if P^.HelpCtx=hcHelpWindow then
begin

4
ide/fpide.pas
View File

@ -766,12 +766,12 @@ begin
GetTargetedEvent:=OK;
end;
function IDEUseSyntaxHighlight(Editor: PFileEditor): boolean; {$ifndef FPC}far;{$endif}
function IDEUseSyntaxHighlight(Editor: PFileEditor): boolean;
begin
IDEUseSyntaxHighlight:=(Editor^.IsFlagSet(efSyntaxHighlight)) and ((Editor^.FileName='') or MatchesFileList(NameAndExtOf(Editor^.FileName),HighlightExts));
end;
function IDEUseTabsPattern(Editor: PFileEditor): boolean; {$ifndef FPC}far;{$endif}
function IDEUseTabsPattern(Editor: PFileEditor): boolean;
begin
{ the commented code lead all new files
to become with TAB use enabled which is wrong in my opinion PM }

2
ide/fpini.pas
View File

@ -536,7 +536,7 @@ var INIFile: PINIFile;
I(*,OpenFileCount*): integer;
OK: boolean;
procedure ConcatName(P: PString); {$ifndef FPC}far;{$endif}
procedure ConcatName(P: PString);
begin
if (S<>'') then S:=S+';';
S:=S+P^;

12
ide/fpmfile.inc
View File

@ -93,10 +93,6 @@ begin
else
DriveNumber:=Ord(FileDir[1])-ord('A')+1;
GetDir(DriveNumber,StoreDir2);
{$ifndef FPC}
ChDir(Copy(FileDir,1,2));
{ sets InOutRes in Windows PM }
{$endif not FPC}
end;
if (FileDir<>'') and ExistsDir(FileDir) then
ChDir(TrimEndSlash(FileDir));
@ -117,10 +113,6 @@ begin
Dispose(D, Done);
if DriveNumber<>0 then
ChDir(TrimEndSlash(StoreDir2));
{$ifndef FPC}
if (Length(StoreDir)>1) and (StoreDir[2]=':') then
ChDir(Copy(StoreDir,1,2));
{$endif not FPC}
ChDir(TrimEndSlash(StoreDir));
end;
if OpenIt then
@ -188,7 +180,7 @@ begin
end;
function TIDEApp.AskSaveAll: boolean;
function CanClose(P: PView): boolean; {$ifndef FPC}far;{$endif}
function CanClose(P: PView): boolean;
begin
CanClose:=not P^.Valid(cmAskSaveAll);
end;
@ -198,7 +190,7 @@ end;
function TIDEApp.SaveAll: boolean;
procedure SendSave(P: PView); {$ifndef FPC}far;{$endif}
procedure SendSave(P: PView);
begin
Message(P,evCommand,cmSave,nil);
end;

6
ide/fpmsrch.inc
View File

@ -52,7 +52,7 @@ var R: TRect;
NameMatches:=(ProcS='') or (Pos(ProcS,UpcaseStr(St)) > 0);
end;
procedure InsertInS(P: PSymbol); {$ifndef FPC}far;{$endif}
procedure InsertInS(P: PSymbol);
procedure InsertItemsInS(P: PSymbolCollection);
var I: Sw_integer;
@ -120,7 +120,7 @@ var R: TRect;
Overflow: boolean;
Level : longint;
procedure InsertInS(P: PSymbol); {$ifndef FPC}far;{$endif}
procedure InsertInS(P: PSymbol);
procedure InsertItemsInS(P: PSymbolCollection);
var I: Sw_integer;
@ -165,7 +165,7 @@ procedure TIDEApp.Modules;
var
R: TRect;
S: PSortedSymbolCollection;
procedure InsertInS(P: PSymbol); {$ifndef FPC}far;{$endif}
procedure InsertInS(P: PSymbol);
begin
S^.Insert(P);
end;

4
ide/fpmwnd.inc
View File

@ -15,7 +15,7 @@
procedure TIDEApp.CloseAll;
procedure SendClose(P: PView); {$ifndef FPC}far;{$endif}
procedure SendClose(P: PView);
begin
Message(P,evCommand,cmClose,nil);
end;
@ -144,7 +144,7 @@ end;
procedure TWindowListDialog.UpdateList;
var VisState: boolean;
procedure AddIt(P: PView); {$ifndef FPC}far;{$endif}
procedure AddIt(P: PView);
begin
if (P<>pointer(Desktop^.Background)) and
(P^.GetState(sfDisabled)=false) and

166
ide/fpredir.pas
View File

@ -24,9 +24,6 @@ Interface
{$endif}
{$endif}
{$ifdef TP}
{$define implemented}
{$endif TP}
{$ifdef Go32v2}
{$define implemented}
{$endif}
@ -49,11 +46,6 @@ Interface
{$define implemented}
{$endif}
{ be sure msdos is not set for FPC compiler }
{$ifdef FPC}
{$UnDef MsDos}
{$endif FPC}
Var
IOStatus : Integer;
RedirErrorOut,RedirErrorIn,
@ -100,12 +92,8 @@ Uses
windows,
{$endif Windows}
{$ifdef unix}
{$ifdef ver1_0}
linux,
{$else}
baseunix,
unix,
{$endif}
baseunix,
unix,
{$endif unix}
dos;
@ -186,34 +174,6 @@ end;
{$ifdef implemented}
{$ifdef TP}
{$ifndef Windows}
const
UnusedHandle = -1;
StdInputHandle = 0;
StdOutputHandle = 1;
StdErrorHandle = 2;
{$endif Windows}
Type
PtrRec = packed record
Ofs, Seg : Word;
end;
PHandles = ^THandles;
THandles = Array [Byte] of Byte;
PWord = ^Word;
Var
MinBlockSize : Word;
MyBlockSize : Word;
Handles : PHandles;
PrefSeg : Word;
OldHandleOut,OldHandleIn,OldHandleError : Byte;
{$endif TP}
var
TempHOut, TempHIn,TempHError : longint;
@ -296,14 +256,6 @@ begin
end;
{$endif}
{$ifdef TP}
Function {$ifdef ver1_0}fdclose{$else}fpclose{$endif} (Handle : Longint) : boolean;
begin
{ if executed as under GO32 this hangs the DOS-prompt }
fpclose:=true;
end;
{$endif}
{$I-}
function FileExist(const FileName : PathStr) : Boolean;
var
@ -384,13 +336,6 @@ function ChangeRedirOut(Const Redir : String; AppendToFile : Boolean) : Boolean;
RedirErrorOut:=IOResult;
IOStatus:=RedirErrorOut;
If IOStatus <> 0 then Exit;
{$ifndef FPC}
Handles:=Ptr (prefseg, PWord (Ptr (prefseg, $34))^);
OldHandleOut:=Handles^[StdOutputHandle];
Handles^[StdOutputHandle]:=Handles^[FileRec (FOUT^).Handle];
ChangeRedirOut:=True;
OutRedirDisabled:=False;
{$else}
{$ifdef Windows}
if SetStdHandle(Std_Output_Handle,FileRec(FOUT^).Handle) then
{$else not Windows}
@ -403,7 +348,6 @@ function ChangeRedirOut(Const Redir : String; AppendToFile : Boolean) : Boolean;
ChangeRedirOut:=True;
OutRedirDisabled:=False;
end;
{$endif def FPC}
RedirChangedOut:=True;
end;
@ -417,13 +361,6 @@ function ChangeRedirIn(Const Redir : String) : Boolean;
RedirErrorIn:=IOResult;
IOStatus:=RedirErrorIn;
If IOStatus <> 0 then Exit;
{$ifndef FPC}
Handles:=Ptr (prefseg, PWord (Ptr (prefseg, $34))^);
OldHandleIn:=Handles^[StdInputHandle];
Handles^[StdInputHandle]:=Handles^[FileRec (FIN^).Handle];
ChangeRedirIn:=True;
InRedirDisabled:=False;
{$else}
{$ifdef Windows}
if SetStdHandle(Std_Input_Handle,FileRec(FIN^).Handle) then
{$else not Windows}
@ -436,7 +373,6 @@ function ChangeRedirIn(Const Redir : String) : Boolean;
ChangeRedirIn:=True;
InRedirDisabled:=False;
end;
{$endif def FPC}
RedirChangedIn:=True;
end;
@ -454,13 +390,6 @@ function ChangeRedirError(Const Redir : String; AppendToFile : Boolean) : Boolea
RedirErrorError:=IOResult;
IOStatus:=RedirErrorError;
If IOStatus <> 0 then Exit;
{$ifndef FPC}
Handles:=Ptr (prefseg, PWord (Ptr (prefseg, $34))^);
OldHandleError:=Handles^[StdErrorHandle];
Handles^[StdErrorHandle]:=Handles^[FileRec (FERR^).Handle];
ChangeRedirError:=True;
ErrorRedirDisabled:=False;
{$else}
{$ifdef Windows}
if SetStdHandle(Std_Error_Handle,FileRec(FERR^).Handle) then
{$else not Windows}
@ -473,59 +402,18 @@ function ChangeRedirError(Const Redir : String; AppendToFile : Boolean) : Boolea
ChangeRedirError:=True;
ErrorRedirDisabled:=False;
end;
{$endif}
RedirChangedError:=True;
end;
{$IfDef MsDos}
{Set HeapEnd Pointer to Current Used Heapsize}
Procedure SmallHeap;assembler;
asm
mov bx,word ptr HeapPtr
shr bx,4
inc bx
add bx,word ptr HeapPtr+2
mov ax,PrefixSeg
sub bx,ax
mov es,ax
mov ah,4ah
int 21h
end;
{Set HeapEnd Pointer to Full Heapsize}
Procedure FullHeap;assembler;
asm
mov bx,word ptr HeapEnd
shr bx,4
inc bx
add bx,word ptr HeapEnd+2
mov ax,PrefixSeg
sub bx,ax
mov es,ax
mov ah,4ah
int 21h
end;
{$EndIf MsDos}
procedure RestoreRedirOut;
begin
If not RedirChangedOut then Exit;
{$ifndef FPC}
Handles^[StdOutputHandle]:=OldHandleOut;
OldHandleOut:=StdOutputHandle;
{$else}
{$ifdef Windows}
SetStdHandle(Std_Output_Handle,StdOutputHandle);
{$else not Windows}
fpdup2(TempHOut,StdOutputHandle);
{$endif not Windows}
{$endif FPC}
Close (FOUT^);
fpclose(TempHOut);
RedirChangedOut:=false;
@ -537,16 +425,11 @@ end;
procedure RestoreRedirIn;
begin
If not RedirChangedIn then Exit;
{$ifndef FPC}
Handles^[StdInputHandle]:=OldHandleIn;
OldHandleIn:=StdInputHandle;
{$else}
{$ifdef Windows}
SetStdHandle(Std_Input_Handle,StdInputHandle);
{$else not Windows}
fpdup2(TempHIn,StdInputHandle);
{$endif not Windows}
{$endif}
Close (FIn^);
fpclose(TempHIn);
RedirChangedIn:=false;
@ -559,15 +442,11 @@ end;
begin
If not RedirChangedIn then Exit;
If InRedirDisabled then Exit;
{$ifndef FPC}
Handles^[StdInputHandle]:=OldHandleIn;
{$else}
{$ifdef Windows}
SetStdHandle(Std_Input_Handle,StdInputHandle);
{$else not Windows}
fpdup2(TempHIn,StdInputHandle);
{$endif not Windows}
{$endif}
InRedirDisabled:=True;
end;
@ -578,16 +457,11 @@ end;
begin
If not RedirChangedIn then Exit;
If not InRedirDisabled then Exit;
{$ifndef FPC}
Handles:=Ptr (prefseg, PWord (Ptr (prefseg, $34))^);
Handles^[StdInputHandle]:=Handles^[FileRec (FIn^).Handle];
{$else}
{$ifdef Windows}
SetStdHandle(Std_Input_Handle,FileRec(FIn^).Handle);
{$else not Windows}
fpdup2(FileRec(FIn^).Handle,StdInputHandle);
{$endif not Windows}
{$endif}
InRedirDisabled:=False;
end;
@ -598,15 +472,11 @@ end;
begin
If not RedirChangedOut then Exit;
If OutRedirDisabled then Exit;
{$ifndef FPC}
Handles^[StdOutputHandle]:=OldHandleOut;
{$else}
{$ifdef Windows}
SetStdHandle(Std_Output_Handle,StdOutputHandle);
{$else not Windows}
fpdup2(TempHOut,StdOutputHandle);
{$endif not Windows}
{$endif}
OutRedirDisabled:=True;
end;
@ -617,16 +487,11 @@ end;
begin
If not RedirChangedOut then Exit;
If not OutRedirDisabled then Exit;
{$ifndef FPC}
Handles:=Ptr (prefseg, PWord (Ptr (prefseg, $34))^);
Handles^[StdOutputHandle]:=Handles^[FileRec (FOut^).Handle];
{$else}
{$ifdef Windows}
SetStdHandle(Std_Output_Handle,FileRec(FOut^).Handle);
{$else not Windows}
fpdup2(FileRec(FOut^).Handle,StdOutputHandle);
{$endif not Windows}
{$endif}
OutRedirDisabled:=False;
end;
@ -636,16 +501,11 @@ end;
begin
If not RedirChangedError then Exit;
{$ifndef FPC}
Handles^[StdErrorHandle]:=OldHandleError;
OldHandleError:=StdErrorHandle;
{$else}
{$ifdef Windows}
SetStdHandle(Std_Error_Handle,StdErrorHandle);
{$else not Windows}
fpdup2(TempHError,StdErrorHandle);
{$endif not Windows}
{$endif}
Close (FERR^);
fpclose(TempHError);
RedirChangedError:=false;
@ -658,15 +518,11 @@ end;
begin
If not RedirChangedError then Exit;
If ErrorRedirDisabled then Exit;
{$ifndef FPC}
Handles^[StdErrorHandle]:=OldHandleError;
{$else}
{$ifdef Windows}
SetStdHandle(Std_Error_Handle,StdErrorHandle);
{$else not Windows}
{$ifdef ver1_0}dup2{$else}fpdup2{$endif}(TempHError,StdErrorHandle);
fpdup2(TempHError,StdErrorHandle);
{$endif not Windows}
{$endif}
ErrorRedirDisabled:=True;
end;
@ -677,16 +533,11 @@ end;
begin
If not RedirChangedError then Exit;
If not ErrorRedirDisabled then Exit;
{$ifndef FPC}
Handles:=Ptr (prefseg, PWord (Ptr (prefseg, $34))^);
Handles^[StdErrorHandle]:=Handles^[FileRec (FErr^).Handle];
{$else}
{$ifdef Windows}
SetStdHandle(Std_Error_Handle,FileRec(FErr^).Handle);
{$else not Windows}
{$ifdef ver1_0}dup2{$else}fpdup2{$endif}(FileRec(FERR^).Handle,StdErrorHandle);
fpdup2(FileRec(FERR^).Handle,StdErrorHandle);
{$endif not Windows}
{$endif}
ErrorRedirDisabled:=False;
end;
@ -752,9 +603,6 @@ procedure RedirEnableAll;
procedure InitRedir;
begin
{$ifndef FPC}
PrefSeg:=PrefixSeg;
{$endif FPC}
end;
{$else not implemented}
@ -939,9 +787,6 @@ end;
{$endif Windows}
Begin
{$IfDef MsDos}
SmallHeap;
{$EndIf MsDos}
SwapVectors;
{$ifdef UNIX}
IOStatus:=0;
@ -982,9 +827,6 @@ end;
fninit
end;
{$endif CPU86}
{$IfDef MsDos}
Fullheap;
{$EndIf MsDos}
End;
{*****************************************************************************

4
ide/fpregs.pas
View File

@ -32,10 +32,6 @@ uses
type
{$ifdef TP}
dword = longint;
{$endif TP}
{$undef cpu_known}
TIntRegs = record

10
ide/fpswitch.pas
View File

@ -794,7 +794,7 @@ begin
end;
function TSwitches.SetCurrSelParam(const s : String) : boolean;
function checkitem(P:PSwitchItem):boolean;{$ifndef FPC}far;{$endif}
function checkitem(P:PSwitchItem):boolean;
begin
{ empty items are not equivalent to others !! }
CheckItem:=((S='') and (P^.Param='')) or
@ -819,7 +819,7 @@ procedure TSwitches.WriteItemsCfg;
var
Pref : char;
procedure writeitem(P:PSwitchItem);{$ifndef FPC}far;{$endif}
procedure writeitem(P:PSwitchItem);
var
s,s1 : string;
i,j : integer;
@ -891,7 +891,7 @@ end;
function TSwitches.ReadItemsCfg(const s:string):boolean;
function checkitem(P:PSwitchItem):boolean;{$ifndef FPC}far;{$endif}
function checkitem(P:PSwitchItem):boolean;
begin
{ empty items are not equivalent to others !! }
{ but -dGDB didn't work because of this PM }
@ -1067,7 +1067,7 @@ var
P : PStringItem;
S : String;
c : char;
function checkitem(P:PSwitchItem):boolean;{$ifndef FPC}far;{$endif}
function checkitem(P:PSwitchItem):boolean;
begin
CheckItem:=(P^.Typ=ot_string) and (P^.Param=c);
end;
@ -1515,7 +1515,7 @@ end;
procedure EnumSwitches(P: PSwitches);
procedure HandleSwitch(P: PSwitchItem); {$ifndef FPC}far;{$endif}
procedure HandleSwitch(P: PSwitchItem);
begin
case P^.ParamID of
{ idAlign :}

4
ide/fpsymbol.pas
View File

@ -284,7 +284,7 @@ const { Symbol browser tabs }
label_browsertab_unit = 'U';
procedure CloseAllBrowsers;
procedure SendCloseIfBrowser(P: PView); {$ifndef FPC}far;{$endif}
procedure SendCloseIfBrowser(P: PView);
begin
if assigned(P) and
((TypeOf(P^)=TypeOf(TBrowserWindow)) or
@ -736,7 +736,7 @@ end;
function LastBrowserWindow: PBrowserWindow;
var BW: PBrowserWindow;
procedure IsBW(P: PView); {$ifndef FPC}far;{$endif}
procedure IsBW(P: PView);
begin
if (P^.HelpCtx=hcBrowserWindow) then
BW:=pointer(P);

2
ide/fptemplt.pas
View File

@ -269,9 +269,7 @@ procedure InitTemplates;
DisposeTemplate(PT);
FindNext(SR);
end;
{$ifdef FPC}
FindClose(SR);
{$endif def FPC}
end;
begin

4
ide/fptools.pas
View File

@ -721,7 +721,7 @@ var
OK: boolean;
_IS: PINISection;
procedure ProcessSection(Sec: PINISection);{$ifndef FPC}far;{$endif}
procedure ProcessSection(Sec: PINISection);
var P1,P2: TPoint;
Typ: string;
Count: sw_integer;
@ -1414,7 +1414,7 @@ begin
end;
procedure DoneToolTempFiles;
procedure DeleteIt(P: PString); {$ifndef FPC}far;{$endif}
procedure DeleteIt(P: PString);
begin
DeleteFile(GetStr(P));
end;

126
ide/fpusrscr.pas
View File

@ -22,12 +22,8 @@ uses
windows,
{$endif Windows}
{$ifdef Unix}
{$ifdef VER1_0}
linux,
{$else}
baseunix,
termio,
{$endif}
baseunix,
termio,
{$endif}
video,Objects;
@ -238,15 +234,8 @@ implementation
uses
Dos,WUtils
(* {$ifdef TP}
{$ifdef DPMI}
,WinAPI
{$endif}
{$endif}*)
{$ifdef FPC}
{$ifdef GO32V2}
,Dpmiexcp, Go32
{$endif}
{$ifdef GO32V2}
,Dpmiexcp, Go32
{$endif}
,Drivers,App
{$ifdef USE_GRAPH_SWITCH}
@ -456,11 +445,7 @@ begin
GetMem(VIDEBuffer,IDEVideoInfo.ScreenSize);
VIDEBufferSize:=IDEVideoInfo.ScreenSize;
end;
{$ifdef FPC}
DosmemGet(VSeg,SOfs,VIDEBuffer^,IDEVideoInfo.ScreenSize);
{$else}
Move(ptr(VSeg,SOfs)^,VIDEBuffer^,IDEVideoInfo.ScreenSize);
{$endif}
end;
procedure TDosScreen.SaveConsoleScreen;
@ -544,11 +529,7 @@ begin
else
VSeg:=SegB800;
SOfs:=MemW[Seg0040:$4e];
{$ifdef FPC}
DosmemGet(VSeg,SOfs,VBuffer^,ConsoleVideoInfo.ScreenSize);
{$else}
Move(ptr(VSeg,SOfs)^,VBuffer^,ConsoleVideoInfo.ScreenSize);
{$endif}
end;
end;
@ -607,12 +588,8 @@ begin
else
VSeg:=SegB800;
SOfs:=MemW[Seg0040:$4e];
{$ifdef FPC}
DosmemPut(VSeg,SOfs,VBuffer^,ConsoleVideoInfo.ScreenSize);
djgpp_set_ctrl_c(Ctrl_c_state);
{$else}
Move(VBuffer^,ptr(VSeg,SOfs)^,ConsoleVideoInfo.ScreenSize);
{$endif}
end;
end;
@ -628,12 +605,8 @@ begin
VSeg:=SegB800;
SOfs:=MemW[Seg0040:$4e];
if assigned(VIDEBuffer) then
{$ifdef FPC}
DosmemPut(VSeg,SOfs,VIDEBuffer^,IDEVideoInfo.ScreenSize);
Ctrl_c_state := djgpp_set_ctrl_c(false);
{$else}
Move(VIDEBuffer^,ptr(VSeg,SOfs)^,IDEVideoInfo.ScreenSize);
{$endif}
DosmemPut(VSeg,SOfs,VIDEBuffer^,IDEVideoInfo.ScreenSize);
Ctrl_c_state := djgpp_set_ctrl_c(false);
{ Its difficult to know
the state of the mouse
so simply show it always
@ -667,11 +640,6 @@ end;
procedure TDOSScreen.GetVideoMode(var MI: TDOSVideoInfo);
var
r: registers;
{$ifdef TP}
P: pointer;
Sel: longint;
(* {$I realintr.inc} *)
{$endif}
begin
if (MI.StateSize>0) and (MI.StateBuf<>nil) then
begin FreeMem(MI.StateBuf,MI.StateSize); MI.StateBuf:=nil; end;
@ -696,42 +664,12 @@ begin
CurPos.X:=r.dl; CurPos.Y:=r.dh;
CurShapeT:=r.ch; CurShapeB:=r.cl;
end;
(*
{$ifdef TP}
{ check VGA functions }
MI.StateSize:=0;
r.ah:=$1c; r.al:=0; r.cx:=7; intr($10,r);
if (r.al=$1c) and ((r.flags and fCarry)=0) and (r.bx>0) then
begin
MI.StateSize:=r.bx;
GetMem(MI.StateBuf,MI.StateSize); FillChar(MI.StateBuf^,MI.StateSize,0);
P:=MI.StateBuf;
{$ifdef DPMI}
Sel:=GlobalDosAlloc(MI.StateSize);
P:=Ptr(Sel shr 16,0);
{$endif}
r.ah:=$1c; r.al:=1; r.cx:=7;
r.es:=PtrRec(P).Seg; r.bx:=PtrRec(P).Ofs;
{$ifdef DPMI}realintr($10,r);{$else}intr($10,r);{$endif}
{$ifdef DPMI}
Move(Ptr(Sel and $ffff,0)^,MI.StateBuf^,MI.StateSize);
GlobalDosFree(Sel and $ffff);
{$endif}
end;
{$endif}
*)
end;
procedure TDOSScreen.SetVideoMode(MI: TDOSVideoInfo);
var r: registers;
CM: TDOSVideoInfo;
{$ifdef TP}
P: pointer;
Sel: longint;
{$I realintr.inc}
{$endif}
begin
FillChar(CM,sizeof(CM),0);
GetVideoMode(CM);
@ -755,26 +693,6 @@ begin
r.ah:=$05; r.al:=MI.Page; intr($10,r);
r.ah:=$02; r.bh:=MI.Page; r.dl:=MI.CurPos.X; r.dh:=MI.CurPos.Y; intr($10,r);
r.ah:=$01; r.ch:=MI.CurShapeT; r.cl:=MI.CurShapeB; intr($10,r);
(*
{$ifdef TP}
if (MI.StateSize>0) and (MI.StateBuf<>nil) then
begin
P:=MI.StateBuf;
{$ifdef DPMI}
Sel:=GlobalDosAlloc(MI.StateSize);
Move(MI.StateBuf^,ptr(Sel and $ffff,0)^,MI.StateSize);
P:=Ptr(Sel shr 16,0);
{$endif}
r.ah:=$1c; r.al:=2; r.cx:=7;
r.es:=PtrRec(P).Seg; r.bx:=PtrRec(P).Ofs;
{$ifdef DPMI}realintr($10,r);{$else}intr($10,r);{$endif}
{$ifdef DPMI}
GlobalDosFree(Sel and $ffff);
{$endif}
end;
{$endif}
*)
end;
{$endif}
@ -799,7 +717,7 @@ begin
TTYFd:=-1;
IsXterm:=getenv('TERM')='xterm';
ThisTTY:=TTYName(stdinputhandle);
if Not IsXterm and {$ifdef ver1_0}IsATTY(stdinputhandle){$else}(IsATTY(stdinputhandle)<>-1){$endif} then
if Not IsXterm and (IsATTY(stdinputhandle)<>-1) then
begin
Console:=TTyNetwork; {Default: Network or other vtxxx tty}
if (Copy(ThisTTY, 1, 8) = '/dev/tty') and (ThisTTY[9]<>'p') Then
@ -808,11 +726,7 @@ begin
'0'..'9' :
begin { running Linux on native console or native-emulation }
FName:='/dev/vcsa' + ThisTTY[9];
{$ifdef ver1_0}
TTYFd:=fdOpen(FName, &666, Open_RdWr); { open console }
{$else}
TTYFd:=fpOpen(FName, &666, O_RdWr); { open console }
{$endif}
If TTYFd <>-1 Then
Console:=ttyLinux;
end;
@ -823,7 +737,7 @@ begin
end;
If Copy(GetEnv('TERM'),1,6)='cons25' Then
Console:=ttyFreeBSD;
{$ifdef ver1_0}ioctl{$else}fpioctl{$endif}(stdinputhandle, TIOCGWINSZ, @WS);
fpioctl(stdinputhandle, TIOCGWINSZ, @WS);
if WS.ws_Col=0 then
WS.ws_Col:=80;
if WS.ws_Row=0 then
@ -914,11 +828,11 @@ begin
write(#27'7'#27'[?47h')
else if (TTYfd<>-1) then
begin
{$ifdef ver1_0}fdSeek{$else}fpLSeek{$endif}(TTYFd, 0, Seek_Set);
{$ifdef ver1_0}fdread{$else}fpread{$endif}(TTYFd,ConsHeight,sizeof(byte));
{$ifdef ver1_0}fdread{$else}fpread{$endif}(TTYFd,ConsWidth,sizeof(byte));
{$ifdef ver1_0}fdread{$else}fpread{$endif}(TTYFd,ConsCursorX,sizeof(byte));
{$ifdef ver1_0}fdread{$else}fpread{$endif}(TTYFd,ConsCursorY,sizeof(byte));
fpLSeek(TTYFd, 0, Seek_Set);
fpread(TTYFd,ConsHeight,sizeof(byte));
fpread(TTYFd,ConsWidth,sizeof(byte));
fpread(TTYFd,ConsCursorX,sizeof(byte));
fpread(TTYFd,ConsCursorY,sizeof(byte));
NewSize:=ConsWidth*ConsHeight*sizeof(word);
if (NewSize<>ConsVideoBufSize) and
assigned(ConsVideoBuf) then
@ -929,7 +843,7 @@ begin
If not assigned(ConsVideoBuf) then
GetMem(ConsVideoBuf,NewSize);
ConsVideoBufSize:=NewSize;
{$ifdef ver1_0}fdread{$else}fpread{$endif}(TTYFd,ConsVideoBuf^,ConsVideoBufSize);
fpread(TTYFd,ConsVideoBuf^,ConsVideoBufSize);
end
else
begin
@ -939,11 +853,7 @@ begin
ConsCursorY:=0;
ConsVideoBuf:=nil;
end;
{$ifdef ver1_0}
ConsTioValid:=TCGetAttr(1,ConsTio);
{$else}
ConsTioValid:=(TCGetAttr(1,ConsTio)<>-1);
{$endif}
end;
@ -956,10 +866,10 @@ begin
end
else if (TTyfd<>-1) then
begin
{$ifdef ver1_0}fdSeek{$else}fplSeek{$endif}(TTYFd, 2, Seek_Set);
{$ifdef ver1_0}fdwrite{$else}fpwrite{$endif}(TTYFd, ConsCursorX, sizeof(byte));
{$ifdef ver1_0}fdwrite{$else}fpwrite{$endif}(TTYFd, ConsCursorY, sizeof(byte));
{$ifdef ver1_0}fdwrite{$else}fpwrite{$endif}(TTYFd, ConsVideoBuf^,ConsVideoBufSize);
fplSeek(TTYFd, 2, Seek_Set);
fpwrite(TTYFd, ConsCursorX, sizeof(byte));
fpwrite(TTYFd, ConsCursorY, sizeof(byte));
fpwrite(TTYFd, ConsVideoBuf^,ConsVideoBufSize);
{ FreeMem(ConsVideoBuf,ConsVideoBufSize);
ConsVideoBuf:=nil; }
end;

28
ide/fpviews.pas
View File

@ -714,7 +714,7 @@ end;
function IsThereAnyEditor: boolean;
function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
function EditorWindow(P: PView): boolean;
begin
EditorWindow:=(P^.HelpCtx=hcSourceWindow);
end;
@ -723,7 +723,7 @@ begin
end;
procedure AskToReloadAllModifiedFiles;
procedure EditorWindowModifiedOnDisk(P: PView); {$ifndef FPC}far;{$endif}
procedure EditorWindowModifiedOnDisk(P: PView);
begin
if (P^.HelpCtx=hcSourceWindow) then
PSourceWindow(P)^.Editor^.ReloadFile;
@ -772,7 +772,7 @@ begin
end;
function IsThereAnyWindow: boolean;
function CheckIt(P: PView): boolean; {$ifndef FPC}far;{$endif}
function CheckIt(P: PView): boolean;
begin
CheckIt:=IsWindow(P);
end;
@ -781,7 +781,7 @@ begin
end;
function IsThereAnyVisibleWindow: boolean;
function CheckIt(P: PView): boolean; {$ifndef FPC}far;{$endif}
function CheckIt(P: PView): boolean;
begin
CheckIt:=IsWindow(P) and P^.GetState(sfVisible);
end;
@ -790,7 +790,7 @@ begin
end;
function FirstEditorWindow: PSourceWindow;
function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
function EditorWindow(P: PView): boolean;
begin
EditorWindow:=(P^.HelpCtx=hcSourceWindow);
end;
@ -802,7 +802,7 @@ function EditorWindowFile(const Name : String): PSourceWindow;
var
SName : string;
function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
function EditorWindow(P: PView): boolean;
begin
EditorWindow:=(TypeOf(P^)=TypeOf(TSourceWindow)) and
(FixFileName(PSourceWindow(P)^.Editor^.FileName)=SName);
@ -819,7 +819,7 @@ function InDisassemblyWindow :boolean;
var
PW : PWindow;
function CheckIt(P: PView): boolean; {$ifndef FPC}far;{$endif}
function CheckIt(P: PView): boolean;
begin
CheckIt:=IsWindow(P) and P^.GetState(sfVisible) and
(P^.HelpCtx <> hcWatchesWindow) and
@ -1151,7 +1151,7 @@ begin
end;
function SearchWindow(const Title: string): PWindow;
function Match(P: PView): boolean; {$ifndef FPC}far;{$endif}
function Match(P: PView): boolean;
var W: PWindow;
OK: boolean;
begin
@ -1217,7 +1217,7 @@ end;
function SearchCoreForFileName(AFileName: string): PCodeEditorCore;
var EC: PCodeEditorCore;
function Check(P: PView): boolean; {$ifndef FPC}far;{$endif}
function Check(P: PView): boolean;
var OK: boolean;
begin
OK:=P^.HelpCtx=hcSourceWindow;
@ -3439,7 +3439,7 @@ end;
procedure TTab.ChangeBounds(var Bounds: TRect);
var D: TPoint;
procedure DoCalcChange(P: PView); {$ifndef FPC}far;{$endif}
procedure DoCalcChange(P: PView);
var
R: TRect;
begin
@ -3729,7 +3729,7 @@ end;
destructor TTab.Done;
var P,X: PTabDef;
procedure DeleteViews(P: PView); {$ifndef FPC}far;{$endif}
procedure DeleteViews(P: PView);
begin
if P<>nil then Delete(P);
end;
@ -3907,7 +3907,7 @@ end;
function LastSourceEditor : PSourceWindow;
function IsSearchedSource(P: PView) : boolean; {$ifndef FPC}far;{$endif}
function IsSearchedSource(P: PView) : boolean;
begin
if assigned(P) and
(TypeOf(P^)=TypeOf(TSourceWindow)) then
@ -3957,7 +3957,7 @@ function IsSearchedFile(W : PSourceWindow) : boolean;
end;
IsSearchedFile:=found;
end;
function IsSearchedSource(P: PView) : boolean; {$ifndef FPC}far;{$endif}
function IsSearchedSource(P: PView) : boolean;
begin
if assigned(P) and
(TypeOf(P^)=TypeOf(TSourceWindow)) then
@ -4588,7 +4588,7 @@ end;
{$ifdef VESA}
function VESASetVideoModeProc(const VideoMode: TVideoMode; Params: Longint): Boolean; {$ifndef FPC}far;{$endif}
function VESASetVideoModeProc(const VideoMode: TVideoMode; Params: Longint): Boolean;
begin
VESASetVideoModeProc:=VESASetMode(Params);
end;

35
ide/globdir.inc
View File

@ -11,20 +11,6 @@
**********************************************************************}
{ --- Special OS settings --- }
{$ifdef TP}
{$define SUPPORTVESA}
{$define TPUNIXLF}
{$define WinClipSupported}
{$define FSCaseInsensitive}
{$C FIXED PRELOAD PERMANENT}
{
Without defining this I got almost always SEGMENT NOT PRESENT (exc 11)
on exiting the IDE, when run on under NT4.0... Strange a bit, not?
(Actually the fault occours in TDOSScreen.GetVideoMode() at the
BIOS call, but I just can't figure out why....)
}
{$endif}
{$ifdef Go32V2}
{$define SUPPORTVESA}
{$define SUPPORTREDIR}
@ -117,7 +103,6 @@
{ ----------- define DOS for DOS targets ---------- }
{$ifdef GO32V2}{$define DOS}{$endif}
{$ifdef TP}{$define DOS}{$endif}
{ include Undo/Redo code from Visa Harvey }
{ let everybody try it out PM }
@ -137,18 +122,16 @@
{$define EXEDEBUG}
{$endif DEBUG}
{$ifdef FPC}
{$ifndef ver2_0}
{$define USERESSTRINGS}
{$endif}
{$define USE_FREEVISION}
{$define HASOUTLINE}
{$ifndef ver2_0}
{$define USERESSTRINGS}
{$endif}
{$define USE_FREEVISION}
{$define HASOUTLINE}
{ Use inlining for small functions }
{$ifndef VER1_0}
{$inline on}
{.$define USEINLINE}
{$endif}
{ Use inlining for small functions }
{$ifndef VER1_0}
{$inline on}
{.$define USEINLINE}
{$endif}
{$define TEST_PARTIAL_SYNTAX}

2
ide/maketp.bat
View File

@ -1,2 +0,0 @@
@echo off
bpc fp -dTP -U..\fake\gdb -U..\fake\compiler

446
ide/pmode.pas
View File

@ -12,7 +12,6 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$ifdef VER70}{$define TP}{$endif}
unit PMode;
interface
@ -23,9 +22,7 @@ type
MemPtr = object
Ofs,Seg: word;
Size : word;
{$ifdef DPMI}
Sel : word;
{$endif}
function DosPtr: pointer;
function DataPtr: pointer;
function DosSeg: word;
@ -79,441 +76,6 @@ function MakePtr(ASeg,AOfs: word): pointer;
implementation
{$ifdef TP}
{$ifdef DPMI}uses WinAPI;{$endif}
{$IFDEF DPMI}
const
DPMI_INTR = $31;
type
TDPMIRegisters = {$ifdef TP}Registers32{$else}TRegisters32{$endif};
var
DPMIRegs: TDPMIRegisters;
{$ENDIF DPMI}
procedure realintr(IntNo: byte; var r: registers);
{$ifdef DPMI}
var Regs: Registers;
begin
FillChar(DPMIRegs, SizeOf(TDPMIRegisters), 0);
DPMIRegs.EAX := r.ax;
DPMIRegs.EBX := r.bx;
DPMIRegs.ECX := r.cx;
DPMIRegs.EDX := r.dx;
DPMIRegs.EDI := r.di;
DPMIRegs.ESI := r.si;
DPMIRegs.EBP := r.bp;
DPMIRegs.DS := r.ds;
DPMIRegs.ES := r.es;
DPMIRegs.Flags := r.flags;
Regs.AX := $0300;
Regs.BL := IntNo;
Regs.BH := 0;
Regs.CX := 0;
Regs.ES := Seg(DPMIRegs);
Regs.DI := Ofs(DPMIRegs);
Intr(DPMI_INTR, Regs);
r.ax := DPMIRegs.EAX;
r.bx := DPMIRegs.EBX;
r.cx := DPMIRegs.ECX;
r.dx := DPMIRegs.EDX;
r.di := DPMIRegs.EDI;
r.si := DPMIRegs.ESI;
r.bp := DPMIRegs.EBP;
r.ds := DPMIRegs.DS;
r.es := DPMIRegs.ES;
r.Flags := DPMIRegs.Flags;
end;
{$else}
begin
intr(IntNo,r);
end;
{$endif}
(*procedure realintr32(IntNo: byte; var r: registers32);
{$ifdef DPMI}
var Regs: Registers;
begin
FillChar(DPMIRegs, SizeOf(TDPMIRegisters), 0);
DPMIRegs:=r;
Regs.AX := $0300;
Regs.BL := IntNo;
Regs.BH := 0;
Regs.CX := 0;
Regs.ES := Seg(DPMIRegs);
Regs.DI := Ofs(DPMIRegs);
Intr(DPMI_INTR, Regs);
r:=DPMIRegs;
end;
{$else}
begin
{ not implemented }
Halt(99);
end;
{$endif}
*)
{$ifndef DPMI}
const DummyIntRedir: boolean = false;
CallAddr: pointer = nil;
DummyInt = $ef;
procedure CallInt; assembler;
asm
push ax
push ds
mov ax, seg CallAddr
mov ds, ax
mov ax, ds:CallAddr.word[0]
mov cs:@JmpAddr.word[0], ax
mov ax, ds:CallAddr.word[2]
mov cs:@JmpAddr.word[2], ax
pop ds
pop ax
sti
db $9a
@JmpAddr:
dw 0,0
jmp @over
@regax: dw 0
@over:
mov word ptr cs:@regax, ax
push bx
pushf
pop ax
mov bx, sp
mov word ptr ss:[bx+6], ax
pop bx
mov ax, word ptr cs:@regax
iret
end;
{$endif}
procedure realcall(Proc: pointer; var r: registers);
{$ifdef DPMI}
var Regs: Registers;
begin
FillChar(DPMIRegs, SizeOf(TDPMIRegisters), 0);
DPMIRegs.EAX := r.ax;
DPMIRegs.EBX := r.bx;
DPMIRegs.ECX := r.cx;
DPMIRegs.EDX := r.dx;
DPMIRegs.EDI := r.di;
DPMIRegs.ESI := r.si;
DPMIRegs.EBP := r.bp;
DPMIRegs.DS := r.ds;
DPMIRegs.ES := r.es;
DPMIRegs.Flags := r.flags;
DPMIRegs.CS := PtrRec(Proc).Seg;
DPMIRegs.IP := PtrRec(Proc).Ofs;
DPMIRegs.SS :=0; DPMIRegs.SP:=0;
Regs.AX := $0301;
Regs.BH := 0;
Regs.CX := 0;
Regs.ES := Seg(DPMIRegs);
Regs.DI := Ofs(DPMIRegs);
Intr(DPMI_INTR, Regs);
r.ax := DPMIRegs.EAX and $ffff;
r.bx := DPMIRegs.EBX and $ffff;
r.cx := DPMIRegs.ECX and $ffff;
r.dx := DPMIRegs.EDX and $ffff;
r.di := DPMIRegs.EDI and $ffff;
r.si := DPMIRegs.ESI and $ffff;
r.bp := DPMIRegs.EBP and $ffff;
r.ds := DPMIRegs.DS;
r.es := DPMIRegs.ES;
r.Flags := DPMIRegs.Flags and $ffff;
end;
{$else}
(*begin
asm
push ds
push bp
mov ax, Proc.word[2]
mov bx, Proc.word[0]
mov cs:@Call+1.word, bx
mov cs:@Call+3.word, ax
lds si, r
mov @rptr.word[2], ds
mov @rptr.word[0], si
lodsw
push ax { -> ax }
lodsw
mov bx, ax
lodsw
mov cx, ax
lodsw
mov dx, ax
lodsw
mov bp, ax
lodsw
push ax { -> si }
lodsw
mov di, ax
lodsw
push ax { -> ds }
lodsw
mov es, ax
lodsw
push ax { -> flags }
popf
pop si
pop ds
pop ax
@Call:
db 9ah
dd 0
jmp @skipover
@rptr: dd 0
@skipover:
pushf
push es
push di
mov es, @rptr.word[2]
mov di, @rptr.word[0]
stosw
mov ax, bx
stosw
mov ax, cx
stosw
mov ax, dx
stosw
mov ax, bp
stosw
mov ax, si
stosw
pop ax { <- di }
stosw
mov ax, ds
stosw
pop ax { <- es }
stosw
pop ax { <- flags }
stosw
pop bp
pop ds
end;
end;
*)
begin
if DummyIntRedir=false then
begin
SetIntVec(DummyInt,@CallInt);
DummyIntRedir:=true;
end;
CallAddr:=Proc;
dos.intr(DummyInt,r);
end;
{$endif}
(*const ActiveBlocks: word = 0;*)
function GetDosMem(var M: MemPtr; Size: word): boolean;
var P: pointer;
L: longint;
begin
M.Size:=Size;
{$ifndef DPMI}
GetMem(P,Size);
M.Seg:=PtrRec(P).Seg; M.Ofs:=PtrRec(P).Ofs;
{$else}
L:=GlobalDosAlloc(Size);
M.Seg:=(L shr 16); M.Ofs:=0;
M.Sel:=(L and $ffff);
{$endif}
if M.Seg<>0 then M.Clear;
GetDosMem:=M.Seg<>0;
(* Inc(ActiveBlocks);
write('|DMC:',ActiveBlocks,'-S:',M.Sel,'-S:',M.Seg);*)
end;
procedure FreeDosMem(var M: MemPtr);
begin
if M.Size=0 then Exit;
{$ifndef DPMI}
if M.Seg<>0 then
FreeMem(Ptr(M.Seg,M.Ofs),M.Size);
{$else}
if M.Sel<>0 then
if GlobalDosFree(M.Sel)<>0 then
writeln('!!!Failed to deallocate Dos block!!!');
{$endif}
FillChar(M,SizeOf(M),0);
end;
{$ifdef DPMI}
function GetSelectorForSeg(Seg: word): word;
var Sel: word;
r: registers;
begin
r.ax:=$0002; r.bx:=Seg;
intr(DPMI_Intr,r);
if (r.flags and fCarry)=0 then
Sel:=r.ax
else
Sel:=0;
GetSelectorForSeg:=Sel;
end;
{$endif}
function MoveDosToPM(DosPtr: pointer; PMPtr: pointer; Size: word): boolean;
{$ifndef DPMI}
begin
Move(DosPtr^,PMPtr^,Size);
MoveDosToPM:=true;
end;
{$else}
var Sel: word;
OK,DisposeSel: boolean;
begin
Sel:=GetSelectorForSeg(PtrRec(DosPtr).Seg);
OK:=Sel<>0; DisposeSel:=false;
if OK=false then
begin
Sel:=AllocSelector(0);
OK:=Sel<>0;
if OK then
begin
SetSelectorLimit(Sel,PtrRec(DosPtr).Ofs+Size);
OK:=SetSelectorBase(Sel,PtrRec(DosPtr).Seg shl 4)=Sel;
end;
if OK then DisposeSel:=true;
end;
if OK then
begin
Move(ptr(Sel,PtrRec(DosPtr).Ofs)^,PMPtr^,Size);
if DisposeSel then FreeSelector(Sel);
end;
MoveDosToPM:=OK;
end;
{$endif}
function MovePMToDos(PMPtr: pointer; DosPtr: pointer; Size: word): boolean;
{$ifndef DPMI}
begin
Move(PMPtr^,DosPtr^,Size);
MovePMToDos:=true;
end;
{$else}
var Sel: word;
OK,DisposeSel: boolean;
begin
Sel:=GetSelectorForSeg(PtrRec(DosPtr).Seg);
OK:=Sel<>0; DisposeSel:=false;
if OK=false then
begin
Sel:=AllocSelector(0);
OK:=Sel<>0;
if OK then
begin
SetSelectorLimit(Sel,PtrRec(DosPtr).Ofs+Size);
OK:=SetSelectorBase(Sel,PtrRec(DosPtr).Seg shl 4)=Sel;
end;
if OK then DisposeSel:=true;
end;
if OK then
begin
Move(PMPtr^,ptr(Sel,PtrRec(DosPtr).Ofs)^,Size);
if DisposeSel then FreeSelector(Sel);
end;
MovePMToDos:=OK;
end;
{$endif}
procedure realGetIntVec(IntNo: byte; var P: pointer);
{$ifndef DPMI}
begin
GetIntVec(IntNo,P);
end;
{$else}
var r: registers;
begin
r.ax:=$200; r.bl:=IntNo;
intr(DPMI_Intr,r);
P:=Ptr(r.cx,r.dx);
end;
{$endif}
procedure MemPtr.MoveDataTo(const Src; DSize: word);
begin
if DSize>Size then
RunError(216);
Move(Src,Ptr(DataSeg,DataOfs)^,DSize);
end;
procedure MemPtr.MoveDataFrom(DSize: word; var Dest);
begin
if DSize>Size then
RunError(216);
Move(Ptr(DataSeg,DataOfs)^,Dest,DSize);
end;
procedure MemPtr.Clear;
begin
FillChar(Ptr(DataSeg,DataOfs)^,Size,0);
end;
procedure RealAbstract;
begin
writeln('Abstract call in real mode...');
RunError(255);
end;
function allocrmcallback(PMAddr: pointer; RealRegs: pregisters): pointer;
{$ifdef DPMI}
var r: registers;
P: pointer;
begin
r.ax:=$0303;
r.ds:=PtrRec(PMAddr).Seg; r.si:=PtrRec(PMAddr).Ofs;
r.es:=PtrRec(RealRegs).Seg; r.di:=PtrRec(RealRegs).Ofs;
intr(DPMI_Intr,r);
if (r.flags and fCarry)=0 then
P:=MakePtr(r.cx,r.dx)
else
P:=nil;
allocrmcallback:=P;
end;
{$else}
begin
RealAbstract;
end;
{$endif}
procedure freermcallback(RealCallAddr: pointer);
{$ifdef DPMI}
var r: registers;
begin
r.ax:=$0304;
r.cx:=PtrRec(RealCallAddr).Seg; r.dx:=PtrRec(RealCallAddr).Seg;
intr(DPMI_Intr,r);
end;
{$else}
begin
RealAbstract;
end;
{$endif}
{$endif TP}
{$ifdef GO32V2}
{ --------------------- GO32 --------------------- }
@ -678,20 +240,12 @@ end;
function MemPtr.DataSeg: word;
begin
{$ifndef DPMI}
DataSeg:=Seg;
{$else}
DataSeg:=Sel;
{$endif}
end;
function MemPtr.DataOfs: word;
begin
{$ifndef DPMI}
DataOfs:=Ofs;
{$else}
DataOfs:=0;
{$endif}
end;
function MemPtr.DosSeg: word;

67
ide/realintr.inc
View File

@ -1,67 +0,0 @@
{$IFDEF DPMI}
const
DPMI_INTR = $31;
type
TDPMIRegisters = record { DPMI call structure }
EDI : LongInt;
ESI : LongInt;
EBP : LongInt;
Reserved: LongInt;
EBX : LongInt;
EDX : LongInt;
ECX : LongInt;
EAX : LongInt;
Flags : Word;
ES : Word;
DS : Word;
FS : Word;
GS : Word;
IP : Word;
CS : Word;
SP : Word;
SS : Word;
end;
var
DPMIRegs: TDPMIRegisters;
procedure realintr(IntNo: byte; var r: registers);
var Regs: Registers;
begin
FillChar(DPMIRegs, SizeOf(TDPMIRegisters), 0);
DPMIRegs.EAX := r.ax;
DPMIRegs.EBX := r.bx;
DPMIRegs.ECX := r.cx;
DPMIRegs.EDX := r.dx;
DPMIRegs.EDI := r.di;
DPMIRegs.ESI := r.si;
DPMIRegs.EBP := r.bp;
DPMIRegs.DS := r.ds;
DPMIRegs.ES := r.es;
{ --- }
DPMIRegs.FS := 0;
DPMIRegs.GS := 0;
DPMIRegs.SS := 0;
DPMIRegs.SP := 0;
{ --- }
DPMIRegs.Flags := r.flags;
Regs.AX := $0300;
Regs.BL := IntNo;
Regs.BH := 0;
Regs.CX := 0;
Regs.ES := Seg(DPMIRegs);
Regs.DI := Ofs(DPMIRegs);
Intr(DPMI_INTR, Regs);
r.ax := DPMIRegs.EAX;
r.bx := DPMIRegs.EBX;
r.cx := DPMIRegs.ECX;
r.dx := DPMIRegs.EDX;
r.di := DPMIRegs.EDI;
r.si := DPMIRegs.ESI;
r.bp := DPMIRegs.EBP;
r.ds := DPMIRegs.DS;
r.es := DPMIRegs.ES;
r.Flags := DPMIRegs.Flags;
end;
{$ENDIF}

7
ide/vesa.pas
View File

@ -56,8 +56,7 @@ const
vesa_mw_WindowB = $0001;
type
{$ifdef FPC}tregisters=registers;{$endif}
{$ifdef TP}tregisters=registers;{$endif}
tregisters=registers;
PtrRec16 = record
Ofs,Seg: word;
@ -134,9 +133,7 @@ Procedure FreeVesaModes;
implementation
uses
{$ifdef FPC}
video, mouse,
{$endif FPC}
{$ifdef TESTGRAPHIC}
graph,
{$endif TESTGRAPHIC}
@ -363,7 +360,6 @@ begin
VESAInit:=OK;
end;
{$ifdef FPC}
Function VesaGetVideoModeData (Index : Word; Var Data : TVideoMode) : boolean;
Var
PrevCount : word;
@ -710,5 +706,4 @@ BEGIN
{$endif TESTGRAPHIC}
SetVideoDriver (Driver);
{$endif FPC}
END.

12
ide/wcedit.pas
View File

@ -62,7 +62,7 @@ type
PCodeEditorCore = ^TCodeEditorCore;
TCodeEditorCore = object(TCustomCodeEditorCore)
{$ifdef TP}public{$else}protected{$endif}
protected
Lines : PLineCollection;
CanUndo : Boolean;
StoreUndo : boolean;
@ -91,7 +91,7 @@ type
function GetLastSyntaxedLine: sw_integer; virtual;
procedure SetLastSyntaxedLine(ALine: sw_integer); virtual;
{ Storage }
{$ifdef TP}public{$else}protected{$endif}
protected
{ Text & info storage abstraction }
procedure ISetLineFlagState(Binding: PEditorBinding; LineNo: sw_integer; Flag: longint; ASet: boolean); virtual;
procedure IGetDisplayTextFormat(Binding: PEditorBinding; LineNo: sw_integer;var DT,DF:string); virtual;
@ -328,7 +328,7 @@ begin
end;
function TLine.GetEditorInfo(Editor: PCustomCodeEditor): PEditorLineInfo;
function Match(P: PEditorLineInfo): boolean; {$ifdef TP}far;{$endif}
function Match(P: PEditorLineInfo): boolean;
begin
Match:=P^.Editor=Editor;
end;
@ -470,7 +470,7 @@ begin
end;
procedure TCodeEditorCore.GetContent(ALines: PUnsortedStringCollection);
procedure AddIt(P: PCustomLine); {$ifndef FPC}far;{$endif}
procedure AddIt(P: PCustomLine);
begin
if Assigned(P) then
ALines^.Insert(NewStr(P^.GetText));
@ -481,7 +481,7 @@ begin
end;
procedure TCodeEditorCore.SetContent(ALines: PUnsortedStringCollection);
procedure AddIt(P: PString); {$ifndef FPC}far;{$endif}
procedure AddIt(P: PString);
begin
AddLine(GetStr(P));
end;
@ -533,7 +533,7 @@ end;
procedure TCodeEditorCore.LinesInsert(Idx: sw_integer; Line: PLine);
var I: sw_integer;
procedure RegLine(P: PEditorBinding); {$ifndef FPC}far;{$endif}
procedure RegLine(P: PEditorBinding);
begin
Line^.AddEditorInfo(I,P^.Editor);
Inc(I);

4
ide/wconsole.pas
View File

@ -17,11 +17,7 @@ unit WConsole;
interface
{$ifdef UNIX}
uses
{$Ifdef ver1_0}
linux;
{$else}
termio;
{$endif}
{$endif UNIX}
type

50
ide/weditor.pas
View File

@ -13,7 +13,6 @@
**********************************************************************}
{$I globdir.inc}
{$ifdef TP}{$L-}{$endif}
unit WEditor;
interface
@ -60,9 +59,9 @@ const
cmExpandFold = 51267;
cmDelToEndOfWord = 51268;
EditorTextBufSize = {$ifdef FPC}32768{$else} 4096{$endif};
EditorTextBufSize = 32768;
MaxLineLength = 255;
MaxLineCount = {$ifdef FPC}2000000{$else}16380{$endif};
MaxLineCount = 2000000;
CodeTemplateCursorChar = '|'; { char to signal cursor pos in templates }
@ -349,7 +348,7 @@ type
PCustomCodeEditorCore = ^TCustomCodeEditorCore;
TCustomCodeEditorCore = object(TObject)
{$ifdef TP}public{$else}protected{$endif}
protected
Bindings : PEditorBindingCollection;
LockFlag : sw_integer;
ChangedLine : sw_integer;
@ -405,7 +404,7 @@ type
function LoadFromStream(Editor: PCustomCodeEditor; Stream: PFastBufStream): boolean; virtual;
function SaveToStream(Editor: PCustomCodeEditor; Stream: PStream): boolean; virtual;
function SaveAreaToStream(Editor: PCustomCodeEditor; Stream: PStream; StartP,EndP: TPoint): boolean; virtual;
{$ifdef TP}public{$else}protected{$endif}
protected
{ Text & info storage abstraction }
{a}procedure ISetLineFlagState(Binding: PEditorBinding; LineNo: sw_integer; Flag: longint; ASet: boolean); virtual;
{a}procedure IGetDisplayTextFormat(Binding: PEditorBinding; LineNo: sw_integer;var DT,DF:string); virtual;
@ -603,7 +602,7 @@ type
{a}procedure CloseGroupedAction(AAction : byte); virtual;
{a}function GetUndoActionCount: sw_integer; virtual;
{a}function GetRedoActionCount: sw_integer; virtual;
{$ifdef TP}public{$else}protected{$endif}
protected
LastLocalCmd: word;
KeyState : Integer;
Bookmarks : array[0..9] of TEditorBookmark;
@ -982,7 +981,7 @@ begin
upper[0]:=s[0];
end;
}
type TPosOfs = {$ifdef TP}longint{$endif}{$ifdef FPC}int64{$endif};
type TPosOfs = int64;
function PosToOfs(const X,Y: sw_integer): TPosOfs;
begin
@ -1037,13 +1036,8 @@ end;}
*****************************************************************************}
Const
{$ifndef FPC}
MaxBufLength = $7f00;
NotFoundValue = -1;
{$else}
MaxBufLength = $7fffff00;
NotFoundValue = -1;
{$endif}
Type
Btable = Array[0..255] of Byte;
@ -1411,7 +1405,7 @@ end;
function TFold.GetLineCount: sw_integer;
var Count: sw_integer;
procedure AddIt(P: PFold); {$ifndef FPC}far;{$endif}
procedure AddIt(P: PFold);
begin
Inc(Count,P^.GetLineCount);
end;
@ -1583,7 +1577,7 @@ begin
end;
function TCustomCodeEditorCore.SearchBinding(AEditor: PCustomCodeEditor): PEditorBinding;
function SearchEditor(P: PEditorBinding): boolean; {$ifndef FPC}far;{$endif}
function SearchEditor(P: PEditorBinding): boolean;
begin
SearchEditor:=P^.Editor=AEditor;
end;
@ -1635,7 +1629,7 @@ end;
function TCustomCodeEditorCore.IsClipboard: Boolean;
function IsClip(P: PEditorBinding): boolean; {$ifndef FPC}far;{$endif}
function IsClip(P: PEditorBinding): boolean;
begin
IsClip:=(P^.Editor=Clipboard);
end;
@ -1707,7 +1701,7 @@ end;
procedure TCustomCodeEditorCore.BindingsChanged;
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
procedure CallIt(P: PEditorBinding);
begin
P^.Editor^.BindingsChanged;
end;
@ -1716,7 +1710,7 @@ begin
end;
procedure TCustomCodeEditorCore.DoLimitsChanged;
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
procedure CallIt(P: PEditorBinding);
begin
P^.Editor^.DoLimitsChanged;
end;
@ -1725,7 +1719,7 @@ begin
end;
procedure TCustomCodeEditorCore.DoContentsChanged;
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
procedure CallIt(P: PEditorBinding);
begin
P^.Editor^.ContentsChanged;
end;
@ -1734,7 +1728,7 @@ begin
end;
procedure TCustomCodeEditorCore.DoModifiedChanged;
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
procedure CallIt(P: PEditorBinding);
begin
P^.Editor^.ModifiedChanged;
end;
@ -1743,7 +1737,7 @@ begin
end;
procedure TCustomCodeEditorCore.DoTabSizeChanged;
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
procedure CallIt(P: PEditorBinding);
begin
P^.Editor^.TabSizeChanged;
end;
@ -1752,7 +1746,7 @@ begin
end;
procedure TCustomCodeEditorCore.UpdateUndoRedo(cm : word; action : byte);
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
procedure CallIt(P: PEditorBinding);
begin
if (P^.Editor^.State and sfActive)<>0 then
begin
@ -1771,7 +1765,7 @@ end;
procedure TCustomCodeEditorCore.DoStoreUndoChanged;
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
procedure CallIt(P: PEditorBinding);
begin
P^.Editor^.StoreUndoChanged;
end;
@ -1779,7 +1773,7 @@ begin
Bindings^.ForEach(@CallIt);
end;
procedure TCustomCodeEditorCore.DoSyntaxStateChanged;
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
procedure CallIt(P: PEditorBinding);
begin
P^.Editor^.SyntaxStateChanged;
end;
@ -1790,7 +1784,7 @@ end;
function TCustomCodeEditorCore.GetLastVisibleLine : sw_integer;
var
y : sw_integer;
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
procedure CallIt(P: PEditorBinding);
begin
if y < P^.Editor^.Delta.Y+P^.Editor^.Size.Y then
y:=P^.Editor^.Delta.Y+P^.Editor^.Size.Y;
@ -2038,7 +2032,7 @@ end;
function TCustomCodeEditorCore.UpdateAttrs(FromLine: sw_integer; Attrs: byte): sw_integer;
var MinLine: sw_integer;
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
procedure CallIt(P: PEditorBinding);
var I: sw_integer;
begin
I:=DoUpdateAttrs(P^.Editor,FromLine,Attrs);
@ -2052,7 +2046,7 @@ end;
function TCustomCodeEditorCore.UpdateAttrsRange(FromLine, ToLine: sw_integer; Attrs: byte): sw_integer;
var MinLine: sw_integer;
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
procedure CallIt(P: PEditorBinding);
var I: sw_integer;
begin
I:=DoUpdateAttrsRange(P^.Editor,FromLine,ToLine,Attrs);
@ -7224,10 +7218,6 @@ begin
end;
if DriveNumber<>0 then
ChDir(StoreDir2);
{$ifndef FPC}
if (Length(StoreDir)>1) and (StoreDir[2]=':') then
ChDir(Copy(StoreDir,1,2));
{$endif not FPC}
if StoreDir<>'' then
ChDir(TrimEndSlash(StoreDir));

42
ide/whelp.pas
View File

@ -156,7 +156,7 @@ type
const TopicCacheSize : sw_integer = 10;
HelpStreamBufSize : sw_integer = 4096;
HelpFacility : PHelpFacility = nil;
MaxHelpTopicSize : sw_word = {$ifdef FPC}3*65520{$else}65520{$endif};
MaxHelpTopicSize : sw_word = 3*65520;
function NewTopic(FileID: byte; HelpCtx: THelpCtx; Pos: longint; Param: string;
ExtData: pointer; ExtDataSize: longint): PTopic;
@ -186,12 +186,8 @@ implementation
uses
{$ifdef Unix}
{$ifdef VER1_0}
linux,
{$else}
baseunix,
unix,
{$endif}
baseunix,
unix,
{$endif Unix}
{$IFDEF OS2}
DosCalls,
@ -314,13 +310,8 @@ Function GetDosTicks:longint; { returns ticks at 18.2 Hz, just like DOS }
tv : TimeVal;
tz : TimeZone;
begin
{$ifdef ver1_0}
GetTimeOfDay(tv); {Timezone no longer used?}
GetDosTicks:=((tv.Sec mod 86400) div 60)*1092+((tv.Sec mod 60)*1000000+tv.USec) div 54945;
{$else}
fpGetTimeOfDay(@tv,@tz);
GetDosTicks:=((tv.tv_Sec mod 86400) div 60)*1092+((tv.tv_Sec mod 60)*1000000+tv.tv_USec) div 54945;
{$endif}
end;
{$endif Unix}
{$ifdef Windows}
@ -333,11 +324,6 @@ Function GetDosTicks:longint; { returns ticks at 18.2 Hz, just like DOS }
GetDosTicks:=MemL[$40:$6c];
end;
{$endif go32v2}
{$ifdef TP}
begin
GetDosTicks:=MemL[$40:$6c];
end;
{$endif go32v2}
{$ifdef netwlibc}
var
tv : TTimeVal;
@ -398,7 +384,7 @@ end;
function CloneTopic(T: PTopic): PTopic;
var NT: PTopic;
procedure CloneMark(P: PString); {$ifndef FPC}far;{$endif}
procedure CloneMark(P: PString);
begin
NT^.NamedMarks^.InsertStr(GetStr(P));
end;
@ -713,9 +699,9 @@ end;
procedure THelpFile.MaintainTopicCache;
var Count: sw_integer;
MinLRU: longint;
procedure CountThem(P: PTopic); {$ifndef FPC}far;{$endif}
procedure CountThem(P: PTopic);
begin if (P^.Text<>nil) or (P^.Links<>nil) then Inc(Count); end;
procedure SearchLRU(P: PTopic); {$ifndef FPC}far;{$endif}
procedure SearchLRU(P: PTopic);
begin if P^.LastAccess<MinLRU then begin MinLRU:=P^.LastAccess; end; end;
var P: PTopic;
begin
@ -779,7 +765,7 @@ end;
function THelpFacility.SearchTopicOwner(SourceFileID: word; Context: THelpCtx): PHelpFile;
var P: PTopic;
HelpFile: PHelpFile;
function Search(F: PHelpFile): boolean; {$ifndef FPC}far;{$endif}
function Search(F: PHelpFile): boolean;
begin
P:=SearchTopicInHelpFile(F,Context); if P<>nil then HelpFile:=F;
Search:=P<>nil;
@ -833,8 +819,8 @@ end;
function THelpFacility.TopicSearch(Keyword: string; var FileID: word; var Context: THelpCtx): boolean;
function ScanHelpFileExact(H: PHelpFile): boolean; {$ifndef FPC}far;{$endif}
function SearchExact(P: PIndexEntry): boolean; {$ifndef FPC}far;{$endif}
function ScanHelpFileExact(H: PHelpFile): boolean;
function SearchExact(P: PIndexEntry): boolean;
begin
SearchExact:=UpcaseStr(P^.Tag^)=Keyword;
end;
@ -845,8 +831,8 @@ begin
if P<>nil then begin FileID:=H^.ID; Context:=P^.HelpCtx; end;
ScanHelpFileExact:=P<>nil;
end;
function ScanHelpFile(H: PHelpFile): boolean; {$ifndef FPC}far;{$endif}
function Search(P: PIndexEntry): boolean; {$ifndef FPC}far;{$endif}
function ScanHelpFile(H: PHelpFile): boolean;
function Search(P: PIndexEntry): boolean;
begin
Search:=copy(UpcaseStr(P^.Tag^),1,length(Keyword))=Keyword;
end;
@ -871,8 +857,8 @@ function THelpFacility.BuildIndexTopic: PTopic;
var T: PTopic;
Keywords: PIndexEntryCollection;
Lines: PUnsortedStringCollection;
procedure InsertKeywordsOfFile(H: PHelpFile); {$ifndef FPC}far;{$endif}
function InsertKeywords(P: PIndexEntry): boolean; {$ifndef FPC}far;{$endif}
procedure InsertKeywordsOfFile(H: PHelpFile);
function InsertKeywords(P: PIndexEntry): boolean;
begin
Keywords^.Insert(P);
InsertKeywords:=Keywords^.Count>=MaxCollectionSize;
@ -1006,7 +992,7 @@ begin
end;
function THelpFacility.SearchFile(ID: byte): PHelpFile;
function Match(P: PHelpFile): boolean; {$ifndef FPC}far;{$endif}
function Match(P: PHelpFile): boolean;
begin
Match:=(P^.ID=ID);
end;

34
ide/whtml.pas
View File

@ -175,28 +175,6 @@ begin
end;
constructor TDOSTextFile.Init(AFileName: string);
(*{$ifdef TPUNIXLF}
procedure readln(var t:text;var s:string);
var
c : char;
i : longint;
begin
c:=#0;
i:=0;
while (not eof(t)) and (c<>#10) and (i<255) do
begin
read(t,c);
if (i<255) and (c<>#10) then
begin
inc(i);
s[i]:=c;
end;
end;
if (i>0) and (s[i]=#13) then
dec(i);
s[0]:=chr(i);
end;
{$endif}*)
var f: file;
linecomplete,hasCR: boolean;
S: string;
@ -447,7 +425,7 @@ begin
if (Code=162) or (Name='cent') then E:='›' else { cent sign }
if (Code=163) or (Name='pound') then E:='œ' else { pound sterling sign }
if (Code=164) or (Name='curren') then E:='$' else { general currency sign }
if (Code=165) or (Name='yen') then E:='<EFBFBD>' else { yen sign }
if (Code=165) or (Name='yen') then E:='' else { yen sign }
if (Code=166) or (Name='brvbar') then E:='|' else { broken vertical bar }
if (Code=167) or (Name='sect') then E:='' else { section sign }
if (Code=168) or (Name='uml') then E:='"' else { umlaut (dieresis) }
@ -479,11 +457,11 @@ begin
if (Code=194) or (Name='Acirc') then E:='A' else { capital A, circumflex accent }
if (Code=195) or (Name='Atilde') then E:='A' else { capital A, tilde accent }
if (Code=196) or (Name='Auml') then E:='Ž' else { capital A, dieresis or umlaut }
if (Code=197) or (Name='Aring') then E:='<EFBFBD>' else { capital A, ring }
if (Code=197) or (Name='Aring') then E:='' else { capital A, ring }
if (Code=198) or (Name='AElig') then E:='’' else { capital AE diphthong }
if (Code=199) or (Name='Ccedil') then E:='€' else { capital C, cedilla }
if (Code=200) or (Name='Egrave') then E:='<EFBFBD>' else { capital E, grave accent }
if (Code=201) or (Name='Eacute') then E:='<EFBFBD>' else { capital E, acute accent }
if (Code=200) or (Name='Egrave') then E:='' else { capital E, grave accent }
if (Code=201) or (Name='Eacute') then E:='' else { capital E, acute accent }
if (Code=202) or (Name='Ecirc') then E:='E' else { capital E, circumflex accent }
if (Code=203) or (Name='Euml') then E:='E' else { capital E, dieresis or umlaut }
if (Code=204) or (Name='Igrave') then E:='I' else { capital I, grave accent }
@ -518,7 +496,7 @@ begin
if (Code=233) or (Name='eacute') then E:='‚' else { small e, acute accent }
if (Code=234) or (Name='ecirc') then E:='ˆ' else { small e, circumflex accent }
if (Code=235) or (Name='euml') then E:='‰' else { small e, dieresis or umlaut }
if (Code=236) or (Name='igrave') then E:='<EFBFBD>' else { small i, grave accent }
if (Code=236) or (Name='igrave') then E:='' else { small i, grave accent }
if (Code=237) or (Name='iacute') then E:='¡' else { small i, acute accent }
if (Code=238) or (Name='icirc') then E:='Œ' else { small i, circumflex accent }
if (Code=239) or (Name='iuml') then E:='‹' else { small i, dieresis or umlaut }
@ -534,7 +512,7 @@ begin
if (Code=249) or (Name='ugrave') then E:='—' else { small u, grave accent }
if (Code=250) or (Name='uacute') then E:='£' else { small u, acute accent }
if (Code=251) or (Name='ucirc') then E:='–' else { small u, circumflex accent }
if (Code=252) or (Name='uuml') then E:='<EFBFBD>' else { small u, dieresis or umlaut }
if (Code=252) or (Name='uuml') then E:='' else { small u, dieresis or umlaut }
if (Code=253) or (Name='yacute') then E:='y' else { small y, acute accent }
(* if (Code=254) or (Name='thorn') then E:='?' else { small thorn, Icelandic }*)
if (Code=255) or (Name='yuml') then E:='y' else { small y, dieresis or umlaut }

8
ide/whtmlhlp.pas
View File

@ -1344,7 +1344,7 @@ begin
end;
function TCustomHTMLHelpFile.SearchTopic(HelpCtx: THelpCtx): PTopic;
function MatchCtx(P: PTopic): boolean; {$ifndef FPC}far;{$endif}
function MatchCtx(P: PTopic): boolean;
begin
MatchCtx:=P^.HelpCtx=HelpCtx;
end;
@ -1535,7 +1535,7 @@ begin
Alias:=Trim(copy(Alias,1,HelpFacility^.IndexTabSize-4-2))+'..';
FormatAlias:=Alias;
end;
(*procedure AddDoc(P: PHTMLLinkScanDocument); {$ifndef FPC}far;{$endif}
(*procedure AddDoc(P: PHTMLLinkScanDocument);
var I: sw_integer;
TLI: THelpCtx;
begin
@ -1576,7 +1576,7 @@ begin
LoadIndex:=OK;
end;
function CreateProcHTML(const FileName,Param: string;Index : longint): PHelpFile; {$ifndef FPC}far;{$endif}
function CreateProcHTML(const FileName,Param: string;Index : longint): PHelpFile;
var H: PHelpFile;
begin
H:=nil;
@ -1585,7 +1585,7 @@ begin
CreateProcHTML:=H;
end;
function CreateProcHTMLIndex(const FileName,Param: string;Index : longint): PHelpFile; {$ifndef FPC}far;{$endif}
function CreateProcHTMLIndex(const FileName,Param: string;Index : longint): PHelpFile;
var H: PHelpFile;
begin
H:=nil;

10
ide/wnghelp.pas
View File

@ -350,7 +350,7 @@ begin
Alias:=Trim(copy(Alias,1,HelpFacility^.IndexTabSize-4-2))+'..';
FormatAlias:=Alias;
end;}
procedure AddToIndex(P: PContainerItemRec); {$ifndef FPC}far;{$endif}
procedure AddToIndex(P: PContainerItemRec);
var S: string;
begin
S:=Trim(P^.Name);
@ -444,17 +444,17 @@ procedure AddLine(const S: string);
begin
Lines^.InsertStr(S);
end;
procedure AddToTopic(P: PContainerItemRec); {$ifndef FPC}far;{$endif}
procedure AddToTopic(P: PContainerItemRec);
begin
AddLine(hscLink+Trim(P^.Name)+hscLink);
AddLinkToTopic(T,ID,P^.FilePos);
end;
procedure AddTopicLine(P: PString); {$ifndef FPC}far;{$endif}
procedure AddTopicLine(P: PString);
begin
AddLine(' '+GetStr(P));
end;
var LinkCount: sw_integer;
procedure AddLink(P: PLinkRec); {$ifndef FPC}far;{$endif}
procedure AddLink(P: PLinkRec);
begin
Inc(LinkCount);
if LinkCount=1 then
@ -505,7 +505,7 @@ begin
inherited Done;
end;
function CreateProc(const FileName,Param: string;Index : longint): PHelpFile; {$ifndef FPC}far;{$endif}
function CreateProc(const FileName,Param: string;Index : longint): PHelpFile;
begin
CreateProc:=New(PNGHelpFile, Init(FileName,Index));
end;

2
ide/woahelp.pas
View File

@ -581,7 +581,7 @@ begin
inherited Done;
end;
function CreateProc(const FileName,Param: string;Index : longint): PHelpFile; {$ifndef FPC}far;{$endif}
function CreateProc(const FileName,Param: string;Index : longint): PHelpFile;
begin
CreateProc:=New(POAHelpFile, Init(FileName,Index));
end;

2
ide/wos2help.pas
View File

@ -597,7 +597,7 @@ begin
inherited Done;
end;
function CreateProc(const FileName,Param: string;Index : longint): PHelpFile; {$ifndef FPC}far;{$endif}
function CreateProc(const FileName,Param: string;Index : longint): PHelpFile;
begin
CreateProc:=New(POS2HelpFile, Init(FileName,Index));
end;

86
ide/wutils.pas
View File

@ -14,11 +14,6 @@ unit WUtils;
interface
{$ifndef FPC}
{$define TPUNIXLF}
{$endif}
uses
{$ifdef Windows}
windows,
@ -32,12 +27,8 @@ uses
{$endif}
{$ifdef Unix}
{$ifdef VER1_0}
linux,
{$else}
baseunix,
unix,
{$endif}
baseunix,
unix,
{$endif Unix}
Dos,Objects;
@ -118,10 +109,6 @@ type
function AtInt(Index: sw_integer): ptrint;
end;
{$ifdef TPUNIXLF}
procedure readln(var t:text;var s:string);
{$endif}
procedure ReadlnFromStream(Stream: PStream; var s:string;var linecomplete,hasCR : boolean);
function eofstream(s: pstream): boolean;
procedure ReadlnFromFile(var f : file; var S:string;
@ -185,9 +172,6 @@ function Now: longint;
function FormatDateTimeL(L: longint; const Format: string): string;
function FormatDateTime(const D: DateTime; const Format: string): string;
{$ifdef TP}
function StrPas(C: PChar): string;
{$endif}
function MemToStr(var B; Count: byte): string;
procedure StrToMem(S: string; var B);
@ -232,37 +216,6 @@ const
);
{$endif}
{$ifdef TPUNIXLF}
procedure readln(var t:text;var s:string);
var
c : char;
i : longint;
begin
if TextRec(t).UserData[1]=2 then
system.readln(t,s)
else
begin
c:=#0;
i:=0;
while (not eof(t)) and (c<>#10) and (i<High(S)) do
begin
read(t,c);
if c<>#10 then
begin
inc(i);
s[i]:=c;
end;
end;
if (i>0) and (s[i]=#13) then
begin
dec(i);
TextRec(t).UserData[1]:=2;
end;
s[0]:=chr(i);
end;
end;
{$endif}
function eofstream(s: pstream): boolean;
begin
eofstream:=(s^.getpos>=s^.getsize);
@ -385,24 +338,6 @@ procedure ReadlnFromFile(var f : file; var S:string;
s[0]:=chr(i);
end;
{$ifdef TP}
{ TP's own StrPas() is buggy, because it causes GPF with strings longer than
255 chars }
function StrPas(C: PChar): string;
var S: string;
I: longint;
begin
if Assigned(C)=false then
S:=''
else
begin
I:=StrLen(C); if I>High(S) then I:=High(S);
S[0]:=chr(I); Move(C^,S[1],I);
end;
StrPas:=S;
end;
{$endif}
function MemToStr(var B; Count: byte): string;
var S: string;
begin
@ -427,9 +362,6 @@ begin
end;
function CharStr(C: char; Count: integer): string;
{$ifndef FPC}
var S: string;
{$endif}
begin
if Count<=0 then
begin
@ -438,14 +370,8 @@ begin
end
else if Count>255 then
Count:=255;
{$ifdef FPC}
CharStr[0]:=chr(Count);
FillChar(CharStr[1],Count,C);
{$else}
S[0]:=chr(Count);
FillChar(S[1],Count,C);
CharStr:=S;
{$endif}
end;
function UpcaseStr(const S: string): string;
@ -744,7 +670,7 @@ begin
end;
procedure TUnsortedStringCollection.Assign(ALines: PUnsortedStringCollection);
procedure AddIt(P: PString); {$ifndef FPC}far;{$endif}
procedure AddIt(P: PString);
begin
Insert(NewStr(GetStr(P)));
end;
@ -1245,9 +1171,7 @@ var
begin
Dos.FindFirst(FileName,Archive+ReadOnly,Dir);
ExistsFile:=(Dos.DosError=0);
{$ifdef FPC}
Dos.FindClose(Dir);
{$endif def FPC}
end;
{ returns zero for empty and non existant files }
@ -1261,9 +1185,7 @@ begin
SizeOfFile:=Dir.Size
else
SizeOfFile:=0;
{$ifdef FPC}
Dos.FindClose(Dir);
{$endif def FPC}
end;
function ExistsDir(const DirName: string): boolean;
@ -1275,9 +1197,7 @@ begin
at least for some Dos version
so we need to check the attributes PM }
ExistsDir:=(Dos.DosError=0) and ((Dir.attr and Directory) <> 0);
{$ifdef FPC}
Dos.FindClose(Dir);
{$endif def FPC}
end;
function CompleteDir(const Path: string): string;

2
ide/wviews.pas
View File

@ -44,7 +44,7 @@ const
CPlainCluster = #7#8#9#9;
type
longstring = {$ifdef TP}string{$else}ansistring{$endif};
longstring = ansistring;
PCenterDialog = ^TCenterDialog;
TCenterDialog = object(TDialog)

2
ide/wvphelp.pas
View File

@ -168,7 +168,7 @@ begin
inherited Done;
end;
function CreateProc(const FileName,Param: string;Index : longint): PHelpFile; {$ifndef FPC}far;{$endif}
function CreateProc(const FileName,Param: string;Index : longint): PHelpFile;
begin
CreateProc:=New(PVPHHelpFile, Init(FileName,Index));
end;

6
ide/wwinhelp.pas
View File

@ -1282,7 +1282,7 @@ begin
Dec(RemSize,CurFrag); Inc(CurOfs,CurFrag);
end;
end;
function SearchTopicStart(P: PTopicEnumData): boolean; {$ifndef FPC}far;{$endif}
function SearchTopicStart(P: PTopicEnumData): boolean;
begin
case P^.TL.RecordType of
$02 : TopicStartPos:=P^.TopicPos;
@ -1290,7 +1290,7 @@ begin
GotIt:=(P^.TL.RecordType in [$20,$23]) and (P^.TopicOfs<=BlockOfs) and (BlockOfs<P^.TopicOfs+P^.LinkData2Size);
SearchTopicStart:=not GotIt;
end;
function RenderTopicProc(P: PTopicEnumData): boolean; {$ifndef FPC}far;{$endif}
function RenderTopicProc(P: PTopicEnumData): boolean;
var LinkData1Ofs: longint;
LinkData2Ofs: longint;
function ReadUCHAR: byte;
@ -1665,7 +1665,7 @@ begin
inherited Done;
end;
function CreateProc(const FileName,Param: string;Index : longint): PHelpFile; {$ifndef FPC}far;{$endif}
function CreateProc(const FileName,Param: string;Index : longint): PHelpFile;
begin
CreateProc:=New(PWinHelpFile, Init(FileName,Index));
end;