mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-22 10:59:29 +02:00
IDE now checks, if all files of the package exists
git-svn-id: trunk@9309 -
This commit is contained in:
mattias
parent
7ed0ada460
commit
dc4d7c5d38
@ -55,7 +55,7 @@ type
|
||||
PCodeXYPosition = ^TCodeXYPosition;
|
||||
|
||||
TCommonAtomFlag = (
|
||||
cafNone,
|
||||
cafNone, // = none of the below
|
||||
cafSemicolon, cafEqual, cafColon, cafComma, cafPoint,
|
||||
cafRoundBracketOpen, cafRoundBracketClose,
|
||||
cafEdgedBracketOpen, cafEdgedBracketClose,
|
||||
|
||||
@ -2175,7 +2175,7 @@ begin
|
||||
repeat
|
||||
ALastAtomEnd:=CurPos.EndPos;
|
||||
ReadNextAtom;
|
||||
until (CurPos.EndPos>ALineEnd) or (CurPos.Flag=cafNone);
|
||||
until (CurPos.EndPos>ALineEnd) or (CurPos.StartPos>SrcLen);
|
||||
end else begin
|
||||
ALineStart:=Srclen+1;
|
||||
ALineEnd:=Srclen+1;
|
||||
|
||||
@ -6691,6 +6691,7 @@ function TFindDeclarationTool.CheckParameterSyntax(CursorNode: TCodeTreeNode;
|
||||
// check for Identifier(expr,expr,...,expr,VarName
|
||||
// or Identifier[expr,expr,...,expr,VarName
|
||||
// ParameterIndex is 0 based
|
||||
{off $DEFINE VerboseCPS}
|
||||
|
||||
procedure RaiseBracketNotOpened;
|
||||
begin
|
||||
@ -6707,16 +6708,16 @@ function TFindDeclarationTool.CheckParameterSyntax(CursorNode: TCodeTreeNode;
|
||||
BracketAtom: TAtomPosition;
|
||||
begin
|
||||
BracketAtom:=CurPos;
|
||||
//DebugLn('CheckBrackets ',GetAtom,' ',dbgs(BracketAtom));
|
||||
{$IFDEF VerboseCPS}DebugLn('CheckBrackets ',GetAtom,' ',dbgs(BracketAtom));{$ENDIF}
|
||||
repeat
|
||||
ReadNextAtom;
|
||||
if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then begin
|
||||
if (LastAtoms.GetValueAt(0).Flag=cafWord) then begin
|
||||
//DebugLn('CheckBrackets check word+bracket open');
|
||||
{$IFDEF VerboseCPS}DebugLn('CheckBrackets check word+bracket open');{$ENDIF}
|
||||
UndoReadNextAtom;
|
||||
if CheckIdentifierAndParameterList() then exit(true);
|
||||
end else begin
|
||||
//DebugLn('CheckBrackets check bracket open');
|
||||
{$IFDEF VerboseCPS}DebugLn('CheckBrackets check bracket open');{$ENDIF}
|
||||
if CheckBrackets then exit(true);
|
||||
end;
|
||||
end else if CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose]
|
||||
@ -6725,14 +6726,14 @@ function TFindDeclarationTool.CheckParameterSyntax(CursorNode: TCodeTreeNode;
|
||||
=(CurPos.Flag=cafRoundBracketClose)
|
||||
then begin
|
||||
// closing bracket found, but the variable was not in them
|
||||
//DebugLn('CheckBrackets bracket closed');
|
||||
{$IFDEF VerboseCPS}DebugLn('CheckBrackets bracket closed');{$ENDIF}
|
||||
exit(false);
|
||||
end else begin
|
||||
// invalid closing bracket found
|
||||
RaiseBracketNotOpened;
|
||||
end;
|
||||
end;
|
||||
until (CurPos.EndPos>CleanCursorPos) or (CurPos.Flag=cafNone);
|
||||
until (CurPos.EndPos>CleanCursorPos);
|
||||
Result:=false;
|
||||
end;
|
||||
|
||||
@ -6746,20 +6747,20 @@ function TFindDeclarationTool.CheckParameterSyntax(CursorNode: TCodeTreeNode;
|
||||
Result:=false;
|
||||
CurProcNameAtom:=CurPos;
|
||||
CurParameterIndex:=0;
|
||||
//DebugLn('CheckIdentifierAndParameterList START ',GetAtom,' ',dbgs(CurProcNameAtom));
|
||||
{$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList START ',GetAtom,' ',dbgs(CurProcNameAtom));{$ENDIF}
|
||||
ReadNextAtom;
|
||||
if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then begin
|
||||
BracketAtom:=CurPos;
|
||||
ParameterStart:=CurPos.EndPos;
|
||||
//DebugLn('CheckIdentifierAndParameterList Bracket=',GetAtom);
|
||||
{$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList Bracket=',GetAtom);{$ENDIF}
|
||||
repeat
|
||||
ReadNextAtom;
|
||||
//DebugLn('CheckIdentifierAndParameterList ',GetAtom);
|
||||
{$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList Atom=',GetAtom);{$ENDIF}
|
||||
if CurPos.EndPos>=CleanCursorPos then begin
|
||||
// parameter found => search parameter expression bounds e.g. ', parameter ,'
|
||||
// important: this function should work, even the code behind
|
||||
// CleanCursorPos is buggy
|
||||
//DebugLn('CheckIdentifierAndParameterList Parameter found, search range ...');
|
||||
{$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList Parameter found, search range ...');{$ENDIF}
|
||||
ProcNameAtom:=CurProcNameAtom;
|
||||
ParameterIndex:=CurParameterIndex;
|
||||
ParameterAtom.StartPos:=ParameterStart;
|
||||
@ -6767,7 +6768,7 @@ function TFindDeclarationTool.CheckParameterSyntax(CursorNode: TCodeTreeNode;
|
||||
MoveCursorToCleanPos(ParameterStart);
|
||||
repeat
|
||||
ReadNextAtom;
|
||||
//DebugLn('CheckIdentifierAndParameterList parameter atom ',GetAtom);
|
||||
{$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList parameter atom ',GetAtom);{$ENDIF}
|
||||
if (CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen]) then
|
||||
ReadTilBracketClose(false)
|
||||
else
|
||||
@ -6778,7 +6779,7 @@ function TFindDeclarationTool.CheckParameterSyntax(CursorNode: TCodeTreeNode;
|
||||
and (not LastUpAtomIs(0,'INHERITED'))) then
|
||||
begin
|
||||
// end of parameter expression found
|
||||
//DebugLn('CheckIdentifierAndParameterList end of parameter found');
|
||||
{$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList end of parameter found');{$ENDIF}
|
||||
exit(true);
|
||||
end else begin
|
||||
// atom belongs to the parameter expression
|
||||
@ -6790,22 +6791,22 @@ function TFindDeclarationTool.CheckParameterSyntax(CursorNode: TCodeTreeNode;
|
||||
end;
|
||||
if (CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen]) then begin
|
||||
if (LastAtoms.GetValueAt(0).Flag=cafWord) then begin
|
||||
//DebugLn('CheckIdentifierAndParameterList check word+bracket open');
|
||||
{$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList check word+bracket open');{$ENDIF}
|
||||
UndoReadNextAtom;
|
||||
if CheckIdentifierAndParameterList() then exit(true);
|
||||
end else begin
|
||||
//DebugLn('CheckIdentifierAndParameterList check bracket open');
|
||||
{$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList check bracket open');{$ENDIF}
|
||||
if CheckBrackets then exit(true);
|
||||
end;
|
||||
end
|
||||
else if CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose] then
|
||||
begin
|
||||
//DebugLn('CheckIdentifierAndParameterList check bracket close');
|
||||
{$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList check bracket close');{$ENDIF}
|
||||
if (BracketAtom.Flag=cafRoundBracketOpen)
|
||||
=(CurPos.Flag=cafRoundBracketClose)
|
||||
then begin
|
||||
// parameter list ended in front of Variable => continue search
|
||||
//DebugLn('CheckIdentifierAndParameterList parm list ended in front of cursor');
|
||||
{$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList parm list ended in front of cursor');{$ENDIF}
|
||||
exit;
|
||||
end else begin
|
||||
// invalid closing bracket found
|
||||
@ -6817,8 +6818,8 @@ function TFindDeclarationTool.CheckParameterSyntax(CursorNode: TCodeTreeNode;
|
||||
ParameterStart:=CurPos.EndPos;
|
||||
inc(CurParameterIndex);
|
||||
end;
|
||||
//DebugLn('CheckIdentifierAndParameterList ',GetAtom);
|
||||
until (CurPos.EndPos>CleanCursorPos) or (CurPos.Flag=cafNone);
|
||||
{$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList After parsing atom: atom=',GetAtom);{$ENDIF}
|
||||
until (CurPos.EndPos>CleanCursorPos);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -6830,7 +6831,7 @@ begin
|
||||
MoveCursorToNodeStart(CursorNode);
|
||||
repeat
|
||||
ReadNextAtom;
|
||||
//DebugLn('TCodeCompletionCodeTool.CheckParameterSyntax ',GetAtom,' ',dbgs(CurPos.EndPos),'<',dbgs(CleanCursorPos));
|
||||
{$IFDEF VerboseCPS}DebugLn('TCodeCompletionCodeTool.CheckParameterSyntax ',GetAtom,' ',dbgs(CurPos.EndPos),'<',dbgs(CleanCursorPos));{$ENDIF}
|
||||
if CurPos.EndPos>CleanCursorPos then exit;
|
||||
if (CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen])
|
||||
and (LastAtoms.GetValueAt(0).Flag=cafWord) then begin
|
||||
|
||||
@ -3110,7 +3110,7 @@ begin
|
||||
CurKeyWordFuncList:=ClassInterfaceKeyWordFuncList;
|
||||
try
|
||||
repeat
|
||||
if CurPos.Flag in [cafEnd,cafNone] then break;
|
||||
if (CurPos.Flag=cafEnd) or (CurPos.StartPos>SrcLen) then break;
|
||||
if not DoAtom then break;
|
||||
ReadNextAtom;
|
||||
until false;
|
||||
|
||||
@ -4,8 +4,10 @@ object CodeContextFrm: TCodeContextFrm
|
||||
Caption = 'CodeContextFrm'
|
||||
ClientHeight = 300
|
||||
ClientWidth = 400
|
||||
KeyPreview = True
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
OnKeyDown = FormKeyDown
|
||||
OnPaint = FormPaint
|
||||
PixelsPerInch = 112
|
||||
HorzScrollBar.Page = 399
|
||||
|
||||
@ -3,8 +3,9 @@
|
||||
LazarusResources.Add('TCodeContextFrm','FORMDATA',[
|
||||
'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
|
||||
+'ClientWidth'#3#144#1#10'KeyPreview'#9#8'OnCreate'#7#10'FormCreate'#9'OnDest'
|
||||
+'roy'#7#11'FormDestroy'#9'OnKeyDown'#7#11'FormKeyDown'#7'OnPaint'#7#9'FormPa'
|
||||
+'int'#13'PixelsPerInch'#2'p'#18'HorzScrollBar.Page'#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
|
||||
]);
|
||||
|
||||
@ -36,10 +36,10 @@ unit CodeContextForm;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
LCLType, LCLIntf,
|
||||
SynEdit, CodeCache, FindDeclarationTool, IdentCompletionTool, CodeTree,
|
||||
CodeAtom, PascalParserTool, CodeToolManager,
|
||||
Classes, SysUtils, Types, LCLProc, LResources, Forms, Controls, Graphics,
|
||||
Dialogs, LCLType, LCLIntf,
|
||||
BasicCodeTools, LinkScanner, CodeCache, FindDeclarationTool,
|
||||
IdentCompletionTool, CodeTree, CodeAtom, PascalParserTool, CodeToolManager,
|
||||
SrcEditorIntf;
|
||||
|
||||
type
|
||||
@ -49,11 +49,14 @@ type
|
||||
TCodeContextFrm = class(TForm)
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure FormPaint(Sender: TObject);
|
||||
private
|
||||
FHints: TStrings;
|
||||
FProcNameCodeXYPos: TCodeXYPosition;
|
||||
procedure CreateHints(const CodeContexts: TCodeContextInfo);
|
||||
procedure ClearMarksInHints;
|
||||
procedure MarkCurrentParameterInHints(ParameterIndex: integer); // 0 based
|
||||
procedure CalculateHintsBounds(const CodeContexts: TCodeContextInfo);
|
||||
procedure DrawHints(var MaxWidth, MaxHeight: Integer; Draw: boolean);
|
||||
public
|
||||
@ -64,22 +67,22 @@ type
|
||||
var
|
||||
CodeContextFrm: TCodeContextFrm = nil;
|
||||
|
||||
function ShowCodeContext(Code: TCodeBuffer; Editor: TSynEdit): boolean;
|
||||
function ShowCodeContext(Code: TCodeBuffer): boolean;
|
||||
|
||||
implementation
|
||||
|
||||
function ShowCodeContext(Code: TCodeBuffer; Editor: TSynEdit): boolean;
|
||||
function ShowCodeContext(Code: TCodeBuffer): boolean;
|
||||
var
|
||||
LogCaretXY: TPoint;
|
||||
CodeContexts: TCodeContextInfo;
|
||||
begin
|
||||
Result:=false;
|
||||
LogCaretXY:=Editor.LogicalCaretXY;
|
||||
LogCaretXY:=SourceEditorWindow.ActiveEditor.CursorTextXY;
|
||||
CodeContexts:=nil;
|
||||
try
|
||||
if not CodeToolBoss.FindCodeContext(Code,LogCaretXY.X,LogCaretXY.Y,
|
||||
CodeContexts)
|
||||
then
|
||||
if (not CodeToolBoss.FindCodeContext(Code,LogCaretXY.X,LogCaretXY.Y,
|
||||
CodeContexts))
|
||||
or (CodeContexts=nil) or (CodeContexts.Count=0) then
|
||||
exit;
|
||||
DebugLn('ShowCodeContext show');
|
||||
{$IFNDEF EnableCodeContext}
|
||||
@ -89,6 +92,7 @@ begin
|
||||
CodeContextFrm:=TCodeContextFrm.Create(nil);
|
||||
CodeContextFrm.SetCodeContexts(CodeContexts);
|
||||
CodeContextFrm.Visible:=true;
|
||||
Result:=true;
|
||||
finally
|
||||
CodeContexts.Free;
|
||||
end;
|
||||
@ -106,6 +110,12 @@ begin
|
||||
FreeAndNil(FHints);
|
||||
end;
|
||||
|
||||
procedure TCodeContextFrm.FormKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
if (Key=VK_ESCAPE) and (Shift=[]) then Close;
|
||||
end;
|
||||
|
||||
procedure TCodeContextFrm.FormPaint(Sender: TObject);
|
||||
var
|
||||
DrawWidth: LongInt;
|
||||
@ -161,11 +171,158 @@ begin
|
||||
if (s[p] in [',',';',':']) and (s[p+1]<>' ') then
|
||||
System.Insert(' ',s,p+1);
|
||||
end;
|
||||
// mark the mark characters
|
||||
for p:=length(s) downto 1 do
|
||||
if s[p]='\' then
|
||||
System.Insert('\',s,p+1);
|
||||
FHints.Add(Trim(s));
|
||||
end;
|
||||
MarkCurrentParameterInHints(CodeContexts.ParameterIndex-1);
|
||||
DebugLn('TCodeContextFrm.UpdateHints ',FHints.Text);
|
||||
end;
|
||||
|
||||
procedure TCodeContextFrm.ClearMarksInHints;
|
||||
// remove all marks except the \\ marks
|
||||
var
|
||||
i: Integer;
|
||||
s: string;
|
||||
p: Integer;
|
||||
begin
|
||||
for i:=0 to FHints.Count-1 do begin
|
||||
s:=FHints[i];
|
||||
p:=1;
|
||||
while p<length(s) do begin
|
||||
if s[p]<>'\' then
|
||||
inc(p) // normal character
|
||||
else if s[p+1]='\' then
|
||||
inc(p,2) // '\\'
|
||||
else begin
|
||||
System.Delete(s,p,2); // remove mark
|
||||
end;
|
||||
end;
|
||||
FHints[i]:=s;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCodeContextFrm.MarkCurrentParameterInHints(ParameterIndex: integer);
|
||||
|
||||
function MarkCurrentParameterInHint(const s: string): string;
|
||||
var
|
||||
p: Integer;
|
||||
CurrentMark: Char;
|
||||
|
||||
procedure Mark(NewMark: char; Position: integer);
|
||||
begin
|
||||
if p=Position then
|
||||
CurrentMark:=NewMark;
|
||||
System.Insert('\'+NewMark,Result,Position);
|
||||
if Position<=p then
|
||||
inc(p,2);
|
||||
//DebugLn('Mark Position=',dbgs(Position),' p=',dbgs(p),' CurrentMark="',CurrentMark,'" ',copy(Result,1,Position+2));
|
||||
end;
|
||||
|
||||
var
|
||||
BracketLevel: Integer;
|
||||
CurParameterIndex: Integer;
|
||||
WordStart: LongInt;
|
||||
WordEnd: LongInt;
|
||||
ModifierStart: LongInt;
|
||||
ModifierEnd: LongInt;
|
||||
SearchingType: Boolean;
|
||||
ReadingType: Boolean;
|
||||
begin
|
||||
Result:=s;
|
||||
BracketLevel:=0;
|
||||
CurParameterIndex:=0;
|
||||
CurrentMark:='*';
|
||||
ReadingType:=false;
|
||||
SearchingType:=false;
|
||||
ModifierStart:=-1;
|
||||
ModifierEnd:=-1;
|
||||
p:=1;
|
||||
while (p<=length(Result)) do begin
|
||||
//DebugLn('MarkCurrentParameterInHint p=',dbgs(p),' "',Result[p],'" BracketLevel=',dbgs(BracketLevel),' CurParameterIndex=',dbgs(CurParameterIndex),' ReadingType=',dbgs(ReadingType),' SearchingType=',dbgs(SearchingType));
|
||||
case Result[p] of
|
||||
'(','{':
|
||||
inc(BracketLevel);
|
||||
')','}':
|
||||
begin
|
||||
if (BracketLevel=1) then begin
|
||||
if CurrentMark<>'*' then
|
||||
Mark('*',p);
|
||||
exit;
|
||||
end;
|
||||
dec(BracketLevel);
|
||||
end;
|
||||
',':
|
||||
if BracketLevel=1 then begin
|
||||
inc(CurParameterIndex);
|
||||
end;
|
||||
':':
|
||||
if BracketLevel=1 then begin
|
||||
// names ended, type started
|
||||
if SearchingType then
|
||||
Mark('b',p);
|
||||
ReadingType:=true;
|
||||
SearchingType:=false;
|
||||
end;
|
||||
';':
|
||||
if BracketLevel=1 then begin
|
||||
// type ended, next parameter started
|
||||
if CurrentMark<>'*' then
|
||||
Mark('*',p);
|
||||
SearchingType:=false;
|
||||
ReadingType:=false;
|
||||
ModifierStart:=-1;
|
||||
inc(CurParameterIndex);
|
||||
end;
|
||||
'''':
|
||||
repeat
|
||||
inc(p);
|
||||
until (p>=length(Result)) or (Result[p]='''');
|
||||
'a'..'z','A'..'Z','_':
|
||||
if (BracketLevel=1) and (not ReadingType) then begin
|
||||
WordStart:=p;
|
||||
while (p<=length(Result)) and (IsIdentChar[Result[p]]) do
|
||||
inc(p);
|
||||
WordEnd:=p;
|
||||
//DebugLn('MarkCurrentParameterInHint Word=',copy(Result,WordStart,WordEnd-WordStart));
|
||||
if (CompareIdentifiers('const',@Result[WordStart])=0)
|
||||
or (CompareIdentifiers('out',@Result[WordStart])=0)
|
||||
or (CompareIdentifiers('var',@Result[WordStart])=0) then begin
|
||||
// modifier
|
||||
ModifierStart:=WordStart;
|
||||
ModifierEnd:=WordEnd;
|
||||
end else begin
|
||||
// parameter name
|
||||
if ParameterIndex=CurParameterIndex then begin
|
||||
// mark parameter
|
||||
Mark('*',WordEnd); // mark WordEnd before WordStart !
|
||||
Mark('b',WordStart);
|
||||
// mark modifier
|
||||
if ModifierStart>0 then begin
|
||||
Mark('*',ModifierEnd); // mark ModifierEnd before ModifierStart !
|
||||
Mark('b',ModifierStart);
|
||||
end;
|
||||
// search type
|
||||
SearchingType:=true;
|
||||
end;
|
||||
end;
|
||||
dec(p);
|
||||
end;
|
||||
end;
|
||||
inc(p);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
ClearMarksInHints;
|
||||
for i:=0 to FHints.Count-1 do
|
||||
FHints[i]:=MarkCurrentParameterInHint(FHints[i]);
|
||||
end;
|
||||
|
||||
procedure TCodeContextFrm.CalculateHintsBounds(const
|
||||
CodeContexts: TCodeContextInfo);
|
||||
var
|
||||
@ -219,22 +376,126 @@ 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;
|
||||
BackgroundColor, TextColor, TextBColor: TColor;
|
||||
|
||||
procedure DrawHint(const Line: string; var AHintRect: TRect);
|
||||
var
|
||||
ATextRect: TRect;
|
||||
TokenStart: Integer;
|
||||
TokenRect: TRect;
|
||||
TokenSize: TPoint;
|
||||
TokenPos: TPoint;
|
||||
TokenEnd: LongInt;
|
||||
UsedWidth: Integer; // maximum right token position
|
||||
LineHeight: Integer; // current line height
|
||||
LastTokenEnd: LongInt;
|
||||
begin
|
||||
ATextRect:=Rect(AHintRect.Left+HorizontalSpace,
|
||||
AHintRect.Top+VerticalSpace,
|
||||
AHintRect.Right-HorizontalSpace,
|
||||
AHintRect.Bottom-VerticalSpace);
|
||||
UsedWidth:=0;
|
||||
LineHeight:=0;
|
||||
TokenPos:=Point(ATextRect.Left,ATextRect.Top);
|
||||
TokenEnd:=1;
|
||||
while (TokenEnd<=length(Line)) do begin
|
||||
LastTokenEnd:=TokenEnd;
|
||||
ReadRawNextPascalAtom(Line,TokenEnd,TokenStart);
|
||||
if TokenEnd<=LastTokenEnd then break;
|
||||
if Line[TokenStart]='\' then begin
|
||||
// mark found
|
||||
if TokenStart>LastTokenEnd then begin
|
||||
// there is a gap between last token and this token -> draw that first
|
||||
TokenEnd:=TokenStart;
|
||||
end else begin
|
||||
inc(TokenStart);
|
||||
if TokenStart>length(Line) then break;
|
||||
TokenEnd:=TokenStart+1;
|
||||
// the token is a mark
|
||||
case Line[TokenStart] of
|
||||
|
||||
'*':
|
||||
begin
|
||||
// switch to normal font
|
||||
Canvas.Font.Color:=TextColor;
|
||||
//DebugLn('DrawHint normal');
|
||||
continue;
|
||||
end;
|
||||
|
||||
'b':
|
||||
begin
|
||||
// switch to bold font
|
||||
Canvas.Font.Color:=TextBColor;
|
||||
//DebugLn('DrawHint blue');
|
||||
continue;
|
||||
end;
|
||||
|
||||
else
|
||||
// the token is a normal character -> paint it
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
//DebugLn('DrawHint Token="',copy(Line,TokenStart,TokenEnd-TokenStart),'"');
|
||||
|
||||
// calculate token size
|
||||
TokenRect:=Bounds(0,0,12345,1234);
|
||||
DrawText(Canvas.Handle,@Line[LastTokenEnd],TokenEnd-LastTokenEnd,TokenRect,
|
||||
DT_SINGLELINE+DT_CALCRECT+DT_NOCLIP);
|
||||
TokenSize:=Point(TokenRect.Right,TokenRect.Bottom);
|
||||
|
||||
if (LineHeight>0) and (TokenPos.X+TokenRect.Right>ATextRect.Right) then
|
||||
begin
|
||||
// token does not fit into line -> break line
|
||||
// fill end of line
|
||||
if Draw and (TokenPos.X<AHintRect.Right) then begin
|
||||
Canvas.FillRect(Rect(TokenPos.X,TokenPos.Y-VerticalSpace,
|
||||
AHintRect.Right,TokenPos.Y+LineHeight+VerticalSpace));
|
||||
end;
|
||||
TokenPos:=Point(ATextRect.Left,TokenPos.y+LineHeight+VerticalSpace);
|
||||
LineHeight:=0;
|
||||
end;
|
||||
|
||||
// token fits into line
|
||||
// => draw token
|
||||
OffsetRect(TokenRect,TokenPos.x,TokenPos.y);
|
||||
if Draw then begin
|
||||
Canvas.FillRect(Rect(TokenRect.Left,TokenRect.Top-VerticalSpace,
|
||||
TokenRect.Right,TokenRect.Bottom+VerticalSpace));
|
||||
DrawText(Canvas.Handle,@Line[LastTokenEnd],TokenEnd-LastTokenEnd,TokenRect,
|
||||
DT_SINGLELINE+DT_NOCLIP);
|
||||
end;
|
||||
// update LineHeight and UsedWidth
|
||||
if LineHeight<TokenSize.y then
|
||||
LineHeight:=TokenSize.y;
|
||||
inc(TokenPos.X,TokenSize.x);
|
||||
if UsedWidth<TokenPos.X then
|
||||
UsedWidth:=TokenPos.X;
|
||||
end;
|
||||
// fill end of line
|
||||
if Draw and (TokenPos.X<AHintRect.Right) and (LineHeight>0) then begin
|
||||
Canvas.FillRect(Rect(TokenPos.X,TokenPos.Y-VerticalSpace,
|
||||
AHintRect.Right,TokenPos.Y+LineHeight+VerticalSpace));
|
||||
end;
|
||||
|
||||
if (not Draw) and (UsedWidth>0) then
|
||||
AHintRect.Right:=UsedWidth+HorizontalSpace;
|
||||
AHintRect.Bottom:=TokenPos.Y+LineHeight+VerticalSpace;
|
||||
end;
|
||||
|
||||
var
|
||||
i: Integer;
|
||||
NewMaxHeight: Integer;
|
||||
NewMaxWidth: Integer;
|
||||
CurHintRect: TRect;
|
||||
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;
|
||||
TextColor:=clDkGray;
|
||||
TextBColor:=clBlack;
|
||||
end;
|
||||
HorizontalSpace:=2;
|
||||
VerticalSpace:=2;
|
||||
@ -242,39 +503,28 @@ begin
|
||||
if Draw then begin
|
||||
Canvas.Brush.Color:=BackgroundColor;
|
||||
Canvas.Font.Color:=TextColor;
|
||||
Canvas.Pen.Color:=clBlack;
|
||||
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);
|
||||
CurHintRect:=Rect(0,NewMaxHeight,MaxWidth,MaxHeight);
|
||||
DrawHint(FHints[i],CurHintRect);
|
||||
//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;
|
||||
if CurHintRect.Right>NewMaxWidth then
|
||||
NewMaxWidth:=CurHintRect.Right;
|
||||
NewMaxHeight:=CurHintRect.Bottom;
|
||||
end;
|
||||
if Draw then begin
|
||||
// fill rest of form
|
||||
if NewMaxHeight<MaxHeight then
|
||||
Canvas.FillRect(Rect(0,NewMaxHeight,MaxWidth,MaxHeight));
|
||||
// draw frame around window
|
||||
Canvas.Pen.Color:=TextColor;
|
||||
Canvas.Frame(Rect(0,0,MaxWidth-1,MaxHeight-1));
|
||||
end;
|
||||
if not Draw then begin
|
||||
// adjust max width and height
|
||||
if NewMaxWidth<MaxWidth then
|
||||
MaxWidth:=NewMaxWidth;
|
||||
if NewMaxHeight<MaxHeight then
|
||||
|
||||
@ -2316,6 +2316,13 @@ resourcestring
|
||||
+'does not correspond to the package name %s%s%s in the file.%sChange '
|
||||
+'package name to %s%s%s?';
|
||||
lisPkgMangSavePackage2 = 'Save package?';
|
||||
lisPkgMangPackageFileMissing = 'Package file missing';
|
||||
lisPkgMangTheFileOfPackageIsMissing = 'The file %s%s%s%sof package %s is '
|
||||
+'missing.';
|
||||
lisPkgMangPackageFileNotSaved = 'Package file not saved';
|
||||
lisPkgMangTheFileOfPackageNeedsToBeSavedFirst = 'The file %s%s%s%sof '
|
||||
+'package %s needs to be saved first.';
|
||||
lisPkgMangIgnoreAndSavePackageNow = 'Ignore and save package now';
|
||||
lisPkgMangPackageChangedSave = 'Package %s%s%s changed. Save?';
|
||||
lisPkgMangErrorWritingPackage = 'Error Writing Package';
|
||||
lisPkgMangUnableToWritePackageToFileError = 'Unable to write package %s%s%s%'
|
||||
|
||||
@ -11136,7 +11136,7 @@ begin
|
||||
writeln('[TMainIDE.DoShowCodeContext] ************');
|
||||
{$ENDIF}
|
||||
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TMainIDE.DoShowCodeContext A');{$ENDIF}
|
||||
Result:=ShowCodeContext(ActiveUnitInfo.Source,ActiveSrcEdit.EditorComponent);
|
||||
Result:=ShowCodeContext(ActiveUnitInfo.Source);
|
||||
if not Result then begin
|
||||
if JumpToError then
|
||||
DoJumpToCodeToolBossError;
|
||||
|
||||
@ -271,6 +271,7 @@ type
|
||||
function DoClosePackageEditor(APackage: TLazPackage): TModalResult; override;
|
||||
function DoCloseAllPackageEditors: TModalResult; override;
|
||||
function DoAddActiveUnitToAPackage: TModalResult;
|
||||
function WarnAboutMissingPackageFiles(APackage: TLazPackage): TModalResult;
|
||||
|
||||
// package compilation
|
||||
function DoCompileProjectDependencies(AProject: TProject;
|
||||
@ -2706,48 +2707,6 @@ end;
|
||||
|
||||
function TPkgManager.DoSavePackage(APackage: TLazPackage;
|
||||
Flags: TPkgSaveFlags): TModalResult;
|
||||
|
||||
function WarnAboutMissingPackageFiles: TModalResult;
|
||||
var
|
||||
i: Integer;
|
||||
AFile: TPkgFile;
|
||||
AFilename: String;
|
||||
begin
|
||||
Result:=mrOk;
|
||||
for i:=0 to APackage.FileCount-1 do begin
|
||||
AFile:=APackage.Files[i];
|
||||
if AFile.FileType=pftVirtualUnit then continue;
|
||||
AFilename:=AFile.Filename;
|
||||
if System.Pos('$(',AFilename)>0 then begin
|
||||
// filename contains macros -> skip
|
||||
end;
|
||||
if FilenameIsAbsolute(AFilename) then begin
|
||||
if not FileExistsCached(AFilename) then begin
|
||||
if not APackage.IsVirtual then
|
||||
AFilename:=CreateRelativePath(AFilename,APackage.Directory);
|
||||
Result:=QuestionDlg('Package file missing',
|
||||
'The file "'+AFilename+'"'#13
|
||||
+'of package '+APackage.IDAsString+' is missing.',
|
||||
mtWarning,[mrIgnore,mrAbort],0);
|
||||
if Result<>mrAbort then
|
||||
Result:=mrOk;
|
||||
// one warning is enough
|
||||
exit;
|
||||
end;
|
||||
end else begin
|
||||
if not APackage.IsVirtual then begin
|
||||
// an unsaved file
|
||||
Result:=QuestionDlg('Package file not saved',
|
||||
'The file "'+AFilename+'"'#13
|
||||
+'of package '+APackage.IDAsString+' needs to be saved first.',
|
||||
mtWarning,[mrIgnore,'Ignore and save package now',mrAbort],0);
|
||||
if Result<>mrAbort then
|
||||
Result:=mrOk;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
XMLConfig: TXMLConfig;
|
||||
PkgLink: TPackageLink;
|
||||
@ -2779,7 +2738,7 @@ begin
|
||||
end;
|
||||
|
||||
// warn about missing files
|
||||
Result:=WarnAboutMissingPackageFiles;
|
||||
Result:=WarnAboutMissingPackageFiles(APackage);
|
||||
if Result<>mrOk then exit;
|
||||
|
||||
// save editor files to codetools
|
||||
@ -2972,6 +2931,9 @@ begin
|
||||
if Result<>mrOk then exit;
|
||||
end;
|
||||
|
||||
Result:=WarnAboutMissingPackageFiles(APackage);
|
||||
if Result<>mrOk then exit;
|
||||
|
||||
PackageGraph.BeginUpdate(false);
|
||||
try
|
||||
// automatically compile required packages
|
||||
@ -3849,6 +3811,51 @@ begin
|
||||
Result:=ShowAddFileToAPackageDlg(Filename,TheUnitName,HasRegisterProc);
|
||||
end;
|
||||
|
||||
function TPkgManager.WarnAboutMissingPackageFiles(APackage: TLazPackage
|
||||
): TModalResult;
|
||||
var
|
||||
i: Integer;
|
||||
AFile: TPkgFile;
|
||||
AFilename: String;
|
||||
begin
|
||||
Result:=mrOk;
|
||||
for i:=0 to APackage.FileCount-1 do begin
|
||||
AFile:=APackage.Files[i];
|
||||
if AFile.FileType=pftVirtualUnit then continue;
|
||||
AFilename:=AFile.Filename;
|
||||
if System.Pos('$(',AFilename)>0 then begin
|
||||
// filename contains macros -> skip
|
||||
end;
|
||||
if (not APackage.IsVirtual) and FilenameIsAbsolute(AFilename) then
|
||||
APackage.LongenFilename(AFilename);
|
||||
if FilenameIsAbsolute(AFilename) then begin
|
||||
if not FileExistsCached(AFilename) then begin
|
||||
if not APackage.IsVirtual then
|
||||
AFilename:=CreateRelativePath(AFilename,APackage.Directory);
|
||||
Result:=QuestionDlg(lisPkgMangPackageFileMissing,
|
||||
Format(lisPkgMangTheFileOfPackageIsMissing, ['"', AFilename, '"',
|
||||
#13, APackage.IDAsString]),
|
||||
mtWarning,[mrIgnore,mrAbort],0);
|
||||
if Result<>mrAbort then
|
||||
Result:=mrOk;
|
||||
// one warning is enough
|
||||
exit;
|
||||
end;
|
||||
end else begin
|
||||
if not APackage.IsVirtual then begin
|
||||
// an unsaved file
|
||||
Result:=QuestionDlg(lisPkgMangPackageFileNotSaved,
|
||||
Format(lisPkgMangTheFileOfPackageNeedsToBeSavedFirst, ['"',
|
||||
AFilename, '"', #13, APackage.IDAsString]),
|
||||
mtWarning, [mrIgnore, lisPkgMangIgnoreAndSavePackageNow, mrAbort], 0
|
||||
);
|
||||
if Result<>mrAbort then
|
||||
Result:=mrOk;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPkgManager.DoInstallPackage(APackage: TLazPackage): TModalResult;
|
||||
var
|
||||
PkgList: TList;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user