PageRenderTime 57ms CodeModel.GetById 35ms app.highlight 11ms RepoModel.GetById 2ms app.codeStats 1ms

/components/synedit/syncompletion.pas

http://github.com/graemeg/lazarus
Pascal | 2208 lines | 1873 code | 221 blank | 114 comment | 162 complexity | 4e0120753942f18b325a29adde58d57b MD5 | raw file

Large files files are truncated, but you can click here to view the full file

   1{-------------------------------------------------------------------------------
   2The contents of this file are subject to the Mozilla Public License
   3Version 1.1 (the "License"); you may not use this file except in compliance
   4with the License. You may obtain a copy of the License at
   5http://www.mozilla.org/MPL/
   6
   7Software distributed under the License is distributed on an "AS IS" basis,
   8WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
   9the specific language governing rights and limitations under the License.
  10
  11The Original Code is: SynCompletionProposal.pas, released 2000-04-11.
  12The Original Code is based on mwCompletionProposal.pas by Cyrille de Brebisson,
  13part of the mwEdit component suite.
  14Portions created by Cyrille de Brebisson are Copyright (C) 1999
  15Cyrille de Brebisson. All Rights Reserved.
  16
  17Contributors to the SynEdit and mwEdit projects are listed in the
  18Contributors.txt file.
  19
  20Alternatively, the contents of this file may be used under the terms of the
  21GNU General Public License Version 2 or later (the "GPL"), in which case
  22the provisions of the GPL are applicable instead of those above.
  23If you wish to allow use of your version of this file only under the terms
  24of the GPL and not to allow others to use your version of this file
  25under the MPL, indicate your decision by deleting the provisions above and
  26replace them with the notice and other provisions required by the GPL.
  27If you do not delete the provisions above, a recipient may use your version
  28of this file under either the MPL or the GPL.
  29
  30$Id$
  31
  32You may retrieve the latest version of this file at the SynEdit home page,
  33located at http://SynEdit.SourceForge.net
  34
  35Known Issues:
  36-------------------------------------------------------------------------------}
  37
  38unit SynCompletion;
  39
  40{$I SynEdit.inc}
  41
  42{$DEFINE HintClickWorkaround} // Workaround for issue 21952
  43
  44interface
  45
  46uses
  47  LCLProc, LCLIntf, LCLType, LazUTF8, LMessages, Classes, Graphics, Forms,
  48  Controls, StdCtrls, ExtCtrls, Menus, SysUtils, types,
  49  SynEditMiscProcs, SynEditKeyCmds, SynEdit, SynEditTypes, SynEditPlugins
  50  {$IF FPC_FULLVERSION >= 20701}, character{$ENDIF};
  51
  52type
  53  TSynBaseCompletionPaintItem =
  54    function(const AKey: string; ACanvas: TCanvas;
  55             X, Y: integer; Selected: boolean; Index: integer
  56            ): boolean of object;
  57  TSynBaseCompletionMeasureItem =
  58    function(const AKey: string; ACanvas: TCanvas;
  59      Selected: boolean; Index: integer): TPoint of object;
  60  TCodeCompletionEvent = procedure(var Value: string;
  61                                   SourceValue: string;
  62                                   var SourceStart, SourceEnd: TPoint;
  63                                   KeyChar: TUTF8Char;
  64                                   Shift: TShiftState) of object;
  65  TValidateEvent = procedure(Sender: TObject;
  66                             KeyChar: TUTF8Char;
  67                             Shift: TShiftState) of object;
  68  TSynBaseCompletionSearchPosition = procedure(var APosition :integer) of object;
  69  
  70  TSynBaseCompletionForm = class;
  71  
  72  { TSynBaseCompletionHint }
  73
  74  TSynBaseCompletionHint = class(THintWindow)
  75  private
  76    FCompletionForm: TSynBaseCompletionForm;
  77    FIndex: Integer;
  78  public
  79    constructor Create(AOwner: TComponent); override;
  80    function CalcHintRect(MaxWidth: Integer; const AHint: string;
  81                          AData: pointer): TRect; override;
  82    procedure Paint; override;
  83    property Index: Integer read FIndex write FIndex;
  84  end;
  85
  86
  87  TSynCompletionLongHintType = (sclpNone,
  88                                sclpExtendRightOnly,
  89                                sclpExtendHalfLeft,
  90                                sclpExtendUnlimitedLeft
  91                               );
  92
  93  { TSynBaseCompletionFormSizeDrag }
  94
  95  TSynBaseCompletionFormSizeDrag = class(TPanel)
  96  private
  97    FMouseDownPos, FMouseLastPos, FWinSize: TPoint;
  98  protected
  99    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
 100    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
 101    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
 102  public
 103    constructor Create(TheOwner: TComponent); override;
 104    procedure Paint; override;
 105  end;
 106
 107  { TSynBaseCompletionForm }
 108
 109  TSynBaseCompletionForm = class(TForm)
 110    procedure SDKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
 111    procedure SDKeyPress(Sender: TObject; var Key: char);
 112    procedure SDUtf8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
 113  protected
 114    FCurrentString: string;
 115    FOnKeyPress: TKeyPressEvent;
 116    FOnKeyDelete: TNotifyEvent;
 117    FOnPaintItem: TSynBaseCompletionPaintItem;
 118    FItemList: TStrings;
 119    FPosition: Integer;
 120    FNbLinesInWindow: Integer;
 121    FFontHeight: integer;
 122    FResizeLock: Integer;
 123    Scroll: TScrollBar;
 124    SizeDrag: TSynBaseCompletionFormSizeDrag;
 125    FOnValidate: TValidateEvent;
 126    FOnCancel: TNotifyEvent;
 127    FClSelect: TColor;
 128    FCaseSensitive: boolean;
 129    FBackgroundColor: TColor;
 130    FDrawBorderColor: TColor;
 131    FOnSearchPosition: TSynBaseCompletionSearchPosition;
 132    FOnKeyCompletePrefix: TNotifyEvent;
 133    FOnKeyNextChar: TNotifyEvent;
 134    FOnKeyPrevChar: TNotifyEvent;
 135    FTextColor: TColor;
 136    FTextSelectedColor: TColor;
 137    FHint: TSynBaseCompletionHint;
 138    FHintTimer: TTimer;
 139    FLongLineHintTime: Integer;
 140    FLongLineHintType: TSynCompletionLongHintType;
 141    FMouseWheelAccumulator: Integer;
 142    procedure DoEditorKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
 143    procedure DoEditorKeyPress(Sender: TObject; var Key: char);
 144    procedure DoEditorUtf8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
 145    procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
 146    procedure SetCurrentString(const Value: string);
 147    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
 148    procedure KeyPress(var Key: char); override;
 149    procedure AddCharAtCursor(AUtf8Char: TUTF8Char); virtual;
 150    procedure DeleteCharBeforeCursor; virtual;
 151    procedure Paint; override;
 152    procedure AppDeactivated(Sender: TObject); // Because Form.Deactivate isn't called
 153    procedure Deactivate; override;
 154    procedure SelectPrec;
 155    procedure SelectNext;
 156    procedure ScrollChange(Sender: TObject);
 157    procedure ScrollGetFocus(Sender: TObject);
 158    procedure ScrollScroll(Sender: TObject; ScrollCode: TScrollCode;
 159      var ScrollPos: Integer);
 160    procedure SetItemList(const Value: TStrings);
 161    procedure SetPosition(const Value: Integer);
 162    procedure SetNbLinesInWindow(const Value: Integer);
 163    {$IFDEF HintClickWorkaround}
 164    procedure HintWindowMouseDown(Sender: TObject; Button: TMouseButton;
 165      Shift: TShiftState; X, Y: Integer);
 166    {$ENDIF}
 167    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
 168      X, Y: Integer); override;
 169    procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
 170    procedure StringListChange(Sender: TObject);
 171    procedure DoOnResize; override;
 172    procedure SetBackgroundColor(const AValue: TColor);
 173    procedure FontChanged(Sender: TObject); override;
 174    procedure WMMouseWheel(var Msg: TLMMouseEvent); message LM_MOUSEWHEEL;
 175  private
 176    FCurrentEditor: TCustomSynEdit; // Must only be set via TSynCompletion.SetEditor
 177    FDoubleClickSelects: Boolean;
 178    FDrawBorderWidth: Integer;
 179    FOnDragResized: TNotifyEvent;
 180    FOnMeasureItem: TSynBaseCompletionMeasureItem;
 181    FOnPositionChanged: TNotifyEvent;
 182    FShowSizeDrag: Boolean;
 183    FHintLock: Integer;
 184    procedure SetCurrentEditor(const AValue: TCustomSynEdit);
 185    procedure SetDrawBorderWidth(const AValue: Integer);
 186    procedure SetLongLineHintTime(const AValue: Integer);
 187    procedure EditorStatusChanged(Sender: TObject; Changes: TSynStatusChanges);
 188    procedure SetShowSizeDrag(const AValue: Boolean);
 189  protected
 190    procedure RegisterHandlers(EditOnly: Boolean = False);
 191    procedure UnRegisterHandlers(EditOnly: Boolean = False);
 192    procedure SetVisible(Value: Boolean); override;
 193    procedure IncHintLock;
 194    procedure DecHintLock;
 195    procedure DoOnDragResize(Sender: TObject);
 196  public
 197    constructor Create(AOwner: Tcomponent); override;
 198    destructor Destroy; override;
 199    function Focused: Boolean; override;
 200    procedure ShowItemHint(AIndex: Integer);
 201    procedure OnHintTimer(Sender: TObject);
 202    // Must only be set via TSynCompletion.SetEditor
 203    property CurrentEditor: TCustomSynEdit read FCurrentEditor;
 204  published
 205    property CurrentString: string read FCurrentString write SetCurrentString;
 206    property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
 207    property OnKeyDelete: TNotifyEvent read FOnKeyDelete write FOnKeyDelete;
 208    property OnPaintItem: TSynBaseCompletionPaintItem read FOnPaintItem
 209      write FOnPaintItem;
 210    property OnMeasureItem: TSynBaseCompletionMeasureItem read FOnMeasureItem
 211      write FOnMeasureItem;
 212    property OnValidate: TValidateEvent read FOnValidate write FOnValidate;
 213    property OnCancel: TNotifyEvent read FOnCancel write FOnCancel;
 214    property ItemList: TStrings read FItemList write SetItemList;
 215    property Position: Integer read FPosition write SetPosition;
 216    property NbLinesInWindow: Integer read FNbLinesInWindow
 217      write SetNbLinesInWindow;
 218    property ClSelect: TColor read FClSelect write FClSelect;
 219    property CaseSensitive: boolean read FCaseSensitive write FCaseSensitive;
 220    property FontHeight:integer read FFontHeight;
 221    property OnSearchPosition:TSynBaseCompletionSearchPosition
 222      read FOnSearchPosition write FOnSearchPosition;
 223    property OnKeyCompletePrefix: TNotifyEvent read FOnKeyCompletePrefix write FOnKeyCompletePrefix;// e.g. Tab
 224    property OnKeyNextChar: TNotifyEvent read FOnKeyNextChar write FOnKeyNextChar;// e.g. arrow right
 225    property OnKeyPrevChar: TNotifyEvent read FOnKeyPrevChar write FOnKeyPrevChar;// e.g. arrow left
 226    property OnPositionChanged: TNotifyEvent read FOnPositionChanged write FOnPositionChanged;
 227    property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor;
 228    property DrawBorderColor: TColor read FDrawBorderColor write FDrawBorderColor;
 229    property DrawBorderWidth: Integer read FDrawBorderWidth write SetDrawBorderWidth;
 230    property TextColor: TColor read FTextColor write FTextColor;
 231    property TextSelectedColor: TColor
 232      read FTextSelectedColor write FTextSelectedColor;
 233    property LongLineHintTime: Integer read FLongLineHintTime
 234             write SetLongLineHintTime default 0;
 235    property LongLineHintType: TSynCompletionLongHintType read FLongLineHintType
 236             write FLongLineHintType default sclpExtendRightOnly;
 237    property DoubleClickSelects: Boolean read FDoubleClickSelects write FDoubleClickSelects default True;
 238    property ShowSizeDrag: Boolean read FShowSizeDrag write SetShowSizeDrag default False;
 239    property OnDragResized: TNotifyEvent read FOnDragResized write FOnDragResized;
 240  end;
 241
 242  TSynBaseCompletionFormClass = class of TSynBaseCompletionForm;
 243
 244  { TSynCompletionForm }
 245
 246  TSynCompletionForm = class(TSynBaseCompletionForm)
 247  protected
 248    procedure AddCharAtCursor(AUtf8Char: TUTF8Char); override;
 249    procedure DeleteCharBeforeCursor; override;
 250  end;
 251
 252  { TSynBaseCompletion }
 253
 254  TSynBaseCompletion = class(TLazSynMultiEditPlugin)
 255  private
 256    FAutoUseSingleIdent: Boolean;
 257    Form: TSynBaseCompletionForm;
 258    FAddedPersistentCaret: boolean;
 259    FOnExecute: TNotifyEvent;
 260    FWidth: Integer;
 261    function GetCaseSensitive: boolean;
 262    function GetClSelect: TColor;
 263    function GetDoubleClickSelects: Boolean;
 264    function GetLongLineHintTime: Integer;
 265    function GetLongLineHintType: TSynCompletionLongHintType;
 266    function GetOnKeyDown: TKeyEvent;
 267    function GetOnMeasureItem: TSynBaseCompletionMeasureItem;
 268    function GetOnPositionChanged: TNotifyEvent;
 269    function GetShowSizeDrag: Boolean;
 270    procedure SetCaseSensitive(const AValue: boolean);
 271    procedure SetClSelect(const Value: TColor);
 272    function GetCurrentString: string;
 273    function GetItemList: TStrings;
 274    function GetNbLinesInWindow: Integer;
 275    function GetOnCancel: TNotifyEvent;
 276    function GetOnKeyPress: TKeyPressEvent;
 277    function GetOnPaintItem: TSynBaseCompletionPaintItem;
 278    function GetOnValidate: TValidateEvent;
 279    function GetPosition: Integer;
 280    procedure SetCurrentString(const Value: string);
 281    procedure SetDoubleClickSelects(const AValue: Boolean);
 282    procedure SetItemList(const Value: TStrings);
 283    procedure SetLongLineHintTime(const AValue: Integer);
 284    procedure SetLongLineHintType(const AValue: TSynCompletionLongHintType);
 285    procedure SetNbLinesInWindow(const Value: Integer);
 286    procedure SetOnCancel(const Value: TNotifyEvent);
 287    procedure SetOnKeyDown(const AValue: TKeyEvent);
 288    procedure SetOnKeyPress(const Value: TKeyPressEvent);
 289    procedure SetOnMeasureItem(const AValue: TSynBaseCompletionMeasureItem);
 290    procedure SetOnPositionChanged(const AValue: TNotifyEvent);
 291    procedure SetOnPaintItem(const Value: TSynBaseCompletionPaintItem);
 292    procedure SetPosition(const Value: Integer);
 293    procedure SetOnValidate(const Value: TValidateEvent);
 294    function GetOnKeyDelete: TNotifyEvent;
 295    procedure SetOnKeyDelete(const Value: TNotifyEvent);
 296    procedure SetShowSizeDrag(const AValue: Boolean);
 297    procedure SetWidth(Value: Integer);
 298    function GetOnUTF8KeyPress: TUTF8KeyPressEvent;
 299    procedure SetOnUTF8KeyPress(const AValue: TUTF8KeyPressEvent);
 300    function GetFontHeight:integer;
 301    function GetOnSearchPosition:TSynBaseCompletionSearchPosition;
 302    procedure SetOnSearchPosition(NewValue :TSynBaseCompletionSearchPosition);
 303    function GetOnKeyCompletePrefix: TNotifyEvent;
 304    procedure SetOnKeyCompletePrefix(const AValue: TNotifyEvent);
 305    function GetOnKeyNextChar: TNotifyEvent;
 306    procedure SetOnKeyNextChar(const AValue: TNotifyEvent);
 307    function GetOnKeyPrevChar: TNotifyEvent;
 308    procedure SetOnKeyPrevChar(const AValue: TNotifyEvent);
 309  protected
 310    function GetCompletionFormClass: TSynBaseCompletionFormClass; virtual;
 311  public
 312    constructor Create(AOwner: TComponent); override;
 313    destructor Destroy; override;
 314    procedure Execute(s: string; x, y: integer); overload;
 315    procedure Execute(s: string; TopLeft: TPoint); overload;
 316    procedure Execute(s: string; TokenRect: TRect); overload; // Excute below or above the token // may be extended to adjust left corner too
 317    procedure Deactivate;
 318    function IsActive: boolean;
 319    function TheForm: TSynBaseCompletionForm;
 320    property OnKeyDown: TKeyEvent read GetOnKeyDown write SetOnKeyDown;
 321    property OnUTF8KeyPress: TUTF8KeyPressEvent read GetOnUTF8KeyPress
 322                                                write SetOnUTF8KeyPress;
 323    property OnKeyPress: TKeyPressEvent read GetOnKeyPress write SetOnKeyPress;
 324    property OnKeyDelete: TNotifyEvent read GetOnKeyDelete write SetOnKeyDelete;
 325    property OnValidate: TValidateEvent read GetOnValidate write SetOnValidate;
 326    property OnCancel: TNotifyEvent read GetOnCancel write SetOnCancel;
 327    property CurrentString: string read GetCurrentString write SetCurrentString;
 328    property FontHeight: integer read GetFontHeight;
 329    property ClSelect: TColor read GetClSelect write SetClSelect; deprecated; // use SelectedColor
 330    property NbLinesInWindow: Integer read GetNbLinesInWindow write SetNbLinesInWindow; deprecated;
 331  published
 332    property OnExecute: TNotifyEvent read FOnExecute write FOnExecute;
 333    property OnPaintItem: TSynBaseCompletionPaintItem
 334             read GetOnPaintItem write SetOnPaintItem;
 335    property OnMeasureItem: TSynBaseCompletionMeasureItem read GetOnMeasureItem
 336             write SetOnMeasureItem;
 337    property ItemList: TStrings read GetItemList write SetItemList;
 338    property Position: Integer read GetPosition write SetPosition;
 339    property LinesInWindow: Integer read GetNbLinesInWindow
 340                                      write SetNbLinesInWindow;
 341    property OnSearchPosition: TSynBaseCompletionSearchPosition
 342                             read GetOnSearchPosition write SetOnSearchPosition;
 343    property OnKeyCompletePrefix: TNotifyEvent read GetOnKeyCompletePrefix
 344                                               write SetOnKeyCompletePrefix;// e.g. Tab
 345    property OnKeyNextChar: TNotifyEvent read GetOnKeyNextChar
 346                                         write SetOnKeyNextChar;// e.g. arrow right
 347    property OnKeyPrevChar: TNotifyEvent read GetOnKeyPrevChar
 348                                         write SetOnKeyPrevChar;// e.g. arrow left
 349    property OnPositionChanged: TNotifyEvent read GetOnPositionChanged
 350                                             write SetOnPositionChanged;
 351    property SelectedColor: TColor read GetClSelect write SetClSelect;
 352    property CaseSensitive: boolean read GetCaseSensitive write SetCaseSensitive;
 353    property Width: Integer read FWidth write SetWidth;
 354    property LongLineHintTime: Integer read GetLongLineHintTime
 355             write SetLongLineHintTime default 0;
 356    property LongLineHintType: TSynCompletionLongHintType read GetLongLineHintType
 357             write SetLongLineHintType default sclpExtendRightOnly;
 358    property DoubleClickSelects: Boolean read GetDoubleClickSelects write SetDoubleClickSelects default True;
 359    property ShowSizeDrag: Boolean read GetShowSizeDrag write SetShowSizeDrag default False;
 360    property AutoUseSingleIdent: Boolean read FAutoUseSingleIdent write FAutoUseSingleIdent;
 361  end;
 362
 363  { TSynCompletion }
 364
 365  TSynCompletion = class(TSynBaseCompletion)
 366  private
 367    FShortCut: TShortCut;
 368    FExecCommandID: TSynEditorCommand;
 369    FEndOfTokenChr: string;
 370    FOnCodeCompletion: TCodeCompletionEvent;
 371    procedure Cancel(Sender: TObject);
 372    procedure Validate(Sender: TObject; KeyChar: TUTF8Char; Shift: TShiftState);
 373    function GetPreviousToken(FEditor: TCustomSynEdit): string;
 374  protected
 375    procedure OnFormPaint(Sender: TObject);
 376    procedure SetEditor(const Value: TCustomSynEdit); override;
 377    procedure DoEditorAdded(AValue: TCustomSynEdit); override;
 378    procedure DoEditorRemoving(AValue: TCustomSynEdit); override;
 379    procedure SetShortCut(Value: TShortCut);
 380    procedure TranslateKey(Sender: TObject; Code: word; SState: TShiftState;
 381      var Data: pointer; var IsStartOfCombo: boolean; var Handled: boolean;
 382      var Command: TSynEditorCommand; FinishComboOnly: Boolean;
 383      var ComboKeyStrokes: TSynEditKeyStrokes);
 384    procedure ProcessSynCommand(Sender: TObject; AfterProcessing: boolean;
 385              var Handled: boolean; var Command: TSynEditorCommand;
 386              var AChar: TUTF8Char; Data: pointer; HandlerData: pointer);
 387    function GetCompletionFormClass: TSynBaseCompletionFormClass; override;
 388  public
 389    constructor Create(AOwner: TComponent); override;
 390    function EditorsCount: integer; deprecated; // use EditorCount
 391    procedure AddCharAtCursor(AUtf8Char: TUTF8Char);
 392    procedure DeleteCharBeforoCursor;
 393  published
 394    property ShortCut: TShortCut read FShortCut write SetShortCut;
 395    property EndOfTokenChr: string read FEndOfTokenChr write FEndOfTokenChr;
 396    property OnCodeCompletion: TCodeCompletionEvent
 397      read FOnCodeCompletion write FOnCodeCompletion;
 398    property ExecCommandID: TSynEditorCommand read FExecCommandID write FExecCommandID;
 399    property Editor;
 400  end;
 401
 402  { TSynAutoComplete }
 403
 404  TSynAutoComplete = class(TLazSynMultiEditPlugin)
 405  private
 406    FExecCommandID: TSynEditorCommand;
 407    FShortCut: TShortCut;
 408    fAutoCompleteList: TStrings;
 409    FEndOfTokenChr: string;
 410    procedure SetAutoCompleteList(List: TStrings);
 411  protected
 412    procedure DoEditorAdded(AValue: TCustomSynEdit); override;
 413    procedure DoEditorRemoving(AValue: TCustomSynEdit); override;
 414    procedure SetShortCut(Value: TShortCut);
 415    function GetPreviousToken(aEditor: TCustomSynEdit): string;
 416    procedure TranslateKey(Sender: TObject; Code: word; SState: TShiftState;
 417      var Data: pointer; var IsStartOfCombo: boolean; var Handled: boolean;
 418      var Command: TSynEditorCommand; FinishComboOnly: Boolean;
 419      var ComboKeyStrokes: TSynEditKeyStrokes);
 420    procedure ProcessSynCommand(Sender: TObject; AfterProcessing: boolean;
 421              var Handled: boolean; var Command: TSynEditorCommand;
 422              var AChar: TUTF8Char; Data: pointer; HandlerData: pointer);
 423  public
 424    constructor Create(AOwner: TComponent); override;
 425    destructor Destroy; override;
 426    procedure Execute(token: string; aEditor: TCustomSynEdit);
 427    function EditorsCount: integer;
 428    function GetTokenList: string;
 429    function GetTokenValue(Token: string): string; 
 430  published
 431    property AutoCompleteList: TStrings read fAutoCompleteList
 432      write SetAutoCompleteList;
 433    property EndOfTokenChr: string read FEndOfTokenChr write FEndOfTokenChr;
 434    property ShortCut: TShortCut read FShortCut write SetShortCut;
 435    property ExecCommandID: TSynEditorCommand read FExecCommandID write FExecCommandID;
 436    property Editor;
 437  end;
 438
 439procedure PrettyTextOut(c: TCanvas; x, y: integer; s: string);
 440
 441const
 442  ecSynCompletionExecute     = ecPluginFirstCompletion +  0;
 443  ecSynAutoCompletionExecute = ecPluginFirstCompletion +  1;
 444
 445  // If extending the list, reserve space in SynEditKeyCmds
 446
 447  ecSynCompletionCount = 2;
 448
 449implementation
 450
 451function IsIdentifierChar(p: PChar): boolean; inline;
 452{$IF FPC_FULLVERSION >= 20701}
 453var
 454  u: UnicodeString;
 455  i: Integer;
 456  L: SizeUInt;
 457{$ENDIF}
 458begin
 459  Result := p^ in ['a'..'z','A'..'Z','0'..'9','_'];
 460  if Result then exit;
 461
 462  {$IF FPC_FULLVERSION >= 20701}
 463  if p^ <= #127 then exit;
 464  i := UTF8CharacterLength(p);
 465  SetLength(u, i);
 466  // wide chars of UTF-16 <= bytes of UTF-8 string
 467  if ConvertUTF8ToUTF16(PWideChar(u), i + 1, p, i, [toInvalidCharToSymbol], L) = trNoError
 468  then begin
 469    SetLength(u, L - 1);
 470    if L > 1 then
 471      Result := TCharacter.IsLetterOrDigit(u, 1);
 472  end;
 473  {$ENDIF}
 474end;
 475
 476{ TSynCompletionForm }
 477
 478procedure TSynCompletionForm.AddCharAtCursor(AUtf8Char: TUTF8Char);
 479begin
 480  inherited AddCharAtCursor(AUtf8Char);
 481  if CurrentEditor <> nil then
 482    (CurrentEditor as TCustomSynEdit).CommandProcessor(ecChar, AUtf8Char, nil);
 483end;
 484
 485procedure TSynCompletionForm.DeleteCharBeforeCursor;
 486begin
 487  if CurrentEditor <> nil then
 488    (CurrentEditor as TCustomSynEdit).CommandProcessor(ecDeleteLastChar, #0, nil);
 489  inherited DeleteCharBeforeCursor;
 490end;
 491
 492{ TSynBaseCompletionFormSizeDrag }
 493
 494procedure TSynBaseCompletionFormSizeDrag.MouseDown(Button: TMouseButton; Shift: TShiftState;
 495  X, Y: Integer);
 496begin
 497  inherited MouseDown(Button, Shift, X, Y);
 498  FMouseDownPos.x := x + Left;
 499  FMouseDownPos.y := y + Top;
 500  FMouseLastPos.x := x + Left;
 501  FMouseLastPos.y := y + Top;
 502  FWinSize.x := TSynBaseCompletionForm(Owner).Width;
 503  FWinSize.y := TSynBaseCompletionForm(Owner).Height;
 504  TSynBaseCompletionForm(Owner).IncHintLock;
 505  MouseCapture := True;
 506end;
 507
 508procedure TSynBaseCompletionFormSizeDrag.MouseMove(Shift: TShiftState; X, Y: Integer);
 509var
 510  F: TSynBaseCompletionForm;
 511begin
 512  inherited MouseMove(Shift, X, Y);
 513  x := x + Left;
 514  y := y + Top;
 515  if (FMouseDownPos.y < 0) or
 516     ((FMouseLastPos.x = x) and (FMouseLastPos.y = y))
 517  then
 518    exit;
 519  FMouseLastPos.x := x;
 520  FMouseLastPos.y := y;
 521
 522  F := TSynBaseCompletionForm(Owner);
 523  F.Width :=
 524    Max(FWinSize.x + x - FMouseDownPos.x, 100);
 525  F.NbLinesInWindow :=
 526    Max((FWinSize.y + y - FMouseDownPos.y) div F.FontHeight, 3);
 527end;
 528
 529procedure TSynBaseCompletionFormSizeDrag.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
 530  Y: Integer);
 531begin
 532  inherited MouseUp(Button, Shift, X, Y);
 533  FMouseDownPos.y := -1;
 534  MouseCapture := False;
 535  TSynBaseCompletionForm(Owner).DecHintLock;
 536
 537  if (FWinSize.x <> TSynBaseCompletionForm(Owner).Width) or
 538     (FWinSize.y <> TSynBaseCompletionForm(Owner).Height)
 539  then
 540    TSynBaseCompletionForm(Owner).DoOnDragResize(Owner);
 541end;
 542
 543constructor TSynBaseCompletionFormSizeDrag.Create(TheOwner: TComponent);
 544begin
 545  inherited Create(TheOwner);
 546  FMouseDownPos.y := -1;
 547end;
 548
 549procedure TSynBaseCompletionFormSizeDrag.Paint;
 550begin
 551  Canvas.Brush.Color := clBtnFace;
 552  Canvas.Brush.Style := bsSolid;
 553  Canvas.FillRect(ClientRect);
 554  Canvas.Pen.Color := clBtnShadow;
 555  Canvas.MoveTo(ClientRect.Right-2, ClientRect.Bottom-1);
 556  Canvas.LineTo(ClientRect.Right-1, ClientRect.Bottom-2);
 557  Canvas.MoveTo(ClientRect.Right-5, ClientRect.Bottom-1);
 558  Canvas.LineTo(ClientRect.Right-1, ClientRect.Bottom-5);
 559  Canvas.MoveTo(ClientRect.Right-8, ClientRect.Bottom-1);
 560  Canvas.LineTo(ClientRect.Right-1, ClientRect.Bottom-8);
 561end;
 562
 563{ TSynBaseCompletionForm }
 564
 565constructor TSynBaseCompletionForm.Create(AOwner: Tcomponent);
 566begin
 567  ControlStyle := ControlStyle + [csNoDesignVisible];
 568  FResizeLock := 1; // prevent DoResize (on Handle Creation) do reset LinesInWindow
 569  FDoubleClickSelects := True;
 570  FHintLock := 0;
 571  BeginFormUpdate;
 572  KeyPreview:= True;
 573  // we have no resource => must be constructed using CreateNew
 574  inherited CreateNew(AOwner, 1);
 575  FItemList := TStringList.Create;
 576  BorderStyle := bsNone;
 577  FormStyle := fsSystemStayOnTop;
 578  Scroll := TScrollBar.Create(self);
 579  Scroll.Kind := sbVertical;
 580  Scroll.OnChange := @ScrollChange;
 581  Scroll.Parent := Self;
 582  Scroll.OnEnter := @ScrollGetFocus;
 583  Scroll.OnScroll := @ScrollScroll;
 584  Scroll.TabStop := False;
 585  Scroll.Visible := True;
 586  //Scroll.Align:=alRight;
 587
 588  SizeDrag := TSynBaseCompletionFormSizeDrag.Create(Self);
 589  SizeDrag.Parent := Self;
 590  SizeDrag.BevelInner := bvNone;
 591  SizeDrag.BevelOuter := bvNone;
 592  SizeDrag.Caption := '';
 593  SizeDrag.AutoSize := False;
 594  SizeDrag.BorderStyle := bsNone;
 595  SizeDrag.Anchors := [akBottom, akRight, akLeft];
 596  SizeDrag.AnchorSideLeft.Side := asrTop;
 597  SizeDrag.AnchorSideLeft.Control := Scroll;
 598  SizeDrag.AnchorSideRight.Side := asrBottom;
 599  SizeDrag.AnchorSideRight.Control := Self;
 600  SizeDrag.AnchorSideBottom.Side := asrBottom;
 601  SizeDrag.AnchorSideBottom.Control := Self;
 602  SizeDrag.Height := Max(7, abs(Font.Height) * 2 div 3);
 603  SizeDrag.Cursor := crSizeNWSE;
 604  SizeDrag.Visible := False;
 605
 606  SizeDrag.OnKeyPress:=@SDKeyPress;
 607  SizeDrag.OnKeyDown:=@SDKeyDown;
 608  SizeDrag.OnUTF8KeyPress:=@SDUtf8KeyPress;
 609
 610  Scroll.Anchors:=[akTop,akRight, akBottom];
 611  Scroll.AnchorSide[akTop].Side := asrTop;
 612  Scroll.AnchorSide[akTop].Control := self;
 613  Scroll.AnchorSide[akRight].Side := asrBottom;
 614  Scroll.AnchorSide[akRight].Control := Self;
 615  Scroll.AnchorSide[akBottom].Side := asrTop;
 616  Scroll.AnchorSide[akBottom].Control := SizeDrag;
 617
 618  DrawBorderWidth := 1;
 619  FTextColor:=clBlack;
 620  FTextSelectedColor:=clWhite;
 621  Caption:='Completion';
 622  Color:=clNone;
 623  FBackgroundColor:=clWhite;
 624  FDrawBorderColor:=clBlack;
 625  FHint := TSynBaseCompletionHint.Create(Self);
 626  FHint.FormStyle := fsSystemStayOnTop;
 627  {$IFDEF HintClickWorkaround}
 628  FHint.OnMouseDown :=@HintWindowMouseDown;
 629  {$ENDIF}
 630  FHintTimer := TTimer.Create(nil);
 631  FHintTimer.OnTimer := @OnHintTimer;
 632  FHintTimer.Interval := 0;
 633  FLongLineHintTime := 0;
 634  FLongLineHintType := sclpExtendRightOnly;
 635  Visible := false;
 636  ClSelect := clHighlight;
 637  TStringList(FItemList).OnChange := @StringListChange;
 638  FNbLinesInWindow := 6;
 639  FontChanged(Font);
 640  ShowHint := False;
 641  EndFormUpdate;
 642  FResizeLock := 0;
 643end;
 644
 645procedure TSynBaseCompletionForm.Deactivate;
 646begin
 647  {$IFDEF VerboseFocus}
 648  DebugLnEnter(['>> TSynBaseCompletionForm.Deactivate ']);
 649  try
 650  {$ENDIF}
 651  // completion box lost focus
 652  // this can happen when a hint window is clicked => ToDo
 653  Visible := False;
 654  FHintTimer.Enabled := False;
 655  FHint.Visible := False;
 656  if Assigned(OnCancel) then OnCancel(Self);
 657  if (FCurrentEditor<>nil) and (TCustomSynEdit(fCurrentEditor).HandleAllocated)
 658  then
 659    SetCaretRespondToFocus(TCustomSynEdit(FCurrentEditor).Handle,true);
 660  {$IFDEF VerboseFocus}
 661  finally
 662    DebugLnExit(['<< TSynBaseCompletionForm.Deactivate ']);
 663  end
 664  {$ENDIF}
 665end;
 666
 667destructor TSynBaseCompletionForm.Destroy;
 668begin
 669  UnRegisterHandlers;
 670  FreeAndNil(Scroll);
 671  FreeAndNil(SizeDrag);
 672  FItemList.Free;
 673  FHintTimer.Free;
 674  FHint.Free;
 675  inherited destroy;
 676end;
 677
 678procedure TSynBaseCompletionForm.ShowItemHint(AIndex: Integer);
 679var
 680  R: TRect;
 681  P: TPoint;
 682  M: TMonitor;
 683  MinLeft: Integer;
 684begin
 685  FHintTimer.Enabled := False;
 686  if Visible and (AIndex >= 0) and (AIndex < ItemList.Count) and
 687     (FLongLineHintType <> sclpNone) and
 688     (FHintLock = 0)
 689  then begin
 690    // CalcHintRect uses the current index
 691    FHint.Index := AIndex;
 692    // calculate the size
 693    R := FHint.CalcHintRect(Monitor.Width, ItemList[AIndex], nil);
 694
 695    if (R.Right <= Scroll.Left) then begin
 696      FHint.Hide;
 697      Exit;
 698    end;
 699
 700    // calculate the position
 701    M := Monitor;
 702    P := ClientToScreen(Point(0, (AIndex - Scroll.Position) * FFontHeight));
 703    case FLongLineHintType of
 704      // ClientWidth may be too much, if part of the ClientWidth extends to another screen.
 705      sclpExtendHalfLeft:      MinLeft := Max(M.Left,  P.X - ClientWidth div 2);
 706      sclpExtendUnlimitedLeft: MinLeft := M.Left;
 707      else                     MinLeft := P.X;
 708    end;
 709    P.X := Max(MinLeft,
 710               Min(P.X,          // Start at drop-down Left boundary
 711                   M.Left + M.Width - R.Right - 1
 712                  )              // Or push left, if hitting right Monitor border
 713              );
 714    P.Y := Max(M.Top, Min(P.Y, M.Top + M.Height - R.Bottom - 1));
 715    // actually Width and Height
 716    R.Right := Min(r.Right, M.Left + M.Width - 1 - P.X);
 717    R.Bottom := Min(r.Bottom, M.Top + M.Height - 1 - P.Y);
 718
 719    FHint.HintRect := Bounds(P.X, P.Y, R.Right, R.Bottom);
 720
 721    if (not FHint.IsVisible) and (FLongLineHintTime > 0) then
 722      FHintTimer.Enabled := True
 723    else
 724      OnHintTimer(nil);
 725  end
 726  else begin
 727    FHint.Hide;
 728  end;
 729end;
 730
 731procedure TSynBaseCompletionForm.OnHintTimer(Sender: TObject);
 732begin
 733  FHintTimer.Enabled := False;
 734  FHint.ActivateHint(ItemList[FHint.Index]);
 735  FHint.Invalidate;
 736end;
 737
 738procedure TSynBaseCompletionForm.KeyDown(var Key: Word; Shift: TShiftState);
 739var
 740  i: integer;
 741  Handled: Boolean;
 742begin
 743  {$IFDEF VerboseKeys}
 744  DebugLnEnter(['TSynBaseCompletionForm.KeyDown ',Key,' Shift=',ssShift in Shift,' Ctrl=',ssCtrl in Shift,' Alt=',ssAlt in Shift]);
 745  try
 746  {$ENDIF}
 747  //debugln('TSynBaseCompletionForm.KeyDown A Key=',dbgs(Key));
 748  inherited KeyDown(Key,Shift);
 749  if Key=VK_UNKNOWN then exit;
 750  Handled:=true;
 751  case Key of
 752// added the VK_XXX codes to make it more readable / maintainable
 753    VK_RETURN:
 754      if Assigned(OnValidate) then
 755        OnValidate(Self, '', Shift);
 756    VK_ESCAPE:
 757      if Assigned(OnCancel) then OnCancel(Self);
 758    // I do not think there is a worst way to do this, but laziness rules :-)
 759    VK_PRIOR:
 760      for i := 1 to NbLinesInWindow do
 761        SelectPrec;
 762    VK_NEXT:
 763      for i := 1 to NbLinesInWindow do
 764        SelectNext;
 765    VK_END:
 766      Position := ItemList.count - 1;
 767    VK_HOME:
 768      Position := 0;
 769    VK_UP:
 770      if ssCtrl in Shift then
 771        Position := 0
 772      else
 773        SelectPrec;
 774    VK_DOWN:
 775      if ssCtrl in Shift then
 776        Position := ItemList.count - 1
 777      else
 778        SelectNext;
 779    VK_BACK:
 780      if (Shift = []) and (Length(CurrentString) > 0) then begin
 781        if Assigned(OnKeyDelete) then OnKeyDelete(Self);
 782        DeleteCharBeforeCursor;
 783      end;
 784    VK_TAB:
 785      begin
 786        if Assigned(OnKeyCompletePrefix) then OnKeyCompletePrefix(Self);
 787      end;
 788    VK_LEFT:
 789      begin
 790        if (Shift = []) and (Length(CurrentString) > 0) then begin
 791          if Assigned(OnKeyPrevChar) then OnKeyPrevChar(Self);
 792        end;
 793      end;
 794    VK_Right:
 795      begin
 796        if Assigned(OnKeyNextChar) then OnKeyNextChar(Self);
 797      end;
 798  else
 799    Handled:=false;
 800  end;
 801  if Handled then Key:=VK_UNKNOWN;
 802  Invalidate;
 803  {$IFDEF VerboseKeys}
 804  finally
 805    DebugLnExit(['TSynBaseCompletionForm.KeyDown ',Key,' Shift=',ssShift in Shift,' Ctrl=',ssCtrl in Shift,' Alt=',ssAlt in Shift]);
 806  end;
 807  {$ENDIF}
 808end;
 809
 810procedure TSynBaseCompletionForm.KeyPress(var Key: char);
 811begin
 812  debugln('TSynBaseCompletionForm.KeyPress A Key="',DbgStr(Key),'"');
 813  if Assigned(OnKeyPress) then
 814    OnKeyPress(Self, Key);
 815  debugln('TSynBaseCompletionForm.KeyPress B Key="',DbgStr(Key),'"');
 816  if Key=#0 then exit;
 817  case key of //
 818    #33..'z':
 819      begin
 820        if Key<>#0 then
 821          AddCharAtCursor(key);
 822        Key:=#0;
 823      end;
 824    #8: ;
 825  else
 826    if (ord(key)>=32) and Assigned(OnValidate) then begin
 827      OnValidate(Self, Key, []);
 828      Key:=#0;
 829    end else begin
 830      if Assigned(OnCancel) then OnCancel(Self);
 831      Key:=#0;
 832    end;
 833  end; // case
 834  Invalidate;
 835  //debugln('TSynBaseCompletionForm.KeyPress END Key="',DbgStr(Key),'"');
 836end;
 837
 838procedure TSynBaseCompletionForm.AddCharAtCursor(AUtf8Char: TUTF8Char);
 839begin
 840  CurrentString := CurrentString + AUtf8Char;
 841end;
 842
 843procedure TSynBaseCompletionForm.DeleteCharBeforeCursor;
 844begin
 845  CurrentString := UTF8Copy(CurrentString, 1, UTF8Length(CurrentString) - 1);
 846end;
 847
 848{$IFDEF HintClickWorkaround}
 849procedure TSynBaseCompletionForm.HintWindowMouseDown(Sender: TObject;
 850  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 851var
 852  p: TPoint;
 853begin
 854  p := ScreenToClient(FHint.ClientToScreen(Point(X, Y)));
 855  MouseDown(Button, Shift, p.X, p.Y);
 856end;
 857{$ENDIF}
 858
 859procedure TSynBaseCompletionForm.MouseDown(Button: TMouseButton;
 860  Shift: TShiftState; X, Y: Integer);
 861var
 862  OldPosition: Integer;
 863begin
 864  OldPosition := Position;
 865  y := (y - 1) div FFontHeight;
 866  Position := Scroll.Position + y;
 867  if DoubleClickSelects and (ssDouble in Shift) and (Position = OldPosition) and
 868     Assigned(OnValidate)
 869  then
 870    OnValidate(Self, '', Shift);
 871end;
 872
 873procedure TSynBaseCompletionForm.MouseMove(Shift: TShiftState; X,Y: Integer);
 874begin
 875  if ((Scroll.Visible) and (x > Scroll.Left)) or
 876     (y  < DrawBorderWidth) or (y >= ClientHeight - DrawBorderWidth)
 877  then
 878    exit;
 879  Y := (Y - DrawBorderWidth) div FFontHeight;
 880  ShowItemHint(Scroll.Position + Y);
 881end;
 882
 883procedure TSynBaseCompletionForm.Paint;
 884var
 885  i, Ind: integer;
 886  PaintWidth, YYY, RightC, BottomC: Integer;
 887  Capt: String;
 888begin
 889//Writeln('[TSynBaseCompletionForm.Paint]');
 890
 891  // update scroll bar
 892  Scroll.Enabled := ItemList.Count > NbLinesInWindow;
 893  Scroll.Visible := (ItemList.Count > NbLinesInWindow) or ShowSizeDrag;
 894
 895  if Scroll.Visible and Scroll.Enabled then
 896  begin
 897    Scroll.Max := ItemList.Count - 1;
 898    Scroll.LargeChange := NbLinesInWindow;
 899    Scroll.PageSize := NbLinesInWindow;
 900  end
 901  else
 902  begin
 903    Scroll.PageSize := 1;
 904    Scroll.Max := 0;
 905  end;
 906
 907  PaintWidth := Width - Scroll.Width;
 908  RightC := PaintWidth - 2 * DrawBorderWidth;
 909  //DebugLn(['TSynBaseCompletionForm.Paint NbLinesInWindow=',NbLinesInWindow,' ItemList.Count=',ItemList.Count]);
 910  for i := 0 to Min(NbLinesInWindow - 1, ItemList.Count - Scroll.Position - 1) do
 911  begin
 912    YYY := DrawBorderWidth + FFontHeight * i;
 913    BottomC := (FFontHeight * (i + 1))+1;
 914    if i + Scroll.Position = Position then
 915    begin
 916      Canvas.Brush.Color := clSelect;
 917      Canvas.Pen.Color := clSelect;
 918      Canvas.Rectangle(DrawBorderWidth, YYY, RightC, BottomC);
 919      Canvas.Pen.Color := clBlack;
 920      Canvas.Font.Color := TextSelectedColor;
 921      Hint := ItemList[Position];
 922    end
 923    else
 924    begin
 925      Canvas.Brush.Color := BackgroundColor;
 926      Canvas.Font.Color := TextColor;
 927      Canvas.FillRect(Rect(DrawBorderWidth, YYY, RightC, BottomC));
 928    end;
 929    //DebugLn(['TSynBaseCompletionForm.Paint ',i,' ',ItemList[Scroll.Position + i]]);
 930    Ind := i + Scroll.Position;
 931    Capt := ItemList[Scroll.Position + i];
 932    if not Assigned(OnPaintItem)
 933    or not OnPaintItem(Capt, Canvas, DrawBorderWidth, YYY, Ind = Position, Ind)
 934    then
 935      Canvas.TextOut(DrawBorderWidth+2, YYY, Capt);
 936  end;
 937  // paint the rest of the background
 938  if NbLinesInWindow > ItemList.Count - Scroll.Position then
 939  begin
 940    Canvas.brush.color := color;
 941    i:=(FFontHeight * ItemList.Count)+1;
 942    Canvas.FillRect(Rect(0, i, PaintWidth, Height));
 943  end;
 944  // draw a rectangle around the window
 945  if DrawBorderWidth > 0 then
 946  begin
 947    Canvas.Pen.Color := DrawBorderColor;
 948    Canvas.Pen.Width := DrawBorderWidth;
 949    Canvas.Moveto(0, 0);
 950    Canvas.LineTo(Width - 1, 0);
 951    Canvas.LineTo(Width - 1, Height - 1);
 952    Canvas.LineTo(0, Height - 1);
 953    Canvas.LineTo(0, 0);
 954  end;
 955end;
 956
 957function TSynBaseCompletionForm.Focused: Boolean;
 958begin
 959  Result:=(inherited Focused) or SizeDrag.Focused;
 960end;
 961
 962procedure TSynBaseCompletionForm.AppDeactivated(Sender: TObject);
 963begin
 964  {$IFDEF VerboseFocus}
 965  DebugLn(['>> TSynBaseCompletionForm.AppDeactivated ']);
 966  {$ENDIF}
 967  Deactivate;
 968end;
 969
 970procedure TSynBaseCompletionForm.ScrollChange(Sender: TObject);
 971begin
 972  if Position < Scroll.Position then
 973    Position := Scroll.Position
 974  else 
 975  if Position > Scroll.Position + NbLinesInWindow - 1 then
 976    Position := Scroll.Position + NbLinesInWindow - 1;
 977  Invalidate;
 978end;
 979
 980procedure TSynBaseCompletionForm.ScrollGetFocus(Sender: TObject);
 981begin
 982  ActiveControl := nil;
 983end;
 984
 985procedure TSynBaseCompletionForm.ScrollScroll(Sender: TObject; ScrollCode: TScrollCode;
 986  var ScrollPos: Integer);
 987begin
 988  if ScrollPos > (Scroll.Max - Scroll.PageSize) + 1 then
 989    ScrollPos := Scroll.Max - Scroll.PageSize + 1;
 990  FHint.Hide;
 991  ShowItemHint(Position);
 992end;
 993
 994procedure TSynBaseCompletionForm.SelectNext;
 995begin
 996  if Position < ItemList.Count - 1 then
 997    Position := Position + 1;
 998end;
 999
1000procedure TSynBaseCompletionForm.SelectPrec;
1001begin
1002  if Position > 0 then
1003    Position := Position - 1;
1004end;
1005
1006procedure TSynBaseCompletionForm.DoEditorKeyDown(Sender: TObject; var Key: Word;
1007  Shift: TShiftState);
1008begin
1009  if (not Visible) or (FCurrentEditor = nil) or (Sender <> FCurrentEditor) then exit;
1010  KeyDown(Key, Shift);
1011  Key := 0;
1012end;
1013
1014procedure TSynBaseCompletionForm.DoEditorKeyPress(Sender: TObject; var Key: char);
1015begin
1016  if (not Visible) or (FCurrentEditor = nil) or (Sender <> FCurrentEditor) then exit;
1017  KeyPress(Key);
1018  Key := #0;
1019end;
1020
1021procedure TSynBaseCompletionForm.DoEditorUtf8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
1022begin
1023  if (not Visible) or (FCurrentEditor = nil) or (Sender <> FCurrentEditor) then exit;
1024  UTF8KeyPress(UTF8Key);
1025  UTF8Key := '';
1026end;
1027
1028procedure TSynBaseCompletionForm.SDKeyDown(Sender: TObject; var Key: Word;
1029  Shift: TShiftState);
1030begin
1031  KeyDown(key,shift);
1032end;
1033
1034procedure TSynBaseCompletionForm.SDKeyPress(Sender: TObject; var Key: char);
1035begin
1036  KeyPress(key);
1037end;
1038
1039procedure TSynBaseCompletionForm.SDUtf8KeyPress(Sender: TObject;
1040  var UTF8Key: TUTF8Char);
1041begin
1042  UTF8KeyPress(UTF8Key);
1043end;
1044
1045procedure TSynBaseCompletionForm.UTF8KeyPress(var UTF8Key: TUTF8Char);
1046begin
1047  {$IFDEF VerboseKeys}
1048  debugln('TSynBaseCompletionForm.UTF8KeyPress A UTF8Key="',DbgStr(UTF8Key),'" ',dbgsName(TObject(TMethod(OnUTF8KeyPress).Data)));
1049  {$ENDIF}
1050  if Assigned(OnUTF8KeyPress) then
1051    OnUTF8KeyPress(Self, UTF8Key);
1052  if UTF8Key='' then
1053    exit;
1054
1055  if UTF8Key=#8 then
1056  begin
1057    // backspace
1058  end
1059  else
1060  if (Length(UTF8Key)>=1) and (not IsIdentifierChar(@UTF8Key[1])) then
1061  begin
1062    // non identifier character
1063    // if it is special key then eat it
1064    if (Length(UTF8Key) = 1) and (UTF8Key[1] < #32) then
1065    begin
1066      if Assigned(OnCancel) then
1067        OnCancel(Self);
1068    end
1069    else
1070    if Assigned(OnValidate) then
1071      OnValidate(Self, UTF8Key, []);
1072    UTF8Key := '';
1073  end
1074  else
1075  if (UTF8Key<>'') then
1076  begin
1077    // identifier character
1078    AddCharAtCursor(UTF8Key);
1079    UTF8Key := '';
1080  end;
1081  {$IFDEF VerboseKeys}
1082  debugln('TSynBaseCompletionForm.UTF8KeyPress END UTF8Key="',DbgStr(UTF8Key),'"');
1083  {$ENDIF}
1084end;
1085
1086procedure TSynBaseCompletionForm.SetCurrentString(const Value: string);
1087var
1088  i: integer;
1089begin
1090  FCurrentString := Value;
1091  //debugln('TSynBaseCompletionForm.SetCurrentString FCurrentString=',FCurrentString);
1092  if Assigned(FOnSearchPosition) then begin
1093    i:=Position;
1094    FOnSearchPosition(i);
1095    Position:=i;
1096  end else begin
1097    if FCaseSensitive then begin
1098      for i := 0 to Pred(ItemList.Count) do
1099        if 0 = CompareStr(fCurrentString,
1100          Copy(ItemList[i], 1, Length(fCurrentString)))
1101        then begin
1102          Position := i;
1103          break;
1104        end;
1105    end else begin
1106      for i := 0 to Pred(ItemList.Count) do
1107        if 0 = WideCompareText(UTF8Decode(fCurrentString),
1108                       UTF8Decode(Copy(ItemList[i], 1, Length(fCurrentString))))
1109        then begin
1110          Position := i;
1111          break;
1112        end;
1113    end;
1114  end;
1115end;
1116
1117procedure TSynBaseCompletionForm.DoOnResize;
1118begin
1119  inherited DoOnResize;
1120  if ([csLoading,csDestroying]*ComponentState<>[]) or (Scroll=nil) then exit;
1121  if (fFontHeight > 0) and (FResizeLock = 0) then
1122  begin
1123    FNbLinesInWindow := (Height-2*DrawBorderWidth+(fFontHeight-1)) div fFontHeight;
1124    Invalidate;
1125  end;
1126end;
1127
1128procedure TSynBaseCompletionForm.SetBackgroundColor(const AValue: TColor);
1129begin
1130  if FBackgroundColor <> AValue then
1131  begin
1132    FBackgroundColor := AValue;
1133    Color := AValue;
1134    FHint.Color := AValue;
1135  end;
1136end;
1137
1138procedure TSynBaseCompletionForm.FontChanged(Sender: TObject);
1139var
1140  TextMetric: TTextMetric;
1141begin
1142  inc(FResizeLock);   // prevent DoResize from recalculating NbLinesInWindow
1143  try
1144    inherited;
1145    FillChar(TextMetric{%H-},SizeOf(TextMetric),0);
1146    GetTextMetrics(Canvas.Handle, TextMetric);
1147    FFontHeight := TextMetric.tmHeight+2;
1148    SetNblinesInWindow(FNbLinesInWindow);
1149    SizeDrag.Height := Max(7, FFontHeight * 2 div 3);
1150  finally
1151    dec(FResizeLock);
1152  end;
1153end;
1154
1155procedure TSynBaseCompletionForm.WMMouseWheel(var Msg: TLMMouseEvent);
1156const
1157  WHEEL_DELTA = 120;
1158var
1159  WheelClicks: Integer;
1160begin
1161  Inc(FMouseWheelAccumulator, Msg.WheelDelta);
1162  WheelClicks := FMouseWheelAccumulator div WHEEL_DELTA;
1163  FMouseWheelAccumulator := FMouseWheelAccumulator - WheelClicks * WHEEL_DELTA;
1164  WheelClicks := WheelClicks * Mouse.WheelScrollLines;
1165  Scroll.Position := Max(0, Min(FItemList.Count - NbLinesInWindow, Scroll.Position - WheelClicks));
1166end;
1167
1168procedure TSynBaseCompletionForm.SetLongLineHintTime(const AValue: Integer);
1169begin
1170  if FLongLineHintTime = AValue then exit;
1171  FLongLineHintTime := AValue;
1172  FHintTimer.Interval := AValue;
1173end;
1174
1175procedure TSynBaseCompletionForm.EditorStatusChanged(Sender: TObject;
1176  Changes: TSynStatusChanges);
1177begin
1178  if (scTopLine in Changes) and Assigned(OnCancel) then
1179    OnCancel(Self);
1180end;
1181
1182procedure TSynBaseCompletionForm.SetShowSizeDrag(const AValue: Boolean);
1183begin
1184  if FShowSizeDrag = AValue then exit;
1185  FShowSizeDrag := AValue;
1186  SizeDrag.Visible := AValue;
1187end;
1188
1189procedure TSynBaseCompletionForm.RegisterHandlers(EditOnly: Boolean);
1190begin
1191  if FCurrentEditor <> nil then begin
1192    FCurrentEditor.RegisterStatusChangedHandler
1193    (@EditorStatusChanged, [scTopLine]);
1194    // Catch Editor events. Some Widgetset may report keys to the editor,
1195    // if the user types faster, then the app can open the form
1196    FCurrentEditor.RegisterBeforeKeyDownHandler(@DoEditorKeyDown);
1197    FCurrentEditor.RegisterBeforeKeyPressHandler(@DoEditorKeyPress);
1198    FCurrentEditor.RegisterBeforeUtf8KeyPressHandler(@DoEditorUtf8KeyPress);
1199  end;
1200  if not EditOnly then
1201    Application.AddOnDeactivateHandler(@AppDeactivated);
1202end;
1203
1204procedure TSynBaseCompletionForm.UnRegisterHandlers(EditOnly: Boolean);
1205begin
1206  if FCurrentEditor <> nil then begin
1207    FCurrentEditor.UnRegisterStatusChangedHandler(@EditorStatusChanged);
1208    FCurrentEditor.UnregisterBeforeKeyDownHandler(@DoEditorKeyDown);
1209    FCurrentEditor.UnregisterBeforeKeyPressHandler(@DoEditorKeyPress);
1210    FCurrentEditor.UnregisterBeforeUtf8KeyPressHandler(@DoEditorUtf8KeyPress);
1211  end;
1212  if not EditOnly then
1213    Application.RemoveOnDeactivateHandler(@AppDeactivated);
1214end;
1215
1216procedure TSynBaseCompletionForm.SetCurrentEditor(const AValue: TCustomSynEdit);
1217begin
1218  if FCurrentEditor = AValue then exit;
1219  UnRegisterHandlers(True);
1220  FCurrentEditor := AValue;
1221  if Visible then
1222    RegisterHandlers(True);
1223end;
1224
1225procedure TSynBaseCompletionForm.SetDrawBorderWidth(const AValue: Integer);
1226begin
1227  if FDrawBorderWidth = AValue then exit;
1228  FDrawBorderWidth := AValue;
1229  NbLinesInWindow := NbLinesInWindow;
1230  Scroll.BorderSpacing.Top := FDrawBorderWidth;
1231  Scroll.BorderSpacing.Right := FDrawBorderWidth;
1232  if SizeDrag.Visible then
1233    Scroll.BorderSpacing.Bottom := 0
1234  else
1235    Scroll.BorderSpacing.Bottom := FDrawBorderWidth;
1236  SizeDrag.BorderSpacing.Right := FDrawBorderWidth;
1237  SizeDrag.BorderSpacing.Bottom := FDrawBorderWidth;
1238end;
1239
1240procedure TSynBaseCompletionForm.SetVisible(Value: Boolean);
1241begin
1242  if Visible = Value then exit;;
1243
1244  if Value then
1245    RegisterHandlers
1246  else
1247    UnRegisterHandlers;
1248
1249  inherited SetVisible(Value);
1250end;
1251
1252procedure TSynBaseCompletionForm.IncHintLock;
1253begin
1254  inc(FHintLock);
1255  FHint.Hide
1256end;
1257
1258procedure TSynBaseCompletionForm.DecHintLock;
1259begin
1260  dec(FHintLock);
1261  if FHintLock = 0 then
1262    ShowItemHint(Position);
1263end;
1264
1265procedure TSynBaseCompletionForm.DoOnDragResize(Sender: TObject);
1266begin
1267  if assigned(FOnDragResized) then
1268    FOnDragResized(Sender);
1269end;
1270
1271procedure TSynBaseCompletionForm.SetItemList(const Value: TStrings);
1272begin
1273  FItemList.Assign(Value);
1274  if Position>=FItemList.Count then Position:=-1;
1275  Invalidate;
1276end;
1277
1278procedure TSynBaseCompletionForm.SetNbLinesInWindow(
1279  const Value: Integer);
1280begin
1281  inc(FResizeLock);   // prevent DoResize from recalculating NbLinesInWindow
1282  try
1283    FNbLinesInWindow := Value;
1284    Height := fFontHeight * NbLinesInWindow + 2*DrawBorderWidth;
1285  finally
1286    dec(FResizeLock);
1287  end;
1288end;
1289
1290procedure TSynBaseCompletionForm.SetPosition(const Value: Integer);
1291begin
1292  if Value < ItemList.Count then begin
1293    if FPosition <> Value then begin
1294      FPosition := Value;
1295      if Position < Scroll.Position then
1296        Scroll.Position := Position
1297      else if Scroll.Position < Position - NbLinesInWindow + 1 then
1298        Scroll.Position := Position - NbLinesInWindow + 1;
1299      Invalidate;
1300      if Assigned(OnPositionChanged) then OnPositionChanged(Self);
1301    end;
1302  end;
1303  if Showing then
1304    ShowItemHint(Position);
1305end;
1306
1307procedure TSynBaseCompletionForm.StringListChange(Sender: TObject);
1308begin
1309  if ItemList.Count - NbLinesInWindow < 0 then
1310    Scroll.Max := 0
1311  else
1312    Scroll.Max := ItemList.Count - NbLinesInWindow;
1313  Position := Position;
1314end;
1315
1316{ TSynBaseCompletion }
1317
1318constructor TSynBaseCompletion.Create(AOwner: TComponent);
1319begin
1320  FWidth := 262;
1321  inherited Create(AOwner);
1322  Form := GetCompletionFormClass.Create(nil); // Do not create with owner, or the designer will make it visible
1323  Form.Width := FWidth;
1324  FAutoUseSingleIdent := True;
1325end;
1326
1327destructor TSynBaseCompletion.Destroy;
1328begin
1329  inherited Destroy;
1330  FreeAndNil(Form);
1331end;
1332
1333function TSynBaseCompletion.GetOnUTF8KeyPress: TUTF8KeyPressEvent;
1334begin
1335  Result:=Form.OnUTF8KeyPress;
1336end;
1337
1338procedure TSynBaseCompletion.SetOnUTF8KeyPress(
1339  const AValue: TUTF8KeyPressEvent);
1340begin
1341  Form.OnUTF8KeyPress:=AValue;
1342end;
1343
1344function TSynBaseCompletion.GetFontHeight:integer;
1345begin
1346  Result:=Form.FontHeight;
1347end;
1348
1349function TSynBaseCompletion.GetOnSearchPosition:TSynBaseCompletionSearchPosition;
1350begin
1351  Result:=Form.OnSearchPosition;
1352end;
1353
1354procedure TSynBaseCompletion.SetOnSearchPosition(
1355  NewValue :TSynBaseCompletionSearchPosition);
1356begin
1357  Form.OnSearchPosition:=NewValue;
1358end;
1359
1360function TSynBaseCompletion.GetOnKeyCompletePrefix: TNotifyEvent;
1361begin
1362  Result:=Form.OnKeyCompletePrefix;
1363end;
1364
1365procedure TSynBaseCompletion.SetOnKeyCompletePrefix(const AValue: TNotifyEvent);
1366begin
1367  Form.OnKeyCompletePrefix:=AValue;
1368end;
1369
1370function TSynBaseCompletion.GetOnKeyNextChar: TNotifyEvent;
1371begin
1372  Result:=Form.OnKeyNextChar;
1373end;
1374
1375procedure TSynBaseCompletion.SetOnKeyNextChar(const AValue: TNotifyEvent);
1376begin
1377  Form.OnKeyNextChar:=AValue;
1378end;
1379
1380function TSynBaseCompletion.GetOnKeyPrevChar: TNotifyEvent;
1381begin
1382  Result:=Form.OnKeyPrevChar;
1383end;
1384
1385procedure TSynBaseCompletion.SetOnKeyPrevChar(const AValue: TNotifyEvent);
1386begin
1387  Form.OnKeyPrevChar:=AValue;
1388end;
1389
1390function TSynBaseCompletion.GetCompletionFormClass: TSynBaseCompletionFormClass;
1391begin
1392  Result := TSynBaseCompletionForm;
1393end;
1394
1395procedure TSynBaseCompletion.Execute(s: string; x, y: integer);
1396var
1397  CurSynEdit: TCustomSynEdit;
1398begin
1399  //writeln('TSynBaseCompletion.Execute ',Form.CurrentEditor.Name);
1400
1401  //Todo: This is dangerous, if other plugins also change/changed the flag.
1402  FAddedPersistentCaret := False;
1403
1404  CurrentString := s;
1405  if Assigned(OnExecute) then
1406    OnExecute(Self);
1407  if (ItemList.Count=1) and Assigned(OnValidate) and FAutoUseSingleIdent then begin
1408    OnValidate(Form, '', []);
1409    exit;
1410  end;
1411  if (ItemList.Count=0) and Assigned(OnCancel) then begin
1412    OnCancel(Form);
1413    exit;
1414  end;
1415
1416  if (Form.CurrentEditor is TCustomSynEdit) then begin
1417    CurSynEdit:=TCustomSynEdit(Form.CurrentEditor);
1418    FAddedPersistentCaret := not(eoPersistentCaret in CurSynEdit.Options);
1419    if FAddedPersistentCaret then
1420      CurSynEdit.Options:=CurSynEdit.Options+[eoPersistentCaret];
1421  end;
1422  Form.SetBounds(x,y,Form.Width,Form.Height);
1423  Form.Show;
1424  Form.Position := Form.Position;
1425end;
1426
1427procedure TSynBaseCompletion.Execute(s: string; TopLeft: TPoint);
1428begin
1429  Execute(s, TopLeft.x, TopLeft.y);
1430end;
1431
1432procedure TSynBaseCompletion.Execute(s: string; TokenRect: TRect);
1433var
1434  SpaceBelow, SpaceAbove: Integer;
1435  Mon: TMonitor;
1436begin
1437  Mon := Screen.MonitorFromPoint(TokenRect.TopLeft);
1438  if Mon <> nil then
1439    TokenRect.Left := Min(TokenRect.Left, Mon.Left + Mon.Width - Form.Width);
1440
1441  SpaceBelow := Mon.Height - TokenRect.Bottom;
1442  SpaceAbove := TokenRect.Top - Mon.Top;
1443  if Form.Height < SpaceBelow then
1444    Execute(s, TokenRect.Left, TokenRect.Bottom)
1445  else
1446  if Form.Height < SpaceAbove then
1447    Execute(s, TokenRect.Left, TokenRect.Top - Form.Height)
1448  else
1449  begin
1450    if SpaceBelow > SpaceAbove then begin
1451      Form.NbLinesInWindow := Max(SpaceBelow div Form.FontHeight, 3); // temporary height
1452    Execute(s, TokenRect.Left, TokenRect.Bottom);
1453    end else begin
1454      Form.NbLinesInWindow := Max(SpaceAbove div Form.FontHeight, 3); // temporary height
1455      Execute(s, TokenRect.Left, TokenRect.Top - Form.Height);
1456    end;;
1457  end…

Large files files are truncated, but you can click here to view the full file