mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 07:38:14 +02:00
fixed checking adding unitpaths on adding units to packages
git-svn-id: trunk@9305 -
This commit is contained in:
parent
2353d96a82
commit
4023c08654
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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);
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
]);
|
||||
|
@ -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 NewMaxWidth<MaxWidth then
|
||||
MaxWidth:=NewMaxWidth;
|
||||
if NewMaxHeight<MaxHeight then
|
||||
MaxHeight:=NewMaxHeight;
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I codecontextform.lrs}
|
||||
|
||||
|
@ -285,6 +285,7 @@ type
|
||||
procedure CenterCursor;
|
||||
function TextToScreenPosition(const Position: TPoint): TPoint; override;
|
||||
function ScreenToTextPosition(const Position: TPoint): TPoint; override;
|
||||
function ScreenToPixelPosition(const Position: TPoint): TPoint; override;
|
||||
function GetCursorScreenXY: TPoint; override;
|
||||
function GetCursorTextXY: TPoint; override;
|
||||
procedure SetCursorScreenXY(const AValue: TPoint); override;
|
||||
@ -2419,6 +2420,11 @@ begin
|
||||
Result:=FEditor.PhysicalToLogicalPos(Position);
|
||||
end;
|
||||
|
||||
function TSourceEditor.ScreenToPixelPosition(const Position: TPoint): TPoint;
|
||||
begin
|
||||
Result:=FEditor.RowColumnToPixels(Position);
|
||||
end;
|
||||
|
||||
function TSourceEditor.LineCount: Integer;
|
||||
begin
|
||||
Result:=FEditor.Lines.Count;
|
||||
|
@ -85,6 +85,7 @@ type
|
||||
function HeightInLines: Integer; virtual; abstract;
|
||||
function CharWidth: integer; virtual; abstract;
|
||||
function CursorInPixel: TPoint; virtual; abstract;
|
||||
function ScreenToPixelPosition(const Position: TPoint): TPoint; virtual; abstract;
|
||||
|
||||
// update
|
||||
procedure BeginUndoBlock; virtual; abstract;
|
||||
|
@ -1270,6 +1270,15 @@ type
|
||||
var
|
||||
MessageBoxFunction: TMessageBoxFunction;
|
||||
|
||||
const
|
||||
DefaultBorderIcons : array[TFormBorderStyle] of TBorderIcons =
|
||||
([], // bsNone
|
||||
[biSystemMenu, biMinimize], // bsSingle
|
||||
[biSystemMenu, biMinimize, biMaximize], // bsSizeable
|
||||
[biSystemMenu], // bsDialog
|
||||
[biSystemMenu, biMinimize], // bsToolWindow
|
||||
[biSystemMenu, biMinimize, biMaximize]); // bsSizeToolWin
|
||||
|
||||
procedure FreeWidgetSet;
|
||||
|
||||
procedure Register;
|
||||
|
@ -1114,14 +1114,6 @@ end;
|
||||
{ TCustomForm SetFormBorderStyle }
|
||||
{------------------------------------------------------------------------------}
|
||||
procedure TCustomForm.SetFormBorderStyle(NewStyle: TFormBorderStyle);
|
||||
const
|
||||
DefaultBorderIcons : array[TFormBorderStyle] of TBorderIcons =
|
||||
([], // bsNone
|
||||
[biSystemMenu, biMinimize], // bsSingle
|
||||
[biSystemMenu, biMinimize, biMaximize], // bsSizeable
|
||||
[biSystemMenu], // bsDialog
|
||||
[biSystemMenu, biMinimize], // bsToolWindow
|
||||
[biSystemMenu, biMinimize, biMaximize]); // bsSizeToolWin
|
||||
var
|
||||
AdaptBorderIcons: boolean;
|
||||
begin
|
||||
|
@ -276,7 +276,7 @@ function MakeWParam(l, h: Word): WPARAM; inline;
|
||||
function MakeLParam(l, h: Word): LPARAM; inline;
|
||||
function MakeLResult(l, h: Word): LRESULT; inline;
|
||||
|
||||
function OffSetRect(var Rect: TRect; dx,dy: Integer): Boolean; inline;
|
||||
function OffsetRect(var Rect: TRect; dx,dy: Integer): Boolean; inline;
|
||||
|
||||
function PtInRect(Rect : TRect; Point : TPoint) : Boolean; inline;
|
||||
function PointToSmallPoint(const P : TPoint) : TSmallPoint; inline;
|
||||
|
@ -316,8 +316,9 @@ procedure TGtkWSCustomForm.SetBorderIcons(const AForm: TCustomForm;
|
||||
end;
|
||||
|
||||
begin
|
||||
if AForm.ComponentState*[csDesigning,csLoading]=[csDesigning] then begin
|
||||
RaiseNotImplemented;
|
||||
if (AForm.ComponentState*[csDesigning,csLoading]=[csDesigning]) then begin
|
||||
if (AForm.BorderIcons<>DefaultBorderIcons[AForm.BorderStyle]) then
|
||||
RaiseNotImplemented;
|
||||
end;
|
||||
inherited SetBorderIcons(AForm, ABorderIcons);
|
||||
end;
|
||||
@ -340,4 +341,4 @@ initialization
|
||||
// RegisterWSComponent(TScreen, TGtkWSScreen);
|
||||
// RegisterWSComponent(TApplicationProperties, TGtkWSApplicationProperties);
|
||||
////////////////////////////////////////////////////
|
||||
end.
|
||||
end.
|
||||
|
@ -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 i<FilesListView.Items.Count do begin
|
||||
Filename:=FilesListView.Items[i].Caption;
|
||||
LazPackage.LongenFilename(Filename);
|
||||
|
||||
// skip directories
|
||||
if DirPathExists(Filename) then continue;
|
||||
if DirPathExists(Filename) then begin
|
||||
FilesListView.Items.Delete(i);
|
||||
continue;
|
||||
end;
|
||||
|
||||
// skip not existing files
|
||||
if (not FileExists(Filename)) then begin
|
||||
if QuestionDlg(lisFileNotFound,
|
||||
Format(lisPkgMangFileNotFound, ['"', Filename, '"']),
|
||||
mtError,[mrIgnore,mrCancel],0)<>mrIgnore
|
||||
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;
|
||||
|
@ -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);
|
||||
|
Loading…
Reference in New Issue
Block a user