paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-20 10:49:34 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Gabor changes: see fixes.txt

Browse Source
This commit is contained in:
pierre 2000-06-22 09:07:11 +00:00
parent 9fd7ba963e
commit ddee9c4979
33 changed files with 810 additions and 424 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
ide/text/fixes.txt
View File

@ -1,3 +1,13 @@
Gabors's log to 22/6/2000 commits
========================== Other improvements ============================
[+] added support for reading .NG (Norton Guide) in the help system
========================== Misc modifications ============================
[?] the VESA unit now uses the routines of PMODE, instead of it's owns
[?] constants (255) changed to High()s in checks for maximum string lengths
Gabors's log to 16/6/2000 commits
========================= Already fixed ================================

7
ide/text/fpcatch.pas
View File

@ -43,7 +43,7 @@ uses
drivers,
{$endif FPC}
app,commands,msgbox,
FPString,FPViews,FPIDE;
FPString,FPIDE;
{$ifdef HasSignal}
@ -112,7 +112,10 @@ end.
{
$Log$
Revision 1.5 2000-05-02 08:42:26 pierre
Revision 1.6 2000-06-22 09:07:11 pierre
* Gabor changes: see fixes.txt
Revision 1.5 2000/05/02 08:42:26 pierre
* new set of Gabor changes: see fixes.txt
Revision 1.4 2000/03/07 21:09:20 pierre

2
ide/text/fpcodcmp.pas
View File

@ -186,8 +186,6 @@ function TCodeCompleteDialog.Execute: Word;
var R: word;
C: PCodeCompleteWordList;
I: integer;
S1,S2,S3: string;
W: word;
begin
New(C, Init(10,20));
if Assigned(CodeCompleteWords) then

9
ide/text/fpcodtmp.pas
View File

@ -72,7 +72,7 @@ procedure RegisterCodeTemplates;
implementation
uses Commands,Views,MsgBox,App,
uses Commands,Views,App,
FPConst,FPString;
{$ifndef NOOBJREG}
@ -252,8 +252,6 @@ end;
constructor TCodeTemplateDialog.Init(const ATitle: string; ATemplate: PCodeTemplate);
var R,R2,R3: TRect;
Items: PSItem;
I,KeyCount: sw_integer;
begin
R.Assign(0,0,52,15);
inherited Init(R,ATitle);
@ -276,7 +274,6 @@ function TCodeTemplateDialog.Execute: Word;
var R: word;
S: string;
L: PUnsortedStringCollection;
W: word;
begin
New(L, Init(10,10));
S:=Template^.GetShortCut;
@ -392,8 +389,6 @@ var R: word;
C: PCodeTemplateCollection;
L: PUnsortedStringCollection;
I: integer;
S1,S2,S3: string;
W: word;
begin
New(C, Init(10,20));
if Assigned(CodeTemplates) then
@ -423,8 +418,6 @@ var P,P2: PCodeTemplate;
IC: boolean;
S: string;
L: PUnsortedStringCollection;
I: sw_integer;
W: word;
Cmd: word;
CanExit: boolean;
begin

8
ide/text/fpcompil.pas
View File

@ -93,7 +93,7 @@ uses
{$endif}
Dos,Video,
App,Commands,tokens,
CompHook, Compiler, systems, browcol, switches,
CompHook, Compiler, systems, browcol,
WEditor,
FPString,FPRedir,FPDesk,FPUsrScr,FPHelp,
FPConst,FPVars,FPUtils,FPIntf,FPSwitch;
@ -641,7 +641,6 @@ var
Error,LinkErrorCount : longint;
E : TEvent;
DummyView: PView;
R: TRect;
const
PpasFile = 'ppas';
@ -912,7 +911,10 @@ end;
end.
{
$Log$
Revision 1.59 2000-06-16 08:50:40 pierre
Revision 1.60 2000-06-22 09:07:11 pierre
* Gabor changes: see fixes.txt
Revision 1.59 2000/06/16 08:50:40 pierre
+ new bunch of Gabor's changes
Revision 1.58 2000/05/29 10:44:56 pierre

8
ide/text/fpconst.pas
View File

@ -49,8 +49,9 @@ const
HTMLIndexExt = '.htx';
HTMLExt = '.htm';
HelpFileExts = '*.tph;*.htm*;*'+HTMLIndexExt;
TemplateExt = '.pt';
NGExt = '.ng';
HelpFileExts = '*.tph;*.htm*;*'+HTMLIndexExt+';*'+NGExt;
EnterSign = #17#196#217;
@ -405,7 +406,10 @@ implementation
END.
{
$Log$
Revision 1.40 2000-06-16 08:50:40 pierre
Revision 1.41 2000-06-22 09:07:11 pierre
* Gabor changes: see fixes.txt
Revision 1.40 2000/06/16 08:50:40 pierre
+ new bunch of Gabor's changes
Revision 1.39 2000/05/30 07:18:33 pierre

8
ide/text/fpdebug.pas
View File

@ -342,7 +342,7 @@ procedure UpdateDebugViews;
implementation
uses
Dos,Mouse,Video,
Dos,Video,
App,Commands,Strings,
{$ifdef win32}
Windebug,
@ -1650,7 +1650,6 @@ var R,R2: TRect;
S: String;
X,X1 : Sw_integer;
Btn: PButton;
const White = 15;
begin
Desktop^.GetExtent(R); R.A.Y:=R.B.Y-18;
inherited Init(R, dialog_breakpointlist, wnNoNumber);
@ -3347,7 +3346,10 @@ end.
{
$Log$
Revision 1.62 2000-06-11 07:01:32 peter
Revision 1.63 2000-06-22 09:07:11 pierre
* Gabor changes: see fixes.txt
Revision 1.62 2000/06/11 07:01:32 peter
* give watches window also a number
* leave watches window in the bottom when cascading windows

9
ide/text/fpdesk.pas
View File

@ -47,15 +47,13 @@ uses Dos,
Objects,Drivers,Video,
Views,App,HistList,BrowCol,
WResourc,WViews,WEditor,
WUtils,
{$ifndef NODEBUG}
fpdebug,
{$endif ndef NODEBUG}
FPConst,FPVars,FPString,FPUtils,FPViews,FPCompile,FPTools,FPHelp,
FPConst,FPVars,FPString,FPUtils,FPViews,FPHelp,
FPCodCmp,FPCodTmp;
type
PWindowInfo = ^TWindowInfo;
TWindowInfo = packed record
HelpCtx : word;
Bounds : TRect;
@ -797,7 +795,10 @@ end;
END.
{
$Log$
Revision 1.28 2000-05-02 08:42:27 pierre
Revision 1.29 2000-06-22 09:07:12 pierre
* Gabor changes: see fixes.txt
Revision 1.28 2000/05/02 08:42:27 pierre
* new set of Gabor changes: see fixes.txt
Revision 1.27 2000/04/25 08:42:33 pierre

17
ide/text/fphelp.pas
View File

@ -282,6 +282,14 @@ procedure InitHelpSystem;
{$IFDEF DEBUG}SetStatus(msg_LoadingHelpFile);{$ENDIF}
end;
procedure AddNGFile(HelpFile: string);
begin
{$IFDEF DEBUG}SetStatus(msg_LoadingHelpFile+' ('+SmartPath(HelpFile)+')');{$ENDIF}
if HelpFacility^.AddNGHelpFile(HelpFile)=false then
ErrorBox(FormatStrStr(msg_failedtoloadhelpfile,HelpFile),nil);
{$IFDEF DEBUG}SetStatus(msg_LoadingHelpFile);{$ENDIF}
end;
procedure AddHTMLIndexFile(HelpFile: string);
begin
{$IFDEF DEBUG}SetStatus(msg_LoadingHelpFile+' ('+SmartPath(HelpFile)+')');{$ENDIF}
@ -301,12 +309,14 @@ begin
S:=HelpFiles^.At(I)^; TopicTitle:='';
P:=Pos('|',S);
if P>0 then
begin TopicTitle:=copy(S,P+1,255); S:=copy(S,1,P-1); end;
begin TopicTitle:=copy(S,P+1,High(S)); S:=copy(S,1,P-1); end;
if TopicTitle='' then TopicTitle:=S;
if copy(UpcaseStr(ExtOf(S)),1,length(HTMLExt))=UpcaseStr(HTMLExt) then { this recognizes both .htm and .html }
AddHTMLFile(TopicTitle,S) else
if UpcaseStr(ExtOf(S))=UpcaseStr(HTMLIndexExt) then
AddHTMLIndexFile(S) else
if UpcaseStr(ExtOf(S))=UpcaseStr(NGExt) then
AddNGFile(S) else
AddOAFile(S);
end;
PopStatus;
@ -480,7 +490,10 @@ end;
END.
{
$Log$
Revision 1.33 2000-06-16 08:50:40 pierre
Revision 1.34 2000-06-22 09:07:12 pierre
* Gabor changes: see fixes.txt
Revision 1.33 2000/06/16 08:50:40 pierre
+ new bunch of Gabor's changes
Revision 1.32 2000/05/30 07:18:33 pierre

8
ide/text/fpide.pas
View File

@ -154,9 +154,8 @@ uses
{$endif WinClipSupported}
Video,Mouse,Keyboard,
Dos,Memory,Menus,Dialogs,StdDlg,ColorSel,Commands,HelpCtx,
AsciiTab,
Systems,
WUtils,WHelp,WHlpView,WINI,WViews,
WUtils,WHlpView,WViews,
FPConst,FPVars,FPUtils,FPSwitch,FPIni,FPIntf,FPCompile,FPHelp,
FPTemplt,FPCalc,FPUsrScr,FPTools,{$ifndef NODEBUG}FPDebug,{$endif}FPRedir,
FPDesk,FPCodCmp,FPCodTmp;
@ -1061,7 +1060,10 @@ end;
END.
{
$Log$
Revision 1.64 2000-06-16 21:19:41 pierre
Revision 1.65 2000-06-22 09:07:12 pierre
* Gabor changes: see fixes.txt
Revision 1.64 2000/06/16 21:19:41 pierre
* Use Open instead of OpenSearch if OpenFileName is empty
Revision 1.63 2000/06/16 08:50:40 pierre

15
ide/text/fpini.pas
View File

@ -27,9 +27,9 @@ function WriteINIFile: boolean;
implementation
uses
Dos,Objects,Drivers,App,
Dos,Objects,Drivers,
WINI,{$ifndef EDITORS}WEditor,WCEdit{$else}Editors{$endif},
{$ifndef NODEBUG}FPDebug,{$endif}FPConst,FPVars,FPViews,
{$ifndef NODEBUG}FPDebug,{$endif}FPConst,FPVars,
FPIntf,FPTools,FPSwitch;
const
@ -84,7 +84,7 @@ const
ieWatchCount = 'Count';
ieWatchName = 'Watch';
ieSourceList = 'SourceList';
ieVideoMode = 'VideoMode';
{ ieVideoMode = 'VideoMode';}
ieAutoSave = 'AutoSaveFlags';
ieMiscOptions = 'MiscOptions';
ieDesktopLocation = 'DesktopLocation';
@ -125,11 +125,11 @@ begin
begin
Inc(I); Hex:=false;
if S[I]='$' then begin Inc(I); Hex:=true; end;
P:=Pos('#',copy(S,I,255)); if P>0 then P:=I+P-1 else P:=length(S)+1;
P:=Pos('#',copy(S,I,High(S))); if P>0 then P:=I+P-1 else P:=length(S)+1;
if Hex=false then
begin
X:=StrToInt(copy(S,I,P-I));
OK:=(LastStrToIntResult=0) and (0<=X) and (X<=255);
OK:=(LastStrToIntResult=0) and (0<=X) and (X<=High(S));
end
else
begin
@ -528,7 +528,10 @@ end;
end.
{
$Log$
Revision 1.29 2000-06-16 08:50:41 pierre
Revision 1.30 2000-06-22 09:07:12 pierre
* Gabor changes: see fixes.txt
Revision 1.29 2000/06/16 08:50:41 pierre
+ new bunch of Gabor's changes
Revision 1.28 2000/03/21 23:30:22 pierre

9
ide/text/fpintf.pas
View File

@ -30,11 +30,11 @@ procedure SetPrimaryFile(const fn:string);
implementation
uses
Compiler,CompHook,
Compiler,
{$ifndef NODEBUG}
FPDebug,
{$endif NODEBUG}
FPCompile,FPRedir,FPVars,
FPRedir,FPVars,
FPUtils,FPSwitch;
{****************************************************************************
@ -212,7 +212,10 @@ end;
end.
{
$Log$
Revision 1.11 2000-05-29 10:44:56 pierre
Revision 1.12 2000-06-22 09:07:12 pierre
* Gabor changes: see fixes.txt
Revision 1.11 2000/05/29 10:44:56 pierre
+ New bunch of Gabor's changes: see fixes.txt
Revision 1.10 2000/05/02 08:42:27 pierre

7
ide/text/fpswitch.pas
View File

@ -172,7 +172,7 @@ implementation
uses
Dos,
GlobType,Tokens,Compiler,
GlobType,
FPString,FPVars,FPUtils;
var
@ -1113,7 +1113,10 @@ end;
end.
{
$Log$
Revision 1.22 2000-05-02 08:42:28 pierre
Revision 1.23 2000-06-22 09:07:12 pierre
* Gabor changes: see fixes.txt
Revision 1.22 2000/05/02 08:42:28 pierre
* new set of Gabor changes: see fixes.txt
Revision 1.21 2000/04/25 08:42:33 pierre

7
ide/text/fpsymbol.pas
View File

@ -868,7 +868,7 @@ end;
procedure TSymbolReferenceView.HandleEvent(var Event: TEvent);
var OldFocus: sw_integer;
DontClear: boolean;
{ DontClear: boolean;}
begin
OldFocus:=Focused;
{ case Event.What of
@ -1692,7 +1692,10 @@ end;
END.
{
$Log$
Revision 1.28 2000-06-16 08:50:42 pierre
Revision 1.29 2000-06-22 09:07:12 pierre
* Gabor changes: see fixes.txt
Revision 1.28 2000/06/16 08:50:42 pierre
+ new bunch of Gabor's changes
Revision 1.27 2000/05/29 10:44:57 pierre

9
ide/text/fptemplt.pas
View File

@ -169,11 +169,11 @@ begin
ReadStringPos:=-1;
end;
function ReadString(const InS: string; StartP: sw_integer; var Expr: string): sw_integer;
{function ReadString(const InS: string; StartP: sw_integer; var Expr: string): sw_integer;
var P: sw_integer;
begin
ReadString:=ReadStringPos(InS,StartP,Expr,P);
end;
end;}
function ProcessTemplateLine(var S: string): boolean;
var OK: boolean;
@ -289,7 +289,10 @@ end;
END.
{
$Log$
Revision 1.9 2000-05-02 08:42:28 pierre
Revision 1.10 2000-06-22 09:07:12 pierre
* Gabor changes: see fixes.txt
Revision 1.9 2000/05/02 08:42:28 pierre
* new set of Gabor changes: see fixes.txt
Revision 1.8 1999/06/25 00:33:40 pierre

27
ide/text/fptools.pas
View File

@ -149,8 +149,8 @@ implementation
uses Dos,
Commands,App,MsgBox,
WUtils,WINI,WEditor,
FPConst,FPString,FPVars,FPUtils,FPCodCmp,FPCodTmp;
WINI,WEditor,
FPConst,FPString,FPVars,FPUtils;
{$ifndef NOOBJREG}
const
@ -571,7 +571,7 @@ begin
ReDraw;
end;
procedure ReplaceStr(var S: string; const What,NewS: string);
(*procedure ReplaceStr(var S: string; const What,NewS: string);
var I : integer;
begin
repeat
@ -597,7 +597,7 @@ begin
Insert(NewS,S,I);
end;
until I=0;
end;
end;*)
function GetCoordEntry(F: PINIFile; Section, Entry: string; var P: TPoint): boolean;
var OK: boolean;
@ -612,7 +612,7 @@ begin
OK:=OK and (Px>0);
if OK then P.X:=StrToInt(copy(S,1,Px-1));
OK:=OK and (LastStrToIntResult=0);
if OK then P.Y:=StrToInt(copy(S,Px+1,255));
if OK then P.Y:=StrToInt(copy(S,Px+1,High(S)));
OK:=OK and (LastStrToIntResult=0);
GetCoordEntry:=OK;
end;
@ -1008,7 +1008,7 @@ begin
if (WordS='$CAP') then
begin
if (Pass=0) then
if (Params[I]=' ') and (I<=255) then Params[I]:='_';
if (Params[I]=' ') and (I<=High(Params)) then Params[I]:='_';
end else
if (WordS='$CAP_MSG') then
begin
@ -1090,7 +1090,7 @@ begin
if ReadTill(S,')')=false then Err:=I else
begin
Consume(')');
FSplit(S,D,N,E); E:=copy(E,2,255);
FSplit(S,D,N,E); E:=copy(E,2,High(E));
I:=I+ReplacePart(LastWordStart,I-1,E)-1;
end;
end else
@ -1167,9 +1167,9 @@ begin
I:=I+ReplacePart(LastWordStart,I-1,'')-1;
if CheckOnly=false then
begin
S:=copy(Params,I+1,255);
S:=copy(Params,I+1,High(Params));
if InputBox(dialog_programarguments, label_enterprogramargument,
S,255-I+1)=cmOK then
S,High(Params)-I+1)=cmOK then
begin
ReplacePart(LastWordStart,255,S);
I:=255;
@ -1182,7 +1182,7 @@ begin
if (WordS='$SAVE') then
begin
if (Pass=0) then
if (Params[I]=' ') and (I<=255) then Params[I]:='_';
if (Params[I]=' ') and (I<=High(Params)) then Params[I]:='_';
end else
if (WordS='$SAVE_ALL') then
begin
@ -1259,7 +1259,7 @@ procedure AddLine;
begin
Row:=ord(Line[1])+ord(Line[2]) shl 8;
Col:=ord(Line[3])+ord(Line[4]) shl 8;
AddToolMessage(FileName,copy(Line,5,255),Row,Col);
AddToolMessage(FileName,copy(Line,5,High(Line)),Row,Col);
end;
begin
New(S, Init(MsgFileName, stOpenRead, 4096));
@ -1507,7 +1507,10 @@ end;
END.
{
$Log$
Revision 1.19 2000-05-02 08:42:29 pierre
Revision 1.20 2000-06-22 09:07:12 pierre
* Gabor changes: see fixes.txt
Revision 1.19 2000/05/02 08:42:29 pierre
* new set of Gabor changes: see fixes.txt
Revision 1.18 2000/04/25 08:42:33 pierre

7
ide/text/fputils.pas
View File

@ -126,7 +126,7 @@ function SmartPath(Path: string): string;
var S: string;
begin
GetDir(0,S); if copy(S,length(S),1)<>DirSep then S:=S+DirSep;
if (copy(Path,1,length(S))=S) {and (Pos('\',copy(Path,length(S)+1,255))=0)} then
if (copy(Path,1,length(S))=S) {and (Pos('\',copy(Path,length(S)+1,High(S)))=0)} then
system.Delete(Path,1,length(S));
SmartPath:=Path;
end;
@ -664,7 +664,10 @@ end;
END.
{
$Log$
Revision 1.15 2000-04-18 11:42:37 pierre
Revision 1.16 2000-06-22 09:07:13 pierre
* Gabor changes: see fixes.txt
Revision 1.15 2000/04/18 11:42:37 pierre
lot of Gabor changes : see fixes.txt
Revision 1.14 2000/01/03 11:38:34 michael

12
ide/text/fpviews.pas
View File

@ -440,8 +440,7 @@ procedure RegisterFPViews;
implementation
uses
{$ifdef GABOR}crt,{$endif}
Video,Strings,Keyboard,Memory,MsgBox,Validate,
Video,Strings,Keyboard,Validate,
Tokens,Version,
{$ifndef NODEBUG}
gdbint,
@ -1389,8 +1388,8 @@ begin
else if Editor^.GetModified then
begin
PA[1]:=@AFileName;
(* longint(PA[2]):=Editor^.ChangedLine;
EditorDialog(edChangedOnloading,@PA);*)
longint(PA[2]):={Editor^.ChangedLine}-1;
EditorDialog(edChangedOnloading,@PA);
end;
end;
Insert(Editor);
@ -3472,7 +3471,10 @@ end;
END.
{
$Log$
Revision 1.72 2000-06-16 08:50:42 pierre
Revision 1.73 2000-06-22 09:07:13 pierre
* Gabor changes: see fixes.txt
Revision 1.72 2000/06/16 08:50:42 pierre
+ new bunch of Gabor's changes
Revision 1.71 2000/05/29 10:44:57 pierre

6
ide/text/pmode.pas
View File

@ -581,7 +581,6 @@ end;
procedure realcall(Proc: pointer; var r: registers);
var rr: trealregs;
const DPMI_INTR = $31;
begin
rr.realeax:=r.ax;
rr.realebx:=r.bx;
@ -718,7 +717,10 @@ end;
END.
{
$Log$
Revision 1.1 2000-04-20 08:47:39 pierre
Revision 1.2 2000-06-22 09:07:13 pierre
* Gabor changes: see fixes.txt
Revision 1.1 2000/04/20 08:47:39 pierre
+ new files from Gabor

14
ide/text/readme.ide
View File

@ -76,13 +76,13 @@
Documentation Ü
ßßßßßßßßßßßßßßßß
Although the IDE itself has no kind of "native"
documentation or help, it is capable of reading both HTML
and TPH format help files. That means, that you can use
both the FPC documentation (included in your distribution,
or downloadable from the Free Pascal HP) and/or the help
files of your Turbo or Borland Pascal (from version 5.5
thru 7.0) installation.
You can install help files of both types in the on-line
documentation or help, it is capable of reading HTML,
Turbo Pascal (TPH), and Norton Guide (NG) format files.
That means, that you can use both the FPC documentation
(included in your distribution, or downloadable from the
Free Pascal HP) and/or the help files of your Turbo or
Borland Pascal (from version 5.5 thru 7.0) installation.
You can install help files of all types in the on-line
help system by going to Help menu, selecting Files and
adding them to the list.

265
ide/text/vesa.pas
View File

@ -19,16 +19,6 @@ interface
uses
Dos,
{$ifdef TP}
{$ifdef DPMI}
WinDos,WinAPI,
{$endif}
{$endif}
{$ifdef FPC}
{$ifdef GO32V2}
Go32,
{$endif}
{$endif}
Objects,Strings,WUtils;
const
@ -136,170 +126,23 @@ function VESAGetMode(var Mode: word): boolean;
function VESASelectMemoryWindow(Window: byte; Position: word): boolean;
function VESAReturnMemoryWindow(Window: byte; var Position: word): boolean;
function MemToStr(var B; Count: byte): string;
implementation
{$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;
MemPtr = record
{$ifdef TP}
Selector: Word; {Protected mode}
Segment : Word; {Real mode}
{$endif}
{$ifdef FPC}
Selector: Word; {Real mode}
Segment : Word; {Protected mode}
{$endif}
end;
Function GetMem(var Mem : MemPtr; Size : Word): Boolean;
begin
if (Size > 0) then
begin
{$ifdef TP}
LongInt(Mem) := GlobalDOSAlloc(Size);
{$endif}
{$ifdef FPC}
longint(Mem) := global_dos_alloc(Size);
if int31error<>0 then longint(Mem):=0;
{$endif}
GetMem := (LongInt(Mem) <> 0);
end
else
begin
LongInt(Mem) := 0;
GetMem := True;
end;
end;
Procedure FreeMem(Mem : MemPtr; Size : Word);
begin
{$ifdef TP}
if (Size > 0) then
GlobalDOSFree(Mem.Selector);
{$endif}
{$ifdef FPC}
if (Size > 0) then
global_dos_free(Mem.Selector);
{$endif}
end;
Function MakePtr(Mem : MemPtr): Pointer;
begin
MakePtr := Ptr(Mem.Selector, 0);
end;
{$ifdef TP}
var
DPMIRegs: TDPMIRegisters;
procedure realintr(IntNo: byte; var r: tregisters);
var Regs: TRegisters;
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);
Dos.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}
{$ENDIF}
function MemToStr(var B; Count: byte): string;
var S: string;
begin
S[0]:=chr(Count);
if Count>0 then Move(B,S[1],Count);
MemToStr:=S;
end;
procedure StrToMem(S: string; var B);
begin
if length(S)>0 then Move(S[1],B,length(S));
end;
uses pmode;
function VESAGetInfo(var B: TVESAInfoBlock): boolean;
{$IFNDEF DPMI}
var r : registers;
{$ELSE}
var r : tregisters;
pB : MemPtr;
{$ENDIF}
var r: registers;
OK: boolean;
M: MemPtr;
begin
StrToMem('VBE2',B.Signature);
GetDosMem(M,SizeOf(B));
M.MoveDataTo(B,sizeof(B));
r.ah:=$4f; r.al:=0;
{$IFNDEF DPMI}
r.es:=seg(B); r.di:=ofs(B);
intr($10,r);
{$ELSE}
GetMem(pB, SizeOf(B));
{$ifdef TP}
Move(B,MakePtr(pB)^,SizeOf(B));
{$endif}
{$ifdef FPC}
dosmemput(pB.Segment,0,B,SizeOf(B));
{$endif}
r.es:=pB.Segment; r.di:=0; r.ds:=r.es;
r.es:=M.DosSeg; r.di:=M.DosOfs;
realintr($10,r);
{$ENDIF}
{$IFDEF DPMI}
{$ifdef TP}
Move(MakePtr(pB)^,B,SizeOf(B));
{$endif}
{$ifdef FPC}
dosmemget(pB.Segment,0,B,SizeOf(B));
{$endif}
FreeMem(pB, SizeOf(B));
{$ENDIF}
M.MoveDataFrom(sizeof(B),B);
FreeDosMem(M);
OK:=(r.ax=$004f){ and (MemToStr(B.Signature,4)='VESA')};
VESAGetInfo:=OK;
end;
@ -307,36 +150,15 @@ end;
function VESAGetModeList(var B: TVESAModeList): boolean;
var OK: boolean;
VI: TVESAInfoBlock;
{$ifdef TP}
{$ifdef DPMI}
Sel: word;
{$endif}
{$endif}
begin
FillChar(B,SizeOf(B),0);
OK:=VESAGetInfo(VI);
if OK then
begin
{$ifdef TP}
{$ifdef DPMI}
Sel:=AllocSelector(0);
OK:=Sel<>0;
OK:=MoveDosToPM(VI.VideoModeList,@B.Modes,sizeof(B.Modes));
if OK then
begin
SetSelectorBase(Sel,(longint(VI.VideoModeList) shr 16)*16+longint(VI.VideoModeList) and $ffff);
SetSelectorLimit(Sel,SizeOf(B.Modes));
Move(ptr(Sel,0)^,B.Modes,SizeOf(B.Modes));
FreeSelector(Sel);
end;
{$endif}
{$endif}
{$ifdef FPC}
with VI do
dosmemget(PtrRec(VideoModeList).Seg,PtrRec(VideoModeList).Ofs,B.Modes,SizeOf(B.Modes));
{$endif}
if OK then
while (B.Modes[B.Count+1]<>$ffff) and (B.Count<255) do
Inc(B.Count);
while (B.Modes[B.Count+1]<>$ffff) and (B.Count<High(B.Modes)) do
Inc(B.Count);
end;
VESAGetModeList:=OK;
end;
@ -364,74 +186,26 @@ end;
function VESAGetOemString: string;
var OK: boolean;
VI: TVESAInfoBlock;
{$ifdef TP}
{$ifdef DPMI}
Sel: word;
{$endif}
{$endif}
S: array[0..256] of char;
begin
FillChar(S,SizeOf(S),0);
OK:=VESAGetInfo(VI);
{$IFDEF DPMI}
if OK then
begin
{$ifdef TP}
Sel:=AllocSelector(0);
OK:=Sel<>0;
if OK then
begin
SetSelectorBase(Sel,longint(PtrRec16(VI.OemString).Seg)*16+PtrRec16(VI.OemString).Ofs);
SetSelectorLimit(Sel,SizeOf(S));
Move(ptr(Sel,0)^,S,SizeOf(S));
FreeSelector(Sel);
end;
{$endif}
{$ifdef FPC}
dosmemget(PtrRec16(VI.OemString).Seg,PtrRec16(VI.OemString).Ofs,S,SizeOf(S));
{$endif}
end;
{$ELSE}
Move(VI.OemString^,S,SizeOf(S));
{$ENDIF}
OK:=MoveDosToPM(VI.OemString,@S,sizeof(S));
VESAGetOemString:=StrPas(@S);
end;
function VESAGetModeInfo(Mode: word; var B: TVESAModeInfoBlock): boolean;
{$IFNDEF DPMI}
var r : registers;
{$ELSE}
var r : tregisters;
{$ENDIF}
M : MemPtr;
OK: boolean;
{$ifdef DPMI}
pB: MemPtr;
{$endif}
begin
r.ah:=$4f; r.al:=$01; r.cx:=Mode;
{$IFDEF DPMI}
GetMem(pB, SizeOf(B));
{$ifdef TP}
Move(B,MakePtr(pB)^,SizeOf(B));
{$endif}
{$ifdef FPC}
dosmemput(pB.Segment,0,B,SizeOf(B));
{$endif}
r.es:=pB.Segment; r.di:=0; {r.ds:=r.es;}
GetDosMem(M,sizeof(B));
r.es:=M.DosSeg; r.di:=M.DosOfs; {r.ds:=r.es;}
realintr($10,r);
{$ELSE}
r.es:=seg(B); r.di:=ofs(B);
intr($10,r);
{$ENDIF}
{$IFDEF DPMI}
{$ifdef TP}
Move(MakePtr(pB)^,B,SizeOf(B));
{$endif}
{$ifdef FPC}
dosmemget(pB.Segment,0,B,SizeOf(B));
{$endif}
FreeMem(pB, SizeOf(B));
{$ENDIF}
M.MoveDataFrom(sizeof(B),B);
FreeDosMem(M);
OK:=(r.ax=$004f);
VESAGetModeInfo:=OK;
end;
@ -490,7 +264,10 @@ BEGIN
END.
{
$Log$
Revision 1.7 2000-03-21 23:22:37 pierre
Revision 1.8 2000-06-22 09:07:13 pierre
* Gabor changes: see fixes.txt
Revision 1.7 2000/03/21 23:22:37 pierre
Gabor fixes to avoid unused vars
Revision 1.6 2000/01/03 11:38:35 michael

2
ide/text/wansi.pas
View File

@ -735,7 +735,6 @@ begin
end;
procedure TANSIView.Draw;
type PDrawBuffer = ^TDrawBuffer;
var I: integer;
Pos: longint;
X,Y: integer;
@ -940,7 +939,6 @@ begin
end;
procedure TANSIBackground.Draw;
type PDrawBuffer = ^TDrawBuffer;
var I: integer;
Pos: longint;
X,Y: integer;

4
ide/text/wcedit.pas
View File

@ -533,8 +533,8 @@ begin
begin
PAdd:=TabSize-((p-1) mod TabSize);
if DF<>'' then
DF:=copy(DF,1,P-1)+CharStr(DF[p],PAdd)+copy(DF,P+1,255);
DT:=copy(DT,1,P-1)+CharStr(' ',PAdd)+copy(DT,P+1,255);
DF:=copy(DF,1,P-1)+CharStr(DF[p],PAdd)+copy(DF,P+1,High(DF));
DT:=copy(DT,1,P-1)+CharStr(' ',PAdd)+copy(DT,P+1,High(DF));
inc(P,PAdd-1);
end;
end;

75
ide/text/weditor.pas
View File

@ -55,7 +55,7 @@ const
cmToggleCase = 51263;
EditorTextBufSize = {$ifdef FPC}32768{$else} 4096{$endif};
MaxLineLength = {$ifdef FPC} 255{$else} 255{$endif};
MaxLineLength = 255;
MaxLineCount = {$ifdef FPC}2000000{$else}16380{$endif};
CodeCompleteMinLen = 4; { minimum length of text to try to complete }
@ -933,7 +933,7 @@ begin
if s[p]=TAB then
begin
PAdd:=TabSize-((p-1) mod TabSize);
s:=copy(S,1,P-1)+CharStr(' ',PAdd)+copy(S,P+1,255);
s:=copy(S,1,P-1)+CharStr(' ',PAdd)+copy(S,P+1,High(s));
inc(P,PAdd-1);
end;
end;
@ -948,7 +948,7 @@ begin
repeat
P:=Pos(TabS,S);
if P>0 then
S:=copy(S,1,P-1)+TAB+copy(S,P+TabSize,255);
S:=copy(S,1,P-1)+TAB+copy(S,P+TabSize,High(S));
until P=0;
CompressUsingTabs:=S;
end;}
@ -1782,21 +1782,31 @@ begin
end;
function TCustomCodeEditorCore.UpdateAttrs(FromLine: sw_integer; Attrs: byte): sw_integer;
var MinLine: sw_integer;
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
var I: sw_integer;
begin
DoUpdateAttrs(P^.Editor,FromLine,Attrs);
I:=DoUpdateAttrs(P^.Editor,FromLine,Attrs);
if (I<MinLine) or (MinLine=-1) then MinLine:=I;
end;
begin
MinLine:=-1;
Bindings^.ForEach(@CallIt);
UpdateAttrs:=MinLine;
end;
function TCustomCodeEditorCore.UpdateAttrsRange(FromLine, ToLine: sw_integer; Attrs: byte): sw_integer;
var MinLine: sw_integer;
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
var I: sw_integer;
begin
DoUpdateAttrsRange(P^.Editor,FromLine,ToLine,Attrs);
I:=DoUpdateAttrsRange(P^.Editor,FromLine,ToLine,Attrs);
if (I<MinLine) or (MinLine=-1) then MinLine:=I;
end;
begin
MinLine:=-1;
Bindings^.ForEach(@CallIt);
UpdateAttrsRange:=MinLine;
end;
function TCustomCodeEditorCore.DoUpdateAttrs(Editor: PCustomCodeEditor; FromLine: sw_integer; Attrs: byte): sw_integer;
@ -2538,7 +2548,7 @@ begin
LineDelta:=0; LineCount:=(Editor^.SelEnd.Y-Editor^.SelStart.Y)+1;
OK:=GetLineCount<MaxLineCount;
OrigS:=GetDisplayText(DestPos.Y);
AfterS:=Copy(OrigS,DestPos.X+1,255);
AfterS:=Copy(OrigS,DestPos.X+1,High(OrigS));
while OK and (LineDelta<LineCount) do
begin
@ -2559,13 +2569,13 @@ begin
if (LineDelta=LineCount-1) or VerticalBlock then
LineEndX:=Editor^.SelEnd.X-1
else
LineEndX:=255;
LineEndX:=High(S);
if LineEndX<LineStartX then
S:=''
else if VerticalBlock then
S:=RExpand(copy(Editor^.GetLineText(Editor^.SelStart.Y+LineDelta),LineStartX+1,LineEndX-LineStartX+1),
Min(LineEndX-LineStartX+1,255))
Min(LineEndX-LineStartX+1,High(S)))
else
S:=copy(Editor^.GetLineText(Editor^.SelStart.Y+LineDelta),LineStartX+1,LineEndX-LineStartX+1);
if VerticalBlock=false then
@ -3161,7 +3171,7 @@ var SelectColor,
LineText,Format: string;
isBreak : boolean;
C: char;
FreeFormat: array[0..255] of boolean;
FreeFormat: array[0..MaxLineLength] of boolean;
Color: word;
ColorTab: array[coFirstColor..coLastColor] of word;
ErrorLine: integer;
@ -3240,7 +3250,7 @@ begin
{ if FlagSet(efSyntaxHighlight) then MaxX:=length(LineText)+1
else }MaxX:=Size.X+Delta.X;
for X:=1 to Min(MaxX,255) do
for X:=1 to Min(MaxX,High(LineText)) do
begin
AX:=Delta.X+X-1;
if X<=length(LineText) then C:=LineText[X] else C:=' ';
@ -3403,7 +3413,7 @@ begin
while (CurPos.X+Shift<length(PreS)) and (PreS[CurPos.X+Shift]<>' ') do
Inc(Shift);
end;
SetLineText(CurPos.Y,RExpand(copy(S,1,CurPos.X+1),CurPos.X+1)+CharStr(' ',Shift)+copy(S,CurPos.X+2,255));
SetLineText(CurPos.Y,RExpand(copy(S,1,CurPos.X+1),CurPos.X+1)+CharStr(' ',Shift)+copy(S,CurPos.X+2,High(S)));
SetCurPtr(CurPos.X+Shift,CurPos.Y);
UpdateAttrs(CurPos.Y,attrAll);
DrawLines(CurPos.Y);
@ -3736,7 +3746,7 @@ var SymIdx: integer;
LineText,LineAttr: string;
CurChar: char;
X,Y: sw_integer;
P,LineCount: sw_integer;
LineCount: sw_integer;
JumpPos: TPoint;
BracketLevel: integer;
begin
@ -3843,7 +3853,7 @@ begin
end;
SetDisplayText(CurPos.Y,copy(S,1,CurPos.X-1+1));
CalcIndent(CurPos.Y);
InsertLine(CurPos.Y+1,IndentStr+copy(S,CurPos.X+1,255));
InsertLine(CurPos.Y+1,IndentStr+copy(S,CurPos.X+1,High(S)));
LimitsChanged;
(* if PointOfs(SelStart)<>PointOfs(SelEnd) then { !!! check it - it's buggy !!! }
begin SelEnd.Y:=CurPos.Y+1; SelEnd.X:=length(GetLineText(CurPos.Y+1))-SelBack; end;*)
@ -3943,7 +3953,7 @@ begin
S:=GetLineText(CurPos.Y);
OI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
CI:=LinePosToCharIdx(CurPos.Y,CP);
SetLineText(CurPos.Y,copy(S,1,CI-1)+copy(S,OI,255));
SetLineText(CurPos.Y,copy(S,1,CI-1)+copy(S,OI,High(S)));
SetCurPtr(CP,CurPos.Y);
{$ifdef Undo}
SetStoreUndo(HoldUndo);
@ -3990,7 +4000,7 @@ begin
CI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
if S[CI]=TAB then
begin
S:=Copy(S,1,CI-1)+CharStr(' ',GetTabSize-1)+Copy(S,CI+1,255);
S:=Copy(S,1,CI-1)+CharStr(' ',GetTabSize-1)+Copy(S,CI+1,High(S));
{$ifdef Undo}
SetStoreUndo(HoldUndo);
Addaction(eaDeleteText,CurPos,CurPos,' ');
@ -4044,7 +4054,7 @@ begin
S:=GetLineText(CurPos.Y);
if (S<>'') and (CurPos.X<>0) then
begin
SetLineText(CurPos.Y,copy(S,LinePosToCharIdx(CurPos.Y,CurPos.X),255));
SetLineText(CurPos.Y,copy(S,LinePosToCharIdx(CurPos.Y,CurPos.X),High(S)));
SetCurPtr(0,CurPos.Y);
UpdateAttrs(CurPos.Y,attrAll);
DrawLines(CurPos.Y);
@ -4073,13 +4083,13 @@ end;
procedure TCustomCodeEditor.DelLine;
var
HoldUndo : boolean;
SP : TPoint;
{ SP : TPoint;}
begin
if IsReadOnly then Exit;
Lock;
if GetLineCount>0 then
begin
SP:=CurPos;
{ SP:=CurPos;}
DeleteLine(CurPos.Y);
HoldUndo:=GetStoreUndo;
SetStoreUndo(false);
@ -4194,7 +4204,7 @@ begin
StartX:=SelStart.X;
EndX:=SelEnd.X;
SetDisplayText(CurLine,RExpand(copy(S,1,StartX),StartX)
+copy(S,EndX+1,255));
+copy(S,EndX+1,High(S)));
if GetStoreUndo then
begin
SPos.X:=StartX;
@ -4211,12 +4221,12 @@ begin
StartX:=SelStart.X;
EndX:=SelEnd.X;
SetDisplayText(CurLine,RExpand(copy(S,1,StartX),StartX)
+copy(GetDisplayText(CurLine+LineCount-1),EndX+1,255));
+copy(GetDisplayText(CurLine+LineCount-1),EndX+1,High(S)));
if GetStoreUndo then
begin
SPos.X:=StartX;
SPos.Y:=CurLine;
AddAction(eaDeleteText,SPos,SPos,Copy(S,StartX+1,255));
AddAction(eaDeleteText,SPos,SPos,Copy(S,StartX+1,High(S)));
S:=GetDisplayText(CurLine+LineCount-1);
end;
Inc(CurLine);
@ -4230,7 +4240,7 @@ begin
end;
if GetStoreUndo then
begin
AddAction(eaInsertText,SPos,SPos,Copy(S,EndX+1,255));
AddAction(eaInsertText,SPos,SPos,Copy(S,EndX+1,High(S)));
end;
end;
HideSelect;
@ -4552,15 +4562,15 @@ begin
TabStart:=CharIdxToLinePos(CurPos.Y,CI-1)+1;
if SC=Tab then TabS:=Tab else
TabS:=CharStr(' ',CurPos.X-TabStart);
SetLineText(CurPos.Y,copy(S,1,CI-1)+TabS+SC+copy(S,CI+1,255));
SetLineText(CurPos.Y,copy(S,1,CI-1)+TabS+SC+copy(S,CI+1,High(S)));
SetCurPtr(CharIdxToLinePos(CurPos.Y,CI+length(TabS)+length(SC)),CurPos.Y);
end
else
begin
if Overwrite and (CI<=length(S)) then
SetLineText(CurPos.Y,copy(S,1,CI-1)+SC+copy(S,CI+length(SC),255))
SetLineText(CurPos.Y,copy(S,1,CI-1)+SC+copy(S,CI+length(SC),High(S)))
else
SetLineText(CurPos.Y,copy(S,1,CI-1)+SC+copy(S,CI,255));
SetLineText(CurPos.Y,copy(S,1,CI-1)+SC+copy(S,CI,High(S)));
SetCurPtr(CharIdxToLinePos(CurPos.Y,CI+length(SC)),CurPos.Y);
end;
{$ifdef Undo}
@ -4691,7 +4701,7 @@ begin
s:=GetLineText(i);
str_begin:=LinePosToCharIdx(i,SelStart.X);
if SelEnd.Y>SelStart.Y then
str_end:=255
str_end:=High(S)
else
str_end:=LinePosToCharIdx(i,SelEnd.X)-1;
s:=copy(s,str_begin,str_end-str_begin+1);
@ -5136,15 +5146,15 @@ begin
end;
procedure TCustomCodeEditor.SetCurPtr(X,Y: sw_integer);
var OldPos,{OldSEnd,}OldSStart: TPoint;
var OldPos{,OldSEnd,OldSStart}: TPoint;
Extended: boolean;
begin
Lock;
X:=Max(0,Min(MaxLineLength+1,X));
Y:=Max(0,Min(GetLineCount-1,Y));
OldPos:=CurPos;
{ OldSEnd:=SelEnd;}
OldSStart:=SelStart;
{ OldSEnd:=SelEnd;
OldSStart:=SelStart;}
CurPos.X:=X;
CurPos.Y:=Y;
TrackCursor(false);
@ -5463,7 +5473,7 @@ begin
S:=CompressUsingTabs(S,TabSize);
}
if Line=EndP.Y then S:=copy(S,1,LinePosToCharIdx(Line,EndP.X));
if Line=StartP.Y then S:=copy(S,LinePosToCharIdx(Line,StartP.X),255);
if Line=StartP.Y then S:=copy(S,LinePosToCharIdx(Line,StartP.X),High(S));
Stream^.Write(S[1],length(S));
if Line<EndP.Y then
Stream^.Write(EOL[1],length(EOL));
@ -5848,7 +5858,10 @@ end;
END.
{
$Log$
Revision 1.94 2000-06-16 21:17:39 pierre
Revision 1.95 2000-06-22 09:07:13 pierre
* Gabor changes: see fixes.txt
Revision 1.94 2000/06/16 21:17:39 pierre
+ TCustoCodeEditorCore.GetChangedLine
Revision 1.93 2000/06/16 08:50:43 pierre

138
ide/text/whelp.pas
View File

@ -37,13 +37,13 @@ const
ncRawChar = $F;
ncRepChar = $E;
rtFileHeader = Byte ($0);
rtContext = Byte ($1);
rtText = Byte ($2);
rtKeyWord = Byte ($3);
rtIndex = Byte ($4);
rtCompression = Byte ($5);
rtIndexTags = Byte ($6);
oa_rtFileHeader = Byte ($0);
oa_rtContext = Byte ($1);
oa_rtText = Byte ($2);
oa_rtKeyWord = Byte ($3);
oa_rtIndex = Byte ($4);
oa_rtCompression = Byte ($5);
oa_rtIndexTags = Byte ($6);
ctNone = $00;
ctNibble = $02;
@ -137,7 +137,7 @@ type
end;
TRecord = packed record
SClass : byte;
SClass : word;
Size : word;
Data : pointer;
end;
@ -197,6 +197,8 @@ type
IndexEntries : PIndexEntryCollection;
constructor Init(AID: word);
function LoadTopic(HelpCtx: THelpCtx): PTopic; virtual;
procedure AddTopic(HelpCtx: THelpCtx; Pos: longint; const Param: string);
procedure AddIndexEntry(const Text: string; AHelpCtx: THelpCtx);
destructor Done; virtual;
public
function LoadIndex: boolean; virtual;
@ -241,6 +243,7 @@ type
constructor Init;
function AddOAHelpFile(const FileName: string): boolean;
function AddHTMLHelpFile(const FileName, TOCEntry: string): boolean;
function AddNGHelpFile(const FileName: string): boolean;
function AddHTMLIndexHelpFile(const FileName: string): boolean;
function LoadTopic(SourceFileID: word; Context: THelpCtx): PTopic; virtual;
function TopicSearch(Keyword: string; var FileID: word; var Context: THelpCtx): boolean; virtual;
@ -262,17 +265,21 @@ const TopicCacheSize : sw_integer = 10;
function NewTopic(FileID: byte; HelpCtx: THelpCtx; Pos: longint; Param: string): PTopic;
procedure DisposeTopic(P: PTopic);
procedure RenderTopic(Lines: PUnsortedStringCollection; T: PTopic);
procedure AddLinkToTopic(T: PTopic; AFileID: word; ACtx: THelpCtx);
function NewIndexEntry(Tag: string; FileID: word; HelpCtx: THelpCtx): PIndexEntry;
procedure DisposeIndexEntry(P: PIndexEntry);
procedure DisposeRecord(var R: TRecord);
implementation
uses
Dos,
{$ifdef Linux}
linux,
{$endif Linux}
WConsts,WViews,WHTMLHlp;
WConsts,WHTMLHlp,WNGHelp;
Function GetDosTicks:longint; { returns ticks at 18.2 Hz, just like DOS }
@ -356,6 +363,51 @@ begin
CloneTopic:=NT;
end;
procedure RenderTopic(Lines: PUnsortedStringCollection; T: PTopic);
var Size,CurPtr,I: sw_word;
S: string;
begin
CurPtr:=0;
for I:=0 to Lines^.Count-1 do
begin
S:=GetStr(Lines^.At(I));
Size:=length(S)+1;
Inc(CurPtr,Size);
end;
Size:=CurPtr;
T^.TextSize:=Size; GetMem(T^.Text,T^.TextSize);
CurPtr:=0;
for I:=0 to Lines^.Count-1 do
begin
S:=GetStr(Lines^.At(I)); Size:=length(S);
Move(S[1],PByteArray(T^.Text)^[CurPtr],Size);
Inc(CurPtr,Size);
PByteArray(T^.Text)^[CurPtr]:=ord(hscLineBreak);
Inc(CurPtr);
if CurPtr>=T^.TextSize then Break;
end;
end;
procedure AddLinkToTopic(T: PTopic; AFileID: word; ACtx: THelpCtx);
var NewSize: word;
NewPtr: pointer;
begin
NewSize:=(T^.LinkCount+1)*sizeof(T^.Links^[0]);
GetMem(NewPtr,NewSize);
if Assigned(T^.Links) then
begin
Move(T^.Links^,NewPtr^,T^.LinkSize);
FreeMem(T^.Links,T^.LinkSize);
end;
T^.Links:=NewPtr;
with T^.Links^[T^.LinkCount] do
begin
FileID:=AFileID;
Context:=ACtx;
end;
Inc(T^.LinkCount);
end;
function NewIndexEntry(Tag: string; FileID: word; HelpCtx: THelpCtx): PIndexEntry;
var P: PIndexEntry;
begin
@ -457,6 +509,16 @@ begin
New(IndexEntries, Init(200,100));
end;
procedure THelpFile.AddTopic(HelpCtx: THelpCtx; Pos: longint; const Param: string);
begin
Topics^.Insert(NewTopic(ID,HelpCtx,Pos,Param));
end;
procedure THelpFile.AddIndexEntry(const Text: string; AHelpCtx: THelpCtx);
begin
IndexEntries^.Insert(NewIndexEntry(Text,ID,AHelpCtx));
end;
function THelpFile.LoadTopic(HelpCtx: THelpCtx): PTopic;
var T: PTopic;
begin
@ -526,7 +588,7 @@ var OK: boolean;
FS,L: longint;
R: TRecord;
begin
inherited Init(AID);
if inherited Init(AID)=false then Fail;
F:=New(PBufStream, Init(AFileName, stOpenRead, HelpStreamBufSize));
OK:=F<>nil;
if OK then OK:=(F^.Status=stOK);
@ -542,12 +604,12 @@ begin
OK:=ReadRecord(R,false);
if (OK=false) or (R.SClass=0) or (R.Size=0) then Break;
case R.SClass of
rtContext : begin F^.Seek(L); OK:=ReadTopics; end;
rtText : {Skip};
rtKeyword : {Skip};
rtIndex : begin IndexTablePos:=L; {OK:=ReadIndexTable; }end;
rtCompression : begin F^.Seek(L); OK:=ReadCompression; end;
rtIndexTags : begin IndexTagsPos:=L; {OK:=ReadIndexTags; }end;
oa_rtContext : begin F^.Seek(L); OK:=ReadTopics; end;
oa_rtText : {Skip};
oa_rtKeyword : {Skip};
oa_rtIndex : begin IndexTablePos:=L; {OK:=ReadIndexTable; }end;
oa_rtCompression : begin F^.Seek(L); OK:=ReadCompression; end;
oa_rtIndexTags : begin IndexTagsPos:=L; {OK:=ReadIndexTags; }end;
else
begin
{$ifdef DEBUGMSG}
@ -592,7 +654,7 @@ begin
if OK then
begin
OK:=ReadRecord(R,true);
OK:=OK and (R.SClass=rtFileHeader) and (R.Size=SizeOf(Header));
OK:=OK and (R.SClass=oa_rtFileHeader) and (R.Size=SizeOf(Header));
if OK then Move(R.Data^,Header,SizeOf(Header));
DisposeRecord(R);
end;
@ -620,7 +682,7 @@ begin
if (L=-1) and (Header.MainIndexScreen>0) then
L:=GetCtxPos(Contexts[Header.MainIndexScreen]);
if (L>0) then
Topics^.Insert(NewTopic(ID,I,L,''));
AddTopic(I,L,'');
end;
DisposeRecord(R);
TopicsRead:=OK;
@ -652,7 +714,7 @@ begin
S[0]:=chr(AddLen); Move(PByteArray(@Entries)^[CurPtr+1],S[1],AddLen);
LastTag:=copy(LastTag,1,CopyCnt)+S;
HelpCtx:=PWord(@PByteArray(@Entries)^[CurPtr+1+AddLen])^;
IndexEntries^.Insert(NewIndexEntry(LastTag,ID,HelpCtx));
AddIndexEntry(LastTag,HelpCtx);
Inc(CurPtr,1+AddLen+2);
end;
DisposeRecord(R);
@ -855,9 +917,9 @@ begin
FillChar(TextR,SizeOf(TextR),0); FillChar(KeyWR,SizeOf(KeyWR),0);
F^.Seek(T^.FileOfs); OK:=F^.Status=stOK;
if OK then OK:=ReadRecord(TextR,true);
OK:=OK and (TextR.SClass=rtText);
OK:=OK and (TextR.SClass=oa_rtText);
if OK then OK:=ReadRecord(KeyWR,true);
OK:=OK and (KeyWR.SClass=rtKeyword);
OK:=OK and (KeyWR.SClass=oa_rtKeyword);
if OK then
begin
@ -937,6 +999,13 @@ begin
AddHTMLHelpFile:=AddFile(H);;
end;
function THelpFacility.AddNGHelpFile(const FileName: string): boolean;
var H: PHelpFile;
begin
H:=New(PNGHelpFile, Init(FileName, LastID+1));
AddNGHelpFile:=AddFile(H);;
end;
function THelpFacility.AddHTMLIndexHelpFile(const FileName: string): boolean;
var H: PHelpFile;
begin
@ -1026,24 +1095,6 @@ begin
if S='' then S:=' ';
Lines^.Insert(NewStr(S));
end;
procedure RenderTopic;
var Size,CurPtr,I: sw_word;
S: string;
function CountSize(P: PString): boolean; {$ifndef FPC}far;{$endif}
begin Inc(Size, length(P^)+1); CountSize:=Size>MaxHelpTopicSize-300; end;
begin
Size:=0; Lines^.FirstThat(@CountSize);
T^.TextSize:=Size; GetMem(T^.Text,T^.TextSize);
CurPtr:=0;
for I:=0 to Lines^.Count-1 do
begin
S:=Lines^.At(I)^;
Size:=length(S)+1; S[Size]:=hscLineBreak;
Move(S[1],PByteArray(T^.Text)^[CurPtr],Size);
Inc(CurPtr,Size);
if CurPtr>=T^.TextSize then Break;
end;
end;
var Line: string;
procedure FlushLine;
begin
@ -1102,7 +1153,7 @@ begin
FlushLine;
AddLine('');
end;
RenderTopic;
RenderTopic(Lines,T);
Dispose(Lines, Done);
Keywords^.DeleteAll; Dispose(Keywords, Done);
BuildIndexTopic:=T;
@ -1134,7 +1185,10 @@ end;
END.
{
$Log$
Revision 1.23 2000-06-16 08:50:44 pierre
Revision 1.24 2000-06-22 09:07:14 pierre
* Gabor changes: see fixes.txt
Revision 1.23 2000/06/16 08:50:44 pierre
+ new bunch of Gabor's changes
Revision 1.22 2000/05/31 20:42:02 pierre

13
ide/text/whlpview.pas
View File

@ -213,7 +213,7 @@ implementation
uses
Video,
WConsts,WViews;
WConsts;
const CommentColor = Blue;
@ -794,7 +794,7 @@ begin
while (Y<=R.B.Y) do
begin
if Y=R.A.Y then StartX:=R.A.X else StartX:=Margin;
if Y=R.B.Y then EndX:=R.B.X else EndX:=255;
if Y=R.B.Y then EndX:=R.B.X else EndX:=High(S);
S:=S+copy(GetLineText(Y),StartX+1,EndX-StartX+1);
Inc(Y);
end;
@ -1138,7 +1138,7 @@ begin
MoveChar(B,' ',NormalColor,Size.X);
if Y<GetLineCount then
begin
S:=copy(GetLineText(Y),Delta.X+1,255);
S:=copy(GetLineText(Y),Delta.X+1,High(S));
S:=copy(S,1,MaxViewWidth);
MoveStr(B,S,NormalColor);
@ -1196,7 +1196,7 @@ begin
if ((SelR.A.X<>SelR.B.X) or (SelR.A.Y<>SelR.B.Y)) and (SelR.A.Y<=Y) and (Y<=SelR.B.Y) then
begin
if Y=SelR.A.Y then MinX:=SelR.A.X else MinX:=0;
if Y=SelR.B.Y then MaxX:=SelR.B.X-1 else MaxX:=255;
if Y=SelR.B.Y then MaxX:=SelR.B.X-1 else MaxX:=High(string);
for DX:=MinX to MaxX do
begin
X:=DX;
@ -1318,7 +1318,10 @@ end;
END.
{
$Log$
Revision 1.17 2000-06-16 08:50:45 pierre
Revision 1.18 2000-06-22 09:07:14 pierre
* Gabor changes: see fixes.txt
Revision 1.17 2000/06/16 08:50:45 pierre
+ new bunch of Gabor's changes
Revision 1.16 2000/05/30 07:18:33 pierre

11
ide/text/whtml.pas
View File

@ -146,7 +146,7 @@ begin
end;
constructor TDOSTextFile.Init(AFileName: string);
{$ifdef TPUNIXLF}
(*{$ifdef TPUNIXLF}
procedure readln(var t:text;var s:string);
var
c : char;
@ -167,7 +167,7 @@ constructor TDOSTextFile.Init(AFileName: string);
dec(i);
s[0]:=chr(i);
end;
{$endif}
{$endif}*)
var f: text;
S: string;
begin
@ -180,7 +180,7 @@ begin
New(Lines, Init(500,2000));
while (Eof(f)=false) and (IOResult=0) do
begin
readln(f,S);
readln(f,S); { this is the one in WUTILS.PAS }
AddLine(S);
end;
Close(f);
@ -711,7 +711,10 @@ end;
END.
{
$Log$
Revision 1.6 2000-04-25 08:42:35 pierre
Revision 1.7 2000-06-22 09:07:15 pierre
* Gabor changes: see fixes.txt
Revision 1.6 2000/04/25 08:42:35 pierre
* New Gabor changes : see fixes.txt
Revision 1.5 2000/03/21 23:20:47 pierre

8
ide/text/whtmlhlp.pas
View File

@ -137,8 +137,7 @@ const HTMLGetSectionColor : THTMLGetSectionColorProc = DefHTMLGetSectionColor;
implementation
uses WConsts,WUtils,WViews,WHTMLScn,
Dos;
uses WConsts,WUtils,WViews,WHTMLScn;
function DefHTMLGetSectionColor(Section: THTMLSection; var Color: byte): boolean;
begin
@ -744,7 +743,10 @@ end;
END.
{
$Log$
Revision 1.14 2000-06-16 08:50:45 pierre
Revision 1.15 2000-06-22 09:07:15 pierre
* Gabor changes: see fixes.txt
Revision 1.14 2000/06/16 08:50:45 pierre
+ new bunch of Gabor's changes
}

13
ide/text/whtmlscn.pas
View File

@ -128,13 +128,18 @@ const
);
function TCustomHTMLLinkScanner.DocAddTextChar(C: char): boolean;
var Added: boolean;
begin
Added:=false;
if InAnchor then
begin
CurLinkText:=CurLinkText+C;
Added:=true;
end;
DocAddTextChar:=Added;
end;
procedure TCustomHTMLLinkScanner.DocAnchor(Entered: boolean);
var P: sw_integer;
begin
if Entered then
begin
@ -210,7 +215,6 @@ begin
end;
procedure THTMLLinkScanDocument.Store(var S: TStream);
var I: integer;
begin
S.WriteStr(DocName);
Aliases^.Store(S);
@ -449,7 +453,10 @@ end;
END.
{
$Log$
Revision 1.6 2000-05-29 11:09:14 pierre
Revision 1.7 2000-06-22 09:07:15 pierre
* Gabor changes: see fixes.txt
Revision 1.6 2000/05/29 11:09:14 pierre
+ New bunch of Gabor's changes: see fixes.txt
Revision 1.5 2000/05/17 08:49:16 pierre

7
ide/text/wini.pas
View File

@ -161,7 +161,7 @@ begin
Inc(P2);
end;
Value:=NewStr(Trim(ValueS));
Comment:=NewStr(copy(S,P2+1,255));
Comment:=NewStr(copy(S,P2+1,High(S)));
end else
begin
Tag:=nil;
@ -478,7 +478,10 @@ end;
END.
{
$Log$
Revision 1.9 2000-04-18 11:42:39 pierre
Revision 1.10 2000-06-22 09:07:15 pierre
* Gabor changes: see fixes.txt
Revision 1.9 2000/04/18 11:42:39 pierre
lot of Gabor changes : see fixes.txt
Revision 1.8 1999/03/08 14:58:21 peter

429
ide/text/wnghelp.pas Normal file
View File

@ -0,0 +1,429 @@
{
$Id$
This file is part of the Free Pascal Integrated Development Environment
Copyright (c) 2000 by Berczi Gabor
Help support for Norton Guide (.NG) files
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$R-}
unit WNGHelp;
interface
uses Objects,
WUtils,WHelp;
const
NGFileSignature = 'NG';
NGXORByte = $1a;
NGMinRecordSize = $1a;
ng_rtContainer = Byte ($0);
ng_rtTopic = Byte ($1);
type
TNGFileHeader = packed record
Signature : array[1..2] of char;
Unknown : word;
Version : word;
MenuCount : word;
GuideName : array[8..47] of char;
Credits : array[48..377] of char;
end;
TNGRecordHeader = packed record
RecType : word;
RecLength : word;
end;
TNGContainerItem = packed record
EntryNameOfs : word; { relative in record }
SubItemsOfs : longint; { file offset to a new record header }
end;
PNGContainerRecord = ^TNGContainerRecord;
TNGContainerRecord = packed record
ItemCount : word;
Unknown : word;
IndexInParent : integer;
ParentOfs : longint;
MenuNo : integer;{ belongs to menu # }
MenuItemNo : integer;{ belongs to menu item # }
Unknown2 : array[18..25] of byte;
Items : array[0..0] of TNGContainerItem;
end;
TNGTopicRecord = packed record
NumberOfLines : word;
SeeAlsoOfs : word;
IndexInParent : integer;
ParentOfs : longint;
MenuNo : integer;{ belongs to menu # }
MenuItemNo : integer;{ belongs to menu item # }
PrevTopicOfs : longint;
NextTopicOfs : longint;
TopicLines : record end;
{ array of TNGSeeAlsoRec }
end;
TNGSeeAlsoRec = packed record
EntryCount : word;
Entries : record end;
{ array of LinkedRecOfs : longint; }
{ array of LinkNames : ASCIIZ; }
end;
PContainerItemRec = ^TContainerItemRec;
TContainerItemRec = record
Name : string;
FilePos : longint;
Container: PNGContainerRecord;
end;
PNGHelpFile = ^TNGHelpFile;
TNGHelpFile = object(THelpFile)
constructor Init(AFileName: string; AID: word);
destructor Done; virtual;
public
function LoadIndex: boolean; virtual;
function ReadTopic(T: PTopic): boolean; virtual;
private
F: PStream;
Header: TNGFileHeader;
{ NextHelpCtx: longint;}
function ReadHeader: boolean;
function ReadContainer(EnumProc: pointer): boolean;
function ReadTopicRec(Lines: PUnsortedStringCollection): boolean;
function ReadRecord(var R: TRecord; ReadData: boolean): boolean;
end;
implementation
uses CallSpec;
function NGDecompressStr(const S: string): string;
var NS: string;
I: sw_integer;
begin
NS:='';
I:=1;
while (I<=length(S)) do
begin
if S[I]=#255 then
begin
NS:=NS+CharStr(' ',ord(S[I+1]));
Inc(I);
end
else
NS:=NS+S[I];
Inc(I);
end;
NGDecompressStr:=NS;
end;
function TranslateStr(const S: string): string;
var NS: string;
I: sw_integer;
InHiLite: boolean;
begin
NS:=''; InHiLite:=false;
I:=1;
while (I<=length(S)) do
begin
case S[I] of
'^' : begin
Inc(I);
case S[I] of
'^' : NS:=NS+'^';
'B' : begin
if InHiLite then
NS:=NS+hscNormText
else
NS:=NS+hscTextColor+chr(15);
InHiLite:=not InHiLite;
end;
'b' : begin
if InHiLite then
NS:=NS+hscNormText
else
NS:=NS+hscTextColor+chr(11);
InHiLite:=not InHiLite;
end;
'U' : begin
if InHiLite then
NS:=NS+hscNormText
else
NS:=NS+hscTextColor+chr(3);
InHiLite:=not InHiLite;
end;
else
NS:=NS;
end;
end;
else NS:=NS+S[I];
end;
Inc(I);
end;
if InHiLite then NS:=NS+hscNormText;
TranslateStr:=NS;
end;
procedure TranslateLines(P: PUnsortedStringCollection);
var S: string;
I: sw_integer;
begin
for I:=0 to P^.Count-1 do
begin
S:=GetStr(P^.At(I));
P^.AtFree(I);
P^.AtInsert(I,NewStr(TranslateStr(S)));
end;
end;
constructor TNGHelpFile.Init(AFileName: string; AID: word);
function FormatAlias(Alias: string): string;
var StartP,EndP: sw_integer;
begin
repeat
StartP:=Pos(' ',Alias);
if StartP>0 then
begin
EndP:=StartP;
while (EndP+1<=length(Alias)) and (Alias[EndP+1]=' ') do Inc(EndP);
Alias:=copy(Alias,1,StartP-1)+' | '+copy(Alias,EndP+1,High(Alias));
end;
until StartP=0;
if Assigned(HelpFacility) then
if length(Alias)>HelpFacility^.IndexTabSize-4 then
Alias:=Trim(copy(Alias,1,HelpFacility^.IndexTabSize-4-2))+'..';
FormatAlias:=Alias;
end;
procedure AddToIndex(P: PContainerItemRec); {$ifndef FPC}far;{$endif}
var S: string;
begin
S:=Trim(P^.Name);
S:=TranslateStr(S);
S:=Trim(FormatAlias(S));
if (S<>'') and (P^.FilePos<>-1) then
begin
{ Inc(NextHelpCtx);}
AddIndexEntry(S,P^.FilePos);
AddTopic(P^.FilePos,P^.FilePos,'');
end;
end;
var OK: boolean;
FS: longint;
R: TRecord;
L: longint;
begin
if inherited Init(AID)=false then Fail;
F:=New(PBufStream, Init(AFileName, stOpenRead, HelpStreamBufSize));
OK:=F<>nil;
if OK then OK:=(F^.Status=stOK);
if OK then
begin
FS:=F^.GetSize;
OK:=ReadHeader;
end;
while OK do
begin
L:=F^.GetPos;
if (L>=FS) then Break;
OK:=ReadRecord(R,false);
if (OK=false) then Break;
case R.SClass of
ng_rtContainer : begin F^.Seek(L); OK:=ReadContainer(@AddToIndex); end;
{ ng_rtTopic : begin F^.Seek(L); OK:=ReadTopicRec; end;}
else
begin
{$ifdef DEBUGMSG}
ClearFormatParams;
AddFormatParamInt(R.SClass);
AddFormatParamInt(L);
AddFormatParamInt(R.Size);
ErrorBox('Uknown help record tag %x encountered, '+
'offset %x, size %d',@FormatParams);
{$else}
{Skip};
{$endif}
end;
end;
if OK then
begin
Inc(L, sizeof(TNGRecordHeader)+R.Size); F^.Seek(L);
OK:=(F^.Status=stOK);
end;
end;
if OK=false then
begin
Done;
Fail;
end;
end;
function TNGHelpFile.ReadHeader: boolean;
var OK: boolean;
begin
F^.Read(Header,sizeof(Header));
OK:=(F^.Status=stOK);
OK:=OK and (Header.Signature=NGFileSignature);
ReadHeader:=OK;
end;
function KillSpecChars(const S: string): string;
var I: sw_integer;
RS: string;
begin
RS:='';
for I:=1 to length(S) do
if S[I]>=#32 then
RS:=RS+S[I];
KillSpecChars:=RS;
end;
function TNGHelpFile.ReadContainer(EnumProc: pointer): boolean;
var OK: boolean;
R: TRecord;
I,L: longint;
CI: TNGContainerItem;
P: pointer;
CIR: TContainerItemRec;
begin
OK:=ReadRecord(R, true);
if OK then
with TNGContainerRecord(R.Data^) do
begin
I:=0;
while (I<ItemCount) do
with Items[I] do
begin
P:=@(PByteArray(R.Data)^[NGMinRecordSize-sizeof(TNGRecordHeader)+EntryNameOfs]);
FillChar(CIR,sizeof(CIR),0);
with CIR do
begin
Container:=R.Data;
Name:=NGDecompressStr(StrPas(P));
FilePos:=SubItemsOfs;
end;
CallPointerLocal(EnumProc,PreviousFramePointer,@CIR);
Inc(I);
end;
end;
DisposeRecord(R);
ReadContainer:=OK;
end;
function TNGHelpFile.ReadTopicRec(Lines: PUnsortedStringCollection): boolean;
var OK: boolean;
R: TRecord;
I: sw_integer;
LineP: pointer;
S: string;
begin
OK:=ReadRecord(R, true);
if OK then
with TNGTopicRecord(R.Data^) do
begin
LineP:=@TopicLines;
for I:=1 to NumberOfLines do
begin
S:=StrPas(LineP);
Lines^.InsertStr(NGDecompressStr(S));
LineP:=pointer(longint(LineP)+length(S)+1);
end;
end;
DisposeRecord(R);
ReadTopicRec:=OK;
end;
function TNGHelpFile.ReadRecord(var R: TRecord; ReadData: boolean): boolean;
var OK: boolean;
H: TNGRecordHeader;
I: sw_integer;
begin
FillChar(R, SizeOf(R), 0);
F^.Read(H,SizeOf(H));
OK:=F^.Status=stOK;
if OK then
for I:=0 to SizeOf(H)-1 do
PByteArray(@H)^[I]:=PByteArray(@H)^[I] xor NGXORByte;
if OK then
begin
R.SClass:=H.RecType; R.Size:=H.RecLength+(NGMinRecordSize-sizeof(TNGRecordHeader));
if (R.Size>0) and ReadData then
begin
GetMem(R.Data,R.Size);
F^.Read(R.Data^,R.Size);
if R.Size>0 then
for I:=0 to R.Size-1 do
PByteArray(R.Data)^[I]:=PByteArray(R.Data)^[I] xor NGXORByte;
OK:=F^.Status=stOK;
end;
if OK=false then DisposeRecord(R);
end;
ReadRecord:=OK;
end;
function TNGHelpFile.LoadIndex: boolean;
begin
LoadIndex:=false;
end;
function TNGHelpFile.ReadTopic(T: PTopic): boolean;
var Lines: PUnsortedStringCollection;
procedure AddToTopic(P: PContainerItemRec); {$ifndef FPC}far;{$endif}
begin
Lines^.InsertStr(hscLink+P^.Name+hscLink);
AddLinkToTopic(T,ID,P^.FilePos);
end;
var OK: boolean;
R: TRecord;
begin
New(Lines, Init(100,100));
F^.Seek(T^.FileOfs); OK:=F^.Status=stOK;
if OK then OK:=ReadRecord(R,false);
case R.SClass of
ng_rtContainer :
begin
F^.Seek(T^.FileOfs);
Lines^.InsertStr(' ');
OK:=ReadContainer(@AddToTopic);
RenderTopic(Lines,T);
end;
ng_rtTopic :
begin
F^.Seek(T^.FileOfs);
Lines^.InsertStr(' ');
OK:=ReadTopicRec(Lines);
TranslateLines(Lines);
Lines^.InsertStr(' ');
RenderTopic(Lines,T);
end;
else OK:=false;
end;
Dispose(Lines, Done);
ReadTopic:=OK;
end;
destructor TNGHelpFile.Done;
begin
if Assigned(F) then Dispose(F, Done); F:=nil;
inherited Done;
end;
END.
{
$Log$
Revision 1.1 2000-06-22 09:07:15 pierre
* Gabor changes: see fixes.txt
}

57
ide/text/wutils.pas
View File

@ -127,6 +127,12 @@ 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);
procedure GiveUpTimeSlice;
const LastStrToIntResult : integer = 0;
@ -164,7 +170,7 @@ const
begin
c:=#0;
i:=0;
while (not eof(t)) and (c<>#10) do
while (not eof(t)) and (c<>#10) and (i<High(S)) do
begin
read(t,c);
if c<>#10 then
@ -198,7 +204,9 @@ procedure ReadlnFromStream(Stream: PStream; var S:string;var linecomplete : bool
i:=0;
{ this created problems for lines longer than 255 characters
now those lines are cutted into pieces without warning PM }
while (not eofstream(stream)) and (c<>#10) and (i<255) do
{ changed implicit 255 to High(S), so it will be automatically extended
when longstrings eventually become default - Gabor }
while (not eofstream(stream)) and (c<>#10) and (i<High(S)) do
begin
stream^.read(c,sizeof(c));
if c<>#10 then
@ -214,7 +222,7 @@ procedure ReadlnFromStream(Stream: PStream; var S:string;var linecomplete : bool
end;
if (c=#13) and (not eofstream(stream)) then
stream^.read(c,sizeof(c));
if (i=255) and not eofstream(stream) then
if (i=High(S)) and not eofstream(stream) then
begin
pos:=stream^.getpos;
stream^.read(c,sizeof(c));
@ -228,6 +236,36 @@ procedure ReadlnFromStream(Stream: PStream; var S:string;var linecomplete : bool
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>255 then I:=255;
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
S[0]:=chr(Count);
if Count>0 then Move(B,S[1],Count);
MemToStr:=S;
end;
procedure StrToMem(S: string; var B);
begin
if length(S)>0 then Move(S[1],B,length(S));
end;
function Max(A,B: longint): longint;
begin
@ -289,7 +327,7 @@ begin
i:=1;
while (i<length(s)) and (s[i]=' ') do
inc(i);
LTrim:=Copy(s,i,255);
LTrim:=Copy(s,i,High(S));
end;
function RTrim(const S: string): string;
@ -482,7 +520,7 @@ begin
{$ifdef win32}
hs:=n+#0;
i:=Windows.GetFullPathName(@hs[1],256,hs2,j);
if (i>0) and (i<=255) then
if (i>0) and (i<=high(hs)) then
begin
hs:=strpas(hs2);
GetLongName:=hs;
@ -662,7 +700,7 @@ end;
function TTextCollection.LookUp(const S: string; var Idx: sw_integer): string;
var OLI,ORI,Left,Right,Mid: integer;
LeftP,RightP,MidP: PString;
{LeftP,RightP,}MidP: PString;
{LeftS,}MidS{,RightS}: string;
FoundS: string;
UpS : string;
@ -676,7 +714,7 @@ begin
begin
OLI:=Left; ORI:=Right;
Mid:=Left+(Right-Left) div 2;
LeftP:=At(Left); RightP:=At(Right); MidP:=At(Mid);
{ LeftP:=At(Left); RightP:=At(Right); }MidP:=At(Mid);
{ LeftS:=UpCaseStr(LeftP^); }MidS:=UpCaseStr(MidP^);
{ RightS:=UpCaseStr(RightP^);}
if copy(MidS,1,length(UpS))=UpS then
@ -934,7 +972,10 @@ end;
END.
{
$Log$
Revision 1.24 2000-06-16 21:16:41 pierre
Revision 1.25 2000-06-22 09:07:15 pierre
* Gabor changes: see fixes.txt
Revision 1.24 2000/06/16 21:16:41 pierre
* allow to read until 255 chars per line
Revision 1.23 2000/06/16 08:50:45 pierre

13
ide/text/wviews.pas
View File

@ -557,10 +557,10 @@ procedure TrackMouse;
var
Mouse: TPoint;
R: TRect;
OldC: PMenuItem;
{ OldC: PMenuItem;}
begin
MakeLocal(E.Where, Mouse);
OldC:=Current;
{ OldC:=Current;}
Current := Menu^.Items;
while Current <> nil do
begin
@ -1272,7 +1272,7 @@ begin
P:=Pos(#13,S);
if P=0 then P:=length(S)+1;
CurS:=copy(S,1,P-1);
CurS:=copy(CurS,Delta.X+1,255);
CurS:=copy(CurS,Delta.X+1,High(CurS));
CurS:=copy(CurS,1,MaxViewWidth);
Delete(S,1,P);
end;
@ -1889,7 +1889,7 @@ begin
if (ListBox<>nil) and (Event.InfoPtr=ListBox) then
begin
FocusItem(ListBox^.Focused);
Text:=GetText(List^.At(Focused),255);
Text:=GetText(List^.At(Focused),High(Text));
DrawView;
DropList(false);
end;
@ -2189,7 +2189,10 @@ end;
END.
{
$Log$
Revision 1.14 2000-06-16 08:50:45 pierre
Revision 1.15 2000-06-22 09:07:15 pierre
* Gabor changes: see fixes.txt
Revision 1.14 2000/06/16 08:50:45 pierre
+ new bunch of Gabor's changes
Revision 1.13 2000/05/02 08:42:29 pierre