1 {
2 /***************************************************************************
3 CodeContextForm.pas
4 -------------------
5
6 ***************************************************************************/
7
8 ***************************************************************************
9 * *
10 * This source is free software; you can redistribute it and/or modify *
11 * it under the terms of the GNU General Public License as published by *
12 * the Free Software Foundation; either version 2 of the License, or *
13 * (at your option) any later version. *
14 * *
15 * This code is distributed in the hope that it will be useful, but *
16 * WITHOUT ANY WARRANTY; without even the implied warranty of *
17 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
18 * General Public License for more details. *
19 * *
20 * A copy of the GNU General Public License is available on the World *
21 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
22 * obtain it by writing to the Free Software Foundation, *
23 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
24 * *
25 ***************************************************************************
26
27 Author: Mattias Gaertner
28
29 Abstract:
30 The popup tooltip window for the source editor.
31 For example for the parameter hints.
32 }
33 unit CodeContextForm;
34
35 {$mode objfpc}{$H+}
36
37 interface
38
39 uses
40 Classes, SysUtils, Types,
41 // LCL
42 LCLProc, LCLType, LCLIntf, LResources, LMessages, Forms, Controls,
43 Graphics, Dialogs, Themes, Buttons,
44 // LazUtils
45 LazStringUtils,
46 // SynEdit
47 SynEdit, SynEditKeyCmds,
48 // CodeTools
49 BasicCodeTools, KeywordFuncLists, LinkScanner, CodeCache, FindDeclarationTool,
50 IdentCompletionTool, CodeTree, CodeAtom, PascalParserTool, CodeToolManager,
51 // IdeIntf
52 SrcEditorIntf, LazIDEIntf, IDEImagesIntf,
53 // IDE
54 LazarusIDEStrConsts;
55
56 type
57
58 { TCodeContextItem }
59
60 TCodeContextItem = class
61 public
62 Code: string;
63 Hint: string;
64 NewBounds: TRect;
65 CopyAllButton: TSpeedButton;
66 destructor Destroy; override;
67 end;
68
69 { TCodeContextFrm }
70
71 TCodeContextFrm = class(THintWindow)
72 procedure ApplicationIdle(Sender: TObject; var {%H-}Done: Boolean);
73 procedure CopyAllBtnClick(Sender: TObject);
74 procedure FormCreate(Sender: TObject);
75 procedure FormDestroy(Sender: TObject);
76 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
77 procedure FormPaint(Sender: TObject);
78 procedure FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
79 procedure OnSrcEditStatusChange(Sender: TObject);
80 private
81 FHints: TFPList; // list of TCodeContextItem
82 FIdleConnected: boolean;
83 FLastParameterIndex: integer;
84 FParamListBracketOpenCodeXYPos: TCodeXYPosition;
85 FProcNameCodeXYPos: TCodeXYPosition;
86 FSourceEditorTopIndex: integer;
87 FBtnWidth: integer;
88 fDestroying: boolean;
89 procedure CreateHints(const CodeContexts: TCodeContextInfo);
90 procedure ClearMarksInHints;
GetHintsnull91 function GetHints(Index: integer): TCodeContextItem;
92 procedure MarkCurrentParameterInHints(ParameterIndex: integer); // 0 based
93 procedure CalculateHintsBounds;
94 procedure DrawHints(var MaxWidth, MaxHeight: Integer; Draw: boolean);
95 procedure CompleteParameters(DeclCode: string);
96 procedure ClearHints;
97 procedure SetIdleConnected(AValue: boolean);
98 procedure SetCodeContexts(const CodeContexts: TCodeContextInfo);
99 protected
100 procedure Notification(AComponent: TComponent; Operation: TOperation);
101 override;
102 procedure WMNCHitTest(var Message: TLMessage); message LM_NCHITTEST;
103 public
104 constructor Create(TheOwner: TComponent); override;
105 destructor Destroy; override;
106 procedure UpdateHints;
107 procedure Paint; override;
108 property ProcNameCodeXYPos: TCodeXYPosition read FProcNameCodeXYPos;
109 property ParamListBracketOpenCodeXYPos: TCodeXYPosition
110 read FParamListBracketOpenCodeXYPos;
111 property SourceEditorTopIndex: integer read FSourceEditorTopIndex;
112 property LastParameterIndex: integer read FLastParameterIndex;
113 property Hints[Index: integer]: TCodeContextItem read GetHints;
114 property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
115 end;
116
117 var
118 CodeContextFrm: TCodeContextFrm = nil;
119
ShowCodeContextnull120 function ShowCodeContext(Code: TCodeBuffer): boolean;
121
122 implementation
123
124 type
125 TWinControlAccess = class(TWinControl);
126
ShowCodeContextnull127 function ShowCodeContext(Code: TCodeBuffer): boolean;
128 var
129 LogCaretXY: TPoint;
130 CodeContexts: TCodeContextInfo;
131 begin
132 Result := False;
133 LogCaretXY := SourceEditorManagerIntf.ActiveEditor.CursorTextXY;
134 CodeContexts := nil;
135 try
136 if not CodeToolBoss.FindCodeContext(Code, LogCaretXY.X, LogCaretXY.Y, CodeContexts) or
137 (CodeContexts = nil) or (CodeContexts.Count = 0) then
138 Exit;
139 if CodeContextFrm = nil then
140 CodeContextFrm := TCodeContextFrm.Create(LazarusIDE.OwningComponent);
141 CodeContextFrm.DisableAlign;
142 try
143 CodeContextFrm.SetCodeContexts(CodeContexts);
144 CodeContextFrm.Visible := True;
145 finally
146 CodeContextFrm.EnableAlign;
147 end;
148 Result := True;
149 finally
150 CodeContexts.Free;
151 end;
152 end;
153
154 { TCodeContextItem }
155
156 destructor TCodeContextItem.Destroy;
157 begin
158 FreeAndNil(CopyAllButton);
159 inherited Destroy;
160 end;
161
162 { TCodeContextFrm }
163
164 procedure TCodeContextFrm.ApplicationIdle(Sender: TObject; var Done: Boolean);
165 begin
166 if not Visible then exit;
167 UpdateHints;
168 IdleConnected:=false;
169 end;
170
171 procedure TCodeContextFrm.CopyAllBtnClick(Sender: TObject);
172 var
173 i: LongInt;
174 Item: TCodeContextItem;
175 begin
176 i:=FHints.Count-1;
177 while (i>=0) do begin
178 Item:=Hints[i];
179 if Item.CopyAllButton=Sender then begin
180 //debugln(['TCodeContextFrm.CopyAllBtnClick Hint="',Item.Code,'"']);
181 CompleteParameters(Item.Code);
182 exit;
183 end;
184 dec(i);
185 end;
186 end;
187
188 procedure TCodeContextFrm.FormCreate(Sender: TObject);
189 begin
190 FBtnWidth:=16;
191 FHints:=TFPList.Create;
192 IdleConnected:=true;
193 SourceEditorManagerIntf.RegisterChangeEvent(semEditorStatus,@OnSrcEditStatusChange);
194 end;
195
196 procedure TCodeContextFrm.FormDestroy(Sender: TObject);
197 begin
198 if SourceEditorManagerIntf<>nil then
199 SourceEditorManagerIntf.UnregisterChangeEvent(semEditorStatus,@OnSrcEditStatusChange);
200 IdleConnected:=false;
201 ClearHints;
202 FreeAndNil(FHints);
203 end;
204
205 procedure TCodeContextFrm.FormKeyDown(Sender: TObject; var Key: Word;
206 Shift: TShiftState);
207 var
208 SrcEdit: TSourceEditorInterface;
209 begin
210 if (Key=VK_ESCAPE) and (Shift=[]) then
211 Hide
212 else if SourceEditorManagerIntf<>nil then begin
213 SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
214 if SrcEdit=nil then
215 Hide
216 else begin
217 // redirect keys
218 TWinControlAccess(SrcEdit.EditorControl).KeyDown(Key,Shift);
219 SetActiveWindow(SourceEditorManagerIntf.ActiveSourceWindow.Handle);
220 end;
221 end;
222 end;
223
224 procedure TCodeContextFrm.FormPaint(Sender: TObject);
225 var
226 DrawWidth: LongInt;
227 DrawHeight: LongInt;
228 begin
229 DrawWidth:=ClientWidth;
230 DrawHeight:=ClientHeight;
231 DrawHints(DrawWidth,DrawHeight,true);
232 end;
233
234 procedure TCodeContextFrm.FormUTF8KeyPress(Sender: TObject;
235 var UTF8Key: TUTF8Char);
236 var
237 SrcEdit: TSourceEditorInterface;
238 ASynEdit: TCustomSynEdit;
239 begin
240 SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
241 if SrcEdit=nil then begin
242 Hide;
243 end else begin
244 ASynEdit:=(SrcEdit.EditorControl as TCustomSynEdit);
245 ASynEdit.CommandProcessor(ecChar,UTF8Key,nil);
246 end;
247 end;
248
249 procedure TCodeContextFrm.OnSrcEditStatusChange(Sender: TObject);
250 begin
251 IdleConnected:=true;
252 end;
253
254 procedure TCodeContextFrm.SetCodeContexts(const CodeContexts: TCodeContextInfo);
255 begin
256 FillChar(FProcNameCodeXYPos,SizeOf(FProcNameCodeXYPos),0);
257 FillChar(FParamListBracketOpenCodeXYPos,SizeOf(FParamListBracketOpenCodeXYPos),0);
258
259 if CodeContexts<>nil then begin
260 if (CodeContexts.ProcNameAtom.StartPos>0) then begin
261 CodeContexts.Tool.MoveCursorToCleanPos(CodeContexts.ProcNameAtom.StartPos);
262 CodeContexts.Tool.CleanPosToCaret(CodeContexts.Tool.CurPos.StartPos,
263 FProcNameCodeXYPos);
264 CodeContexts.Tool.ReadNextAtom;// read proc name
265 CodeContexts.Tool.ReadNextAtom;// read bracket open
266 if CodeContexts.Tool.CurPos.Flag
267 in [cafRoundBracketOpen,cafEdgedBracketOpen]
268 then begin
269 CodeContexts.Tool.CleanPosToCaret(CodeContexts.Tool.CurPos.StartPos,
270 FParamListBracketOpenCodeXYPos);
271 end;
272 end;
273 end;
274
275 CreateHints(CodeContexts);
276 CalculateHintsBounds;
277 end;
278
279 procedure TCodeContextFrm.UpdateHints;
280 var
281 SrcEdit: TSourceEditorInterface;
282 CurTextXY: TPoint;
283 ASynEdit: TSynEdit;
284 NewParameterIndex: Integer;
285 BracketPos: TPoint;
286 Line: string;
287 Code: String;
288 TokenEnd: LongInt;
289 TokenStart: LongInt;
290 KeepOpen: Boolean;
291 BracketLevel: Integer;
292 i: Integer;
293 Item: TCodeContextItem;
294 begin
295 if not Visible then exit;
296
297 KeepOpen:=false;
298 NewParameterIndex:=-1;
299 try
300 if not Application.Active then exit;
301
302 // check Source Editor
303 if SourceEditorManagerIntf=nil then exit;
304 SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
305 if (SrcEdit=nil) or (SrcEdit.CodeToolsBuffer<>ProcNameCodeXYPos.Code) then
306 exit;
307 if SrcEdit.TopLine<>FSourceEditorTopIndex then exit;
308
309 CurTextXY:=SrcEdit.CursorTextXY;
310 BracketPos:=Point(ParamListBracketOpenCodeXYPos.X,
311 ParamListBracketOpenCodeXYPos.Y);
312 if ComparePoints(CurTextXY,BracketPos)<=0 then begin
313 // cursor moved in front of parameter list
314 exit;
315 end;
316
317 // find out, if cursor is in procedure call and where
318 ASynEdit:=SrcEdit.EditorControl as TSynEdit;
319
320 Line:=ASynEdit.Lines[BracketPos.Y-1];
321 if (length(Line)<BracketPos.X) or (not (Line[BracketPos.X] in ['(','[']))
322 then begin
323 // bracket lost -> something changed -> hints became invalid
324 exit;
325 end;
326
327 // collect the lines from bracket open to cursor
328 Code:=StringListPartToText(ASynEdit.Lines,BracketPos.Y-1,CurTextXY.Y-1,#10);
329 if CurTextXY.Y<=ASynEdit.Lines.Count then begin
330 Line:=ASynEdit.Lines[CurTextXY.Y-1];
331 if length(Line)>=CurTextXY.X then
332 SetLength(Code,length(Code)-length(Line)+CurTextXY.X-1);
333 end;
334 //DebugLn('TCodeContextFrm.UpdateHints Code="',DbgStr(Code),'"');
335
336 // parse the code
337 TokenEnd:=BracketPos.X;
338 BracketLevel:=0;
339 repeat
340 ReadRawNextPascalAtom(Code,TokenEnd,TokenStart);
341 if TokenEnd=TokenStart then break;
342 case Code[TokenStart] of
343 '(','[':
344 begin
345 inc(BracketLevel);
346 if BracketLevel=1 then
347 NewParameterIndex:=0;
348 end;
349 ')',']':
350 begin
351 if BracketLevel=1 then begin
352 if Code[TokenStart]=']' then begin
353 ReadRawNextPascalAtom(Code,TokenEnd,TokenStart);
354 if TokenEnd=TokenStart then exit;
355 if Code[TokenStart]='[' then begin
356 inc(NewParameterIndex);
357 continue; // [][] is full version of [,]
358 end
359 end else
360 exit;// cursor behind procedure call
361 end;
362 dec(BracketLevel);
363 end;
364 ',':
365 if BracketLevel=1 then inc(NewParameterIndex);
366 else
367 if IsIdentStartChar[Code[TokenStart]] then begin
368 if CompareIdentifiers(@Code[TokenStart],'end')=0 then
369 break;// cursor behind procedure call
370 end;
371 end;
372 until false;
373 KeepOpen:=true;
374
375 // show buttons
376 for i:=0 to FHints.Count-1 do begin
377 Item:=TCodeContextItem(FHints[i]);
378 if Item.CopyAllButton <> nil then begin
379 Item.CopyAllButton.BoundsRect:=Item.NewBounds;
380 Item.CopyAllButton.Visible:=Item.NewBounds.Right>0;
381 end;
382 end;
383 finally
384 if not KeepOpen then
385 Hide
386 else if NewParameterIndex<>LastParameterIndex then
387 MarkCurrentParameterInHints(NewParameterIndex);
388 end;
389 end;
390
391 procedure TCodeContextFrm.WMNCHitTest(var Message: TLMessage);
392 begin
393 Message.Result := HTCLIENT;
394 end;
395
396 procedure TCodeContextFrm.CreateHints(const CodeContexts: TCodeContextInfo);
397
FindBaseTypenull398 function FindBaseType(Tool: TFindDeclarationTool; Node: TCodeTreeNode;
399 var s: string): boolean;
400 var
401 Expr: TExpressionType;
402 Params: TFindDeclarationParams;
403 ExprTool: TFindDeclarationTool;
404 ExprNode: TCodeTreeNode;
405 begin
406 Result:=false;
407 Params:=TFindDeclarationParams.Create(Tool, Node);
408 try
409 try
410 Expr:=Tool.ConvertNodeToExpressionType(Node,Params);
411 if (Expr.Desc=xtContext) and (Expr.Context.Node<>nil) then begin
412 ExprTool:=Expr.Context.Tool;
413 ExprNode:=Expr.Context.Node;
414 if ExprNode.Desc=ctnReferenceTo then begin
415 ExprNode:=ExprNode.FirstChild;
416 if ExprNode=nil then exit;
417 end;
418 case ExprNode.Desc of
419 ctnProcedureType:
420 begin
421 s:=s+ExprTool.ExtractProcHead(ExprNode,
422 [phpWithVarModifiers,phpWithParameterNames,phpWithDefaultValues,
423 phpWithResultType]);
424 Result:=true;
425 end;
426 ctnOpenArrayType,ctnRangedArrayType:
427 begin
428 s:=s+ExprTool.ExtractArrayRanges(ExprNode,[]);
429 Result:=true;
430 end;
431 end;
432 end else if Expr.Desc in (xtAllStringTypes+xtAllWideStringTypes-[xtShortString])
433 then begin
434 s:=s+'[Index: 1..high(PtrUInt)]';
435 Result:=true;
436 end else if Expr.Desc=xtShortString then begin
437 s:=s+'[Index: 0..255]';
438 Result:=true;
439 end;
440 if not Result then
441 debugln(['TCodeContextFrm.CreateHints.FindBaseType: not yet supported: ',ExprTypeToString(Expr)]);
442 except
443 end;
444 finally
445 Params.Free;
446 end;
447 end;
448
449 var
450 i: Integer;
451 CurExprType: TExpressionType;
452 CodeNode: TCodeTreeNode;
453 CodeTool: TFindDeclarationTool;
454 s: String;
455 p: Integer;
456 CurContext: TCodeContextInfoItem;
457 Btn: TSpeedButton;
458 j: Integer;
459 Code: String;
460 Item: TCodeContextItem;
461 begin
462 ClearHints;
463 if (CodeContexts=nil) or (CodeContexts.Count=0) then exit;
464 for i:=0 to CodeContexts.Count-1 do begin
465 CurContext:=CodeContexts[i];
466 CurExprType:=CurContext.Expr;
467 Code:=ExpressionTypeDescNames[CurExprType.Desc];
468 if CurExprType.Context.Node<>nil then begin
469 CodeNode:=CurExprType.Context.Node;
470 CodeTool:=CurExprType.Context.Tool;
471 case CodeNode.Desc of
472 ctnProcedure:
473 begin
474 Code:=CodeTool.ExtractProcHead(CodeNode,
475 [phpWithVarModifiers,phpWithParameterNames,phpWithDefaultValues,
476 phpWithResultType]);
477 end;
478 ctnProperty:
479 begin
480 if CodeTool.PropertyNodeHasParamList(CodeNode) then begin
481 Code:=CodeTool.ExtractProperty(CodeNode,
482 [phpWithVarModifiers,phpWithParameterNames,phpWithDefaultValues,
483 phpWithResultType]);
484 end else if not CodeTool.PropNodeIsTypeLess(CodeNode) then begin
485 Code:=CodeTool.ExtractPropName(CodeNode,false);
486 if not FindBaseType(CodeTool,CodeNode,Code) then
487 continue;
488 end else begin
489 // ignore properties without type
490 continue;
491 end;
492 end;
493 ctnVarDefinition:
494 begin
495 Code:=CodeTool.ExtractDefinitionName(CodeNode);
496 if not FindBaseType(CodeTool,CodeNode,Code) then
497 continue; // ignore normal variables
498 end;
499 end;
500 end else if CurContext.Params<>nil then begin
501 // compiler function
Codenull502 Code:=CurContext.ProcName+'('+CurContext.Params.DelimitedText+')';
503 if CurContext.ResultType<>'' then
504 Code:=Code+':'+CurContext.ResultType;
505 end;
506 // insert spaces
507 for p:=length(Code)-1 downto 1 do begin
508 if (Code[p] in [',',';',':']) and (Code[p+1]<>' ') then
509 System.Insert(' ',Code,p+1);
510 end;
511 Code:=Trim(Code);
512 s:=Code;
513 // mark the mark characters
514 for p:=length(s) downto 1 do
515 if s[p]='\' then
516 System.Insert('\',s,p+1);
517 // add hint if not already exists
518 j:=FHints.Count-1;
519 while (j>=0) and (CompareText(Hints[j].Code,Code)<>0) do
520 dec(j);
521 if j<0 then begin
522 Item:=TCodeContextItem.Create;
523 Item.Code:=Code;
524 Item.Hint:=s;
525 Btn:=TSpeedButton.Create(Self);
526 Item.CopyAllButton:=Btn;
527 Btn.Name:='CopyAllSpeedButton'+IntToStr(i+1);
528 Btn.OnClick:=@CopyAllBtnClick;
529 Btn.Visible:=false;
530 IDEImages.AssignImage(Btn, 'laz_copy');
531 Btn.Flat:=true;
532 Btn.Parent:=Self;
533 FHints.Add(Item);
534 end;
535 end;
536 if FHints.Count=0 then begin
537 Item:=TCodeContextItem.Create;
538 Item.Code:='';
539 Item.Hint:=lisNoHints;
540 FHints.Add(Item);
541 end;
542 MarkCurrentParameterInHints(CodeContexts.ParameterIndex-1);
543 end;
544
545 procedure TCodeContextFrm.ClearMarksInHints;
546 // remove all marks except the \\ marks
547 var
548 i: Integer;
549 s: string;
550 p: Integer;
551 Item: TCodeContextItem;
552 begin
553 for i:=0 to FHints.Count-1 do begin
554 Item:=Hints[i];
555 s:=Item.Hint;
556 p:=1;
557 while p<length(s) do begin
558 if s[p]<>'\' then
559 inc(p) // normal character
560 else if s[p+1]='\' then
561 inc(p,2) // '\\'
562 else begin
563 System.Delete(s,p,2); // remove mark
564 end;
565 end;
566 Item.Hint:=s;
567 end;
568 end;
569
GetHintsnull570 function TCodeContextFrm.GetHints(Index: integer): TCodeContextItem;
571 begin
572 Result:=TCodeContextItem(FHints[Index]);
573 end;
574
575 procedure TCodeContextFrm.MarkCurrentParameterInHints(ParameterIndex: integer);
576
MarkCurrentParameterInHintnull577 function MarkCurrentParameterInHint(const s: string): string;
578 var
579 p: Integer;
580 CurrentMark: Char;
581
582 procedure Mark(NewMark: char; Position: integer);
583 begin
584 if p=Position then
585 CurrentMark:=NewMark;
586 System.Insert('\'+NewMark,Result,Position);
587 if Position<=p then
588 inc(p,2);
589 //DebugLn('Mark Position=',dbgs(Position),' p=',dbgs(p),' CurrentMark="',CurrentMark,'" ',copy(Result,1,Position+2));
590 end;
591
592 var
593 BracketLevel: Integer;
594 CurParameterIndex: Integer;
595 WordStart: LongInt;
596 WordEnd: LongInt;
597 ModifierStart: LongInt;
598 ModifierEnd: LongInt;
599 SearchingType: Boolean;
600 ReadingType: Boolean;
601 begin
602 Result:=s;
603 BracketLevel:=0;
604 CurParameterIndex:=0;
605 CurrentMark:='*';
606 ReadingType:=false;
607 SearchingType:=false;
608 ModifierStart:=-1;
609 ModifierEnd:=-1;
610 p:=1;
611 while (p<=length(Result)) do begin
612 //DebugLn('MarkCurrentParameterInHint p=',dbgs(p),' "',Result[p],'" BracketLevel=',dbgs(BracketLevel),' CurParameterIndex=',dbgs(CurParameterIndex),' ReadingType=',dbgs(ReadingType),' SearchingType=',dbgs(SearchingType));
613 case Result[p] of
614 '(','{','[':
615 inc(BracketLevel);
616 ')','}',']':
617 begin
618 if (BracketLevel=1) then begin
619 if CurrentMark<>'*' then
620 Mark('*',p);
621 exit;
622 end;
623 dec(BracketLevel);
624 end;
625 ',':
626 if BracketLevel=1 then begin
627 inc(CurParameterIndex);
628 end;
629 ':':
630 if BracketLevel=1 then begin
631 // names ended, type started
632 if SearchingType then
633 Mark('b',p);
634 ReadingType:=true;
635 SearchingType:=false;
636 end;
637 ';':
638 if BracketLevel=1 then begin
639 // type ended, next parameter started
640 if CurrentMark<>'*' then
641 Mark('*',p);
642 SearchingType:=false;
643 ReadingType:=false;
644 ModifierStart:=-1;
645 inc(CurParameterIndex);
646 end;
647 '''':
648 repeat
649 inc(p);
650 until (p>=length(Result)) or (Result[p]='''');
651 'a'..'z','A'..'Z','_','0'..'9':
652 if (BracketLevel=1) and (not ReadingType) then begin
653 WordStart:=p;
654 while (p<=length(Result)) and IsDottedIdentChar[Result[p]] do
655 inc(p);
656 WordEnd:=p;
657 //DebugLn('MarkCurrentParameterInHint Word=',copy(Result,WordStart,WordEnd-WordStart));
658 if (CompareIdentifiers('const',@Result[WordStart])=0)
659 or (CompareIdentifiers('out',@Result[WordStart])=0)
660 or (CompareIdentifiers('var',@Result[WordStart])=0) then begin
661 // modifier
662 ModifierStart:=WordStart;
663 ModifierEnd:=WordEnd;
664 end else begin
665 // parameter name
666 if ParameterIndex=CurParameterIndex then begin
667 // mark parameter
668 Mark('*',WordEnd); // mark WordEnd before WordStart !
669 Mark('b',WordStart);
670 // mark modifier
671 if ModifierStart>0 then begin
672 Mark('*',ModifierEnd); // mark ModifierEnd before ModifierStart !
673 Mark('b',ModifierStart);
674 end;
675 // search type
676 SearchingType:=true;
677 end;
678 end;
679 dec(p);
680 end;
681 end;
682 inc(p);
683 end;
684 end;
685
686 var
687 i: Integer;
688 Item: TCodeContextItem;
689 begin
690 //DebugLn('TCodeContextFrm.MarkCurrentParameterInHints FLastParameterIndex=',dbgs(FLastParameterIndex),' ParameterIndex=',dbgs(ParameterIndex));
691 ClearMarksInHints;
692 for i:=0 to FHints.Count-1 do begin
693 Item:=Hints[i];
694 Item.Hint:=MarkCurrentParameterInHint(Item.Hint);
695 end;
696 FLastParameterIndex:=ParameterIndex;
697 Invalidate;
698 end;
699
700 procedure TCodeContextFrm.CalculateHintsBounds;
701 var
702 DrawWidth: LongInt;
703 SrcEdit: TSourceEditorInterface;
704 NewBounds: TRect;
705 CursorTextXY: TPoint;
706 ScreenTextXY: TPoint;
707 ClientXY: TPoint;
708 DrawHeight: LongInt;
709 ScreenXY: TPoint;
710 begin
711 SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
712 if SrcEdit=nil then exit;
713
714 // calculate the position of the context in the source editor
715 CursorTextXY:=SrcEdit.CursorTextXY;
716 if ProcNameCodeXYPos.Code<>nil then begin
717 if (ProcNameCodeXYPos.Code=SrcEdit.CodeToolsBuffer)
718 and (ProcNameCodeXYPos.Y<=CursorTextXY.Y) then begin
719 CursorTextXY:=Point(ProcNameCodeXYPos.X,ProcNameCodeXYPos.Y);
720 end;
721 end;
722 // calculate screen position
723 ScreenTextXY:=SrcEdit.TextToScreenPosition(CursorTextXY);
724 ClientXY:=SrcEdit.ScreenToPixelPosition(ScreenTextXY);
725 ScreenXY:=SrcEdit.EditorControl.ClientToScreen(ClientXY);
726 FSourceEditorTopIndex:=SrcEdit.TopLine;
727
728 // calculate size of hints
729 DrawWidth:=SourceEditorManagerIntf.ActiveSourceWindow.ClientWidth;
730 DrawHeight:=ScreenXY.Y-GetParentForm(SrcEdit.EditorControl).Monitor.WorkareaRect.Top-10;
731 DrawHints(DrawWidth,DrawHeight,false);
732 if DrawWidth<20 then DrawWidth:=20;
733 if DrawHeight<5 then DrawHeight:=5;
734
735 // calculate position of hints in editor client area
736 if ClientXY.X+DrawWidth>SrcEdit.EditorControl.ClientWidth then
737 ClientXY.X:=SrcEdit.EditorControl.ClientWidth-DrawWidth;
738 if ClientXY.X<0 then
739 ClientXY.X:=0;
740 dec(ClientXY.Y,DrawHeight);
741
742 // calculate screen position
743 ScreenXY:=SrcEdit.EditorControl.ClientToScreen(ClientXY);
744 NewBounds:=Bounds(ScreenXY.X,ScreenXY.Y-4,DrawWidth,DrawHeight);
745
746 // move form
747 BoundsRect:=NewBounds;
748 end;
749
750 procedure TCodeContextFrm.DrawHints(var MaxWidth, MaxHeight: Integer;
751 Draw: boolean);
752 var
753 LeftSpace, RightSpace: Integer;
754 VerticalSpace: Integer;
755 BackgroundColor, TextGrayColor, TextColor, PenColor: TColor;
756 TextGrayStyle, TextStyle: TFontStyles;
757
758 procedure DrawHint(Index: integer; var AHintRect: TRect);
759 var
760 ATextRect: TRect;
761 TokenStart: Integer;
762 TokenRect: TRect;
763 TokenSize: TPoint;
764 TokenPos: TPoint;
765 TokenEnd: LongInt;
766 UsedWidth: Integer; // maximum right token position
767 LineHeight: Integer; // current line height
768 LastTokenEnd: LongInt;
769 Line: string;
770 Item: TCodeContextItem;
771 y: LongInt;
772 r: TRect;
773 begin
774 Item:=Hints[Index];
775 Line:=Item.Hint;
776 ATextRect:=Rect(AHintRect.Left+LeftSpace,
777 AHintRect.Top+VerticalSpace,
778 AHintRect.Right-RightSpace,
779 AHintRect.Bottom-VerticalSpace);
780 UsedWidth:=0;
781 LineHeight:=0;
782 TokenPos:=Point(ATextRect.Left,ATextRect.Top);
783 TokenEnd:=1;
784 while (TokenEnd<=length(Line)) do begin
785 LastTokenEnd:=TokenEnd;
786 ReadRawNextPascalAtom(Line,TokenEnd,TokenStart);
787 if TokenEnd<=LastTokenEnd then break;
788 if Line[TokenStart]='\' then begin
789 // mark found
790 if TokenStart>LastTokenEnd then begin
791 // there is a gap between last token and this token -> draw that first
792 TokenEnd:=TokenStart;
793 end else begin
794 inc(TokenStart);
795 if TokenStart>length(Line) then break;
796 TokenEnd:=TokenStart+1;
797 // the token is a mark
798 case Line[TokenStart] of
799
800 '*':
801 begin
802 // switch to normal font
803 if Draw then begin
804 Canvas.Font.Color:=TextGrayColor;
805 Canvas.Font.Style:=TextGrayStyle;
806 end;
807 //DebugLn('DrawHint gray');
808 continue;
809 end;
810
811 'b':
812 begin
813 // switch to normal font
814 if Draw then begin
815 Canvas.Font.Color:=TextColor;
816 Canvas.Font.Style:=TextStyle;
817 end;
818 //DebugLn('DrawHint normal');
819 continue;
820 end;
821
822 else
823 // the token is a normal character -> paint it
824 end;
825 end;
826 end;
827 //DebugLn('DrawHint Token="',copy(Line,TokenStart,TokenEnd-TokenStart),'"');
828
829 // calculate token size
830 TokenRect:=Bounds(0,0,12345,1234);
831 DrawText(Canvas.Handle,@Line[LastTokenEnd],TokenEnd-LastTokenEnd,TokenRect,
832 DT_SINGLELINE+DT_CALCRECT+DT_NOCLIP);
833 TokenSize:=Point(TokenRect.Right,TokenRect.Bottom);
834 {$IFDEF EnableCCFFontMin}
835 // workaround for bug 22190
836 if TokenSize.y<14 then TokenSize.y:=14;
837 {$ENDIF}
838 //DebugLn(['DrawHint Draw="',Draw,'" Token="',copy(Line,TokenStart,TokenEnd-TokenStart),'" TokenSize=',dbgs(TokenSize)]);
839
840 if (LineHeight>0) and (TokenPos.X+TokenRect.Right>ATextRect.Right) then
841 begin
842 // token does not fit into line -> break line
843 // fill end of line
844 if Draw and (TokenPos.X<AHintRect.Right) then begin
845 Canvas.FillRect(Rect(TokenPos.X,TokenPos.Y-VerticalSpace,
846 AHintRect.Right,TokenPos.Y+LineHeight+VerticalSpace));
847 end;
848 TokenPos:=Point(ATextRect.Left,TokenPos.y+LineHeight+VerticalSpace);
849 LineHeight:=0;
850 end;
851
852 // token fits into line
853 // => draw token
854 OffsetRect(TokenRect,TokenPos.x,TokenPos.y);
855 if Draw then begin
856 Canvas.FillRect(Rect(TokenRect.Left,TokenRect.Top-VerticalSpace,
857 TokenRect.Right,TokenRect.Bottom+VerticalSpace));
858 DrawText(Canvas.Handle,@Line[LastTokenEnd],TokenEnd-LastTokenEnd,
859 TokenRect,DT_SINGLELINE+DT_NOCLIP);
860 end;
861 // update LineHeight and UsedWidth
862 if LineHeight<TokenSize.y then
863 LineHeight:=TokenSize.y;
864 inc(TokenPos.X,TokenSize.x);
865 if UsedWidth<TokenPos.X then
866 UsedWidth:=TokenPos.X;
867 end;
868 // fill end of line
869 if Draw and (TokenPos.X<AHintRect.Right) and (LineHeight>0) then begin
870 Canvas.FillRect(Rect(TokenPos.X,TokenPos.Y-VerticalSpace,
871 AHintRect.Right,TokenPos.Y+LineHeight+VerticalSpace));
872 end;
873
874 if (not Draw) and (UsedWidth>0) then
875 AHintRect.Right:=UsedWidth+RightSpace;
876 AHintRect.Bottom:=TokenPos.Y+LineHeight+VerticalSpace;
877
878 if Draw and (Item.CopyAllButton<>nil) then begin
879 // move button at end of first line
880 y:=ATextRect.Top;
881 if LineHeight>FBtnWidth then
882 inc(y,(LineHeight-FBtnWidth) div 2);
883 Item.NewBounds:=Bounds(AHintRect.Right-RightSpace-1,y,FBtnWidth,FBtnWidth);
884 r:=Item.CopyAllButton.BoundsRect;
885 if not CompareRect(@r,@Item.NewBounds) then
886 IdleConnected:=true;
887 end;
888 //debugln(['DrawHint ',y,' Line="',dbgstr(Line),'" LineHeight=',LineHeight,' ']);
889 end;
890
891 var
892 i: Integer;
893 NewMaxHeight: Integer;
894 NewMaxWidth: Integer;
895 CurHintRect: TRect;
896 Details: TThemedElementDetails;
897 begin
898 //DebugLn('TCodeContextFrm.DrawHints DrawWidth=',dbgs(MaxWidth),' DrawHeight=',dbgs(MaxHeight),' Draw=',dbgs(Draw));
899 if Draw then begin
900 // make colors theme dependent
901 BackgroundColor:=clInfoBk;
902 TextGrayColor:=clInfoText;
903 TextGrayStyle:=[];
904 TextColor:=clInfoText;
905 TextStyle:=[fsBold];
906 PenColor:=clBlack;
907 end;
908 LeftSpace:=2;
909 RightSpace:=2+FBtnWidth;
910 VerticalSpace:=2;
911
912 if Draw then begin
913 Canvas.Brush.Color:=BackgroundColor;
914 Canvas.Font.Color:=TextGrayColor;
915 Canvas.Font.Style:=TextGrayStyle;
916 Canvas.Pen.Color:=PenColor;
917 Details := ThemeServices.GetElementDetails(tttStandardLink);
918 ThemeServices.DrawElement(Canvas.Handle, Details, ClientRect);
919 end else begin
920 Canvas.Font.Style:=[fsBold];
921 end;
922 NewMaxWidth:=0;
923 NewMaxHeight:=0;
924 for i:=0 to FHints.Count-1 do begin
925 if Draw and (NewMaxHeight>=MaxHeight) then break;
926 CurHintRect:=Rect(0,NewMaxHeight,MaxWidth,MaxHeight);
927 DrawHint(i,CurHintRect);
928 if CurHintRect.Right>NewMaxWidth then
929 NewMaxWidth:=CurHintRect.Right;
930 NewMaxHeight:=CurHintRect.Bottom;
931 end;
932 // for fractionals add some space
933 inc(NewMaxWidth,2);
934 inc(NewMaxHeight,2);
935 // add space for the copy all button
936 inc(NewMaxWidth,16);
937
938 if Draw then begin
939 // fill rest of form
940 if NewMaxHeight<MaxHeight then
941 Canvas.FillRect(Rect(0,NewMaxHeight,MaxWidth,MaxHeight));
942 // draw frame around window
943 Canvas.Frame(Rect(0,0,MaxWidth-1,MaxHeight-1));
944 end;
945 if not Draw then begin
946 // adjust max width and height
947 if NewMaxWidth<MaxWidth then
948 MaxWidth:=NewMaxWidth;
949 if NewMaxHeight<MaxHeight then
950 MaxHeight:=NewMaxHeight;
951 end;
952 end;
953
954 procedure TCodeContextFrm.CompleteParameters(DeclCode: string);
955 // add the parameter names in the source editor
956
ReadNextAtomnull957 function ReadNextAtom(ASynEdit: TSynEdit; var TokenLine, TokenEnd: integer;
958 out TokenStart: integer): string;
959 var
960 Line: string;
961 begin
962 while TokenLine<=ASynEdit.Lines.Count do begin
963 Line:=ASynEdit.Lines[TokenLine-1];
964 ReadRawNextPascalAtom(Line,TokenEnd,TokenStart);
965 if TokenStart<TokenEnd then begin
966 Result:=copy(Line,TokenStart,TokenEnd-TokenStart);
967 exit;
968 end;
969 inc(TokenLine);
970 TokenEnd:=1;
971 end;
972 TokenStart:=TokenEnd;
973 Result:='';
974 end;
975
976 procedure AddParameters(ASynEdit: TSynEdit; Y, X: integer;
977 AddComma, AddCLoseBracket: boolean;
978 StartIndex: integer);
979 var
980 NewCode: String;
981 TokenStart: Integer;
982 BracketLevel: Integer;
983 ParameterIndex: Integer;
984 TokenEnd: integer;
985 LastToken: String;
986 Indent: LongInt;
987 XY: TPoint;
988 begin
989 TokenEnd:=1;
990 BracketLevel:=0;
991 ParameterIndex:=-1;
992 NewCode:='';
993 LastToken:='';
994 repeat
995 ReadRawNextPascalAtom(DeclCode,TokenEnd,TokenStart);
996 if TokenEnd=TokenStart then break;
997 case DeclCode[TokenStart] of
998 '(','[':
999 begin
1000 inc(BracketLevel);
1001 if BracketLevel=1 then
1002 ParameterIndex:=0;
1003 end;
1004 ')',']':
1005 begin
1006 dec(BracketLevel);
1007 if BracketLevel=0 then begin
1008 // closing bracket found
1009 break;
1010 end;
1011 end;
1012 ',',':':
1013 if BracketLevel=1 then begin
1014 if (LastToken<>'') and (IsIdentStartChar[LastToken[1]])
1015 and (ParameterIndex>=StartIndex) then begin
1016 // add parameter
1017 if AddComma then
1018 NewCode:=NewCode+',';
1019 NewCode:=NewCode+LastToken;
1020 AddComma:=true;
1021 end;
1022 if DeclCode[TokenStart]=',' then
1023 inc(ParameterIndex);
1024 end;
1025 ';':
1026 if BracketLevel=1 then
1027 inc(ParameterIndex);
1028 else
1029
1030 end;
1031 LastToken:=copy(DeclCode,TokenStart,TokenEnd-TokenStart);
1032 until false;
1033 if NewCode='' then exit;
1034 if AddCLoseBracket then
1035 NewCode+=')';
1036 // format insertion
1037 Indent:=GetLineIndentWithTabs(ASynEdit.Lines[Y-1],X,ASynEdit.TabWidth);
1038 if Y<>FParamListBracketOpenCodeXYPos.Y then
1039 dec(Indent,CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.Indent);
1040 NewCode:=CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
1041 NewCode,Indent,[],X);
1042 delete(NewCode,1,Indent);
1043 if NewCode='' then begin
1044 ShowMessage(lisAllParametersOfThisFunctionAreAlreadySetAtThisCall);
1045 exit;
1046 end;
1047 // insert
1048 ASynEdit.BeginUndoBlock{$IFDEF SynUndoDebugBeginEnd}('TCodeContextFrm.CompleteParameters'){$ENDIF};
1049 try
1050 XY:=Point(X,Y);
1051 ASynEdit.BlockBegin:=XY;
1052 ASynEdit.BlockEnd:=XY;
1053 ASynEdit.LogicalCaretXY:=XY;
1054 ASynEdit.SelText:=NewCode;
1055 finally
1056 ASynEdit.EndUndoBlock{$IFDEF SynUndoDebugBeginEnd}('TCodeContextFrm.CompleteParameters'){$ENDIF};
1057 end;
1058 end;
1059
1060 var
1061 SrcEdit: TSourceEditorInterface;
1062 BracketPos: TPoint;
1063 ASynEdit: TSynEdit;
1064 Line: string;
1065 TokenLine, TokenEnd, TokenStart: LongInt;
1066 LastTokenLine, LastTokenEnd: LongInt;
1067 BracketLevel: Integer;
1068 ParameterIndex: Integer;
1069 Token: String;
1070 LastToken: String;
1071 NeedComma: Boolean;
1072 begin
1073 SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
1074 if (SrcEdit=nil) or (SrcEdit.CodeToolsBuffer<>ProcNameCodeXYPos.Code) then
1075 exit;
1076 BracketPos:=Point(ParamListBracketOpenCodeXYPos.X,
1077 ParamListBracketOpenCodeXYPos.Y);
1078 // find out, if cursor is in procedure call and where
1079 ASynEdit:=SrcEdit.EditorControl as TSynEdit;
1080
1081 Line:=ASynEdit.Lines[BracketPos.Y-1];
1082 if (length(Line)<BracketPos.X) or (not (Line[BracketPos.X] in ['(','[']))
1083 then begin
1084 // bracket lost -> something changed -> hints became invalid
1085 exit;
1086 end;
1087
1088 // parse the code
1089 TokenLine:=BracketPos.Y;
1090 TokenEnd:=BracketPos.X;
1091 //debugln(['TCodeContextFrm.CompleteParameters START BracketPos=',dbgs(BracketPos)]);
1092 TokenStart:=TokenEnd;
1093 BracketLevel:=0;
1094 ParameterIndex:=-1;
1095 Token:='';
1096 repeat
1097 LastTokenLine:=TokenLine;
1098 LastTokenEnd:=TokenEnd;
1099 LastToken:=Token;
1100 Token:=ReadNextAtom(ASynEdit,TokenLine,TokenEnd,TokenStart);
1101 //debugln(['TCodeContextFrm.CompleteParameters Token="',Token,'" ParameterIndex=',ParameterIndex]);
1102 if TokenEnd=TokenStart then break;
1103 case Token[1] of
1104 '(','[':
1105 begin
1106 inc(BracketLevel);
1107 if BracketLevel=1 then
1108 ParameterIndex:=0;
1109 end;
1110 ')',']':
1111 begin
1112 dec(BracketLevel);
1113 if BracketLevel=0 then break;
1114 end;
1115 ',':
1116 if BracketLevel=1 then inc(ParameterIndex);
1117 ';':
1118 break; // missing close bracket => cursor behind procedure call
1119 else
1120 if IsIdentStartChar[Token[1]] then begin
1121 if CompareIdentifiers(PChar(Token),'end')=0 then
1122 break;// missing close bracket => cursor behind procedure call
1123 end;
1124 end;
1125 until false;
1126 NeedComma:=(LastToken<>',') and (LastToken<>'(') and (LastToken<>'[');
1127 if NeedComma then inc(ParameterIndex);
1128 //debugln(['TCodeContextFrm.CompleteParameters BracketLevel=',BracketLevel,' NeedComma=',NeedComma,' ParameterIndex=',ParameterIndex]);
1129 if BracketLevel=0 then begin
1130 // closing bracket found
1131 //debugln(['TCodeContextFrm.CompleteParameters y=',LastTokenLine,' x=',LastTokenEnd,' ParameterIndex=',ParameterIndex]);
1132 AddParameters(ASynEdit,LastTokenLine,LastTokenEnd,NeedComma,false,ParameterIndex);
1133 end else if BracketLevel=1 then begin
1134 // missing closing bracket
1135 AddParameters(ASynEdit,LastTokenLine,LastTokenEnd,NeedComma,true,ParameterIndex);
1136 end;
1137 end;
1138
1139 procedure TCodeContextFrm.ClearHints;
1140 var
1141 i: Integer;
1142 begin
1143 for i:=0 to FHints.Count-1 do
1144 FreeAndNil(Hints[i].CopyAllButton);
1145 for i:=0 to FHints.Count-1 do
1146 TObject(FHints[i]).Free;
1147 FHints.Clear;
1148 end;
1149
1150 procedure TCodeContextFrm.SetIdleConnected(AValue: boolean);
1151 begin
1152 if fDestroying then AValue:=false;
1153 if FIdleConnected=AValue then Exit;
1154 FIdleConnected:=AValue;
1155 if IdleConnected then
1156 Application.AddOnIdleHandler(@ApplicationIdle)
1157 else
1158 Application.RemoveOnIdleHandler(@ApplicationIdle);
1159 end;
1160
1161 procedure TCodeContextFrm.Notification(AComponent: TComponent;
1162 Operation: TOperation);
1163 var
1164 i: Integer;
1165 begin
1166 inherited Notification(AComponent, Operation);
1167 if Operation=opRemove then
1168 begin
1169 if FHints<>nil then
1170 for i:=0 to FHints.Count-1 do
1171 if Hints[i].CopyAllButton=AComponent then
1172 Hints[i].CopyAllButton:=nil;
1173 end;
1174 end;
1175
1176 procedure TCodeContextFrm.Paint;
1177 begin
1178 FormPaint(Self);
1179 end;
1180
1181 constructor TCodeContextFrm.Create(TheOwner: TComponent);
1182 begin
1183 inherited Create(TheOwner);
1184 OnDestroy:=@FormDestroy;
1185 OnKeyDown:=@FormKeyDown;
1186 OnUTF8KeyPress:=@FormUTF8KeyPress;
1187 FormCreate(Self);
1188 end;
1189
1190 destructor TCodeContextFrm.Destroy;
1191 begin
1192 fDestroying:=true;
1193 IdleConnected:=false;
1194 if CodeContextFrm=Self then
1195 CodeContextFrm:=nil;
1196 inherited Destroy;
1197 end;
1198
1199 end.
1200
1201