calltips, highlight current argument

and remove calltips stacking for now
This commit is contained in:
Basile Burg 2020-03-10 20:11:34 +01:00
parent d250e6b52a
commit 0923410ffc
3 changed files with 268 additions and 128 deletions

View File

@ -159,6 +159,17 @@ function getIndexOfTokenLeftTo(tokens: TLexTokenList; caretPos: TPoint): integer
*)
function getExpressionAt(tokens: TLexTokenList; caretPos: TPoint): string;
(**
* Returns the position of the opening paren of a CallExp
*)
function getCallExpLeftParenLoc(tokens: TLexTokenList; caretPos: TPoint): TPoint;
(**
* Returns the index of the parameter located at caretPos.
*)
function getCurrentParameterIndex(tokens: TLexTokenList; caretPos: TPoint): integer;
implementation
{$REGION TReaderHead -----------------------------------------------------------}
@ -1055,6 +1066,65 @@ begin
end;
end;
function getCallExpLeftParenLoc(tokens: TLexTokenList; caretPos: TPoint): TPoint;
var
t: PLexToken;
i: integer;
p: integer = 0;
s: integer = 0;
begin
result := Point(0,0);
i := getIndexOfTokenAt(tokens, caretPos) + 1;
while i > 0 do
begin
i -= 1;
t := tokens[i];
if t^.kind <> TLexTokenKind.ltkSymbol then
continue;
p += byte(t^.Data = ')');
p -= byte(t^.Data = '(');
if p = -1 then
begin
result := t^.position;
result.x += 2;
break;
end;
end;
end;
function getCurrentParameterIndex(tokens: TLexTokenList; caretPos: TPoint): integer;
var
t: PLexToken;
i: integer;
p: integer = 0;
s: integer = 0;
begin
result := -1;
i := getIndexOfTokenAt(tokens, caretPos) + 1;
while i > 0 do
begin
// skip nested ParenExp
i -= 1;
t := tokens[i];
if t^.kind <> TLexTokenKind.ltkSymbol then
continue;
p += byte(t^.Data = ')');
p -= byte(t^.Data = '(');
if p = -1 then
begin
result += 1;
break;
end;
if p > 0 then
continue;
// detect IndexExp, SliceExp, etc.
s += byte(t^.Data = ']');
s -= byte(t^.Data = '[');
// add a param if not in opIndex, opSlice, ParenExp
result += Byte((t^.Data = ',') and (s = 0) and (p = 0));
end;
end;
function getExpressionAt(tokens: TLexTokenList; caretPos: TPoint): string;
var
ri: integer;

View File

@ -51,6 +51,9 @@ type
// indicates wether the range is consumed.
function empty: boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
// when {$DEBUG} is defined this helper assign yield to a local, which can then be inspected
function debug(): PStringRange; {$IFNDEF DEBUG}inline;{$ENDIF}
// yields the state of the range to a string.
function yield: string; {$IFNDEF DEBUG}inline;{$ENDIF}
// returns a copy.
@ -59,6 +62,8 @@ type
function reset: PStringRange; {$IFNDEF DEBUG}inline;{$ENDIF}
// continue taking for N steps, i.e following any of the "take" family of functions
function takeMore(value: integer): TStringRange; overload; {$IFNDEF DEBUG}inline;{$ENDIF}
// advances the range while the front is in value, returns a copy.
function takeWhile(value: TSysCharSet): TStringRange; overload; {$IFNDEF DEBUG}inline;{$ENDIF}
// advances the range while the front is equal to value, returns a copy.
@ -67,6 +72,8 @@ type
function takeUntil(value: TSysCharSet): TStringRange; overload; {$IFNDEF DEBUG}inline;{$ENDIF}
// advances the range until the front is equal to value, returns a copy.
function takeUntil(value: Char): TStringRange; overload; {$IFNDEF DEBUG}inline;{$ENDIF}
// advances the range until the count of pair defined by the front() and closer is equal to 0, returns a copy.
function takePair(const closer: Char): TStringRange; {$IFNDEF DEBUG}inline;{$ENDIF}
// advances the range while the front is in value.
function popWhile(value: TSysCharSet): PStringRange; overload; {$IFNDEF DEBUG}inline;{$ENDIF}
// advances the range while the front is equal to value.
@ -75,6 +82,8 @@ type
function popUntil(value: TSysCharSet): PStringRange; overload; {$IFNDEF DEBUG}inline;{$ENDIF}
// advances the range until the front is equal to value.
function popUntil(value: Char): PStringRange; overload; {$IFNDEF DEBUG}inline;{$ENDIF}
// advances the range until the count of pair defined by the front() and closer is equal to 0.
function popPair(const closer: Char): PStringRange; {$IFNDEF DEBUG}inline;{$ENDIF}
// advances the range until the beginning of the next line.
function popLine: PStringRange; {$IFNDEF DEBUG}inline;{$ENDIF}
@ -170,6 +179,18 @@ begin
result := pos >= len;
end;
function TStringRange.debug(): PStringRange;
{$IFDEF DEBUG}
var
s: string;
{$ENDIF}
begin
result := @self;
{$IFDEF DEBUG}
s:= yield();
{$ENDIF}
end;
function TStringRange.yield: string;
begin
Result := ptr[pos .. len-1];
@ -188,6 +209,13 @@ begin
Result := @Self;
end;
function TStringRange.takeMore(value: integer): TStringRange;
begin
Result.ptr := ptr;
Result.pos := pos;
Result.len := len + value;
end;
function TStringRange.takeWhile(value: TSysCharSet): TStringRange;
begin
Result.ptr := ptr + pos;
@ -244,6 +272,28 @@ begin
end;
end;
function TStringRange.takePair(const closer: Char): TStringRange;
var
opener: char;
c: integer = 0;
begin
Result.ptr := ptr + pos;
Result.pos := 0;
Result.len := 0;
opener := front();
while true do
begin
if empty() then
break;
c += Byte(front() = opener);
c -= Byte(front() = closer);
if c = 0 then
break;
Result.len += 1;
popFront();
end;
end;
function TStringRange.popWhile(value: TSysCharSet): PStringRange;
begin
while true do
@ -296,6 +346,25 @@ begin
Result := @self;
end;
function TStringRange.popPair(const closer: Char): PStringRange;
var
opener: char;
c: integer = 0;
begin
result := @self;
opener := front();
while true do
begin
if result^.empty() then
break;
c += Byte(result^.front() = opener);
c -= Byte(result^.front() = closer );
if c = 0 then
break;
result := result^.popFront();
end;
end;
function TStringRange.nextWord: string;
const
blk = [#0 .. #32];

View File

@ -62,13 +62,17 @@ type
AData: Pointer): TRect; override;
end;
// Specialized to allow displaying call tips, actual param in bold
// Specialized to allow displaying call tips
TEditorCallTipWindow = class(TEditorHintWindow)
strict private
fIndexOfExpectedArg: integer;
fActivating: boolean;
public
function CalcHintRect(MaxWidth: Integer; const AHint: string;
AData: Pointer): TRect; override;
// like ActivateHint(string) but
// prevent overzealous opimizations that prevent flickering
// that become a problem when the hint string is dynamic.
procedure ActivateDynamicHint(const AHint: String);
function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override;
procedure Paint; override;
property indexOfExpectedArg: integer write fIndexOfExpectedArg;
end;
@ -221,7 +225,6 @@ type
fMatchSelectionOpts: TSynSearchOptions;
fMatchIdentOpts: TSynSearchOptions;
fMatchOpts: TIdentifierMatchOptions;
fCallTipStrings: TStringList;
fOverrideColMode: boolean;
fAutoCloseCurlyBrace: TBraceAutoCloseStyle;
fSmartDdocNewline: boolean;
@ -502,6 +505,7 @@ const
' (mixin) '
);
{$REGION TEditorCallTipWindow --------------------------------------------------}
function TEditorHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: String; AData: Pointer): TRect;
begin
Font.Size:= FontSize;
@ -510,54 +514,96 @@ end;
function TEditorCallTipWindow.CalcHintRect(MaxWidth: Integer; const AHint: String; AData: Pointer): TRect;
begin
//Font.Style := Font.Style + [fsBold];
Font.Size:= FontSize;
result := inherited CalcHintRect(MaxWidth, AHint, AData);
//Font.Style := Font.Style - [fsBold];
end;
procedure TEditorCallTipWindow.ActivateDynamicHint(const AHint: String);
begin
if fActivating then
exit;
fActivating := True;
try
Caption := AHint;
Invalidate;
ActivateSub;
finally
fActivating := False;
end
end;
procedure TEditorCallTipWindow.Paint;
//var
//s: string;
//a: string;
//i: integer = 0;
//x: integer = 0;
//o: integer = 0;
//r: TStringRange = (ptr:nil; pos:0; len: 0);
//f: TFontStyles;
var
s: string;
a: string;
b: string;
i: integer = 0;
x: integer;
y: integer;
r: TStringRange = (ptr:nil; pos:0; len: 0);
t: TStringRange;
u: TStringRange;
j: integer = 0;
procedure writePart(const part: string; var x: integer);
begin
canvas.TextOut(x, y, part);
x += canvas.TextWidth(part);
end;
begin
//s := caption;
//caption := '';
inherited Paint;
//if s.isEmpty then
// exit;
//f := canvas.Font.Style;
//r.init(s);
//// func decl (TODO skip template params)
//a := r.takeUntil('(').yield + '(';
//o := x;
//x += canvas.TextWidth(a);
//canvas.TextOut(o, 0, a);
//r.popFront;
//// func args
//while not r.empty do
//begin
// a := r.takeUntil(',').yield;
// if not r.empty then
// begin
// r.popFrontN(2);
// a += ', ';
// end;
// o := x;
// if fIndexOfExpectedArg = i then
// canvas.Font.Style := canvas.Font.Style + [fsBold]
// else
// canvas.Font.Style := canvas.Font.Style - [fsBold];
// x += canvas.TextWidth(a);
// canvas.TextOut(o, 0, a);
// canvas.Font.Style := f;
// i += 1;
//end;
s := caption;
if s.isEmpty then
exit;
u.init(s);
y := ScaleY(3,96);
while true do
begin
i := 0;
b := u.nextLine();
if b.isEmpty then
break;
r.init(b);
canvas.Brush.Color:= color;
x := ScaleX(3,96);
// result
a := r.takeUntil(' ').takeMore(1).yield();
r.popFront;
writePart(a, x);
// name
a := r.takeUntil('(').yield();
writePart(a, x);
// template params
t := r.save.popPair(')')^;
if not t.empty() and (t.popFront^.front = '(') then
begin
a := r.takePair(')').takeMore(1).yield();
r.popFront();
writePart(a, x);
end;
// func args
while not r.empty do
begin
a := r.takeUntil([',', ')']).yield;
if not r.empty then
begin
if r.front = ',' then
a += ', '
else
a += ')';
r.popFrontN(2);
end;
if fIndexOfExpectedArg = i then
canvas.Brush.Color:= clHighlight
else
canvas.Brush.Color:= color;
writePart(a, x);
i += 1;
end;
y += Font.Size + ScaleY(9,96);
end;
end;
{$ENDREGION}
{$REGION TSortDialog -----------------------------------------------------------}
constructor TSortDialog.construct(editor: TDexedMemo);
@ -1072,7 +1118,6 @@ begin
fCompletion.ShortCut:=0;
fCompletion.LinesInWindow:=15;
fCompletion.Width:= 250;
fCallTipStrings:= TStringList.Create;
MouseLinkColor.Style:= [fsUnderline];
with MouseActions.Add do begin
@ -1178,7 +1223,6 @@ begin
fMultiDocSubject.Free;
fPositions.Free;
fCompletion.Free;
fCallTipStrings.Free;
fLexToks.Clear;
fLexToks.Free;
fSortDialog.Free;
@ -2648,6 +2692,7 @@ begin
fCallTipWin := TEditorCallTipWindow.Create(self);
fCallTipWin.Color := clInfoBk + $01010100;
fCallTipWin.Font.Color:= clInfoText;
fCallTipWin.AutoHide:=false;
end;
if fDDocWin.isNil then
begin
@ -2659,73 +2704,32 @@ end;
procedure TDexedMemo.showCallTips(findOpenParen: boolean = true);
var
str, lne: string;
i, x: integer;
j: integer = 0;
n: integer = 0;
s: string;
i: integer = 0;
o: TPoint;
p: TPoint;
begin
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
if not fCallTipWin.Visible then
fCallTipStrings.Clear;
str := LineText[1..CaretX];
x := CaretX;
i := min(x, str.length);
if findOpenParen then
while true do
begin
if i = 1 then
break;
if str[i] = ',' then
j += 1;
if str[i] = ')' then
n += 1;
if str[i-1] = '(' then
begin
if n = 0 then
begin
LogicalCaretXY := Point(i, CaretY);
break;
end
else n -= 1;
end;
if str[i] = #9 then
i -= TabWidth
else
i -= 1;
if i <= 0 then
break;
end;
if i > 0 then
begin
DcdWrapper.getCallTip(str);
i := fCallTipStrings.Count;
if (fCallTipStrings.Count <> 0) and str.isNotEmpty then
fCallTipStrings.Insert(0, '---');
fCallTipStrings.Insert(0, str);
i := fCallTipStrings.Count - i;
// overload count to delete on ')'
{$PUSH}{$HINTS OFF}{$WARNINGS OFF}
fCallTipStrings.Objects[0] := TObject(pointer(i));
{$POP}
str := '';
for lne in fCallTipStrings do
if lne.isNotEmpty then
str += lne + LineEnding;
if str.isNotEmpty then
begin
{$IFDEF WINDOWS}
str := str[1..str.length-2];
{$ELSE}
str := str[1..str.length-1];
{$ENDIF}
showCallTipsString(str, j);
end;
end;
o := CaretXY;
if findOpenParen then
CaretX:=x;
begin
lexWholeText([lxoNoWhites, lxoNoComments]);
i := getCurrentParameterIndex(fLexToks, CaretXY);
p := getCallExpLeftParenLoc(fLexToks, CaretXY);
// otherwise strange behavior of <kbd>SPACE</kbd>.
BeginUpdate();
CaretXY := p;
end;
DcdWrapper.getCallTip(s);
if s.isNotEmpty then
showCallTipsString(s, i);
if findOpenParen then
begin
CaretXY := o;
EndUpdate();
end;
end;
procedure TDexedMemo.showCallTipsString(const tips: string; indexOfExpected: integer);
@ -2740,35 +2744,21 @@ begin
fCallTipWin.FontSize := Font.Size;
fCallTipWin.HintRect := fCallTipWin.CalcHintRect(0, tips, nil);
fCallTipWin.OffsetHintRect(pnt, Font.Size * 2);
// see procedure THintWindow.ActivateHint(const AHint: String);
// caused a regression in call tips stacking
fCallTipWin.Caption:= tips;
fCallTipWin.ActivateHint(tips);
fCallTipWin.ActivateDynamicHint(tips);
end;
procedure TDexedMemo.hideCallTips;
begin
if not fCallTipWin.Visible then
exit;
fCallTipStrings.Clear;
fCallTipWin.Hide;
end;
procedure TDexedMemo.decCallTipsLvl;
var
i: integer;
begin
{$PUSH}{$HINTS OFF}{$WARNINGS OFF}
i := integer(pointer(fCallTipStrings.Objects[0]));
{$POP}
for i in [0..i-1] do
fCallTipStrings.Delete(0);
if fCallTipStrings.Count = 0 then
hideCallTips
else
showCallTipsString(fCallTipStrings.Text, 0);
if not fCallTipWin.Visible then
exit;
hideCallTips;
end;
procedure TDexedMemo.showDDocs;
@ -3633,6 +3623,8 @@ begin
fCompletion.Execute(GetWordAtRowCol(LogicalCaretXY),
ClientToScreen(point(CaretXPix, CaretYPix + LineHeight)));
end;
if (Key = VK_BACK) and fCallTipWin.Visible then
showCallTips(true);
end;
procedure TDexedMemo.UTF8KeyPress(var Key: TUTF8Char);
@ -3656,6 +3648,15 @@ begin
inherited;
if fCallTipWin.Visible then
begin
//fCallTipStrings.clear;
//lexWholeText([lxoNoComments, lxoNoWhites]);
//i := getCurrentParameterIndex(fLexToks, CaretXY);
//showCallTipsString(fCallTipStrings.Text, i);
showCallTips(true);
end;
fCanDscan := true;
case c of
#39: if autoCloseSingleQuote in fAutoClosedPairs then