From 0923410ffcb61483f082fe99a6c75e9731bf7391 Mon Sep 17 00:00:00 2001 From: Basile Burg Date: Tue, 10 Mar 2020 20:11:34 +0100 Subject: [PATCH] calltips, highlight current argument and remove calltips stacking for now --- src/u_dlang.pas | 70 ++++++++++++ src/u_stringrange.pas | 69 ++++++++++++ src/u_synmemo.pas | 257 +++++++++++++++++++++--------------------- 3 files changed, 268 insertions(+), 128 deletions(-) diff --git a/src/u_dlang.pas b/src/u_dlang.pas index 7da40ef8..4751745f 100644 --- a/src/u_dlang.pas +++ b/src/u_dlang.pas @@ -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; diff --git a/src/u_stringrange.pas b/src/u_stringrange.pas index 655e50d3..bd474a95 100644 --- a/src/u_stringrange.pas +++ b/src/u_stringrange.pas @@ -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]; diff --git a/src/u_synmemo.pas b/src/u_synmemo.pas index 52035742..e1551f30 100644 --- a/src/u_synmemo.pas +++ b/src/u_synmemo.pas @@ -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 SPACE. + 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