paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-23 07:50:06 +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 Gabors's log to 16/6/2000 commits
========================= Already fixed ================================ ========================= Already fixed ================================

7
ide/text/fpcatch.pas
View File

@ -43,7 +43,7 @@ uses
drivers, drivers,
{$endif FPC} {$endif FPC}
app,commands,msgbox, app,commands,msgbox,
FPString,FPViews,FPIDE; FPString,FPIDE;
{$ifdef HasSignal} {$ifdef HasSignal}
@ -112,7 +112,10 @@ end.
{ {
$Log$ $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 * new set of Gabor changes: see fixes.txt
Revision 1.4 2000/03/07 21:09:20 pierre 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; var R: word;
C: PCodeCompleteWordList; C: PCodeCompleteWordList;
I: integer; I: integer;
S1,S2,S3: string;
W: word;
begin begin
New(C, Init(10,20)); New(C, Init(10,20));
if Assigned(CodeCompleteWords) then if Assigned(CodeCompleteWords) then

9
ide/text/fpcodtmp.pas
View File

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

8
ide/text/fpcompil.pas
View File

@ -93,7 +93,7 @@ uses
{$endif} {$endif}
Dos,Video, Dos,Video,
App,Commands,tokens, App,Commands,tokens,
CompHook, Compiler, systems, browcol, switches, CompHook, Compiler, systems, browcol,
WEditor, WEditor,
FPString,FPRedir,FPDesk,FPUsrScr,FPHelp, FPString,FPRedir,FPDesk,FPUsrScr,FPHelp,
FPConst,FPVars,FPUtils,FPIntf,FPSwitch; FPConst,FPVars,FPUtils,FPIntf,FPSwitch;
@ -641,7 +641,6 @@ var
Error,LinkErrorCount : longint; Error,LinkErrorCount : longint;
E : TEvent; E : TEvent;
DummyView: PView; DummyView: PView;
R: TRect;
const const
PpasFile = 'ppas'; PpasFile = 'ppas';
@ -912,7 +911,10 @@ end;
end. end.
{ {
$Log$ $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 + new bunch of Gabor's changes
Revision 1.58 2000/05/29 10:44:56 pierre Revision 1.58 2000/05/29 10:44:56 pierre

8
ide/text/fpconst.pas
View File

@ -49,8 +49,9 @@ const
HTMLIndexExt = '.htx'; HTMLIndexExt = '.htx';
HTMLExt = '.htm'; HTMLExt = '.htm';
HelpFileExts = '*.tph;*.htm*;*'+HTMLIndexExt;
TemplateExt = '.pt'; TemplateExt = '.pt';
NGExt = '.ng';
HelpFileExts = '*.tph;*.htm*;*'+HTMLIndexExt+';*'+NGExt;
EnterSign = #17#196#217; EnterSign = #17#196#217;
@ -405,7 +406,10 @@ implementation
END. END.
{ {
$Log$ $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 + new bunch of Gabor's changes
Revision 1.39 2000/05/30 07:18:33 pierre Revision 1.39 2000/05/30 07:18:33 pierre

8
ide/text/fpdebug.pas
View File

@ -342,7 +342,7 @@ procedure UpdateDebugViews;
implementation implementation
uses uses
Dos,Mouse,Video, Dos,Video,
App,Commands,Strings, App,Commands,Strings,
{$ifdef win32} {$ifdef win32}
Windebug, Windebug,
@ -1650,7 +1650,6 @@ var R,R2: TRect;
S: String; S: String;
X,X1 : Sw_integer; X,X1 : Sw_integer;
Btn: PButton; Btn: PButton;
const White = 15;
begin begin
Desktop^.GetExtent(R); R.A.Y:=R.B.Y-18; Desktop^.GetExtent(R); R.A.Y:=R.B.Y-18;
inherited Init(R, dialog_breakpointlist, wnNoNumber); inherited Init(R, dialog_breakpointlist, wnNoNumber);
@ -3347,7 +3346,10 @@ end.
{ {
$Log$ $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 * give watches window also a number
* leave watches window in the bottom when cascading windows * 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, Objects,Drivers,Video,
Views,App,HistList,BrowCol, Views,App,HistList,BrowCol,
WResourc,WViews,WEditor, WResourc,WViews,WEditor,
WUtils,
{$ifndef NODEBUG} {$ifndef NODEBUG}
fpdebug, fpdebug,
{$endif ndef NODEBUG} {$endif ndef NODEBUG}
FPConst,FPVars,FPString,FPUtils,FPViews,FPCompile,FPTools,FPHelp, FPConst,FPVars,FPString,FPUtils,FPViews,FPHelp,
FPCodCmp,FPCodTmp; FPCodCmp,FPCodTmp;
type type
PWindowInfo = ^TWindowInfo;
TWindowInfo = packed record TWindowInfo = packed record
HelpCtx : word; HelpCtx : word;
Bounds : TRect; Bounds : TRect;
@ -797,7 +795,10 @@ end;
END. END.
{ {
$Log$ $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 * new set of Gabor changes: see fixes.txt
Revision 1.27 2000/04/25 08:42:33 pierre 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} {$IFDEF DEBUG}SetStatus(msg_LoadingHelpFile);{$ENDIF}
end; 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); procedure AddHTMLIndexFile(HelpFile: string);
begin begin
{$IFDEF DEBUG}SetStatus(msg_LoadingHelpFile+' ('+SmartPath(HelpFile)+')');{$ENDIF} {$IFDEF DEBUG}SetStatus(msg_LoadingHelpFile+' ('+SmartPath(HelpFile)+')');{$ENDIF}
@ -301,12 +309,14 @@ begin
S:=HelpFiles^.At(I)^; TopicTitle:=''; S:=HelpFiles^.At(I)^; TopicTitle:='';
P:=Pos('|',S); P:=Pos('|',S);
if P>0 then 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 TopicTitle='' then TopicTitle:=S;
if copy(UpcaseStr(ExtOf(S)),1,length(HTMLExt))=UpcaseStr(HTMLExt) then { this recognizes both .htm and .html } if copy(UpcaseStr(ExtOf(S)),1,length(HTMLExt))=UpcaseStr(HTMLExt) then { this recognizes both .htm and .html }
AddHTMLFile(TopicTitle,S) else AddHTMLFile(TopicTitle,S) else
if UpcaseStr(ExtOf(S))=UpcaseStr(HTMLIndexExt) then if UpcaseStr(ExtOf(S))=UpcaseStr(HTMLIndexExt) then
AddHTMLIndexFile(S) else AddHTMLIndexFile(S) else
if UpcaseStr(ExtOf(S))=UpcaseStr(NGExt) then
AddNGFile(S) else
AddOAFile(S); AddOAFile(S);
end; end;
PopStatus; PopStatus;
@ -480,7 +490,10 @@ end;
END. END.
{ {
$Log$ $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 + new bunch of Gabor's changes
Revision 1.32 2000/05/30 07:18:33 pierre Revision 1.32 2000/05/30 07:18:33 pierre

8
ide/text/fpide.pas
View File

@ -154,9 +154,8 @@ uses
{$endif WinClipSupported} {$endif WinClipSupported}
Video,Mouse,Keyboard, Video,Mouse,Keyboard,
Dos,Memory,Menus,Dialogs,StdDlg,ColorSel,Commands,HelpCtx, Dos,Memory,Menus,Dialogs,StdDlg,ColorSel,Commands,HelpCtx,
AsciiTab,
Systems, Systems,
WUtils,WHelp,WHlpView,WINI,WViews, WUtils,WHlpView,WViews,
FPConst,FPVars,FPUtils,FPSwitch,FPIni,FPIntf,FPCompile,FPHelp, FPConst,FPVars,FPUtils,FPSwitch,FPIni,FPIntf,FPCompile,FPHelp,
FPTemplt,FPCalc,FPUsrScr,FPTools,{$ifndef NODEBUG}FPDebug,{$endif}FPRedir, FPTemplt,FPCalc,FPUsrScr,FPTools,{$ifndef NODEBUG}FPDebug,{$endif}FPRedir,
FPDesk,FPCodCmp,FPCodTmp; FPDesk,FPCodCmp,FPCodTmp;
@ -1061,7 +1060,10 @@ end;
END. END.
{ {
$Log$ $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 * Use Open instead of OpenSearch if OpenFileName is empty
Revision 1.63 2000/06/16 08:50:40 pierre 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 implementation
uses uses
Dos,Objects,Drivers,App, Dos,Objects,Drivers,
WINI,{$ifndef EDITORS}WEditor,WCEdit{$else}Editors{$endif}, WINI,{$ifndef EDITORS}WEditor,WCEdit{$else}Editors{$endif},
{$ifndef NODEBUG}FPDebug,{$endif}FPConst,FPVars,FPViews, {$ifndef NODEBUG}FPDebug,{$endif}FPConst,FPVars,
FPIntf,FPTools,FPSwitch; FPIntf,FPTools,FPSwitch;
const const
@ -84,7 +84,7 @@ const
ieWatchCount = 'Count'; ieWatchCount = 'Count';
ieWatchName = 'Watch'; ieWatchName = 'Watch';
ieSourceList = 'SourceList'; ieSourceList = 'SourceList';
ieVideoMode = 'VideoMode'; { ieVideoMode = 'VideoMode';}
ieAutoSave = 'AutoSaveFlags'; ieAutoSave = 'AutoSaveFlags';
ieMiscOptions = 'MiscOptions'; ieMiscOptions = 'MiscOptions';
ieDesktopLocation = 'DesktopLocation'; ieDesktopLocation = 'DesktopLocation';
@ -125,11 +125,11 @@ begin
begin begin
Inc(I); Hex:=false; Inc(I); Hex:=false;
if S[I]='$' then begin Inc(I); Hex:=true; end; 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 if Hex=false then
begin begin
X:=StrToInt(copy(S,I,P-I)); 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 end
else else
begin begin
@ -528,7 +528,10 @@ end;
end. end.
{ {
$Log$ $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 + new bunch of Gabor's changes
Revision 1.28 2000/03/21 23:30:22 pierre 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 implementation
uses uses
Compiler,CompHook, Compiler,
{$ifndef NODEBUG} {$ifndef NODEBUG}
FPDebug, FPDebug,
{$endif NODEBUG} {$endif NODEBUG}
FPCompile,FPRedir,FPVars, FPRedir,FPVars,
FPUtils,FPSwitch; FPUtils,FPSwitch;
{**************************************************************************** {****************************************************************************
@ -212,7 +212,10 @@ end;
end. end.
{ {
$Log$ $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 + New bunch of Gabor's changes: see fixes.txt
Revision 1.10 2000/05/02 08:42:27 pierre Revision 1.10 2000/05/02 08:42:27 pierre

7
ide/text/fpswitch.pas
View File

@ -172,7 +172,7 @@ implementation
uses uses
Dos, Dos,
GlobType,Tokens,Compiler, GlobType,
FPString,FPVars,FPUtils; FPString,FPVars,FPUtils;
var var
@ -1113,7 +1113,10 @@ end;
end. end.
{ {
$Log$ $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 * new set of Gabor changes: see fixes.txt
Revision 1.21 2000/04/25 08:42:33 pierre 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); procedure TSymbolReferenceView.HandleEvent(var Event: TEvent);
var OldFocus: sw_integer; var OldFocus: sw_integer;
DontClear: boolean; { DontClear: boolean;}
begin begin
OldFocus:=Focused; OldFocus:=Focused;
{ case Event.What of { case Event.What of
@ -1692,7 +1692,10 @@ end;
END. END.
{ {
$Log$ $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 + new bunch of Gabor's changes
Revision 1.27 2000/05/29 10:44:57 pierre Revision 1.27 2000/05/29 10:44:57 pierre

9
ide/text/fptemplt.pas
View File

@ -169,11 +169,11 @@ begin
ReadStringPos:=-1; ReadStringPos:=-1;
end; 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; var P: sw_integer;
begin begin
ReadString:=ReadStringPos(InS,StartP,Expr,P); ReadString:=ReadStringPos(InS,StartP,Expr,P);
end; end;}
function ProcessTemplateLine(var S: string): boolean; function ProcessTemplateLine(var S: string): boolean;
var OK: boolean; var OK: boolean;
@ -289,7 +289,10 @@ end;
END. END.
{ {
$Log$ $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 * new set of Gabor changes: see fixes.txt
Revision 1.8 1999/06/25 00:33:40 pierre Revision 1.8 1999/06/25 00:33:40 pierre

27
ide/text/fptools.pas
View File

@ -149,8 +149,8 @@ implementation
uses Dos, uses Dos,
Commands,App,MsgBox, Commands,App,MsgBox,
WUtils,WINI,WEditor, WINI,WEditor,
FPConst,FPString,FPVars,FPUtils,FPCodCmp,FPCodTmp; FPConst,FPString,FPVars,FPUtils;
{$ifndef NOOBJREG} {$ifndef NOOBJREG}
const const
@ -571,7 +571,7 @@ begin
ReDraw; ReDraw;
end; end;
procedure ReplaceStr(var S: string; const What,NewS: string); (*procedure ReplaceStr(var S: string; const What,NewS: string);
var I : integer; var I : integer;
begin begin
repeat repeat
@ -597,7 +597,7 @@ begin
Insert(NewS,S,I); Insert(NewS,S,I);
end; end;
until I=0; until I=0;
end; end;*)
function GetCoordEntry(F: PINIFile; Section, Entry: string; var P: TPoint): boolean; function GetCoordEntry(F: PINIFile; Section, Entry: string; var P: TPoint): boolean;
var OK: boolean; var OK: boolean;
@ -612,7 +612,7 @@ begin
OK:=OK and (Px>0); OK:=OK and (Px>0);
if OK then P.X:=StrToInt(copy(S,1,Px-1)); if OK then P.X:=StrToInt(copy(S,1,Px-1));
OK:=OK and (LastStrToIntResult=0); 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); OK:=OK and (LastStrToIntResult=0);
GetCoordEntry:=OK; GetCoordEntry:=OK;
end; end;
@ -1008,7 +1008,7 @@ begin
if (WordS='$CAP') then if (WordS='$CAP') then
begin begin
if (Pass=0) then 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 end else
if (WordS='$CAP_MSG') then if (WordS='$CAP_MSG') then
begin begin
@ -1090,7 +1090,7 @@ begin
if ReadTill(S,')')=false then Err:=I else if ReadTill(S,')')=false then Err:=I else
begin begin
Consume(')'); 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; I:=I+ReplacePart(LastWordStart,I-1,E)-1;
end; end;
end else end else
@ -1167,9 +1167,9 @@ begin
I:=I+ReplacePart(LastWordStart,I-1,'')-1; I:=I+ReplacePart(LastWordStart,I-1,'')-1;
if CheckOnly=false then if CheckOnly=false then
begin begin
S:=copy(Params,I+1,255); S:=copy(Params,I+1,High(Params));
if InputBox(dialog_programarguments, label_enterprogramargument, if InputBox(dialog_programarguments, label_enterprogramargument,
S,255-I+1)=cmOK then S,High(Params)-I+1)=cmOK then
begin begin
ReplacePart(LastWordStart,255,S); ReplacePart(LastWordStart,255,S);
I:=255; I:=255;
@ -1182,7 +1182,7 @@ begin
if (WordS='$SAVE') then if (WordS='$SAVE') then
begin begin
if (Pass=0) then 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 end else
if (WordS='$SAVE_ALL') then if (WordS='$SAVE_ALL') then
begin begin
@ -1259,7 +1259,7 @@ procedure AddLine;
begin begin
Row:=ord(Line[1])+ord(Line[2]) shl 8; Row:=ord(Line[1])+ord(Line[2]) shl 8;
Col:=ord(Line[3])+ord(Line[4]) 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; end;
begin begin
New(S, Init(MsgFileName, stOpenRead, 4096)); New(S, Init(MsgFileName, stOpenRead, 4096));
@ -1507,7 +1507,10 @@ end;
END. END.
{ {
$Log$ $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 * new set of Gabor changes: see fixes.txt
Revision 1.18 2000/04/25 08:42:33 pierre 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; var S: string;
begin begin
GetDir(0,S); if copy(S,length(S),1)<>DirSep then S:=S+DirSep; 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)); system.Delete(Path,1,length(S));
SmartPath:=Path; SmartPath:=Path;
end; end;
@ -664,7 +664,10 @@ end;
END. END.
{ {
$Log$ $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 lot of Gabor changes : see fixes.txt
Revision 1.14 2000/01/03 11:38:34 michael Revision 1.14 2000/01/03 11:38:34 michael

12
ide/text/fpviews.pas
View File

@ -440,8 +440,7 @@ procedure RegisterFPViews;
implementation implementation
uses uses
{$ifdef GABOR}crt,{$endif} Video,Strings,Keyboard,Validate,
Video,Strings,Keyboard,Memory,MsgBox,Validate,
Tokens,Version, Tokens,Version,
{$ifndef NODEBUG} {$ifndef NODEBUG}
gdbint, gdbint,
@ -1389,8 +1388,8 @@ begin
else if Editor^.GetModified then else if Editor^.GetModified then
begin begin
PA[1]:=@AFileName; PA[1]:=@AFileName;
(* longint(PA[2]):=Editor^.ChangedLine; longint(PA[2]):={Editor^.ChangedLine}-1;
EditorDialog(edChangedOnloading,@PA);*) EditorDialog(edChangedOnloading,@PA);
end; end;
end; end;
Insert(Editor); Insert(Editor);
@ -3472,7 +3471,10 @@ end;
END. END.
{ {
$Log$ $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 + new bunch of Gabor's changes
Revision 1.71 2000/05/29 10:44:57 pierre 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); procedure realcall(Proc: pointer; var r: registers);
var rr: trealregs; var rr: trealregs;
const DPMI_INTR = $31;
begin begin
rr.realeax:=r.ax; rr.realeax:=r.ax;
rr.realebx:=r.bx; rr.realebx:=r.bx;
@ -718,7 +717,10 @@ end;
END. END.
{ {
$Log$ $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 + new files from Gabor

14
ide/text/readme.ide
View File

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

265
ide/text/vesa.pas
View File

@ -19,16 +19,6 @@ interface
uses uses
Dos, Dos,
{$ifdef TP}
{$ifdef DPMI}
WinDos,WinAPI,
{$endif}
{$endif}
{$ifdef FPC}
{$ifdef GO32V2}
Go32,
{$endif}
{$endif}
Objects,Strings,WUtils; Objects,Strings,WUtils;
const const
@ -136,170 +126,23 @@ function VESAGetMode(var Mode: word): boolean;
function VESASelectMemoryWindow(Window: byte; Position: word): boolean; function VESASelectMemoryWindow(Window: byte; Position: word): boolean;
function VESAReturnMemoryWindow(Window: byte; var Position: word): boolean; function VESAReturnMemoryWindow(Window: byte; var Position: word): boolean;
function MemToStr(var B; Count: byte): string;
implementation implementation
{$IFDEF DPMI} uses pmode;
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;
function VESAGetInfo(var B: TVESAInfoBlock): boolean; function VESAGetInfo(var B: TVESAInfoBlock): boolean;
{$IFNDEF DPMI} var r: registers;
var r : registers;
{$ELSE}
var r : tregisters;
pB : MemPtr;
{$ENDIF}
OK: boolean; OK: boolean;
M: MemPtr;
begin begin
StrToMem('VBE2',B.Signature); StrToMem('VBE2',B.Signature);
GetDosMem(M,SizeOf(B));
M.MoveDataTo(B,sizeof(B));
r.ah:=$4f; r.al:=0; r.ah:=$4f; r.al:=0;
{$IFNDEF DPMI} r.es:=M.DosSeg; r.di:=M.DosOfs;
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;
realintr($10,r); realintr($10,r);
{$ENDIF} M.MoveDataFrom(sizeof(B),B);
{$IFDEF DPMI} FreeDosMem(M);
{$ifdef TP}
Move(MakePtr(pB)^,B,SizeOf(B));
{$endif}
{$ifdef FPC}
dosmemget(pB.Segment,0,B,SizeOf(B));
{$endif}
FreeMem(pB, SizeOf(B));
{$ENDIF}
OK:=(r.ax=$004f){ and (MemToStr(B.Signature,4)='VESA')}; OK:=(r.ax=$004f){ and (MemToStr(B.Signature,4)='VESA')};
VESAGetInfo:=OK; VESAGetInfo:=OK;
end; end;
@ -307,36 +150,15 @@ end;
function VESAGetModeList(var B: TVESAModeList): boolean; function VESAGetModeList(var B: TVESAModeList): boolean;
var OK: boolean; var OK: boolean;
VI: TVESAInfoBlock; VI: TVESAInfoBlock;
{$ifdef TP}
{$ifdef DPMI}
Sel: word;
{$endif}
{$endif}
begin begin
FillChar(B,SizeOf(B),0); FillChar(B,SizeOf(B),0);
OK:=VESAGetInfo(VI); OK:=VESAGetInfo(VI);
if OK then if OK then
begin begin
{$ifdef TP} OK:=MoveDosToPM(VI.VideoModeList,@B.Modes,sizeof(B.Modes));
{$ifdef DPMI}
Sel:=AllocSelector(0);
OK:=Sel<>0;
if OK then if OK then
begin while (B.Modes[B.Count+1]<>$ffff) and (B.Count<High(B.Modes)) do
SetSelectorBase(Sel,(longint(VI.VideoModeList) shr 16)*16+longint(VI.VideoModeList) and $ffff); Inc(B.Count);
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);
end; end;
VESAGetModeList:=OK; VESAGetModeList:=OK;
end; end;
@ -364,74 +186,26 @@ end;
function VESAGetOemString: string; function VESAGetOemString: string;
var OK: boolean; var OK: boolean;
VI: TVESAInfoBlock; VI: TVESAInfoBlock;
{$ifdef TP}
{$ifdef DPMI}
Sel: word;
{$endif}
{$endif}
S: array[0..256] of char; S: array[0..256] of char;
begin begin
FillChar(S,SizeOf(S),0); FillChar(S,SizeOf(S),0);
OK:=VESAGetInfo(VI); OK:=VESAGetInfo(VI);
{$IFDEF DPMI}
if OK then if OK then
begin OK:=MoveDosToPM(VI.OemString,@S,sizeof(S));
{$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}
VESAGetOemString:=StrPas(@S); VESAGetOemString:=StrPas(@S);
end; end;
function VESAGetModeInfo(Mode: word; var B: TVESAModeInfoBlock): boolean; function VESAGetModeInfo(Mode: word; var B: TVESAModeInfoBlock): boolean;
{$IFNDEF DPMI}
var r : registers; var r : registers;
{$ELSE} M : MemPtr;
var r : tregisters;
{$ENDIF}
OK: boolean; OK: boolean;
{$ifdef DPMI}
pB: MemPtr;
{$endif}
begin begin
r.ah:=$4f; r.al:=$01; r.cx:=Mode; r.ah:=$4f; r.al:=$01; r.cx:=Mode;
{$IFDEF DPMI} GetDosMem(M,sizeof(B));
GetMem(pB, SizeOf(B)); r.es:=M.DosSeg; r.di:=M.DosOfs; {r.ds:=r.es;}
{$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;}
realintr($10,r); realintr($10,r);
{$ELSE} M.MoveDataFrom(sizeof(B),B);
r.es:=seg(B); r.di:=ofs(B); FreeDosMem(M);
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}
OK:=(r.ax=$004f); OK:=(r.ax=$004f);
VESAGetModeInfo:=OK; VESAGetModeInfo:=OK;
end; end;
@ -490,7 +264,10 @@ BEGIN
END. END.
{ {
$Log$ $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 Gabor fixes to avoid unused vars
Revision 1.6 2000/01/03 11:38:35 michael Revision 1.6 2000/01/03 11:38:35 michael

2
ide/text/wansi.pas
View File

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

4
ide/text/wcedit.pas
View File

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

75
ide/text/weditor.pas
View File

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

138
ide/text/whelp.pas
View File

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

13
ide/text/whlpview.pas
View File

@ -213,7 +213,7 @@ implementation
uses uses
Video, Video,
WConsts,WViews; WConsts;
const CommentColor = Blue; const CommentColor = Blue;
@ -794,7 +794,7 @@ begin
while (Y<=R.B.Y) do while (Y<=R.B.Y) do
begin begin
if Y=R.A.Y then StartX:=R.A.X else StartX:=Margin; 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); S:=S+copy(GetLineText(Y),StartX+1,EndX-StartX+1);
Inc(Y); Inc(Y);
end; end;
@ -1138,7 +1138,7 @@ begin
MoveChar(B,' ',NormalColor,Size.X); MoveChar(B,' ',NormalColor,Size.X);
if Y<GetLineCount then if Y<GetLineCount then
begin begin
S:=copy(GetLineText(Y),Delta.X+1,255); S:=copy(GetLineText(Y),Delta.X+1,High(S));
S:=copy(S,1,MaxViewWidth); S:=copy(S,1,MaxViewWidth);
MoveStr(B,S,NormalColor); 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 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 begin
if Y=SelR.A.Y then MinX:=SelR.A.X else MinX:=0; 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 for DX:=MinX to MaxX do
begin begin
X:=DX; X:=DX;
@ -1318,7 +1318,10 @@ end;
END. END.
{ {
$Log$ $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 + new bunch of Gabor's changes
Revision 1.16 2000/05/30 07:18:33 pierre Revision 1.16 2000/05/30 07:18:33 pierre

11
ide/text/whtml.pas
View File

@ -146,7 +146,7 @@ begin
end; end;
constructor TDOSTextFile.Init(AFileName: string); constructor TDOSTextFile.Init(AFileName: string);
{$ifdef TPUNIXLF} (*{$ifdef TPUNIXLF}
procedure readln(var t:text;var s:string); procedure readln(var t:text;var s:string);
var var
c : char; c : char;
@ -167,7 +167,7 @@ constructor TDOSTextFile.Init(AFileName: string);
dec(i); dec(i);
s[0]:=chr(i); s[0]:=chr(i);
end; end;
{$endif} {$endif}*)
var f: text; var f: text;
S: string; S: string;
begin begin
@ -180,7 +180,7 @@ begin
New(Lines, Init(500,2000)); New(Lines, Init(500,2000));
while (Eof(f)=false) and (IOResult=0) do while (Eof(f)=false) and (IOResult=0) do
begin begin
readln(f,S); readln(f,S); { this is the one in WUTILS.PAS }
AddLine(S); AddLine(S);
end; end;
Close(f); Close(f);
@ -711,7 +711,10 @@ end;
END. END.
{ {
$Log$ $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 * New Gabor changes : see fixes.txt
Revision 1.5 2000/03/21 23:20:47 pierre 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 implementation
uses WConsts,WUtils,WViews,WHTMLScn, uses WConsts,WUtils,WViews,WHTMLScn;
Dos;
function DefHTMLGetSectionColor(Section: THTMLSection; var Color: byte): boolean; function DefHTMLGetSectionColor(Section: THTMLSection; var Color: byte): boolean;
begin begin
@ -744,7 +743,10 @@ end;
END. END.
{ {
$Log$ $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 + new bunch of Gabor's changes
} }

13
ide/text/whtmlscn.pas
View File

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

7
ide/text/wini.pas
View File

@ -161,7 +161,7 @@ begin
Inc(P2); Inc(P2);
end; end;
Value:=NewStr(Trim(ValueS)); Value:=NewStr(Trim(ValueS));
Comment:=NewStr(copy(S,P2+1,255)); Comment:=NewStr(copy(S,P2+1,High(S)));
end else end else
begin begin
Tag:=nil; Tag:=nil;
@ -478,7 +478,10 @@ end;
END. END.
{ {
$Log$ $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 lot of Gabor changes : see fixes.txt
Revision 1.8 1999/03/08 14:58:21 peter 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 FormatDateTimeL(L: longint; const Format: string): string;
function FormatDateTime(const D: DateTime; 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; procedure GiveUpTimeSlice;
const LastStrToIntResult : integer = 0; const LastStrToIntResult : integer = 0;
@ -164,7 +170,7 @@ const
begin begin
c:=#0; c:=#0;
i:=0; i:=0;
while (not eof(t)) and (c<>#10) do while (not eof(t)) and (c<>#10) and (i<High(S)) do
begin begin
read(t,c); read(t,c);
if c<>#10 then if c<>#10 then
@ -198,7 +204,9 @@ procedure ReadlnFromStream(Stream: PStream; var S:string;var linecomplete : bool
i:=0; i:=0;
{ this created problems for lines longer than 255 characters { this created problems for lines longer than 255 characters
now those lines are cutted into pieces without warning PM } 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 begin
stream^.read(c,sizeof(c)); stream^.read(c,sizeof(c));
if c<>#10 then if c<>#10 then
@ -214,7 +222,7 @@ procedure ReadlnFromStream(Stream: PStream; var S:string;var linecomplete : bool
end; end;
if (c=#13) and (not eofstream(stream)) then if (c=#13) and (not eofstream(stream)) then
stream^.read(c,sizeof(c)); stream^.read(c,sizeof(c));
if (i=255) and not eofstream(stream) then if (i=High(S)) and not eofstream(stream) then
begin begin
pos:=stream^.getpos; pos:=stream^.getpos;
stream^.read(c,sizeof(c)); stream^.read(c,sizeof(c));
@ -228,6 +236,36 @@ procedure ReadlnFromStream(Stream: PStream; var S:string;var linecomplete : bool
s[0]:=chr(i); s[0]:=chr(i);
end; 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; function Max(A,B: longint): longint;
begin begin
@ -289,7 +327,7 @@ begin
i:=1; i:=1;
while (i<length(s)) and (s[i]=' ') do while (i<length(s)) and (s[i]=' ') do
inc(i); inc(i);
LTrim:=Copy(s,i,255); LTrim:=Copy(s,i,High(S));
end; end;
function RTrim(const S: string): string; function RTrim(const S: string): string;
@ -482,7 +520,7 @@ begin
{$ifdef win32} {$ifdef win32}
hs:=n+#0; hs:=n+#0;
i:=Windows.GetFullPathName(@hs[1],256,hs2,j); i:=Windows.GetFullPathName(@hs[1],256,hs2,j);
if (i>0) and (i<=255) then if (i>0) and (i<=high(hs)) then
begin begin
hs:=strpas(hs2); hs:=strpas(hs2);
GetLongName:=hs; GetLongName:=hs;
@ -662,7 +700,7 @@ end;
function TTextCollection.LookUp(const S: string; var Idx: sw_integer): string; function TTextCollection.LookUp(const S: string; var Idx: sw_integer): string;
var OLI,ORI,Left,Right,Mid: integer; var OLI,ORI,Left,Right,Mid: integer;
LeftP,RightP,MidP: PString; {LeftP,RightP,}MidP: PString;
{LeftS,}MidS{,RightS}: string; {LeftS,}MidS{,RightS}: string;
FoundS: string; FoundS: string;
UpS : string; UpS : string;
@ -676,7 +714,7 @@ begin
begin begin
OLI:=Left; ORI:=Right; OLI:=Left; ORI:=Right;
Mid:=Left+(Right-Left) div 2; 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^); { LeftS:=UpCaseStr(LeftP^); }MidS:=UpCaseStr(MidP^);
{ RightS:=UpCaseStr(RightP^);} { RightS:=UpCaseStr(RightP^);}
if copy(MidS,1,length(UpS))=UpS then if copy(MidS,1,length(UpS))=UpS then
@ -934,7 +972,10 @@ end;
END. END.
{ {
$Log$ $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 * allow to read until 255 chars per line
Revision 1.23 2000/06/16 08:50:45 pierre Revision 1.23 2000/06/16 08:50:45 pierre

13
ide/text/wviews.pas
View File

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