calltips, highlight current argument

and remove calltips stacking for now

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;

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

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;
+    // like ActivateHint(string) but
-      AData: Pointer): TRect; override;
+    // 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
+var
-  //s: string;
+  s: string;
-  //a: string;
+  a: string;
-  //i: integer = 0;
+  b: string;
-  //x: integer = 0;
+  i: integer = 0;
-  //o: integer = 0;
+  x: integer;
-  //r: TStringRange = (ptr:nil; pos:0; len: 0);
+  y: integer;
-  //f: TFontStyles;
+  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;
+  s := caption;
-  //caption := '';
+  if s.isEmpty then
-  inherited Paint;
+    exit;
-  //if s.isEmpty then
+  u.init(s);
-  //  exit;
+  y := ScaleY(3,96);
-  //f := canvas.Font.Style;
+  while true do
-  //r.init(s);
+  begin
-  //// func decl (TODO skip template params)
+    i := 0;
-  //a := r.takeUntil('(').yield + '(';
+    b := u.nextLine();
-  //o := x;
+    if b.isEmpty then
-  //x += canvas.TextWidth(a);
+      break;
-  //canvas.TextOut(o, 0, a);
+    r.init(b);
-  //r.popFront;
+    canvas.Brush.Color:= color;
-  //// func args
+    x := ScaleX(3,96);
-  //while not r.empty do
+    // result
-  //begin
+    a := r.takeUntil(' ').takeMore(1).yield();
-  //  a := r.takeUntil(',').yield;
+    r.popFront;
-  //  if not r.empty then
+    writePart(a, x);
-  //  begin
+    // name
-  //    r.popFrontN(2);
+    a := r.takeUntil('(').yield();
-  //    a += ', ';
+    writePart(a, x);
-  //  end;
+    // template params
-  //  o := x;
+    t := r.save.popPair(')')^;
-  //  if fIndexOfExpectedArg = i then
+    if not t.empty() and (t.popFront^.front = '(') then
-  //    canvas.Font.Style := canvas.Font.Style + [fsBold]
+    begin
-  //  else
+      a := r.takePair(')').takeMore(1).yield();
-  //    canvas.Font.Style := canvas.Font.Style - [fsBold];
+      r.popFront();
-  //  x += canvas.TextWidth(a);
+      writePart(a, x);
-  //  canvas.TextOut(o, 0, a);
+    end;
-  //  canvas.Font.Style := f;
+    // func args
-  //  i += 1;
+    while not r.empty do
-  //end;
+    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;
+  s: string;
-  i, x: integer;
+  i: integer = 0;
-  j: integer = 0;
+  o: TPoint;
-  n: integer = 0;
+  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);
-
+  fCallTipWin.ActivateDynamicHint(tips);
-  // see procedure THintWindow.ActivateHint(const AHint: String);
-  // caused a regression in call tips stacking
-  fCallTipWin.Caption:= tips;
-
-  fCallTipWin.ActivateHint(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}
+  if not fCallTipWin.Visible then
-  i := integer(pointer(fCallTipStrings.Objects[0]));
+    exit;
-  {$POP}
+  hideCallTips;
-  for i in [0..i-1] do
-    fCallTipStrings.Delete(0);
-  if fCallTipStrings.Count = 0 then
-    hideCallTips
-  else
-    showCallTipsString(fCallTipStrings.Text, 0);
 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