paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-27 08:33:43 +02:00
Code Issues Packages Projects Releases Wiki Activity
a7109a116b
fpc/ide/whlpview.pas

1490 lines
42 KiB
ObjectPascal
Raw Blame History

{
$Id$
This file is part of the Free Pascal Integrated Development Environment
Copyright (c) 1998 by Berczi Gabor
Help display objects
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.
**********************************************************************}
unit WHlpView;
interface
uses
Objects,Drivers,Views,
{$ifdef FVISION}
FVConsts,
{$else}
Commands,
{$endif}
WEditor,WCEdit,
WUtils,WHelp;
{$IFNDEF EDITORS}
type
TEditor = TCodeEditor; PEditor = PCodeEditor;
{$ENDIF}
const
cmPrevTopic = 90;
HistorySize = 30;
CHelpViewer = #33#34#35#36;
CHelpFrame = #37#37#38#38#39;
cmHelpFilesChanged = 57340;
type
PHelpLink = ^THelpLink;
THelpLink = record
Bounds : TRect;
FileID : longint;
Context : THelpCtx;
end;
PHelpColorArea = ^THelpColorArea;
THelpColorArea = record
Color : byte;
Bounds : TRect;
AttrMask : byte;
end;
PHelpKeyword = ^THelpKeyword;
THelpKeyword = record
KWord : PString;
Index : sw_integer;
end;
PLinkCollection = ^TLinkCollection;
TLinkCollection = object(TCollection)
procedure FreeItem(Item: Pointer); virtual;
end;
PColorAreaCollection = ^TColorAreaCollection;
TColorAreaCollection = object(TCollection)
procedure FreeItem(Item: Pointer); virtual;
end;
PKeywordCollection = ^TKeywordCollection;
TKeywordCollection = object({TSorted}TCollection)
function At(Index: sw_Integer): PHelpKeyword;
procedure FreeItem(Item: Pointer); virtual;
function Compare(Key1, Key2: Pointer): sw_Integer; virtual;
end;
{ TSearchRelation = (srEqual,srGreater,srLess,srGreatEqu,srLessEqu);
PAdvancedStringCollection = ^TAdvancedStringCollection;
TAdvancedStringCollection = object(TStringCollection)
function SearchItem(Key: pointer; Rel: TSearchRelation; var Index: integer): boolean; virtual;
end;}
PNamedMark = ^TNamedMark;
TNamedMark = object(TObject)
constructor Init(const AName: string; AX, AY: integer);
function GetName: string;
destructor Done; virtual;
private
Name: PString;
Pos: TPoint;
end;
PNamedMarkCollection = ^TNamedMarkCollection;
TNamedMarkCollection = object(TSortedCollection)
function At(Index: sw_Integer): PNamedMark;
function Compare(Key1, Key2: Pointer): sw_Integer; virtual;
function SearchMark(const Name: string): PNamedMark;
function GetMarkPos(const Name: string; var P: TPoint): boolean;
procedure Add(const Name: string; P: TPoint);
end;
PHelpTopic = ^THelpTopic;
THelpTopic = object(TObject)
Topic: PTopic;
Lines: PUnsortedStringCollection;
Links: PLinkCollection;
NamedMarks: PNamedMarkCollection;
ColorAreas: PColorAreaCollection;
public
constructor Init(ATopic: PTopic);
procedure SetParams(AMargin, AWidth: sw_integer); virtual;
function GetLineCount: sw_integer; virtual;
function GetLineText(Line: sw_integer): string; virtual;
function GetLinkCount: sw_integer; virtual;
procedure GetLinkBounds(Index: sw_integer; var R: TRect); virtual;
function GetLinkFileID(Index: sw_integer): word; virtual;
function GetLinkContext(Index: sw_integer): THelpCtx; virtual;
function GetColorAreaCount: sw_integer; virtual;
procedure GetColorAreaBounds(Index: sw_integer; var R: TRect); virtual;
function GetColorAreaColor(Index: sw_integer): word; virtual;
function GetColorAreaMask(Index: sw_integer): word; virtual;
destructor Done; virtual;
private
Width,Margin: sw_integer;
{ StockItem: boolean;}
procedure ReBuild;
end;
THelpHistoryEntry = record
Context_ : THelpCtx;
Delta_ : TPoint;
CurPos_ : TPoint;
CurLink_ : sw_integer;
FileID_ : word;
end;
PHelpViewer = ^THelpViewer;
THelpViewer = object(TEditor)
Margin: sw_integer;
HelpTopic: PHelpTopic;
CurLink: sw_integer;
constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
procedure ChangeBounds(var Bounds: TRect); virtual;
procedure Draw; virtual;
procedure HandleEvent(var Event: TEvent); virtual;
procedure SetCurPtr(X,Y: sw_integer); virtual;
function GetLineCount: sw_integer; virtual;
function GetLine(LineNo: sw_integer): PCustomLine; virtual;
function GetLineText(Line: sw_integer): string; virtual;
function GetDisplayText(I: sw_integer): string; virtual;
function GetLinkCount: sw_integer; virtual;
procedure GetLinkBounds(Index: sw_integer; var R: TRect); virtual;
function GetLinkFileID(Index: sw_integer): word; virtual;
function GetLinkContext(Index: sw_integer): THelpCtx; virtual;
function GetLinkText(Index: sw_integer): string; virtual;
function GetColorAreaCount: sw_integer; virtual;
procedure GetColorAreaBounds(Index: sw_integer; var R: TRect); virtual;
function GetColorAreaColor(Index: sw_integer): word; virtual;
function GetColorAreaMask(Index: sw_integer): word; virtual;
procedure SelectNextLink(ANext: boolean); virtual;
procedure SwitchToIndex; virtual;
procedure SwitchToTopic(SourceFileID: word; Context: THelpCtx); virtual;
procedure SetTopic(Topic: PTopic); virtual;
procedure SetCurLink(Link: sw_integer); virtual;
procedure SelectLink(Index: sw_integer); virtual;
procedure PrevTopic; virtual;
procedure RenderTopic; virtual;
procedure Lookup(S: string); virtual;
function GetPalette: PPalette; virtual;
constructor Load(var S: TStream);
procedure Store(var S: TStream);
destructor Done; virtual;
private
History : array[0..HistorySize] of THelpHistoryEntry;
HistoryPtr : integer;
WordList : PKeywordCollection;
Lookupword : string;
InLookUp : boolean;
IndexTopic : PTopic;
IndexHelpTopic: PHelpTopic;
function LinkContainsPoint(var R: TRect; var P: TPoint): boolean;
procedure ISwitchToTopic(SourceFileID: word; Context: THelpCtx; RecordInHistory: boolean);
procedure ISwitchToTopicPtr(P: PTopic; RecordInHistory: boolean);
procedure BuildTopicWordList;
end;
PHelpFrame = ^THelpFrame;
THelpFrame = object(TFrame)
function GetPalette: PPalette; virtual;
end;
PHelpWindow = ^THelpWindow;
THelpWindow = object(TWindow)
HSB,VSB : PScrollBar;
HelpView: PHelpViewer;
HideOnClose: boolean;
constructor Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word; AContext: THelpCtx; ANumber: Integer);
procedure InitFrame; virtual;
procedure InitScrollBars; virtual;
procedure InitHelpView; virtual;
procedure ShowIndex; virtual;
procedure ShowTopic(SourceFileID: word; Context: THelpCtx); virtual;
procedure HandleEvent(var Event: TEvent); virtual;
procedure Close; virtual;
function GetPalette: PPalette; virtual; { needs to be overriden }
end;
implementation
uses
Video,
WConsts;
const CommentColor = Blue;
function NewLink(FileID: longint; Topic: THelpCtx; StartP, EndP: TPoint): PHelpLink;
var P: PHelpLink;
begin
New(P); FillChar(P^, SizeOf(P^), 0);
P^.FileID:=FileID;
P^.Context:=Topic; P^.Bounds.A:=StartP; P^.Bounds.B:=EndP;
NewLink:=P;
end;
procedure DisposeLink(P: PHelpLink);
begin
if P<>nil then Dispose(P);
end;
function NewColorArea(Color, AttrMask: byte; StartP, EndP: TPoint): PHelpColorArea;
var P: PHelpColorArea;
begin
New(P); FillChar(P^, SizeOf(P^), 0);
P^.Color:=Color; P^.AttrMask:=AttrMask;
P^.Bounds.A:=StartP; P^.Bounds.B:=EndP;
NewColorArea:=P;
end;
procedure DisposeColorArea(P: PHelpColorArea);
begin
if P<>nil then Dispose(P);
end;
function NewKeyword(Index: sw_integer; KWord: string): PHelpKeyword;
var P: PHelpKeyword;
begin
New(P); FillChar(P^, SizeOf(P^), 0);
P^.Index:=Index; P^.KWord:=NewStr(KWord);
NewKeyword:=P;
end;
procedure DisposeKeyword(P: PHelpKeyword);
begin
if P<>nil then
begin
if P^.KWord<>nil then DisposeStr(P^.KWord);
Dispose(P);
end;
end;
procedure TLinkCollection.FreeItem(Item: Pointer);
begin
if Item<>nil then DisposeLink(Item);
end;
procedure TColorAreaCollection.FreeItem(Item: Pointer);
begin
if Item<>nil then DisposeColorArea(Item);
end;
function TKeywordCollection.At(Index: sw_Integer): PHelpKeyword;
begin
At:=inherited At(Index);
end;
procedure TKeywordCollection.FreeItem(Item: Pointer);
begin
if Item<>nil then DisposeKeyword(Item);
end;
function TKeywordCollection.Compare(Key1, Key2: Pointer): sw_Integer;
var R: sw_integer;
K1: PHelpKeyword absolute Key1;
K2: PHelpKeyword absolute Key2;
S1,S2: string;
begin
S1:=UpcaseStr(K1^.KWord^); S2:=UpcaseStr(K2^.KWord^);
if S1<S2 then R:=-1 else
if S1>S2 then R:=1 else
R:=0;
Compare:=R;
end;
{function TAdvancedStringCollection.SearchItem(Key: pointer; Rel: TSearchRelation; var Index: sw_integer): boolean;
var
L, H, I, C: sw_Integer;
const resSmaller = -1; resEqual = 0; resGreater = 1;
begin
Index:=-1;
case Rel of
srEqual :
while (L <= H) and (Index=-1) do
begin
I := (L + H) shr 1;
C := Compare(KeyOf(Items^[I]), Key);
if C = resSmaller then L := I + 1 else
begin
H := I - 1;
if C = resEqual then
begin
if not Duplicates then L := I;
Index := L;
end;
end;
end;
srGreater :
begin
end;
srLess :
;
srGreatEqu :
;
srLessEqu :
;
else Exit;
end;
Search:=Index<>-1;
end;}
constructor TNamedMark.Init(const AName: string; AX, AY: integer);
begin
inherited Init;
Name:=NewStr(AName);
Pos.X:=AX; Pos.Y:=AY;
end;
function TNamedMark.GetName: string;
begin
GetName:=GetStr(Name);
end;
destructor TNamedMark.Done;
begin
if Assigned(Name) then DisposeStr(Name); Name:=nil;
inherited Done;
end;
function TNamedMarkCollection.At(Index: sw_Integer): PNamedMark;
begin
At:=inherited At(Index);
end;
function TNamedMarkCollection.Compare(Key1, Key2: Pointer): sw_Integer;
var K1: PNamedMark absolute Key1;
K2: PNamedMark absolute Key2;
R: integer;
N1,N2: string;
begin
N1:=UpcaseStr(K1^.GetName); N2:=UpcaseStr(K2^.GetName);
if N1<N2 then R:=-1 else
if N1>N2 then R:= 1 else
R:=0;
Compare:=R;
end;
function TNamedMarkCollection.SearchMark(const Name: string): PNamedMark;
var M,P: PNamedMark;
I: sw_integer;
begin
New(M, Init(Name,0,0));
if Search(M,I)=false then P:=nil else
P:=At(I);
Dispose(M, Done);
SearchMark:=P;
end;
function TNamedMarkCollection.GetMarkPos(const Name: string; var P: TPoint): boolean;
var M: PNamedMark;
begin
M:=SearchMark(Name);
if Assigned(M) then
P:=M^.Pos;
GetMarkPos:=Assigned(M);
end;
procedure TNamedMarkCollection.Add(const Name: string; P: TPoint);
begin
Insert(New(PNamedMark, Init(Name, P.X, P.Y)));
end;
constructor THelpTopic.Init(ATopic: PTopic);
begin
inherited Init;
Topic:=ATopic;
New(Lines, Init(100,100));
New(Links, Init(50,50));
New(ColorAreas, Init(50,50));
New(NamedMarks, Init(10,10));
end;
procedure THelpTopic.SetParams(AMargin, AWidth: sw_integer);
begin
if Width<>AWidth then
begin
Width:=AWidth; Margin:=AMargin;
ReBuild;
end;
end;
procedure THelpTopic.ReBuild;
var TextPos,LinkNo,NamedMarkNo: sw_word;
Line,CurWord: string;
C: char;
InLink,InCodeArea,InColorArea,InImage: boolean;
LinkStart,LinkEnd,CodeAreaStart,CodeAreaEnd: TPoint;
ColorAreaStart,ColorAreaEnd: TPoint;
ColorAreaType: (atText,atFull);
CurPos: TPoint;
ZeroLevel: sw_integer;
LineStart,NextLineStart: sw_integer;
LineAlign : (laLeft,laCenter,laRight);
FirstLink,LastLink: sw_integer;
AreaColor: word;
NextByte: (nbNormal,nbAreaColor);
procedure ClearLine;
begin
Line:='';
end;
procedure AddWord(TheWord: string); forward;
procedure NextLine;
var P: sw_integer;
I,Delta: sw_integer;
begin
Line:=CharStr(' ',Margin)+Line;
repeat
P:=Pos(#255,Line);
if P>0 then
if InImage then
Delete(Line,p,1)
else
Line[P]:=#32;
until P=0;
while copy(Line,length(Line),1)=' ' do Delete(Line,length(Line),1);
Delta:=0;
if Line<>'' then
case LineAlign of
laLeft : ;
laCenter : if Margin+length(Line)+Margin<Width then
begin
Delta:=(Width-(Margin+length(Line)+Margin)) div 2;
Line:=CharStr(' ',Delta)+Line;
end;
laRight : if Margin+length(Line)+Margin<Width then
begin
Delta:=Width-(Margin+length(Line)+Margin);
Line:=CharStr(' ',Delta)+Line;
end;
end;
if (Delta>0) and (FirstLink<>LastLink) then
for I:=FirstLink to LastLink-1 do
with PHelpLink(Links^.At(I))^ do
Bounds.Move(Delta,0);
if Line='' then Line:=' ';
Lines^.Insert(NewStr(Line));
ClearLine;
LineStart:=NextLineStart;
CurPos.X:=Margin+LineStart; Line:=CharStr(#255,LineStart); Inc(CurPos.Y);
if InLink then LinkStart:=CurPos;
FirstLink:=LastLink;
end;
procedure FlushLine;
var W: string;
begin
if CurWord<>'' then begin W:=CurWord; CurWord:=''; AddWord(W); end;
NextLine;
end;
procedure AddWord(TheWord: string);
var W: string;
begin
W:=TheWord;
while (length(W)>0) and (W[length(W)] in [' ',#255]) do
Delete(W,length(W),1);
if (copy(Line+TheWord,1,1)<>' ') then
if (Line<>'') and (Margin+length(Line)+length(W)+Margin>Width) and
not InImage then
NextLine;
Line:=Line+TheWord;
CurPos.X:=Margin+length(Line);
end;
procedure CheckZeroLevel;
begin
if ZeroLevel<>0 then
begin
if CurWord<>'' then AddWord(CurWord+' ');
CurWord:='';
ZeroLevel:=0;
end;
end;
procedure EndColorArea;
var Mask: word;
begin
if ColorAreaType=atText then Mask:=$f0 else Mask:=$00;
if CurWord<>'' then AddWord(CurWord); CurWord:='';
ColorAreaEnd:=CurPos; Dec(ColorAreaEnd.X);
ColorAreas^.Insert(NewColorArea(AreaColor,Mask,ColorAreaStart,ColorAreaEnd));
InColorArea:=false; AreaColor:=0;
end;
begin
Lines^.FreeAll; Links^.FreeAll; NamedMarks^.FreeAll; ColorAreas^.FreeAll;
if Topic=nil then Lines^.Insert(NewStr(msg_nohelpavailabelforthistopic)) else
begin
LineStart:=0; NextLineStart:=0;
TextPos:=0; ClearLine; CurWord:=''; Line:='';
CurPos.X:=Margin+LineStart; CurPos.Y:=0; LinkNo:=0;
NamedMarkNo:=0;
InLink:=false; InCodeArea:=false; InColorArea:=false;
InImage:=false;
ZeroLevel:=0;
LineAlign:=laLeft;
FirstLink:=0; LastLink:=0; NextByte:=nbNormal;
while (TextPos<Topic^.TextSize) or InImage do
begin
C:=chr(PByteArray(Topic^.Text)^[TextPos]);
case NextByte of
nbAreaColor :
begin
AreaColor:=ord(C);
NextByte:=nbNormal;
end;
nbNormal :
begin
case C of
hscLineBreak :
{if ZeroLevel=0 then ZeroLevel:=1 else
begin FlushLine; FlushLine; ZeroLevel:=0; end;}
if InLink then CurWord:=CurWord+' ' else
begin
NextLineStart:=0;
FlushLine;
LineStart:=0;
LineAlign:=laLeft;
end;
#1 : Break;
hscLink :
begin
CheckZeroLevel;
if InLink=false then
begin LinkStart:=CurPos; InLink:=true; end else
begin
if CurWord<>'' then AddWord(CurWord); CurWord:='';
LinkEnd:=CurPos; Dec(LinkEnd.X);
if Topic^.Links<>nil then
begin
Inc(LastLink);
if LinkNo<Topic^.LinkCount then
Links^.Insert(NewLink(Topic^.Links^[LinkNo].FileID,
Topic^.Links^[LinkNo].Context,LinkStart,LinkEnd));
Inc(LinkNo);
end;
InLink:=false;
end;
end;
hscLineStart :
begin
NextLineStart:=length(Line)+length(CurWord);
{ LineStart:=LineStart+(NextLineStart-LineStart);}
end;
hscCode :
begin
if InCodeArea=false then
CodeAreaStart:=CurPos else
begin
if CurWord<>'' then AddWord(CurWord); CurWord:='';
CodeAreaEnd:=CurPos; Dec(CodeAreaEnd.X);
ColorAreas^.Insert(NewColorArea(CommentColor,$f0,CodeAreaStart,CodeAreaEnd));
end;
InCodeArea:=not InCodeArea;
end;
hscCenter :
LineAlign:=laCenter;
hscRight :
LineAlign:=laCenter;
hscNamedMark :
begin
if NamedMarkNo<Topic^.NamedMarks^.Count then
NamedMarks^.Add(GetStr(Topic^.NamedMarks^.At(NamedMarkNo)),CurPos);
Inc(NamedMarkNo);
end;
hscTextAttr,hscTextColor :
begin
if InColorArea then
EndColorArea;
if C=hscTextAttr then
ColorAreaType:=atFull
else
ColorAreaType:=atText;
NextByte:=nbAreaColor;
ColorAreaStart:=CurPos;
InColorArea:=true;
end;
hscInImage :
begin
InImage := not InImage;
end;
hscNormText :
begin
if InColorArea then
EndColorArea;
end;
#32: if InLink then CurWord:=CurWord+C else
begin CheckZeroLevel; AddWord(CurWord+C); CurWord:=''; end;
else begin CheckZeroLevel; CurWord:=CurWord+C; end;
end;
end;
end;
CurPos.X:=Margin+length(Line)+length(CurWord);
Inc(TextPos);
end;
if (Line<>'') or (CurWord<>'') then FlushLine;
end;
end;
function THelpTopic.GetLineCount: sw_integer;
begin
GetLineCount:=Lines^.Count;
end;
function THelpTopic.GetLineText(Line: sw_integer): string;
var S: string;
begin
if Line<GetLineCount then S:=PString(Lines^.At(Line))^ else S:='';
GetLineText:=S;
end;
function THelpTopic.GetLinkCount: sw_integer;
begin
GetLinkCount:=Links^.Count;
end;
procedure THelpTopic.GetLinkBounds(Index: sw_integer; var R: TRect);
var P: PHelpLink;
begin
P:=Links^.At(Index);
R:=P^.Bounds;
end;
function THelpTopic.GetLinkFileID(Index: sw_integer): word;
var P: PHelpLink;
begin
P:=Links^.At(Index);
GetLinkFileID:=P^.FileID;
end;
function THelpTopic.GetLinkContext(Index: sw_integer): THelpCtx;
var P: PHelpLink;
begin
P:=Links^.At(Index);
GetLinkContext:=P^.Context;
end;
function THelpTopic.GetColorAreaCount: sw_integer;
begin
GetColorAreaCount:=ColorAreas^.Count;
end;
procedure THelpTopic.GetColorAreaBounds(Index: sw_integer; var R: TRect);
var P: PHelpColorArea;
begin
P:=ColorAreas^.At(Index);
R:=P^.Bounds;
end;
function THelpTopic.GetColorAreaColor(Index: sw_integer): word;
var P: PHelpColorArea;
begin
P:=ColorAreas^.At(Index);
GetColorAreaColor:=P^.Color;
end;
function THelpTopic.GetColorAreaMask(Index: sw_integer): word;
var P: PHelpColorArea;
begin
P:=ColorAreas^.At(Index);
GetColorAreaMask:=P^.AttrMask;
end;
destructor THelpTopic.Done;
begin
inherited Done;
Dispose(Lines, Done);
Dispose(Links, Done);
Dispose(ColorAreas, Done);
Dispose(NamedMarks, Done);
if (Topic<>nil) then DisposeTopic(Topic);
end;
constructor THelpViewer.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
begin
inherited Init(Bounds, AHScrollBar, AVScrollBar, nil, nil);
Flags:=efInsertMode; ReadOnly:=true;
New(WordList, Init(50,50));
Margin:=1; CurLink:=-1;
end;
procedure THelpViewer.ChangeBounds(var Bounds: TRect);
begin
if Owner<>nil then Owner^.Lock;
inherited ChangeBounds(Bounds);
if (HelpTopic<>nil) and (HelpTopic^.Topic<>nil) and
(HelpTopic^.Topic^.FileID<>0) then RenderTopic;
if Owner<>nil then Owner^.UnLock;
end;
procedure THelpViewer.RenderTopic;
begin
if HelpTopic<>nil then
HelpTopic^.SetParams(Margin,Size.X);
{$ifndef EDITORS}
SetLimit(255,GetLineCount);
{$endif}
DrawView;
end;
function THelpViewer.LinkContainsPoint(var R: TRect; var P: TPoint): boolean;
var OK: boolean;
begin
if (R.A.Y=R.B.Y) then
OK:= (P.Y=R.A.Y) and (R.A.X<=P.X) and (P.X<=R.B.X) else
OK:=
( (R.A.Y=P.Y) and (R.A.X<=P.X) ) or
( (R.A.Y<P.Y) and (P.Y<R.B.Y) ) or
( (R.B.Y=P.Y) and (P.X<=R.B.X) );
LinkContainsPoint:=OK;
end;
procedure THelpViewer.SetCurPtr(X,Y: sw_integer);
var OldCurLink,I: sw_integer;
OldPos,P: TPoint;
R: TRect;
begin
OldPos:=CurPos;
OldCurLink:=CurLink;
inherited SetCurPtr(X,Y);
CurLink:=-1;
P:=CurPos;
for I:=0 to GetLinkCount-1 do
begin
GetLinkBounds(I,R);
if LinkContainsPoint(R,P) then
begin CurLink:=I; Break; end;
end;
if OldCurLink<>CurLink then DrawView;
if ((OldPos.X<>CurPos.X) or (OldPos.Y<>CurPos.Y)) and (InLookup=false) then
Lookup('');
end;
function THelpViewer.GetLineCount: sw_integer;
var Count: sw_integer;
begin
if HelpTopic=nil then Count:=0 else Count:=HelpTopic^.GetLineCount;
GetLineCount:=Count;
end;
function THelpViewer.GetLine(LineNo: sw_integer): PCustomLine;
begin
{Abstract; used in wcedit unit ! }
GetLine:=nil;
end;
function THelpViewer.GetDisplayText(I: sw_integer): string;
begin
GetDisplayText:=ExtractTabs(GetLineText(I),DefaultTabSize);
end;
function THelpViewer.GetLineText(Line: sw_integer): string;
var S: string;
begin
if HelpTopic=nil then S:='' else S:=HelpTopic^.GetLineText(Line);
GetLineText:=S;
end;
function THelpViewer.GetLinkCount: sw_integer;
var Count: sw_integer;
begin
if HelpTopic=nil then Count:=0 else Count:=HelpTopic^.GetLinkCount;
GetLinkCount:=Count;
end;
procedure THelpViewer.GetLinkBounds(Index: sw_integer; var R: TRect);
begin
HelpTopic^.GetLinkBounds(Index,R);
end;
function THelpViewer.GetLinkFileID(Index: sw_integer): word;
begin
GetLinkFileID:=HelpTopic^.GetLinkFileID(Index);
end;
function THelpViewer.GetLinkContext(Index: sw_integer): THelpCtx;
begin
GetLinkContext:=HelpTopic^.GetLinkContext(Index);
end;
function THelpViewer.GetLinkText(Index: sw_integer): string;
var S: string;
R: TRect;
Y,StartX,EndX: sw_integer;
begin
S:=''; GetLinkBounds(Index,R);
Y:=R.A.Y;
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:=High(S);
S:=S+copy(GetLineText(Y),StartX+1,EndX-StartX+1);
Inc(Y);
end;
GetLinkText:=S;
end;
function THelpViewer.GetColorAreaCount: sw_integer;
var Count: sw_integer;
begin
if HelpTopic=nil then Count:=0 else Count:=HelpTopic^.GetColorAreaCount;
GetColorAreaCount:=Count;
end;
procedure THelpViewer.GetColorAreaBounds(Index: sw_integer; var R: TRect);
begin
HelpTopic^.GetColorAreaBounds(Index,R);
end;
function THelpViewer.GetColorAreaColor(Index: sw_integer): word;
begin
GetColorAreaColor:=HelpTopic^.GetColorAreaColor(Index);
end;
function THelpViewer.GetColorAreaMask(Index: sw_integer): word;
begin
GetColorAreaMask:=HelpTopic^.GetColorAreaMask(Index);
end;
procedure THelpViewer.SelectNextLink(ANext: boolean);
var I,Link: sw_integer;
R: TRect;
begin
if HelpTopic=nil then Exit;
Link:=CurLink;
if Link<>-1 then
begin
if ANext then
begin Inc(Link); if Link>=GetLinkCount then Link:=0; end else
begin Dec(Link); if Link=-1 then Link:=GetLinkCount-1; end;
end else
for I:=0 to GetLinkCount-1 do
begin
GetLinkBounds(I,R);
if (R.A.Y>CurPos.Y) or
(R.A.Y=CurPos.Y) and (R.A.X>CurPos.X) then
begin Link:=I; Break; end;
end;
if (Link=-1) and (GetLinkCount>0) then
if ANext then Link:=0
else Link:=GetLinkCount-1;
SetCurLink(Link);
end;
procedure THelpViewer.SetCurLink(Link: sw_integer);
var R: TRect;
begin
if Link<>-1 then
begin
GetLinkBounds(Link,R);
SetCurPtr(R.A.X,R.A.Y);
TrackCursor(true);
end;
end;
procedure THelpViewer.SwitchToIndex;
begin
if IndexTopic=nil then
IndexTopic:=HelpFacility^.BuildIndexTopic;
ISwitchToTopicPtr(IndexTopic,true);
end;
procedure THelpViewer.SwitchToTopic(SourceFileID: word; Context: THelpCtx);
begin
ISwitchToTopic(SourceFileID,Context,true);
end;
procedure THelpViewer.ISwitchToTopic(SourceFileID: word; Context: THelpCtx; RecordInHistory: boolean);
var P: PTopic;
begin
if HelpFacility=nil then P:=nil else
if (SourceFileID=0) and (Context=0) and (HelpTopic<>nil) then
P:=IndexTopic else
P:=HelpFacility^.LoadTopic(SourceFileID, Context);
ISwitchToTopicPtr(P,RecordInHistory);
end;
procedure THelpViewer.ISwitchToTopicPtr(P: PTopic; RecordInHistory: boolean);
var HistoryFull: boolean;
begin
if (P<>nil) and RecordInHistory and (HelpTopic<>nil) then
begin
HistoryFull:=HistoryPtr>=HistorySize;
if HistoryFull then
Move(History[1],History[0],SizeOf(History)-SizeOf(History[0]));
with History[HistoryPtr] do
begin
{SourceTopic_:=SourceTopic; }Context_:=HelpTopic^.Topic^.HelpCtx;
FileID_:=HelpTopic^.Topic^.FileID;
Delta_:=Delta; CurPos_:=CurPos; CurLink_:=CurLink;
end;
if HistoryFull=false then Inc(HistoryPtr);
end;
if Owner<>nil then Owner^.Lock;
SetTopic(P);
DrawView;
if Owner<>nil then Owner^.UnLock;
end;
procedure THelpViewer.PrevTopic;
begin
if HistoryPtr>0 then
begin
if Owner<>nil then Owner^.Lock;
Dec(HistoryPtr);
with History[HistoryPtr] do
begin
ISwitchToTopic(FileID_,Context_,false);
ScrollTo(Delta_.X,Delta_.Y);
SetCurPtr(CurPos_.X,CurPos_.Y);
TrackCursor(false);
if CurLink<>CurLink_ then SetCurLink(CurLink_);
end;
DrawView;
if Owner<>nil then Owner^.UnLock;
end;
end;
procedure THelpViewer.SetTopic(Topic: PTopic);
var Bookmark: string;
P: TPoint;
begin
CurLink:=-1;
if (HelpTopic=nil) or (Topic<>HelpTopic^.Topic) then
begin
if (HelpTopic<>nil) and (HelpTopic<>IndexHelpTopic) then
Dispose(HelpTopic, Done);
HelpTopic:=nil;
if Topic<>nil then
begin
if (Topic=IndexTopic) and (IndexHelpTopic<>nil) then
HelpTopic:=IndexHelpTopic else
New(HelpTopic, Init(Topic));
if Topic=IndexTopic then
IndexHelpTopic:=HelpTopic;
end;
end;
if Owner<>nil then Owner^.Lock;
SetCurPtr(0,0); TrackCursor(false);
RenderTopic;
BuildTopicWordList;
Lookup('');
if Assigned(Topic) then
if Topic^.StartNamedMark>0 then
if Topic^.NamedMarks^.Count>=Topic^.StartNamedMark then
begin
Bookmark:=GetStr(Topic^.NamedMarks^.At(Topic^.StartNamedMark-1));
if HelpTopic^.NamedMarks^.GetMarkPos(Bookmark,P) then
begin
SetCurPtr(P.X,P.Y);
ScrollTo(0,Max(0,P.Y-1));
end;
end;
SetSelection(CurPos,CurPos);
DrawView;
if Owner<>nil then Owner^.UnLock;
end;
procedure THelpViewer.BuildTopicWordList;
var I: sw_integer;
begin
WordList^.FreeAll;
for I:=0 to GetLinkCount-1 do
WordList^.Insert(NewKeyword(I,Trim(GetLinkText(I))));
end;
procedure THelpViewer.Lookup(S: string);
var Index, I: Sw_integer;
W: string;
OldLookup: string;
R: TRect;
P: PHelpKeyword;
begin
InLookup:=true;
OldLookup:=LookupWord;
S:=UpcaseStr(S);
Index:=-1;
I:=0; {J:=0;
while (J<GetLinkCount) do
begin
GetLinkBounds(J,R);
if (R.A.Y<CurPos.Y) or ((R.A.Y=CurPos.Y) and (R.B.X<CurPos.X))
then Inc(J) else
begin I:=J; Break; end;
end;}
if S='' then LookupWord:='' else
begin
while (Index=-1) and (I<WordList^.Count) do
begin
P:=WordList^.At(I);
if P^.KWord<>nil then
begin
W:=UpcaseStr(Trim(P^.KWord^));
if copy(W,1,length(S))=S then Index:=I;
end;
{ if W>S then Break else}
Inc(I);
end;
if Index<>-1 then
begin
W:=Trim(WordList^.At(Index)^.KWord^);
LookupWord:=copy(W,1,length(S));
end;
end;
if LookupWord<>OldLookup then
begin
if Index=-1 then SetCurLink(CurLink) else
begin
if Owner<>nil then Owner^.Lock;
P:=WordList^.At(Index);
S:=GetLinkText(P^.Index);
I:=Pos(LookupWord,S); if I=0 then I:=1;
GetLinkBounds(P^.Index,R);
SetCurPtr(R.A.X+(I-1)+length(Lookupword),R.A.Y);
CurLink:=P^.Index; DrawView;
TrackCursor(true);
if Owner<>nil then Owner^.UnLock;
end;
end;
InLookup:=false;
end;
procedure THelpViewer.SelectLink(Index: sw_integer);
var ID: word;
Ctx: THelpCtx;
begin
if Index=-1 then Exit;
if HelpTopic=nil then begin ID:=0; Ctx:=0; end else
begin
ID:=GetLinkFileID(Index);
Ctx:=GetLinkContext(Index);
end;
SwitchToTopic(ID,Ctx);
end;
procedure THelpViewer.HandleEvent(var Event: TEvent);
var DontClear: boolean;
procedure GetMousePos(var P: TPoint);
begin
MakeLocal(Event.Where,P);
Inc(P.X,Delta.X); Inc(P.Y,Delta.Y);
end;
begin
case Event.What of
evMouseDown :
if MouseInView(Event.Where) then
if (Event.Buttons=mbLeftButton) and (Event.Double) then
begin
inherited HandleEvent(Event);
if CurLink<>-1 then
SelectLink(CurLink);
end;
evBroadcast :
case Event.Command of
cmHelpFilesChanged :
begin
if HelpTopic=IndexHelpTopic then HelpTopic:=nil;
IndexTopic:=nil;
if IndexHelpTopic<>nil then Dispose(IndexHelpTopic, Done);
IndexHelpTopic:=nil;
end;
end;
evCommand :
begin
DontClear:=false;
case Event.Command of
cmPrevTopic :
PrevTopic;
else DontClear:=true;
end;
if DontClear=false then ClearEvent(Event);
end;
evKeyDown :
begin
DontClear:=false;
case Event.KeyCode of
kbTab :
SelectNextLink(true);
kbShiftTab :
begin NoSelect:=true; SelectNextLink(false); NoSelect:=false; end;
kbEnter :
if CurLink<>-1 then
SelectLink(CurLink);
kbBack,kbDel :
if Length(LookupWord)>0 then
Lookup(Copy(LookupWord,1,Length(LookupWord)-1));
else
case Event.CharCode of
#32..#255 :
begin NoSelect:=true; Lookup(LookupWord+Event.CharCode); NoSelect:=false; end;
else DontClear:=true;
end;
end;
TrackCursor(false);
if DontClear=false then ClearEvent(Event);
end;
end;
inherited HandleEvent(Event);
end;
procedure THelpViewer.Draw;
var NormalColor, LinkColor,
SelectColor, SelectionColor: word;
B: TDrawBuffer;
DX,DY,X,Y,I,MinX,MaxX,ScreenX: sw_integer;
LastLinkDrawn,LastColorAreaDrawn: sw_integer;
S: string;
R: TRect;
{$ifndef EDITORS}
SelR : TRect;
{$endif}
C,Mask: word;
CurP: TPoint;
ANDSB,ORSB: word;
begin
if ELockFlag>0 then
begin
DrawCalled:=true;
Exit;
end;
DrawCalled:=false;
NormalColor:=GetColor(1); LinkColor:=GetColor(2);
SelectColor:=GetColor(3); SelectionColor:=GetColor(4);
{$ifndef EDITORS}
SelR.A:=SelStart; SelR.B:=SelEnd;
{$endif}
LastLinkDrawn:=0; LastColorAreaDrawn:=0;
for DY:=0 to Size.Y-1 do
begin
Y:=Delta.Y+DY;
MoveChar(B,' ',NormalColor,Size.X);
if Y<GetLineCount then
begin
S:=copy(GetLineText(Y),Delta.X+1,High(S));
S:=copy(S,1,MaxViewWidth);
MoveStr(B,S,NormalColor);
for I:=LastColorAreaDrawn to GetColorAreaCount-1 do
begin
GetColorAreaBounds(I,R);
if R.A.Y>Y then Break;
LastColorAreaDrawn:=I;
if Y=R.B.Y then MaxX:=R.B.X else MaxX:=(length(S)+Delta.X-1);
if Y=R.A.Y then MinX:=R.A.X else MinX:=0;
if (R.A.Y<=Y) and (Y<=R.B.Y) then
begin
C:=GetColorAreaColor(I);
Mask:=GetColorAreaMask(I);
for DX:=MinX to MaxX do
begin
X:=DX;
ScreenX:=X-(Delta.X);
if (ScreenX>=0) and (ScreenX<=High(B)) then
begin
{ CurP.X:=X; CurP.Y:=Y;
if LinkAreaContainsPoint(R,CurP) then}
(* B[ScreenX]:=(B[ScreenX] and $f0ff) or (C shl 8);*)
ANDSB:=(Mask shl 8)+$ff;
ORSB:=(C shl 8);
B[ScreenX]:=(B[ScreenX] and ANDSB) or ORSB;
end;
end;
end;
end;
for I:=LastLinkDrawn to GetLinkCount-1 do
begin
GetLinkBounds(I,R);
if R.A.Y>Y then Break;
LastLinkDrawn:=I;
if Y=R.B.Y then MaxX:=R.B.X else MaxX:=(length(S)-1);
if Y=R.A.Y then MinX:=R.A.X else MinX:=0;
if (R.A.Y<=Y) and (Y<=R.B.Y) then
for DX:=MinX to MaxX do
begin
X:=DX;
ScreenX:=X-(Delta.X);
if (ScreenX>=0) and (ScreenX<=High(B)) then
begin
CurP.X:=X; CurP.Y:=Y;
if LinkContainsPoint(R,CurP) then
if I=CurLink then C:=SelectColor else C:=LinkColor;
B[ScreenX]:=(B[ScreenX] and $ff) or (C shl 8);
end;
end;
end;
{$ifndef EDITORS}
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:=High(string);
for DX:=MinX to MaxX do
begin
X:=DX;
ScreenX:=X-(Delta.X);
if (ScreenX>=0) and (ScreenX<High(B)) then
B[ScreenX]:=(B[ScreenX] and $0fff) or ((SelectionColor and $f0) shl 8);
end;
end;
{$endif}
end;
WriteLine(0,DY,Size.X,1,B);
end;
DrawCursor;
end;
function THelpViewer.GetPalette: PPalette;
const P: string[length(CHelpViewer)] = CHelpViewer;
begin
GetPalette:=@P;
end;
constructor THelpViewer.Load(var S: TStream);
begin
inherited Load(S);
end;
procedure THelpViewer.Store(var S: TStream);
begin
inherited Store(S);
end;
destructor THelpViewer.Done;
begin
if (HelpTopic<>nil) and (HelpTopic<>IndexHelpTopic) then
Dispose(HelpTopic, Done);
HelpTopic:=nil;
if IndexHelpTopic<>nil then
Dispose(IndexHelpTopic, Done);
IndexHelpTopic:=nil;
inherited Done;
if assigned(WordList) then
Dispose(WordList, Done);
end;
function THelpFrame.GetPalette: PPalette;
const P: string[length(CHelpFrame)] = CHelpFrame;
begin
GetPalette:=@P;
end;
constructor THelpWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word; AContext: THelpCtx; ANumber: Integer);
begin
inherited Init(Bounds, ATitle, ANumber);
InitScrollBars;
if Assigned(HSB) then Insert(HSB);
if Assigned(VSB) then Insert(VSB);
InitHelpView;
if Assigned(HelpView) then
begin
if (ASourceFileID<>0) or (AContext<>0) then
ShowTopic(ASourceFileID, AContext);
Insert(HelpView);
end;
end;
procedure THelpWindow.InitScrollBars;
var R: TRect;
begin
GetExtent(R); R.Grow(0,-1); R.A.X:=R.B.X-1;
New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
GetExtent(R); R.Grow(-1,0); R.A.Y:=R.B.Y-1;
New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY;
end;
procedure THelpWindow.InitHelpView;
var R: TRect;
begin
GetExtent(R); R.Grow(-1,-1);
New(HelpView, Init(R, HSB, VSB));
HelpView^.GrowMode:=gfGrowHiX+gfGrowHiY;
end;
procedure THelpWindow.InitFrame;
var R: TRect;
begin
GetExtent(R);
Frame:=New(PHelpFrame, Init(R));
end;
procedure THelpWindow.ShowIndex;
begin
HelpView^.SwitchToIndex;
end;
procedure THelpWindow.ShowTopic(SourceFileID: word; Context: THelpCtx);
begin
HelpView^.SwitchToTopic(SourceFileID, Context);
end;
procedure THelpWindow.HandleEvent(var Event: TEvent);
begin
case Event.What of
evKeyDown :
case Event.KeyCode of
kbEsc :
begin
Event.What:=evCommand; Event.Command:=cmClose;
end;
end;
end;
inherited HandleEvent(Event);
end;
procedure THelpWindow.Close;
begin
if HideOnClose then Hide else inherited Close;
end;
function THelpWindow.GetPalette: PPalette;
begin
GetPalette:=nil;
end;
END.
{
$Log$
Revision 1.2 2001-08-05 02:01:49 peter
* FVISION define to compile with fvision units
Revision 1.1 2001/08/04 11:30:25 peter
* ide works now with both compiler versions
Revision 1.1.2.5 2001/03/20 00:20:44 pierre
* fix some memory leaks + several small enhancements
Revision 1.1.2.4 2001/03/06 22:04:54 pierre
* Avoid cursor updates when editor window is locked
Revision 1.1.2.3 2000/12/18 21:59:25 pierre
* fix for bug1216
Revision 1.1.2.2 2000/11/16 23:13:06 pierre
+ support for ANSI substitutes to HTML images in HTML viewer
Revision 1.1.2.1 2000/11/14 23:41:33 pierre
* fix for bug 1234
Revision 1.1 2000/07/13 09:48:37 michael
+ Initial import
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
+ colors for HTML help by Gabor
Revision 1.15 2000/05/29 10:45:00 pierre
+ New bunch of Gabor's changes: see fixes.txt
Revision 1.14 2000/04/25 08:42:35 pierre
* New Gabor changes : see fixes.txt
Revision 1.13 2000/04/18 11:42:39 pierre
lot of Gabor changes : see fixes.txt
Revision 1.12 2000/03/21 23:21:38 pierre
adapted to wcedit addition
Revision 1.11 2000/02/07 08:29:13 michael
[*] the fake (!) TOKENS.PAS still contained the typo bug
FSplit(,n,d,e) (correctly FSplit(,d,n,e))
[*] CodeComplete had a very ugly bug - coordinates were document-relative
(instead of being screen-relative)
[*] TResourceStream didn't count the size of the resource names when
determining the file size and this could lead to the last resources not
loaded correctly
[+] Ctrl-Enter in editor now tries to open the file at cursor
[+] CodeComplete option added to Options|Environment|Editor
[+] user interface for managing CodeComplete implemented
[+] user interface for CodeTemplates implemented
[+] CodeComplete wordlist and CodeTemplates stored in desktop file
[+] help topic size no longer limited to 64KB when compiled with FPC
Revision 1.10 1999/08/16 18:25:31 peter
* Adjusting the selection when the editor didn't contain any line.
* Reserved word recognition redesigned, but this didn't affect the overall
syntax highlight speed remarkably (at least not on my Amd-K6/350).
The syntax scanner loop is a bit slow but the main problem is the
recognition of special symbols. Switching off symbol processing boosts
the performance up to ca. 200%...
* The editor didn't allow copying (for ex to clipboard) of a single character
* 'File|Save as' caused permanently run-time error 3. Not any more now...
* Compiler Messages window (actually the whole desktop) did not act on any
keypress when compilation failed and thus the window remained visible
+ Message windows are now closed upon pressing Esc
+ At 'Run' the IDE checks whether any sources are modified, and recompiles
only when neccessary
+ BlockRead and BlockWrite (Ctrl+K+R/W) implemented in TCodeEditor
+ LineSelect (Ctrl+K+L) implemented
* The IDE had problems closing help windows before saving the desktop
Revision 1.9 1999/06/28 19:32:35 peter
* fixes from gabor
Revision 1.8 1999/04/07 21:56:02 peter
+ object support for browser
* html help fixes
* more desktop saving things
* NODEBUG directive to exclude debugger
Revision 1.7 1999/03/08 14:58:20 peter
+ prompt with dialogs for tools
Revision 1.6 1999/03/01 15:42:13 peter
+ Added dummy entries for functions not yet implemented
* MenuBar didn't update itself automatically on command-set changes
* Fixed Debugging/Profiling options dialog
* TCodeEditor converts spaces to tabs at save only if efUseTabChars is set
* efBackSpaceUnindents works correctly
+ 'Messages' window implemented
+ Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
+ Added TP message-filter support (for ex. you can call GREP thru
GREP2MSG and view the result in the messages window - just like in TP)
* A 'var' was missing from the param-list of THelpFacility.TopicSearch,
so topic search didn't work...
* In FPHELP.PAS there were still context-variables defined as word instead
of THelpCtx
* StdStatusKeys() was missing from the statusdef for help windows
+ Topic-title for index-table can be specified when adding a HTML-files
Revision 1.5 1999/02/18 13:44:38 peter
* search fixed
+ backward search
* help fixes
* browser updates
Revision 1.4 1999/02/08 10:37:47 peter
+ html helpviewer
Revision 1.3 1999/01/21 11:54:32 peter
+ tools menu
+ speedsearch in symbolbrowser
* working run command
Revision 1.2 1998/12/28 15:47:57 peter
+ Added user screen support, display & window
+ Implemented Editor,Mouse Options dialog
+ Added location of .INI and .CFG file
+ Option (INI) file managment implemented (see bottom of Options Menu)
+ Switches updated
+ Run program
Revision 1.31 1998/12/27 12:07:30 gabor
* changed THelpViewer.Init to reflect changes in WEDITOR
Revision 1.3 1998/12/22 10:39:56 peter
+ options are now written/read
+ find and replace routines
}
Reference in New Issue View Git Blame Copy Permalink