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

IDE: started css for lazdoc

Browse Source 
git-svn-id: trunk@30473 -
This commit is contained in:
mattias 2011-04-25 21:21:35 +00:00
parent a5e1656dfb
commit 678eb31e5f
7 changed files with 313 additions and 85 deletions

1
.gitattributes vendored
View File

@ -2926,6 +2926,7 @@ docs/html/sourceforgefooter.xml svneol=native#text/xml
docs/images/laztitle.png -text
docs/images/laztitle.svg -text svneol=native#image/svg%2Bxml
docs/index.html svneol=native#text/html
docs/lazdoc.css svneol=native#text/plain
docs/xml/README.txt svneol=native#text/plain
docs/xml/fcl/bmpcomn.xml svneol=native#text/xml
docs/xml/fcl/clipping.xml svneol=native#text/xml

159
components/turbopower_ipro/design/ipidehtmlcontrol.pas
View File

@ -22,30 +22,44 @@ unit IPIDEHTMLControl;
interface
uses
Classes, SysUtils, LCLProc, Graphics, Controls, Dialogs,
IpHtml, IDEHelpIntf, LazHelpIntf;
Classes, SysUtils, math, LCLProc, Graphics, Controls, Dialogs,
IpMsg, Ipfilebroker, IpHtml, IDEHelpIntf, LazHelpIntf;
type
TSimpleIpHtml = class(TIpHtml)
TLazIPHtmlControl = class;
{ TLazIpHtmlDataProvider }
TLazIpHtmlDataProvider = class(TIpHtmlDataProvider)
private
FControl: TLazIPHtmlControl;
protected
function DoGetStream(const URL: string): TStream; override;
public
property OnGetImageX;
property Control: TLazIPHtmlControl read FControl;
end;
{ TIPLazHtmlControl }
{ TLazIPHtmlControl }
TIPLazHtmlControl = class(TIpHtmlPanel,TIDEHTMLControlIntf)
TLazIPHtmlControl = class(TIpHtmlPanel,TIDEHTMLControlIntf)
function DataProviderCanHandle(Sender: TObject; const URL: string): Boolean;
procedure DataProviderCheckURL(Sender: TObject; const URL: string;
var Available: Boolean; var ContentType: string);
procedure DataProviderGetHtml(Sender: TObject; const URL: string;
const {%H-}aPostData: TIpFormDataEntity; var Stream: TStream);
procedure DataProviderGetImage(Sender: TIpHtmlNode; const URL: string;
var Picture: TPicture);
procedure DataProviderLeave(Sender: TIpHtml);
procedure DataProviderReportReference(Sender: TObject; const URL: string);
private
FProvider: TAbstractIDEHTMLProvider;
FIDEProvider: TAbstractIDEHTMLProvider;
FURL: string;
procedure SetProvider(const AValue: TAbstractIDEHTMLProvider);
procedure HTMLGetImageX(Sender: TIpHtmlNode; const URL: string;
var Picture: TPicture);
public
constructor Create(AOwner: TComponent); override;
function GetURL: string;
procedure SetURL(const AValue: string);
property Provider: TAbstractIDEHTMLProvider read FProvider write SetProvider;
procedure SetHTMLContent(Stream: TStream);
property IDEProvider: TAbstractIDEHTMLProvider read FIDEProvider write FIDEProvider;
procedure SetHTMLContent(Stream: TStream; const NewURL: string);
procedure GetPreferredControlSize(out AWidth, AHeight: integer);
end;
@ -64,25 +78,49 @@ end;
function IPCreateLazIDEHTMLControl(Owner: TComponent;
var Provider: TAbstractIDEHTMLProvider): TControl;
var
HTMLControl: TIPLazHtmlControl;
HTMLControl: TLazIPHtmlControl;
begin
HTMLControl:=TIPLazHtmlControl.Create(Owner);
HTMLControl:=TLazIPHtmlControl.Create(Owner);
Result:=HTMLControl;
if Provider=nil then
Provider:=CreateIDEHTMLProvider(HTMLControl);
Provider.ControlIntf:=HTMLControl;
HTMLControl.Provider:=Provider;
HTMLControl.IDEProvider:=Provider;
end;
{ TIPLazHtmlControl }
{ TLazIpHtmlDataProvider }
procedure TIPLazHtmlControl.SetProvider(const AValue: TAbstractIDEHTMLProvider);
function TLazIpHtmlDataProvider.DoGetStream(const URL: string): TStream;
begin
if FProvider=AValue then exit;
FProvider:=AValue;
debugln(['TLazIpHtmlDataProvider.DoGetStream ',URL]);
Result:=Control.IDEProvider.GetStream(URL);
end;
procedure TIPLazHtmlControl.HTMLGetImageX(Sender: TIpHtmlNode;
{ TLazIPHtmlControl }
function TLazIPHtmlControl.DataProviderCanHandle(Sender: TObject;
const URL: string): Boolean;
begin
debugln(['TLazIPHtmlControl.DataProviderCanHandle URL=',URL]);
Result:=false;
end;
procedure TLazIPHtmlControl.DataProviderCheckURL(Sender: TObject;
const URL: string; var Available: Boolean; var ContentType: string);
begin
debugln(['TLazIPHtmlControl.DataProviderCheckURL URL=',URL]);
Available:=false;
ContentType:='';
end;
procedure TLazIPHtmlControl.DataProviderGetHtml(Sender: TObject;
const URL: string; const aPostData: TIpFormDataEntity; var Stream: TStream);
begin
debugln(['TLazIPHtmlControl.DataProviderGetHtml URL=',URL]);
Stream:=nil;
end;
procedure TLazIPHtmlControl.DataProviderGetImage(Sender: TIpHtmlNode;
const URL: string; var Picture: TPicture);
var
URLType: string;
@ -94,9 +132,9 @@ var
NewURL: String;
begin
//DebugLn(['TIPLazHtmlControl.HTMLGetImageX URL=',URL]);
if Provider=nil then exit;
NewURL:=Provider.BuildURL(Provider.BaseURL,URL);
//DebugLn(['TIPLazHtmlControl.HTMLGetImageX NewURL=',NewURL,' Provider.BaseURL=',Provider.BaseURL,' URL=',URL]);
if IDEProvider=nil then exit;
NewURL:=IDEProvider.MakeURLAbsolute(IDEProvider.BaseURL,URL);
//DebugLn(['TIPLazHtmlControl.HTMLGetImageX NewURL=',NewURL,' Provider.BaseURL=',IDEProvider.BaseURL,' URL=',URL]);
Picture:=nil;
Stream:=nil;
@ -109,15 +147,15 @@ begin
Ext:=ExtractFileExt(Filename);
//DebugLn(['TIPLazHtmlControl.HTMLGetImageX URLPath=',URLPath,' Filename=',Filename,' Ext=',Ext]);
Picture:=TPicture.Create;
// quick check if file format is supported
// quick check if file format is supported (raises an exception)
Picture.FindGraphicClassWithFileExt(Ext);
// get stream
Stream:=Provider.GetStream(NewURL);
Stream:=IDEProvider.GetStream(NewURL);
// load picture
Picture.LoadFromStreamWithFileExt(Stream,Ext);
finally
if Stream<>nil then
Provider.ReleaseStream(NewURL);
IDEProvider.ReleaseStream(NewURL);
end;
except
on E: Exception do begin
@ -127,43 +165,64 @@ begin
end;
end;
constructor TIPLazHtmlControl.Create(AOwner: TComponent);
procedure TLazIPHtmlControl.DataProviderLeave(Sender: TIpHtml);
begin
//debugln(['TLazIPHtmlControl.DataProviderLeave ']);
end;
procedure TLazIPHtmlControl.DataProviderReportReference(Sender: TObject;
const URL: string);
begin
debugln(['TLazIPHtmlControl.DataProviderReportReference URL=',URL]);
end;
constructor TLazIPHtmlControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
DefaultFontSize := 8;
MarginHeight := 0;
MarginWidth := 0;
MarginWidth := 0;
DataProvider:=TLazIpHtmlDataProvider.Create(Self);
with TLazIpHtmlDataProvider(DataProvider) do begin
FControl:=Self;
Name:='TLazIPHtmlControlDataProvider';
OnCanHandle:=@DataProviderCanHandle;
OnGetHtml:=@DataProviderGetHtml;
OnGetImage:=@DataProviderGetImage;
OnLeave:=@DataProviderLeave;
OnCheckURL:=@DataProviderCheckURL;
OnReportReference:=@DataProviderReportReference;
end;
end;
function TIPLazHtmlControl.GetURL: string;
function TLazIPHtmlControl.GetURL: string;
begin
Result:=FURL;
end;
procedure TIPLazHtmlControl.SetURL(const AValue: string);
procedure TLazIPHtmlControl.SetURL(const AValue: string);
var
Stream: TStream;
NewHTML: TSimpleIpHtml;
NewHTML: TIpHtml;
NewURL: String;
ok: Boolean;
begin
if Provider=nil then raise Exception.Create('TIPLazHtmlControl.SetURL missing Provider');
if IDEProvider=nil then raise Exception.Create('TIPLazHtmlControl.SetURL missing Provider');
if FURL=AValue then exit;
NewURL:=Provider.BuildURL(Provider.BaseURL,AValue);
NewURL:=IDEProvider.MakeURLAbsolute(IDEProvider.BaseURL,AValue);
if FURL=NewURL then exit;
FURL:=NewURL;
try
Stream:=Provider.GetStream(FURL);
Stream:=IDEProvider.GetStream(FURL);
ok:=false;
NewHTML:=nil;
try
NewHTML:=TSimpleIpHtml.Create; // Beware: Will be freed automatically TIpHtmlPanel
NewHTML.OnGetImageX:=@HTMLGetImageX;
NewHTML:=TIpHtml.Create; // Beware: Will be freed automatically TIpHtmlPanel
NewHTML.LoadFromStream(Stream);
ok:=true;
finally
if not ok then NewHTML.Free;
Provider.ReleaseStream(FURL);
IDEProvider.ReleaseStream(FURL);
end;
SetHtml(NewHTML);
except
@ -175,31 +234,25 @@ begin
end;
end;
procedure TIPLazHtmlControl.SetHTMLContent(Stream: TStream);
procedure TLazIPHtmlControl.SetHTMLContent(Stream: TStream; const NewURL: string
);
var
ok: Boolean;
NewHTML: TSimpleIpHtml;
NewHTML: TIpHtml;
begin
ok:=false;
NewHTML:=nil;
try
NewHTML:=TSimpleIpHtml.Create; // Beware: Will be freed automatically by TIpHtmlPanel
NewHTML.OnGetImageX:=@HTMLGetImageX;
NewHTML.LoadFromStream(Stream);
ok:=true;
finally
if not ok then NewHTML.Free;
end;
FURL:=NewURL;
NewHTML:=TIpHtml.Create; // Beware: Will be freed automatically by TIpHtmlPanel
SetHtml(NewHTML);
NewHTML.LoadFromStream(Stream);
end;
procedure TIPLazHtmlControl.GetPreferredControlSize(out AWidth, AHeight: integer);
procedure TLazIPHtmlControl.GetPreferredControlSize(out AWidth, AHeight: integer);
begin
with GetContentSize do
begin
AWidth := cx;
AHeight := cy;
AWidth := Max(0,Min(cx,10000));
AHeight := Max(0,Min(cy,10000));
end;
debugln(['TLazIPHtmlControl.GetPreferredControlSize Width=',AWidth,' Height=',AHeight]);
end;
end.

152
docs/lazdoc.css Normal file
View File

@ -0,0 +1,152 @@
body {
background: #ffffc0
}
body, p, th, td, caption, h1, h2, h3, ul, ol, dl {
color: black;
font-family: sans-serif
}
div {
margin: 0 0 0 0px;
padding: 0 0 0 0;
}
tt, span.keyword, pre {
font-family: Courier, monospace
}
body, p, th, td, caption, ul, ol, dl, tt, span.kw, pre {
font-size: 14px
}
A:link {
color: blue
}
A:visited {
color: darkblue
}
A:active {
color: red
}
A {
text-decoration: none
}
A:hover {
text-decoration: underline
}
h1, h2, td.h2 {
color: #005A9C
}
/* Especially for Netscape on Linux: */
h3, td.h3 {
font-size: 12pt
}
/* identifier in source fragments */
span.identifier {
}
/* symbols in source fragments */
span.symbol {
color: darkred
}
/* keywords in source fragments */
span.keyword {
font-weight: bold
}
/* comments in source fragments */
span.comment {
color: darkcyan;
font-style: italic
}
/* directives in source fragments */
span.directive {
color: darkyellow;
font-style: italic
}
/* numbers in source fragments */
span.number {
color: darkmagenta
}
/* characters (#...) in source fragments */
span.character {
color: darkcyan
}
/* strings in source fragments */
span.string {
color: blue
}
/* assembler passages in source fragments */
span.assembler {
color: green
}
td.pre {
white-space: pre
}
p.cmt {
color: gray
}
span.warning {
color: red;
font-weight: bold
}
span.file {
color: darkgreen
}
table.remark {
background-color: #ffffc0;
}
table.bar {
background-color: #a0c0ff;
}
span.bartitle {
font-weight: bold;
font-style: italic;
color: darkblue
}
/* definition list */
dl {
border: 3px double #ccc;
padding: 0.5em;
}
/* definition list: term */
dt {
float: left;
clear: left;
width: auto; /* normally browsers default width of largest item */
padding-right: 20px;
font-weight: bold;
color: darkgreen;
}
/* definition list: description */
dd {
margin: 0 0 0 110px;
padding: 0 0 0.5em 0;
}

2
ide/codehelp.pas
View File

@ -2500,7 +2500,7 @@ begin
finally
ElementNames.Free;
FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
HTMLHint:='<html><head><link rel="stylesheet" href="fpdoc.css" type="text/css"></head>'+LineEnding
HTMLHint:='<html><head><link rel="stylesheet" href="lazdoc://lazarus/lazdoc.css" type="text/css"></head>'+LineEnding
+'<body>'+LineEnding+HTMLHint+LineEnding+'</body>'+LineEnding;
end;
debugln(['TCodeHelpManager.GetHTMLHint2 ',HTMLHint]);

2
ide/fpdochints.pas
View File

@ -174,7 +174,7 @@ begin
if FHTMLHint<>'' then
ms.Write(FHTMLHint[1],length(FHTMLHint));
ms.Position:=0;
FHTMLProvider.ControlIntf.SetHTMLContent(ms);
FHTMLProvider.ControlIntf.SetHTMLContent(ms,'');
finally
ms.Free;
end;

53
ide/helpmanager.pas
View File

@ -107,7 +107,7 @@ type
function GetURL: string;
procedure SetURL(const AValue: string);
property Provider: TAbstractIDEHTMLProvider read FProvider write SetProvider;
procedure SetHTMLContent(Stream: TStream);
procedure SetHTMLContent(Stream: TStream; const NewURL: string);
procedure GetPreferredControlSize(out AWidth, AHeight: integer);
property MaxLineCount: integer read FMaxLineCount write FMaxLineCount;
end;
@ -402,7 +402,7 @@ var
begin
if Provider=nil then raise Exception.Create('TSimpleHTMLControl.SetURL missing Provider');
if FURL=AValue then exit;
NewURL:=Provider.BuildURL(Provider.BaseURL,AValue);
NewURL:=Provider.MakeURLAbsolute(Provider.BaseURL,AValue);
if FURL=NewURL then exit;
FURL:=NewURL;
try
@ -419,10 +419,12 @@ begin
end;
end;
procedure TSimpleHTMLControl.SetHTMLContent(Stream: TStream);
procedure TSimpleHTMLControl.SetHTMLContent(Stream: TStream;
const NewURL: string);
var
s: string;
begin
FURL:=NewURL;
SetLength(s,Stream.Size);
if s<>'' then
Stream.Read(s[1],length(s));
@ -508,21 +510,34 @@ end;
function TLIHProviders.GetStream(const URL: string): TStream;
procedure OpenFile(out Stream: TStream; const Filename: string);
procedure OpenFile(out Stream: TStream; const Filename: string;
UseCTCache: boolean);
var
fs: TFileStream;
ok: Boolean;
Buf: TCodeBuffer;
ms: TMemoryStream;
begin
fs:=nil;
ok:=false;
try
fs:=TFileStream.Create(UTF8ToSys(Filename),fmOpenRead);
//DebugLn(['OpenFile ',Filename,' ',fs.Size,' ',fs.Position]);
Stream:=fs;
ok:=true;
finally
if not ok then
fs.Free;
if UseCTCache then begin
Buf:=CodeToolBoss.LoadFile(Filename,true,false);
if Buf=nil then
raise Exception.Create('TLIHProviders.GetStream: unable to open file '+Filename);
ms:=TMemoryStream.Create;
Buf.SaveToStream(ms);
ms.Position:=0;
Result:=ms;
end else begin
fs:=nil;
ok:=false;
try
DebugLn(['TLIHProviders.GetStream.OpenFile ',Filename]);
fs:=TFileStream.Create(UTF8ToSys(Filename),fmOpenRead);
Stream:=fs;
ok:=true;
finally
if not ok then
fs.Free;
end;
end;
end;
@ -553,8 +568,12 @@ begin
URLPath:=copy(URLPath,9,length(URLPath));
if (URLPath='index.html')
or (URLPath='images/laztitle.jpg')
or (URLPath='images/cheetah1.png') then begin
OpenFile(Result,EnvironmentOptions.LazarusDirectory+PathDelim+'docs'+PathDelim+URLPath);
or (URLPath='images/cheetah1.png')
or (URLPath='lazdoc.css')
then begin
OpenFile(Result,
EnvironmentOptions.LazarusDirectory+SetDirSeparators('/docs/'+URLPath),
true);
end;
end;
end else begin
@ -1322,7 +1341,7 @@ begin
if TheHint<>'' then
ms.Write(TheHint[1],length(TheHint));
ms.Position:=0;
Provider.ControlIntf.SetHTMLContent(ms);
Provider.ControlIntf.SetHTMLContent(ms,'');
finally
ms.Free;
end;

29
ideintf/idehelpintf.pas
View File

@ -86,7 +86,7 @@ type
function GetURL: string;
procedure SetURL(const AValue: string);
property URL: string read GetURL write SetURL;
procedure SetHTMLContent(Stream: TStream);
procedure SetHTMLContent(Stream: TStream; const NewURL: string = '');
procedure GetPreferredControlSize(out AWidth, AHeight: integer);
end;
@ -112,7 +112,7 @@ type
If not found it raises an exception. }
procedure ReleaseStream(const URL: string); virtual; abstract;
property BaseURL: string read FBaseURL write SetBaseURL;// fallback for relative URLs
function BuildURL(const CurBaseURL, CurURL: string): string; virtual;
function MakeURLAbsolute(const aBaseURL, aURL: string): string; virtual;
property ControlIntf: TIDEHTMLControlIntf read FControlIntf write SetControlIntf;
end;
@ -123,7 +123,7 @@ type
var
CreateIDEHTMLControl: TCreateIDEHTMLControlEvent = nil;// will be set by the IDE
// and overidden by a package like turbopoweriprodsgn.lpk
// and can be overidden by a package like turbopoweriprodsgn.lpk
CreateIDEHTMLProvider: TCreateIDEHTMLProviderEvent = nil;// will be set by the IDE
@ -173,24 +173,27 @@ begin
inherited Destroy;
end;
function TAbstractIDEHTMLProvider.BuildURL(const CurBaseURL, CurURL: string
function TAbstractIDEHTMLProvider.MakeURLAbsolute(const aBaseURL, aURL: string
): string;
var
URLType: string;
URLPath: string;
URLParams: string;
begin
Result:=CurURL;
SplitURL(CurURL,URLType,URLPath,URLParams);
//DebugLn(['TAbstractIDEHTMLProvider.BuildURL CurURL=',CurURL,' URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams]);
Result:=aURL;
SplitURL(aURL,URLType,URLPath,URLParams);
//DebugLn(['TAbstractIDEHTMLProvider.BuildURL URL=',aURL,' URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams]);
if URLType='' then begin
// no URLType => use CurURL as URLPath
Result:=CurURL;
//DebugLn(['TAbstractIDEHTMLProvider.BuildURL AAA1 ',Result]);
if not URLFilenameIsAbsolute(Result) then
Result:=CurBaseURL+Result;
// no URLType => use aURL as URLPath
Result:=aURL;
if not URLFilenameIsAbsolute(Result) then begin
if aBaseURL<>'' then
Result:=aBaseURL+Result
else
Result:=BaseURL+Result;
end;
end else begin
Result:=CurURL;
Result:=aURL;
end;
end;