fixed checking adding unitpaths on adding units to packages

git-svn-id: trunk@9305 -
This commit is contained in:
mattias 2006-05-18 22:52:15 +00:00
parent 2353d96a82
commit 4023c08654
14 changed files with 325 additions and 59 deletions

View File

@ -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)

View File

@ -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

View File

@ -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);

View File

@ -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

View File

@ -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
]);

View File

@ -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}

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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

View File

@ -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;

View File

@ -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.

View File

@ -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;

View File

@ -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);