From 47a5b4d0ded37bd5d70664776bf740762fea1972 Mon Sep 17 00:00:00 2001 From: mattias Date: Tue, 13 Sep 2005 10:46:20 +0000 Subject: [PATCH] added lazdoc IDE feature, enable with -dEnableLazDoc from Darius Blaszijk git-svn-id: trunk@7685 - --- .gitattributes | 3 + ide/lazdocfrm.lfm | 49 ++++++ ide/lazdocfrm.lrs | 19 +++ ide/lazdocfrm.pas | 375 ++++++++++++++++++++++++++++++++++++++++++++++ ide/main.pp | 10 +- ide/mainbar.pas | 1 + ide/mainbase.pas | 2 + ide/uniteditor.pp | 78 +++++++++- 8 files changed, 528 insertions(+), 9 deletions(-) create mode 100644 ide/lazdocfrm.lfm create mode 100644 ide/lazdocfrm.lrs create mode 100644 ide/lazdocfrm.pas diff --git a/.gitattributes b/.gitattributes index 7f8feae30e..50ea2c109b 100644 --- a/.gitattributes +++ b/.gitattributes @@ -883,6 +883,9 @@ ide/lazarusidestrconsts.pas svneol=native#text/pascal ide/lazarusmanager.pas svneol=native#text/pascal ide/lazconf.pp svneol=native#text/pascal ide/lazcwstring.pas svneol=native#text/plain +ide/lazdocfrm.lfm svneol=native#text/plain +ide/lazdocfrm.lrs svneol=native#text/plain +ide/lazdocfrm.pas svneol=native#text/plain ide/lrtpotools.pas svneol=native#text/pascal ide/macropromptdlg.pas svneol=native#text/pascal ide/main.pp svneol=native#text/pascal diff --git a/ide/lazdocfrm.lfm b/ide/lazdocfrm.lfm new file mode 100644 index 0000000000..c4f392038f --- /dev/null +++ b/ide/lazdocfrm.lfm @@ -0,0 +1,49 @@ +object LazDocForm: TLazDocForm + ActiveControl = TabSheet1 + Caption = 'LazDoc editor' + ClientHeight = 195 + ClientWidth = 753 + OnCreate = FormCreate + PixelsPerInch = 96 + HorzScrollBar.Page = 752 + VertScrollBar.Page = 194 + Left = 245 + Height = 195 + Top = 506 + Width = 753 + object PageControl: TPageControl + ActivePage = TabSheet1 + Align = alClient + TabIndex = 0 + TabOrder = 0 + TabPosition = tpBottom + Height = 195 + Width = 753 + object TabSheet1: TTabSheet + Caption = 'TabSheet1' + ClientHeight = 169 + ClientWidth = 745 + Height = 169 + Width = 745 + object DescrMemo: TMemo + Align = alClient + Font.CharSet = ANSI_CHARSET + Font.Color = clBlack + Font.Height = -12 + Font.Name = 'Courier New' + Font.Pitch = fpFixed + OnChange = DescrMemoChange + TabOrder = 0 + Height = 169 + Width = 745 + end + end + end + object OpenDialog1: TOpenDialog + Title = 'Open existing file' + FilterIndex = 0 + Title = 'Open existing file' + left = 29 + top = 720 + end +end diff --git a/ide/lazdocfrm.lrs b/ide/lazdocfrm.lrs new file mode 100644 index 0000000000..3bf9b4a7b9 --- /dev/null +++ b/ide/lazdocfrm.lrs @@ -0,0 +1,19 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TLazDocForm','FORMDATA',[ + 'TPF0'#11'TLazDocForm'#10'LazDocForm'#13'ActiveControl'#7#9'TabSheet1'#7'Capt' + +'ion'#6#13'LazDoc editor'#12'ClientHeight'#3#195#0#11'ClientWidth'#3#241#2#8 + +'OnCreate'#7#10'FormCreate'#13'PixelsPerInch'#2'`'#18'HorzScrollBar.Page'#3 + +#240#2#18'VertScrollBar.Page'#3#194#0#4'Left'#3#245#0#6'Height'#3#195#0#3'To' + +'p'#3#250#1#5'Width'#3#241#2#0#12'TPageControl'#11'PageControl'#10'ActivePag' + +'e'#7#9'TabSheet1'#5'Align'#7#8'alClient'#8'TabIndex'#2#0#8'TabOrder'#2#0#11 + +'TabPosition'#7#8'tpBottom'#6'Height'#3#195#0#5'Width'#3#241#2#0#9'TTabSheet' + +#9'TabSheet1'#7'Caption'#6#9'TabSheet1'#12'ClientHeight'#3#169#0#11'ClientWi' + +'dth'#3#233#2#6'Height'#3#169#0#5'Width'#3#233#2#0#5'TMemo'#9'DescrMemo'#5'A' + +'lign'#7#8'alClient'#12'Font.CharSet'#7#12'ANSI_CHARSET'#10'Font.Color'#7#7 + +'clBlack'#11'Font.Height'#2#244#9'Font.Name'#6#11'Courier New'#10'Font.Pitch' + +#7#7'fpFixed'#8'OnChange'#7#15'DescrMemoChange'#8'TabOrder'#2#0#6'Height'#3 + +#169#0#5'Width'#3#233#2#0#0#0#0#11'TOpenDialog'#11'OpenDialog1'#5'Title'#6#18 + +'Open existing file'#11'FilterIndex'#2#0#5'Title'#6#18'Open existing file'#4 + +'left'#2#29#3'top'#3#208#2#0#0#0 +]); diff --git a/ide/lazdocfrm.pas b/ide/lazdocfrm.pas new file mode 100644 index 0000000000..bdb6fbd738 --- /dev/null +++ b/ide/lazdocfrm.pas @@ -0,0 +1,375 @@ +{ +/*************************************************************************** + 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 . You can also * + * obtain it by writing to the Free Software Foundation, * + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * + * * + *************************************************************************** +} +unit LazDocFrm; + +{$mode objfpc}{$H+} + +{$define dbgLazDoc} + +interface + +uses + Buttons, + Classes, + ComCtrls, + Controls, + Dialogs, + DOM, + Forms, + Graphics, + LCLProc, + LResources, + StdCtrls, + StrUtils, + SynEdit, + SysUtils, + XMLread, + XMLwrite; + +type + TFPDocNode = record + Short: String; + Descr: String; + end; + + { TLazDocForm } + + TLazDocForm = class(TForm) + DescrMemo: TMemo; + OpenDialog1: TOpenDialog; + PageControl: TPageControl; + TabSheet1: TTabSheet; + procedure DescrMemoChange(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + { private declarations } + FDocFileName: String; + FCurrentElement: String; + procedure SetDocFileName(Value: 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; + public + { public declarations } + procedure UpdateLazDoc(source: TStrings; pos: TPoint); + property DocFileName: String read FDocFileName write SetDocFileName; + end; + +const + MAINFORMCAPTION = 'LazDoc editor'; + NODOCUMENTATION = 'Documentation entry does not exist'; + +var + LazDocForm: TLazDocForm; + doc: TXMLdocument; + +procedure DoShowLazDoc; + +implementation + +{ TLazDocForm } + +procedure DoShowLazDoc; +begin + if LazDocForm = Nil then + LazDocForm := TLazDocForm.Create(Nil); + + LazDocForm.Show; +end; + +procedure TLazDocForm.SetDocFileName(Value: String); +begin + if FileExists(Value) and (Value <> FDocFileName) then + begin + + FDocFileName := Value; + + if not Assigned(doc) then + doc := TXMLDocument.Create; + + ReadXMLFile(doc, FDocFileName); + + //clear all element editors/viewers + DescrMemo.Clear; + + SetCaption; + + {$ifdef dbgLazDoc} + DebugLn('TLazDocForm.SetDocFileName: document is set: ' + Value); + {$endif} + + end; +end; + +procedure TLazDocForm.FormCreate(Sender: TObject); +begin + Caption := MAINFORMCAPTION; + + with PageControl do + begin + Page[0].Caption := 'Description'; + PageIndex := 0; + end; +end; + +function TLazDocForm.NodeByName(ElementName: String): TDOMNode; +var + n: TDOMNode; +begin + Result := Nil; + + //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; + + //proceed to element + n := n.FirstChild; + while n.NodeName <> 'element' do + n := n.NextSibling; + + //search elements for ElementName + while Assigned(n) and (TDomElement(n)['name'] <> ElementName) do + begin + n := n.NextSibling; + + if not Assigned(n) then + Exit; + + 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); + //else if S='errors' then + //FErrorsNode:=Node.NodeValue + //else if S='seealso' then + //FSeeAlsoNode:=Node.NodeValue + //else if S='example' then + //FExampleNodes.Add(n); + 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] <> ';') 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; + end; +end; + +procedure TLazDocForm.SetCaption; +var + strCaption: String; +begin + strCaption := MAINFORMCAPTION + ' - '; + + if FCurrentElement <> '' then + strCaption := strCaption + FCurrentElement + ' - ' + else + strCaption := strCaption + ' - '; + + Caption := strCaption + FDocFileName; +end; + +procedure TLazDocForm.UpdateLazDoc(source: TStrings; pos: TPoint); +var + dn: TFPDocNode; + n: TDOMNode; +begin + if not Assigned(doc) then + begin + {$ifdef dbgLazDoc} + DebugLn('TLazDocForm.UpdateLazDoc: document is not set'); + {$endif} + + Exit; + end; + + FCurrentElement := GetNearestSourceElement(source, pos); + + SetCaption; + + n := NodeByName(FCurrentElement); + + DescrMemo.Enabled := Assigned(n); + + if Assigned(n) then + begin + dn := ElementFromNode(n); + + DescrMemo.Lines.Text := dn.Descr; + end + else + begin + DescrMemo.Lines.Text := NODOCUMENTATION; + end; +end; + +procedure TLazDocForm.DescrMemoChange(Sender: TObject); +var + n: TDOMNode; + S: String; + child: TDOMNode; +begin + n := NodeByName(FCurrentElement); + + if not Assigned(n) then + Exit; + + n := n.FirstChild; + while Assigned(n) do + begin + if (n.NodeType = ELEMENT_NODE) then + begin + S := n.NodeName; + + if S = 'descr' then + begin + if not Assigned(n.FirstChild) then + begin + child := doc.CreateTextNode(DescrMemo.Text); + n.AppendChild(child); + end + else + n.FirstChild.NodeValue := DescrMemo.Text; + end; + end; + n := n.NextSibling; + end; + + WriteXMLFile(doc, FDocFileName); +end; + +initialization + {$I lazdocfrm.lrs} + +end. + diff --git a/ide/main.pp b/ide/main.pp index b45c7ff35f..002ecda443 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -259,6 +259,7 @@ type procedure mnuToolGuessMisplacedIFDEFClicked(Sender: TObject); procedure mnuToolMakeResourceStringClicked(Sender: TObject); procedure mnuToolDiffClicked(Sender: TObject); + procedure mnuToolLazDocClicked(Sender: TObject); //DBlaszijk 5-sep-05 procedure mnuToolConvertDFMtoLFMClicked(Sender: TObject); procedure mnuToolCheckLFMClicked(Sender: TObject); procedure mnuToolConvertDelphiUnitClicked(Sender: TObject); @@ -1916,6 +1917,7 @@ begin itmToolGuessMisplacedIFDEF.OnClick := @mnuToolGuessMisplacedIFDEFClicked; itmToolMakeResourceString.OnClick := @mnuToolMakeResourceStringClicked; itmToolDiff.OnClick := @mnuToolDiffClicked; + itmToolLazDoc.OnClick := @mnuToolLazDocClicked; //DBlaszijk 5-sep-05 itmToolConvertDFMtoLFM.OnClick := @mnuToolConvertDFMtoLFMClicked; itmToolConvertDelphiUnit.OnClick := @mnuToolConvertDelphiUnitClicked; itmToolConvertDelphiProject.OnClick := @mnuToolConvertDelphiProjectClicked; @@ -3004,6 +3006,12 @@ begin DoDiff; end; +//DBlaszijk 5-sep-05 +procedure TMainIDE.mnuToolLazDocClicked(Sender: TObject); +begin + SourceNotebook.ShowLazDoc; +end; + procedure TMainIDE.mnuToolConvertDFMtoLFMClicked(Sender: TObject); begin DoConvertDFMtoLFM; @@ -9932,7 +9940,7 @@ begin if Project1=nil then exit; FuncData:=PReadFunctionData(Data); Param:=FuncData^.Param; - debugln('TMainIDE.MacroFunctionProject A Param="',Param,'"'); + //debugln('TMainIDE.MacroFunctionProject A Param="',Param,'"'); if CompareText(Param,'SrcPath')=0 then FuncData^.Result:=Project1.CompilerOptions.GetSrcPath(false) else if CompareText(Param,'IncPath')=0 then diff --git a/ide/mainbar.pas b/ide/mainbar.pas index 1a253a490d..dcd605153e 100644 --- a/ide/mainbar.pas +++ b/ide/mainbar.pas @@ -249,6 +249,7 @@ type itmToolConvertDFMtoLFM: TMenuItem; itmToolMakeResourceString: TMenuItem; itmToolDiff: TMenuItem; + itmToolLazDoc: TMenuItem; //DBlaszijk 5-sep-05 itmToolBuildLazarus: TMenuItem; itmToolConfigureBuildLazarus: TMenuItem; diff --git a/ide/mainbase.pas b/ide/mainbase.pas index e7708bdaf6..69d4937c88 100644 --- a/ide/mainbase.pas +++ b/ide/mainbase.pas @@ -653,6 +653,7 @@ begin CreateMenuItem(ParentMI,itmToolGuessMisplacedIFDEF,'itmToolGuessMisplacedIFDEF',lisMenuGuessMisplacedIFDEF); CreateMenuItem(ParentMI,itmToolMakeResourceString,'itmToolMakeResourceString',lisMenuMakeResourceString); CreateMenuItem(ParentMI,itmToolDiff,'itmToolDiff',lisMenuDiff); + CreateMenuItem(ParentMI,itmToolLazDoc,'itmToolLazDoc','LazDoc'); //DBlaszijk 5-sep-05 ParentMI.Add(CreateMenuSeparator); CreateMenuItem(ParentMI,itmToolCheckLFM,'itmToolCheckLFM',lisMenuCheckLFM); @@ -854,6 +855,7 @@ begin itmToolGuessMisplacedIFDEF.ShortCut:=CommandToShortCut(ecGuessMisplacedIFDEF); itmToolMakeResourceString.ShortCut:=CommandToShortCut(ecMakeResourceString); itmToolDiff.ShortCut:=CommandToShortCut(ecDiff); + //itmToolLazDoc.ShortCut:=CommandToShortCut(ecLazDoc); //DBlaszijk 5-sep-05 itmToolConvertDFMtoLFM.ShortCut:=CommandToShortCut(ecConvertDFM2LFM); itmToolCheckLFM.ShortCut:=CommandToShortCut(ecCheckLFM); itmToolConvertDelphiUnit.ShortCut:=CommandToShortCut(ecConvertDelphiUnit); diff --git a/ide/uniteditor.pp b/ide/uniteditor.pp index 53c31acce8..22ce9b60b9 100644 --- a/ide/uniteditor.pp +++ b/ide/uniteditor.pp @@ -56,7 +56,7 @@ uses WordCompletion, FindReplaceDialog, FindInFilesDlg, IDEProcs, IDEOptionDefs, EnvironmentOpts, MsgView, SearchResultView, InputHistory, SortSelectionDlg, EncloseSelectionDlg, DiffDialog, ConDef, InvertAssignTool, - SourceEditProcs, SourceMarks, CharacterMapDlg, frmSearch, + SourceEditProcs, SourceMarks, CharacterMapDlg, frmSearch, LazDocFrm, BaseDebugManager, Debugger, MainIntf; type @@ -470,6 +470,7 @@ type Shift: TShiftstate; X,Y: Integer); procedure EditorMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftstate; X,Y: Integer); + procedure EditorKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); //hintwindow stuff FHintWindow: THintWindow; @@ -510,6 +511,10 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; + procedure ShowLazDoc; //DBlaszijk 11-sep-05 + procedure UpdateLazDoc; //DBlaszijk 11-sep-05 + procedure LazDocNewPage; //DBlaszijk 11-sep-05 + property Editors[Index:integer]:TSourceEditor read GetEditors; function EditorCount:integer; function Empty: boolean; @@ -2480,6 +2485,53 @@ begin inherited Destroy; end; +procedure TSourceNotebook.ShowLazDoc; +begin + {$IFNDEF EnableLazDoc} + exit; + {$ENDIF} + DoShowLazDoc; + LazDocNewPage; +end; + +procedure TSourceNotebook.LazDocNewPage; +var + SrcEdit: TSourceEditor; +begin + {$IFNDEF EnableLazDoc} + exit; + {$ENDIF} + //try to find if the file belongs to LCL + //for other projects the location of the doc file could + //be found through the lpi file + if Assigned(LazDocForm) then + begin + SrcEdit:=GetActiveSE; + + if FileIsInPath(SrcEdit.FileName,EnvironmentOptions.LazarusDirectory+'lcl') + then + //load the XML file + LazDocForm.DocFileName := EnvironmentOptions.LazarusDirectory + + SetDirSeparators('docs/xml/lcl/')+ + ChangeFileExt(ExtractFileName(SrcEdit.FileName),'.xml'); + end; +end; + +procedure TSourceNotebook.UpdateLazDoc; +var + SrcEdit: TSourceEditor; +begin + SrcEdit:=GetActiveSE; + + //try to find if the file belongs to LCL + //for other projects the location of the doc file could + //be found through the lpi file + if FileIsInPath(SrcEdit.FileName,EnvironmentOptions.LazarusDirectory+'lcl') + then + LazDocForm.UpdateLazDoc(SrcEdit.EditorComponent.Lines, + SrcEdit.EditorComponent.CaretXY); +end; + function TSourceNotebook.OnSynCompletionPaintItem(const AKey: string; ACanvas: TCanvas; X, Y: integer; ItemSelected: boolean; Index: integer): boolean; @@ -3771,9 +3823,7 @@ Begin {$ENDIF} Result := TSourceEditor.Create(Self,Notebook.Page[PageNum]); Result.EditorComponent.BeginUpdate; - {$IFDEF IDE_DEBUG} - writeln('TSourceNotebook.NewSE C '); - {$ENDIF} + FSourceEditorList.Add(Result); Result.CodeTemplates:=CodeTemplateModul; Notebook.PageIndex := Pagenum; @@ -3785,6 +3835,8 @@ Begin Result.OnMouseMove := @EditorMouseMove; Result.OnMouseDown := @EditorMouseDown; Result.OnMouseUp := @EditorMouseUp; + Result.OnKeyDown :=@EditorKeyDown; + Result.EditorComponent.EndUpdate; {$IFDEF IDE_DEBUG} writeln('TSourceNotebook.NewSE end '); @@ -5066,6 +5118,9 @@ Procedure TSourceNotebook.NotebookPageChanged(Sender: TObject); var TempEditor:TSourceEditor; Begin TempEditor:=GetActiveSE; + + LazDocNewPage; + //writeln('TSourceNotebook.NotebookPageChanged ',Notebook.Pageindex,' ',TempEditor <> nil,' fAutoFocusLock=',fAutoFocusLock); if TempEditor <> nil then begin @@ -5305,6 +5360,17 @@ begin FOnCtrlMouseUp(Sender,Button,Shift,X,Y); end; end; + if Assigned(LazDocForm) then + UpdateLazDoc; +end; + +procedure TSourceNotebook.EditorKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if not Assigned(LazDocForm) then Exit; + + if Key in [VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_END, VK_HOME] then + UpdateLazDoc; end; procedure TSourceNotebook.ShowSynEditHint(const MousePos: TPoint); @@ -5479,7 +5545,6 @@ begin Left := 5; Width:=Self.Width-2*Left; Caption := lisUEGotoLine; - Visible := True; end; Edit1 := TEdit.Create(self); @@ -5491,7 +5556,6 @@ begin Left := 5; Caption := ''; OnKeyDown:=@Edit1KeyDown; - Visible := True; end; btnOK := TBitbtn.Create(self); @@ -5503,7 +5567,6 @@ begin Left := 40; kind := bkOK; Default:=false; - Visible := True; end; btnCancel := TBitbtn.Create(self); @@ -5515,7 +5578,6 @@ begin Left := 120; kind := bkCancel; Default:=false; - Visible := True; end; end; ActiveControl:=Edit1;