IDE: code hints: fpdoc links to open the help

git-svn-id: trunk@31224 -

ide/buildlazdialog.pas

@@ -570,7 +570,7 @@ begin
     if NewUnitDirectory<>'' then
       // FPC interpretes '\ ' as an escape for a space in a path,
       // so make sure the directory doesn't end with the path delimeter.
-      AppendExtraOption('-FU'+ChompPathDelim(NewTargetDirectory));
+      AppendExtraOption('-FU'+ChompPathDelim(NewUnitDirectory));
 
     if NewTargetDirectory<>'' then
       // FPC interpretes '\ ' as an escape for a space in a path,

ide/codehelp.pas

@@ -315,6 +315,7 @@ type
     function SourcePosToFPDocHint(const aFilename: string; X,Y: integer;
                                   Caption: string=''): string;
     function OwnerToFPDocHint(AnOwner: TObject): string;
+    function FPDocLinkToURL(FPDocFile: TLazFPDocFile; const LinkID: string): string;
   public
     // Event lists
     procedure RemoveAllHandlersOfObject(AnObject: TObject);
@@ -2496,7 +2497,7 @@ begin
                 HTMLHint:=HTMLHint+s;
               end;
               HTMLHint:=HTMLHint+GetFPDocNodeAsHTML(FPDocFile,ElementNode.FindNode(FPDocItemNames[fpdiErrors]));
-              // todo HTMLHint:=HTMLHint+GetFPDocNodeAsHTML(FPDocFile,ElementNode.FindNode(FPDocItemNames[fpdiSeeAlso]));
+              HTMLHint:=HTMLHint+GetFPDocNodeAsHTML(FPDocFile,ElementNode.FindNode(FPDocItemNames[fpdiSeeAlso]));
               HTMLHint:=HTMLHint+GetFPDocNodeAsHTML(FPDocFile,ElementNode.FindNode(FPDocItemNames[fpdiExample]));
             end;
           end;
@@ -2533,7 +2534,7 @@ begin
     except
       on E: Exception do begin
         debugln(['TCodeHelpManager.GetHTMLHint2 Exception: ',E.Message]);
-        DumpExceptionBackTrace;
+        //DumpExceptionBackTrace;
       end;
     end;
 
@@ -2633,7 +2634,7 @@ function TCodeHelpManager.GetFPDocNodeAsHTML(FPDocFile: TLazFPDocFile;
       if (Attr=nil) or (Attr.NodeValue='') then exit;
       s:=AddChilds(Node);
       if s='' then s:=Attr.NodeValue;
-      Result:=Result+'<a href="'+Attr.NodeValue+'">'+s+'</a><br>';
+      Result:=Result+'<a href="fpdoc://'+FPDocLinkToURL(FPDocFile,Attr.NodeValue)+'">'+s+'</a><br>';
     end else if (Node.NodeName='example') then begin
       Attr:=Node.Attributes.GetNamedItem('file');
       if (Attr=nil) or (Attr.NodeValue='') then exit;
@@ -2833,6 +2834,24 @@ begin
                                    +TLazPackage(AnOwner).Name+'</a></span>';
 end;
 
+function TCodeHelpManager.FPDocLinkToURL(FPDocFile: TLazFPDocFile;
+  const LinkID: string): string;
+begin
+  Result:=LinkID;
+  if Result='' then exit;
+  if Result[1]='#' then begin
+    // has already a package
+    exit;
+  end;
+  if FPDocFile.GetElementWithName(Result)<>nil then begin
+    // link target is in this unit => prepend package and unit name
+    Result:='#'+FPDocFile.GetPackageName+'.'+FPDocFile.GetModuleName+'.'+Result;
+  end else begin
+    // link target is not in this unit, but same package => prepend package name
+    Result:='#'+FPDocFile.GetPackageName+'.'+Result;
+  end;
+end;
+
 procedure TCodeHelpManager.FreeDocs;
 var
   AVLNode: TAvgLvlTreeNode;

ide/idehelpmanager.pas

@@ -41,8 +41,8 @@ uses
   PascalParserTool, FindDeclarationTool,
   // IDEIntf
   PropEdits, ObjectInspector, FormEditingIntf, ProjectIntf, TextTools,
-  LazHelpIntf, LazHelpHTML, HelpFPDoc, MacroIntf, IDEWindowIntf, IDEMsgIntf,
-  PackageIntf, LazIDEIntf, HelpIntfs, IDEHelpIntf,
+  IDEDialogs, LazHelpIntf, LazHelpHTML, HelpFPDoc, MacroIntf, IDEWindowIntf,
+  IDEMsgIntf, PackageIntf, LazIDEIntf, HelpIntfs, IDEHelpIntf,
   // IDE
   LazarusIDEStrConsts, TransferMacros, DialogProcs, IDEOptionDefs,
   ObjInspExt, EnvironmentOpts, AboutFrm, MsgView, Project, PackageDefs, MainBar,
@@ -75,6 +75,7 @@ type
     FProviders: TLIHProviders;
     procedure SetProviders(const AValue: TLIHProviders);
     procedure OpenNextURL(Data: PtrInt); // called via Application.QueueAsyncCall
+    procedure OpenFPDoc(Path: string);
   public
     NextURL: string;
     destructor Destroy; override;
@@ -540,6 +541,7 @@ var
 begin
   fWaitingForAsync:=false;
   SplitURL(NextURL,URLScheme,URLPath,URLParams);
+  debugln(['TLazIDEHTMLProvider.OpenNextURL "',URLScheme,'" :// "',URLPath,'" & "',URLParams,'"']);
   if URLScheme='source' then begin
     p:=Point(1,1);
     if REMatches(URLPath,'(.*)\((.*),(.*)\)') then begin
@@ -554,6 +556,109 @@ begin
   end else if (URLScheme='openpackage') and (URLPath<>'')
   and IsValidIdent(URLPath) then begin
     PackageEditingInterface.DoOpenPackageWithName(URLPath,[],false);
+  end else if (URLScheme='fpdoc') and (URLParams<>'') then begin
+    OpenFPDoc(URLParams);
+  end;
+end;
+
+procedure TLazIDEHTMLProvider.OpenFPDoc(Path: string);
+var
+  RestPath: string;
+
+  function ExtractSubPath: string;
+  var
+    p: SizeInt;
+  begin
+    p:=System.Pos('.',RestPath);
+    if p<1 then p:=length(RestPath)+1;
+    Result:=copy(RestPath,1,p-1);
+    RestPath:=copy(RestPath,p+1,length(RestPath));
+  end;
+
+  procedure InvalidPathError(Msg: string);
+  begin
+    debugln(['InvalidPathError Path="',Path,'" Msg="',Msg,'"']);
+    IDEMessageDialog('Unable to open fpdoc help',
+      'The fpdoc path "'+Path+'" is invalid.'#13+Msg,mtError,[mbCancel]);
+  end;
+
+var
+  PkgName: String;
+  Pkg: TLazPackage;
+  AnUnitName: String;
+  PkgFile: TPkgFile;
+  ContextList: TPascalHelpContextList;
+  ElementName: String;
+  Filename: String;
+  ErrMsg: string;
+  PascalHelpContextLists: TList;
+  i: Integer;
+begin
+  RestPath:=Path;
+  PkgName:=ExtractSubPath;
+  if (PkgName='') or (PkgName[1]<>'#') then begin
+    InvalidPathError('It does not start with a package name, for example #rtl.');
+    exit;
+  end;
+  PkgName:=copy(PkgName,2,length(PkgName));
+  if (PkgName='') or not IsValidIdent(PkgName) then begin
+    InvalidPathError('It does not start with a package name, for example #rtl.');
+    exit;
+  end;
+  if SysUtils.CompareText(PkgName,'rtl')=0 then PkgName:='fcl';
+  Pkg:=TLazPackage(PackageEditingInterface.FindPackageWithName(PkgName));
+  if Pkg=nil then begin
+    InvalidPathError('Package "'+PkgName+'" not found.');
+    exit;
+  end;
+  if Pkg.IsVirtual then begin
+    InvalidPathError('Package "'+PkgName+'" has no help.');
+    exit;
+  end;
+
+  AnUnitName:=ExtractSubPath;
+  if (AnUnitName='') or (not IsValidIdent(AnUnitName)) then begin
+    InvalidPathError('Unit name "'+AnUnitName+'" is invalid.');
+    exit;
+  end;
+
+  Filename:='';
+  PkgFile:=Pkg.FindUnit(AnUnitName);
+  if (PkgFile<>nil) and (PkgFile.FileType in PkgFileRealUnitTypes) then begin
+    // normal unit in lpk
+    if PkgFile.IsVirtual then begin
+      InvalidPathError('Unit "'+PkgFile.Filename+'" has no help.');
+      exit;
+    end;
+    Filename:=PkgFile.Filename;
+  end else if SysUtils.CompareText(PkgName,'fcl')=0 then begin
+    // search in FPC sources
+    Filename:=CodeToolBoss.DirectoryCachePool.FindUnitInUnitSet('',AnUnitName);
+  end;
+  if Filename='' then begin
+    InvalidPathError('Unit "'+AnUnitName+'" has no help.');
+    exit;
+  end;
+
+  PascalHelpContextLists:=TList.Create;
+  try
+    // create a context list (and add it as sole element to the PascalHelpContextLists)
+    ContextList:=TPascalHelpContextList.Create;
+    PascalHelpContextLists.Add(ContextList);
+    ContextList.Add(pihcFilename,Filename);
+    ContextList.Add(pihcSourceName,AnUnitName);
+    repeat
+      ElementName:=ExtractSubPath;
+      if ElementName='' then break;
+      ContextList.Add(pihcType,ElementName);
+    until false;
+    ShowHelpForPascalContexts(Filename,Point(1,1),PascalHelpContextLists,ErrMsg);
+  finally
+    if PascalHelpContextLists<>nil then begin
+      for i:=0 to PascalHelpContextLists.Count-1 do
+        TObject(PascalHelpContextLists[i]).Free;
+      PascalHelpContextLists.Free;
+    end;
   end;
 end;
 
@@ -572,9 +677,8 @@ var
 begin
   Result:=false;
   SplitURL(NextURL,URLScheme,URLPath,URLParams);
-  if (URLScheme='file') or (URLScheme='lazdoc') then begin
+  if (URLScheme='file') or (URLScheme='lazdoc') or (URLScheme='fpdoc') then
     Result:=true;
-  end;
 end;
 
 procedure TLazIDEHTMLProvider.OpenURLAsync(const URL: string);
@@ -1173,12 +1277,8 @@ function TIDEHelpManager.ConvertCodePosToPascalHelpContext(
 
   procedure AddContext(Descriptor: TPascalHelpContextType;
     const Context: string);
-  var
-    CurContext: TPascalHelpContext;
   begin
-    CurContext.Descriptor:=Descriptor;
-    CurContext.Context:=Context;
-    Result.Add(CurContext);
+    Result.Add(Descriptor,Context);
     //debugln('  AddContext Descriptor=',dbgs(ord(Descriptor)),' Context="',Context,'"');
   end;
 

ideintf/idehelpintf.pas

@@ -107,8 +107,9 @@ type
     destructor Destroy; override;
     function URLHasStream(const URL: string): boolean; virtual; abstract;
       { The standard IDE implementation supports for OpenURLAsync the following:
-        source://local-file-name   : this opens the file local-file-name in the editor
-        openpackage://package-name : this opens the package editor of the package with the name package-name
+        source://local-file-name   : open a file local-file-name in the source editor
+        openpackage://package-name : open a package editor
+        fpdoc://#package-name.unitname.element : this opens the help for the fpdoc entry
         }
     procedure OpenURLAsync(const URL: string); virtual; abstract;
     function GetStream(const URL: string; Shared: boolean

lcl/lazhelpintf.pas

@@ -66,6 +66,7 @@ type
     function GetItems(Index: integer): TPascalHelpContext;
   public
     procedure Add(const Context: TPascalHelpContext);
+    procedure Add(Descriptor: TPascalHelpContextType; const Context: string);
     procedure Insert(Index: integer; const Context: TPascalHelpContext);
     procedure Clear;
     destructor Destroy; override;
@@ -2255,6 +2256,16 @@ begin
   fItems[FCount-1]:=Context;
 end;
 
+procedure TPascalHelpContextList.Add(Descriptor: TPascalHelpContextType;
+  const Context: string);
+var
+  CurContext: TPascalHelpContext;
+begin
+  CurContext.Descriptor:=Descriptor;
+  CurContext.Context:=Context;
+  Add(CurContext);
+end;
+
 procedure TPascalHelpContextList.Insert(Index: integer;
   const Context: TPascalHelpContext);
 begin