unit atsynedit_form_complete; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LclProc, LclType, ATSynEdit, ATSynEdit_Carets, ATSynEdit_Commands, ATStringProc, ATListbox, Math; type TATCompletionPropEvent = procedure (Sender: TObject; out AText, ASuffix: string; out ACharsLeft, ACharsRight: integer) of object; //AText is #13-separated strings, each string is '|'-separated items. //Usually item_0 is prefix to show, //item_1 is actual text (result of function), //item_2..etc are only to show. //e.g. 'func|Func1|(param1, param2)'+#13+'var|Var1'+#13+'var|Var2' //AChars: how many chars to replace before caret. procedure DoEditorCompletionListbox(AEd: TATSynEdit; AOnGetProp: TATCompletionPropEvent); procedure EditorGetCurrentWord(Ed: TATSynEdit; const AWordChars: atString; out AWord: atString; out ACharsLeft, ACharsRight: integer); type { TFormATSynEditComplete } TFormATSynEditComplete = class(TForm) List: TATListbox; procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCreate(Sender: TObject); procedure FormDeactivate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormShow(Sender: TObject); procedure FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char); procedure ListClick(Sender: TObject); procedure ListDrawItem(Sender: TObject; C: TCanvas; AIndex: integer; const ARect: TRect); private { private declarations } SList: TStringlist; FOnGetProp: TATCompletionPropEvent; FEdit: TATSynEdit; FCharsLeft, FCharsRight: integer; FSuffix: string; FHintWnd: THintWindow; procedure DoHintHide; procedure DoHintShow(const AHint: string); procedure DoReplaceTo(const Str: string); procedure DoResult; procedure DoUpdate; function GetItemText(S: string; AIndex: integer): string; function GetResultText: string; public { public declarations } property Editor: TATSynEdit read FEdit write FEdit; property OnGetProp: TATCompletionPropEvent read FOnGetProp write FOnGetProp; end; const cCompleteItemCount = 5; var cCompleteColorFont: array[0..cCompleteItemCount-1] of TColor = (clPurple, clBlack, clNavy, clBlack, clBlack); cCompleteFontStyles: array[0..cCompleteItemCount-1] of TFontStyles = ([fsBold], [], [], [], []); cCompleteColorBg: TColor = $e0e0e0; cCompleteColorSelBg: TColor = clMedGray; cCompleteIndexOfText: integer = 1; cCompleteIndexOfDesc: integer = 2; cCompleteSepChar: char = '|'; cCompleteHintChar: char = #9; cCompleteListSort: boolean = false; cCompleteKeyUpDownWrap: boolean = true; cCompleteInsertAlsoBracket: boolean = true; cCompleteFontName: string = 'default'; cCompleteFontSize: integer = 10; cCompleteItemHeight: integer = 17; cCompleteBorderSize: integer = 4; cCompleteFormSizeX: integer = 500; cCompleteFormSizeY: integer = 200; cCompleteHintSizeX: integer = 400; cCompleteTextIndent0: integer = 4; cCompleteTextIndent: integer = 8; implementation {$R *.lfm} var FormComplete: TFormATSynEditComplete = nil; procedure DoEditorCompletionListbox(AEd: TATSynEdit; AOnGetProp: TATCompletionPropEvent); begin if AEd.ModeReadOnly then exit; if AEd.Carets.Count<>1 then exit; if FormComplete=nil then FormComplete:= TFormATSynEditComplete.Create(nil); FormComplete.Editor:= AEd; FormComplete.OnGetProp:= AOnGetProp; FormComplete.DoUpdate; end; procedure TFormATSynEditComplete.DoReplaceTo(const Str: string); var Caret: TATCaretItem; Pos, Shift, PosAfter: TPoint; begin if Str<>'' then begin Caret:= Editor.Carets[0]; Pos.X:= Caret.PosX; Pos.Y:= Caret.PosY; FCharsLeft:= Min(Pos.X, FCharsLeft); Dec(Pos.X, FCharsLeft); Editor.Strings.TextDeleteRight(Pos.X, Pos.Y, FCharsLeft+FCharsRight, Shift, PosAfter, false); Editor.Strings.TextInsert(Pos.X, Pos.Y, Utf8Decode(Str), false, Shift, PosAfter); Caret.PosX:= Pos.X+Length(Utf8Decode(Str)); Caret.EndX:= -1; Caret.EndY:= -1; Editor.Update(true); Editor.DoEventChange; end; end; { TFormATSynEditComplete } procedure TFormATSynEditComplete.FormCreate(Sender: TObject); begin SList:= TStringList.Create; FHintWnd:= THintWindow.Create(Self); end; procedure TFormATSynEditComplete.FormDeactivate(Sender: TObject); begin Close; end; procedure TFormATSynEditComplete.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin DoHintHide; if Assigned(FEdit) then FEdit.OptCaretStopUnfocused:= true; CloseAction:= caHide; end; procedure TFormATSynEditComplete.FormDestroy(Sender: TObject); begin SList.Free; end; procedure TFormATSynEditComplete.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if (key=vk_up) and (shift=[]) then begin if List.ItemIndex>0 then List.ItemIndex:= List.ItemIndex-1 else if cCompleteKeyUpDownWrap then List.ItemIndex:= List.ItemCount-1; key:= 0; exit end; if (key=vk_down) and (shift=[]) then begin if List.ItemIndex=0 then begin SText:= GetItemText(SList[List.ItemIndex], cCompleteIndexOfText); SDesc:= GetItemText(SList[List.ItemIndex], cCompleteIndexOfDesc); Result:= SText; if FSuffix<>'' then Result:= Result+FSuffix else if cCompleteInsertAlsoBracket then if SBeginsWith(SDesc, '(') then Result:= Result+'('; end; end; procedure TFormATSynEditComplete.ListDrawItem(Sender: TObject; C: TCanvas; AIndex: integer; const ARect: TRect); var Str, SItem, SHint: string; NSize, i: integer; begin Str:= SList[AIndex]; SHint:= SGetItemAtEnd(Str, cCompleteHintChar); if AIndex=List.ItemIndex then DoHintShow(SHint); if AIndex=List.ItemIndex then C.Brush.Color:= cCompleteColorSelBg else C.Brush.Color:= cCompleteColorBg; C.FillRect(ARect); C.Font.Assign(List.Font); NSize:= cCompleteTextIndent0; for i:= 0 to cCompleteItemCount-1 do begin SItem:= SGetItem(Str, cCompleteSepChar); C.Font.Style:= cCompleteFontStyles[i]; C.Font.Color:= cCompleteColorFont[i]; C.TextOut(ARect.Left+NSize, ARect.Top, SItem); Inc(NSize, C.TextWidth(SItem)+cCompleteTextIndent); end; end; procedure TFormATSynEditComplete.DoResult; begin DoReplaceTo(GetResultText); Close; end; procedure TFormATSynEditComplete.DoUpdate; var AText: string; P: TPoint; begin if Assigned(FOnGetProp) then FOnGetProp(Editor, AText, FSuffix, FCharsLeft, FCharsRight); if (AText='') then begin Close; exit end; SList.Text:= AText; if SList.Count=0 then exit; if cCompleteListSort then SList.Sort; List.ItemCount:= SList.Count; List.ItemIndex:= 0; Color:= cCompleteColorBg; List.Color:= cCompleteColorBg; List.Font.Name:= cCompleteFontName; List.Font.Size:= cCompleteFontSize; List.ItemHeight:= cCompleteItemHeight; List.BorderSpacing.Around:= cCompleteBorderSize; List.Invalidate; P.X:= Editor.Carets[0].CoordX-Editor.TextCharSize.X*FCharsLeft; P.Y:= Editor.Carets[0].CoordY+Editor.TextCharSize.Y; P:= Editor.ClientToScreen(P); SetBounds(P.X, P.Y, cCompleteFormSizeX, cCompleteFormSizeY); Show; end; procedure EditorGetCurrentWord(Ed: TATSynEdit; const AWordChars: atString; out AWord: atString; out ACharsLeft, ACharsRight: integer); var str: atString; n: integer; begin AWord:= ''; ACharsLeft:= 0; ACharsRight:= 0; str:= Ed.Strings.Lines[Ed.Carets[0].PosY]; n:= Ed.Carets[0].PosX; if (n>Length(str)) then exit; while (n>0) and (IsCharWord(str[n], AWordChars)) do begin AWord:= str[n]+AWord; Dec(n); Inc(ACharsLeft); end; n:= Ed.Carets[0].PosX; while (n