lazarus/ide/lazdocfrm.pas
mattias 7382c71808 clean up
git-svn-id: trunk@8067 -
2005-11-05 13:34:53 +00:00

827 lines
20 KiB
ObjectPascal

{
/***************************************************************************
LazDocFrm.pas
-------------
***************************************************************************/
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code 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. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
}
{
see for todo list: http://wiki.lazarus.freepascal.org/index.php/LazDoc
}
unit LazDocFrm;
{$mode objfpc}{$H+}
{ $define dbgLazDoc}
interface
uses
Buttons,
Classes,
ComCtrls,
Controls,
Dialogs,
DOM,
ExtCtrls,
Forms,
Graphics,
IDEProcs,
LazarusIDEStrConsts,
LCLProc,
LResources,
StdCtrls,
StrUtils,
SynEdit,
SysUtils,
XMLread,
XMLwrite;
const
SHORT = 1;
DESCR = 2;
ERRORS = 4;
SEEALSO = 5;
EXAMPLE = 6;
NODEITEMS = EXAMPLE; //always make nodeitems equal to higest element
type
TFPDocNode = array [1..NODEITEMS] of String;
{ TLazDocForm }
TLazDocForm = class(TForm)
AddLinkButton: TButton;
BrowseExampleButton: TButton;
ExampleEdit: TEdit;
LinkIdComboBox: TComboBox;
DeleteLinkButton: TButton;
DescrMemo: TMemo;
LinkTextEdit: TEdit;
LinkListBox: TListBox;
OpenDialog: TOpenDialog;
Panel1: TPanel;
ShortEdit: TEdit;
ErrorsMemo: TMemo;
PageControl: TPageControl;
DescrTabSheet: TTabSheet;
ErrorsTabSheet: TTabSheet;
ShortTabSheet: TTabSheet;
BoldFormatButton: TSpeedButton;
ItalicFormatButton: TSpeedButton;
InsertCodeTagButton: TSpeedButton;
InsertRemarkButton: TSpeedButton;
InsertVarTagButton: TSpeedButton;
ExampleTabSheet: TTabSheet;
UnderlineFormatButton: TSpeedButton;
SeeAlsoTabSheet: TTabSheet;
procedure AddLinkButtonClick(Sender: TObject);
procedure BrowseExampleButtonClick(Sender: TObject);
procedure DeleteLinkButtonClick(Sender: TObject);
procedure DocumentationTagChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormatButtonClick(Sender: TObject);
procedure LinkChange(Sender: TObject);
procedure LinkListBoxClick(Sender: TObject);
private
{ private declarations }
FLinkIndex: Integer;
FChanged: Boolean;
FDocFileName: String;
FCurrentElement: String;
FLastElement: String;
function GetModuleNode: TDOMNode;
function GetFirstElement: TDOMNode;
procedure GetElementList;
function MakeLink: String;
procedure SetDocFileName(Value: String);
procedure InsertElement(ElementName: String);
function NodeByName(ElementName: String): TDOMNode;
function GetFirstChildValue(n: TDOMNode): String;
function ElementFromNode(Node: TDOMNode): TFPDocNode;
function ExtractFuncProc(startpos: tpoint; keyword: String;
src: tStrings): String;
function GetNearestSourceElement(source: tStrings;
caretpos: tpoint): String;
procedure SetCaption;
procedure Save;
public
{ public declarations }
procedure Reset;
procedure UpdateLazDoc(source: TStrings; pos: TPoint);
property DocFileName: String read FDocFileName write SetDocFileName;
end;
var
LazDocForm: TLazDocForm;
doc: TXMLdocument = Nil;
//maybe better to make it a member field of TLazFormDoc
procedure DoShowLazDoc;
implementation
{ TLazDocForm }
procedure DoShowLazDoc;
begin
if LazDocForm = Nil then
Application.CreateForm(TLazDocForm, LazDocForm);
LazDocForm.Show;
end;
function TLazDocForm.GetModuleNode: TDOMNode;
var
n: TDOMNode;
begin
//get first node
n := doc.FindNode('fpdoc-descriptions');
//proceed to package (could there be more packages in one file??)
n := n.FirstChild;
//proceed to module (could there be more modules in one file??)
n := n.FirstChild;
while n.NodeName <> 'module' do
n := n.NextSibling;
Result := n;
end;
function TLazDocForm.GetFirstElement: TDOMNode;
var
n: TDOMNode;
begin
//get first module node
n := GetModuleNode;
//proceed to element
n := n.FirstChild;
while n.NodeName <> 'element' do
n := n.NextSibling;
Result := n;
end;
procedure TLazDocForm.GetElementList;
var
n: TDOMNode;
begin
LinkIdComboBox.Clear;
if not Assigned(doc) then
begin
{$ifdef dbgLazDoc}
DebugLn('TLazDocForm.GetElementList: document is not set');
{$endif}
Exit;
end;
//get first element node
n := GetFirstElement;
//search all elements
while Assigned(n) do
begin
//showmessage(TDomElement(n)['name']);
LinkIdComboBox.Items.Add(TDomElement(n)['name']);
n := n.NextSibling;
if not Assigned(n) then
Exit;
while n.NodeName = '#comment' do
n := n.NextSibling;
end;
end;
procedure TLazDocForm.SetDocFileName(Value: String);
begin
LinkIdComboBox.Clear;
if FileExists(Value) and (Value <> FDocFileName) then
begin
//reset Self
Reset;
FDocFileName := Value;
if Assigned(doc) then
FreeAndNil(doc);
ReadXMLFile(doc, FDocFileName);
SetCaption;
GetElementList;
{$ifdef dbgLazDoc}
DebugLn('TLazDocForm.SetDocFileName: document is set: ' + Value);
{$endif}
end;
end;
procedure TLazDocForm.FormCreate(Sender: TObject);
begin
Caption := lisLazDocMainFormCaption;
FLinkIndex := -1;
with PageControl do
begin
Page[0].Caption := lisLazDocShortTag;
Page[1].Caption := lisLazDocDescrTag;
Page[2].Caption := lisLazDocErrorsTag;
Page[3].Caption := lisLazDocSeeAlsoTag;
Page[4].Caption := lisLazDocExampleTag;
PageIndex := 0;
end;
BoldFormatButton.Hint := lisLazDocHintBoldFormat;
ItalicFormatButton.Hint := lisLazDocHintItalicFormat;
UnderlineFormatButton.Hint := lisLazDocHintUnderlineFormat;
InsertCodeTagButton.Hint := lisLazDocHintInsertCodeTag;
InsertRemarkButton.Hint := lisLazDocHintRemarkTag;
InsertVarTagButton.Hint := lisLazDocHintVarTag;
AddLinkButton.Caption := lisLazDocAddLinkButton;
DeleteLinkButton.Caption := lisLazDocDeleteLinkButton;
BrowseExampleButton.Caption := lisLazDocBrowseExampleButton;
Reset;
Resize;
end;
procedure TLazDocForm.FormResize(Sender: TObject);
begin
LinkIdComboBox.Width := (AddLinkButton.Left - LinkIdComboBox.Left - 8) div 2;
LinkTextEdit.Left := LinkIdComboBox.Left + LinkIdComboBox.Width + 4;
LinkTextEdit.Width := LinkIdComboBox.Width;
end;
procedure TLazDocForm.FormatButtonClick(Sender: TObject);
procedure InsertTag(starttag, endtag: String);
begin
if PageControl.ActivePage.Caption = lisLazDocDescrTag then
DescrMemo.SelText := starttag + DescrMemo.SelText + endtag;
if PageControl.ActivePage.Caption = lisLazDocErrorsTag then
ErrorsMemo.SelText := starttag + ErrorsMemo.SelText + endtag;
end;
begin
case TSpeedButton(Sender).Tag of
//bold
0:
InsertTag('<b>', '</b>');
//italic
1:
InsertTag('<i>', '</i>');
//underline
2:
InsertTag('<u>', '</u>');
//codetag
3:
InsertTag('<p><code>', '</code></p>');
//remarktag
4:
InsertTag('<p><remark>', '</remark></p>');
//vartag
5:
InsertTag('<var>', '</var>');
end;
end;
procedure TLazDocForm.LinkChange(Sender: TObject);
begin
if FLinkIndex = -1 then
Exit;
LinkListBox.Items.Strings[FLinkIndex] := MakeLink;
end;
procedure TLazDocForm.LinkListBoxClick(Sender: TObject);
var
strTmp: String;
intTmp: Integer;
intStart: Integer;
begin
//split the link into Id and Text
FLinkIndex := LinkListBox.ItemIndex;
if FLinkIndex = -1 then
Exit;
intStart := PosEx('"', LinkListBox.Items[FLinkIndex], 1);
intTmp := PosEx('"', LinkListBox.Items[FLinkIndex], intStart + 1);
LinkIdComboBox.Text := Copy(LinkListBox.Items[FLinkIndex],
intStart + 1, intTmp - intStart - 1);
strTmp := Copy(LinkListBox.Items[FLinkIndex], intTmp + 2,
Length(LinkListBox.Items[FLinkIndex]));
if strTmp = '>' then
LinkTextEdit.Text := ''
else
LinkTextEdit.Text := Copy(strTmp, 1, Length(strTmp) - Length('</link>'));
end;
procedure TLazDocForm.InsertElement(ElementName: String);
var
n: TDOMNode;
child: TDOMNode;
begin
Exit;
//preparations being made for adding nodes
//having to finalize adding comment
//get first module node
n := GetModuleNode;
//TODO: insert element comment (important or not!!)
child := doc.CreateComment('test');
n.AppendChild(child);
child := doc.CreateElement('element');
TDOMElement(child).SetAttribute('name', ElementName);
child.AppendChild(doc.CreateElement('short'));
child.AppendChild(doc.CreateElement('descr'));
child.AppendChild(doc.CreateElement('errors'));
child.AppendChild(doc.CreateElement('seealso'));
child.AppendChild(doc.CreateElement('example'));
n.AppendChild(child);
WriteXMLFile(doc, FDocFileName);
end;
function TLazDocForm.NodeByName(ElementName: String): TDOMNode;
var
n: TDOMNode;
begin
Result := Nil;
if not Assigned(doc) then
begin
{$ifdef dbgLazDoc}
DebugLn('TLazDocForm.NodeByName: document is not set');
{$endif}
Exit;
end;
//get first element node
n := GetFirstElement;
//search elements for ElementName
while Assigned(n) and (TDomElement(n)['name'] <> ElementName) do
begin
n := n.NextSibling;
//no element found
if not Assigned(n) then
begin
InsertElement(ElementName);
Exit;
end;
while n.NodeName = '#comment' do
n := n.NextSibling;
end;
{$ifdef dbgLazDoc}
DebugLn('TLazDocForm.NodeByName: element node found where name is: ' +
ElementName);
{$endif}
Result := n;
end;
function TLazDocForm.GetFirstChildValue(n: TDOMNode): String;
begin
if Assigned(n.FirstChild) then
begin
{$ifdef dbgLazDoc}
DebugLn('TLazDocForm.GetFirstChildValue: retrieving node ' +
n.NodeName + '=' + n.FirstChild.NodeValue);
{$endif}
Result := n.FirstChild.NodeValue;
end
else
begin
{$ifdef dbgLazDoc}
DebugLn('TLazDocForm.GetFirstChildValue: retrieving empty node ' +
n.NodeName);
{$endif}
Result := '';
end;
end;
function TLazDocForm.ElementFromNode(Node: TDOMNode): TFPDocNode;
var
S: String;
begin
Node := Node.FirstChild;
while Assigned(Node) do
begin
if (Node.NodeType = ELEMENT_NODE) then
begin
S := Node.NodeName;
if S = 'short' then
Result[SHORT] := GetFirstChildValue(Node);
if S = 'descr' then
Result[DESCR] := GetFirstChildValue(Node);
if S = 'errors' then
Result[ERRORS] := GetFirstChildValue(Node);
if S = 'seealso' then
Result[SEEALSO] := GetFirstChildValue(Node);
if S = 'example' then
Result[EXAMPLE] := GetFirstChildValue(Node);
end;
Node := Node.NextSibling;
end;
end;
function TLazDocForm.ExtractFuncProc(startpos: tpoint;
keyword: String; src: tStrings): String;
var
xpos: Integer;
ypos: Integer;
begin
xpos := Succ(startpos.x + length(keyword));
ypos := startpos.y;
result := '';
while (src[ypos][xpos] <> '(') and (src[ypos][xpos] <> ';') and
(src[ypos][xpos] <> ':') do
begin
Result := Result + src[ypos][xpos];
Inc(xpos);
if xpos > length(src[ypos]) then
begin
xpos := 0;
Inc(ypos);
end;
end;
end;
function TLazDocForm.GetNearestSourceElement(source: tStrings;
caretpos: tpoint): String;
var
xpos: Integer;
ypos: Integer;
begin
//find preceding keyword
xpos := Succ(caretpos.x);
ypos := caretpos.y;
while (xpos > 0) or (ypos > 0) do
begin
Dec(xpos);
if xpos < 0 then
begin
Dec(ypos);
xpos := length(source[ypos]);
end;
//check for keywords
if PosEx('procedure', source[ypos], xpos) = 1 then
begin
Result := ExtractFuncProc(Point(xpos, ypos), 'procedure', source);
Exit;
end;
if PosEx('function', source[ypos], xpos) = 1 then
begin
Result := ExtractFuncProc(Point(xpos, ypos), 'function', source);
Exit;
end;
if PosEx('constructor', source[ypos], xpos) = 1 then
begin
Result := ExtractFuncProc(Point(xpos, ypos), 'constructor', source);
Exit;
end;
if PosEx('desctructor', source[ypos], xpos) = 1 then
begin
Result := ExtractFuncProc(Point(xpos, ypos), 'desctructor', source);
Exit;
end;
end;
end;
procedure TLazDocForm.SetCaption;
var
strCaption: String;
begin
strCaption := lisLazDocMainFormCaption + ' - ';
if FCurrentElement <> '' then
strCaption := strCaption + FCurrentElement + ' - '
else
strCaption := strCaption + lisLazDocNoTagCaption + ' - ';
if FDocFileName <> '' then
Caption := strCaption + FDocFileName
else
Caption := strCaption + lisLazDocNoTagCaption;
end;
procedure TLazDocForm.Reset;
begin
FreeAndNil(Doc);
FCurrentElement := '';
FDocFileName := '';
SetCaption;
//clear all element editors/viewers
ShortEdit.Clear;
DescrMemo.Clear;
ErrorsMemo.Clear;
LinkIdComboBox.Text := '';
LinkTextEdit.Clear;
LinkListBox.Clear;
ExampleEdit.Clear;
FChanged := False;
end;
procedure TLazDocForm.UpdateLazDoc(source: TStrings; pos: TPoint);
var
dn: TFPDocNode;
n: TDOMNode;
EnabledState: Boolean;
begin
if not Assigned(doc) then
begin
{$ifdef dbgLazDoc}
DebugLn('TLazDocForm.UpdateLazDoc: document is not set');
{$endif}
Exit;
end;
//save the current changes to documentation
Save;
FCurrentElement := GetNearestSourceElement(source, pos);
//do not continue if FCurrentElement=FLastElement
//or FCurrentElement is empty (J. Reyes)
if (FCurrentElement = FLastElement) or (FCurrentElement = '') then
Exit;
SetCaption;
FLastElement := FCurrentElement;
n := NodeByName(FCurrentElement);
EnabledState := Assigned(n);
if Assigned(n) then
begin
dn := ElementFromNode(n);
ShortEdit.Text := dn[SHORT];
DescrMemo.Lines.Text := ConvertLineEndings(dn[DESCR]);
ErrorsMemo.Lines.Text := ConvertLineEndings(dn[ERRORS]);
LinkListBox.Items.Text := ConvertLineEndings(dn[SEEALSO]);
LinkIdComboBox.Text := '';
LinkTextEdit.Clear;
ExampleEdit.Text := Copy(dn[EXAMPLE], 16, Length(dn[EXAMPLE]) - 19);
end
else
begin
ShortEdit.Text := lisLazDocNoDocumentation;
DescrMemo.Lines.Text := lisLazDocNoDocumentation;
ErrorsMemo.Lines.Text := lisLazDocNoDocumentation;
LinkIdComboBox.Text := lisLazDocNoDocumentation;
LinkTextEdit.Text := lisLazDocNoDocumentation;
LinkListBox.Clear;
ExampleEdit.Text := lisLazDocNoDocumentation;
end;
FChanged := False;
ShortEdit.Enabled := EnabledState;
DescrMemo.Enabled := EnabledState;
ErrorsMemo.Enabled := EnabledState;
LinkIdComboBox.Enabled := EnabledState;
LinkTextEdit.Enabled := EnabledState;
LinkListBox.Enabled := EnabledState;
AddLinkButton.Enabled := EnabledState;
DeleteLinkButton.Enabled := EnabledState;
ExampleEdit.Enabled := EnabledState;
BrowseExampleButton.Enabled := EnabledState;
end;
function ToUnixLineEnding(const s: String): String;
var
p: Integer;
begin
Result:=s;
p:=1;
while (p<=length(s)) do begin
if not (s[p] in [#10,#13]) then begin
inc(p);
end else begin
// line ending
if (p<length(s)) and (s[p+1] in [#10,#13]) and (s[p]<>s[p+1]) then begin
// double character line ending
Result:=copy(Result,1,p-1)+#10+copy(Result,p+2,length(Result));
end else if s[p]=#13 then begin
// single char line ending #13
Result[p]:=#10;
end;
inc(p);
end;
end;
end;
procedure TLazDocForm.Save;
var
n: TDOMNode;
S: String;
NodeWritten: array [1..NODEITEMS] of Boolean;
i: Integer;
procedure CheckAndWriteNode(NodeName: String; NodeText: String;
NodeIndex: Integer);
var
child: TDOMNode;
begin
{$ifdef dbgLazDoc}
DebugLn('TLazDocForm.Save[CheckAndWriteNode]: checking element: ' +
NodeName);
{$endif}
if S = NodeName then
begin
if not Assigned(n.FirstChild) then
begin
child := doc.CreateTextNode(ToUnixLineEnding(NodeText));
n.AppendChild(child);
end
else
n.FirstChild.NodeValue := ToUnixLineEnding(NodeText);
NodeWritten[NodeIndex] := True;
end;
end;
procedure InsertNodeElement(ElementName: String; ElementText: String);
var
child: TDOMNode;
begin
{$ifdef dbgLazDoc}
DebugLn('TLazDocForm.Save[InsertNodeElement]: inserting element: ' +
ElementName);
{$endif}
child := doc.CreateElement(ElementName);
child.AppendChild(doc.CreateTextNode(ToUnixLineEnding(ElementText)));
n.AppendChild(child);
end;
begin
//nothing changed, so exit
if not FChanged then
Exit;
n := NodeByName(FCurrentElement);
if not Assigned(n) then
Exit;
//reset all nodes
for i := 1 to NODEITEMS do
NodeWritten[i] := False;
//write all known nodes to XML
n := n.FirstChild;
while Assigned(n) do
begin
if (n.NodeType = ELEMENT_NODE) then
begin
S := n.NodeName;
CheckAndWriteNode('short', ShortEdit.Text, SHORT);
CheckAndWriteNode('descr', DescrMemo.Text, DESCR);
CheckAndWriteNode('errors', ErrorsMemo.Text, ERRORS);
CheckAndWriteNode('seealso', LinkListBox.Text, SEEALSO);
CheckAndWriteNode('example', '<example file="' +
ExampleEdit.Text + '"/>', EXAMPLE);
end;
n := n.NextSibling;
end;
//add new nodes to XML if not already updated
n := NodeByName(FCurrentElement);
for i := 1 to NODEITEMS do
if NodeWritten[i] = False then
case i of
SHORT:
InsertNodeElement('short', ShortEdit.Text);
DESCR:
InsertNodeElement('descr', DescrMemo.Text);
ERRORS:
InsertNodeElement('errors', ErrorsMemo.Text);
SEEALSO:
InsertNodeElement('seealso', LinkListBox.Text);
EXAMPLE:
InsertNodeElement('example', '<example file="' +
ExampleEdit.Text + '"/>');
end;
WriteXMLFile(doc, FDocFileName);
FChanged := False;
end;
procedure TLazDocForm.DocumentationTagChange(Sender: TObject);
begin
FChanged := True;
end;
function TLazDocForm.MakeLink: String;
begin
if Trim(LinkTextEdit.Text) = '' then
Result := '<link id="' + Trim(LinkIdComboBox.Text) + '"/>'
else
Result := '<link id="' + Trim(LinkIdComboBox.Text) + '">' +
LinkTextEdit.Text + '</link>';
end;
procedure TLazDocForm.AddLinkButtonClick(Sender: TObject);
begin
FLinkIndex := -1;
if Trim(LinkIdComboBox.Text) <> '' then
begin
LinkListBox.Items.Add(MakeLink);
FChanged := True;
end;
end;
procedure TLazDocForm.BrowseExampleButtonClick(Sender: TObject);
begin
if OpenDialog.Execute then
ExampleEdit.Text := SetDirSeparators(ExtractRelativepath(
ExtractFilePath(FDocFileName), OpenDialog.FileName));
end;
procedure TLazDocForm.DeleteLinkButtonClick(Sender: TObject);
begin
if FLinkIndex >= 0 then
begin
LinkListBox.Items.Delete(FLinkIndex);
FLinkIndex := -1;
FChanged := True;
end;
end;
initialization
{$I lazdocfrm.lrs}
finalization
FreeAndNil(doc)
end.