diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index a86ba0ab09..a7c607d34b 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -6710,13 +6710,17 @@ function TFindDeclarationTool.CheckParameterSyntax(CursorNode: TCodeTreeNode; //DebugLn('CheckBrackets ',GetAtom,' ',dbgs(BracketAtom)); repeat ReadNextAtom; - if CurPos.Flag=cafWord then begin - if CheckIdentifierAndParameterList() then exit(true); - end; if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then begin - if CheckBrackets then exit(true); - end; - if CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose] then begin + if (LastAtoms.GetValueAt(0).Flag=cafWord) then begin + //DebugLn('CheckBrackets check word+bracket open'); + UndoReadNextAtom; + if CheckIdentifierAndParameterList() then exit(true); + end else begin + //DebugLn('CheckBrackets check bracket open'); + if CheckBrackets then exit(true); + end; + end else if CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose] + then begin if (BracketAtom.Flag=cafRoundBracketOpen) =(CurPos.Flag=cafRoundBracketClose) then begin @@ -6784,17 +6788,18 @@ function TFindDeclarationTool.CheckParameterSyntax(CursorNode: TCodeTreeNode; end; until false; end; - if (CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen]) - and (LastAtoms.GetValueAt(0).Flag=cafWord) then begin - //DebugLn('CheckIdentifierAndParameterList check word+bracket'); - UndoReadNextAtom; - if CheckIdentifierAndParameterList() then exit(true); - end; - if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then begin - //DebugLn('CheckIdentifierAndParameterList check bracket open'); - if CheckBrackets then exit(true); - end; - if CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose] then begin + if (CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen]) then begin + if (LastAtoms.GetValueAt(0).Flag=cafWord) then begin + //DebugLn('CheckIdentifierAndParameterList check word+bracket open'); + UndoReadNextAtom; + if CheckIdentifierAndParameterList() then exit(true); + end else begin + //DebugLn('CheckIdentifierAndParameterList check bracket open'); + if CheckBrackets then exit(true); + end; + end + else if CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose] then + begin //DebugLn('CheckIdentifierAndParameterList check bracket close'); if (BracketAtom.Flag=cafRoundBracketOpen) =(CurPos.Flag=cafRoundBracketClose) diff --git a/components/codetools/identcompletiontool.pas b/components/codetools/identcompletiontool.pas index de5eee2e80..15304c49ad 100644 --- a/components/codetools/identcompletiontool.pas +++ b/components/codetools/identcompletiontool.pas @@ -220,7 +220,9 @@ type FCount: integer; FParameterIndex: integer; FProcName: string; + FProcNameAtom: TAtomPosition; FStartPos: integer; + FTool: TFindDeclarationTool; function GetItems(Index: integer): TExpressionType; public constructor Create; @@ -229,8 +231,10 @@ type property Items[Index: integer]: TExpressionType read GetItems; default; function Add(const Context: TExpressionType): integer; procedure Clear; + property Tool: TFindDeclarationTool read FTool write FTool; property ParameterIndex: integer read FParameterIndex write FParameterIndex;// 1 based property ProcName: string read FProcName write FProcName; + property ProcNameAtom: TAtomPosition read FProcNameAtom write FProcNameAtom; property StartPos: integer read FStartPos write FStartPos;// context is valid from StartPos to EndPos property EndPos: integer read FEndPos write FEndPos; end; @@ -1226,11 +1230,13 @@ begin case FoundContext.Node.Desc of ctnProcedure: begin + //DebugLn('TIdentCompletionTool.CollectAllContexts CurrentContexts.ProcNameAtom.StartPos=',dbgs(CurrentContexts.ProcNameAtom.StartPos)); if (CurrentContexts.ProcName='') then exit; FoundContext.Tool.MoveCursorToProcName(FoundContext.Node,true); if not FoundContext.Tool.CompareSrcIdentifier( FoundContext.Tool.CurPos.StartPos, - CurrentContexts.ProcName) then exit; + CurrentContexts.ProcName) + then exit; end; else exit; @@ -1421,7 +1427,9 @@ var Result:=true; if CurrentContexts=nil then CurrentContexts:=TCodeContextInfo.Create; + CurrentContexts.Tool:=Self; CurrentContexts.ParameterIndex:=ParameterIndex+1; + CurrentContexts.ProcNameAtom:=ProcNameAtom; CurrentContexts.ProcName:=GetAtom(ProcNameAtom); MoveCursorToAtomPos(ProcNameAtom); ReadNextAtom; // read opening bracket diff --git a/components/synedit/synedit.pp b/components/synedit/synedit.pp index df3e137c9a..f60ccd73a0 100644 --- a/components/synedit/synedit.pp +++ b/components/synedit/synedit.pp @@ -1216,16 +1216,12 @@ end; function TCustomSynEdit.RowColumnToPixels( {$IFDEF SYN_LAZARUS}const {$ENDIF}RowCol: TPoint): TPoint; -// converts Caret position (screen position (1,1) based) +// converts screen position (1,1) based // to client area coordinate begin Result:=RowCol; Result.X := (Result.X - 1) * fCharWidth + fTextOffset; - {$IFDEF SYN_LAZARUS} - Result.Y := RowToScreenRow(Result.Y) * fTextHeight + 1; - {$ELSE} Result.Y := (Result.Y - fTopLine) * fTextHeight + 1; - {$ENDIF} end; procedure TCustomSynEdit.ComputeCaret(X, Y: Integer); @@ -1618,7 +1614,11 @@ end; function TCustomSynEdit.CaretYPix: Integer; begin + {$IFDEF SYN_LAZARUS} + Result := RowToScreenRow(fCaretY) * fTextHeight + 1; + {$ELSE} Result := RowColumnToPixels(Point(1, fCaretY)).Y; + {$ENDIF} end; procedure TCustomSynEdit.FontChanged(Sender: TObject); diff --git a/ide/codecontextform.lfm b/ide/codecontextform.lfm index 522169cebf..3bc541f5ff 100644 --- a/ide/codecontextform.lfm +++ b/ide/codecontextform.lfm @@ -1,7 +1,12 @@ object CodeContextFrm: TCodeContextFrm + BorderIcons = [] + BorderStyle = bsNone Caption = 'CodeContextFrm' ClientHeight = 300 ClientWidth = 400 + OnCreate = FormCreate + OnDestroy = FormDestroy + OnPaint = FormPaint PixelsPerInch = 112 HorzScrollBar.Page = 399 VertScrollBar.Page = 299 diff --git a/ide/codecontextform.lrs b/ide/codecontextform.lrs index fc8187696f..320971eb66 100644 --- a/ide/codecontextform.lrs +++ b/ide/codecontextform.lrs @@ -1,8 +1,10 @@ { This is an automatically generated lazarus resource file } LazarusResources.Add('TCodeContextFrm','FORMDATA',[ - 'TPF0'#15'TCodeContextFrm'#14'CodeContextFrm'#7'Caption'#6#14'CodeContextFrm' - +#12'ClientHeight'#3','#1#11'ClientWidth'#3#144#1#13'PixelsPerInch'#2'p'#18'H' - +'orzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3'+'#1#4'Left'#3'"'#1#6'H' - +'eight'#3','#1#3'Top'#3#163#0#5'Width'#3#144#1#0#0 + 'TPF0'#15'TCodeContextFrm'#14'CodeContextFrm'#11'BorderIcons'#11#0#11'BorderS' + +'tyle'#7#6'bsNone'#7'Caption'#6#14'CodeContextFrm'#12'ClientHeight'#3','#1#11 + +'ClientWidth'#3#144#1#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDes' + +'troy'#7'OnPaint'#7#9'FormPaint'#13'PixelsPerInch'#2'p'#18'HorzScrollBar.Pag' + +'e'#3#143#1#18'VertScrollBar.Page'#3'+'#1#4'Left'#3'"'#1#6'Height'#3','#1#3 + +'Top'#3#163#0#5'Width'#3#144#1#0#0 ]); diff --git a/ide/codecontextform.pas b/ide/codecontextform.pas index 470204feb4..afefb1af02 100644 --- a/ide/codecontextform.pas +++ b/ide/codecontextform.pas @@ -37,15 +37,28 @@ interface uses Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs, - CodeCache, FindDeclarationTool, IdentCompletionTool, CodeToolManager, SynEdit; + LCLType, LCLIntf, + SynEdit, CodeCache, FindDeclarationTool, IdentCompletionTool, CodeTree, + CodeAtom, PascalParserTool, CodeToolManager, + SrcEditorIntf; type { TCodeContextFrm } TCodeContextFrm = class(TForm) + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormPaint(Sender: TObject); private + FHints: TStrings; + FProcNameCodeXYPos: TCodeXYPosition; + procedure CreateHints(const CodeContexts: TCodeContextInfo); + procedure CalculateHintsBounds(const CodeContexts: TCodeContextInfo); + procedure DrawHints(var MaxWidth, MaxHeight: Integer; Draw: boolean); public + procedure SetCodeContexts(const CodeContexts: TCodeContextInfo); + property ProcNameCodeXYPos: TCodeXYPosition read FProcNameCodeXYPos; end; var @@ -68,15 +81,207 @@ begin CodeContexts) then exit; - DebugLn('ShowCodeContext show TODO'); + DebugLn('ShowCodeContext show'); + {$IFNDEF EnableCodeContext} + exit; + {$ENDIF} if CodeContextFrm=nil then CodeContextFrm:=TCodeContextFrm.Create(nil); - + CodeContextFrm.SetCodeContexts(CodeContexts); + CodeContextFrm.Visible:=true; finally CodeContexts.Free; end; end; +{ TCodeContextFrm } + +procedure TCodeContextFrm.FormCreate(Sender: TObject); +begin + FHints:=TStringList.Create; +end; + +procedure TCodeContextFrm.FormDestroy(Sender: TObject); +begin + FreeAndNil(FHints); +end; + +procedure TCodeContextFrm.FormPaint(Sender: TObject); +var + DrawWidth: LongInt; + DrawHeight: LongInt; +begin + DrawWidth:=Self.ClientWidth; + DrawHeight:=Self.ClientHeight; + DrawHints(DrawWidth,DrawHeight,true); +end; + +procedure TCodeContextFrm.SetCodeContexts(const CodeContexts: TCodeContextInfo); +begin + FillChar(FProcNameCodeXYPos,SizeOf(FProcNameCodeXYPos),0); + + if CodeContexts<>nil then begin + if (CodeContexts.ProcNameAtom.StartPos>0) then + CodeContexts.Tool.CleanPosToCaret(CodeContexts.ProcNameAtom.StartPos, + FProcNameCodeXYPos); + end; + + CreateHints(CodeContexts); + CalculateHintsBounds(CodeContexts); +end; + +procedure TCodeContextFrm.CreateHints(const CodeContexts: TCodeContextInfo); +var + i: Integer; + CurExprType: TExpressionType; + CodeNode: TCodeTreeNode; + CodeTool: TFindDeclarationTool; + s: String; + p: Integer; +begin + FHints.Clear; + if (CodeContexts=nil) or (CodeContexts.Count=0) then exit; + for i:=0 to CodeContexts.Count-1 do begin + CurExprType:=CodeContexts[i]; + s:=ExpressionTypeDescNames[CurExprType.Desc]; + if CurExprType.Context.Node<>nil then begin + CodeNode:=CurExprType.Context.Node; + CodeTool:=CurExprType.Context.Tool; + case CodeNode.Desc of + ctnProcedure: + begin + s:=CodeTool.ExtractProcHead(CodeNode, + [phpWithVarModifiers,phpWithParameterNames,phpWithDefaultValues, + phpWithResultType,phpWithOfObject]); + end; + end; + end; + // insert spaces + for p:=length(s)-1 downto 1 do begin + if (s[p] in [',',';',':']) and (s[p+1]<>' ') then + System.Insert(' ',s,p+1); + end; + FHints.Add(Trim(s)); + end; + DebugLn('TCodeContextFrm.UpdateHints ',FHints.Text); +end; + +procedure TCodeContextFrm.CalculateHintsBounds(const + CodeContexts: TCodeContextInfo); +var + DrawWidth: LongInt; + SrcEdit: TSourceEditorInterface; + NewBounds: TRect; + CursorTextXY: TPoint; + ScreenTextXY: TPoint; + ClientXY: TPoint; + DrawHeight: LongInt; + ScreenXY: TPoint; +begin + SrcEdit:=SourceEditorWindow.ActiveEditor; + if SrcEdit=nil then exit; + + // calculate the position of the context in the source editor + CursorTextXY:=SrcEdit.CursorTextXY; + if ProcNameCodeXYPos.Code<>nil then begin + if (ProcNameCodeXYPos.Code=SrcEdit.CodeToolsBuffer) + and (ProcNameCodeXYPos.Y<=CursorTextXY.Y) then begin + CursorTextXY:=Point(ProcNameCodeXYPos.X,ProcNameCodeXYPos.Y); + end; + end; + // calculate screen position + ScreenTextXY:=SrcEdit.TextToScreenPosition(CursorTextXY); + ClientXY:=SrcEdit.ScreenToPixelPosition(ScreenTextXY); + + // calculate size of hints + DrawWidth:=SourceEditorWindow.ClientWidth; + DrawHeight:=ClientXY.Y; + DrawHints(DrawWidth,DrawHeight,false); + if DrawWidth<20 then DrawWidth:=20; + if DrawHeight<5 then DrawHeight:=5; + + // calculate position of hints in editor client area + if ClientXY.X+DrawWidth>SrcEdit.EditorControl.ClientWidth then + ClientXY.X:=SrcEdit.EditorControl.ClientWidth-DrawWidth; + if ClientXY.X<0 then + ClientXY.X:=0; + dec(ClientXY.Y,DrawHeight); + + // calculate screen position + ScreenXY:=SrcEdit.EditorControl.ClientToScreen(ClientXY); + dec(ScreenXY.Y,4); + NewBounds:=Bounds(ScreenXY.X,ScreenXY.Y,DrawWidth,DrawHeight); + + // move form + BoundsRect:=NewBounds; +end; + +procedure TCodeContextFrm.DrawHints(var MaxWidth, MaxHeight: Integer; + Draw: boolean); +var + BackgroundColor, TextColor: TColor; + i: Integer; + NewMaxHeight: Integer; + Flags: Cardinal; + CurRect: TRect; + s: string; + CurTextRect: TRect; + HorizontalSpace: Integer; + VerticalSpace: Integer; + NewMaxWidth: Integer; +begin + //DebugLn('TCodeContextFrm.DrawHints DrawWidth=',dbgs(MaxWidth),' DrawHeight=',dbgs(MaxHeight),' Draw=',dbgs(Draw)); + if Draw then begin + // TODO: make colors configurable and theme dependent + BackgroundColor:=clWhite; + TextColor:=clBlack; + end; + HorizontalSpace:=2; + VerticalSpace:=2; + + if Draw then begin + Canvas.Brush.Color:=BackgroundColor; + Canvas.Font.Color:=TextColor; + end; + NewMaxWidth:=0; + NewMaxHeight:=0; + for i:=0 to FHints.Count-1 do begin + if Draw and (NewMaxHeight>=MaxHeight) then break; + s:=FHints[i]; + Flags:=DT_WordBreak; + CurTextRect:=Rect(0,NewMaxHeight,MaxWidth,MaxHeight); + OffsetRect(CurTextRect,HorizontalSpace,VerticalSpace); + // calculate height + DrawText(Canvas.Handle,PChar(s),Length(s),CurTextRect,Flags+DT_CalcRect); + if Draw then + CurRect:=Rect(0,NewMaxHeight,MaxWidth,CurTextRect.Bottom+VerticalSpace) + else + CurRect:=Rect(0,NewMaxHeight, + CurTextRect.Right+HorizontalSpace, + CurTextRect.Bottom+VerticalSpace); + //DebugLn('TCodeContextFrm.DrawHints i=',dbgs(i),' CurTextRect=',dbgs(CurTextRect),' CurRect=',dbgs(CurRect),' s="',s,'"'); + if CurRect.Right>NewMaxWidth then + NewMaxWidth:=CurRect.Right; + if Draw then begin + // draw text and background + Canvas.FillRect(CurRect); + DrawText(Canvas.Handle, PChar(s), Length(s), CurTextRect, Flags); + end; + NewMaxHeight:=CurRect.Bottom; + end; + if Draw then begin + // draw frame around window + Canvas.Pen.Color:=TextColor; + Canvas.Frame(Rect(0,0,MaxWidth-1,MaxHeight-1)); + end; + if not Draw then begin + if NewMaxWidthDefaultBorderIcons[AForm.BorderStyle]) then + RaiseNotImplemented; end; inherited SetBorderIcons(AForm, ABorderIcons); end; @@ -340,4 +341,4 @@ initialization // RegisterWSComponent(TScreen, TGtkWSScreen); // RegisterWSComponent(TApplicationProperties, TGtkWSApplicationProperties); //////////////////////////////////////////////////// -end. \ No newline at end of file +end. diff --git a/packager/addtopackagedlg.pas b/packager/addtopackagedlg.pas index 05bb282d42..5201336f0b 100644 --- a/packager/addtopackagedlg.pas +++ b/packager/addtopackagedlg.pas @@ -38,8 +38,9 @@ unit AddToPackageDlg; interface uses - Classes, SysUtils, LResources, Forms, Controls, Buttons, StdCtrls, ExtCtrls, - Dialogs, FileUtil, ComCtrls, AVL_Tree, LCLProc, NewItemIntf, ProjectIntf, + Classes, SysUtils, LResources, LCLType, Forms, Controls, Buttons, StdCtrls, + ExtCtrls, Dialogs, FileUtil, ComCtrls, AVL_Tree, LCLProc, + NewItemIntf, ProjectIntf, LazarusIDEStrConsts, IDEWindowIntf, InputHistory, CodeToolManager, IDEDefs, IDEProcs, EnvironmentOpts, PackageSystem, PackageDefs, ComponentReg; @@ -151,6 +152,8 @@ type procedure AddFileShortenButtonClick(Sender: TObject); procedure AddToPackageDlgClose(Sender: TObject; var CloseAction: TCloseAction); + procedure AddToPackageDlgKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); procedure AddUnitButtonClick(Sender: TObject); procedure AddUnitFileBrowseButtonClick(Sender: TObject); procedure AddUnitFileShortenButtonClick(Sender: TObject); @@ -475,6 +478,13 @@ begin IDEDialogLayoutList.SaveLayout(Self); end; +procedure TAddToPackageDlg.AddToPackageDlgKeyDown(Sender: TObject; + var Key: Word; Shift: TShiftState); +begin + if (Key=VK_ESCAPE) and (Shift=[]) then + ModalResult:=mrCancel; +end; + procedure TAddToPackageDlg.AddFilePageResize(Sender: TObject); var x: Integer; @@ -774,23 +784,33 @@ begin ok:=false; try LastParams:=nil; - for i:=0 to FilesListView.Items.Count-1 do begin + i:=0; + while imrIgnore + then + exit; + FilesListView.Items.Delete(i); + continue; + end; + NewFileType:=FileNameToPkgFileType(Filename); - if (not FileExists(Filename)) then begin - MessageDlg(lisFileNotFound, - Format(lisPkgMangFileNotFound, ['"', Filename, '"']), - mtError,[mbCancel],0); - exit; - end; if LazPackage.FindPkgFile(Filename,true,true,false)<>nil then begin // file already in package + FilesListView.Items.Delete(i); continue; end; @@ -811,7 +831,11 @@ begin // check filename if not CheckAddingUnitFilename(LazPackage,CurParams.AddType, - OnGetIDEFileInfo,CurParams.UnitFilename) then exit; + OnGetIDEFileInfo,CurParams.UnitFilename) + then begin + FilesListView.Items.Delete(i); + exit; + end; CurParams.AutoAddLFMFile:=true; CurParams.AutoAddLRSFile:=true; @@ -829,11 +853,14 @@ begin Format(lisA2PTheUnitNameAndFilenameDiffer, ['"', CurParams.UnitName, '"', #13, '"', CurParams.UnitFilename, '"']), mtError,[mbIgnore,mbCancel],0)<>mrIgnore - then + then begin + FilesListView.Items.Delete(i); exit; + end; end; end; LastParams:=CurParams; + inc(i); end; ok:=LastParams<>nil; finally @@ -1913,6 +1940,8 @@ begin Params:=TAddToPkgResult.Create; Position:=poScreenCenter; IDEDialogLayoutList.ApplyLayout(Self,500,300); + KeyPreview:=true; + OnKeyDown:=@AddToPackageDlgKeyDown; SetupComponents; OnClose:=@AddToPackageDlgClose; end; diff --git a/packager/packageeditor.pas b/packager/packageeditor.pas index 6bc6e7480e..83144c1307 100644 --- a/packager/packageeditor.pas +++ b/packager/packageeditor.pas @@ -1915,16 +1915,19 @@ begin ShortDirectory:=NewDirectory; LazPackage.ShortenFilename(ShortDirectory,false); if ShortDirectory='' then exit; - UnitPath:=LazPackage.GetUnitPath(true); - UnitPathPos:=SearchDirectoryInSearchPath(UnitPath,ShortDirectory,1); + LazPackage.LongenFilename(NewDirectory); + + UnitPath:=LazPackage.GetUnitPath(false); + UnitPathPos:=SearchDirectoryInSearchPath(UnitPath,NewDirectory,1); IncPathPos:=1; if AnIncludeFile<>'' then begin NewIncDirectory:=ExtractFilePath(AnIncludeFile); ShortIncDirectory:=NewIncDirectory; LazPackage.ShortenFilename(ShortIncDirectory,false); if ShortIncDirectory<>'' then begin - IncPath:=LazPackage.GetIncludePath(true); - IncPathPos:=SearchDirectoryInSearchPath(IncPath,ShortIncDirectory,1); + LazPackage.LongenFilename(NewIncDirectory); + IncPath:=LazPackage.GetIncludePath(false); + IncPathPos:=SearchDirectoryInSearchPath(IncPath,NewIncDirectory,1); end; end; if UnitPathPos<1 then begin @@ -1939,7 +1942,7 @@ begin OtherUnitFiles:=MergeSearchPaths(OtherUnitFiles,ShortDirectory); end; if IncPathPos<1 then begin - // the unit is in untipath, but the include file not in the incpath + // the unit is in unitpath, but the include file not in the incpath // -> auto extend the include path with LazPackage.CompilerOptions do IncludePath:=MergeSearchPaths(IncludePath,ShortIncDirectory);