paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 14:58:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

added example to add IDE help for the sources of a package

Browse Source 
git-svn-id: trunk@9941 -
This commit is contained in:
mattias 2006-09-19 22:25:33 +00:00
parent ea03a657dc
commit 92a59e706f
25 changed files with 548 additions and 153 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
.gitattributes vendored
View File

@ -1008,6 +1008,15 @@ examples/groupboxnested.pas svneol=native#text/pascal
examples/hello.lpi svneol=native#text/plain
examples/hello.pp svneol=native#text/pascal
examples/helloform.pp svneol=native#text/pascal
examples/helpforpackage/README.txt svneol=native#text/plain
examples/helpforpackage/demopackagewithhelp.lpk svneol=native#text/plain
examples/helpforpackage/demopackagewithhelp.pas svneol=native#text/plain
examples/helpforpackage/html/index.html svneol=native#text/plain
examples/helpforpackage/html/pkghelpdemounit1/index-5.html svneol=native#text/plain
examples/helpforpackage/html/pkghelpdemounit1/index.html svneol=native#text/plain
examples/helpforpackage/html/pkghelpdemounit1/register.html svneol=native#text/plain
examples/helpforpackage/pkghelpdemounit1.pas svneol=native#text/plain
examples/helpforpackage/xml/pkghelpdemounit1.xml svneol=native#text/plain
examples/helphtml/html/edit1.html svneol=native#text/plain
examples/helphtml/html/edit2.html svneol=native#text/plain
examples/helphtml/html/index.html svneol=native#text/plain
@ -2594,6 +2603,7 @@ packager/addtopackagedlg.pas svneol=native#text/pascal
packager/basepkgmanager.pas svneol=native#text/pascal
packager/brokendependenciesdlg.pas svneol=native#text/pascal
packager/globallinks/README.txt svneol=native#text/plain
packager/globallinks/demopackagewithhelp-0.lpl svneol=native#text/plain
packager/globallinks/h2paswizard-0.lpl svneol=native#text/plain
packager/globallinks/lazcustomform-0.lpl svneol=native#text/plain
packager/globallinks/lazopenglcontext-0.lpl svneol=native#text/plain

8
components/printers/osprinters.pas
View File

@ -35,21 +35,21 @@ unit OSPrinters;
interface
{$IFDEF UNIX}
{$I ./unix/cupsprinters_h.inc}
{$I cupsprinters_h.inc}
{$ENDIF}
{$IFDEF MSWindows}
{$I ./win32/winprinters_h.inc}
{$I winprinters_h.inc}
{$ENDIF}
implementation
{$IFDEF UNIX}
{$I ./unix/cupsprinters.inc}
{$I cupsprinters.inc}
{$ENDIF}
{$IFDEF MSWindows}
{$I ./win32/winprinters.inc}
{$I winprinters.inc}
{$ENDIF}
end.

2
components/printers/printer4lazarus.lpk
View File

@ -6,7 +6,7 @@
<CompilerOptions>
<Version Value="5"/>
<SearchPaths>
<IncludeFiles Value="$(TargetOS)/"/>
<IncludeFiles Value="unix/;win32/"/>
<OtherUnitFiles Value="unix/;win32/"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>

12
components/printers/sample/selectprinter.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<PathDelim Value="/"/>
<Version Value="5"/>
<General>
<Flags>
@ -15,7 +15,6 @@
</General>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
@ -23,7 +22,7 @@
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="2">
@ -49,20 +48,19 @@
<UnitName Value="frmselprinter"/>
</Unit1>
<Unit2>
<Filename Value="..\..\..\..\..\..\..\lazarus\components\PRINTERS\WIN32\winprndialogs.inc"/>
<Filename Value="../../../../../../../lazarus/components/PRINTERS/WIN32/winprndialogs.inc"/>
<IsPartOfProject Value="True"/>
</Unit2>
<Unit3>
<Filename Value="..\..\..\..\..\..\..\lazarus\components\PRINTERS\LINUX\cupsprndialogs.inc"/>
<Filename Value="../../../../../../../lazarus/components/PRINTERS/LINUX/cupsprndialogs.inc"/>
<IsPartOfProject Value="True"/>
</Unit3>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<SearchPaths>
<SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/>
<SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>

19
components/printers/unix/cupsprinters.inc
View File

@ -236,8 +236,7 @@ begin
end;
end;
//Initialize the options with the default options of selected
//printer
//Initialize the options with the default options of selected printer
procedure TCUPSPrinter.SetOptionsOfPrinter;
Var Opts : Pcups_option_t;
Opt : Pcups_option_t;
@ -310,17 +309,22 @@ var
Attribute : Pipp_attribute_t; //Current attribute
i : Integer;
begin
//DebugLn(['TCUPSPrinter.GetEnumAttributeString START aName="',aName,'"']);
if not assigned(Lst) then
raise Exception.Create('Lst must be assigned');
if not CUPSLibInstalled then Exit;
if not CUPSLibInstalled then begin
DebugLn(['TCUPSPrinter.GetEnumAttributeString CUPSLibInstalled not installed']);
Exit;
end;
Reponse:=GetCupsRequest;
if Assigned(Reponse) then
begin
if not Assigned(Reponse) then begin
DebugLn(['TCUPSPrinter.GetEnumAttributeString no Reponse']);
end else begin
try
Attribute:=ippFindAttribute(Reponse,aName, IPP_TAG_ZERO);
if Assigned(Attribute) then
begin
if Assigned(Attribute) then begin
//DebugLn(['TCUPSPrinter.GetEnumAttributeString Attribute^.num_values=',Attribute^.num_values]);
for i:=0 to Attribute^.num_values-1 do
begin
if Attribute^.value_tag=IPP_TAG_INTEGER then
@ -516,6 +520,7 @@ end;
procedure TCUPSPrinter.DoEnumPapers(Lst: TStrings);
begin
//DebugLn(['TCUPSPrinter.DoEnumPapers ',dbgsName(Self)]);
inherited DoEnumPapers(Lst);
GetEnumAttributeString('media-supported',Lst);

16
examples/helpforpackage/README.txt Normal file
View File

@ -0,0 +1,16 @@
This package (demopackagewithhelp.lpk) demonstrates how to register help in the
IDE for the sources of a package.
The help itself is in fpdoc format.
Here is an example how to create the basic fpdoc xml file from the source:
makeskel --package=demopackagewithhelp --input=pkghelpdemounit1.pas --output=xml/pkghelpdemounit1.xml
Use the program LazDE (lazarus/doceditor/lazde.lpi)
or LazDoc tool in the IDE to write some documentation.
Then create the html files from the xml files:
cd html && fpdoc --package=demopackagewithhelp --descr=../xml/pkghelpdemounit1.xml --input=../pkghelpdemounit1.pas

42
examples/helpforpackage/demopackagewithhelp.lpk Normal file
View File

@ -0,0 +1,42 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="2">
<Name Value="DemoPackageWithHelp"/>
<CompilerOptions>
<Version Value="5"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Files Count="1">
<Item1>
<Filename Value="pkghelpdemounit1.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="PkgHelpDemoUnit1"/>
</Item1>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="IDEIntf"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>
</CONFIG>

21
examples/helpforpackage/demopackagewithhelp.pas Normal file
View File

@ -0,0 +1,21 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit DemoPackageWithHelp;
interface
uses
PkgHelpDemoUnit1, LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('PkgHelpDemoUnit1', @PkgHelpDemoUnit1.Register);
end;
initialization
RegisterPackage('DemoPackageWithHelp', @Register);
end.

26
examples/helpforpackage/html/index.html Normal file
View File

@ -0,0 +1,26 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<title>Reference for package 'demopackagewithhelp'</title>
<link rel="stylesheet" type="text/css" href="fpdoc.css">
</head>
<body>
<table cellpadding="4" cellspacing="0" border="0" width="100%" class="bar">
<tr>
<td><b></b></td>
<td align="right"><span class="bartitle"> (<a href="index.html">#demopackagewithhelp</a>)</span></td>
</tr>
</table>
<h1>Reference for package 'demopackagewithhelp'</h1>
<p></p>
<h2>Units</h2>
<table cellspacing="0" cellpadding="0">
<tr>
<td valign="top"><p><tt><span class="code"><a href="pkghelpdemounit1/index.html">PkgHelpDemoUnit1</a></span></tt></p></td>
<td><p>&nbsp;&nbsp;</p></td>
<td><p class="cmt"></p></td>
</tr>
</table>
</body>
</html>

24
examples/helpforpackage/html/pkghelpdemounit1/index-5.html Normal file
View File

@ -0,0 +1,24 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<title>Reference for unit 'PkgHelpDemoUnit1': Procedures and functions</title>
<link rel="stylesheet" type="text/css" href="../fpdoc.css">
</head>
<body>
<table cellpadding="4" cellspacing="0" border="0" width="100%" class="bar">
<tr>
<td><b>[<a href="../pkghelpdemounit1/index.html">Overview</a>][Procedures and functions]</b></td>
<td align="right"><span class="bartitle">Reference for unit 'PkgHelpDemoUnit1' (<a href="../index.html">#demopackagewithhelp</a>)</span></td>
</tr>
</table>
<h1>Reference for unit 'PkgHelpDemoUnit1': Procedures and functions</h1>
<table cellspacing="0" cellpadding="0">
<tr>
<td valign="top"><p><tt><span class="code"><a href="../pkghelpdemounit1/register.html">Register</a></span></tt></p></td>
<td><p>&nbsp;&nbsp;</p></td>
<td><p class="cmt"></p></td>
</tr>
</table>
</body>
</html>

32
examples/helpforpackage/html/pkghelpdemounit1/index.html Normal file
View File

@ -0,0 +1,32 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<title>Reference for unit 'PkgHelpDemoUnit1'</title>
<link rel="stylesheet" type="text/css" href="../fpdoc.css">
</head>
<body>
<table cellpadding="4" cellspacing="0" border="0" width="100%" class="bar">
<tr>
<td><b>[Overview][<a href="../pkghelpdemounit1/index-5.html">Procedures and functions</a>]</b></td>
<td align="right"><span class="bartitle">Reference for unit 'PkgHelpDemoUnit1' (<a href="../index.html">#demopackagewithhelp</a>)</span></td>
</tr>
</table>
<h1>Reference for unit 'PkgHelpDemoUnit1'</h1>
<p></p>
<table cellspacing="0" cellpadding="0">
<tr>
<td><p><tt><span class="code"><span class="kw">uses</span></span></tt></p></td>
</tr>
<tr>
<td valign="top"><p><tt><span class="code">&nbsp;&nbsp;Classes<span class="sym">,</span> </span></tt></p></td>
</tr>
<tr>
<td valign="top"><p><tt><span class="code">&nbsp;&nbsp;SysUtils<span class="sym">,</span> </span></tt></p></td>
</tr>
<tr>
<td valign="top"><p><tt><span class="code">&nbsp;&nbsp;HelpFPDoc<span class="sym">;</span> </span></tt></p></td>
</tr>
</table>
</body>
</html>

25
examples/helpforpackage/html/pkghelpdemounit1/register.html Normal file
View File

@ -0,0 +1,25 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<title>Register</title>
<link rel="stylesheet" type="text/css" href="../fpdoc.css">
</head>
<body>
<table cellpadding="4" cellspacing="0" border="0" width="100%" class="bar">
<tr>
<td><b>[<a href="../pkghelpdemounit1/index.html">Overview</a>][<a href="../pkghelpdemounit1/index-5.html">Procedures and functions</a>]</b></td>
<td align="right"><span class="bartitle">Reference for unit 'PkgHelpDemoUnit1' (<a href="../index.html">#demopackagewithhelp</a>)</span></td>
</tr>
</table>
<h1>Register</h1>
<p></p>
<h2>Declaration</h2>
<p>Source position: pkghelpdemounit1.pas line 28</p>
<table cellspacing="0" cellpadding="0">
<tr>
<td><p><tt><span class="code"><span class="kw">procedure</span> Register<span class="sym">;</span></span></tt></p></td>
</tr>
</table>
</body>
</html>

39
examples/helpforpackage/pkghelpdemounit1.pas Normal file
View File

@ -0,0 +1,39 @@
{
*****************************************************************************
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
Author: Mattias Gaertner
Abstract:
Example unit demonstrating how to register IDE online help for the sources
of a package.
}
unit PkgHelpDemoUnit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, HelpFPDoc;
procedure Register;
implementation
procedure Register;
begin
RegisterFPDocHTMLHelpForPackage('Demo Help DB','Demo Help Database',
'file://$PkgDir(DemoPackageWithHelp)/html','DemoPackageWithHelp');
end;
end.

57
examples/helpforpackage/xml/pkghelpdemounit1.xml Normal file
View File

@ -0,0 +1,57 @@
<?xml version="1.0" encoding="ISO-8859-1"?>
<fpdoc-descriptions>
<package name="demopackagewithhelp">
<!--
====================================================================
PkgHelpDemoUnit1
====================================================================
-->
<module name="PkgHelpDemoUnit1">
<short></short>
<descr>
</descr>
<!-- unresolved type reference Visibility: default -->
<element name="Classes">
<short></short>
<descr>
</descr>
<seealso>
</seealso>
</element>
<!-- unresolved type reference Visibility: default -->
<element name="SysUtils">
<short></short>
<descr>
</descr>
<seealso>
</seealso>
</element>
<!-- unresolved type reference Visibility: default -->
<element name="HelpFPDoc">
<short></short>
<descr>
</descr>
<seealso>
</seealso>
</element>
<!-- procedure Visibility: default -->
<element name="Register">
<short></short>
<descr>
</descr>
<errors>
</errors>
<seealso>
</seealso>
</element>
</module> <!-- PkgHelpDemoUnit1 -->
</package>
</fpdoc-descriptions>

20
ide/main.pp
View File

@ -817,9 +817,9 @@ type
// methods for debugging, compiling and external tools
function GetTestBuildDirectory: string; override;
procedure OnMacroSubstitution(TheMacro: TTransferMacro; var s: string;
const Data: PtrInt;
var Handled, Abort: boolean);
procedure OnMacroSubstitution(TheMacro: TTransferMacro;
const MacroName: string; var s: string;
const Data: PtrInt; var Handled, Abort: boolean);
procedure GetIDEFileState(Sender: TObject; const AFilename: string;
NeededFlags: TIDEFileStateFlags; var ResultFlags: TIDEFileStateFlags); override;
@ -8952,25 +8952,27 @@ begin
FDisplayState:= dsSource;
end;
procedure TMainIDE.OnMacroSubstitution(TheMacro: TTransferMacro; var s:string;
procedure TMainIDE.OnMacroSubstitution(TheMacro: TTransferMacro;
const MacroName: string; var s:string;
const Data: PtrInt; var Handled, Abort: boolean);
var MacroName:string;
var MacroLName:string;
begin
if TheMacro=nil then begin
DebugLn('WARNING: Macro not defined: "'+s+'".');
DebugLn('WARNING: Macro not defined: "'+MacroName+'".');
s:='';
//MessageDlg('Unknown Macro','Macro not defined: "'+s+'".',mtError,[mbAbort],0);
DumpStack;
Handled:=true;
exit;
end;
MacroName:=lowercase(TheMacro.Name);
MacroLName:=lowercase(MacroName);
Handled:=true;
if MacroName='save' then begin
if MacroLName='save' then begin
if (SourceNoteBook<>nil) and (SourceNoteBook.NoteBook<>nil) then
Abort:=(DoSaveEditorFile(SourceNoteBook.NoteBook.PageIndex,
[sfCheckAmbiguousFiles])<>mrOk);
s:='';
end else if MacroName='saveall' then begin
end else if MacroLName='saveall' then begin
Abort:=(DoSaveAll([sfCheckAmbiguousFiles])<>mrOk);
s:='';
end else

13
ide/transfermacros.pp
View File

@ -51,11 +51,11 @@ uses Classes, SysUtils, LCLProc, FileUtil, LazarusIDEStrConsts, MacroIntf;
type
TTransferMacro = class;
TOnSubstitution = procedure(TheMacro: TTransferMacro; var s:string;
const Data: PtrInt; var Handled, Abort: boolean) of object;
TOnSubstitution = procedure(TheMacro: TTransferMacro; const MacroName: string;
var s:string; const Data: PtrInt; var Handled, Abort: boolean) of object;
TMacroFunction = function(const s:string; const Data: PtrInt;
var Abort: boolean):string of object;
TMacroFunction = function(const s: string; const Data: PtrInt;
var Abort: boolean): string of object;
TTransferMacroFlag = (
tmfInteractive
@ -296,6 +296,7 @@ begin
Handled:=false;
Abort:=false;
if MacroName<>'' then begin
if MacroName='PkgPath' then DebugLn(['TTransferMacroList.SubstituteStr MacroStr="',MacroStr,'"']);
// Macro function -> substitute macro parameter first
MacroParam:=copy(MacroStr,length(MacroName)+3,
length(MacroStr)-length(MacroName)-3);
@ -305,7 +306,7 @@ begin
end;
AMacro:=FindByName(MacroName);
if Assigned(fOnSubstitution) then begin
fOnSubstitution(AMacro,MacroParam,Data,Handled,Abort);
fOnSubstitution(AMacro,MacroName,MacroParam,Data,Handled,Abort);
if Handled then
MacroStr:=MacroParam
else if Abort then begin
@ -327,7 +328,7 @@ begin
MacroName:=copy(s,MacroStart+2,OldMacroLen-3);
AMacro:=FindByName(MacroName);
if Assigned(fOnSubstitution) then begin
fOnSubstitution(AMacro,MacroName,Data,Handled,Abort);
fOnSubstitution(AMacro,MacroName,MacroName,Data,Handled,Abort);
if Handled then
MacroStr:=MacroName
else if Abort then begin

50
ideintf/helpfpdoc.pas
View File

@ -39,9 +39,59 @@ type
var ErrMsg: string): TShowHelpResult; override;
end;
function RegisterFPDocHTMLHelpForPackage(const DBName, DBTitle, BaseURL,
PackageName: string; AdditionalDirectories: string = ''
): TFPDocHTMLHelpDatabase;
implementation
function RegisterFPDocHTMLHelpForPackage(const DBName, DBTitle, BaseURL,
PackageName: string; AdditionalDirectories: string
): TFPDocHTMLHelpDatabase;
{ It registers help for all *.pas and *.pp files of the package source
directory (where the .lpk file is) and all sub directories.
DBName: the database ID. The IDE will change it if there is already a DB
with this name.
DBTitle: the localized title shown in IDE dialogs.
BaseURL: all paths are relative to this URL.
PackageName: the name of the package.
AdditionalDirectories: additional source directories separated by semicolon.
Paths must be relative to the package source directory.
}
var
FPDocNode: THelpNode;
p: LongInt;
Dir: String;
begin
// create help database
Result:=TFPDocHTMLHelpDatabase(
HelpDatabases.CreateHelpDatabase(DBName,TFPDocHTMLHelpDatabase,true));
Result.DefaultBaseURL:=BaseURL;
// FPDoc nodes for units in the LCL
FPDocNode:=THelpNode.CreateURL(Result,DBTitle,'file://index.html');
// register TOC (table of contents)
Result.TOCNode:=THelpNode.Create(Result,FPDocNode);
// register fpdoc item
Result.RegisterItem(THelpDBISourceDirectory.Create(FPDocNode,
'$PkgDir('+PackageName+')',
'*.pp;*.pas', // this entry is for pascal files
true // for this source directory and all sub directories.
));
// register additional source directories
while AdditionalDirectories<>'' do begin
p:=System.Pos(';',AdditionalDirectories);
if p<1 then p:=length(AdditionalDirectories);
Dir:=Trim(copy(AdditionalDirectories,1,p-1));
if Dir<>'' then begin
FPDocNode:=THelpNode.CreateURL(Result,DBTitle+' '+Dir,'file://index.html');
Result.RegisterItem(THelpDBISourceDirectory.Create(FPDocNode,
'$PkgDir('+PackageName+')'+Dir,'*.pp;*.pas',false));
end;
System.Delete(AdditionalDirectories,1,p);
end;
end;
{ TFPDocHTMLHelpDatabase }
function TFPDocHTMLHelpDatabase.ShowHelp(Query: THelpQuery; BaseNode,

2
lcl/helpintfs.pas
View File

@ -217,7 +217,7 @@ type
end;
var
HelpManager: THelpManager = nil;
HelpManager: THelpManager = nil;// set by the IDE
//==============================================================================
{ Showing help (how it works):

7
lcl/lazhelpintf.pas
View File

@ -986,12 +986,12 @@ begin
if (ListOfPascalHelpContextList=nil)
or (ListOfPascalHelpContextList.Count=0) then exit;
// add the registered nodes
debugln('THelpDatabase.GetNodesForPascalContexts A ListOfPascalHelpContextList.Count=',dbgs(ListOfPascalHelpContextList.Count));
debugln('THelpDatabase.GetNodesForPascalContexts A ID="',ID,'" ListOfPascalHelpContextList.Count=',dbgs(ListOfPascalHelpContextList.Count));
if FSearchItems<>nil then begin
// check every pascal context
for j:=0 to ListOfPascalHelpContextList.Count-1 do begin
PascalContext:=TPascalHelpContextList(ListOfPascalHelpContextList[j]);
debugln('THelpDatabase.GetNodesForPascalContexts A PascalContext.Count=',dbgs(PascalContext.Count));
//debugln('THelpDatabase.GetNodesForPascalContexts A ID="',ID,'" PascalContext.Count=',dbgs(PascalContext.Count));
if (PascalContext.Count>0)
and (PascalContext.List[0].Descriptor=pihcFilename) then begin
// search file item
@ -1000,7 +1000,7 @@ begin
if not (SearchItem is THelpDBISourceFile) then continue;
FileItem:=THelpDBISourceFile(SearchItem);
Filename:=PascalContext.List[0].Context;
debugln('THelpDatabase.GetNodesForPascalContexts B FileItem.ClassName=',FileItem.ClassName,' Filename=',Filename,' FileItem.GetFullFilename="',FileItem.GetFullFilename,'"');
//debugln('THelpDatabase.GetNodesForPascalContexts B FileItem.ClassName=',FileItem.ClassName,' Filename=',Filename,' FileItem.GetFullFilename="',FileItem.GetFullFilename,'"');
if (FileItem.FileMatches(Filename)) then begin
CreateNodeQueryListAndAdd(FileItem.Node,PascalContext,ListOfNodes,true);
debugln('THelpDatabase.GetNodesForPascalContexts C FileItem.ClassName=',FileItem.ClassName,' Filename=',Filename,' ',dbgs(ListOfNodes.Count));
@ -2227,6 +2227,7 @@ var
ExpFilename: String;
begin
ExpFilename:=FFilename;
//DebugLn(['THelpDBISourceFile.GetFullFilename ExpFilename="',ExpFilename,'"']);
if (HelpDatabases<>nil) then
HelpDatabases.SubstituteMacros(ExpFilename);
ExpFilename:=TrimFilename(ExpFilename);

10
lcl/printers.pas
View File

@ -28,7 +28,7 @@ unit Printers;
interface
uses
Classes, SysUtils,Graphics;
Classes, SysUtils, LCLProc, Graphics;
type
TPrinter = Class;
EPrinter = class(Exception);
@ -660,6 +660,8 @@ end;
//Initialize the Lst with all supported papers names
procedure TPrinter.DoEnumPapers(Lst: TStrings);
begin
//DebugLn(['TPrinter.DoEnumPapers ',dbgsName(Self)]);
//Override this methode
end;
@ -781,11 +783,13 @@ end;
function TPaperSize.GetSupportedPapers: TStrings;
begin
if (fOwnedPrinter.Printers.Count>0) and
((fSupportedPapers.Count=0) or (fLastPrinterIndex<>fOwnedPrinter.PrinterIndex)) then
((fSupportedPapers.Count=0)
or (fLastPrinterIndex<>fOwnedPrinter.PrinterIndex)) then
begin
fOwnedPrinter.SelectCurrentPrinterOrDefault;
fSupportedPapers.Clear;
//DebugLn(['TPaperSize.GetSupportedPapers ',dbgsName(fOwnedPrinter),' ',dbgsName(Printer),' ',fOwnedPrinter=Printer]);
fOwnedPrinter.DoEnumPapers(fSupportedPapers);
fLastPrinterIndex:=fOwnedPrinter.PrinterIndex;
end;
@ -817,7 +821,7 @@ begin
begin
Result := TmpPaperRect;
end
else raise EPrinter.Create(Format('The paper "%s" as not definied rect ! ',[aName]));
else raise EPrinter.Create(Format('The paper "%s" has no defined rectangle ! ',[aName]));
end
else raise EPrinter.Create(Format('Paper "%s" not supported !',[aName]));
end;

1
packager/globallinks/demopackagewithhelp-0.lpl Normal file
View File

@ -0,0 +1 @@
$(LazarusDir)/examples/helpforpackage/demopackagewithhelp.lpk

15
packager/packagedefs.pas
View File

@ -615,7 +615,8 @@ type
procedure SetName(const AValue: string); override;
procedure SetPackageEditor(const AValue: TBasePackageEditor);
procedure SetPackageType(const AValue: TLazPackageType);
procedure OnMacroListSubstitution(TheMacro: TTransferMacro; var s: string;
procedure OnMacroListSubstitution(TheMacro: TTransferMacro;
const MacroName: string; var s: string;
const Data: PtrInt; var Handled, Abort: boolean);
procedure SetUserReadOnly(const AValue: boolean);
procedure GetWritableOutputDirectory(var AnOutDir: string);
@ -1980,7 +1981,8 @@ end;
{ TLazPackage }
procedure TLazPackage.OnMacroListSubstitution(TheMacro: TTransferMacro;
var s: string; const Data: PtrInt; var Handled, Abort: boolean);
const MacroName: string; var s: string; const Data: PtrInt;
var Handled, Abort: boolean);
begin
if CompareText(s,'PkgOutDir')=0 then begin
Handled:=true;
@ -3296,11 +3298,14 @@ begin
do
inc(IdentEndPos);
if IdentEndPos=1 then exit;
Name:=copy(s,1,IdentEndPos-1);
StartPos:=IdentEndPos;
while (StartPos<=length(s)) and (s[StartPos]=' ') do inc(StartPos);
if StartPos=IdentEndPos then exit;
if not Version.ReadString(copy(s,StartPos,length(s))) then exit;
Name:=copy(s,1,IdentEndPos-1);
if StartPos=IdentEndPos then begin
Version.Clear;
end else begin
if not Version.ReadString(copy(s,StartPos,length(s))) then exit;
end;
Result:=true;
end;

137
packager/packagesystem.pas
View File

@ -48,7 +48,8 @@ uses
// FPC + LCL
Classes, SysUtils, FileUtil, LCLProc, Forms, Controls, Dialogs,
// codetools
AVL_Tree, Laz_XMLCfg, CodeCache, BasicCodeTools, CodeToolManager,
AVL_Tree, Laz_XMLCfg, DefineTemplates, CodeCache, BasicCodeTools,
CodeToolManager,
// IDEIntf,
SrcEditorIntf, IDEExternToolIntf, IDEDialogs, IDEMsgIntf, PackageIntf,
// IDE
@ -148,6 +149,20 @@ type
procedure EndUpdate;
function Updating: boolean;
procedure RebuildDefineTemplates;
function MacroFunctionPkgDir(const s: string; const Data: PtrInt;
var Abort: boolean): string;
function MacroFunctionPkgSrcPath(const s: string; const Data: PtrInt;
var Abort: boolean): string;
function MacroFunctionPkgUnitPath(const s: string; const Data: PtrInt;
var Abort: boolean): string;
function MacroFunctionPkgIncPath(const s: string; const Data: PtrInt;
var Abort: boolean): string;
function MacroFunctionCTPkgDir(Data: Pointer): boolean;
function MacroFunctionCTPkgSrcPath(Data: Pointer): boolean;
function MacroFunctionCTPkgUnitPath(Data: Pointer): boolean;
function MacroFunctionCTPkgIncPath(Data: Pointer): boolean;
function GetPackageFromMacroParameter(const TheID: string;
out APackage: TLazPackage): boolean;
public
// searching
function CheckIfPackageCanBeClosed(APackage: TLazPackage): boolean;
@ -459,6 +474,19 @@ begin
FTree:=TAVLTree.Create(@CompareLazPackageID);
FItems:=TFPList.Create;
FLazarusBasePackages:=TFPList.Create;
if GlobalMacroList<>nil then begin
GlobalMacroList.Add(TTransferMacro.Create('PKGDIR','',
'package directory. parameter is package id.',@MacroFunctionPkgDir,[]));
GlobalMacroList.Add(TTransferMacro.Create('PKGSRCPATH','',
'package source search path. parameter is package id.',
@MacroFunctionPkgSrcPath,[]));
GlobalMacroList.Add(TTransferMacro.Create('PKGUNITATH','',
'package unit search path. parameter is package id.',
@MacroFunctionPkgUnitPath,[]));
GlobalMacroList.Add(TTransferMacro.Create('PKGINCPATH','',
'package include files search path. parameter is package id.',
@MacroFunctionPkgIncPath,[]));
end;
end;
destructor TLazPackageGraph.Destroy;
@ -538,6 +566,113 @@ begin
Packages[i].DefineTemplates.AllChanged;
end;
function TLazPackageGraph.MacroFunctionPkgDir(const s: string;
const Data: PtrInt; var Abort: boolean): string;
var
APackage: TLazPackage;
begin
if GetPackageFromMacroParameter(s,APackage) then
Result:=APackage.Directory
else
Result:='';
end;
function TLazPackageGraph.MacroFunctionPkgSrcPath(const s: string;
const Data: PtrInt; var Abort: boolean): string;
var
APackage: TLazPackage;
begin
if GetPackageFromMacroParameter(s,APackage) then
Result:=APackage.SourceDirectories.CreateSearchPathFromAllFiles
else
Result:='';
end;
function TLazPackageGraph.MacroFunctionPkgUnitPath(const s: string;
const Data: PtrInt; var Abort: boolean): string;
var
APackage: TLazPackage;
begin
if GetPackageFromMacroParameter(s,APackage) then
Result:=APackage.GetUnitPath(false)
else
Result:='';
end;
function TLazPackageGraph.MacroFunctionPkgIncPath(const s: string;
const Data: PtrInt; var Abort: boolean): string;
var
APackage: TLazPackage;
begin
if GetPackageFromMacroParameter(s,APackage) then
Result:=APackage.GetIncludePath(false)
else
Result:='';
end;
function TLazPackageGraph.MacroFunctionCTPkgDir(Data: Pointer): boolean;
var
FuncData: PReadFunctionData;
APackage: TLazPackage;
begin
FuncData:=PReadFunctionData(Data);
Result:=GetPackageFromMacroParameter(FuncData^.Param,APackage);
if Result then
FuncData^.Result:=APackage.Directory;
end;
function TLazPackageGraph.MacroFunctionCTPkgSrcPath(Data: Pointer): boolean;
var
FuncData: PReadFunctionData;
APackage: TLazPackage;
begin
FuncData:=PReadFunctionData(Data);
Result:=GetPackageFromMacroParameter(FuncData^.Param,APackage);
if Result then
FuncData^.Result:=APackage.SourceDirectories.CreateSearchPathFromAllFiles;
end;
function TLazPackageGraph.MacroFunctionCTPkgUnitPath(Data: Pointer): boolean;
var
FuncData: PReadFunctionData;
APackage: TLazPackage;
begin
FuncData:=PReadFunctionData(Data);
Result:=GetPackageFromMacroParameter(FuncData^.Param,APackage);
if Result then
FuncData^.Result:=APackage.GetUnitPath(false);
end;
function TLazPackageGraph.MacroFunctionCTPkgIncPath(Data: Pointer): boolean;
var
FuncData: PReadFunctionData;
APackage: TLazPackage;
begin
FuncData:=PReadFunctionData(Data);
Result:=GetPackageFromMacroParameter(FuncData^.Param,APackage);
if Result then
FuncData^.Result:=APackage.GetIncludePath(false);
end;
function TLazPackageGraph.GetPackageFromMacroParameter(const TheID: string;
out APackage: TLazPackage): boolean;
var
PkgID: TLazPackageID;
begin
PkgID:=TLazPackageID.Create;
if PkgID.StringToID(TheID) then begin
APackage:=FindPackageWithID(PkgID);
if APackage=nil then begin
DebugLn('WARNING: TLazPackageGraph.GetPackageFromMacroParameter unknown package id "',TheID,'"');
end;
end else begin
APackage:=nil;
DebugLn('WARNING: TLazPackageGraph.GetPackageFromMacroParameter invalid package id "',TheID,'"');
end;
PkgID.Free;
Result:=APackage<>nil;
end;
function TLazPackageGraph.FindLowestPkgNodeByName(const PkgName: string
): TAVLTreeNode;
var

4
packager/pkggraphexplorer.pas
View File

@ -199,7 +199,7 @@ begin
if Dependency<>nil then begin
// node is a not fullfilled dependency
AllowExpansion:=false;
end else begin
end else if Pkg<>nil then begin
// node is a package
ViewNode:=Node.GetFirstChild;
Dependency:=Pkg.FirstRequiredDependency;
@ -239,6 +239,8 @@ begin
ViewNode.Free;
ViewNode:=NextViewNode;
end;
end else begin
DebugLn(['TPkgGraphExplorerDlg.PkgTreeViewExpanding Node has no package ',Node.Text]);
end;
end;

109
packager/pkgmanager.pas
View File

@ -161,10 +161,6 @@ type
function CheckPackageGraphForCompilation(APackage: TLazPackage;
FirstDependency: TPkgDependency;
const Directory: string): TModalResult;
function MacroFunctionPkgPath(Data: Pointer): boolean;
function MacroFunctionPkgSrcPath(Data: Pointer): boolean;
function MacroFunctionPkgUnitPath(Data: Pointer): boolean;
function MacroFunctionPkgIncPath(Data: Pointer): boolean;
function DoGetUnitRegisterInfo(const AFilename: string;
var TheUnitName: string; var HasRegisterProc: boolean;
IgnoreErrors: boolean): TModalResult;
@ -1458,103 +1454,6 @@ begin
Result:=mrOk;
end;
function TPkgManager.MacroFunctionPkgPath(Data: Pointer): boolean;
var
FuncData: PReadFunctionData;
PkgID: TLazPackageID;
APackage: TLazPackage;
begin
FuncData:=PReadFunctionData(Data);
PkgID:=TLazPackageID.Create;
Result:=false;
if PkgID.StringToID(FuncData^.Param) then begin
APackage:=PackageGraph.FindPackageWithID(PkgID);
if APackage<>nil then begin
FuncData^.Result:=APackage.Directory;
Result:=true;
end else begin
DebugLn('WARNING: TPkgManager.MacroFunctionPkgPath unknown package id: ',FuncData^.Param);
end;
end else begin
DebugLn('WARNING: TPkgManager.MacroFunctionPkgPath invalid package id: ',FuncData^.Param);
end;
PkgID.Free;
end;
function TPkgManager.MacroFunctionPkgSrcPath(Data: Pointer): boolean;
var
FuncData: PReadFunctionData;
PkgID: TLazPackageID;
APackage: TLazPackage;
begin
FuncData:=PReadFunctionData(Data);
PkgID:=TLazPackageID.Create;
Result:=false;
if PkgID.StringToID(FuncData^.Param) then begin
APackage:=PackageGraph.FindPackageWithID(PkgID);
if APackage<>nil then begin
FuncData^.Result:=APackage.SourceDirectories.CreateSearchPathFromAllFiles;
Result:=true;
end else begin
DebugLn('WARNING: TPkgManager.MacroFunctionPkgSrcPath unknown package id: ',FuncData^.Param);
end;
//if AnsiCompareText(APackage.IDAsString,'uni_avglvltree')=0 then begin
//debugln('TPkgManager.MacroFunctionPkgSrcPath PkgID=',FuncData^.Param,' ',dbgs(APackage<>nil),' FuncData^.Result="',FuncData^.Result,'"');
{if APackage<>nil then begin
with APackage.SourceDirectories.CreateFileList do begin
debugln(Text);
Free;
end;
end;}
//end;
end else begin
DebugLn('WARNING: TPkgManager.MacroFunctionPkgSrcPath invalid package id: ',FuncData^.Param);
end;
PkgID.Free;
end;
function TPkgManager.MacroFunctionPkgUnitPath(Data: Pointer): boolean;
var
FuncData: PReadFunctionData;
PkgID: TLazPackageID;
APackage: TLazPackage;
begin
FuncData:=PReadFunctionData(Data);
PkgID:=TLazPackageID.Create;
Result:=false;
if PkgID.StringToID(FuncData^.Param) then begin
APackage:=PackageGraph.FindPackageWithID(PkgID);
if APackage<>nil then begin
FuncData^.Result:=APackage.GetUnitPath(false);
Result:=true;
end else begin
DebugLn('WARNING: TPkgManager.MacroFunctionPkgUnitPath unknown package id: ',FuncData^.Param);
end;
end else begin
DebugLn('WARNING: TPkgManager.MacroFunctionPkgUnitPath invalid package id: ',FuncData^.Param);
end;
PkgID.Free;
end;
function TPkgManager.MacroFunctionPkgIncPath(Data: Pointer): boolean;
var
FuncData: PReadFunctionData;
PkgID: TLazPackageID;
APackage: TLazPackage;
begin
FuncData:=PReadFunctionData(Data);
PkgID:=TLazPackageID.Create;
Result:=false;
if PkgID.StringToID(FuncData^.Param) then begin
APackage:=PackageGraph.FindPackageWithID(PkgID);
if APackage<>nil then begin
FuncData^.Result:=APackage.GetIncludePath(false);
Result:=true;
end;
end;
PkgID.Free;
end;
function TPkgManager.DoGetUnitRegisterInfo(const AFilename: string;
var TheUnitName: string; var HasRegisterProc: boolean; IgnoreErrors: boolean
): TModalResult;
@ -1812,13 +1711,13 @@ begin
// package macros
CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
'PKGPATH',nil,@MacroFunctionPkgPath);
'PKGDIR',nil,@PackageGraph.MacroFunctionCTPkgDir);
CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
'PKGSRCPATH',nil,@MacroFunctionPkgSrcPath);
'PKGSRCPATH',nil,@PackageGraph.MacroFunctionCTPkgSrcPath);
CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
'PKGUNITPATH',nil,@MacroFunctionPkgUnitPath);
'PKGUNITPATH',nil,@PackageGraph.MacroFunctionCTPkgUnitPath);
CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
'PKGINCPATH',nil,@MacroFunctionPkgIncPath);
'PKGINCPATH',nil,@PackageGraph.MacroFunctionCTPkgIncPath);
LazPackageDescriptors:=TLazPackageDescriptors.Create;
LazPackageDescriptors.AddDefaultPackageDescriptors;