1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Author: Mattias Gaertner
22
23 Abstract:
24 This unit is part of the IDE's help system. It implements the help for
25 sources via fpdoc files and Pascal comments.
26 }
27 unit CodeHelp;
28
29 {$mode objfpc}{$H+}
30
31 {off $DEFINE VerboseCodeHelp}
32 {off $DEFINE VerboseCodeHelpFails}
33 {off $DEFINE VerboseHints}
34
35 {$IFDEF VerboseCodeHelp}
36 {$DEFINE VerboseCodeHelpFails}
37 {$ENDIF}
38
39 interface
40
41 uses
42 // RTL + FCL
43 Classes, SysUtils, Laz_AVL_Tree,
44 // LCL
45 LCLProc, Forms, Controls, Dialogs,
46 // CodeTools
47 CodeAtom, CodeTree, CodeToolManager, FindDeclarationTool, BasicCodeTools,
48 KeywordFuncLists, PascalParserTool, CodeCache, CacheCodeTools, CustomCodeTool,
49 FileProcs, DefineTemplates,
50 // LazUtils
51 AvgLvlTree, FileUtil, LazFileUtils, LazUTF8, LazFileCache, LazMethodList,
52 LazLoggerBase, Laz2_DOM, Laz2_XMLRead, Laz2_XMLWrite,
53 // SynEdit
54 SynHighlighterPas,
55 // IDEIntf
56 IDECommands, IDEMsgIntf, MacroIntf, PackageIntf, LazHelpIntf, ProjectIntf,
57 IDEDialogs, IDEHelpIntf, LazIDEIntf, IDEExternToolIntf,
58 // IDE
59 EditorOptions, LazarusIDEStrConsts, IDEProcs, PackageDefs,
60 EnvironmentOpts, TransferMacros, PackageSystem, DialogProcs, KeyMapping;
61
62 const
63 IDEProjectName = 'Lazarus';
64 FPCDocsRepositoryURL = 'http://svn.freepascal.org/svn/fpcdocs/trunk';
65 type
66 TFPDocItem = (
67 fpdiShort,
68 fpdiElementLink,
69 fpdiDescription,
70 fpdiErrors,
71 fpdiSeeAlso,
72 fpdiExample
73 );
74
75 TFPDocElementValues = array [TFPDocItem] of String;
76
77 const
78 FPDocItemNames: array[TFPDocItem] of shortstring = (
79 'short',
80 'elementlink',
81 'descr',
82 'errors',
83 'seealso',
84 'example'
85 );
86
87 type
88 TLazFPDocFileFlag = (
89 ldffDocChangingCalled,
90 ldffDocChangedNeedsCalling
91 );
92 TLazFPDocFileFlags = set of TLazFPDocFileFlag;
93
94 { TLazFPDocFile
95 An fpdoc xml file. The CodeBuffer is the xml source. The Doc is the parsed dom tree. }
96
97 TLazFPDocFile = class
98 private
99 fUpdateLock: integer;
100 FFlags: TLazFPDocFileFlags;
101 FDocChangeStamp: int64;
102 FDocSaveChangeStamp: int64;
GetDocModifiednull103 function GetDocModified: boolean;
104 procedure SetDocModified(AValue: boolean);
105 public
106 Filename: string;// the fpdoc xml filename
107 Doc: TXMLdocument;// IMPORTANT: if you change this, call DocChanging and DocChanged to notify the references
108 DocErrorMsg: string; // if xml is broken, Doc could not be created
109 CodeBufferChangeStep: integer;// the CodeBuffer.ChangeStep value, when Doc was built
110 CodeBuffer: TCodeBuffer;
111 constructor Create;
112 destructor Destroy; override;
GetPackageNodenull113 function GetPackageNode: TDOMNode; // the lazarus project or package
GetPackageNamenull114 function GetPackageName: string;
GetModuleNodenull115 function GetModuleNode: TDOMNode; // the unit
GetModuleNamenull116 function GetModuleName: string;
GetModuleTopicCountnull117 function GetModuleTopicCount: Integer;
GetModuleTopicNamenull118 function GetModuleTopicName(Index: Integer): String;
GetModuleTopicnull119 function GetModuleTopic(Name: String): TDOMNode;
CreateModuleTopicnull120 function CreateModuleTopic(Name: String): TDOMNode;
GetFirstElementnull121 function GetFirstElement: TDOMNode;
GetElementWithNamenull122 function GetElementWithName(const ElementName: string;
123 CreateIfNotExists: boolean = false): TDOMNode;
GetChildValuesAsStringnull124 function GetChildValuesAsString(Node: TDOMNode): String;
GetValuesFromNodenull125 function GetValuesFromNode(Node: TDOMNode): TFPDocElementValues;
GetValueFromNodenull126 function GetValueFromNode(Node: TDOMNode; Item: TFPDocItem): string;
127 procedure SetChildValue(Node: TDOMNode; const ChildName: string; NewValue: string);
128 property DocModified: boolean read GetDocModified write SetDocModified;
129 property DocChangeStamp: int64 read FDocChangeStamp;
130 procedure DocChanging;
131 procedure DocChanged;
132 procedure BeginUpdate;
133 procedure EndUpdate;
134 end;
135
136 { TLazFPDocNode }
137
138 TLazFPDocNode = class
139 public
140 DocFile: TLazFPDocFile;
141 Node: TDomNode;
142 constructor Create(AFile: TLazFPDocFile; ANode: TDOMNode);
143 end;
144
145 { TCHSourceToFPDocFile - cache item for source to FPDoc file mapping }
146
147 TCHSourceToFPDocFile = class
148 public
149 SourceFilename: string;
150 FPDocFilename: string;
151 FPDocFileOwner: TObject; // always check FPDocFilenameTimeStamp before accessing
152 FPDocFilenameTimeStamp: integer; // corresponds to CompilerParseStamp
153 FilesTimeStamp: int64; // corresponds to FileStateCache.TimeStamp
IsValidnull154 function IsValid: boolean;
155 procedure MakeValid;
156 end;
157
158 { TCodeHelpElement - mapping between one codetools position and a fpdoc xml node.
159 This data is only valid as long as codetools data and fpdoc data are not
160 changed, so don't store it. }
161
162 TCodeHelpElement = class
163 public
164 CodeContext: TFindContext;
165 CodeXYPos: TCodeXYPosition;
166 ElementOwnerName: string;// the name of the lazarus package or project
167 ElementFPDocPackageName: string;
168 ElementUnitName: string;
169 ElementUnitFileName: string;
170 ElementName: string;
171 ElementNode: TDOMNode; // nil = not yet parsed (ElementNodeValid=false) or does not exist (ElementNodeValid=true)
172 ElementNodeValid: boolean;
173 FPDocFile: TLazFPDocFile;
174 procedure WriteDebugReport;
175 end;
176
177 { TCodeHelpElementChain - a list of TCodeHelpElement.
178 For example the list of one element plus its ancestors.
179 Only valid for short time. So always check IsValid. }
180
181 TCodeHelpElementChain = class
182 private
183 FItems: TFPList; // list of TCodeHelpElement
GetCountnull184 function GetCount: integer;
GetItemsnull185 function GetItems(Index: integer): TCodeHelpElement;
Addnull186 function Add: TCodeHelpElement;
187 public
188 CodePos: TCodePosition;
189 IDEChangeStep: integer; // corresponds to CompilerParseStamp
190 CodetoolsChangeStep: integer; // corresponds to CodeToolBoss.CodeTreeNodesDeletedStep
191 constructor Create;
192 destructor Destroy; override;
193 procedure Clear;
194 property Items[Index: integer]: TCodeHelpElement read GetItems; default;
195 property Count: integer read GetCount;
IndexOfFilenull196 function IndexOfFile(AFile: TLazFPDocFile): integer;
IndexOfElementNamenull197 function IndexOfElementName(ElementName: string): integer;
IndexOfElementNamenull198 function IndexOfElementName(ElementUnitName, ElementName: string): integer;
IsValidnull199 function IsValid: boolean;
200 procedure MakeValid;
DocFilenull201 function DocFile: TLazFPDocFile; // DocFile of first element
202 procedure WriteDebugReport;
203 end;
204
205 TCodeHelpChangeEvent = procedure(Sender: TObject; LazFPDocFile: TLazFPDocFile) of object;
206
207 TCodeHelpManagerHandler = (
208 chmhDocChanging,
209 chmhDocChanged
210 );
211
212 TCodeHelpOpenFileFlag = (
213 chofUpdateFromDisk,
214 chofRevert,
215 chofQuiet
216 );
217 TCodeHelpOpenFileFlags = set of TCodeHelpOpenFileFlag;
218
219 TCodeHelpParseResult = (
220 chprParsing, // means: done a small step, but not yet finished the job
221 chprFailed,
222 chprSuccess
223 );
224
225 TCodeHelpHintOption = (
226 chhoSmallStep, // do the next step. Use this to run on idle.
227 chhoDeclarationHeader, // add a header with source position and type of identifier
228 chhoComments, // add the pasdoc comments
229 chhoShowFocusHint // show the shortcut ecFocusHint
230 );
231 TCodeHelpHintOptions = set of TCodeHelpHintOption;
232
233 { TCodeHelpManager }
234
235 TCodeHelpManager = class(TComponent)
236 private
237 FDocs: TAvlTree;// tree of loaded TLazFPDocFile
238 FHandlers: array[TCodeHelpManagerHandler] of TMethodList;
239 FPasHighlighter: TSynPasSyn;
240 FSrcToDocMap: TAvlTree; // tree of TCHSourceToFPDocFile sorted for SourceFilename
241 FDeclarationCache: TDeclarationInheritanceCache;
242 procedure AddHandler(HandlerType: TCodeHelpManagerHandler;
243 const AMethod: TMethod; {%H-}AsLast: boolean = false);
244 procedure RemoveHandler(HandlerType: TCodeHelpManagerHandler;
245 const AMethod: TMethod);
246 procedure FreeHandlers;
247 procedure CallDocChangeEvents(HandlerType: TCodeHelpManagerHandler;
248 Doc: TLazFPDocFile);
DoCreateFPDocFileForSourcenull249 function DoCreateFPDocFileForSource(const SrcFilename: string;
250 out NewOwner: TObject): string;
CreateFPDocFilenull251 function CreateFPDocFile(const ExpandedFilename, PackageName,
252 ModuleName: string): TCodeBuffer;
253 public
254 constructor Create(TheOwner: TComponent); override;
255 destructor Destroy; override;
256 procedure FreeDocs;
257 procedure ClearSrcToDocMap;
258
FindFPDocFilenull259 function FindFPDocFile(const Filename: string): TLazFPDocFile;
LoadFPDocFilenull260 function LoadFPDocFile(const Filename: string;
261 Flags: TCodeHelpOpenFileFlags;
262 out ADocFile: TLazFPDocFile;
263 out CacheWasUsed: boolean): TCodeHelpParseResult;
SaveFPDocFilenull264 function SaveFPDocFile(ADocFile: TLazFPDocFile): TModalResult;
GetFPDocFilenameForHelpContextnull265 function GetFPDocFilenameForHelpContext(
266 Context: TPascalHelpContextList;
267 out CacheWasUsed: boolean): string;
GetFPDocFilenameForSourcenull268 function GetFPDocFilenameForSource(SrcFilename: string;
269 ResolveIncludeFiles: Boolean;
270 out CacheWasUsed: boolean;
271 out AnOwner: TObject;// a package or a project or LazarusHelp or nil for user defined
272 CreateIfNotExists: boolean = false): string;
273 procedure GetFPDocFilenamesForSources(SrcFilenames: TFilenameToStringTree;
274 ResolveIncludeFiles: boolean;
275 var FPDocFilenames: TFilenameToStringTree // Filename to ModuleName
276 );
GetIDESrcFPDocPathnull277 function GetIDESrcFPDocPath: string; // $(LazarusDir)/docs/xml/ide/
IsIDESrcFilenull278 function IsIDESrcFile(const SrcFilename: string): boolean;
FindFPDocPackageOwnernull279 function FindFPDocPackageOwner(const PackageName: string): TObject;
FindModuleOwnernull280 function FindModuleOwner(FPDocFile: TLazFPDocFile): TObject;
GetModuleOwnerNamenull281 function GetModuleOwnerName(TheOwner: TObject): string;
GetFPDocPackageNameByOwnernull282 function GetFPDocPackageNameByOwner(TheOwner: TObject): string;
ExpandFPDocLinkIDnull283 function ExpandFPDocLinkID(const LinkID, DefaultUnitName,
284 DefaultOwnerName: string): string;
ExpandFPDocLinkIDnull285 function ExpandFPDocLinkID(const LinkID, DefaultUnitName: string;
286 TheOwner: TObject): string;
CodeNodeToElementNamenull287 function CodeNodeToElementName(Tool: TFindDeclarationTool;
288 CodeNode: TCodeTreeNode): string;
GetFPDocNodenull289 function GetFPDocNode(Tool: TCodeTool; CodeNode: TCodeTreeNode; Complete: boolean;
290 out FPDocFile: TLazFPDocFile; out DOMNode: TDOMNode;
291 out CacheWasUsed: boolean): TCodeHelpParseResult;
GetLinkedFPDocNodenull292 function GetLinkedFPDocNode(StartFPDocFile: TLazFPDocFile;
293 StartDOMNode: TDOMNode;
294 const Path: string;
295 Flags: TCodeHelpOpenFileFlags;
296 out ModuleOwner: TObject;
297 out FPDocFile: TLazFPDocFile; out DOMNode: TDOMNode;
298 out InvalidPath: integer;
299 out CacheWasUsed: boolean): TCodeHelpParseResult;
GetDeclarationChainnull300 function GetDeclarationChain(Code: TCodeBuffer; X, Y: integer;
301 out ListOfPCodeXYPosition: TFPList;
302 out CacheWasUsed: boolean): TCodeHelpParseResult;
GetCodeContextnull303 function GetCodeContext(CodePos: PCodeXYPosition;
304 out FindContext: TFindContext;
305 {%H-}Complete: boolean;
306 out CacheWasUsed: boolean): TCodeHelpParseResult;
GetElementChainnull307 function GetElementChain(Code: TCodeBuffer; X, Y: integer; Complete: boolean;
308 out Chain: TCodeHelpElementChain;
309 out CacheWasUsed: boolean): TCodeHelpParseResult;
GetHTMLHintnull310 function GetHTMLHint(Code: TCodeBuffer; X, Y: integer; Options: TCodeHelpHintOptions;
311 out BaseURL, HTMLHint, PropDetails: string;
312 out CacheWasUsed: boolean): TCodeHelpParseResult;
GetHTMLHintForNodenull313 function GetHTMLHintForNode(CTTool: TFindDeclarationTool; CTNode: TCodeTreeNode;
314 XYPos: TCodeXYPosition; Options: TCodeHelpHintOptions;
315 out BaseURL, HTMLHint: string;
316 out CacheWasUsed: boolean): TCodeHelpParseResult;
GetHTMLHintForExprnull317 function GetHTMLHintForExpr(CTExprType: TExpressionType;
318 XYPos: TCodeXYPosition; Options: TCodeHelpHintOptions;
319 out BaseURL, HTMLHint: string;
320 out CacheWasUsed: boolean): TCodeHelpParseResult;
GetHTMLHintForUnitnull321 function GetHTMLHintForUnit(AUnitName, InFilename: string; BaseDir: string;
322 Options: TCodeHelpHintOptions;
323 out BaseURL, HTMLHint: string;
324 out CacheWasUsed: boolean): TCodeHelpParseResult;
GetHTMLDeclarationHeadernull325 function GetHTMLDeclarationHeader(Tool: TFindDeclarationTool;
326 Node: TCodeTreeNode; XYPos: TCodeXYPosition): string;
GetHTMLDeclarationHeadernull327 function GetHTMLDeclarationHeader(Tool: TFindDeclarationTool;
328 Node: TCodeTreeNode; Desc: TExpressionTypeDesc; XYPos: TCodeXYPosition): string;
GetPasDocCommentsAsHTMLnull329 function GetPasDocCommentsAsHTML(Tool: TFindDeclarationTool; Node: TCodeTreeNode): string;
GetFPDocNodeAsHTMLnull330 function GetFPDocNodeAsHTML(FPDocFile: TLazFPDocFile; DOMNode: TDOMNode): string;
TextToHTMLnull331 function TextToHTML(Txt: string): string;
CreateElementnull332 function CreateElement(Code: TCodeBuffer; X, Y: integer;
333 out Element: TCodeHelpElement): Boolean;
SourceToFPDocHintnull334 function SourceToFPDocHint(Src: string; NestedComments: boolean = true): string;
SourcePosToFPDocHintnull335 function SourcePosToFPDocHint(XYPos: TCodeXYPosition; Caption: string=''): string;
SourcePosToFPDocHintnull336 function SourcePosToFPDocHint(const aFilename: string; X,Y: integer;
337 Caption: string=''): string;
OwnerToFPDocHintnull338 function OwnerToFPDocHint(AnOwner: TObject): string;
FPDocLinkToURLnull339 function FPDocLinkToURL(FPDocFile: TLazFPDocFile; const LinkID: string): string;
340 public
341 // Event lists
342 procedure RemoveAllHandlersOfObject(AnObject: TObject);
343 procedure AddHandlerOnChanging(const OnDocChangingEvent: TCodeHelpChangeEvent;
344 AsLast: boolean = false);
345 procedure RemoveHandlerOnChanging(const OnDocChangingEvent: TCodeHelpChangeEvent);
346 procedure AddHandlerOnChanged(const OnDocChangedEvent: TCodeHelpChangeEvent;
347 AsLast: boolean = false);
348 procedure RemoveHandlerOnChanged(const OnDocChangedEvent: TCodeHelpChangeEvent);
349 public
350 property PasHighlighter: TSynPasSyn read FPasHighlighter;
351 end;
352
353 TFPDocHintToken = (
354 fpdhtText,
355 fpdhtKeyword,
356 fpdhtString,
357 fpdhtNumber,
358 fpdhtSymbol
359 );
360 TFPDocHintTokens = set of TFPDocHintToken;
361
362 var
363 CodeHelpBoss: TCodeHelpManager = nil;// set by the IDE
364
CompareLazFPDocFilenamesnull365 function CompareLazFPDocFilenames(Data1, Data2: Pointer): integer;
CompareAnsistringWithLazFPDocFilenull366 function CompareAnsistringWithLazFPDocFile(Key, Data: Pointer): integer;
CompareLDSrc2DocSrcFilenamesnull367 function CompareLDSrc2DocSrcFilenames(Data1, Data2: Pointer): integer;
CompareAnsistringWithLDSrc2DocSrcFilenull368 function CompareAnsistringWithLDSrc2DocSrcFile(Key, Data: Pointer): integer;
369
ToUnixLineEndingnull370 function ToUnixLineEnding(const s: String): String;
ToOSLineEndingnull371 function ToOSLineEnding(const s: String): String;
ReplaceLineEndingsnull372 function ReplaceLineEndings(const s, NewLineEnds: string): string;
AppendLineEndingnull373 function AppendLineEnding(const s: string): string; // append if not empty and there is not already a line ending
XMLUnescapenull374 function XMLUnescape(s: string): string; // convert escape characters
MakeValidFPDocPackageNamenull375 function MakeValidFPDocPackageName(const s: string): string;
376
377 implementation
378
ToUnixLineEndingnull379 function ToUnixLineEnding(const s: String): String;
380 var
381 p: Integer;
382 begin
383 Result:=s;
384 p:=1;
385 while (p<=length(Result)) do begin
386 case Result[p] of
387 #10:
388 if (p<length(Result)) and (Result[p+1] in [#10,#13])
389 and (Result[p]<>Result[p+1]) then begin
390 // double character line ending
391 System.Delete(Result,p,2);
392 end;
393 #13:
394 begin
395 // single char line ending #13
396 Result[p]:=#10;
397 end;
398 end;
399 inc(p);
400 end;
401 end;
402
ToOSLineEndingnull403 function ToOSLineEnding(const s: String): String;
404 const
405 le: shortstring = LineEnding;
406 var
407 p: Integer;
408 begin
409 Result:=s;
410 p:=1;
411 while (p<=length(Result)) do begin
412 if not (Result[p] in [#10,#13]) then begin
413 inc(p);
414 end else begin
415 // line ending
416 if (p<length(Result)) and (Result[p+1] in [#10,#13]) and (Result[p]<>Result[p+1]) then begin
417 // double character line ending
418 if (length(le)<>2)
419 or (le[1]<>Result[p]) or (le[2]<>Result[p+1]) then begin
420 Result:=copy(Result,1,p-1)+le+copy(Result,p+2,length(Result));
421 inc(p, length(le)-1);
422 end
423 else
424 inc(p);
425 end else begin
426 // single char line ending #13 or #10
427 if (length(le)<>1)
428 or (le[1]<>Result[p]) then begin
429 Result:=copy(Result,1,p-1)+le+copy(Result,p+1,length(Result));
430 inc(p, length(le)-1);
431 end;
432 end;
433 inc(p);
434 end;
435 end;
436 end;
437
ReplaceLineEndingsnull438 function ReplaceLineEndings(const s, NewLineEnds: string): string;
439 var
440 p: Integer;
441 StartPos: LongInt;
442 begin
443 Result:=s;
444 p:=1;
445 while (p<=length(Result)) do begin
446 if Result[p] in [#10,#13] then begin
447 StartPos:=p;
448 if (p<length(Result))
449 and (Result[p+1] in [#10,#13]) and (Result[p]<>Result[p+1]) then
450 inc(p);
451 Result:=copy(Result,1,StartPos-1)+NewLineEnds+copy(Result,p+1,length(Result));
452 inc(p,length(NewLineEnds));
453 end else begin
454 inc(p);
455 end;
456 end;
457 end;
458
AppendLineEndingnull459 function AppendLineEnding(const s: string): string;
460 begin
461 Result:=s;
462 if (Result='') or (Result[length(Result)] in [#10,#13]) then exit;
463 Result:=Result+LineEnding;
464 end;
465
XMLUnescapenull466 function XMLUnescape(s: string): string;
467 var
468 p: PChar;
469
470 procedure Replace(StartPos: PChar; const NewTxt: string);
471 var
472 RelStartP: PtrInt;
473 begin
474 RelStartP:=StartPos-PChar(s);
475 s:=copy(s,1,RelStartP)+NewTxt+copy(s,p-PChar(s)+1,length(s));
476 p:=PChar(s)+RelStartP+length(NewTxt);
477 end;
478
479 var
480 StartPos: PChar;
481 i: Integer;
482 CurChar: String;
483 begin
484 if s='' then exit('');
485 p:=PChar(s);
486 repeat
487 if (p^=#0) and (p-PChar(s)>=length(s)) then
488 break
489 else if p^='&' then begin
490 StartPos:=p;
491 CurChar:='';
492 case p[1] of
493 '0'..'9':
494 begin
495 // decimal number
496 i:=0;
497 while p^ in ['0'..'9'] do
498 begin
499 if i>=0 then
500 i:=i+10+ord(p^)-ord('0');
501 if i>$10FFFF then
502 i:=-1;
503 inc(p);
504 end;
505 if i>=0 then
506 CurChar:=UnicodeToUTF8(i);
507 end;
508 'a'..'z','A'..'Z':
509 begin
510 // name
511 inc(p);
512 while not (p^ in [';',#0]) do inc(p);
513 if p^=';' then begin
514 if CompareIdentifiers(StartPos+1,'amp')=0 then
515 CurChar:='&'
516 else if CompareIdentifiers(StartPos+1,'quot')=0 then
517 CurChar:='"'
518 else if CompareIdentifiers(StartPos+1,'apos')=0 then
519 CurChar:=''''
520 else if CompareIdentifiers(StartPos+1,'lt')=0 then
521 CurChar:='<'
522 else if CompareIdentifiers(StartPos+1,'gt')=0 then
523 CurChar:='>';
524 end;
525 end;
526 end;
527 while not (p^ in [';',#0]) do inc(p);
528 if p^=';' then inc(p);
529 Replace(StartPos,CurChar);
530 end else
531 inc(p);
532 until false;
533 Result:=s;
534 end;
535
MakeValidFPDocPackageNamenull536 function MakeValidFPDocPackageName(const s: string): string;
537 var
538 i: Integer;
539 begin
540 Result:=s;
541 for i:=length(Result) downto 1 do
542 if not (Result[i] in ['a'..'z','A'..'Z','0'..'9','_',' ',',','+','-','/','(',')'])
543 then
544 system.Delete(Result,i,1);
545 end;
546
CompareLazFPDocFilenamesnull547 function CompareLazFPDocFilenames(Data1, Data2: Pointer): integer;
548 begin
549 Result:=CompareFilenames(TLazFPDocFile(Data1).Filename,
550 TLazFPDocFile(Data2).Filename);
551 end;
552
CompareAnsistringWithLazFPDocFilenull553 function CompareAnsistringWithLazFPDocFile(Key, Data: Pointer): integer;
554 begin
555 Result:=CompareFilenames(AnsiString(Key),TLazFPDocFile(Data).Filename);
556 end;
557
CompareLDSrc2DocSrcFilenamesnull558 function CompareLDSrc2DocSrcFilenames(Data1, Data2: Pointer): integer;
559 begin
560 Result:=CompareFilenames(TCHSourceToFPDocFile(Data1).SourceFilename,
561 TCHSourceToFPDocFile(Data2).SourceFilename);
562 end;
563
CompareAnsistringWithLDSrc2DocSrcFilenull564 function CompareAnsistringWithLDSrc2DocSrcFile(Key, Data: Pointer): integer;
565 begin
566 Result:=CompareFilenames(AnsiString(Key),TCHSourceToFPDocFile(Data).SourceFilename);
567 end;
568
569 { TCHSourceToFPDocFile }
570
TCHSourceToFPDocFile.IsValidnull571 function TCHSourceToFPDocFile.IsValid: boolean;
572 begin
573 Result:=(FPDocFilenameTimeStamp=CompilerParseStamp)
574 and (FilesTimeStamp=FileStateCache.TimeStamp)
575 end;
576
577 procedure TCHSourceToFPDocFile.MakeValid;
578 begin
579 FPDocFilenameTimeStamp:=CompilerParseStamp;
580 FilesTimeStamp:=FileStateCache.TimeStamp;
581 end;
582
583 { TLazFPDocFile }
584
GetDocModifiednull585 function TLazFPDocFile.GetDocModified: boolean;
586 begin
587 Result:=FDocSaveChangeStamp<>FDocChangeStamp;
588 end;
589
590 procedure TLazFPDocFile.SetDocModified(AValue: boolean);
591 begin
592 if AValue then
593 CTIncreaseChangeStamp64(FDocChangeStamp)
594 else
595 FDocSaveChangeStamp:=FDocChangeStamp;
596 end;
597
598 constructor TLazFPDocFile.Create;
599 begin
600 FDocChangeStamp:=CTInvalidChangeStamp64;
601 FDocSaveChangeStamp:=CTInvalidChangeStamp64;
602 end;
603
604 destructor TLazFPDocFile.Destroy;
605 begin
606 FreeAndNil(Doc);
607 inherited Destroy;
608 end;
609
TLazFPDocFile.GetPackageNodenull610 function TLazFPDocFile.GetPackageNode: TDOMNode;
611 begin
612 Result:=nil;
613 if Doc=nil then exit;
614
615 // get first node
616 Result := Doc.FindNode('fpdoc-descriptions');
617 if Result=nil then begin
618 //DebugLn(['TLazFPDocFile.GetPackageNode fpdoc-descriptions not found']);
619 exit;
620 end;
621
622 // proceed to package
623 Result := Result.FindNode('package');
624 end;
625
TLazFPDocFile.GetPackageNamenull626 function TLazFPDocFile.GetPackageName: string;
627 var
628 Node: TDOMNode;
629 begin
630 Node:=GetPackageNode;
631 if Node is TDOMElement then
632 Result:=TDomElement(Node).GetAttribute('name')
633 else
634 Result:='';
635 end;
636
TLazFPDocFile.GetModuleNodenull637 function TLazFPDocFile.GetModuleNode: TDOMNode;
638 begin
639 Result:=GetPackageNode;
640 if Result=nil then begin
641 //DebugLn(['TLazFPDocFile.GetModuleNode fpdoc-descriptions has no package']);
642 exit;
643 end;
644
645 // proceed to module
646 Result := Result.FindNode('module');
647 end;
648
TLazFPDocFile.GetModuleNamenull649 function TLazFPDocFile.GetModuleName: string;
650 var
651 Node: TDOMNode;
652 begin
653 Node:=GetModuleNode;
654 if Node is TDOMElement then
655 Result:=TDomElement(Node).GetAttribute('name')
656 else
657 Result:='';
658 end;
659
GetModuleTopicCountnull660 function TLazFPDocFile.GetModuleTopicCount: Integer;
661 var
662 Node: TDOMNode;
663 begin
664 Result := 0;
665 Node := GetModuleNode;
666 if Node = nil then exit;
667 Node := Node.FirstChild;
668 while (Node <> nil) do begin
669 if (Node.NodeName = 'topic') then inc(result);
670 Node := Node.NextSibling;
671 end;
672 end;
673
TLazFPDocFile.GetModuleTopicNamenull674 function TLazFPDocFile.GetModuleTopicName(Index: Integer): String;
675 var
676 Node: TDOMNode;
677 begin
678 Result := '';
679 Node := GetModuleNode;
680 if Node = nil then exit;
681 Node := Node.FirstChild;
682 while (Node <> nil) and (Index >= 0) do begin
683 if (Node.NodeName = 'topic') and (Node is TDomElement) then begin
684 if Index = 0 then begin
685 Result := TDomElement(Node).GetAttribute('name');
686 exit;
687 end;
688 dec(Index);
689 end;
690 Node := Node.NextSibling;
691 end;
692 end;
693
GetModuleTopicnull694 function TLazFPDocFile.GetModuleTopic(Name: String): TDOMNode;
695 begin
696 Result := GetModuleNode;
697 if Result = nil then exit(nil);
698 Result := Result.FirstChild;
699 while (Result <> nil) do begin
700 if (Result.NodeName = 'topic') and (Result is TDomElement) and
701 (CompareTextIgnoringSpace(TDomElement(Result).GetAttribute('name'), Name,false) = 0)
702 then
703 exit;
704 Result := Result.NextSibling;
705 end;
706 end;
707
CreateModuleTopicnull708 function TLazFPDocFile.CreateModuleTopic(Name: String): TDOMNode;
709 var
710 ModuleNode: TDOMNode;
711 begin
712 ModuleNode := GetModuleNode;
713 if ModuleNode = nil then exit(nil);
714
715 DocChanging;
716 try
717 Result:=Doc.CreateElement('topic');
718 TDOMElement(Result).SetAttribute('name', Name);
719 ModuleNode.AppendChild(Result);
720 finally
721 DocChanged;
722 end;
723 end;
724
GetFirstElementnull725 function TLazFPDocFile.GetFirstElement: TDOMNode;
726 begin
727 //get first module node
728 Result := GetModuleNode;
729 //DebugLn(['TLazFPDocFile.GetFirstElement GetModuleNode=',GetModuleNode<>nil]);
730 if Result=nil then exit;
731
732 //proceed to element
733 Result := Result.FirstChild;
734 while (Result<>nil) and (Result.NodeName <> 'element') do
735 Result := Result.NextSibling;
736 end;
737
TLazFPDocFile.GetElementWithNamenull738 function TLazFPDocFile.GetElementWithName(const ElementName: string;
739 CreateIfNotExists: boolean): TDOMNode;
740 var
741 ModuleNode: TDOMNode;
742 begin
743 Result:=nil;
744 // get first module node
745 ModuleNode:=GetModuleNode;
746 if ModuleNode=nil then begin
747 if CreateIfNotExists then
748 DebugLn(['TLazFPDocFile.GetElementWithName create failed: missing module name. ElementName=',ElementName]);
749 exit;
750 end;
751 // check module name
752 if (ModuleNode is TDomElement)
753 and (CompareTextIgnoringSpace(TDomElement(ModuleNode).GetAttribute('name'),ElementName,false)=0)
754 then begin
755 exit(ModuleNode);
756 end;
757 // check elements
758 Result:=GetFirstElement;
759 //DebugLn(['TLazFPDocFile.GetElementWithName ',ElementName,' GetFirstElement=',GetFirstElement<>nil]);
760 while Result<>nil do begin
761 //DebugLn(['TLazFPDocFile.GetElementWithName ',dbgsName(Result)]);
762 //if Result is TDomElement then DebugLn(['TLazFPDocFile.GetElementWithName ',TDomElement(Result).GetAttribute('name')]);
763 if (Result is TDomElement)
764 and (CompareTextIgnoringSpace(TDomElement(Result).GetAttribute('name'),ElementName,false)=0)
765 then
766 exit;
767 Result:=Result.NextSibling;
768 end;
769 if (Result=nil) and CreateIfNotExists then begin
770 DebugLn(['TLazFPDocFile.GetElementWithName creating ',ElementName]);
771 DocChanging;
772 try
773 Result:=Doc.CreateElement('element');
774 TDOMElement(Result).SetAttribute('name',ElementName);
775 ModuleNode.AppendChild(Result);
776 finally
777 DocChanged;
778 end;
779 end;
780 end;
781
TLazFPDocFile.GetChildValuesAsStringnull782 function TLazFPDocFile.GetChildValuesAsString(Node: TDOMNode): String;
783
784 procedure FindEndOfTag(const Src: string; var EndPos: integer);
785 begin
786 while (EndPos<=length(Src)) do begin
787 if (Src[EndPos]='>') then begin
788 inc(EndPos);
789 exit;
790 end else if Src[EndPos]='"' then begin
791 repeat
792 inc(EndPos);
793 until (EndPos>=length(Src)) or (Src[EndPos]='"');
794 end;
795 inc(EndPos);
796 end;
797 end;
798
799 var
800 MemStream: TMemoryStream;
801 StartPos: Integer;
802 EndPos: Integer;
803 begin
804 Result:='';
805 MemStream:=TMemoryStream.Create;
806 try
807 // write node with children
808 WriteXML(Node,MemStream);
809 MemStream.Position:=0;
810 SetLength(Result,MemStream.Size);
811 if Result<>'' then
812 MemStream.Read(Result[1],length(Result));
813 // remove enclosing tag(s) for Node, because Result should only
814 // contain the child values:
815 // <nodename/> or <nodename>...<nodename/>
816 // <nodename something=""/>
817 // plus line ends
818 StartPos:=1;
819 EndPos:=length(Result)+1;
820 // skip start tag and spaces at start
821 while (StartPos<=length(Result))
822 and (Result[StartPos] in [' ',#9,#10,#13]) do
823 inc(StartPos);
824 if (StartPos<=length(Result)) and (Result[StartPos]='<') then begin
825 inc(StartPos);
826 FindEndOfTag(Result,StartPos);
827 while (StartPos<=length(Result))
828 and (Result[StartPos] in [' ',#9,#10,#13]) do
829 inc(StartPos);
830 end;
831 // skip ending line ends and spaces at end
832 while (EndPos>StartPos) and (Result[EndPos-1] in [' ',#9,#10,#13]) do
833 dec(EndPos);
834 // skip end tag
835 if (EndPos>StartPos) and (Result[EndPos-1]='>') then begin
836 repeat
837 dec(EndPos);
838 if (EndPos=StartPos) then break;
839 if (Result[EndPos-1]='"') then begin
840 repeat
841 dec(EndPos);
842 until (EndPos=StartPos) or (Result[EndPos]='"');
843 end else if (Result[EndPos-1]='<') then begin
844 dec(EndPos);
845 break;
846 end;
847 until false;
848 while (EndPos>StartPos) and (Result[EndPos-1] in [' ',#9,#10,#13]) do
849 dec(EndPos);
850 end;
851 Result:=copy(Result,StartPos,EndPos-StartPos);
852
853 // the xml writer adds/removes spaces/new lines automatically
854 // add newlines after br and p tags
855 StartPos:=1;
856 while StartPos<length(Result) do begin
857 if Result[StartPos]='<' then begin
858 // search end of tag
859 EndPos:=StartPos+1;
860 FindEndOfTag(Result,EndPos);
861 if Result[StartPos+1]='/' then
862 inc(StartPos);
863 if (CompareIdentifiers(@Result[StartPos+1],'br')=0)
864 or (CompareIdentifiers(@Result[StartPos+1],'p')=0) then
865 begin
866 // add new line
867 if (EndPos <= Length(Result)) and not (Result[EndPos] in [#10,#13]) then
868 Result:=copy(Result,1,EndPos-1)+LineEnding+copy(Result,EndPos,length(Result));
869 end;
870 StartPos:=EndPos;
871 end else begin
872 inc(StartPos);
873 end;
874 end;
875 finally
876 MemStream.Free;
877 end;
878 {$ifdef VerboseCodeHelp}
879 if Result<>'' then
880 DebugLn(['TLazFPDocFile.GetChildValuesAsString Node=',Node.NodeName,' Result=',Result]);
881 {$endif}
882 end;
883
GetValuesFromNodenull884 function TLazFPDocFile.GetValuesFromNode(Node: TDOMNode): TFPDocElementValues;
tonull885 // simple function to return the values as string
886 var
887 S: String;
888 i: TFPDocItem;
889 begin
890 //DebugLn(['TLazFPDocFile.GetValuesFromNode ',Node.NodeName,' ',dbgsName(Node),' ',Node is TDomElement]);
891 for i in TFPDocItem do
892 Result[i] := '';
893 if Node is TDomElement then
894 Result[fpdiElementLink] := TDomElement(Node).GetAttribute('link');
895 Node := Node.FirstChild;
896 while Assigned(Node) do
897 begin
898 if (Node.NodeType = ELEMENT_NODE) then
899 begin
900 S := Node.NodeName;
901 if S = FPDocItemNames[fpdiShort] then
902 Result[fpdiShort] := GetChildValuesAsString(Node);
903
904 if S = FPDocItemNames[fpdiDescription] then
905 Result[fpdiDescription] := GetChildValuesAsString(Node);
906
907 if S = FPDocItemNames[fpdiErrors] then
908 Result[fpdiErrors] := GetChildValuesAsString(Node);
909
910 if S = FPDocItemNames[fpdiSeeAlso] then
911 Result[fpdiSeeAlso] := GetChildValuesAsString(Node);
912
913 if S = FPDocItemNames[fpdiExample] then
914 Result[fpdiExample] := Node.Attributes.GetNamedItem('file').NodeValue;
915 end;
916 Node := Node.NextSibling;
917 end;
918 end;
919
GetValueFromNodenull920 function TLazFPDocFile.GetValueFromNode(Node: TDOMNode; Item: TFPDocItem): string;
921 var
922 Child: TDOMNode;
923 begin
924 Result:='';
925 Child:=Node.FindNode(FPDocItemNames[Item]);
926 //DebugLn(['TLazFPDocFile.GetValueFromNode ',FPDocItemNames[Item],' Found=',Child<>nil]);
927 if Child<>nil then begin
928 if Item=fpdiExample then
929 Result := Child.Attributes.GetNamedItem('file').NodeValue
930 else
931 Result := GetChildValuesAsString(Child);
932 end;
933 end;
934
935 procedure TLazFPDocFile.SetChildValue(Node: TDOMNode; const ChildName: string;
936 NewValue: string);
937
938 procedure ReadXMLFragmentFromString(AParentNode: TDOMNode; const s: string);
939 var
940 MemStream: TStream;
941 begin
942 if s='' then exit;
943 try
944 MemStream:=TMemoryStream.Create;
945 MemStream.Write(s[1],length(s));
946 MemStream.Position:=0;
947 ReadXMLFragment(AParentNode,MemStream);
948 finally
949 MemStream.Free;
950 end;
951 end;
952
953 var
954 Child: TDOMNode;
955 FileAttribute, LinkAttribute: TDOMAttr;
956 begin
957 NewValue:=ToOSLineEnding(NewValue);
958 if ChildName=FPDocItemNames[fpdiElementLink] then begin
959 // update attribute
960 if Node is TDomElement then begin
961 LinkAttribute:=TDomElement(Node).GetAttributeNode('link');
962 if ((NewValue='') and (LinkAttribute<>nil))
963 or ((NewValue<>'') and ((LinkAttribute=nil) or (LinkAttribute.NodeValue<>NewValue)))
964 then begin
965 // delete, add or change attribute 'link'
966 DebugLn(['TLazFPDocFile.SetChildValue Changing link Name=',ChildName,' NewValue="',NewValue,'"']);
967 DocChanging;
968 try
969 if NewValue='' then begin
970 TDomElement(Node).RemoveAttributeNode(LinkAttribute);
971 LinkAttribute.Free;
972 end else
973 TDomElement(Node).SetAttribute('link',NewValue);
974 finally
975 DocChanged;
976 end;
977 end;
978 end;
979 end else begin
980 // update sub node
981 Child:=Node.FindNode(ChildName);
982 if ChildName = FPDocItemNames[fpdiExample] then begin
983 // update sub node example, attribute file
984 NewValue:=FilenameToURLPath(NewValue);
985 FileAttribute:=nil;
986 if Child is TDomElement then
987 FileAttribute:=TDomElement(Child).GetAttributeNode('file');
988 if ((NewValue='') and (FileAttribute<>nil))
989 or ((NewValue<>'') and ((FileAttribute=nil) or (FileAttribute.NodeValue<>NewValue)))
990 then begin
991 // delete, add or change attribute 'file'
992 DebugLn(['TLazFPDocFile.SetChildValue Changing example file Name=',ChildName,' NewValue="',NewValue,'"']);
993 DocChanging;
994 try
995 if NewValue='' then begin
996 // remove old content
997 while Child.LastChild<>nil do
998 Child.RemoveChild(Child.LastChild);
999 Node.RemoveChild(Child);
1000 end else begin
1001 if Child=nil then begin
1002 Child := Doc.CreateElement(ChildName);
1003 Node.AppendChild(Child);
1004 end;
1005 TDomElement(Child).SetAttribute('file',NewValue);
1006 end;
1007 finally
1008 DocChanged;
1009 end;
1010 end;
1011 end else begin
1012 if Child=nil then begin
1013 // add node
1014 if NewValue<>'' then begin
1015 DebugLn(['TLazFPDocFile.SetChildValue Adding Name=',ChildName,' NewValue="',NewValue,'"']);
1016 DocChanging;
1017 try
1018 Child := Doc.CreateElement(ChildName);
1019 Node.AppendChild(Child);
1020 ReadXMLFragmentFromString(Child,NewValue);
1021 finally
1022 DocChanged;
1023 end;
1024 end;
1025 end else if GetChildValuesAsString(Child)<>NewValue then begin
1026 // change node
1027 DocChanging;
1028 try
1029 DebugLn(['TLazFPDocFile.SetChildValue Changing ',Node.NodeName,
1030 ' ChildName=',Child.NodeName,
1031 ' OldValue=',GetChildValuesAsString(Child),
1032 ' NewValue="',NewValue,'"']);
1033 // remove old content
1034 while Child.LastChild<>nil do
1035 Child.RemoveChild(Child.LastChild);
1036 if NewValue='' then begin
1037 // remove entire child
1038 Node.RemoveChild(Child);
1039 end else begin
1040 // set new content
1041 ReadXMLFragmentFromString(Child,NewValue);
1042 end;
1043 finally
1044 DocChanged;
1045 end;
1046 end;
1047 end;
1048 end;
1049 end;
1050
1051 procedure TLazFPDocFile.DocChanging;
1052 begin
1053 if (ldffDocChangingCalled in FFlags) then exit;
1054 DocModified:=true;
1055 Include(FFlags,ldffDocChangingCalled);
1056 CodeHelpBoss.CallDocChangeEvents(chmhDocChanging,Self);
1057 end;
1058
1059 procedure TLazFPDocFile.DocChanged;
1060 begin
1061 if not (ldffDocChangingCalled in FFlags) then
1062 raise Exception.Create('TLazFPDocFile.DocChanged missing call to DocChanging');
1063 if (fUpdateLock>0) then begin
1064 Include(FFlags,ldffDocChangedNeedsCalling);
1065 exit;
1066 end;
1067 Exclude(FFlags,ldffDocChangedNeedsCalling);
1068 Exclude(FFlags,ldffDocChangingCalled);
1069 CodeHelpBoss.CallDocChangeEvents(chmhDocChanged,Self);
1070 end;
1071
1072 procedure TLazFPDocFile.BeginUpdate;
1073 begin
1074 inc(fUpdateLock);
1075 end;
1076
1077 procedure TLazFPDocFile.EndUpdate;
1078 begin
1079 dec(fUpdateLock);
1080 if fUpdateLock<0 then RaiseGDBException('TLazFPDocFile.EndUpdate');
1081 if fUpdateLock=0 then begin
1082 if ldffDocChangedNeedsCalling in FFlags then
1083 DocChanged;
1084 end;
1085 end;
1086
1087 procedure TCodeHelpManager.AddHandler(HandlerType: TCodeHelpManagerHandler;
1088 const AMethod: TMethod; AsLast: boolean);
1089 begin
1090 if FHandlers[HandlerType]=nil then
1091 FHandlers[HandlerType]:=TMethodList.Create;
1092 FHandlers[HandlerType].Add(AMethod);
1093 end;
1094
1095 procedure TCodeHelpManager.RemoveHandler(HandlerType: TCodeHelpManagerHandler;
1096 const AMethod: TMethod);
1097 begin
1098 FHandlers[HandlerType].Remove(AMethod);
1099 end;
1100
1101 procedure TCodeHelpManager.FreeHandlers;
1102 var
1103 HandlerType: TCodeHelpManagerHandler;
1104 begin
1105 for HandlerType:=Low(TCodeHelpManagerHandler) to High(TCodeHelpManagerHandler) do
1106 FreeThenNil(FHandlers[HandlerType]);
1107 end;
1108
1109 procedure TCodeHelpManager.CallDocChangeEvents(HandlerType: TCodeHelpManagerHandler;
1110 Doc: TLazFPDocFile);
1111 var
1112 i: LongInt;
1113 begin
1114 i:=FHandlers[HandlerType].Count;
1115 while FHandlers[HandlerType].NextDownIndex(i) do
1116 TCodeHelpChangeEvent(FHandlers[HandlerType].Items[i])(Self,Doc);
1117 end;
1118
TCodeHelpManager.DoCreateFPDocFileForSourcenull1119 function TCodeHelpManager.DoCreateFPDocFileForSource(const SrcFilename: string;
1120 out NewOwner: TObject): string;
1121
1122 procedure CleanUpPkgList(var PkgList: TFPList);
1123 var
1124 i: Integer;
1125 AProject: TLazProject;
1126 BaseDir: String;
1127 APackage: TLazPackage;
1128 begin
1129 if (PkgList=nil) then exit;
1130 for i:=PkgList.Count-1 downto 0 do begin
1131 if TObject(PkgList[i]) is TLazProject then begin
1132 AProject:=TLazProject(PkgList[i]);
1133 BaseDir:=ExtractFilePath(AProject.ProjectInfoFile);
1134 if BaseDir<>'' then continue;
1135 end else if TObject(PkgList[i]) is TLazPackage then begin
1136 APackage:=TLazPackage(PkgList[i]);
1137 BaseDir:=APackage.DirectoryExpanded;
1138 if BaseDir<>'' then continue;
1139 end;
1140 // this owner can not be used
1141 PkgList.Delete(i);
1142 end;
1143 if PkgList.Count=0 then
1144 FreeAndNil(PkgList);
1145
1146 if PkgList.Count>1 then begin
1147 // there are more than one possible owners
1148 DebugLn(['TCodeHelpManager.DoCreateFPDocFileForSource.CleanUpPkgList Warning: overlapping projects/packages']);
1149 end;
1150 end;
1151
SelectNewFPDocPathsnull1152 function SelectNewFPDocPaths(const Title, BaseDir: string): string;
1153 begin
1154 Result:=LazSelectDirectory('Choose FPDoc directory for '+Title,BaseDir);
1155 if (Result<>'') then
1156 Result:=CreateRelativePath(Result,BaseDir);
1157 end;
1158
FindSuitableDirectorynull1159 function FindSuitableDirectory(SearchPath, BaseDir: string; Writable: boolean): string;
1160 var
1161 p: Integer;
1162 begin
1163 //debugln(['FindSuitableDirectory SearchPath="',SearchPath,'"']);
1164 p:=1;
1165 repeat
1166 Result:=GetNextDirectoryInSearchPath(SearchPath,p);
1167 if Result='' then exit;
1168 if not FilenameIsAbsolute(Result) then
1169 Result:=ChompPathDelim(AppendPathDelim(BaseDir)+Result);
1170 //debugln(['FindSuitableDirectory Dir="',Result,'" exists=',DirPathExistsCached(Result),' writable=',DirectoryIsWritableCached(Result)]);
1171 if not DirPathExistsCached(Result) then continue;
1172 if Writable and not DirectoryIsWritableCached(Result) then
1173 continue;
1174 exit;
1175 until false;
1176 end;
1177
1178 var
1179 OwnerList: TFPList;
1180 AProject: TLazProject;
1181 APackage: TLazPackage;
1182 FPDocPaths: String;
1183 FPDocPackageName: String;
1184 NewPath: String;
1185 BaseDir: String;
1186 Code: TCodeBuffer;
1187 CurUnitName: String;
1188 UnitSet: TFPCUnitSetCache;
1189 IsInFPCSrc: Boolean;
1190 AVLNode: TAvlTreeNode;
1191 begin
1192 Result:='';
1193 NewOwner:=nil;
1194 DebugLn(['TCodeHelpManager.DoCreateFPDocFileForSource ',SrcFilename]);
1195 if not FilenameIsAbsolute(SrcFilename) then begin
1196 DebugLn(['TCodeHelpManager.DoCreateFPDocFileForSource failed, because file no absolute: ',SrcFilename]);
1197 exit;
1198 end;
1199
1200 OwnerList:=nil;
1201 try
1202 IsInFPCSrc:=false;
1203 // get all packages owning the file
1204 OwnerList:=PackageEditingInterface.GetOwnersOfUnit(SrcFilename);
1205 CleanUpPkgList(OwnerList);
1206 if (OwnerList=nil) then begin
1207 OwnerList:=PackageEditingInterface.GetPossibleOwnersOfUnit(SrcFilename,
1208 [piosfIncludeSourceDirectories]);
1209 CleanUpPkgList(OwnerList);
1210 end;
1211 if (OwnerList=nil) and IsIDESrcFile(SrcFilename) then begin
1212 OwnerList:=TFPList.Create;
1213 OwnerList.Add(LazarusHelp);
1214 end;
1215 if OwnerList=nil then begin
1216 UnitSet:=CodeToolBoss.GetUnitSetForDirectory(ExtractFilePath(SrcFilename));
1217 if (UnitSet<>nil) and FileIsInPath(SrcFilename,UnitSet.FPCSourceDirectory)
1218 then begin
1219 // in FPC sources
1220 IsInFPCSrc:=true;
1221 BaseDir:=GetCurrentDirUTF8;
1222 FPDocPaths:=EnvironmentOptions.GetParsedFPDocPaths;
1223 FPDocPackageName:='fcl';
1224 NewPath:=CreateRelativePath(SrcFilename,UnitSet.FPCSourceDirectory);
1225 if copy(NewPath,1,4)='rtl'+PathDelim then
1226 FPDocPackageName:='rtl';
1227 end else begin
1228 // no package/project found
1229 IDEMessageDialog(lisProjAddPackageNotFound,
1230 Format(lisLDTheUnitIsNotOwnedBeAnyPackageOrProjectPleaseAddThe, [
1231 SrcFilename, #13, #13]), mtError, [mbCancel]);
1232 exit;
1233 end;
1234 end else begin
1235 NewOwner:=TObject(OwnerList[0]);
1236 if NewOwner is TLazProject then begin
1237 AProject:=TLazProject(NewOwner);
1238 BaseDir:=ExtractFilePath(AProject.ProjectInfoFile);
1239 if AProject.FPDocPaths='' then
1240 AProject.FPDocPaths:=SelectNewFPDocPaths(AProject.GetTitleOrName,BaseDir);
1241 FPDocPaths:=AProject.FPDocPaths;
1242 FPDocPackageName:=GetFPDocPackageNameByOwner(AProject);
1243 end else if NewOwner is TLazPackage then begin
1244 APackage:=TLazPackage(NewOwner);
1245 BaseDir:=APackage.DirectoryExpanded;
1246 if APackage.FPDocPaths='' then
1247 APackage.FPDocPaths:=SelectNewFPDocPaths(APackage.Name,BaseDir);
1248 FPDocPaths:=APackage.FPDocPaths;
1249 FPDocPackageName:=GetFPDocPackageNameByOwner(APackage);
1250 end else if NewOwner=LazarusHelp then begin
1251 // in IDE
1252 BaseDir:=EnvironmentOptions.GetParsedLazarusDirectory;
1253 FPDocPaths:=GetIDESrcFPDocPath;
1254 FPDocPackageName:=IDEProjectName;
1255 end else begin
1256 DebugLn(['TCodeHelpManager.DoCreateFPDocFileForSource unknown owner type ',dbgsName(NewOwner)]);
1257 NewOwner:=nil;
1258 exit;
1259 end;
1260 end;
1261
1262 IDEMacros.CreateAbsoluteSearchPath(FPDocPaths,BaseDir);
1263
1264 // search a writable directory
1265 NewPath:=FindSuitableDirectory(FPDocPaths,BaseDir,true);
1266 if NewPath='' then
1267 NewPath:=FindSuitableDirectory(FPDocPaths,BaseDir,false);
1268 if NewPath='' then begin
1269 // no valid directory found
1270 DebugLn(['TCodeHelpManager.DoCreateFPDocFileForSource FPDocPackageName="',FPDocPackageName,'" FPDocPaths="',FPDocPaths,'" ']);
1271 if IsInFPCSrc then
1272 IDEMessageDialog(lisLDNoValidFPDocPath,
1273 Format(lisTheUnitIsPartOfTheFPCSourcesButTheCorrespondingFpd, [
1274 SrcFilename, #13, #13, FPCDocsRepositoryURL, #13, #13])
1275 , mtError, [mbCancel])
1276 else
1277 IDEMessageDialog(lisLDNoValidFPDocPath,
1278 Format(lisLDDoesNotHaveAnyValidFPDocPathUnableToCreateTheFpdo,
1279 [FPDocPackageName, LineEnding, SrcFilename]),
1280 mtError, [mbCancel]);
1281 exit;
1282 end;
1283 // fpdoc directory found
1284 Result:=AppendPathDelim(NewPath)+lowercase(ExtractFileNameOnly(SrcFilename))+'.xml';
1285 Code:=CodeToolBoss.LoadFile(SrcFilename,true,false);
1286 // get unitname
1287 CurUnitName:=ExtractFileNameOnly(SrcFilename);
1288 if Code<>nil then
1289 CurUnitName:=CodeToolBoss.GetSourceName(Code,false);
1290 // remove cache (source to fpdoc filename)
1291 AVLNode:=FSrcToDocMap.FindKey(Pointer(SrcFilename),
1292 @CompareAnsistringWithLDSrc2DocSrcFile);
1293 if AVLNode<>nil then
1294 FSrcToDocMap.FreeAndDelete(AVLNode);
1295 // create fpdoc file
1296 if CreateFPDocFile(Result,FPDocPackageName,CurUnitName)=nil then
1297 Result:='';
1298 finally
1299 OwnerList.Free;
1300 end;
1301 end;
1302
CreateFPDocFilenull1303 function TCodeHelpManager.CreateFPDocFile(const ExpandedFilename,
1304 PackageName, ModuleName: string): TCodeBuffer;
1305 var
1306 Doc: TXMLDocument;
1307 DescrNode: TDOMElement;
1308 ms: TMemoryStream;
1309 s: string;
1310 ModuleNode: TDOMElement;
1311 PackageNode: TDOMElement;
1312 begin
1313 Result:=nil;
1314 if FileExistsCached(ExpandedFilename) then begin
1315 Result:=CodeToolBoss.LoadFile(ExpandedFilename,true,false);
1316 exit;
1317 end;
1318 Result:=CodeToolBoss.CreateFile(ExpandedFilename);
1319 if Result=nil then begin
1320 IDEMessageDialog(lisUnableToCreateFile,
1321 Format(lisUnableToCreateFile2, [ExpandedFilename]), mtError, [mbCancel]);
1322 exit;
1323 end;
1324
1325 Doc:=nil;
1326 ms:=nil;
1327 try
1328 Doc:=TXMLDocument.Create;
1329 // <fpdoc-descriptions>
1330 DescrNode:=Doc.CreateElement('fpdoc-descriptions');
1331 Doc.AppendChild(DescrNode);
1332 // <package name="packagename">
1333 PackageNode:=Doc.CreateElement('package');
1334 PackageNode.SetAttribute('name',PackageName);
1335 DescrNode.AppendChild(PackageNode);
1336 // <module name="unitname">
1337 ModuleNode:=Doc.CreateElement('module');
1338 ModuleNode.SetAttribute('name',ModuleName);
1339 PackageNode.AppendChild(ModuleNode);
1340 // write the XML to a string
1341 ms:=TMemoryStream.Create;
1342 WriteXMLFile(Doc,ms,[xwfPreserveWhiteSpace]);
1343 ms.Position:=0;
1344 SetLength(s,ms.Size);
1345 if s<>'' then
1346 ms.Read(s[1],length(s));
1347 // copy to codebuffer
1348 //DebugLn(['TCodeHelpManager.CreateFPDocFile ',s]);
1349 Result.Source:=s;
1350 // save file
1351 if SaveCodeBuffer(Result)<>mrOk then
1352 Result:=nil;
1353 finally
1354 ms.Free;
1355 Doc.Free;
1356 end;
1357 end;
1358
1359 constructor TCodeHelpManager.Create(TheOwner: TComponent);
1360 begin
1361 inherited Create(TheOwner);
1362 FDocs:=TAvlTree.Create(@CompareLazFPDocFilenames);
1363 FSrcToDocMap:=TAvlTree.Create(@CompareLDSrc2DocSrcFilenames);
1364 FDeclarationCache:=TDeclarationInheritanceCache.Create(
1365 @CodeToolBoss.FindDeclarationAndOverload,
1366 @CodeToolBoss.GetCodeTreeNodesDeletedStep);
1367 FPasHighlighter:=TSynPasSyn.Create(Self);
1368 end;
1369
1370 destructor TCodeHelpManager.Destroy;
1371 begin
1372 ClearSrcToDocMap;
1373 FreeDocs;
1374 FreeAndNil(FDocs);
1375 FreeAndNil(FSrcToDocMap);
1376 FreeAndNil(FDeclarationCache);
1377 FreeHandlers;
1378 inherited Destroy;
1379 end;
1380
FindFPDocFilenull1381 function TCodeHelpManager.FindFPDocFile(const Filename: string): TLazFPDocFile;
1382 var
1383 Node: TAvlTreeNode;
1384 begin
1385 Node:=FDocs.FindKey(Pointer(Filename),@CompareAnsistringWithLazFPDocFile);
1386 if Node<>nil then
1387 Result:=TLazFPDocFile(Node.Data)
1388 else
1389 Result:=nil;
1390 end;
1391
TCodeHelpManager.LoadFPDocFilenull1392 function TCodeHelpManager.LoadFPDocFile(const Filename: string;
1393 Flags: TCodeHelpOpenFileFlags;
1394 out ADocFile: TLazFPDocFile; out CacheWasUsed: boolean
1395 ): TCodeHelpParseResult;
1396 var
1397 MemStream: TMemoryStream;
1398 CurFilename: String;
1399 begin
1400 Result:=chprFailed;
1401 CacheWasUsed:=true;
1402 ADocFile:=FindFPDocFile(Filename);
1403 if ADocFile=nil then begin
1404 CacheWasUsed:=false;
1405 ADocFile:=TLazFPDocFile.Create;
1406 ADocFile.Filename:=Filename;
1407 FDocs.Add(ADocFile);
1408 end;
1409 ADocFile.CodeBuffer:=CodeToolBoss.LoadFile(Filename,
1410 chofUpdateFromDisk in Flags,chofRevert in Flags);
1411 if ADocFile.CodeBuffer=nil then begin
1412 DebugLn(['TCodeHelpManager.LoadFPDocFile unable to load "',Filename,'"']);
1413 FreeAndNil(ADocFile.Doc);
1414 exit;
1415 end;
1416 if (ADocFile.CodeBufferChangeStep=ADocFile.CodeBuffer.ChangeStep) then begin
1417 // CodeBuffer has not changed
1418 if ADocFile.DocErrorMsg<>'' then begin
1419 if not (chofQuiet in Flags) then begin
1420 // for example: Filename(y,x) Error: description
1421 IDEMessagesWindow.AddCustomMessage(mluError,ADocFile.DocErrorMsg,
1422 ADocFile.CodeBuffer.Filename,0,0,'FPDoc');
1423 end;
1424 // no update needed
1425 exit(chprFailed);
1426 end;
1427 if ADocFile.DocModified and (chofRevert in Flags) then begin
1428 // revert the modifications => rebuild the Doc from the CodeBuffer
1429 end else begin
1430 // no update needed
1431 exit(chprSuccess);
1432 end;
1433 end;
1434 CacheWasUsed:=false;
1435
1436 {$IFDEF VerboseCodeHelp}
1437 DebugLn(['TCodeHelpManager.LoadFPDocFile parsing ',ADocFile.Filename]);
1438 {$ENDIF}
1439 CallDocChangeEvents(chmhDocChanging,ADocFile);
1440
1441 // parse XML
1442 ADocFile.CodeBufferChangeStep:=ADocFile.CodeBuffer.ChangeStep;
1443 ADocFile.DocModified:=false;
1444 ADocFile.DocErrorMsg:='Unknown error';
1445 FreeAndNil(ADocFile.Doc);
1446 CurFilename:=ADocFile.CodeBuffer.Filename;
1447
1448 MemStream:=TMemoryStream.Create;
1449 try
1450 ADocFile.CodeBuffer.SaveToStream(MemStream);
1451 MemStream.Position:=0;
1452 Result:=chprFailed;
1453 try
1454 ReadXMLFile(ADocFile.Doc,MemStream,CurFilename,[xrfPreserveWhiteSpace]);
1455 ADocFile.DocErrorMsg:='';
1456 Result:=chprSuccess;
1457 except
1458 on E: EXMLReadError do begin
1459 ADocFile.DocErrorMsg:=E.Message;
1460 DebugLn(['TCodeHelpManager.LoadFPDocFile ',E.Message]);
1461 if not (chofQuiet in Flags) then begin
1462 // for example: Filename(y,x) Error: description
1463 IDEMessagesWindow.AddCustomMessage(mluError,ADocFile.DocErrorMsg,
1464 CurFilename,0,0,'FPDoc');
1465 end;
1466 end;
1467 on E: Exception do begin
1468 ADocFile.DocErrorMsg:='Error reading xml file "'+CurFilename+'" '+E.Message;
1469 DebugLn(['TCodeHelpManager.LoadFPDocFile '+ADocFile.DocErrorMsg]);
1470 if not (chofQuiet in Flags) then begin
1471 IDEMessageDialog(lisErrorReadingXML,
1472 Format(lisErrorReadingXmlFile, [CurFilename, LineEnding, E.Message]),
1473 mtError, [mbCancel]);
1474 end;
1475 end;
1476 end;
1477 finally
1478 if Result<>chprSuccess then
1479 FreeAndNil(ADocFile.Doc);
1480 MemStream.Free;
1481 CallDocChangeEvents(chmhDocChanging,ADocFile);
1482 end;
1483 end;
1484
TCodeHelpManager.SaveFPDocFilenull1485 function TCodeHelpManager.SaveFPDocFile(ADocFile: TLazFPDocFile): TModalResult;
1486 var
1487 ms: TMemoryStream;
1488 s: string;
1489 begin
1490 if (not ADocFile.DocModified)
1491 and (ADocFile.CodeBufferChangeStep=ADocFile.CodeBuffer.ChangeStep)
1492 and (not ADocFile.CodeBuffer.FileOnDiskNeedsUpdate) then begin
1493 DebugLn(['TCodeHelpManager.SaveFPDocFile no save needed: ',ADocFile.Filename]);
1494 exit(mrOk);
1495 end;
1496 if (ADocFile.Doc=nil) then begin
1497 DebugLn(['TCodeHelpManager.SaveFPDocFile no Doc: ',ADocFile.Filename]);
1498 exit(mrOk);
1499 end;
1500 if not FilenameIsAbsolute(ADocFile.Filename) then begin
1501 DebugLn(['TCodeHelpManager.SaveFPDocFile no expanded filename: ',ADocFile.Filename]);
1502 exit(mrCancel);
1503 end;
1504
1505 // write Doc to xml stream
1506 try
1507 ms:=TMemoryStream.Create;
1508 WriteXMLFile(ADocFile.Doc,ms,[xwfPreserveWhiteSpace]);
1509 ms.Position:=0;
1510 SetLength(s,ms.Size);
1511 if s<>'' then
1512 ms.Read(s[1],length(s));
1513 finally
1514 ms.Free;
1515 end;
1516
1517 // write to CodeBuffer
1518 ADocFile.CodeBuffer.Source:=s;
1519 ADocFile.DocModified:=false;
1520 if ADocFile.CodeBuffer.ChangeStep=ADocFile.CodeBufferChangeStep then begin
1521 // doc was not really modified => do not save to keep file date
1522 DebugLn(['TCodeHelpManager.SaveFPDocFile Doc was not really modified ',ADocFile.Filename]);
1523 exit(mrOk);
1524 end;
1525 ADocFile.CodeBufferChangeStep:=ADocFile.CodeBuffer.ChangeStep;
1526
1527 // write to disk
1528 Result:=SaveCodeBuffer(ADocFile.CodeBuffer);
1529 DebugLn(['TCodeHelpManager.SaveFPDocFile saved ',ADocFile.Filename]);
1530 end;
1531
GetFPDocFilenameForHelpContextnull1532 function TCodeHelpManager.GetFPDocFilenameForHelpContext(
1533 Context: TPascalHelpContextList; out CacheWasUsed: boolean): string;
1534 var
1535 i: Integer;
1536 SrcFilename: String;
1537 AnOwner: TObject;
1538 begin
1539 Result:='';
1540 CacheWasUsed:=true;
1541 if Context=nil then exit;
1542 for i:=0 to Context.Count-1 do begin
1543 if Context.Items[i].Descriptor<>pihcFilename then continue;
1544 SrcFilename:=Context.Items[i].Context;
1545 Result:=GetFPDocFilenameForSource(SrcFilename,true,CacheWasUsed,AnOwner);
1546 exit;
1547 end;
1548 end;
1549
GetFPDocFilenameForSourcenull1550 function TCodeHelpManager.GetFPDocFilenameForSource(SrcFilename: string;
1551 ResolveIncludeFiles: Boolean; out CacheWasUsed: boolean;
1552 out AnOwner: TObject; CreateIfNotExists: boolean): string;
1553 {off $Define VerboseGetFPDocForSrc}
1554 var
1555 FPDocName: String;
1556 SearchedPaths: string;
1557
SearchInPathnull1558 function SearchInPath(Paths: string; const BaseDir: string;
1559 out Filename: string): boolean;
1560 var
1561 CurPath: String;
1562 p: Integer;
1563 begin
1564 Result:=false;
1565 if Paths='' then exit;
1566 {$IFDEF VerboseGetFPDocForSrc}
1567 debugln(['GetFPDocFilenameForSource.SearchInPath unresolved Paths="',Paths,'" BaseDir="',BaseDir,'"']);
1568 {$ENDIF}
1569 if not IDEMacros.CreateAbsoluteSearchPath(Paths,BaseDir) then begin
1570 {$IFDEF VerboseGetFPDocForSrc}
1571 debugln(['GetFPDocFilenameForSource.SearchInPath invalid macro Paths="',Paths,'"']);
1572 {$ENDIF}
1573 exit;
1574 end;
1575 {$IFDEF VerboseGetFPDocForSrc}
1576 debugln(['GetFPDocFilenameForSource.SearchInPath resolved Paths="',Paths,'"']);
1577 {$ENDIF}
1578 if Paths='' then exit;
1579 p:=1;
1580 repeat
1581 CurPath:=GetNextDirectoryInSearchPath(Paths,p);
1582 if CurPath<>'' then begin
1583 CurPath:=CleanAndExpandDirectory(CurPath);
1584 if SearchDirectoryInSearchPath(SearchedPaths,CurPath)<1 then begin
1585 // not yet searched in this directory
1586 SearchedPaths:=SearchedPaths+';'+CurPath;
1587 Filename:=AppendPathDelim(CurPath)+FPDocName;
1588 {$IFDEF VerboseGetFPDocForSrc}
1589 debugln(['GetFPDocFilenameForSource.SearchInPath try file="',Filename,'"']);
1590 {$ENDIF}
1591 if FileExistsCached(Filename) then exit(true);
1592 end;
1593 end;
1594 until p>length(Paths);
1595 Filename:='';
1596 end;
1597
CheckUnitOwnersnull1598 function CheckUnitOwners(CheckSourceDirectories: boolean;
1599 out Filename: string): boolean;
1600 var
1601 PkgList: TFPList;
1602 i: Integer;
1603 APackage: TLazPackage;
1604 BaseDir: String;
1605 AProject: TLazProject;
1606 begin
1607 Result:=false;
1608 Filename:='';
1609 if not FilenameIsAbsolute(SrcFilename) then exit;
1610
1611 if CheckSourceDirectories then begin
1612 PkgList:=PackageEditingInterface.GetPossibleOwnersOfUnit(SrcFilename,[]);
1613 end else begin
1614 PkgList:=PackageEditingInterface.GetOwnersOfUnit(SrcFilename);
1615 end;
1616 // get all packages owning the file
1617 if PkgList=nil then begin
1618 {$IFDEF VerboseGetFPDocForSrc}
1619 debugln(['GetFPDocFilenameForSource.CheckUnitOwners no owner for SrcFile="',SrcFilename,'"']);
1620 {$ENDIF}
1621 exit;
1622 end;
1623 try
1624 for i:=0 to PkgList.Count-1 do begin
1625 {$IFDEF VerboseGetFPDocForSrc}
1626 debugln(['GetFPDocFilenameForSource.CheckUnitOwners owner="',DbgSName(TObject(PkgList[i])),'"']);
1627 {$ENDIF}
1628 if TObject(PkgList[i]) is TLazProject then begin
1629 AProject:=TLazProject(PkgList[i]);
1630 AnOwner:=AProject;
1631 if AProject.FPDocPaths='' then begin
1632 {$IFDEF VerboseGetFPDocForSrc}
1633 debugln(['GetFPDocFilenameForSource.CheckUnitOwners project has no FPDocPaths "',AProject.ProjectInfoFile,'"']);
1634 {$ENDIF}
1635 continue;
1636 end;
1637 BaseDir:=ExtractFilePath(AProject.ProjectInfoFile);
1638 if BaseDir='' then begin
1639 {$IFDEF VerboseGetFPDocForSrc}
1640 debugln(['GetFPDocFilenameForSource.CheckUnitOwners project is virtual "',AProject.ProjectInfoFile,'"']);
1641 {$ENDIF}
1642 continue;
1643 end;
1644 // add fpdoc paths of project
1645 if SearchInPath(AProject.FPDocPaths,BaseDir,Filename) then begin
1646 {$IFDEF VerboseGetFPDocForSrc}
1647 debugln(['GetFPDocFilenameForSource.CheckUnitOwners found in project "',AProject.ProjectInfoFile,'" File="',Filename,'"']);
1648 {$ENDIF}
1649 exit(true);
1650 end;
1651 end else if TObject(PkgList[i]) is TLazPackage then begin
1652 APackage:=TLazPackage(PkgList[i]);
1653 AnOwner:=APackage;
1654 if APackage.FPDocPaths='' then begin
1655 {$IFDEF VerboseGetFPDocForSrc}
1656 debugln(['GetFPDocFilenameForSource.CheckUnitOwners package has no FPDocPaths ',APackage.Name,' "',APackage.Filename,'"']);
1657 {$ENDIF}
1658 continue;
1659 end;
1660 BaseDir:=APackage.Directory;
1661 if BaseDir='' then begin
1662 {$IFDEF VerboseGetFPDocForSrc}
1663 debugln(['GetFPDocFilenameForSource.CheckUnitOwners package is virtual "',APackage.Name,'"']);
1664 {$ENDIF}
1665 continue;
1666 end;
1667 // add fpdoc paths of package
1668 if SearchInPath(APackage.FPDocPaths,BaseDir,Filename) then begin
1669 {$IFDEF VerboseGetFPDocForSrc}
1670 debugln(['GetFPDocFilenameForSource.CheckUnitOwners found in package "',APackage.Filename,'" File="',Filename,'"']);
1671 {$ENDIF}
1672 exit(true);
1673 end;
1674 end;
1675 end;
1676 finally
1677 PkgList.Free;
1678 end;
1679 end;
1680
CheckIfInLazarusnull1681 function CheckIfInLazarus(out Filename: string): boolean;
1682 begin
1683 Result:=false;
1684 Filename:='';
1685 if not FilenameIsAbsolute(SrcFilename) then exit;
1686 // check IDE directories
1687 if IsIDESrcFile(SrcFilename) then begin
1688 AnOwner:=LazarusHelp;
1689 {$IFDEF VerboseGetFPDocForSrc}
1690 debugln(['GetFPDocFilenameForSource.CheckIfInLazarus IsIDESrcFile "',SrcFilename,'"']);
1691 {$ENDIF}
1692 if SearchInPath(GetIDESrcFPDocPath,'',Filename) then begin
1693 {$IFDEF VerboseGetFPDocForSrc}
1694 debugln(['GetFPDocFilenameForSource.CheckIfInLazarus found in IDE "',Filename,'"']);
1695 {$ENDIF}
1696 exit(true);
1697 end;
1698 end;
1699
1700 // finally: check if in user directories
1701 if SearchInPath(EnvironmentOptions.FPDocPaths,'',Filename) then
1702 begin
1703 {$IFDEF VerboseGetFPDocForSrc}
1704 debugln(['GetFPDocFilenameForSource.CheckIfInLazarus found in user files "',Filename,'"']);
1705 {$ENDIF}
1706 AnOwner:=nil;
1707 exit(true);
1708 end;
1709 end;
1710
1711 var
1712 CodeBuf: TCodeBuffer;
1713 AVLNode: TAvlTreeNode;
1714 MapEntry: TCHSourceToFPDocFile;
1715 begin
1716 Result:='';
1717 CacheWasUsed:=true;
1718 AnOwner:=nil;
1719
1720 if ResolveIncludeFiles then begin
1721 CodeBuf:=CodeToolBoss.FindFile(SrcFilename);
1722 if CodeBuf<>nil then begin
1723 CodeBuf:=CodeToolBoss.GetMainCode(CodeBuf);
1724 if CodeBuf<>nil then begin
1725 SrcFilename:=CodeBuf.Filename;
1726 end;
1727 end;
1728 end;
1729
1730 if not FilenameIsPascalSource(SrcFilename) then
1731 begin
1732 {$IFDEF VerboseGetFPDocForSrc}
1733 DebugLn(['TCodeHelpManager.GetFPDocFilenameForSource error: not a source file: "',SrcFilename,'"']);
1734 {$ENDIF}
1735 exit;
1736 end;
1737
1738 try
1739 // first try cache
1740 MapEntry:=nil;
1741 AVLNode:=FSrcToDocMap.FindKey(Pointer(SrcFilename),
1742 @CompareAnsistringWithLDSrc2DocSrcFile);
1743 if AVLNode<>nil then begin
1744 MapEntry:=TCHSourceToFPDocFile(AVLNode.Data);
1745 if MapEntry.IsValid then begin
1746 AnOwner:=MapEntry.FPDocFileOwner;
1747 Result:=MapEntry.FPDocFilename;
1748 exit;
1749 end;
1750 end;
1751 CacheWasUsed:=false;
1752
1753 {$IF defined(VerboseCodeHelp) or defined(VerboseGetFPDocForSrc)}
1754 DebugLn(['TCodeHelpManager.GetFPDocFilenameForSource searching SrcFilename=',SrcFilename]);
1755 {$ENDIF}
1756
1757 // first check if the file is owned by any project/package
1758 SearchedPaths:='';
1759 FPDocName:=lowercase(ExtractFileNameOnly(SrcFilename))+'.xml';
1760 if (not CheckUnitOwners(false,Result)) // first check if file is owned by a package/project
1761 and (not CheckUnitOwners(true,Result))// then check if the file is in a source directory of a package/project
1762 and (not CheckIfInLazarus(Result))
1763 then begin
1764 // not found
1765 if AnOwner=nil then
1766 DebugLn(['TCodeHelpManager.GetFPDocFilenameForSource Hint: file without owner: ',SrcFilename])
1767 else if AnOwner is TLazProject then begin
1768 if TLazProject(AnOwner).FPDocPaths='' then
1769 debugln(['TCodeHelpManager.GetFPDocFilenameForSource Hint: Owner (project) has no fpdoc paths: ',SrcFilename])
1770 else
1771 debugln(['TCodeHelpManager.GetFPDocFilenameForSource Hint: Owner (project) has no fpdoc file for: ',SrcFilename])
1772 end else if AnOwner is TLazPackage then begin
1773 if TLazPackage(AnOwner).FPDocPaths='' then
1774 debugln(['TCodeHelpManager.GetFPDocFilenameForSource Hint: Owner (package ',TLazPackage(AnOwner).Name,') has no fpdoc paths: ',SrcFilename])
1775 else
1776 debugln(['TCodeHelpManager.GetFPDocFilenameForSource Hint: Owner (package ',TLazPackage(AnOwner).Name,') has no fpdoc file for: ',SrcFilename])
1777 end;
1778 end;
1779
1780 // save to cache
1781 if MapEntry=nil then begin
1782 MapEntry:=TCHSourceToFPDocFile.Create;
1783 MapEntry.SourceFilename:=SrcFilename;
1784 FSrcToDocMap.Add(MapEntry);
1785 end;
1786 MapEntry.FPDocFilename:=Result;
1787 MapEntry.FPDocFileOwner:=AnOwner;
1788 MapEntry.MakeValid;
1789 finally
1790 if (Result='') and CreateIfNotExists then begin
1791 Result:=DoCreateFPDocFileForSource(SrcFilename,AnOwner);
1792 end;
1793 {$IF defined(VerboseCodeHelp) or defined(VerboseGetFPDocForSrc)}
1794 DebugLn(['TCodeHelpManager.GetFPDocFilenameForSource SrcFilename="',SrcFilename,'" Result="',Result,'"']);
1795 {$ENDIF}
1796 end;
1797 {$IF defined(VerboseCodeHelp) or defined(VerboseGetFPDocForSrc)}
1798 DebugLn(['TCodeHelpManager.GetFPDocFilenameForSource ',dbgsName(AnOwner)]);
1799 {$endif}
1800 end;
1801
1802 procedure TCodeHelpManager.GetFPDocFilenamesForSources(
1803 SrcFilenames: TFilenameToStringTree; ResolveIncludeFiles: boolean;
1804 var FPDocFilenames: TFilenameToStringTree);
1805 var
1806 SrcFilename: String;
1807 CacheWasUsed: boolean;
1808 AnOwner: TObject;
1809 FPDocFilename: String;
1810 S2SItem: PStringToStringItem;
1811 begin
1812 for S2SItem in SrcFilenames do begin
1813 SrcFilename:=S2SItem^.Name;
1814 FPDocFilename:=GetFPDocFilenameForSource(SrcFilename,ResolveIncludeFiles,
1815 CacheWasUsed,AnOwner);
1816 //DebugLn(['TCodeHelpManager.GetFPDocFilenamesForSources FPDoc=',FPDocFilename,' Src=',SrcFilename]);
1817 if FPDocFilename<>'' then begin
1818 if FPDocFilenames=nil then
1819 FPDocFilenames:=TFilenameToStringTree.Create(false);
1820 FPDocFilenames[FPDocFilename]:=GetModuleOwnerName(AnOwner);
1821 end;
1822 end;
1823 end;
1824
GetIDESrcFPDocPathnull1825 function TCodeHelpManager.GetIDESrcFPDocPath: string;
1826 var
1827 LazDir: String;
1828 begin
1829 Result:='';
1830 LazDir:=AppendPathDelim(EnvironmentOptions.GetParsedLazarusDirectory);
1831 if (LazDir='') or not FilenameIsAbsolute(LazDir) then exit;
1832 Result:=LazDir+GetForcedPathDelims('docs/xml/ide/');
1833 end;
1834
IsIDESrcFilenull1835 function TCodeHelpManager.IsIDESrcFile(const SrcFilename: string): boolean;
1836 var
1837 LazDir: String;
1838 begin
1839 Result:=false;
1840 LazDir:=AppendPathDelim(EnvironmentOptions.GetParsedLazarusDirectory);
1841 if (LazDir='') or not FilenameIsAbsolute(LazDir) then exit;
1842 if not FileIsInPath(SrcFilename,LazDir) then exit;
1843 // check if SrcFilename is in one of the IDE directories or sub directories
1844 if FileIsInPath(SrcFilename,LazDir+'ide')
1845 or FileIsInPath(SrcFilename,LazDir+'debugger')
1846 or FileIsInPath(SrcFilename,LazDir+'packager')
1847 or FileIsInPath(SrcFilename,LazDir+'converter')
1848 or FileIsInPath(SrcFilename,LazDir+'designer')
1849 then
1850 Result:=true;
1851 end;
1852
FindFPDocPackageOwnernull1853 function TCodeHelpManager.FindFPDocPackageOwner(const PackageName: string
1854 ): TObject;
1855 var
1856 AProject: TLazProject;
1857 i: Integer;
1858 Pkg: TLazPackage;
1859 begin
1860 // check project
1861 AProject:=LazarusIDE.ActiveProject;
1862 if (AProject<>nil)
1863 and (SysUtils.CompareText(GetFPDocPackageNameByOwner(AProject),PackageName)=0)
1864 then begin
1865 Result:=AProject;
1866 exit;
1867 end;
1868 // check package
1869 for i:=0 to PackageGraph.Count-1 do begin
1870 Pkg:=PackageGraph[i];
1871 if SysUtils.CompareText(Pkg.GetFPDocPackageName,PackageName)=0 then
1872 exit(Pkg);
1873 end;
1874 // check IDE as project
1875 if SysUtils.CompareText(IDEProjectName,PackageName)=0 then begin
1876 Result:=LazarusHelp;
1877 exit;
1878 end;
1879 Result:=nil;
1880 end;
1881
TCodeHelpManager.FindModuleOwnernull1882 function TCodeHelpManager.FindModuleOwner(FPDocFile: TLazFPDocFile): TObject;
1883 var
1884 AProject: TLazProject;
1885 Path: String;
1886 p: PChar;
1887 PkgName: String;
1888
InPackagenull1889 function InPackage(Pkg: TLazPackage): boolean;
1890 var
1891 SearchPath: String;
1892 begin
1893 Result:=false;
1894 if (Pkg=nil) or (Pkg.FPDocPaths='') then exit;
1895 // check if the file is in the search path
1896 Path:=ExtractFilePath(FPDocFile.Filename);
1897 SearchPath:=Pkg.FPDocPaths;
1898 if not IDEMacros.CreateAbsoluteSearchPath(SearchPath,Pkg.Directory)
1899 then
1900 exit;
1901 SearchPath:=MinimizeSearchPath(SearchPath);
1902 //DebugLn(['InPackage Path="',Path,'" SearchPath="',SearchPath,'"']);
1903 p:=FindPathInSearchPath(PChar(Path),length(Path),
1904 PChar(SearchPath),length(SearchPath));
1905 if p<>nil then begin
1906 FindModuleOwner:=Pkg;
1907 Result:=true;
1908 end;
1909 end;
1910
1911 var
1912 Pkg: TLazPackage;
1913 SearchPath: String;
1914 i: Integer;
1915 begin
1916 Result:=nil;
1917 if FPDocFile=nil then exit;
1918 AProject:=LazarusIDE.ActiveProject;
1919
1920 // virtual files belong to the project
1921 if not FilenameIsAbsolute(FPDocFile.Filename) then
1922 exit(AProject);
1923
1924 // check if in the doc path of the project
1925 if (AProject<>nil) and (AProject.FPDocPaths<>'')
1926 and FilenameIsAbsolute(AProject.ProjectInfoFile) then begin
1927 Path:=ExtractFilePath(FPDocFile.Filename);
1928 SearchPath:=AProject.FPDocPaths;
1929 IDEMacros.CreateAbsoluteSearchPath(SearchPath,
1930 ExtractFilePath(AProject.ProjectInfoFile));
1931 SearchPath:=TrimSearchPath(SearchPath,'');
1932 p:=FindPathInSearchPath(PChar(Path),length(Path),
1933 PChar(SearchPath),length(SearchPath));
1934 if p<>nil then begin
1935 Result:=AProject;
1936 exit;
1937 end;
1938 end;
1939
1940 // check the packagename in the fpdoc file
1941 PkgName:=FPDocFile.GetPackageName;
1942 if PkgName<>'' then begin
1943 Pkg:=PackageGraph.FindPackageWithName(PkgName,nil);
1944 if InPackage(Pkg) then exit;
1945 end;
1946
1947 // search in all packages
1948 for i:=0 to PackageGraph.Count-1 do
1949 if InPackage(PackageGraph.Packages[i]) then exit;
1950
1951 // check the IDE
1952 SearchPath:=GetIDESrcFPDocPath;
1953 if (SearchPath<>'') and FileIsInPath(FPDocFile.Filename,SearchPath) then
1954 begin
1955 Result:=LazarusHelp;
1956 exit;
1957 end;
1958 end;
1959
GetModuleOwnerNamenull1960 function TCodeHelpManager.GetModuleOwnerName(TheOwner: TObject): string;
1961 begin
1962 if TheOwner is TLazPackage then
1963 Result:=TLazPackage(TheOwner).Name
1964 else if TheOwner is TLazProject then
1965 Result:=ExtractFileNameOnly(TLazProject(TheOwner).ProjectInfoFile)
1966 else if TheOwner=LazarusHelp then
1967 Result:=IDEProjectName
1968 else
1969 Result:='';
1970 end;
1971
GetFPDocPackageNameByOwnernull1972 function TCodeHelpManager.GetFPDocPackageNameByOwner(TheOwner: TObject
1973 ): string;
1974 begin
1975 if TheOwner is TLazPackage then
1976 Result:=TLazPackage(TheOwner).GetFPDocPackageName
1977 else if TheOwner is TLazProject then
1978 Result:=TLazProject(TheOwner).GetFPDocPackageName
1979 else if TheOwner=LazarusHelp then
1980 Result:=IDEProjectName
1981 else
1982 Result:='';
1983 end;
1984
ExpandFPDocLinkIDnull1985 function TCodeHelpManager.ExpandFPDocLinkID(const LinkID, DefaultUnitName,
1986 DefaultOwnerName: string): string;
1987 begin
1988 Result:=LinkID;
1989 if (LinkID='') or (LinkID[1]='#') then exit;
1990 Result:=ExpandFPDocLinkID(LinkId,DefaultUnitName,
1991 FindFPDocPackageOwner(DefaultOwnerName));
1992 end;
1993
ExpandFPDocLinkIDnull1994 function TCodeHelpManager.ExpandFPDocLinkID(const LinkID,
1995 DefaultUnitName: string; TheOwner: TObject): string;
1996
SearchFPDocFilenull1997 function SearchFPDocFile(SearchPath: string;
1998 const BaseDir, AUnitname: string): string;
1999 var
2000 FPDocFilename: String;
2001 begin
2002 Result:='';
2003 if BaseDir='' then exit;
2004 if not IDEMacros.CreateAbsoluteSearchPath(SearchPath,BaseDir) then exit;
2005 FPDocFilename:=lowercase(AUnitName)+'.xml';
2006 Result:=SearchFileInPath(FPDocFilename,'',SearchPath,';',ctsfcDefault);
2007 end;
2008
2009 var
2010 FirstPointPos: LongInt;
2011 APackage: TLazPackage;
2012 FirstIdentifier: String;
2013 AddUnit: Boolean;
2014 AProject: TLazProject;
2015 begin
2016 Result:=LinkID;
2017 if (LinkID='') or (LinkID[1]='#') then exit;
2018 FirstPointPos:=System.Pos(LinkID,'.');
2019 FirstIdentifier:=copy(LinkID,1,FirstPointPos);
2020 if (FirstIdentifier<>'')
2021 and (SysUtils.CompareText(FirstIdentifier,DefaultUnitName)<>0) then
2022 begin
2023 // the LinkID has sub identifiers, so the first identifier could be a unit
2024 // But it is not the DefaultUnitName
2025 // => check if it is another unitname of the Owner
2026 AddUnit:=false;
2027 if TheOwner is TLazPackage then begin
2028 APackage:=TLazPackage(TheOwner);
2029 if (APackage.FindUnit(FirstIdentifier)=nil) then begin
2030 // the unit is not owned.
2031 if SearchFPDocFile(APackage.FPDocPaths,APackage.DirectoryExpanded,
2032 FirstIdentifier)='' then
2033 begin
2034 // and there is no fpdoc file for this identifier
2035 // => not a unit
2036 AddUnit:=true;
2037 end;
2038 end;
2039 end else if TheOwner is TLazProject then begin
2040 AProject:=TLazProject(TheOwner);
2041 if SearchFPDocFile(AProject.FPDocPaths,
2042 ExtractFilePath(AProject.ProjectInfoFile),FirstIdentifier)='' then
2043 begin
2044 // there is no fpdoc file for this identifier
2045 // => not a unit
2046 AddUnit:=true;
2047 end;
2048 end else begin
2049 // unknown owner type
2050 exit;
2051 end;
2052 if AddUnit then
2053 Result:=DefaultUnitName+'.'+Result;
2054 end;
2055 Result:='#'+GetFPDocPackageNameByOwner(TheOwner)+'.'+Result;
2056 end;
2057
TCodeHelpManager.CodeNodeToElementNamenull2058 function TCodeHelpManager.CodeNodeToElementName(Tool: TFindDeclarationTool;
2059 CodeNode: TCodeTreeNode): string;
2060 var
2061 NodeName: String;
2062 begin
2063 Result:='';
2064 if CodeNode.Desc in AllSourceTypes then begin
2065 Result:=Tool.ExtractSourceName;
2066 end else begin
2067 while CodeNode<>nil do begin
2068 NodeName:='';
2069 case CodeNode.Desc of
2070 ctnVarDefinition:
2071 if Tool.NodeIsResultIdentifier(CodeNode) then
2072 // fpdoc prefixes the result variable with 'Identifier ' (don't ask)
2073 NodeName:='Identifier '+Tool.ExtractDefinitionName(CodeNode)
2074 else
2075 NodeName:=Tool.ExtractDefinitionName(CodeNode);
2076 ctnConstDefinition, ctnTypeDefinition, ctnGenericType:
2077 NodeName:=Tool.ExtractDefinitionName(CodeNode);
2078 ctnProperty:
2079 NodeName:=Tool.ExtractPropName(CodeNode,false);
2080 ctnProcedure:
2081 if Tool.NodeIsOperator(CodeNode) then
2082 NodeName:=Tool.ExtractProcHead(CodeNode,
2083 [phpWithStart,phpWithResultType,phpWithoutSemicolon])
2084 else
2085 NodeName:=Tool.ExtractProcName(CodeNode,[]);
2086 ctnEnumIdentifier:
2087 NodeName:=GetIdentifier(@Tool.Src[CodeNode.StartPos]);
2088 ctnIdentifier:
2089 if Tool.NodeIsResultType(CodeNode) then
2090 NodeName:='Result';
2091 end;
2092 if NodeName<>'' then begin
2093 if Result<>'' then
2094 Result:='.'+Result;
2095 Result:=NodeName+Result;
2096 end;
2097 CodeNode:=CodeNode.Parent;
2098 end;
2099 end;
2100 end;
2101
GetFPDocNodenull2102 function TCodeHelpManager.GetFPDocNode(Tool: TCodeTool; CodeNode: TCodeTreeNode;
2103 Complete: boolean; out FPDocFile: TLazFPDocFile; out DOMNode: TDOMNode;
2104 out CacheWasUsed: boolean): TCodeHelpParseResult;
2105 var
2106 SrcFilename: String;
2107 FPDocFilename: String;
2108 ElementName: String;
2109 AnOwner: TObject;
2110 begin
2111 FPDocFile:=nil;
2112 DOMNode:=nil;
2113 CacheWasUsed:=true;
2114
2115 // find corresponding FPDoc file
2116 SrcFilename:=Tool.MainFilename;
2117 FPDocFilename:=GetFPDocFilenameForSource(SrcFilename,false,CacheWasUsed,AnOwner);
2118 if FPDocFilename='' then exit(chprFailed);
2119 if (not CacheWasUsed) and (not Complete) then exit(chprParsing);
2120
2121 // load FPDoc file
2122 Result:=LoadFPDocFile(FPDocFilename,[chofUpdateFromDisk],FPDocFile,CacheWasUsed);
2123 if Result<>chprSuccess then exit;
2124 if (not CacheWasUsed) and (not Complete) then exit(chprParsing);
2125
2126 // find FPDoc node
2127 ElementName:=CodeNodeToElementName(Tool,CodeNode);
2128 if ElementName='' then exit(chprFailed);
2129 DOMNode:=FPDocFile.GetElementWithName(ElementName);
2130 if DOMNode=nil then exit(chprFailed);
2131
2132 Result:=chprSuccess;
2133 end;
2134
GetLinkedFPDocNodenull2135 function TCodeHelpManager.GetLinkedFPDocNode(StartFPDocFile: TLazFPDocFile;
2136 StartDOMNode: TDOMNode; const Path: string; Flags: TCodeHelpOpenFileFlags;
2137 out ModuleOwner: TObject; out FPDocFile: TLazFPDocFile; out DOMNode: TDOMNode;
2138 out InvalidPath: integer; out CacheWasUsed: boolean): TCodeHelpParseResult;
2139
2140 function FindFPDocFilename(BaseDir, SearchPath, AUnitName: string): string;
2141 begin
2142 Result:='';
2143 if not IDEMacros.CreateAbsoluteSearchPath(SearchPath,BaseDir) then exit;
2144 //DebugLn(['FindFPDocFilename BaseDir=',BaseDir,' SearchPath=',SearchPath,' UnitName=',AUnitname]);
2145 Result:=SearchFileInPath(AUnitName+'.xml',BaseDir,SearchPath,';',ctsfcDefault);
2146 end;
2147
2148 function FindElement(StartPos: integer; aFPDocFile: TLazFPDocFile): boolean;
2149 var
2150 ElementName: String;
2151 p: integer;
2152 begin
2153 p:=length(Path)+1;
2154 while p>StartPos do begin
2155 ElementName:=copy(Path,StartPos,p-StartPos);
2156 //DebugLn(['TCodeHelpManager.GetLinkedFPDocNode ElementName=',ElementName]);
2157 DOMNode:=aFPDocFile.GetElementWithName(ElementName);
2158 if DOMNode<>nil then begin
2159 InvalidPath:=p;
2160 if p>length(Path) then
2161 GetLinkedFPDocNode:=chprSuccess
2162 else
2163 GetLinkedFPDocNode:=chprFailed;
2164 FPDocFile:=aFPDocFile;
2165 exit(true);
2166 end;
2167 dec(p);
2168 while (p>StartPos) and (Path[p]<>'.') do dec(p);
2169 end;
2170 Result:=false;
2171 end;
2172
2173 var
2174 StartPos, p: LongInt;
2175 PkgName: String;
2176 Pkg: TLazPackage;
2177 AUnitName: String;
2178 AProject: TLazProject;
2179 FPDocFilename: String;
2180 BaseDir: String;
2181 begin
2182 ModuleOwner:=nil;
2183 FPDocFile:=nil;
2184 DOMNode:=nil;
2185 InvalidPath:=0;
2186 CacheWasUsed:=false;
2187 Result:=chprFailed;
2188
2189 //DebugLn(['TCodeHelpManager.GetLinkedFPDocNode Path="',Path,'"']);
2190 if Path='' then exit;
2191 if StartDOMNode=nil then ; // for future use
2192
2193 StartPos:=1;
2194 p:=1;
2195 if Path[1]='#' then begin
2196 // switch package
2197 while (p<=length(Path)) and (Path[p]<>'.') do inc(p);
2198 PkgName:=copy(Path,2,p-2);
2199 //DebugLn(['TCodeHelpManager.GetLinkedFPDocNode PkgName=',PkgName]);
2200 if PkgName='' then exit;
2201 Pkg:=PackageGraph.FindPackageWithName(PkgName,nil);
2202 if Pkg=nil then exit;
2203 InvalidPath:=p;
2204 ModuleOwner:=Pkg;
2205 if p>length(Path) then begin
2206 // link to the module, no unit
2207 Result:=chprSuccess;
2208 exit;
2209 end;
2210 StartPos:=p+1;
2211 p:=StartPos;
2212 end else begin
2213 // relative link (either in the same fpdoc file or of the same module)
2214 // use same package
2215 ModuleOwner:=FindModuleOwner(StartFPDocFile);
2216 if ModuleOwner=nil then exit;
2217 // try in the same fpdoc file
2218 if FindElement(StartPos,StartFPDocFile) then exit;
2219 end;
2220
2221 // search in another unit
2222 while (p<=length(Path)) and (Path[p]<>'.') do inc(p);
2223 AUnitName:=copy(Path,StartPos,p-StartPos);
2224 //DebugLn(['TCodeHelpManager.GetLinkedFPDocNode UnitName=',AUnitName]);
2225 if AUnitName='' then exit;
2226 FPDocFilename:='';
2227 if ModuleOwner is TLazProject then begin
2228 AProject:=TLazProject(ModuleOwner);
2229 if (AProject.FPDocPaths<>'') then begin
2230 BaseDir:=ExtractFilePath(AProject.ProjectInfoFile);
2231 FPDocFilename:=FindFPDocFilename(BaseDir,AProject.FPDocPaths,AUnitName);
2232 end;
2233 end else if ModuleOwner is TLazPackage then begin
2234 Pkg:=TLazPackage(ModuleOwner);
2235 if Pkg.FPDocPaths<>'' then begin
2236 BaseDir:=Pkg.Directory;
2237 FPDocFilename:=FindFPDocFilename(BaseDir,Pkg.FPDocPaths,AUnitName);
2238 end;
2239 end;
2240 //DebugLn(['TCodeHelpManager.GetLinkedFPDocNode FPDocFilename=',FPDocFilename]);
2241 if FPDocFilename='' then exit;
2242
2243 // load FPDocFile
2244 Result:=LoadFPDocFile(FPDocFilename,Flags,FPDocFile,CacheWasUsed);
2245 if Result<>chprSuccess then exit;
2246 InvalidPath:=p;
2247 if p>length(Path) then begin
2248 // link to a unit, no element
2249 Result:=chprSuccess;
2250 exit;
2251 end;
2252 StartPos:=p+1;
2253
2254 // find element
2255 if FindElement(StartPos,FPDocFile) then exit;
2256
2257 Result:=chprFailed;
2258 end;
2259
GetDeclarationChainnull2260 function TCodeHelpManager.GetDeclarationChain(Code: TCodeBuffer; X, Y: integer;
2261 out ListOfPCodeXYPosition: TFPList; out CacheWasUsed: boolean
2262 ): TCodeHelpParseResult;
2263 begin
2264 if FDeclarationCache.FindDeclarations(Code,X,Y,ListOfPCodeXYPosition,
2265 CacheWasUsed)
2266 then
2267 Result:=chprSuccess
2268 else
2269 Result:=chprFailed;
2270 end;
2271
GetCodeContextnull2272 function TCodeHelpManager.GetCodeContext(CodePos: PCodeXYPosition; out
2273 FindContext: TFindContext; Complete: boolean; out CacheWasUsed: boolean
2274 ): TCodeHelpParseResult;
2275 var
2276 CurTool: TCodeTool;
2277 CleanPos: integer;
2278 Node: TCodeTreeNode;
2279 begin
2280 Result:=chprFailed;
2281 FindContext:=CleanFindContext;
2282 CacheWasUsed:=true;
2283
2284 //DebugLn(['TCodeHelpManager.GetElementChain i=',i,' X=',CodePos^.X,' Y=',CodePos^.Y]);
2285 if (CodePos=nil) or (CodePos^.Code=nil) or (CodePos^.X<1) or (CodePos^.Y<1)
2286 then begin
2287 DebugLn(['TCodeHelpManager.GetElementChain invalid CodePos']);
2288 exit;
2289 end;
2290
2291 // build CodeTree and find node
2292 if not CodeToolBoss.Explore(CodePos^.Code,CurTool,false,true) then begin
2293 DebugLn(['TCodeHelpManager.GetElementChain note: there was a parser error']);
2294 end;
2295 if CurTool=nil then begin
2296 DebugLn(['TCodeHelpManager.GetElementChain explore failed']);
2297 exit;
2298 end;
2299 if CurTool.CaretToCleanPos(CodePos^,CleanPos)<>0 then begin
2300 DebugLn(['TCodeHelpManager.GetElementChain invalid CodePos']);
2301 exit;
2302 end;
2303
2304 Node:=CurTool.FindDeepestNodeAtPos(CleanPos,false);
2305 if Node=nil then begin
2306 DebugLn(['TCodeHelpManager.GetElementChain node not found']);
2307 exit;
2308 end;
2309
2310 // use only definition nodes
2311 if (Node.Desc=ctnProcedureHead) then begin
2312 if CurTool.PositionInFuncResultName(Node,CleanPos)
2313 and (Node.LastChild<>nil) and (Node.LastChild.Desc=ctnIdentifier) then begin
2314 // cursor on function result
2315 // use the result type node
2316 Node:=Node.LastChild;
2317 end else if (Node.Parent<>nil) and (Node.Parent.Desc=ctnProcedure) then
2318 Node:=Node.Parent;
2319 end;
2320 if (not (Node.Desc in
2321 (AllIdentifierDefinitions+AllSourceTypes
2322 +[ctnProperty,ctnProcedure,ctnEnumIdentifier])))
2323 and (not CurTool.NodeIsResultType(Node))
2324 then begin
2325 DebugLn(['TCodeHelpManager.GetElementChain ignoring node ',Node.DescAsString]);
2326 exit;
2327 end;
2328 if (CurTool.NodeIsForwardDeclaration(Node)) then begin
2329 //DebugLn(['TCodeHelpManager.GetElementChain ignoring forward']);
2330 exit;
2331 end;
2332
2333 // success
2334 FindContext.Tool:=CurTool;
2335 FindContext.Node:=Node;
2336 Result:=chprSuccess;
2337 end;
2338
GetElementChainnull2339 function TCodeHelpManager.GetElementChain(Code: TCodeBuffer; X, Y: integer;
2340 Complete: boolean; out Chain: TCodeHelpElementChain; out CacheWasUsed: boolean
2341 ): TCodeHelpParseResult;
2342 var
2343 ListOfPCodeXYPosition: TFPList;
2344 i: Integer;
2345 CodePos: PCodeXYPosition;
2346 CHElement: TCodeHelpElement;
2347 FPDocFilename: String;
2348 FindContext: TFindContext;
2349 AnOwner: TObject;
2350 NewElementName: String;
2351 NewUnitName: String;
2352 begin
2353 Chain:=nil;
2354 ListOfPCodeXYPosition:=nil;
2355 CodeToolBoss.ActivateWriteLock;
2356 try
2357 //DebugLn(['TCodeHelpManager.GetElementChain GetDeclarationChain...']);
2358 // get the declaration chain
2359 Result:=GetDeclarationChain(Code,X,Y,ListOfPCodeXYPosition,CacheWasUsed);
2360 if Result<>chprSuccess then begin
2361 {$IFDEF VerboseCodeHelpFails}
2362 DebugLn(['TCodeHelpManager.GetElementChain GetDeclarationChain failed ',Code.Filename,' x=',x,' y=',y]);
2363 {$ENDIF}
2364 exit;
2365 end;
2366 if (not CacheWasUsed) and (not Complete) then exit(chprParsing);
2367
2368 {$IFDEF VerboseCodeHelp}
2369 DebugLn(['TCodeHelpManager.GetElementChain init the element chain: ListOfPCodeXYPosition.Count=',ListOfPCodeXYPosition.Count,' ...']);
2370 {$ENDIF}
2371 // init the element chain
2372 Result:=chprParsing;
2373 Chain:=TCodeHelpElementChain.Create;
2374 Chain.CodePos.Code:=Code;
2375 Chain.MakeValid;
2376 Code.LineColToPosition(Y,X,Chain.CodePos.P);
2377 // fill the element chain
2378 for i:=0 to ListOfPCodeXYPosition.Count-1 do begin
2379 // get source position of declaration
2380 CodePos:=PCodeXYPosition(ListOfPCodeXYPosition[i]);
2381 Result:=GetCodeContext(CodePos,FindContext,Complete,CacheWasUsed);
2382 if Result=chprFailed then continue; // skip invalid contexts
2383 if Result<>chprSuccess then continue;
2384 if (not CacheWasUsed) and (not Complete) then exit(chprParsing);
2385
2386 // get fpdoc element path
2387 NewUnitName:=FindContext.Tool.GetSourceName(false);
2388 NewElementName:=CodeNodeToElementName(FindContext.Tool,FindContext.Node);
2389
2390 // skip code nodes with same fpdoc element
2391 if (Chain.IndexOfElementName(NewUnitName,NewElementName)>=0) then continue;
2392
2393 // add element
2394 CHElement:=Chain.Add;
2395 CHElement.CodeXYPos:=CodePos^;
2396 CHElement.CodeContext:=FindContext;
2397 CHElement.ElementName:=NewElementName;
2398 //DebugLn(['TCodeHelpManager.GetElementChain i=',i,' CodeContext=',FindContextToString(CHElement.CodeContext)]);
2399
2400 // find corresponding FPDoc file
2401 CHElement.ElementUnitFileName:=CHElement.CodeContext.Tool.MainFilename;
2402 CHElement.ElementUnitName:=NewUnitName;
2403 AnOwner:=Self;
2404 FPDocFilename:=GetFPDocFilenameForSource(CHElement.ElementUnitFileName,
2405 false,CacheWasUsed,AnOwner);
2406 CHElement.ElementOwnerName:=GetModuleOwnerName(AnOwner);
2407 CHElement.ElementFPDocPackageName:=GetFPDocPackageNameByOwner(AnOwner);
2408 //DebugLn(['TCodeHelpManager.GetElementChain FPDocFilename=',FPDocFilename]);
2409 if (not CacheWasUsed) and (not Complete) then exit(chprParsing);
2410
2411 if FPDocFilename<>'' then begin
2412 // load FPDoc file
2413 LoadFPDocFile(FPDocFilename,[chofUpdateFromDisk],CHElement.FPDocFile,
2414 CacheWasUsed);
2415 if (not CacheWasUsed) and (not Complete) then exit(chprParsing);
2416 end;
2417 end;
2418
2419 // get fpdoc nodes
2420 for i:=0 to Chain.Count-1 do begin
2421 CHElement:=Chain[i];
2422 //DebugLn(['TCodeHelpManager.GetElementChain i=',i,' Element=',CHElement.ElementName]);
2423 // get fpdoc node
2424 if (CHElement.FPDocFile<>nil) and (CHElement.ElementName<>'') then begin
2425 CHElement.ElementNode:=
2426 CHElement.FPDocFile.GetElementWithName(CHElement.ElementName);
2427 CHElement.ElementNodeValid:=true;
2428 end;
2429 //DebugLn(['TCodeHelpManager.GetElementChain ElementNode=',CHElement.ElementNode<>nil]);
2430 end;
2431
2432 Result:=chprSuccess;
2433 finally
2434 if Result<>chprSuccess then
2435 FreeAndNil(Chain);
2436 CodeToolBoss.DeactivateWriteLock;
2437 end;
2438 end;
2439
GetHTMLHintnull2440 function TCodeHelpManager.GetHTMLHint(Code: TCodeBuffer; X, Y: integer;
2441 Options: TCodeHelpHintOptions;
2442 out BaseURL, HTMLHint, PropDetails: string;
2443 out CacheWasUsed: boolean): TCodeHelpParseResult;
2444 var
2445 CursorPos: TCodeXYPosition;
2446 XYPos: TCodeXYPosition;
2447 TopLine: integer;
2448 CTExprType: TExpressionType;
2449 begin
2450 Result:=chprFailed;
2451 BaseURL:='lazdoc://';
2452 HTMLHint:='';
2453 PropDetails:='';
2454 CacheWasUsed:=true;
2455
2456 CursorPos.X:=X;
2457 CursorPos.Y:=Y;
2458 CursorPos.Code:=Code;
2459 if not CodeToolBoss.InitCurCodeTool(Code) then exit;
2460 try
2461 // find declaration
2462 if not CodeToolBoss.CurCodeTool.FindDeclaration(CursorPos,
2463 DefaultFindSmartHintFlags+[fsfSearchSourceName],CTExprType,XYPos,TopLine)
2464 then
2465 exit;
2466 if (CTExprType.Desc=xtContext) and (CTExprType.Context.Node=nil) then begin
2467 // codetools found a source file, not a declararion
2468 debugln(['TCodeHelpManager.GetHTMLHint not a declaration']);
2469 exit;
2470 end;
2471 Result:=GetHTMLHintForExpr(CTExprType,XYPos,Options,BaseURL,HTMLHint,CacheWasUsed);
2472 // Property details are like "published property TType.PropName:Integer"
2473 if (CTExprType.Desc=xtContext) and (CTExprType.Context.Tool<>nil) then
2474 PropDetails:=CTExprType.Context.Tool.GetSmartHint(CTExprType.Context.Node,XYPos,false);
2475 except
2476 on E: ECodeToolError do begin
2477 //debugln(['TCodeHelpManager.GetHTMLHint ECodeToolError: ',E.Message]);
2478 end;
2479 on E: Exception do begin
2480 debugln(['TCodeHelpManager.GetHTMLHint Exception: ',E.Message]);
2481 //DumpExceptionBackTrace;
2482 end;
2483 end;
2484 end;
2485
GetHTMLHintForExprnull2486 function TCodeHelpManager.GetHTMLHintForExpr(CTExprType: TExpressionType;
2487 XYPos: TCodeXYPosition; Options: TCodeHelpHintOptions; out BaseURL,
2488 HTMLHint: string; out CacheWasUsed: boolean): TCodeHelpParseResult;
2489 var
2490 aTopLine: integer;
2491 ListOfPCodeXYPosition: TFPList;
2492 AnOwner: TObject;
2493 FPDocFilename: String;
2494 FPDocFile: TLazFPDocFile;
2495 Complete: boolean;
2496 ElementName: String;
2497 ElementNode: TDOMNode;
2498 ElementNames: TStringList;
2499 i: Integer;
2500 OldXYPos: TCodeXYPosition;
2501 OldCTTool: TFindDeclarationTool;
2502 OldCTNode: TCodeTreeNode;
2503 n: Integer;
2504 s, Descr, Short: String;
2505 Cmd: TKeyCommandRelation;
2506 CTTool: TFindDeclarationTool;
2507 CTNode: TCodeTreeNode;
2508 begin
2509 Result:=chprFailed;
2510 BaseURL:='lazdoc://';
2511 HTMLHint:='';
2512 CacheWasUsed:=true;
2513 AnOwner := nil;
2514
2515 if (CTExprType.Desc in xtAllIdentPredefinedTypes) then
2516 CTExprType.Context.Tool := CodeToolBoss.CurCodeTool.FindCodeToolForUsedUnit('system','',false);
2517 CTTool := CTExprType.Context.Tool;
2518 CTNode := CTExprType.Context.Node;
2519
2520 if CTTool=nil then
2521 Exit(chprFailed);
2522
2523 ListOfPCodeXYPosition:=nil;
2524 Complete:=not (chhoSmallStep in Options);
2525 ElementNames:=TStringList.Create;
2526 try
2527 try
2528 if chhoDeclarationHeader in Options then
2529 HTMLHint:=HTMLHint+GetHTMLDeclarationHeader(CTTool,CTNode,CTExprType.Desc,XYPos);
2530
2531 for n:=1 to 30 do
2532 begin
2533 if (CTExprType.Desc=xtContext) and (CTNode<>nil) then
2534 ElementName:=CodeNodeToElementName(CTTool,CTNode)
2535 else if (CTExprType.Desc in xtAllIdentPredefinedTypes) then
2536 ElementName:=ExpressionTypeDescNames[CTExprType.Desc]
2537 else
2538 break;
2539 //debugln(['TCodeHelpManager.GetHTMLHintForNode ElementName=',ElementName]);
2540 i:=ElementNames.Count-1;
2541 while (i>=0) do begin
2542 if (ElementNames.Objects[i]=CTTool)
2543 and (CompareText(ElementNames[i],ElementName)=0) then
2544 break;
2545 dec(i);
2546 end;
2547 if i>=0 then begin
2548 // a loop or a forward definition
2549 {$IFDEF VerboseCodeHelp}
2550 debugln(['TCodeHelpManager.GetHTMLHintForNode already seen "',ElementName,'"']);
2551 {$ENDIF}
2552 end else begin
2553 ElementNames.AddObject(ElementName,CTTool);
2554
2555 // add fpdoc entry
2556 FPDocFilename:=GetFPDocFilenameForSource(CTTool.MainFilename,
2557 false,CacheWasUsed,AnOwner);
2558 {$IFDEF VerboseCodeHelp}
2559 DebugLn(['TCodeHelpManager.GetHTMLHintForNode: FPDocFilename=',FPDocFilename,' ElementName="',ElementName,'"']);
2560 {$ENDIF}
2561 if (not CacheWasUsed) and (not Complete) then exit(chprParsing);
2562
2563 if FPDocFilename<>'' then begin
2564 // load FPDoc file
2565 LoadFPDocFile(FPDocFilename,[chofUpdateFromDisk],FPDocFile,CacheWasUsed);
2566 if (not CacheWasUsed) and (not Complete) then exit(chprParsing);
2567
2568 ElementNode:=FPDocFile.GetElementWithName(ElementName);
2569 if ElementNode<>nil then begin
2570 //DebugLn(['TCodeHelpManager.GetHTMLHintForNode: fpdoc element found "',ElementName,'"']);
2571 Short:=AppendLineEnding(GetFPDocNodeAsHTML(FPDocFile,ElementNode.FindNode(FPDocItemNames[fpdiShort])));
2572 Descr:=AppendLineEnding(GetFPDocNodeAsHTML(FPDocFile,ElementNode.FindNode(FPDocItemNames[fpdiDescription])));
2573 s:=Short+Descr;
2574 if chhoDeclarationHeader in Options then
2575 begin
2576 // Add Description header only when requested. Save space otherwise.
2577 if s<>'' then
2578 s:='<br>'+LineEnding+'<div class="title">Description</div>'+LineEnding+s;
2579 end
2580 else begin
2581 // Make Short text distinctive if both are given and no header is requested.
2582 if (Short<>'') and (Descr<>'') then
2583 s:=Short+'<hr>'+Descr;
2584 end;
2585 HTMLHint:=HTMLHint+s;
2586 HTMLHint:=HTMLHint+GetFPDocNodeAsHTML(FPDocFile,ElementNode.FindNode(FPDocItemNames[fpdiErrors]));
2587 HTMLHint:=HTMLHint+GetFPDocNodeAsHTML(FPDocFile,ElementNode.FindNode(FPDocItemNames[fpdiSeeAlso]));
2588 HTMLHint:=HTMLHint+GetFPDocNodeAsHTML(FPDocFile,ElementNode.FindNode(FPDocItemNames[fpdiExample]));
2589 end;
2590 end;
2591
2592 if chhoComments in Options then
2593 begin
2594 // add pasdoc
2595 HTMLHint:=HTMLHint+GetPasDocCommentsAsHTML(CTTool,CTNode);
2596 end;
2597 end;
2598
2599 // find inherited node
2600 if (CTNode<>nil) and (
2601 (CTNode.Desc=ctnProperty) or
2602 ((CTNode.Desc in [ctnProcedure,ctnProcedureHead])
2603 and (CTTool.ProcNodeHasSpecifier(CTNode,psOVERRIDE))))
2604 then begin
2605 {$ifdef VerboseCodeHelp}
2606 debugln(['TCodeHelpManager.GetHTMLHintForNode: searching for inherited of ',CTNode.DescAsString,' ',dbgs(XYPos)]);
2607 {$endif}
2608 OldXYPos:=XYPos;
2609 OldCTTool:=CTTool;
2610 OldCTNode:=CTNode;
2611 if (not OldCTTool.FindDeclaration(OldXYPos,[fsfSearchSourceName],
2612 CTTool,CTNode,XYPos,aTopLine))
2613 or (CTNode=OldCTNode)
2614 or (CTNode=nil)
2615 then begin
2616 {$ifdef VerboseCodeHelp}
2617 debugln(['TCodeHelpManager.GetHTMLHintForNode: inherited not found: ',dbgs(OldXYPos)]);
2618 {$endif}
2619 break;
2620 end;
2621 end else begin
2622 {$ifdef VerboseCodeHelp}
2623 debugln(['TCodeHelpManager.GetHTMLHintForNode: not searching inherited for ',CTNode.DescAsString]);
2624 {$endif}
2625 break;
2626 end;
2627
2628 end;
2629
2630 except
2631 on E: ECodeToolError do begin
2632 //debugln(['TCodeHelpManager.GetHTMLHintForNode: ECodeToolError: ',E.Message]);
2633 end;
2634 on E: Exception do begin
2635 debugln(['TCodeHelpManager.GetHTMLHintForNode: Exception: ',E.Message]);
2636 //DumpExceptionBackTrace;
2637 end;
2638 end;
2639
2640 finally
2641 ElementNames.Free;
2642 FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
2643
2644 // Add package name
2645 s:=OwnerToFPDocHint(AnOwner);
2646 if s<>'' then
2647 HTMLHint:=HTMLHint+s;
2648
2649 if HTMLHint<>'' then begin
2650 if (chhoShowFocusHint in Options) then begin
2651 Cmd:=EditorOpts.KeyMap.FindByCommand(ecFocusHint);
2652 if (Cmd<>nil) and (not IDEShortCutEmpty(Cmd.ShortcutA)) then begin
2653 HTMLHint:=HTMLHint+'<div class="focushint">Press '
2654 +KeyAndShiftStateToEditorKeyString(Cmd.ShortcutA)+' for focus</div>'+LineEnding;
2655 end;
2656 end;
2657 HTMLHint:='<html><head><link rel="stylesheet" href="lazdoc://lazarus/lazdoc.css" type="text/css">'+LineEnding
2658 +'<meta http-equiv="Content-Type" content="text/html; charset=utf-8"></head>'+LineEnding
2659 +'<body>'+LineEnding+HTMLHint+'</body>'+LineEnding;
2660 Result:=chprSuccess;
2661 end else
2662 Result:=chprFailed;
2663 end;
2664 {$ifdef VerboseCodeHelp}
2665 debugln(['TCodeHelpManager.GetHTMLHintForNode: ',HTMLHint]);
2666 {$endif}
2667 end;
2668
GetHTMLHintForNodenull2669 function TCodeHelpManager.GetHTMLHintForNode(CTTool: TFindDeclarationTool;
2670 CTNode: TCodeTreeNode; XYPos: TCodeXYPosition; Options: TCodeHelpHintOptions;
2671 out BaseURL, HTMLHint: string; out CacheWasUsed: boolean
2672 ): TCodeHelpParseResult;
2673 var
2674 ExprType: TExpressionType;
2675 begin
2676 ExprType.Desc:=xtContext;
2677 ExprType.Context.Tool:=CTTool;
2678 ExprType.Context.Node:=CTNode;
2679 Result := GetHTMLHintForExpr(ExprType, XYPos, Options, BaseURL, HTMLHint, CacheWasUsed);
2680 end;
2681
GetHTMLHintForUnitnull2682 function TCodeHelpManager.GetHTMLHintForUnit(AUnitName, InFilename: string;
2683 BaseDir: string; Options: TCodeHelpHintOptions; out BaseURL,
2684 HTMLHint: string; out CacheWasUsed: boolean): TCodeHelpParseResult;
2685 var
2686 aFilename: String;
2687 Code: TCodeBuffer;
2688 CTTool: TCodeTool;
2689 NamePos: TAtomPosition;
2690 XYPos: TCodeXYPosition;
2691 begin
2692 Result:=chprFailed;
2693 BaseURL:='lazdoc://';
2694 HTMLHint:='';
2695 CacheWasUsed:=true;
2696
2697 try
2698 aFilename:=CodeToolBoss.DirectoryCachePool.FindUnitSourceInCompletePath(
2699 BaseDir,AUnitName,InFilename);
2700 if aFilename='' then begin
2701 debugln(['TCodeHelpManager.GetHTMLHintForUnit unit "',AUnitName,'" not found, BaseDir="',BaseDir,'"']);
2702 exit; // unit not found
2703 end;
2704 Code:=CodeToolBoss.LoadFile(aFilename,true,false);
2705 if Code=nil then begin
2706 debugln(['TCodeHelpManager.GetHTMLHintForUnit unable to load file "',aFilename,'"']);
2707 exit; // can not load source file
2708 end;
2709 CodeToolBoss.Explore(Code,CTTool,false,true);
2710 if CTTool=nil then begin
2711 debugln(['TCodeHelpManager.GetHTMLHintForUnit unable to explore ',Code.Filename]);
2712 exit; // e.g. main source not found
2713 end;
2714 if not CTTool.GetSourceNamePos(NamePos) then begin
2715 debugln(['TCodeHelpManager.GetHTMLHintForUnit unit has no header ',CTTool.MainFilename]);
2716 exit;
2717 end;
2718 if not CTTool.CleanPosToCaret(NamePos.StartPos,XYPos) then begin
2719 debugln(['TCodeHelpManager.GetHTMLHintForUnit CTTool.CleanPosToCaret failed']);
2720 exit;
2721 end;
2722 debugln(['TCodeHelpManager.GetHTMLHintForUnit ',dbgs(XYPos)]);
2723 Result:=GetHTMLHintForNode(CTTool,CTTool.Tree.Root,XYPos,
2724 Options,BaseURL,HTMLHint,CacheWasUsed);
2725 except
2726 on E: ECodeToolError do begin
2727 debugln(['TCodeHelpManager.GetHTMLHint ECodeToolError: ',E.Message]);
2728 end;
2729 on E: Exception do begin
2730 debugln(['TCodeHelpManager.GetHTMLHintForUnit Exception: ',E.Message]);
2731 //DumpExceptionBackTrace;
2732 end;
2733 end;
2734 end;
2735
GetHTMLDeclarationHeadernull2736 function TCodeHelpManager.GetHTMLDeclarationHeader(Tool: TFindDeclarationTool;
2737 Node: TCodeTreeNode; Desc: TExpressionTypeDesc; XYPos: TCodeXYPosition
2738 ): string;
2739 var
2740 CTHint: String;
2741 begin
2742 Result:='<div class="header">';
2743 // add declaration
2744 if Desc=xtContext then
2745 CTHint:=Tool.GetSmartHint(Node,XYPos,false)
2746 else if Desc in xtAllIdentPredefinedTypes then
2747 CTHint:='type '+ExpressionTypeDescNames[Desc]
2748 else
2749 CTHint:='';
2750 Result:=Result+' <nobr>'+SourceToFPDocHint(CTHint)+'</nobr>';
2751
2752 // add link to declaration
2753 Result:=Result+'<br>'+LineEnding;
2754 if XYPos.Code=nil then begin
2755 if (Node<>nil) then
2756 Tool.CleanPosToCaret(Node.StartPos,XYPos)
2757 else if Desc in xtAllIdentPredefinedTypes then
2758 Tool.CleanPosToCaret(Tool.Tree.Root.StartPos,XYPos);
2759 end;
2760 Result:=Result+' '+SourcePosToFPDocHint(XYPos)+LineEnding;
2761
2762 if (XYPos.Code<>nil) and (CompareFilenames(Tool.MainFilename,XYPos.Code.Filename)<>0)
2763 then begin
2764 // node in include file => show link to unit
2765 Result:=Result+'<br> unit '+SourcePosToFPDocHint(Tool.MainFilename,1,1,Tool.GetSourceName)+LineEnding;
2766 end;
2767
2768 Result:=Result+'</div>'+LineEnding;
2769 end;
2770
GetHTMLDeclarationHeadernull2771 function TCodeHelpManager.GetHTMLDeclarationHeader(Tool: TFindDeclarationTool;
2772 Node: TCodeTreeNode; XYPos: TCodeXYPosition): string;
2773 begin
2774 Result := GetHTMLDeclarationHeader(Tool, Node, xtContext, XYPos);
2775 end;
2776
GetPasDocCommentsAsHTMLnull2777 function TCodeHelpManager.GetPasDocCommentsAsHTML(Tool: TFindDeclarationTool;
2778 Node: TCodeTreeNode): string;
2779 var
2780 ListOfPCodeXYPosition: TFPList;
2781 i: Integer;
2782 CodeXYPos, LastCodeXYPos: PCodeXYPosition;
2783 CommentCode: TCodeBuffer;
2784 CommentStart: integer;
2785 NestedComments: Boolean;
2786 CommentStr, LastComment: String;
2787
2788 function ShiftLeft(const Comment: String) : String;
2789 var
2790 Lines : TStringList;
2791 S : String;
2792 I, J, LeftMost : Integer;
2793 begin
2794 try
2795 Lines := TStringList.Create;
2796 Lines.Text := Comment;
2797
2798 LeftMost := Length(Comment);
2799
2800 for I := 0 to Lines.Count - 1 do
2801 begin
2802 if LeftMost <= 1 then
2803 Break;
2804
2805 S := Lines[I];
2806 J := 1;
2807 while (J <= Length(S)) and (J < LeftMost) and (S[J] = ' ') do
2808 Inc(J);
2809
2810 if J < LeftMost then
2811 LeftMost := J;
2812 end;
2813
2814 if LeftMost > 1 then
2815 for I := 0 to Lines.Count - 1 do
2816 Lines[I] := Copy(Lines[I], LeftMost, Length(Lines[I]) - LeftMost + 1);
2817
2818 Result := Lines.Text;
2819 finally
2820 FreeAndNil(Lines);
2821 end;
2822 end;
2823
2824 procedure AddComment;
2825 begin
2826 if (CodeXYPos=nil) or (LastCodeXYPos=nil)
2827 or (CodeXYPos^.Code<>LastCodeXYPos^.Code)
2828 or (CodeXYPos^.Y-LastCodeXYPos^.Y>10) then begin
2829 // the last comment is at a different position => add a source link
2830 if LastComment<>'' then
2831 Result:=Result+'<span class="comment">'+TextToHTML(ShiftLeft(LastComment))
2832 +' ('+SourcePosToFPDocHint(LastCodeXYPos^,'Source')+')'
2833 +'</span><br>'+LineEnding;
2834 LastComment:=CommentStr;
2835 end else begin
2836 // these two comments are very near together => combine them
2837 if LastComment<>'' then
2838 LastComment+=LineEnding;
2839 LastComment+=CommentStr;
2840 end;
2841 LastCodeXYPos:=CodeXYPos;
2842 end;
2843
2844 function ExtractComment(const Source: String;
2845 CommentStart: Integer) : String;
2846 var
2847 CommentEnd, XPos: Integer;
2848 begin
2849 XPos := CodeXYPos^.X;
2850 CommentEnd := FindCommentEnd(Source, CommentStart, NestedComments);
2851
2852 case Source[CommentStart] of
2853 '/':
2854 begin
2855 CommentStart := CommentStart + 2;
2856 XPos := 0;
2857 end;
2858 '(':
2859 begin
2860 CommentStart := CommentStart + 2;
2861 CommentEnd := CommentEnd - 2;
2862 XPos := XPos + 1;
2863 end;
2864 '{':
2865 begin
2866 CommentStart := CommentStart + 1;
2867 CommentEnd := CommentEnd - 1;
2868 end;
2869 end;
2870 Result:=Copy(Source, CommentStart, CommentEnd - CommentStart);
2871
2872 Result := TrimRight(Result);
2873
2874 if XPos > 0 then
2875 Result := StringOfChar(' ', XPos) + Result;
2876 end;
2877
2878 begin
2879 Result:='';
2880 if (Tool=nil) or (Node=nil) then exit;
2881 ListOfPCodeXYPosition:=nil;
2882 try
2883 if not Tool.GetPasDocComments(Node,ListOfPCodeXYPosition) then exit;
2884 if ListOfPCodeXYPosition=nil then exit;
2885 NestedComments := Tool.Scanner.NestedComments;
2886 LastCodeXYPos := nil;
2887 LastComment := '';
2888 for i := 0 to ListOfPCodeXYPosition.Count - 1 do
2889 begin
2890 CodeXYPos := PCodeXYPosition(ListOfPCodeXYPosition[i]);
2891 CommentCode := CodeXYPos^.Code;
2892 CommentCode.LineColToPosition(CodeXYPos^.Y,CodeXYPos^.X,CommentStart);
2893 if (CommentStart<1) or (CommentStart>CommentCode.SourceLength)
2894 then
2895 continue;
2896 CommentStr := ExtractComment(CommentCode.Source, CommentStart);
2897 AddComment;
2898 end;
2899 CommentStr:='';
2900 CodeXYPos:=nil;
2901 AddComment;
2902 finally
2903 FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
2904 end;
2905 end;
2906
GetFPDocNodeAsHTMLnull2907 function TCodeHelpManager.GetFPDocNodeAsHTML(FPDocFile: TLazFPDocFile;
2908 DOMNode: TDOMNode): string;
2909
2910 function NodeToHTML(Node: TDOMNode): string; forward;
2911
2912 function AddChilds(Node: TDOMNode): string;
2913 var
2914 Child: TDOMNode;
2915 begin
2916 Result:='';
2917 Child:=Node.FirstChild;
2918 while Child<>nil do begin
2919 Result:=Result+NodeToHTML(Child);
2920 Child:=Child.NextSibling;
2921 end;
2922 end;
2923
2924 function NodeToHTML(Node: TDOMNode): string;
2925 var
2926 s: String;
2927 Attr: TDOMNode;
2928 begin
2929 Result:='';
2930 if Node=nil then exit;
2931 //debugln(['TCodeHelpManager.GetFPDocNodeAsHTML.NodeToHTML ',Node.NodeName]);
2932 if (Node.NodeName='short')
2933 or (Node.NodeName='descr')
2934 or (Node.NodeName='seealso')
2935 or (Node.NodeName='errors')
2936 then begin
2937 s:=AddChilds(Node);
2938 if s='' then exit;
2939 if Node.NodeName='errors' then
2940 Result:=Result+'<div class="title">'+'Errors'+'</div>'
2941 else if Node.NodeName='seealso' then
2942 Result:=Result+'<div class="title">'+'See also'+'</div>';
2943 Result:=Result+'<div class="'+Node.NodeName+'">'+s+'</div>'+LineEnding;
2944 end else
2945 if (Node.NodeName='p')
2946 or (Node.NodeName='b')
2947 or (Node.NodeName='pre')
2948 or (Node.NodeName='table')
2949 or (Node.NodeName='th')
2950 or (Node.NodeName='tr')
2951 or (Node.NodeName='td')
2952 or (Node.NodeName='ul')
2953 or (Node.NodeName='li')
2954 or (Node.NodeName='hr')
2955 then begin
2956 Result:=Result+'<'+Node.NodeName+'>'+AddChilds(Node)+'</'+Node.NodeName+'>';
2957 end else if (Node.NodeName='var') then begin
2958 Result:=Result+'<span class="keyword">'+AddChilds(Node)+'</span>';
2959 end else if (Node.NodeName='link') and (Node.Attributes<>nil) then begin
2960 Attr:=Node.Attributes.GetNamedItem('id');
2961 if (Attr=nil) or (Attr.NodeValue='') then exit;
2962 s:=AddChilds(Node);
2963 if s='' then s:=Attr.NodeValue;
2964 Result:=Result+'<a href="fpdoc://'+FPDocLinkToURL(FPDocFile,Attr.NodeValue)+'">'+s+'</a>';
2965 if (Node.ParentNode<>nil) and (Node.ParentNode.NodeName='seealso') then
2966 Result:=Result+'<br>';
2967 end else if (Node.NodeName='example') then begin
2968 Attr:=Node.Attributes.GetNamedItem('file');
2969 if (Attr=nil) or (Attr.NodeValue='') then exit;
2970 s:=ExtractFilePath(FPDocFile.Filename);
2971 if not FilenameIsAbsolute(s) then exit;
2972 s:=s+Attr.NodeValue;
2973 Result:=Result+SourcePosToFPDocHint(s,1,1,'Example')+'<br>';
2974 end else if (Node.NodeName='#text') then begin
2975 Result:=Result+Node.NodeValue;
2976 end else begin
2977 debugln(['TCodeHelpManager.GetFPDocNodeAsHTML.NodeToHTML skipping ',Node.NodeName]);
2978 end;
2979 end;
2980
2981 begin
2982 Result:=NodeToHTML(DOMNode);
2983 end;
2984
TextToHTMLnull2985 function TCodeHelpManager.TextToHTML(Txt: string): string;
2986 var
2987 l: Integer;
2988 c, d: PChar;
2989 begin
2990 Result := '';
2991 if Txt = '' then
2992 exit;
2993 c := @Txt[1];
2994 l := 0;
2995 while c^ <> #0 do begin
2996 inc(l);
2997 case c^ of
2998 ' ' : inc(l, 5);
2999 '<' : inc(l, 3);
3000 '>' : inc(l, 3);
3001 '&' : inc(l, 4);
3002 #10,#13 :
3003 begin
3004 inc(l, 3);
3005 if c[1] in [#10,#13] then
3006 inc(c);
3007 end;
3008 end;
3009 inc(c);
3010 end;
3011
3012 SetLength(Result, l);
3013 c := @Txt[1];
3014 d := @Result[1];
3015 while c^ <> #0 do begin
3016 case c^ of
3017 ' ' :
3018 begin
3019 d[0] := '&';
3020 d[1] := 'n';
3021 d[2] := 'b';
3022 d[3] := 's';
3023 d[4] := 'p';
3024 d[5] := ';';
3025 inc(d, 5);
3026 end;
3027 '<' :
3028 begin
3029 d[0] := '&';
3030 d[1] := 'l';
3031 d[2] := 't';
3032 d[3] := ';';
3033 inc(d, 3);
3034 end;
3035 '>' :
3036 begin
3037 d[0] := '&';
3038 d[1] := 'g';
3039 d[2] := 't';
3040 d[3] := ';';
3041 inc(d, 3);
3042 end;
3043 '&' :
3044 begin
3045 d[0] := '&';
3046 d[1] := 'a';
3047 d[2] := 'm';
3048 d[3] := 'p';
3049 d[4] := ';';
3050 inc(d, 4);
3051 end;
3052 #10,#13 :
3053 begin
3054 d[0] := '<';
3055 d[1] := 'b';
3056 d[2] := 'r';
3057 d[3] := '>';
3058 inc(d, 3);
3059 if c[1] in [#10,#13] then
3060 inc(c);
3061 end;
3062 else
3063 d^ := c^;
3064 end;
3065 inc(c);
3066 inc(d);
3067 end;
3068 end;
3069
CreateElementnull3070 function TCodeHelpManager.CreateElement(Code: TCodeBuffer; X, Y: integer;
3071 out Element: TCodeHelpElement): Boolean;
3072 var
3073 CacheWasUsed: boolean;
3074 FPDocFilename: String;
3075 AnOwner: TObject;
3076 CHResult: TCodeHelpParseResult;
3077 begin
3078 Result:=false;
3079 Element:=nil;
3080 if Code=nil then begin
3081 DebugLn(['TCodeHelpManager.CreateElement failed Code=nil']);
3082 exit;
3083 end;
3084 DebugLn(['TCodeHelpManager.CreateElement START ',Code.Filename,' ',X,',',Y]);
3085
3086 Element:=TCodeHelpElement.Create;
3087 try
3088 // check if code context can have a fpdoc element
3089 Element.CodeXYPos.Code:=Code;
3090 Element.CodeXYPos.X:=X;
3091 Element.CodeXYPos.Y:=Y;
3092 if GetCodeContext(@Element.CodeXYPos,Element.CodeContext,true,
3093 CacheWasUsed)<>chprSuccess then
3094 begin
3095 DebugLn(['TCodeHelpManager.CreateElement GetCodeContext failed for ',Code.Filename,' ',X,',',Y]);
3096 exit;
3097 end;
3098 Element.ElementName:=CodeNodeToElementName(Element.CodeContext.Tool,
3099 Element.CodeContext.Node);
3100 DebugLn(['TCodeHelpManager.CreateElement Element.ElementName=',Element.ElementName]);
3101
3102 // find / create fpdoc file
3103 Element.ElementUnitFileName:=Element.CodeContext.Tool.MainFilename;
3104 Element.ElementUnitName:=Element.CodeContext.Tool.GetSourceName(false);
3105 FPDocFilename:=GetFPDocFilenameForSource(Element.ElementUnitFileName,false,
3106 CacheWasUsed,AnOwner,true);
3107 if FPDocFilename='' then begin
3108 // no fpdoc file
3109 DebugLn(['TCodeHelpManager.CreateElement unable to create fpdoc file for ',FPDocFilename]);
3110 end;
3111 DebugLn(['TCodeHelpManager.CreateElement FPDocFilename=',FPDocFilename]);
3112
3113 // parse fpdoc file
3114 CHResult:=LoadFPDocFile(FPDocFilename,[chofUpdateFromDisk],
3115 Element.FPDocFile,CacheWasUsed);
3116 if CHResult<>chprSuccess then begin
3117 DebugLn(['TCodeHelpManager.CreateElement unable to load fpdoc file ',FPDocFilename]);
3118 exit;
3119 end;
3120
3121 Element.ElementNode:=Element.FPDocFile.GetElementWithName(
3122 Element.ElementName,true);
3123 Result:=Element.ElementNode<>nil;
3124 finally
3125 if not Result then
3126 FreeAndNil(Element);
3127 end;
3128 end;
3129
SourceToFPDocHintnull3130 function TCodeHelpManager.SourceToFPDocHint(Src: string; NestedComments: boolean
3131 ): string;
3132
3133 procedure EndSpan(SpanName: string; var r: string);
3134 begin
3135 if SpanName='' then exit;
3136 r:=r+'</span>';
3137 end;
3138
3139 procedure StartSpan(SpanName: string; var r: string);
3140 begin
3141 if SpanName='' then exit;
3142 r:=r+'<span class="'+SpanName+'">';
3143 end;
3144
3145 function TokenIDToSpan(TokenID: TtkTokenKind): string;
3146 begin
3147 case TokenID of
3148 tkComment: Result:='comment';
3149 tkIdentifier: Result:='identifier';
3150 tkKey: Result:='keyword';
3151 tkNumber: Result:='number';
3152 tkString: Result:='string';
3153 tkSymbol: Result:='symbol';
3154 tkDirective: Result:='directive';
3155 else Result:='';
3156 end;
3157 end;
3158
3159 var
3160 TokenID: TtkTokenKind;
3161 LastTokenID: TtkTokenKind;
3162 Token: String;
3163 begin
3164 Result:='';
3165 PasHighlighter.NestedComments:=NestedComments;
3166 PasHighlighter.ResetRange;
3167 PasHighlighter.SetLine(Src,0);
3168 LastTokenID:=tkUnknown;
3169 while not PasHighlighter.GetEol do begin
3170 TokenID:=PasHighlighter.GetTokenID;
3171 if (Result<>'') and (LastTokenID<>TokenID) then
3172 EndSpan(TokenIDToSpan(LastTokenID),Result);
3173 if (Result='') or (LastTokenID<>TokenID) then
3174 StartSpan(TokenIDToSpan(TokenID),Result);
3175 Token:=PasHighlighter.GetToken;
3176 //debugln(['TCodeHelpManager.SourceToFPDocHint ',Token,' ',ord(TokenID)]);
3177 Result:=Result+TextToHTML(Token);
3178 LastTokenID:=TokenID;
3179 PasHighlighter.Next;
3180 end;
3181 if (Result<>'') and (LastTokenID<>tkUnknown) then
3182 EndSpan(TokenIDToSpan(LastTokenID),Result);
3183 end;
3184
SourcePosToFPDocHintnull3185 function TCodeHelpManager.SourcePosToFPDocHint(XYPos: TCodeXYPosition;
3186 Caption: string): string;
3187 begin
3188 Result:='';
3189 if XYPos.Code=nil then exit;
3190 Result:=SourcePosToFPDocHint(XYPos.Code.Filename,XYPos.X,XYPos.Y,Caption);
3191 end;
3192
SourcePosToFPDocHintnull3193 function TCodeHelpManager.SourcePosToFPDocHint(const aFilename: string; X,
3194 Y: integer; Caption: string): string;
3195 var
3196 Link: String;
3197 i: Integer;
3198 begin
3199 Result:='';
3200 if aFilename='' then exit;
3201 Link:=aFilename;
3202 if Y>=1 then begin
3203 Link:=Link+'('+IntToStr(Y);
3204 if X>=1 then
3205 Link:=Link+','+IntToStr(X);
3206 Link:=Link+')';
3207 end;
3208 if Caption='' then begin
3209 Caption:=Link;
3210 // make caption breakable into several lines
3211 for i:=length(Caption)-1 downto 1 do begin
3212 if Caption[i]=PathDelim then
3213 System.Insert('<wbr/>',Caption,i+1);
3214 end;
3215 end;
3216 Result:='<a href="source://'+Link+'">'+Caption+'</a>';
3217 end;
3218
OwnerToFPDocHintnull3219 function TCodeHelpManager.OwnerToFPDocHint(AnOwner: TObject): string;
3220 var
3221 PackName: string;
3222 begin
3223 Result:='';
3224 if AnOwner=nil then exit;
3225 if AnOwner is TLazPackage then begin
3226 PackName:=TLazPackage(AnOwner).Name;
3227 Result:='<br>'+LineEnding+'<div class="title">Package</div>'+LineEnding
3228 +'<a href="openpackage://'+PackName+'">'+PackName+'</a>';
3229 end;
3230 end;
3231
FPDocLinkToURLnull3232 function TCodeHelpManager.FPDocLinkToURL(FPDocFile: TLazFPDocFile;
3233 const LinkID: string): string;
3234 begin
3235 Result:=LinkID;
3236 if Result='' then exit;
3237 if Result[1]='#' then begin
3238 // has already a package
3239 exit;
3240 end;
3241 if FPDocFile.GetElementWithName(Result)<>nil then begin
3242 // link target is in this unit => prepend package and unit name
3243 Result:='#'+FPDocFile.GetPackageName+'.'+FPDocFile.GetModuleName+'.'+Result;
3244 end else begin
3245 // link target is not in this unit, but same package => prepend package name
3246 Result:='#'+FPDocFile.GetPackageName+'.'+Result;
3247 end;
3248 end;
3249
3250 procedure TCodeHelpManager.FreeDocs;
3251 var
3252 AVLNode: TAvlTreeNode;
3253 begin
3254 AVLNode:=FDocs.FindLowest;
3255 while AVLNode<>nil do begin
3256 CallDocChangeEvents(chmhDocChanging,TLazFPDocFile(AVLNode.Data));
3257 AVLNode:=FDocs.FindSuccessor(AVLNode);
3258 end;
3259 FDocs.FreeAndClear;
3260 end;
3261
3262 procedure TCodeHelpManager.ClearSrcToDocMap;
3263 begin
3264 FSrcToDocMap.FreeAndClear;
3265 end;
3266
3267 procedure TCodeHelpManager.RemoveAllHandlersOfObject(AnObject: TObject);
3268 var
3269 HandlerType: TCodeHelpManagerHandler;
3270 begin
3271 for HandlerType:=Low(TCodeHelpManagerHandler) to High(TCodeHelpManagerHandler) do
3272 FHandlers[HandlerType].RemoveAllMethodsOfObject(AnObject);
3273 end;
3274
3275 procedure TCodeHelpManager.AddHandlerOnChanging(
3276 const OnDocChangingEvent: TCodeHelpChangeEvent; AsLast: boolean);
3277 begin
3278 AddHandler(chmhDocChanging,TMethod(OnDocChangingEvent),AsLast);
3279 end;
3280
3281 procedure TCodeHelpManager.RemoveHandlerOnChanging(
3282 const OnDocChangingEvent: TCodeHelpChangeEvent);
3283 begin
3284 RemoveHandler(chmhDocChanging,TMethod(OnDocChangingEvent));
3285 end;
3286
3287 procedure TCodeHelpManager.AddHandlerOnChanged(
3288 const OnDocChangedEvent: TCodeHelpChangeEvent; AsLast: boolean);
3289 begin
3290 AddHandler(chmhDocChanged,TMethod(OnDocChangedEvent),AsLast);
3291 end;
3292
3293 procedure TCodeHelpManager.RemoveHandlerOnChanged(
3294 const OnDocChangedEvent: TCodeHelpChangeEvent);
3295 begin
3296 RemoveHandler(chmhDocChanged,TMethod(OnDocChangedEvent));
3297 end;
3298
3299
3300 { TCodeHelpElementChain }
3301
GetCountnull3302 function TCodeHelpElementChain.GetCount: integer;
3303 begin
3304 Result:=FItems.Count;
3305 end;
3306
TCodeHelpElementChain.GetItemsnull3307 function TCodeHelpElementChain.GetItems(Index: integer): TCodeHelpElement;
3308 begin
3309 Result:=TCodeHelpElement(FItems[Index]);
3310 end;
3311
Addnull3312 function TCodeHelpElementChain.Add: TCodeHelpElement;
3313 begin
3314 Result:=TCodeHelpElement.Create;
3315 FItems.Add(Result);
3316 end;
3317
3318 constructor TCodeHelpElementChain.Create;
3319 begin
3320 FItems:=TFPList.Create;
3321 end;
3322
3323 destructor TCodeHelpElementChain.Destroy;
3324 begin
3325 Clear;
3326 FreeAndNil(FItems);
3327 inherited Destroy;
3328 end;
3329
3330 procedure TCodeHelpElementChain.Clear;
3331 var
3332 i: Integer;
3333 begin
3334 for i:=0 to FItems.Count-1 do TObject(FItems[i]).Free;
3335 FItems.Clear;
3336 end;
3337
IndexOfFilenull3338 function TCodeHelpElementChain.IndexOfFile(AFile: TLazFPDocFile): integer;
3339 begin
3340 Result:=FItems.Count-1;
3341 while (Result>=0) do begin
3342 if Items[Result].FPDocFile=AFile then exit;
3343 dec(Result);
3344 end;
3345 end;
3346
TCodeHelpElementChain.IndexOfElementNamenull3347 function TCodeHelpElementChain.IndexOfElementName(ElementName: string): integer;
3348 begin
3349 Result:=FItems.Count-1;
3350 while (Result>=0) do begin
3351 if SysUtils.CompareText(Items[Result].ElementName,ElementName)=0 then exit;
3352 dec(Result);
3353 end;
3354 end;
3355
TCodeHelpElementChain.IndexOfElementNamenull3356 function TCodeHelpElementChain.IndexOfElementName(ElementUnitName,
3357 ElementName: string): integer;
3358 begin
3359 Result:=FItems.Count-1;
3360 while (Result>=0) do begin
3361 if (SysUtils.CompareText(Items[Result].ElementUnitName,ElementUnitName)=0)
3362 and (SysUtils.CompareText(Items[Result].ElementName,ElementName)=0) then
3363 exit;
3364 dec(Result);
3365 end;
3366 end;
3367
TCodeHelpElementChain.IsValidnull3368 function TCodeHelpElementChain.IsValid: boolean;
3369 begin
3370 Result:=(IDEChangeStep=CompilerParseStamp)
3371 and (CodetoolsChangeStep=CodeToolBoss.CodeTreeNodesDeletedStep);
3372 //DebugLn(['TCodeHelpElementChain.IsValid Result=',Result,' IDEChangeStep=',IDEChangeStep,' CompilerParseStamp=',CompilerParseStamp,' CodetoolsChangeStep=',CodetoolsChangeStep,' CodeToolBoss.CodeTreeNodesDeletedStep=',CodeToolBoss.CodeTreeNodesDeletedStep]);
3373 end;
3374
3375 procedure TCodeHelpElementChain.MakeValid;
3376 begin
3377 IDEChangeStep:=CompilerParseStamp;
3378 CodetoolsChangeStep:=CodeToolBoss.CodeTreeNodesDeletedStep;
3379 end;
3380
DocFilenull3381 function TCodeHelpElementChain.DocFile: TLazFPDocFile;
3382 begin
3383 Result:=nil;
3384 if (Count>0) then
3385 Result:=Items[0].FPDocFile;
3386 end;
3387
3388 procedure TCodeHelpElementChain.WriteDebugReport;
3389 var
3390 Line, Column: integer;
3391 i: Integer;
3392 begin
3393 CodePos.Code.AbsoluteToLineCol(CodePos.P,Line,Column);
3394 DebugLn(['TCodeHelpElementChain.WriteDebugReport ',CodePos.Code.Filename,' X=',Column,' Y=',Line,' IDEChangeStep=',IDEChangeStep,' CodetoolsChangeStep=',CodetoolsChangeStep]);
3395 for i:=0 to Count-1 do
3396 Items[i].WriteDebugReport;
3397 end;
3398
3399 { TLazFPDocNode }
3400
3401 constructor TLazFPDocNode.Create(AFile: TLazFPDocFile; ANode: TDOMNode);
3402 begin
3403 Node:=ANode;
3404 DocFile:=AFile;
3405 end;
3406
3407 { TCodeHelpElement }
3408
3409 procedure TCodeHelpElement.WriteDebugReport;
3410 begin
3411 DebugLn([' ',CodeXYPos.Code.Filename,' X=',CodeXYPos.X,' Y=',CodeXYPos.Y,' ElementOwnerName=',ElementOwnerName,' ElementFPDocPackageName=',ElementFPDocPackageName,' ElementUnitName=',ElementUnitName,' ElementUnitFileName=',ElementUnitFileName,' ElementName=',ElementName]);
3412 end;
3413
3414 end.
3415
3416