mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 21:19:31 +02:00
further html improvements
git-svn-id: trunk@7545 -
This commit is contained in:
pierre
parent
e5d97fbc66
commit
4fde26ba5e
@ -421,6 +421,13 @@ begin
|
||||
Code:=$ffff;
|
||||
end;
|
||||
end;
|
||||
{ #0 to #127 is same for Unicode and Code page 437 }
|
||||
if (code<=127) then
|
||||
begin
|
||||
E:=chr(code);
|
||||
DocDecodeNamedEntity:=true;
|
||||
exit;
|
||||
end;
|
||||
if (Code=$22) or (Name='quot') then E:='"' else { double quote sign }
|
||||
if (Code=$26) or (Name='amp') then E:='&' else { ampersand }
|
||||
if (Code=$3C) or (Name='lt') then E:='<' else { less-than sign }
|
||||
@ -431,7 +438,7 @@ begin
|
||||
if (Code=$5E) then E:='^' else { ^ }
|
||||
if (Code=$5F) then E:='_' else { _ }
|
||||
if (Code=160) or (Name='nbsp') then E:=#255 else { no-break space }
|
||||
if (Code=161) or (Name='iexcl') then E:='' else { inverted excalamation mark }
|
||||
if (Code=161) or (Name='iexcl') then E:='' else { inverted exclamation mark }
|
||||
if (Code=162) or (Name='cent') then E:='›' else { cent sign }
|
||||
if (Code=163) or (Name='pound') then E:='œ' else { pound sterling sign }
|
||||
if (Code=164) or (Name='curren') then E:='$' else { general currency sign }
|
||||
@ -468,8 +475,8 @@ begin
|
||||
if (Code=195) or (Name='Atilde') then E:='A' else { capital A, tilde accent }
|
||||
if (Code=196) or (Name='Auml') then E:='Ž' else { capital A, dieresis or umlaut }
|
||||
if (Code=197) or (Name='Aring') then E:='<27>' else { capital A, ring }
|
||||
if (Code=198) or (Name='AElig') then E:='AE' else { capital AE diphthong }
|
||||
(* if (Code=199) or (Name='Ccedil') then E:='?' else { capital C, cedilla }*)
|
||||
if (Code=198) or (Name='AElig') then E:='’' else { capital AE diphthong }
|
||||
if (Code=199) or (Name='Ccedil') then E:='€' else { capital C, cedilla }
|
||||
if (Code=200) or (Name='Egrave') then E:='<27>' else { capital E, grave accent }
|
||||
if (Code=201) or (Name='Eacute') then E:='<27>' else { capital E, acute accent }
|
||||
if (Code=202) or (Name='Ecirc') then E:='E' else { capital E, circumflex accent }
|
||||
@ -501,7 +508,7 @@ begin
|
||||
if (Code=228) or (Name='auml') then E:='„' else { small a, dieresis or umlaut }
|
||||
if (Code=229) or (Name='aring') then E:='†' else { small a, ring }
|
||||
if (Code=230) or (Name='aelig') then E:='ae' else { small ae, diphthong }
|
||||
(* if (Code=231) or (Name='ccedil') then E:='?' else { small c, cedilla }*)
|
||||
if (Code=231) or (Name='ccedil') then E:='‡' else { small c, cedilla }
|
||||
if (Code=232) or (Name='egrave') then E:='Š' else { small e, grave accent }
|
||||
if (Code=233) or (Name='eacute') then E:='‚' else { small e, acute accent }
|
||||
if (Code=234) or (Name='ecirc') then E:='ˆ' else { small e, circumflex accent }
|
||||
@ -527,15 +534,19 @@ begin
|
||||
(* if (Code=254) or (Name='thorn') then E:='?' else { small thorn, Icelandic }*)
|
||||
if (Code=255) or (Name='yuml') then E:='y' else { small y, dieresis or umlaut }
|
||||
{ Special codes appearing in TeXH generated files }
|
||||
if (Code=8217) then E:='''' else { acute accent as generated by TeXH }
|
||||
if (code=$2c6) then E:='^' else { Modifier Letter Circumflex Accent }
|
||||
if (code=$2013) then E:='-' else { En dash }
|
||||
if (code=$2014) then E:='--' else { Em dash }
|
||||
if (code=$201D) then E:='``' else { right double quotation marks }
|
||||
if (code=$2013{8211}) then E:='-' else { En dash }
|
||||
if (code=$2014{8212}) then E:='--' else { Em dash }
|
||||
if (Code=$2018{8216}) then E:='`' else { acute accent as generated by TeXH }
|
||||
if (Code=$2019{8217}) then E:='''' else { acute accent as generated by TeXH }
|
||||
if (code=$201C{8220}) then E:='''''' else { left double quotation marks }
|
||||
if (code=$201D{8221}) then E:='``' else { right double quotation marks }
|
||||
if (code=$2026{8230}) then E:='...' else { horizontal ellipsis }
|
||||
if (Code=$FB00) then E:='ff' else { ff together }
|
||||
if (Code=$FB01) then E:='fi' else { fi together }
|
||||
if (Code=$FB02) then E:='fl' else { fl together }
|
||||
if (Code=$FB03) then E:='ffi' else { ffi together }
|
||||
if (Code=$FB04) then E:='ffl' else { ffl together }
|
||||
Found:=false;
|
||||
DocDecodeNamedEntity:=Found;
|
||||
{$ifdef DEBUG}
|
||||
@ -633,7 +644,10 @@ begin
|
||||
S:=Trim(S); I:=1;
|
||||
while (I<=length(S)) and (S[I]<>'=') do
|
||||
begin
|
||||
ParamName:=ParamName+S[I];
|
||||
if S[I]=' ' then
|
||||
ParamName:=''
|
||||
else
|
||||
ParamName:=ParamName+S[I];
|
||||
Inc(I);
|
||||
end;
|
||||
ParamName:=Trim(ParamName);
|
||||
|
||||
129
ide/whtmlhlp.pas
129
ide/whtmlhlp.pas
@ -87,11 +87,12 @@ type
|
||||
procedure DocTITLE(Entered: boolean); virtual;
|
||||
procedure DocBODY(Entered: boolean); virtual;
|
||||
procedure DocAnchor(Entered: boolean); virtual;
|
||||
procedure DocUnknownTag; virtual;
|
||||
procedure DocUnknownTag; virtual;
|
||||
procedure DocHeading(Level: integer; Entered: boolean); virtual;
|
||||
procedure DocParagraph(Entered: boolean); virtual;
|
||||
procedure DocBreak; virtual;
|
||||
procedure DocImage; virtual;
|
||||
procedure DocProcessComment(Comment: string); virtual;
|
||||
procedure DocBold(Entered: boolean); virtual;
|
||||
procedure DocCite(Entered: boolean); virtual;
|
||||
procedure DocCode(Entered: boolean); virtual;
|
||||
@ -127,10 +128,13 @@ type
|
||||
InAnchor: boolean;
|
||||
InParagraph: boolean;
|
||||
InPreformatted: boolean;
|
||||
SuppressOutput: boolean;
|
||||
SuppressUntil : string;
|
||||
InDefExp: boolean;
|
||||
TopicTitle: string;
|
||||
Indent: integer;
|
||||
AnyCharsInLine: boolean;
|
||||
AnyCharsInLine,
|
||||
LastAnsiLoadFailed: boolean;
|
||||
CurHeadLevel: integer;
|
||||
PAlign: TParagraphAlign;
|
||||
LinkIndexes: array[0..MaxTopicLinks] of sw_integer;
|
||||
@ -658,7 +662,7 @@ begin
|
||||
begin
|
||||
Topic^.NamedMarks^.InsertStr(Name);
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage('',' Adding Name '+Name,1,1);
|
||||
DebugMessage('',' Adding Name "'+Name+'"',1,1);
|
||||
{$endif DEBUG}
|
||||
AddChar(hscNamedMark);
|
||||
end;
|
||||
@ -669,10 +673,12 @@ begin
|
||||
begin
|
||||
InAnchor:=true;
|
||||
AddChar(hscLink);
|
||||
if pos('#',HRef)=1 then
|
||||
Href:=NameAndExtOf(GetFilename)+Href;
|
||||
HRef:=CompleteURL(URL,HRef);
|
||||
LinkIndexes[LinkPtr]:=TopicLinks^.AddItem(HRef);
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage('',' Adding Link '+HRef,1,1);
|
||||
DebugMessage('',' Adding Link "'+HRef+'"',1,1);
|
||||
{$endif DEBUG}
|
||||
Inc(LinkPtr);
|
||||
end;
|
||||
@ -763,15 +769,87 @@ begin
|
||||
AnyCharsInLine:=false;
|
||||
end;
|
||||
|
||||
procedure THTMLTopicRenderer.DocProcessComment(Comment: string);
|
||||
var
|
||||
src,index : string;
|
||||
begin
|
||||
if pos('tex4ht:',Comment)=0 then
|
||||
exit;
|
||||
DebugMessage(GetFileName,'tex4ht comment "'
|
||||
+Comment+'"',Line,1);
|
||||
if SuppressOutput then
|
||||
begin
|
||||
if (pos(SuppressUntil,Comment)=0) then
|
||||
exit
|
||||
else
|
||||
begin
|
||||
DebugMessage(GetFileName,' Found '+SuppressUntil+'comment "'
|
||||
+Comment+'" SuppressOuput reset to false',Line,1);
|
||||
SuppressOutput:=false;
|
||||
SuppressUntil:='';
|
||||
end;
|
||||
end;
|
||||
{$ifdef DEBUG}
|
||||
if (pos('tex4ht:graphics ',Comment)>0) and
|
||||
LastAnsiLoadFailed then
|
||||
begin
|
||||
DebugMessage(GetFileName,' Using tex4ht comment "'
|
||||
+Comment+'"',Line,1);
|
||||
{ Try again with this info }
|
||||
TagParams:=Comment;
|
||||
DocImage;
|
||||
end;
|
||||
{$endif DEBUG}
|
||||
if (pos('tex4ht:syntaxdiagram ',Comment)>0) then
|
||||
begin
|
||||
DebugMessage(GetFileName,' Using tex4ht:syntaxdiagram comment "'
|
||||
+Comment+'"',Line,1);
|
||||
{ Try again with this info }
|
||||
TagParams:=Comment;
|
||||
DocImage;
|
||||
if not LastAnsiLoadFailed then
|
||||
begin
|
||||
SuppressOutput:=true;
|
||||
SuppressUntil:='tex4ht:endsyntaxdiagram ';
|
||||
end
|
||||
end;
|
||||
if (pos('tex4ht:mysyntdiag ',Comment)>0) then
|
||||
begin
|
||||
DebugMessage(GetFileName,' Using tex4ht:mysyntdiag comment "'
|
||||
+Comment+'"',Line,1);
|
||||
{ Try again with this info }
|
||||
TagParams:=Comment;
|
||||
DocGetTagParam('SRC',src);
|
||||
DocGetTagParam('INDEX',index);
|
||||
TagParams:='src="../syntax/'+src+'-'+index+'.png"';
|
||||
DocImage;
|
||||
if not LastAnsiLoadFailed then
|
||||
begin
|
||||
SuppressOutput:=true;
|
||||
SuppressUntil:='tex4ht:endmysyntdiag ';
|
||||
end
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THTMLTopicRenderer.DocImage;
|
||||
var Src,Alt,SrcLine: string;
|
||||
var Name,Src,Alt,SrcLine: string;
|
||||
f : text;
|
||||
attr : byte;
|
||||
PA : PHTMLAnsiView;
|
||||
StorePreformatted : boolean;
|
||||
begin
|
||||
if SuppressOutput then
|
||||
exit;
|
||||
{$ifdef DEBUG}
|
||||
if not DocGetTagParam('NAME',Name) then
|
||||
Name:='<No name>';
|
||||
DebugMessage(GetFileName,' Image "'+Name+'"',Line,1);
|
||||
{$endif DEBUG}
|
||||
if DocGetTagParam('SRC',src) then
|
||||
begin
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage(GetFileName,' Image source tag "'+Src+'"',Line,1);
|
||||
{$endif DEBUG}
|
||||
if src<>'' then
|
||||
begin
|
||||
src:=CompleteURL(URL,src);
|
||||
@ -779,10 +857,30 @@ begin
|
||||
Try to see if a file with same name and extension .git
|
||||
exists PM }
|
||||
src:=DirAndNameOf(src)+'.ans';
|
||||
if ExistsFile(src) then
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage(GetFileName,' Trying "'+Src+'"',Line,1);
|
||||
{$endif DEBUG}
|
||||
if not ExistsFile(src) then
|
||||
begin
|
||||
DocGetTagParam('SRC',src);
|
||||
src:=DirAndNameOf(src)+'.ans';
|
||||
src:=CompleteURL(DirOf(URL)+'../',src);
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage(GetFileName,' Trying "'+Src+'"',Line,1);
|
||||
{$endif DEBUG}
|
||||
end;
|
||||
if not ExistsFile(src) then
|
||||
begin
|
||||
LastAnsiLoadFailed:=true;
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage(GetFileName,' "'+Src+'" not found',Line,1);
|
||||
{$endif DEBUG}
|
||||
end
|
||||
else
|
||||
begin
|
||||
PA:=New(PHTMLAnsiView,init(@self));
|
||||
PA^.LoadFile(src);
|
||||
LastAnsiLoadFailed:=false;
|
||||
if AnyCharsInLine then DocBreak;
|
||||
StorePreformatted:=InPreformatted;
|
||||
InPreformatted:=true;
|
||||
@ -798,7 +896,14 @@ begin
|
||||
end;
|
||||
{ also look for a raw text file without colors }
|
||||
src:=DirAndNameOf(src)+'.txt';
|
||||
if ExistsFile(src) then
|
||||
if not ExistsFile(src) then
|
||||
begin
|
||||
LastAnsiLoadFailed:=true;
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage(GetFileName,' "'+Src+'" not found',Line,1);
|
||||
{$endif DEBUG}
|
||||
end
|
||||
else
|
||||
begin
|
||||
Assign(f,src);
|
||||
Reset(f);
|
||||
@ -809,7 +914,9 @@ begin
|
||||
AddText(SrcLine+hscLineBreak);
|
||||
end;
|
||||
Close(f);
|
||||
LastAnsiLoadFailed:=false;
|
||||
DocPreformatted(false);
|
||||
LastAnsiLoadFailed:=false;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
@ -1071,7 +1178,7 @@ end;
|
||||
|
||||
procedure THTMLTopicRenderer.AddChar(C: char);
|
||||
begin
|
||||
if (Topic=nil) or (TextPtr=MaxBytes) then Exit;
|
||||
if (Topic=nil) or (TextPtr=MaxBytes) or SuppressOutput then Exit;
|
||||
Topic^.Text^[TextPtr]:=ord(C);
|
||||
Inc(TextPtr);
|
||||
if (C>#15) and ((C<>' ') or (InPreFormatted=true)) then
|
||||
@ -1080,7 +1187,7 @@ end;
|
||||
|
||||
procedure THTMLTopicRenderer.AddCharAt(C: char;AtPtr : sw_word);
|
||||
begin
|
||||
if (Topic=nil) or (TextPtr=MaxBytes) then Exit;
|
||||
if (Topic=nil) or (TextPtr=MaxBytes) or SuppressOutput then Exit;
|
||||
if AtPtr>TextPtr then
|
||||
AtPtr:=TextPtr
|
||||
else
|
||||
@ -1132,7 +1239,7 @@ function THTMLTopicRenderer.AddTextAt(const S: String;AtPtr : sw_word) : sw_word
|
||||
var
|
||||
i,slen,len : sw_word;
|
||||
begin
|
||||
if (Topic=nil) or (TextPtr>=MaxBytes) then Exit;
|
||||
if (Topic=nil) or (TextPtr>=MaxBytes) or SuppressOutput then Exit;
|
||||
slen:=length(s);
|
||||
if TextPtr+slen>=MaxBytes then
|
||||
slen:=MaxBytes-TextPtr;
|
||||
@ -1185,6 +1292,8 @@ begin
|
||||
TextPtr:=0; LinkPtr:=0;
|
||||
AnyCharsInLine:=false;
|
||||
LastTextChar:=#0;
|
||||
SuppressUntil:='';
|
||||
SuppressOutput:=false;
|
||||
OK:=Process(HTMLFile);
|
||||
|
||||
if OK then
|
||||
|
||||
462
ide/whtmlscn.pas
462
ide/whtmlscn.pas
@ -34,16 +34,50 @@ type
|
||||
{a}function CheckURL(const URL: string): boolean; virtual;
|
||||
{a}function CheckText(const Text: string): boolean; virtual;
|
||||
{a}procedure AddLink(const LinkText, LinkURL: string); virtual;
|
||||
{a}procedure AddRef(LinkURL: string); virtual;
|
||||
{a}procedure AddNameID(AName: string); virtual;
|
||||
{a}procedure AddID(AName: string); virtual;
|
||||
{a}function GetDocumentBaseURL: string; virtual;
|
||||
private
|
||||
CurLinkText: string;
|
||||
CurURL: string;
|
||||
CurName: string;
|
||||
CurName,
|
||||
CurID: string;
|
||||
CurDoc: string;
|
||||
InAnchor,InNameAnchor: boolean;
|
||||
InAnchor,InNameAnchor,
|
||||
HasHRef : boolean;
|
||||
LastSynonym: PHTMLLinkScanDocument;
|
||||
end;
|
||||
|
||||
TNameIDState = (IsReferenced, IsFound,IsID);
|
||||
TNameIDStates = set of TNameIDState;
|
||||
|
||||
|
||||
PNameID = ^TNameID;
|
||||
TNameID = object(TObject)
|
||||
constructor Init(const AName : string; Astate : TNameIDState);
|
||||
destructor Done; virtual;
|
||||
procedure SetState(Astate : TNameIDState; enabled : boolean);
|
||||
procedure SetOrigin(const AOrigin : string);
|
||||
procedure SetLine(ALine : sw_integer);
|
||||
function GetLine : sw_integer;
|
||||
function GetState : TNameIDStates;
|
||||
function GetName : string;
|
||||
function GetOrigin : string;
|
||||
private
|
||||
Name : pstring;
|
||||
Origin : pstring;
|
||||
Line : sw_integer;
|
||||
State : TNameIDStates;
|
||||
end;
|
||||
|
||||
PNameIDCollection = ^TNameIDCollection;
|
||||
TNameIDCollection = object(TSortedCollection)
|
||||
function At(Index: sw_Integer): PNameID;
|
||||
function Compare(Key1, Key2: Pointer): sw_Integer; virtual;
|
||||
end;
|
||||
|
||||
|
||||
THTMLLinkScanDocument = object(TObject)
|
||||
constructor Init(const ADocName: string);
|
||||
function GetName: string;
|
||||
@ -74,6 +108,7 @@ type
|
||||
THTMLLinkScanner = object(TCustomHTMLLinkScanner)
|
||||
constructor Init(const ABaseDir: string);
|
||||
procedure SetBaseDir(const ABaseDir: string);
|
||||
{a}function FindID(const AName : string) : PNameID; virtual;
|
||||
function GetDocumentCount: sw_integer;
|
||||
function GetDocumentURL(DocIndex: sw_integer): string;
|
||||
function GetUniqueDocumentURL(DocIndex: sw_integer): string;
|
||||
@ -85,8 +120,8 @@ type
|
||||
public
|
||||
procedure AddLink(const LinkText, LinkURL: string); virtual;
|
||||
private
|
||||
Documents: PHTMLLinkScanDocumentCollection;
|
||||
BaseDir: PString;
|
||||
Documents: PHTMLLinkScanDocumentCollection;
|
||||
BaseDir: PString;
|
||||
function ExpandChildURL(const S: string): string;
|
||||
function NormalizeChildURL(const S: string): string;
|
||||
end;
|
||||
@ -98,18 +133,25 @@ type
|
||||
constructor Init(const ADocumentURL: string);
|
||||
function GetDocumentURL: string;
|
||||
destructor Done; virtual;
|
||||
function AddReferencedName (const AName : string) : PNameID;
|
||||
function AddFoundName (const AName : string) : PNameID;
|
||||
procedure CheckNameList;
|
||||
function FindID(const AName : string) : PNameID; virtual;
|
||||
private
|
||||
DocumentURL : PString;
|
||||
NameIDList : PNameIDCollection;
|
||||
Owner : PHTMLLinkScanner;
|
||||
public
|
||||
State : THTMLLinkScanState;
|
||||
end;
|
||||
|
||||
PHTMLLinkScanFileCollection = ^THTMLLinkScanFileCollection;
|
||||
THTMLLinkScanFileCollection = object(TSortedCollection)
|
||||
function At(Index: sw_Integer): PHTMLLinkScanFile;
|
||||
function Compare(Key1, Key2: Pointer): sw_Integer; virtual;
|
||||
function SearchFile(const DocURL: string): PHTMLLinkScanFile;
|
||||
function FindFileWithState(AState: THTMLLinkScanState): PHTMLLinkScanFile;
|
||||
function At(Index: sw_Integer): PHTMLLinkScanFile;
|
||||
function Compare(Key1, Key2: Pointer): sw_Integer; virtual;
|
||||
function SearchFile(const DocURL: string): PHTMLLinkScanFile;
|
||||
function FindFileWithState(AState: THTMLLinkScanState): PHTMLLinkScanFile;
|
||||
procedure CheckNameIDLists;
|
||||
end;
|
||||
|
||||
THTMLLinkScanOption = (soSubDocsOnly);
|
||||
@ -121,12 +163,17 @@ type
|
||||
destructor Done; virtual;
|
||||
public
|
||||
function GetDocumentBaseURL: string; virtual;
|
||||
function FindID(const AName : string) : PNameID; virtual;
|
||||
procedure AddLink(const LinkText, LinkURL: string); virtual;
|
||||
procedure AddRef(LinkURL: string); virtual;
|
||||
procedure AddNameID(AName: string); virtual;
|
||||
procedure AddID(AName: string); virtual;
|
||||
function CheckURL(const URL: string): boolean; virtual;
|
||||
private
|
||||
Options: THTMLLinkScanOptions;
|
||||
BaseURL: string;
|
||||
CurBaseURL: string;
|
||||
IDList : PNameIDCollection;
|
||||
DocumentFiles: PHTMLLinkScanFileCollection;
|
||||
procedure ScheduleDoc(const DocumentURL: string);
|
||||
public
|
||||
@ -170,11 +217,15 @@ begin
|
||||
if Entered then
|
||||
begin
|
||||
CurLinkText:='';
|
||||
if DocGetTagParam('HREF',CurURL)=false then
|
||||
if DocGetTagParam('HREF',CurURL) then
|
||||
HasHRef:=true
|
||||
else
|
||||
CurURL:='';
|
||||
if not DocGetTagParam('NAME',CurName) then
|
||||
if not DocGetTagParam('ID',CurName) then
|
||||
CurName:='';
|
||||
if not DocGetTagParam('ID',CurID) then
|
||||
CurID:='';
|
||||
if CurName<>'' then
|
||||
begin
|
||||
InNameAnchor:=true;
|
||||
@ -188,28 +239,43 @@ begin
|
||||
else
|
||||
CurName:='';
|
||||
CurURL:=Trim(CurURL);
|
||||
if pos('#',CurURL)=1 then
|
||||
CurURL:=CurDoc+CurURL;
|
||||
CurURL:=CompleteURL(GetDocumentBaseURL,CurURL);
|
||||
end
|
||||
else
|
||||
begin
|
||||
CurLinkText:=Trim(CurLinkText);
|
||||
if (CurName='') and CheckURL(CurURL) and CheckText(CurLinkText) and
|
||||
not DisableCrossIndexing then
|
||||
if HasHRef then
|
||||
begin
|
||||
AddLink(CurLinkText,CurURL);
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage('',' Adding ScanLink "'+CurLinkText+'" to "'+
|
||||
CurURL+'"',1,1);
|
||||
{$endif DEBUG}
|
||||
if CheckURL(CurURL) and CheckText(CurLinkText) and
|
||||
not DisableCrossIndexing then
|
||||
begin
|
||||
AddLink(CurLinkText,CurURL);
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage(CurDoc,' Adding ScanLink "'+CurLinkText+'" to "'+
|
||||
CurURL+'"',Line,1);
|
||||
{$endif DEBUG}
|
||||
end;
|
||||
{ Be sure to parse referenced file,
|
||||
even if that link is not valid }
|
||||
AddRef(CurURL);
|
||||
end;
|
||||
if InNameAnchor and CheckURL(CurName) and CheckText(CurLinkText) then
|
||||
if not HasHRef and InNameAnchor and CheckURL(CurName) and CheckText(CurLinkText) then
|
||||
begin
|
||||
AddLink(CurLinkText,CurName);
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage('',' Adding ScanName '+CurLinkText+' to '+CurName,1,1);
|
||||
DebugMessage(CurDoc,' Adding ScanName "'+CurLinkText+'" to "'+CurName+'"',Line,1);
|
||||
{$endif DEBUG}
|
||||
end;
|
||||
if InNameAnchor then
|
||||
begin
|
||||
AddNameID(CurName);
|
||||
end;
|
||||
if not HasHRef and (CurID<>'') then
|
||||
AddID(CurID);
|
||||
InNameAnchor:=false;
|
||||
HasHRef:=false;
|
||||
end;
|
||||
InAnchor:=Entered;
|
||||
end;
|
||||
@ -237,11 +303,110 @@ begin
|
||||
{ Abstract }
|
||||
end;
|
||||
|
||||
procedure TCustomHTMLLinkScanner.AddRef(LinkURL: string);
|
||||
begin
|
||||
{ Abstract }
|
||||
end;
|
||||
|
||||
procedure TCustomHTMLLinkScanner.AddNameID(AName: string);
|
||||
begin
|
||||
{ Abstract }
|
||||
end;
|
||||
|
||||
procedure TCustomHTMLLinkScanner.AddID(AName: string);
|
||||
begin
|
||||
{ Abstract }
|
||||
end;
|
||||
|
||||
|
||||
constructor TNameID.Init(const AName : string; Astate : TNameIDState);
|
||||
begin
|
||||
inherited Init;
|
||||
SetStr(Name,AName);
|
||||
Origin:=nil;
|
||||
State:=[AState];
|
||||
end;
|
||||
|
||||
destructor TNameID.Done;
|
||||
begin
|
||||
if assigned(Name) then
|
||||
DisposeStr(Name);
|
||||
Name:=nil;
|
||||
if assigned(Origin) then
|
||||
DisposeStr(Origin);
|
||||
Origin:=nil;
|
||||
inherited Done;
|
||||
end;
|
||||
|
||||
procedure TNameID.SetState(Astate : TNameIDState; enabled : boolean);
|
||||
begin
|
||||
if enabled then
|
||||
Include(State,AState)
|
||||
else
|
||||
Exclude(State,AState);
|
||||
end;
|
||||
|
||||
|
||||
function TNameID.GetState : TNameIDStates;
|
||||
begin
|
||||
GetState:=State;
|
||||
end;
|
||||
|
||||
function TNameID.GetName : string;
|
||||
begin
|
||||
GetName:=GetStr(Name);
|
||||
end;
|
||||
|
||||
function TNameID.GetOrigin : string;
|
||||
begin
|
||||
GetOrigin:=GetStr(Origin);
|
||||
end;
|
||||
|
||||
procedure TNameID.SetOrigin(const AOrigin : string);
|
||||
begin
|
||||
SetStr(Origin,AOrigin);
|
||||
end;
|
||||
procedure TNameID.SetLine(ALine : sw_integer);
|
||||
begin
|
||||
Line:=ALine;
|
||||
end;
|
||||
|
||||
function TNameID.GetLine : sw_integer;
|
||||
begin
|
||||
GetLine:=Line;
|
||||
end;
|
||||
|
||||
|
||||
function TNameIDCollection.At(Index: sw_Integer): PNameID;
|
||||
begin
|
||||
At:=Inherited At(Index);
|
||||
end;
|
||||
|
||||
function TNameIDCollection.Compare(Key1, Key2: Pointer): sw_Integer;
|
||||
var
|
||||
R: sw_integer;
|
||||
K1: PNameID absolute Key1;
|
||||
K2: PNameID absolute Key2;
|
||||
S1,S2: string;
|
||||
begin
|
||||
S1:=K1^.GetName;
|
||||
S2:=K2^.GetName;
|
||||
S1:=UpcaseStr(S1); S2:=UpcaseStr(S2);
|
||||
if S1<S2 then R:=-1 else
|
||||
if S1>S2 then R:= 1 else
|
||||
R:=0;
|
||||
Compare:=R;
|
||||
end;
|
||||
|
||||
|
||||
constructor THTMLLinkScanDocument.Init(const ADocName: string);
|
||||
begin
|
||||
inherited Init;
|
||||
SetStr(DocName,ADocName);
|
||||
New(Aliases, Init(10,10));
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage('',' Adding New LinkScan document "'+ADocName+'"',1,1);
|
||||
{$endif DEBUG}
|
||||
Synonym:=nil;
|
||||
end;
|
||||
|
||||
@ -274,6 +439,9 @@ end;
|
||||
procedure THTMLLinkScanDocument.AddAlias(const Alias: string);
|
||||
begin
|
||||
Aliases^.Insert(NewStr(Alias));
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage('',' Adding alias "'+Alias+'" to LinkScan document "'+GetStr(DocName)+'"',1,1);
|
||||
{$endif DEBUG}
|
||||
end;
|
||||
|
||||
constructor THTMLLinkScanDocument.Load(var S: TStream);
|
||||
@ -297,9 +465,13 @@ end;
|
||||
|
||||
destructor THTMLLinkScanDocument.Done;
|
||||
begin
|
||||
if Assigned(Aliases) then
|
||||
Dispose(Aliases, Done);
|
||||
Aliases:=nil;
|
||||
if Assigned(DocName) then
|
||||
DisposeStr(DocName);
|
||||
DocName:=nil;
|
||||
inherited Done;
|
||||
if Assigned(Aliases) then Dispose(Aliases, Done); Aliases:=nil;
|
||||
if Assigned(DocName) then DisposeStr(DocName); DocName:=nil;
|
||||
end;
|
||||
|
||||
constructor THTMLLinkScanDocumentCollection.Init(AScanner: PHTMLLinkScanner; ALimit, ADelta: Integer);
|
||||
@ -472,6 +644,12 @@ begin
|
||||
CurrentHTMLIndexVersion:=HTMLIndexVersion;
|
||||
end;
|
||||
|
||||
function THTMLLinkScanner.FindID(const AName : string) : PNameID;
|
||||
begin
|
||||
{abstract}FindID:=nil;
|
||||
end;
|
||||
|
||||
|
||||
procedure THTMLLinkScanner.StoreDocuments(var S: TStream);
|
||||
var L: longint;
|
||||
begin
|
||||
@ -487,15 +665,20 @@ end;
|
||||
|
||||
destructor THTMLLinkScanner.Done;
|
||||
begin
|
||||
if Assigned(Documents) then
|
||||
Dispose(Documents, Done);
|
||||
Documents:=nil;
|
||||
if Assigned(BaseDir) then
|
||||
DisposeStr(BaseDir);
|
||||
BaseDir:=nil;
|
||||
inherited Done;
|
||||
if Assigned(Documents) then Dispose(Documents, Done); Documents:=nil;
|
||||
if Assigned(BaseDir) then DisposeStr(BaseDir); BaseDir:=nil;
|
||||
end;
|
||||
|
||||
constructor THTMLLinkScanFile.Init(const ADocumentURL: string);
|
||||
begin
|
||||
inherited Init;
|
||||
SetStr(DocumentURL,ADocumentURL);
|
||||
New(NameIDList, Init(5,10));
|
||||
end;
|
||||
|
||||
function THTMLLinkScanFile.GetDocumentURL: string;
|
||||
@ -503,10 +686,98 @@ begin
|
||||
GetDocumentURL:=GetStr(DocumentURL);
|
||||
end;
|
||||
|
||||
function THTMLLinkScanFile.AddReferencedName (const AName : string) : PNameID;
|
||||
var
|
||||
index : sw_integer;
|
||||
PN : PNameID;
|
||||
begin
|
||||
new(PN,init(AName,IsReferenced));
|
||||
if not NameIDList^.Search(PN,Index) then
|
||||
NameIDList^.Insert(PN)
|
||||
else
|
||||
begin
|
||||
dispose(PN,Done);
|
||||
PN:=NameIDList^.At(Index);
|
||||
PN^.SetState(IsReferenced,true);
|
||||
end;
|
||||
AddReferencedName:=PN;
|
||||
end;
|
||||
|
||||
function THTMLLinkScanFile.AddFoundName (const AName : string) : PNameID;
|
||||
var
|
||||
index : sw_integer;
|
||||
PN : PNameID;
|
||||
begin
|
||||
new(PN,init(AName,IsFound));
|
||||
if not NameIDList^.Search(PN,Index) then
|
||||
NameIDList^.Insert(PN)
|
||||
else
|
||||
begin
|
||||
dispose(PN,Done);
|
||||
PN:=NameIDList^.At(Index);
|
||||
PN^.SetState(IsFound,true);
|
||||
end;
|
||||
AddFoundName:=PN;
|
||||
end;
|
||||
|
||||
procedure THTMLLinkScanFile.CheckNameList;
|
||||
var
|
||||
i : sw_integer;
|
||||
PN,PN2 : PNameID;
|
||||
begin
|
||||
{$ifdef DEBUG}
|
||||
for i:=0 to NameIDList^.Count-1 do
|
||||
begin
|
||||
PN:=NameIDList^.At(i);
|
||||
if not (IsFound in PN^.GetState) then
|
||||
begin
|
||||
if (IsReferenced in PN^.GetState) then
|
||||
DebugMessage(GetDocumentURL,'Name "'+PN^.GetName+'" from "'+
|
||||
PN^.GetOrigin+'" not found',1,1);
|
||||
PN2:=Owner^.FindID(PN^.GetName);
|
||||
if assigned(PN2) then
|
||||
begin
|
||||
DebugMessage('','ID found in "'+PN2^.GetOrigin+'"',1,1);
|
||||
if not (IsFound in PN2^.GetState) then
|
||||
DebugMessage('','ID not found',1,1);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{$endif DEBUG}
|
||||
end;
|
||||
|
||||
|
||||
function THTMLLinkScanFile.FindID(const AName : string) : PNameID;
|
||||
var
|
||||
PN : PNameID;
|
||||
Index : sw_integer;
|
||||
begin
|
||||
new(PN,init(AName,IsID));
|
||||
if NameIDList^.Search(PN,Index) then
|
||||
begin
|
||||
dispose(PN,done);
|
||||
PN:=NameIDList^.At(Index);
|
||||
if (IsID in PN^.GetState) then
|
||||
FindId:=PN
|
||||
else
|
||||
FindID:=nil;
|
||||
end
|
||||
else
|
||||
begin
|
||||
dispose(PN,done);
|
||||
PN:=nil;
|
||||
FindID:=nil;
|
||||
end;
|
||||
|
||||
end;
|
||||
destructor THTMLLinkScanFile.Done;
|
||||
begin
|
||||
if Assigned(DocumentURL) then
|
||||
DisposeStr(DocumentURL);
|
||||
DocumentURL:=nil;
|
||||
dispose(NameIDList,done);
|
||||
NameIDList:=nil;
|
||||
inherited Done;
|
||||
if Assigned(DocumentURL) then DisposeStr(DocumentURL); DocumentURL:=nil;
|
||||
end;
|
||||
|
||||
function THTMLLinkScanFileCollection.At(Index: sw_Integer): PHTMLLinkScanFile;
|
||||
@ -555,22 +826,44 @@ begin
|
||||
FindFileWithState:=P;
|
||||
end;
|
||||
|
||||
procedure THTMLLinkScanFileCollection.CheckNameIDLists;
|
||||
|
||||
procedure DoCheckNameList(P : PHTMLLinkScanFile);
|
||||
begin
|
||||
P^.CheckNameList;
|
||||
end;
|
||||
|
||||
begin
|
||||
ForEach(@DoCheckNameList);
|
||||
end;
|
||||
|
||||
|
||||
constructor THTMLFileLinkScanner.Init(const ABaseDir: string);
|
||||
begin
|
||||
inherited Init(ABaseDir);
|
||||
New(DocumentFiles, Init(50,100));
|
||||
New(IDList, Init(50,100));
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage('','THTMLFileLinkScanner Init "'+ABaseDir+'"',1,1);
|
||||
{$endif DEBUG}
|
||||
end;
|
||||
|
||||
procedure THTMLFileLinkScanner.ProcessDocument(const DocumentURL: string; AOptions: THTMLLinkScanOptions);
|
||||
var P: PHTMLLinkScanFile;
|
||||
begin
|
||||
CurBaseURL:=''; Options:=AOptions;
|
||||
CurBaseURL:='';
|
||||
Options:=AOptions;
|
||||
ScheduleDoc(DocumentURL);
|
||||
repeat
|
||||
P:=DocumentFiles^.FindFileWithState(ssScheduled);
|
||||
if Assigned(P) then
|
||||
ProcessDoc(P);
|
||||
until P=nil;
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage('','THTMLFileLinkScanner CheckNameList start ',1,1);
|
||||
DocumentFiles^.CheckNameIDLists;
|
||||
DebugMessage('','THTMLFileLinkScanner CheckNameList end ',1,1);
|
||||
{$endif DEBUG}
|
||||
end;
|
||||
|
||||
function THTMLFileLinkScanner.GetDocumentBaseURL: string;
|
||||
@ -596,11 +889,109 @@ begin
|
||||
P:=Pos('#',LinkURL);
|
||||
if P=0 then DocURL:=LinkURL else DocURL:=copy(LinkURL,1,P-1);
|
||||
D:=DocumentFiles^.SearchFile(DocURL);
|
||||
if Assigned(D)=false then
|
||||
if not Assigned(D) then
|
||||
ScheduleDoc(DocURL);
|
||||
inherited AddLink(LinkText,LinkURL);
|
||||
end;
|
||||
|
||||
procedure THTMLFileLinkScanner.AddRef(LinkURL: string);
|
||||
var D: PHTMLLinkScanFile;
|
||||
P: sw_integer;
|
||||
DocURL: string;
|
||||
PN : PNameID;
|
||||
begin
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage(CurDoc,' Adding Ref to "'+
|
||||
LinkURL+'"',Line,1);
|
||||
{$endif DEBUG}
|
||||
P:=Pos('#',LinkURL);
|
||||
if P=0 then DocURL:=LinkURL else DocURL:=copy(LinkURL,1,P-1);
|
||||
D:=DocumentFiles^.SearchFile(DocURL);
|
||||
if not Assigned(D) then
|
||||
ScheduleDoc(DocURL);
|
||||
D:=DocumentFiles^.SearchFile(DocURL);
|
||||
if P>0 then
|
||||
begin
|
||||
PN:=D^.AddReferencedName(copy(LinkURL,P+1,length(LinkURL)));
|
||||
PN^.SetOrigin(CurDoc);
|
||||
PN^.SetLine(Line);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THTMLFileLinkScanner.AddNameID(AName : string);
|
||||
var D: PHTMLLinkScanFile;
|
||||
P: sw_integer;
|
||||
PN : PNameID;
|
||||
DocURL: string;
|
||||
begin
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage(CurDoc,' Adding NameID "'+
|
||||
CurName+'"',Line,1);
|
||||
{$endif DEBUG}
|
||||
P:=Pos('#',AName);
|
||||
if P=0 then DocURL:=AName else DocURL:=copy(AName,1,P-1);
|
||||
D:=DocumentFiles^.SearchFile(DocURL);
|
||||
if not Assigned(D) then
|
||||
ScheduleDoc(DocURL);
|
||||
D:=DocumentFiles^.SearchFile(DocURL);
|
||||
PN:=D^.AddFoundName(copy(AName,P+1,length(AName)));
|
||||
PN^.SetOrigin(CurDoc);
|
||||
PN^.SetLine(Line);
|
||||
end;
|
||||
|
||||
procedure THTMLFileLinkScanner.AddID(AName : string);
|
||||
var
|
||||
D: PHTMLLinkScanFile;
|
||||
PN : PNameID;
|
||||
index : sw_integer;
|
||||
begin
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage(CurDoc,' Adding Id "'+
|
||||
AName+'"',Line,1);
|
||||
{$endif DEBUG}
|
||||
D:=DocumentFiles^.SearchFile(CurDoc);
|
||||
if not Assigned(D) then
|
||||
ScheduleDoc(CurDoc);
|
||||
D:=DocumentFiles^.SearchFile(CurDoc);
|
||||
PN:=D^.AddFoundName(AName);
|
||||
PN^.SetState(IsId,true);
|
||||
PN^.SetOrigin(CurDoc);
|
||||
PN^.SetLine(Line);
|
||||
|
||||
new(PN,init(AName,IsID));
|
||||
if IDList^ .Search(PN,index) then
|
||||
begin
|
||||
dispose(PN,done);
|
||||
{$ifdef DEBUG}
|
||||
PN:=IDList^.At(Index);
|
||||
DebugMessage(CurDoc,'ID "'+AName+'" already defined in "'+
|
||||
PN^.GetOrigin+'('+IntToStr(PN^.GetLine)+')"',Line,1);
|
||||
{$endif DEBUG}
|
||||
end
|
||||
else
|
||||
begin
|
||||
IDList^.Insert(PN);
|
||||
PN^.SetOrigin(CurDoc);
|
||||
PN^.SetLine(Line);
|
||||
end;
|
||||
end;
|
||||
|
||||
function THTMLFileLinkScanner.FindID(const AName : string) : PNameID;
|
||||
|
||||
Function ContainsNamedID(D : PHTMLLinkScanFile) : boolean;
|
||||
begin
|
||||
ContainsNamedID:=D^.FindID(AName)<>nil;
|
||||
end;
|
||||
var
|
||||
D : PHTMLLinkScanFile;
|
||||
begin
|
||||
D:=DocumentFiles^.FirstThat(@ContainsNamedID);
|
||||
if assigned(D) then
|
||||
FindID:=D^.FindID(AName)
|
||||
else
|
||||
FindID:=nil;
|
||||
end;
|
||||
|
||||
procedure THTMLFileLinkScanner.ProcessDoc(Doc: PHTMLLinkScanFile);
|
||||
var F: PDOSTextFile;
|
||||
begin
|
||||
@ -608,11 +999,17 @@ begin
|
||||
|
||||
Doc^.State:=ssProcessing;
|
||||
CurDoc:=Doc^.GetDocumentURL;
|
||||
New(F, Init(Doc^.GetDocumentURL));
|
||||
New(F, Init(CurDoc));
|
||||
if Assigned(F) then
|
||||
begin
|
||||
CurBaseURL:=CompleteURL(Doc^.GetDocumentURL,'');
|
||||
CurBaseURL:=CompleteURL(CurDoc,'');
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage(CurDoc,'Processing "'+CurDoc+'"',1,1);
|
||||
{$endif DEBUG}
|
||||
Process(F);
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage(CurDoc,'Finished processing "'+CurDoc+'"',Line,1);
|
||||
{$endif DEBUG}
|
||||
Dispose(F, Done);
|
||||
end
|
||||
else
|
||||
@ -630,13 +1027,22 @@ var D: PHTMLLinkScanFile;
|
||||
begin
|
||||
New(D, Init(DocumentURL));
|
||||
D^.State:=ssScheduled;
|
||||
D^.Owner:=@Self;
|
||||
{$ifdef DEBUG}
|
||||
DebugMessage('','Scheduling file "'+DocumentURL+'"',1,1);
|
||||
{$endif DEBUG}
|
||||
DocumentFiles^.Insert(D);
|
||||
end;
|
||||
|
||||
destructor THTMLFileLinkScanner.Done;
|
||||
begin
|
||||
if Assigned(DocumentFiles) then
|
||||
Dispose(DocumentFiles, Done);
|
||||
DocumentFiles:=nil;
|
||||
if Assigned(IDList) then
|
||||
Dispose(IDList, Done);
|
||||
IDList:=nil;
|
||||
inherited Done;
|
||||
if Assigned(DocumentFiles) then Dispose(DocumentFiles, Done); DocumentFiles:=nil;
|
||||
end;
|
||||
|
||||
procedure RegisterWHTMLScan;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user