PageRenderTime 48ms CodeModel.GetById 11ms RepoModel.GetById 1ms app.codeStats 0ms

/components/synedit/syncompletion.pas

http://github.com/graemeg/lazarus
Pascal | 2208 lines | 1873 code | 221 blank | 114 comment | 162 complexity | 4e0120753942f18b325a29adde58d57b MD5 | raw file
Possible License(s): GPL-2.0, LGPL-2.0, MPL-2.0-no-copyleft-exception
  1. {-------------------------------------------------------------------------------
  2. The contents of this file are subject to the Mozilla Public License
  3. Version 1.1 (the "License"); you may not use this file except in compliance
  4. with the License. You may obtain a copy of the License at
  5. http://www.mozilla.org/MPL/
  6. Software distributed under the License is distributed on an "AS IS" basis,
  7. WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
  8. the specific language governing rights and limitations under the License.
  9. The Original Code is: SynCompletionProposal.pas, released 2000-04-11.
  10. The Original Code is based on mwCompletionProposal.pas by Cyrille de Brebisson,
  11. part of the mwEdit component suite.
  12. Portions created by Cyrille de Brebisson are Copyright (C) 1999
  13. Cyrille de Brebisson. All Rights Reserved.
  14. Contributors to the SynEdit and mwEdit projects are listed in the
  15. Contributors.txt file.
  16. Alternatively, the contents of this file may be used under the terms of the
  17. GNU General Public License Version 2 or later (the "GPL"), in which case
  18. the provisions of the GPL are applicable instead of those above.
  19. If you wish to allow use of your version of this file only under the terms
  20. of the GPL and not to allow others to use your version of this file
  21. under the MPL, indicate your decision by deleting the provisions above and
  22. replace them with the notice and other provisions required by the GPL.
  23. If you do not delete the provisions above, a recipient may use your version
  24. of this file under either the MPL or the GPL.
  25. $Id$
  26. You may retrieve the latest version of this file at the SynEdit home page,
  27. located at http://SynEdit.SourceForge.net
  28. Known Issues:
  29. -------------------------------------------------------------------------------}
  30. unit SynCompletion;
  31. {$I SynEdit.inc}
  32. {$DEFINE HintClickWorkaround} // Workaround for issue 21952
  33. interface
  34. uses
  35. LCLProc, LCLIntf, LCLType, LazUTF8, LMessages, Classes, Graphics, Forms,
  36. Controls, StdCtrls, ExtCtrls, Menus, SysUtils, types,
  37. SynEditMiscProcs, SynEditKeyCmds, SynEdit, SynEditTypes, SynEditPlugins
  38. {$IF FPC_FULLVERSION >= 20701}, character{$ENDIF};
  39. type
  40. TSynBaseCompletionPaintItem =
  41. function(const AKey: string; ACanvas: TCanvas;
  42. X, Y: integer; Selected: boolean; Index: integer
  43. ): boolean of object;
  44. TSynBaseCompletionMeasureItem =
  45. function(const AKey: string; ACanvas: TCanvas;
  46. Selected: boolean; Index: integer): TPoint of object;
  47. TCodeCompletionEvent = procedure(var Value: string;
  48. SourceValue: string;
  49. var SourceStart, SourceEnd: TPoint;
  50. KeyChar: TUTF8Char;
  51. Shift: TShiftState) of object;
  52. TValidateEvent = procedure(Sender: TObject;
  53. KeyChar: TUTF8Char;
  54. Shift: TShiftState) of object;
  55. TSynBaseCompletionSearchPosition = procedure(var APosition :integer) of object;
  56. TSynBaseCompletionForm = class;
  57. { TSynBaseCompletionHint }
  58. TSynBaseCompletionHint = class(THintWindow)
  59. private
  60. FCompletionForm: TSynBaseCompletionForm;
  61. FIndex: Integer;
  62. public
  63. constructor Create(AOwner: TComponent); override;
  64. function CalcHintRect(MaxWidth: Integer; const AHint: string;
  65. AData: pointer): TRect; override;
  66. procedure Paint; override;
  67. property Index: Integer read FIndex write FIndex;
  68. end;
  69. TSynCompletionLongHintType = (sclpNone,
  70. sclpExtendRightOnly,
  71. sclpExtendHalfLeft,
  72. sclpExtendUnlimitedLeft
  73. );
  74. { TSynBaseCompletionFormSizeDrag }
  75. TSynBaseCompletionFormSizeDrag = class(TPanel)
  76. private
  77. FMouseDownPos, FMouseLastPos, FWinSize: TPoint;
  78. protected
  79. procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  80. procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  81. procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  82. public
  83. constructor Create(TheOwner: TComponent); override;
  84. procedure Paint; override;
  85. end;
  86. { TSynBaseCompletionForm }
  87. TSynBaseCompletionForm = class(TForm)
  88. procedure SDKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  89. procedure SDKeyPress(Sender: TObject; var Key: char);
  90. procedure SDUtf8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
  91. protected
  92. FCurrentString: string;
  93. FOnKeyPress: TKeyPressEvent;
  94. FOnKeyDelete: TNotifyEvent;
  95. FOnPaintItem: TSynBaseCompletionPaintItem;
  96. FItemList: TStrings;
  97. FPosition: Integer;
  98. FNbLinesInWindow: Integer;
  99. FFontHeight: integer;
  100. FResizeLock: Integer;
  101. Scroll: TScrollBar;
  102. SizeDrag: TSynBaseCompletionFormSizeDrag;
  103. FOnValidate: TValidateEvent;
  104. FOnCancel: TNotifyEvent;
  105. FClSelect: TColor;
  106. FCaseSensitive: boolean;
  107. FBackgroundColor: TColor;
  108. FDrawBorderColor: TColor;
  109. FOnSearchPosition: TSynBaseCompletionSearchPosition;
  110. FOnKeyCompletePrefix: TNotifyEvent;
  111. FOnKeyNextChar: TNotifyEvent;
  112. FOnKeyPrevChar: TNotifyEvent;
  113. FTextColor: TColor;
  114. FTextSelectedColor: TColor;
  115. FHint: TSynBaseCompletionHint;
  116. FHintTimer: TTimer;
  117. FLongLineHintTime: Integer;
  118. FLongLineHintType: TSynCompletionLongHintType;
  119. FMouseWheelAccumulator: Integer;
  120. procedure DoEditorKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  121. procedure DoEditorKeyPress(Sender: TObject; var Key: char);
  122. procedure DoEditorUtf8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
  123. procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
  124. procedure SetCurrentString(const Value: string);
  125. procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  126. procedure KeyPress(var Key: char); override;
  127. procedure AddCharAtCursor(AUtf8Char: TUTF8Char); virtual;
  128. procedure DeleteCharBeforeCursor; virtual;
  129. procedure Paint; override;
  130. procedure AppDeactivated(Sender: TObject); // Because Form.Deactivate isn't called
  131. procedure Deactivate; override;
  132. procedure SelectPrec;
  133. procedure SelectNext;
  134. procedure ScrollChange(Sender: TObject);
  135. procedure ScrollGetFocus(Sender: TObject);
  136. procedure ScrollScroll(Sender: TObject; ScrollCode: TScrollCode;
  137. var ScrollPos: Integer);
  138. procedure SetItemList(const Value: TStrings);
  139. procedure SetPosition(const Value: Integer);
  140. procedure SetNbLinesInWindow(const Value: Integer);
  141. {$IFDEF HintClickWorkaround}
  142. procedure HintWindowMouseDown(Sender: TObject; Button: TMouseButton;
  143. Shift: TShiftState; X, Y: Integer);
  144. {$ENDIF}
  145. procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  146. X, Y: Integer); override;
  147. procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
  148. procedure StringListChange(Sender: TObject);
  149. procedure DoOnResize; override;
  150. procedure SetBackgroundColor(const AValue: TColor);
  151. procedure FontChanged(Sender: TObject); override;
  152. procedure WMMouseWheel(var Msg: TLMMouseEvent); message LM_MOUSEWHEEL;
  153. private
  154. FCurrentEditor: TCustomSynEdit; // Must only be set via TSynCompletion.SetEditor
  155. FDoubleClickSelects: Boolean;
  156. FDrawBorderWidth: Integer;
  157. FOnDragResized: TNotifyEvent;
  158. FOnMeasureItem: TSynBaseCompletionMeasureItem;
  159. FOnPositionChanged: TNotifyEvent;
  160. FShowSizeDrag: Boolean;
  161. FHintLock: Integer;
  162. procedure SetCurrentEditor(const AValue: TCustomSynEdit);
  163. procedure SetDrawBorderWidth(const AValue: Integer);
  164. procedure SetLongLineHintTime(const AValue: Integer);
  165. procedure EditorStatusChanged(Sender: TObject; Changes: TSynStatusChanges);
  166. procedure SetShowSizeDrag(const AValue: Boolean);
  167. protected
  168. procedure RegisterHandlers(EditOnly: Boolean = False);
  169. procedure UnRegisterHandlers(EditOnly: Boolean = False);
  170. procedure SetVisible(Value: Boolean); override;
  171. procedure IncHintLock;
  172. procedure DecHintLock;
  173. procedure DoOnDragResize(Sender: TObject);
  174. public
  175. constructor Create(AOwner: Tcomponent); override;
  176. destructor Destroy; override;
  177. function Focused: Boolean; override;
  178. procedure ShowItemHint(AIndex: Integer);
  179. procedure OnHintTimer(Sender: TObject);
  180. // Must only be set via TSynCompletion.SetEditor
  181. property CurrentEditor: TCustomSynEdit read FCurrentEditor;
  182. published
  183. property CurrentString: string read FCurrentString write SetCurrentString;
  184. property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
  185. property OnKeyDelete: TNotifyEvent read FOnKeyDelete write FOnKeyDelete;
  186. property OnPaintItem: TSynBaseCompletionPaintItem read FOnPaintItem
  187. write FOnPaintItem;
  188. property OnMeasureItem: TSynBaseCompletionMeasureItem read FOnMeasureItem
  189. write FOnMeasureItem;
  190. property OnValidate: TValidateEvent read FOnValidate write FOnValidate;
  191. property OnCancel: TNotifyEvent read FOnCancel write FOnCancel;
  192. property ItemList: TStrings read FItemList write SetItemList;
  193. property Position: Integer read FPosition write SetPosition;
  194. property NbLinesInWindow: Integer read FNbLinesInWindow
  195. write SetNbLinesInWindow;
  196. property ClSelect: TColor read FClSelect write FClSelect;
  197. property CaseSensitive: boolean read FCaseSensitive write FCaseSensitive;
  198. property FontHeight:integer read FFontHeight;
  199. property OnSearchPosition:TSynBaseCompletionSearchPosition
  200. read FOnSearchPosition write FOnSearchPosition;
  201. property OnKeyCompletePrefix: TNotifyEvent read FOnKeyCompletePrefix write FOnKeyCompletePrefix;// e.g. Tab
  202. property OnKeyNextChar: TNotifyEvent read FOnKeyNextChar write FOnKeyNextChar;// e.g. arrow right
  203. property OnKeyPrevChar: TNotifyEvent read FOnKeyPrevChar write FOnKeyPrevChar;// e.g. arrow left
  204. property OnPositionChanged: TNotifyEvent read FOnPositionChanged write FOnPositionChanged;
  205. property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor;
  206. property DrawBorderColor: TColor read FDrawBorderColor write FDrawBorderColor;
  207. property DrawBorderWidth: Integer read FDrawBorderWidth write SetDrawBorderWidth;
  208. property TextColor: TColor read FTextColor write FTextColor;
  209. property TextSelectedColor: TColor
  210. read FTextSelectedColor write FTextSelectedColor;
  211. property LongLineHintTime: Integer read FLongLineHintTime
  212. write SetLongLineHintTime default 0;
  213. property LongLineHintType: TSynCompletionLongHintType read FLongLineHintType
  214. write FLongLineHintType default sclpExtendRightOnly;
  215. property DoubleClickSelects: Boolean read FDoubleClickSelects write FDoubleClickSelects default True;
  216. property ShowSizeDrag: Boolean read FShowSizeDrag write SetShowSizeDrag default False;
  217. property OnDragResized: TNotifyEvent read FOnDragResized write FOnDragResized;
  218. end;
  219. TSynBaseCompletionFormClass = class of TSynBaseCompletionForm;
  220. { TSynCompletionForm }
  221. TSynCompletionForm = class(TSynBaseCompletionForm)
  222. protected
  223. procedure AddCharAtCursor(AUtf8Char: TUTF8Char); override;
  224. procedure DeleteCharBeforeCursor; override;
  225. end;
  226. { TSynBaseCompletion }
  227. TSynBaseCompletion = class(TLazSynMultiEditPlugin)
  228. private
  229. FAutoUseSingleIdent: Boolean;
  230. Form: TSynBaseCompletionForm;
  231. FAddedPersistentCaret: boolean;
  232. FOnExecute: TNotifyEvent;
  233. FWidth: Integer;
  234. function GetCaseSensitive: boolean;
  235. function GetClSelect: TColor;
  236. function GetDoubleClickSelects: Boolean;
  237. function GetLongLineHintTime: Integer;
  238. function GetLongLineHintType: TSynCompletionLongHintType;
  239. function GetOnKeyDown: TKeyEvent;
  240. function GetOnMeasureItem: TSynBaseCompletionMeasureItem;
  241. function GetOnPositionChanged: TNotifyEvent;
  242. function GetShowSizeDrag: Boolean;
  243. procedure SetCaseSensitive(const AValue: boolean);
  244. procedure SetClSelect(const Value: TColor);
  245. function GetCurrentString: string;
  246. function GetItemList: TStrings;
  247. function GetNbLinesInWindow: Integer;
  248. function GetOnCancel: TNotifyEvent;
  249. function GetOnKeyPress: TKeyPressEvent;
  250. function GetOnPaintItem: TSynBaseCompletionPaintItem;
  251. function GetOnValidate: TValidateEvent;
  252. function GetPosition: Integer;
  253. procedure SetCurrentString(const Value: string);
  254. procedure SetDoubleClickSelects(const AValue: Boolean);
  255. procedure SetItemList(const Value: TStrings);
  256. procedure SetLongLineHintTime(const AValue: Integer);
  257. procedure SetLongLineHintType(const AValue: TSynCompletionLongHintType);
  258. procedure SetNbLinesInWindow(const Value: Integer);
  259. procedure SetOnCancel(const Value: TNotifyEvent);
  260. procedure SetOnKeyDown(const AValue: TKeyEvent);
  261. procedure SetOnKeyPress(const Value: TKeyPressEvent);
  262. procedure SetOnMeasureItem(const AValue: TSynBaseCompletionMeasureItem);
  263. procedure SetOnPositionChanged(const AValue: TNotifyEvent);
  264. procedure SetOnPaintItem(const Value: TSynBaseCompletionPaintItem);
  265. procedure SetPosition(const Value: Integer);
  266. procedure SetOnValidate(const Value: TValidateEvent);
  267. function GetOnKeyDelete: TNotifyEvent;
  268. procedure SetOnKeyDelete(const Value: TNotifyEvent);
  269. procedure SetShowSizeDrag(const AValue: Boolean);
  270. procedure SetWidth(Value: Integer);
  271. function GetOnUTF8KeyPress: TUTF8KeyPressEvent;
  272. procedure SetOnUTF8KeyPress(const AValue: TUTF8KeyPressEvent);
  273. function GetFontHeight:integer;
  274. function GetOnSearchPosition:TSynBaseCompletionSearchPosition;
  275. procedure SetOnSearchPosition(NewValue :TSynBaseCompletionSearchPosition);
  276. function GetOnKeyCompletePrefix: TNotifyEvent;
  277. procedure SetOnKeyCompletePrefix(const AValue: TNotifyEvent);
  278. function GetOnKeyNextChar: TNotifyEvent;
  279. procedure SetOnKeyNextChar(const AValue: TNotifyEvent);
  280. function GetOnKeyPrevChar: TNotifyEvent;
  281. procedure SetOnKeyPrevChar(const AValue: TNotifyEvent);
  282. protected
  283. function GetCompletionFormClass: TSynBaseCompletionFormClass; virtual;
  284. public
  285. constructor Create(AOwner: TComponent); override;
  286. destructor Destroy; override;
  287. procedure Execute(s: string; x, y: integer); overload;
  288. procedure Execute(s: string; TopLeft: TPoint); overload;
  289. procedure Execute(s: string; TokenRect: TRect); overload; // Excute below or above the token // may be extended to adjust left corner too
  290. procedure Deactivate;
  291. function IsActive: boolean;
  292. function TheForm: TSynBaseCompletionForm;
  293. property OnKeyDown: TKeyEvent read GetOnKeyDown write SetOnKeyDown;
  294. property OnUTF8KeyPress: TUTF8KeyPressEvent read GetOnUTF8KeyPress
  295. write SetOnUTF8KeyPress;
  296. property OnKeyPress: TKeyPressEvent read GetOnKeyPress write SetOnKeyPress;
  297. property OnKeyDelete: TNotifyEvent read GetOnKeyDelete write SetOnKeyDelete;
  298. property OnValidate: TValidateEvent read GetOnValidate write SetOnValidate;
  299. property OnCancel: TNotifyEvent read GetOnCancel write SetOnCancel;
  300. property CurrentString: string read GetCurrentString write SetCurrentString;
  301. property FontHeight: integer read GetFontHeight;
  302. property ClSelect: TColor read GetClSelect write SetClSelect; deprecated; // use SelectedColor
  303. property NbLinesInWindow: Integer read GetNbLinesInWindow write SetNbLinesInWindow; deprecated;
  304. published
  305. property OnExecute: TNotifyEvent read FOnExecute write FOnExecute;
  306. property OnPaintItem: TSynBaseCompletionPaintItem
  307. read GetOnPaintItem write SetOnPaintItem;
  308. property OnMeasureItem: TSynBaseCompletionMeasureItem read GetOnMeasureItem
  309. write SetOnMeasureItem;
  310. property ItemList: TStrings read GetItemList write SetItemList;
  311. property Position: Integer read GetPosition write SetPosition;
  312. property LinesInWindow: Integer read GetNbLinesInWindow
  313. write SetNbLinesInWindow;
  314. property OnSearchPosition: TSynBaseCompletionSearchPosition
  315. read GetOnSearchPosition write SetOnSearchPosition;
  316. property OnKeyCompletePrefix: TNotifyEvent read GetOnKeyCompletePrefix
  317. write SetOnKeyCompletePrefix;// e.g. Tab
  318. property OnKeyNextChar: TNotifyEvent read GetOnKeyNextChar
  319. write SetOnKeyNextChar;// e.g. arrow right
  320. property OnKeyPrevChar: TNotifyEvent read GetOnKeyPrevChar
  321. write SetOnKeyPrevChar;// e.g. arrow left
  322. property OnPositionChanged: TNotifyEvent read GetOnPositionChanged
  323. write SetOnPositionChanged;
  324. property SelectedColor: TColor read GetClSelect write SetClSelect;
  325. property CaseSensitive: boolean read GetCaseSensitive write SetCaseSensitive;
  326. property Width: Integer read FWidth write SetWidth;
  327. property LongLineHintTime: Integer read GetLongLineHintTime
  328. write SetLongLineHintTime default 0;
  329. property LongLineHintType: TSynCompletionLongHintType read GetLongLineHintType
  330. write SetLongLineHintType default sclpExtendRightOnly;
  331. property DoubleClickSelects: Boolean read GetDoubleClickSelects write SetDoubleClickSelects default True;
  332. property ShowSizeDrag: Boolean read GetShowSizeDrag write SetShowSizeDrag default False;
  333. property AutoUseSingleIdent: Boolean read FAutoUseSingleIdent write FAutoUseSingleIdent;
  334. end;
  335. { TSynCompletion }
  336. TSynCompletion = class(TSynBaseCompletion)
  337. private
  338. FShortCut: TShortCut;
  339. FExecCommandID: TSynEditorCommand;
  340. FEndOfTokenChr: string;
  341. FOnCodeCompletion: TCodeCompletionEvent;
  342. procedure Cancel(Sender: TObject);
  343. procedure Validate(Sender: TObject; KeyChar: TUTF8Char; Shift: TShiftState);
  344. function GetPreviousToken(FEditor: TCustomSynEdit): string;
  345. protected
  346. procedure OnFormPaint(Sender: TObject);
  347. procedure SetEditor(const Value: TCustomSynEdit); override;
  348. procedure DoEditorAdded(AValue: TCustomSynEdit); override;
  349. procedure DoEditorRemoving(AValue: TCustomSynEdit); override;
  350. procedure SetShortCut(Value: TShortCut);
  351. procedure TranslateKey(Sender: TObject; Code: word; SState: TShiftState;
  352. var Data: pointer; var IsStartOfCombo: boolean; var Handled: boolean;
  353. var Command: TSynEditorCommand; FinishComboOnly: Boolean;
  354. var ComboKeyStrokes: TSynEditKeyStrokes);
  355. procedure ProcessSynCommand(Sender: TObject; AfterProcessing: boolean;
  356. var Handled: boolean; var Command: TSynEditorCommand;
  357. var AChar: TUTF8Char; Data: pointer; HandlerData: pointer);
  358. function GetCompletionFormClass: TSynBaseCompletionFormClass; override;
  359. public
  360. constructor Create(AOwner: TComponent); override;
  361. function EditorsCount: integer; deprecated; // use EditorCount
  362. procedure AddCharAtCursor(AUtf8Char: TUTF8Char);
  363. procedure DeleteCharBeforoCursor;
  364. published
  365. property ShortCut: TShortCut read FShortCut write SetShortCut;
  366. property EndOfTokenChr: string read FEndOfTokenChr write FEndOfTokenChr;
  367. property OnCodeCompletion: TCodeCompletionEvent
  368. read FOnCodeCompletion write FOnCodeCompletion;
  369. property ExecCommandID: TSynEditorCommand read FExecCommandID write FExecCommandID;
  370. property Editor;
  371. end;
  372. { TSynAutoComplete }
  373. TSynAutoComplete = class(TLazSynMultiEditPlugin)
  374. private
  375. FExecCommandID: TSynEditorCommand;
  376. FShortCut: TShortCut;
  377. fAutoCompleteList: TStrings;
  378. FEndOfTokenChr: string;
  379. procedure SetAutoCompleteList(List: TStrings);
  380. protected
  381. procedure DoEditorAdded(AValue: TCustomSynEdit); override;
  382. procedure DoEditorRemoving(AValue: TCustomSynEdit); override;
  383. procedure SetShortCut(Value: TShortCut);
  384. function GetPreviousToken(aEditor: TCustomSynEdit): string;
  385. procedure TranslateKey(Sender: TObject; Code: word; SState: TShiftState;
  386. var Data: pointer; var IsStartOfCombo: boolean; var Handled: boolean;
  387. var Command: TSynEditorCommand; FinishComboOnly: Boolean;
  388. var ComboKeyStrokes: TSynEditKeyStrokes);
  389. procedure ProcessSynCommand(Sender: TObject; AfterProcessing: boolean;
  390. var Handled: boolean; var Command: TSynEditorCommand;
  391. var AChar: TUTF8Char; Data: pointer; HandlerData: pointer);
  392. public
  393. constructor Create(AOwner: TComponent); override;
  394. destructor Destroy; override;
  395. procedure Execute(token: string; aEditor: TCustomSynEdit);
  396. function EditorsCount: integer;
  397. function GetTokenList: string;
  398. function GetTokenValue(Token: string): string;
  399. published
  400. property AutoCompleteList: TStrings read fAutoCompleteList
  401. write SetAutoCompleteList;
  402. property EndOfTokenChr: string read FEndOfTokenChr write FEndOfTokenChr;
  403. property ShortCut: TShortCut read FShortCut write SetShortCut;
  404. property ExecCommandID: TSynEditorCommand read FExecCommandID write FExecCommandID;
  405. property Editor;
  406. end;
  407. procedure PrettyTextOut(c: TCanvas; x, y: integer; s: string);
  408. const
  409. ecSynCompletionExecute = ecPluginFirstCompletion + 0;
  410. ecSynAutoCompletionExecute = ecPluginFirstCompletion + 1;
  411. // If extending the list, reserve space in SynEditKeyCmds
  412. ecSynCompletionCount = 2;
  413. implementation
  414. function IsIdentifierChar(p: PChar): boolean; inline;
  415. {$IF FPC_FULLVERSION >= 20701}
  416. var
  417. u: UnicodeString;
  418. i: Integer;
  419. L: SizeUInt;
  420. {$ENDIF}
  421. begin
  422. Result := p^ in ['a'..'z','A'..'Z','0'..'9','_'];
  423. if Result then exit;
  424. {$IF FPC_FULLVERSION >= 20701}
  425. if p^ <= #127 then exit;
  426. i := UTF8CharacterLength(p);
  427. SetLength(u, i);
  428. // wide chars of UTF-16 <= bytes of UTF-8 string
  429. if ConvertUTF8ToUTF16(PWideChar(u), i + 1, p, i, [toInvalidCharToSymbol], L) = trNoError
  430. then begin
  431. SetLength(u, L - 1);
  432. if L > 1 then
  433. Result := TCharacter.IsLetterOrDigit(u, 1);
  434. end;
  435. {$ENDIF}
  436. end;
  437. { TSynCompletionForm }
  438. procedure TSynCompletionForm.AddCharAtCursor(AUtf8Char: TUTF8Char);
  439. begin
  440. inherited AddCharAtCursor(AUtf8Char);
  441. if CurrentEditor <> nil then
  442. (CurrentEditor as TCustomSynEdit).CommandProcessor(ecChar, AUtf8Char, nil);
  443. end;
  444. procedure TSynCompletionForm.DeleteCharBeforeCursor;
  445. begin
  446. if CurrentEditor <> nil then
  447. (CurrentEditor as TCustomSynEdit).CommandProcessor(ecDeleteLastChar, #0, nil);
  448. inherited DeleteCharBeforeCursor;
  449. end;
  450. { TSynBaseCompletionFormSizeDrag }
  451. procedure TSynBaseCompletionFormSizeDrag.MouseDown(Button: TMouseButton; Shift: TShiftState;
  452. X, Y: Integer);
  453. begin
  454. inherited MouseDown(Button, Shift, X, Y);
  455. FMouseDownPos.x := x + Left;
  456. FMouseDownPos.y := y + Top;
  457. FMouseLastPos.x := x + Left;
  458. FMouseLastPos.y := y + Top;
  459. FWinSize.x := TSynBaseCompletionForm(Owner).Width;
  460. FWinSize.y := TSynBaseCompletionForm(Owner).Height;
  461. TSynBaseCompletionForm(Owner).IncHintLock;
  462. MouseCapture := True;
  463. end;
  464. procedure TSynBaseCompletionFormSizeDrag.MouseMove(Shift: TShiftState; X, Y: Integer);
  465. var
  466. F: TSynBaseCompletionForm;
  467. begin
  468. inherited MouseMove(Shift, X, Y);
  469. x := x + Left;
  470. y := y + Top;
  471. if (FMouseDownPos.y < 0) or
  472. ((FMouseLastPos.x = x) and (FMouseLastPos.y = y))
  473. then
  474. exit;
  475. FMouseLastPos.x := x;
  476. FMouseLastPos.y := y;
  477. F := TSynBaseCompletionForm(Owner);
  478. F.Width :=
  479. Max(FWinSize.x + x - FMouseDownPos.x, 100);
  480. F.NbLinesInWindow :=
  481. Max((FWinSize.y + y - FMouseDownPos.y) div F.FontHeight, 3);
  482. end;
  483. procedure TSynBaseCompletionFormSizeDrag.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  484. Y: Integer);
  485. begin
  486. inherited MouseUp(Button, Shift, X, Y);
  487. FMouseDownPos.y := -1;
  488. MouseCapture := False;
  489. TSynBaseCompletionForm(Owner).DecHintLock;
  490. if (FWinSize.x <> TSynBaseCompletionForm(Owner).Width) or
  491. (FWinSize.y <> TSynBaseCompletionForm(Owner).Height)
  492. then
  493. TSynBaseCompletionForm(Owner).DoOnDragResize(Owner);
  494. end;
  495. constructor TSynBaseCompletionFormSizeDrag.Create(TheOwner: TComponent);
  496. begin
  497. inherited Create(TheOwner);
  498. FMouseDownPos.y := -1;
  499. end;
  500. procedure TSynBaseCompletionFormSizeDrag.Paint;
  501. begin
  502. Canvas.Brush.Color := clBtnFace;
  503. Canvas.Brush.Style := bsSolid;
  504. Canvas.FillRect(ClientRect);
  505. Canvas.Pen.Color := clBtnShadow;
  506. Canvas.MoveTo(ClientRect.Right-2, ClientRect.Bottom-1);
  507. Canvas.LineTo(ClientRect.Right-1, ClientRect.Bottom-2);
  508. Canvas.MoveTo(ClientRect.Right-5, ClientRect.Bottom-1);
  509. Canvas.LineTo(ClientRect.Right-1, ClientRect.Bottom-5);
  510. Canvas.MoveTo(ClientRect.Right-8, ClientRect.Bottom-1);
  511. Canvas.LineTo(ClientRect.Right-1, ClientRect.Bottom-8);
  512. end;
  513. { TSynBaseCompletionForm }
  514. constructor TSynBaseCompletionForm.Create(AOwner: Tcomponent);
  515. begin
  516. ControlStyle := ControlStyle + [csNoDesignVisible];
  517. FResizeLock := 1; // prevent DoResize (on Handle Creation) do reset LinesInWindow
  518. FDoubleClickSelects := True;
  519. FHintLock := 0;
  520. BeginFormUpdate;
  521. KeyPreview:= True;
  522. // we have no resource => must be constructed using CreateNew
  523. inherited CreateNew(AOwner, 1);
  524. FItemList := TStringList.Create;
  525. BorderStyle := bsNone;
  526. FormStyle := fsSystemStayOnTop;
  527. Scroll := TScrollBar.Create(self);
  528. Scroll.Kind := sbVertical;
  529. Scroll.OnChange := @ScrollChange;
  530. Scroll.Parent := Self;
  531. Scroll.OnEnter := @ScrollGetFocus;
  532. Scroll.OnScroll := @ScrollScroll;
  533. Scroll.TabStop := False;
  534. Scroll.Visible := True;
  535. //Scroll.Align:=alRight;
  536. SizeDrag := TSynBaseCompletionFormSizeDrag.Create(Self);
  537. SizeDrag.Parent := Self;
  538. SizeDrag.BevelInner := bvNone;
  539. SizeDrag.BevelOuter := bvNone;
  540. SizeDrag.Caption := '';
  541. SizeDrag.AutoSize := False;
  542. SizeDrag.BorderStyle := bsNone;
  543. SizeDrag.Anchors := [akBottom, akRight, akLeft];
  544. SizeDrag.AnchorSideLeft.Side := asrTop;
  545. SizeDrag.AnchorSideLeft.Control := Scroll;
  546. SizeDrag.AnchorSideRight.Side := asrBottom;
  547. SizeDrag.AnchorSideRight.Control := Self;
  548. SizeDrag.AnchorSideBottom.Side := asrBottom;
  549. SizeDrag.AnchorSideBottom.Control := Self;
  550. SizeDrag.Height := Max(7, abs(Font.Height) * 2 div 3);
  551. SizeDrag.Cursor := crSizeNWSE;
  552. SizeDrag.Visible := False;
  553. SizeDrag.OnKeyPress:=@SDKeyPress;
  554. SizeDrag.OnKeyDown:=@SDKeyDown;
  555. SizeDrag.OnUTF8KeyPress:=@SDUtf8KeyPress;
  556. Scroll.Anchors:=[akTop,akRight, akBottom];
  557. Scroll.AnchorSide[akTop].Side := asrTop;
  558. Scroll.AnchorSide[akTop].Control := self;
  559. Scroll.AnchorSide[akRight].Side := asrBottom;
  560. Scroll.AnchorSide[akRight].Control := Self;
  561. Scroll.AnchorSide[akBottom].Side := asrTop;
  562. Scroll.AnchorSide[akBottom].Control := SizeDrag;
  563. DrawBorderWidth := 1;
  564. FTextColor:=clBlack;
  565. FTextSelectedColor:=clWhite;
  566. Caption:='Completion';
  567. Color:=clNone;
  568. FBackgroundColor:=clWhite;
  569. FDrawBorderColor:=clBlack;
  570. FHint := TSynBaseCompletionHint.Create(Self);
  571. FHint.FormStyle := fsSystemStayOnTop;
  572. {$IFDEF HintClickWorkaround}
  573. FHint.OnMouseDown :=@HintWindowMouseDown;
  574. {$ENDIF}
  575. FHintTimer := TTimer.Create(nil);
  576. FHintTimer.OnTimer := @OnHintTimer;
  577. FHintTimer.Interval := 0;
  578. FLongLineHintTime := 0;
  579. FLongLineHintType := sclpExtendRightOnly;
  580. Visible := false;
  581. ClSelect := clHighlight;
  582. TStringList(FItemList).OnChange := @StringListChange;
  583. FNbLinesInWindow := 6;
  584. FontChanged(Font);
  585. ShowHint := False;
  586. EndFormUpdate;
  587. FResizeLock := 0;
  588. end;
  589. procedure TSynBaseCompletionForm.Deactivate;
  590. begin
  591. {$IFDEF VerboseFocus}
  592. DebugLnEnter(['>> TSynBaseCompletionForm.Deactivate ']);
  593. try
  594. {$ENDIF}
  595. // completion box lost focus
  596. // this can happen when a hint window is clicked => ToDo
  597. Visible := False;
  598. FHintTimer.Enabled := False;
  599. FHint.Visible := False;
  600. if Assigned(OnCancel) then OnCancel(Self);
  601. if (FCurrentEditor<>nil) and (TCustomSynEdit(fCurrentEditor).HandleAllocated)
  602. then
  603. SetCaretRespondToFocus(TCustomSynEdit(FCurrentEditor).Handle,true);
  604. {$IFDEF VerboseFocus}
  605. finally
  606. DebugLnExit(['<< TSynBaseCompletionForm.Deactivate ']);
  607. end
  608. {$ENDIF}
  609. end;
  610. destructor TSynBaseCompletionForm.Destroy;
  611. begin
  612. UnRegisterHandlers;
  613. FreeAndNil(Scroll);
  614. FreeAndNil(SizeDrag);
  615. FItemList.Free;
  616. FHintTimer.Free;
  617. FHint.Free;
  618. inherited destroy;
  619. end;
  620. procedure TSynBaseCompletionForm.ShowItemHint(AIndex: Integer);
  621. var
  622. R: TRect;
  623. P: TPoint;
  624. M: TMonitor;
  625. MinLeft: Integer;
  626. begin
  627. FHintTimer.Enabled := False;
  628. if Visible and (AIndex >= 0) and (AIndex < ItemList.Count) and
  629. (FLongLineHintType <> sclpNone) and
  630. (FHintLock = 0)
  631. then begin
  632. // CalcHintRect uses the current index
  633. FHint.Index := AIndex;
  634. // calculate the size
  635. R := FHint.CalcHintRect(Monitor.Width, ItemList[AIndex], nil);
  636. if (R.Right <= Scroll.Left) then begin
  637. FHint.Hide;
  638. Exit;
  639. end;
  640. // calculate the position
  641. M := Monitor;
  642. P := ClientToScreen(Point(0, (AIndex - Scroll.Position) * FFontHeight));
  643. case FLongLineHintType of
  644. // ClientWidth may be too much, if part of the ClientWidth extends to another screen.
  645. sclpExtendHalfLeft: MinLeft := Max(M.Left, P.X - ClientWidth div 2);
  646. sclpExtendUnlimitedLeft: MinLeft := M.Left;
  647. else MinLeft := P.X;
  648. end;
  649. P.X := Max(MinLeft,
  650. Min(P.X, // Start at drop-down Left boundary
  651. M.Left + M.Width - R.Right - 1
  652. ) // Or push left, if hitting right Monitor border
  653. );
  654. P.Y := Max(M.Top, Min(P.Y, M.Top + M.Height - R.Bottom - 1));
  655. // actually Width and Height
  656. R.Right := Min(r.Right, M.Left + M.Width - 1 - P.X);
  657. R.Bottom := Min(r.Bottom, M.Top + M.Height - 1 - P.Y);
  658. FHint.HintRect := Bounds(P.X, P.Y, R.Right, R.Bottom);
  659. if (not FHint.IsVisible) and (FLongLineHintTime > 0) then
  660. FHintTimer.Enabled := True
  661. else
  662. OnHintTimer(nil);
  663. end
  664. else begin
  665. FHint.Hide;
  666. end;
  667. end;
  668. procedure TSynBaseCompletionForm.OnHintTimer(Sender: TObject);
  669. begin
  670. FHintTimer.Enabled := False;
  671. FHint.ActivateHint(ItemList[FHint.Index]);
  672. FHint.Invalidate;
  673. end;
  674. procedure TSynBaseCompletionForm.KeyDown(var Key: Word; Shift: TShiftState);
  675. var
  676. i: integer;
  677. Handled: Boolean;
  678. begin
  679. {$IFDEF VerboseKeys}
  680. DebugLnEnter(['TSynBaseCompletionForm.KeyDown ',Key,' Shift=',ssShift in Shift,' Ctrl=',ssCtrl in Shift,' Alt=',ssAlt in Shift]);
  681. try
  682. {$ENDIF}
  683. //debugln('TSynBaseCompletionForm.KeyDown A Key=',dbgs(Key));
  684. inherited KeyDown(Key,Shift);
  685. if Key=VK_UNKNOWN then exit;
  686. Handled:=true;
  687. case Key of
  688. // added the VK_XXX codes to make it more readable / maintainable
  689. VK_RETURN:
  690. if Assigned(OnValidate) then
  691. OnValidate(Self, '', Shift);
  692. VK_ESCAPE:
  693. if Assigned(OnCancel) then OnCancel(Self);
  694. // I do not think there is a worst way to do this, but laziness rules :-)
  695. VK_PRIOR:
  696. for i := 1 to NbLinesInWindow do
  697. SelectPrec;
  698. VK_NEXT:
  699. for i := 1 to NbLinesInWindow do
  700. SelectNext;
  701. VK_END:
  702. Position := ItemList.count - 1;
  703. VK_HOME:
  704. Position := 0;
  705. VK_UP:
  706. if ssCtrl in Shift then
  707. Position := 0
  708. else
  709. SelectPrec;
  710. VK_DOWN:
  711. if ssCtrl in Shift then
  712. Position := ItemList.count - 1
  713. else
  714. SelectNext;
  715. VK_BACK:
  716. if (Shift = []) and (Length(CurrentString) > 0) then begin
  717. if Assigned(OnKeyDelete) then OnKeyDelete(Self);
  718. DeleteCharBeforeCursor;
  719. end;
  720. VK_TAB:
  721. begin
  722. if Assigned(OnKeyCompletePrefix) then OnKeyCompletePrefix(Self);
  723. end;
  724. VK_LEFT:
  725. begin
  726. if (Shift = []) and (Length(CurrentString) > 0) then begin
  727. if Assigned(OnKeyPrevChar) then OnKeyPrevChar(Self);
  728. end;
  729. end;
  730. VK_Right:
  731. begin
  732. if Assigned(OnKeyNextChar) then OnKeyNextChar(Self);
  733. end;
  734. else
  735. Handled:=false;
  736. end;
  737. if Handled then Key:=VK_UNKNOWN;
  738. Invalidate;
  739. {$IFDEF VerboseKeys}
  740. finally
  741. DebugLnExit(['TSynBaseCompletionForm.KeyDown ',Key,' Shift=',ssShift in Shift,' Ctrl=',ssCtrl in Shift,' Alt=',ssAlt in Shift]);
  742. end;
  743. {$ENDIF}
  744. end;
  745. procedure TSynBaseCompletionForm.KeyPress(var Key: char);
  746. begin
  747. debugln('TSynBaseCompletionForm.KeyPress A Key="',DbgStr(Key),'"');
  748. if Assigned(OnKeyPress) then
  749. OnKeyPress(Self, Key);
  750. debugln('TSynBaseCompletionForm.KeyPress B Key="',DbgStr(Key),'"');
  751. if Key=#0 then exit;
  752. case key of //
  753. #33..'z':
  754. begin
  755. if Key<>#0 then
  756. AddCharAtCursor(key);
  757. Key:=#0;
  758. end;
  759. #8: ;
  760. else
  761. if (ord(key)>=32) and Assigned(OnValidate) then begin
  762. OnValidate(Self, Key, []);
  763. Key:=#0;
  764. end else begin
  765. if Assigned(OnCancel) then OnCancel(Self);
  766. Key:=#0;
  767. end;
  768. end; // case
  769. Invalidate;
  770. //debugln('TSynBaseCompletionForm.KeyPress END Key="',DbgStr(Key),'"');
  771. end;
  772. procedure TSynBaseCompletionForm.AddCharAtCursor(AUtf8Char: TUTF8Char);
  773. begin
  774. CurrentString := CurrentString + AUtf8Char;
  775. end;
  776. procedure TSynBaseCompletionForm.DeleteCharBeforeCursor;
  777. begin
  778. CurrentString := UTF8Copy(CurrentString, 1, UTF8Length(CurrentString) - 1);
  779. end;
  780. {$IFDEF HintClickWorkaround}
  781. procedure TSynBaseCompletionForm.HintWindowMouseDown(Sender: TObject;
  782. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  783. var
  784. p: TPoint;
  785. begin
  786. p := ScreenToClient(FHint.ClientToScreen(Point(X, Y)));
  787. MouseDown(Button, Shift, p.X, p.Y);
  788. end;
  789. {$ENDIF}
  790. procedure TSynBaseCompletionForm.MouseDown(Button: TMouseButton;
  791. Shift: TShiftState; X, Y: Integer);
  792. var
  793. OldPosition: Integer;
  794. begin
  795. OldPosition := Position;
  796. y := (y - 1) div FFontHeight;
  797. Position := Scroll.Position + y;
  798. if DoubleClickSelects and (ssDouble in Shift) and (Position = OldPosition) and
  799. Assigned(OnValidate)
  800. then
  801. OnValidate(Self, '', Shift);
  802. end;
  803. procedure TSynBaseCompletionForm.MouseMove(Shift: TShiftState; X,Y: Integer);
  804. begin
  805. if ((Scroll.Visible) and (x > Scroll.Left)) or
  806. (y < DrawBorderWidth) or (y >= ClientHeight - DrawBorderWidth)
  807. then
  808. exit;
  809. Y := (Y - DrawBorderWidth) div FFontHeight;
  810. ShowItemHint(Scroll.Position + Y);
  811. end;
  812. procedure TSynBaseCompletionForm.Paint;
  813. var
  814. i, Ind: integer;
  815. PaintWidth, YYY, RightC, BottomC: Integer;
  816. Capt: String;
  817. begin
  818. //Writeln('[TSynBaseCompletionForm.Paint]');
  819. // update scroll bar
  820. Scroll.Enabled := ItemList.Count > NbLinesInWindow;
  821. Scroll.Visible := (ItemList.Count > NbLinesInWindow) or ShowSizeDrag;
  822. if Scroll.Visible and Scroll.Enabled then
  823. begin
  824. Scroll.Max := ItemList.Count - 1;
  825. Scroll.LargeChange := NbLinesInWindow;
  826. Scroll.PageSize := NbLinesInWindow;
  827. end
  828. else
  829. begin
  830. Scroll.PageSize := 1;
  831. Scroll.Max := 0;
  832. end;
  833. PaintWidth := Width - Scroll.Width;
  834. RightC := PaintWidth - 2 * DrawBorderWidth;
  835. //DebugLn(['TSynBaseCompletionForm.Paint NbLinesInWindow=',NbLinesInWindow,' ItemList.Count=',ItemList.Count]);
  836. for i := 0 to Min(NbLinesInWindow - 1, ItemList.Count - Scroll.Position - 1) do
  837. begin
  838. YYY := DrawBorderWidth + FFontHeight * i;
  839. BottomC := (FFontHeight * (i + 1))+1;
  840. if i + Scroll.Position = Position then
  841. begin
  842. Canvas.Brush.Color := clSelect;
  843. Canvas.Pen.Color := clSelect;
  844. Canvas.Rectangle(DrawBorderWidth, YYY, RightC, BottomC);
  845. Canvas.Pen.Color := clBlack;
  846. Canvas.Font.Color := TextSelectedColor;
  847. Hint := ItemList[Position];
  848. end
  849. else
  850. begin
  851. Canvas.Brush.Color := BackgroundColor;
  852. Canvas.Font.Color := TextColor;
  853. Canvas.FillRect(Rect(DrawBorderWidth, YYY, RightC, BottomC));
  854. end;
  855. //DebugLn(['TSynBaseCompletionForm.Paint ',i,' ',ItemList[Scroll.Position + i]]);
  856. Ind := i + Scroll.Position;
  857. Capt := ItemList[Scroll.Position + i];
  858. if not Assigned(OnPaintItem)
  859. or not OnPaintItem(Capt, Canvas, DrawBorderWidth, YYY, Ind = Position, Ind)
  860. then
  861. Canvas.TextOut(DrawBorderWidth+2, YYY, Capt);
  862. end;
  863. // paint the rest of the background
  864. if NbLinesInWindow > ItemList.Count - Scroll.Position then
  865. begin
  866. Canvas.brush.color := color;
  867. i:=(FFontHeight * ItemList.Count)+1;
  868. Canvas.FillRect(Rect(0, i, PaintWidth, Height));
  869. end;
  870. // draw a rectangle around the window
  871. if DrawBorderWidth > 0 then
  872. begin
  873. Canvas.Pen.Color := DrawBorderColor;
  874. Canvas.Pen.Width := DrawBorderWidth;
  875. Canvas.Moveto(0, 0);
  876. Canvas.LineTo(Width - 1, 0);
  877. Canvas.LineTo(Width - 1, Height - 1);
  878. Canvas.LineTo(0, Height - 1);
  879. Canvas.LineTo(0, 0);
  880. end;
  881. end;
  882. function TSynBaseCompletionForm.Focused: Boolean;
  883. begin
  884. Result:=(inherited Focused) or SizeDrag.Focused;
  885. end;
  886. procedure TSynBaseCompletionForm.AppDeactivated(Sender: TObject);
  887. begin
  888. {$IFDEF VerboseFocus}
  889. DebugLn(['>> TSynBaseCompletionForm.AppDeactivated ']);
  890. {$ENDIF}
  891. Deactivate;
  892. end;
  893. procedure TSynBaseCompletionForm.ScrollChange(Sender: TObject);
  894. begin
  895. if Position < Scroll.Position then
  896. Position := Scroll.Position
  897. else
  898. if Position > Scroll.Position + NbLinesInWindow - 1 then
  899. Position := Scroll.Position + NbLinesInWindow - 1;
  900. Invalidate;
  901. end;
  902. procedure TSynBaseCompletionForm.ScrollGetFocus(Sender: TObject);
  903. begin
  904. ActiveControl := nil;
  905. end;
  906. procedure TSynBaseCompletionForm.ScrollScroll(Sender: TObject; ScrollCode: TScrollCode;
  907. var ScrollPos: Integer);
  908. begin
  909. if ScrollPos > (Scroll.Max - Scroll.PageSize) + 1 then
  910. ScrollPos := Scroll.Max - Scroll.PageSize + 1;
  911. FHint.Hide;
  912. ShowItemHint(Position);
  913. end;
  914. procedure TSynBaseCompletionForm.SelectNext;
  915. begin
  916. if Position < ItemList.Count - 1 then
  917. Position := Position + 1;
  918. end;
  919. procedure TSynBaseCompletionForm.SelectPrec;
  920. begin
  921. if Position > 0 then
  922. Position := Position - 1;
  923. end;
  924. procedure TSynBaseCompletionForm.DoEditorKeyDown(Sender: TObject; var Key: Word;
  925. Shift: TShiftState);
  926. begin
  927. if (not Visible) or (FCurrentEditor = nil) or (Sender <> FCurrentEditor) then exit;
  928. KeyDown(Key, Shift);
  929. Key := 0;
  930. end;
  931. procedure TSynBaseCompletionForm.DoEditorKeyPress(Sender: TObject; var Key: char);
  932. begin
  933. if (not Visible) or (FCurrentEditor = nil) or (Sender <> FCurrentEditor) then exit;
  934. KeyPress(Key);
  935. Key := #0;
  936. end;
  937. procedure TSynBaseCompletionForm.DoEditorUtf8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
  938. begin
  939. if (not Visible) or (FCurrentEditor = nil) or (Sender <> FCurrentEditor) then exit;
  940. UTF8KeyPress(UTF8Key);
  941. UTF8Key := '';
  942. end;
  943. procedure TSynBaseCompletionForm.SDKeyDown(Sender: TObject; var Key: Word;
  944. Shift: TShiftState);
  945. begin
  946. KeyDown(key,shift);
  947. end;
  948. procedure TSynBaseCompletionForm.SDKeyPress(Sender: TObject; var Key: char);
  949. begin
  950. KeyPress(key);
  951. end;
  952. procedure TSynBaseCompletionForm.SDUtf8KeyPress(Sender: TObject;
  953. var UTF8Key: TUTF8Char);
  954. begin
  955. UTF8KeyPress(UTF8Key);
  956. end;
  957. procedure TSynBaseCompletionForm.UTF8KeyPress(var UTF8Key: TUTF8Char);
  958. begin
  959. {$IFDEF VerboseKeys}
  960. debugln('TSynBaseCompletionForm.UTF8KeyPress A UTF8Key="',DbgStr(UTF8Key),'" ',dbgsName(TObject(TMethod(OnUTF8KeyPress).Data)));
  961. {$ENDIF}
  962. if Assigned(OnUTF8KeyPress) then
  963. OnUTF8KeyPress(Self, UTF8Key);
  964. if UTF8Key='' then
  965. exit;
  966. if UTF8Key=#8 then
  967. begin
  968. // backspace
  969. end
  970. else
  971. if (Length(UTF8Key)>=1) and (not IsIdentifierChar(@UTF8Key[1])) then
  972. begin
  973. // non identifier character
  974. // if it is special key then eat it
  975. if (Length(UTF8Key) = 1) and (UTF8Key[1] < #32) then
  976. begin
  977. if Assigned(OnCancel) then
  978. OnCancel(Self);
  979. end
  980. else
  981. if Assigned(OnValidate) then
  982. OnValidate(Self, UTF8Key, []);
  983. UTF8Key := '';
  984. end
  985. else
  986. if (UTF8Key<>'') then
  987. begin
  988. // identifier character
  989. AddCharAtCursor(UTF8Key);
  990. UTF8Key := '';
  991. end;
  992. {$IFDEF VerboseKeys}
  993. debugln('TSynBaseCompletionForm.UTF8KeyPress END UTF8Key="',DbgStr(UTF8Key),'"');
  994. {$ENDIF}
  995. end;
  996. procedure TSynBaseCompletionForm.SetCurrentString(const Value: string);
  997. var
  998. i: integer;
  999. begin
  1000. FCurrentString := Value;
  1001. //debugln('TSynBaseCompletionForm.SetCurrentString FCurrentString=',FCurrentString);
  1002. if Assigned(FOnSearchPosition) then begin
  1003. i:=Position;
  1004. FOnSearchPosition(i);
  1005. Position:=i;
  1006. end else begin
  1007. if FCaseSensitive then begin
  1008. for i := 0 to Pred(ItemList.Count) do
  1009. if 0 = CompareStr(fCurrentString,
  1010. Copy(ItemList[i], 1, Length(fCurrentString)))
  1011. then begin
  1012. Position := i;
  1013. break;
  1014. end;
  1015. end else begin
  1016. for i := 0 to Pred(ItemList.Count) do
  1017. if 0 = WideCompareText(UTF8Decode(fCurrentString),
  1018. UTF8Decode(Copy(ItemList[i], 1, Length(fCurrentString))))
  1019. then begin
  1020. Position := i;
  1021. break;
  1022. end;
  1023. end;
  1024. end;
  1025. end;
  1026. procedure TSynBaseCompletionForm.DoOnResize;
  1027. begin
  1028. inherited DoOnResize;
  1029. if ([csLoading,csDestroying]*ComponentState<>[]) or (Scroll=nil) then exit;
  1030. if (fFontHeight > 0) and (FResizeLock = 0) then
  1031. begin
  1032. FNbLinesInWindow := (Height-2*DrawBorderWidth+(fFontHeight-1)) div fFontHeight;
  1033. Invalidate;
  1034. end;
  1035. end;
  1036. procedure TSynBaseCompletionForm.SetBackgroundColor(const AValue: TColor);
  1037. begin
  1038. if FBackgroundColor <> AValue then
  1039. begin
  1040. FBackgroundColor := AValue;
  1041. Color := AValue;
  1042. FHint.Color := AValue;
  1043. end;
  1044. end;
  1045. procedure TSynBaseCompletionForm.FontChanged(Sender: TObject);
  1046. var
  1047. TextMetric: TTextMetric;
  1048. begin
  1049. inc(FResizeLock); // prevent DoResize from recalculating NbLinesInWindow
  1050. try
  1051. inherited;
  1052. FillChar(TextMetric{%H-},SizeOf(TextMetric),0);
  1053. GetTextMetrics(Canvas.Handle, TextMetric);
  1054. FFontHeight := TextMetric.tmHeight+2;
  1055. SetNblinesInWindow(FNbLinesInWindow);
  1056. SizeDrag.Height := Max(7, FFontHeight * 2 div 3);
  1057. finally
  1058. dec(FResizeLock);
  1059. end;
  1060. end;
  1061. procedure TSynBaseCompletionForm.WMMouseWheel(var Msg: TLMMouseEvent);
  1062. const
  1063. WHEEL_DELTA = 120;
  1064. var
  1065. WheelClicks: Integer;
  1066. begin
  1067. Inc(FMouseWheelAccumulator, Msg.WheelDelta);
  1068. WheelClicks := FMouseWheelAccumulator div WHEEL_DELTA;
  1069. FMouseWheelAccumulator := FMouseWheelAccumulator - WheelClicks * WHEEL_DELTA;
  1070. WheelClicks := WheelClicks * Mouse.WheelScrollLines;
  1071. Scroll.Position := Max(0, Min(FItemList.Count - NbLinesInWindow, Scroll.Position - WheelClicks));
  1072. end;
  1073. procedure TSynBaseCompletionForm.SetLongLineHintTime(const AValue: Integer);
  1074. begin
  1075. if FLongLineHintTime = AValue then exit;
  1076. FLongLineHintTime := AValue;
  1077. FHintTimer.Interval := AValue;
  1078. end;
  1079. procedure TSynBaseCompletionForm.EditorStatusChanged(Sender: TObject;
  1080. Changes: TSynStatusChanges);
  1081. begin
  1082. if (scTopLine in Changes) and Assigned(OnCancel) then
  1083. OnCancel(Self);
  1084. end;
  1085. procedure TSynBaseCompletionForm.SetShowSizeDrag(const AValue: Boolean);
  1086. begin
  1087. if FShowSizeDrag = AValue then exit;
  1088. FShowSizeDrag := AValue;
  1089. SizeDrag.Visible := AValue;
  1090. end;
  1091. procedure TSynBaseCompletionForm.RegisterHandlers(EditOnly: Boolean);
  1092. begin
  1093. if FCurrentEditor <> nil then begin
  1094. FCurrentEditor.RegisterStatusChangedHandler
  1095. (@EditorStatusChanged, [scTopLine]);
  1096. // Catch Editor events. Some Widgetset may report keys to the editor,
  1097. // if the user types faster, then the app can open the form
  1098. FCurrentEditor.RegisterBeforeKeyDownHandler(@DoEditorKeyDown);
  1099. FCurrentEditor.RegisterBeforeKeyPressHandler(@DoEditorKeyPress);
  1100. FCurrentEditor.RegisterBeforeUtf8KeyPressHandler(@DoEditorUtf8KeyPress);
  1101. end;
  1102. if not EditOnly then
  1103. Application.AddOnDeactivateHandler(@AppDeactivated);
  1104. end;
  1105. procedure TSynBaseCompletionForm.UnRegisterHandlers(EditOnly: Boolean);
  1106. begin
  1107. if FCurrentEditor <> nil then begin
  1108. FCurrentEditor.UnRegisterStatusChangedHandler(@EditorStatusChanged);
  1109. FCurrentEditor.UnregisterBeforeKeyDownHandler(@DoEditorKeyDown);
  1110. FCurrentEditor.UnregisterBeforeKeyPressHandler(@DoEditorKeyPress);
  1111. FCurrentEditor.UnregisterBeforeUtf8KeyPressHandler(@DoEditorUtf8KeyPress);
  1112. end;
  1113. if not EditOnly then
  1114. Application.RemoveOnDeactivateHandler(@AppDeactivated);
  1115. end;
  1116. procedure TSynBaseCompletionForm.SetCurrentEditor(const AValue: TCustomSynEdit);
  1117. begin
  1118. if FCurrentEditor = AValue then exit;
  1119. UnRegisterHandlers(True);
  1120. FCurrentEditor := AValue;
  1121. if Visible then
  1122. RegisterHandlers(True);
  1123. end;
  1124. procedure TSynBaseCompletionForm.SetDrawBorderWidth(const AValue: Integer);
  1125. begin
  1126. if FDrawBorderWidth = AValue then exit;
  1127. FDrawBorderWidth := AValue;
  1128. NbLinesInWindow := NbLinesInWindow;
  1129. Scroll.BorderSpacing.Top := FDrawBorderWidth;
  1130. Scroll.BorderSpacing.Right := FDrawBorderWidth;
  1131. if SizeDrag.Visible then
  1132. Scroll.BorderSpacing.Bottom := 0
  1133. else
  1134. Scroll.BorderSpacing.Bottom := FDrawBorderWidth;
  1135. SizeDrag.BorderSpacing.Right := FDrawBorderWidth;
  1136. SizeDrag.BorderSpacing.Bottom := FDrawBorderWidth;
  1137. end;
  1138. procedure TSynBaseCompletionForm.SetVisible(Value: Boolean);
  1139. begin
  1140. if Visible = Value then exit;;
  1141. if Value then
  1142. RegisterHandlers
  1143. else
  1144. UnRegisterHandlers;
  1145. inherited SetVisible(Value);
  1146. end;
  1147. procedure TSynBaseCompletionForm.IncHintLock;
  1148. begin
  1149. inc(FHintLock);
  1150. FHint.Hide
  1151. end;
  1152. procedure TSynBaseCompletionForm.DecHintLock;
  1153. begin
  1154. dec(FHintLock);
  1155. if FHintLock = 0 then
  1156. ShowItemHint(Position);
  1157. end;
  1158. procedure TSynBaseCompletionForm.DoOnDragResize(Sender: TObject);
  1159. begin
  1160. if assigned(FOnDragResized) then
  1161. FOnDragResized(Sender);
  1162. end;
  1163. procedure TSynBaseCompletionForm.SetItemList(const Value: TStrings);
  1164. begin
  1165. FItemList.Assign(Value);
  1166. if Position>=FItemList.Count then Position:=-1;
  1167. Invalidate;
  1168. end;
  1169. procedure TSynBaseCompletionForm.SetNbLinesInWindow(
  1170. const Value: Integer);
  1171. begin
  1172. inc(FResizeLock); // prevent DoResize from recalculating NbLinesInWindow
  1173. try
  1174. FNbLinesInWindow := Value;
  1175. Height := fFontHeight * NbLinesInWindow + 2*DrawBorderWidth;
  1176. finally
  1177. dec(FResizeLock);
  1178. end;
  1179. end;
  1180. procedure TSynBaseCompletionForm.SetPosition(const Value: Integer);
  1181. begin
  1182. if Value < ItemList.Count then begin
  1183. if FPosition <> Value then begin
  1184. FPosition := Value;
  1185. if Position < Scroll.Position then
  1186. Scroll.Position := Position
  1187. else if Scroll.Position < Position - NbLinesInWindow + 1 then
  1188. Scroll.Position := Position - NbLinesInWindow + 1;
  1189. Invalidate;
  1190. if Assigned(OnPositionChanged) then OnPositionChanged(Self);
  1191. end;
  1192. end;
  1193. if Showing then
  1194. ShowItemHint(Position);
  1195. end;
  1196. procedure TSynBaseCompletionForm.StringListChange(Sender: TObject);
  1197. begin
  1198. if ItemList.Count - NbLinesInWindow < 0 then
  1199. Scroll.Max := 0
  1200. else
  1201. Scroll.Max := ItemList.Count - NbLinesInWindow;
  1202. Position := Position;
  1203. end;
  1204. { TSynBaseCompletion }
  1205. constructor TSynBaseCompletion.Create(AOwner: TComponent);
  1206. begin
  1207. FWidth := 262;
  1208. inherited Create(AOwner);
  1209. Form := GetCompletionFormClass.Create(nil); // Do not create with owner, or the designer will make it visible
  1210. Form.Width := FWidth;
  1211. FAutoUseSingleIdent := True;
  1212. end;
  1213. destructor TSynBaseCompletion.Destroy;
  1214. begin
  1215. inherited Destroy;
  1216. FreeAndNil(Form);
  1217. end;
  1218. function TSynBaseCompletion.GetOnUTF8KeyPress: TUTF8KeyPressEvent;
  1219. begin
  1220. Result:=Form.OnUTF8KeyPress;
  1221. end;
  1222. procedure TSynBaseCompletion.SetOnUTF8KeyPress(
  1223. const AValue: TUTF8KeyPressEvent);
  1224. begin
  1225. Form.OnUTF8KeyPress:=AValue;
  1226. end;
  1227. function TSynBaseCompletion.GetFontHeight:integer;
  1228. begin
  1229. Result:=Form.FontHeight;
  1230. end;
  1231. function TSynBaseCompletion.GetOnSearchPosition:TSynBaseCompletionSearchPosition;
  1232. begin
  1233. Result:=Form.OnSearchPosition;
  1234. end;
  1235. procedure TSynBaseCompletion.SetOnSearchPosition(
  1236. NewValue :TSynBaseCompletionSearchPosition);
  1237. begin
  1238. Form.OnSearchPosition:=NewValue;
  1239. end;
  1240. function TSynBaseCompletion.GetOnKeyCompletePrefix: TNotifyEvent;
  1241. begin
  1242. Result:=Form.OnKeyCompletePrefix;
  1243. end;
  1244. procedure TSynBaseCompletion.SetOnKeyCompletePrefix(const AValue: TNotifyEvent);
  1245. begin
  1246. Form.OnKeyCompletePrefix:=AValue;
  1247. end;
  1248. function TSynBaseCompletion.GetOnKeyNextChar: TNotifyEvent;
  1249. begin
  1250. Result:=Form.OnKeyNextChar;
  1251. end;
  1252. procedure TSynBaseCompletion.SetOnKeyNextChar(const AValue: TNotifyEvent);
  1253. begin
  1254. Form.OnKeyNextChar:=AValue;
  1255. end;
  1256. function TSynBaseCompletion.GetOnKeyPrevChar: TNotifyEvent;
  1257. begin
  1258. Result:=Form.OnKeyPrevChar;
  1259. end;
  1260. procedure TSynBaseCompletion.SetOnKeyPrevChar(const AValue: TNotifyEvent);
  1261. begin
  1262. Form.OnKeyPrevChar:=AValue;
  1263. end;
  1264. function TSynBaseCompletion.GetCompletionFormClass: TSynBaseCompletionFormClass;
  1265. begin
  1266. Result := TSynBaseCompletionForm;
  1267. end;
  1268. procedure TSynBaseCompletion.Execute(s: string; x, y: integer);
  1269. var
  1270. CurSynEdit: TCustomSynEdit;
  1271. begin
  1272. //writeln('TSynBaseCompletion.Execute ',Form.CurrentEditor.Name);
  1273. //Todo: This is dangerous, if other plugins also change/changed the flag.
  1274. FAddedPersistentCaret := False;
  1275. CurrentString := s;
  1276. if Assigned(OnExecute) then
  1277. OnExecute(Self);
  1278. if (ItemList.Count=1) and Assigned(OnValidate) and FAutoUseSingleIdent then begin
  1279. OnValidate(Form, '', []);
  1280. exit;
  1281. end;
  1282. if (ItemList.Count=0) and Assigned(OnCancel) then begin
  1283. OnCancel(Form);
  1284. exit;
  1285. end;
  1286. if (Form.CurrentEditor is TCustomSynEdit) then begin
  1287. CurSynEdit:=TCustomSynEdit(Form.CurrentEditor);
  1288. FAddedPersistentCaret := not(eoPersistentCaret in CurSynEdit.Options);
  1289. if FAddedPersistentCaret then
  1290. CurSynEdit.Options:=CurSynEdit.Options+[eoPersistentCaret];
  1291. end;
  1292. Form.SetBounds(x,y,Form.Width,Form.Height);
  1293. Form.Show;
  1294. Form.Position := Form.Position;
  1295. end;
  1296. procedure TSynBaseCompletion.Execute(s: string; TopLeft: TPoint);
  1297. begin
  1298. Execute(s, TopLeft.x, TopLeft.y);
  1299. end;
  1300. procedure TSynBaseCompletion.Execute(s: string; TokenRect: TRect);
  1301. var
  1302. SpaceBelow, SpaceAbove: Integer;
  1303. Mon: TMonitor;
  1304. begin
  1305. Mon := Screen.MonitorFromPoint(TokenRect.TopLeft);
  1306. if Mon <> nil then
  1307. TokenRect.Left := Min(TokenRect.Left, Mon.Left + Mon.Width - Form.Width);
  1308. SpaceBelow := Mon.Height - TokenRect.Bottom;
  1309. SpaceAbove := TokenRect.Top - Mon.Top;
  1310. if Form.Height < SpaceBelow then
  1311. Execute(s, TokenRect.Left, TokenRect.Bottom)
  1312. else
  1313. if Form.Height < SpaceAbove then
  1314. Execute(s, TokenRect.Left, TokenRect.Top - Form.Height)
  1315. else
  1316. begin
  1317. if SpaceBelow > SpaceAbove then begin
  1318. Form.NbLinesInWindow := Max(SpaceBelow div Form.FontHeight, 3); // temporary height
  1319. Execute(s, TokenRect.Left, TokenRect.Bottom);
  1320. end else begin
  1321. Form.NbLinesInWindow := Max(SpaceAbove div Form.FontHeight, 3); // temporary height
  1322. Execute(s, TokenRect.Left, TokenRect.Top - Form.Height);
  1323. end;;
  1324. end;
  1325. end;
  1326. function TSynBaseCompletion.GetCurrentString: string;
  1327. begin
  1328. result := Form.CurrentString;
  1329. end;
  1330. function TSynBaseCompletion.GetItemList: TStrings;
  1331. begin
  1332. result := Form.ItemList;
  1333. end;
  1334. function TSynBaseCompletion.GetNbLinesInWindow: Integer;
  1335. begin
  1336. Result := Form.NbLinesInWindow;
  1337. end;
  1338. function TSynBaseCompletion.GetOnCancel: TNotifyEvent;
  1339. begin
  1340. Result := Form.OnCancel;
  1341. end;
  1342. function TSynBaseCompletion.GetOnKeyPress: TKeyPressEvent;
  1343. begin
  1344. Result := Form.OnKeyPress;
  1345. end;
  1346. function TSynBaseCompletion.GetOnPaintItem: TSynBaseCompletionPaintItem;
  1347. begin
  1348. Result := Form.OnPaintItem;
  1349. end;
  1350. function TSynBaseCompletion.GetOnValidate: TValidateEvent;
  1351. begin
  1352. Result := Form.OnValidate;
  1353. end;
  1354. function TSynBaseCompletion.GetPosition: Integer;
  1355. begin
  1356. Result := Form.Position;
  1357. end;
  1358. procedure TSynBaseCompletion.SetCurrentString(const Value: string);
  1359. begin
  1360. form.CurrentString := Value;
  1361. end;
  1362. procedure TSynBaseCompletion.SetDoubleClickSelects(const AValue: Boolean);
  1363. begin
  1364. Form.DoubleClickSelects := AValue;
  1365. end;
  1366. procedure TSynBaseCompletion.SetItemList(const Value: TStrings);
  1367. begin
  1368. form.ItemList := Value;
  1369. end;
  1370. procedure TSynBaseCompletion.SetLongLineHintTime(const AValue: Integer);
  1371. begin
  1372. Form.LongLineHintTime := AValue;
  1373. end;
  1374. procedure TSynBaseCompletion.SetLongLineHintType(const AValue: TSynCompletionLongHintType);
  1375. begin
  1376. Form.LongLineHintType := AValue;
  1377. end;
  1378. procedure TSynBaseCompletion.SetNbLinesInWindow(const Value: Integer);
  1379. begin
  1380. form.NbLinesInWindow := Value;
  1381. end;
  1382. procedure TSynBaseCompletion.SetOnCancel(const Value: TNotifyEvent);
  1383. begin
  1384. form.OnCancel := Value;
  1385. end;
  1386. procedure TSynBaseCompletion.SetOnKeyDown(const AValue: TKeyEvent);
  1387. begin
  1388. Form.OnKeyDown:=AValue;
  1389. end;
  1390. procedure TSynBaseCompletion.SetOnKeyPress(const Value: TKeyPressEvent);
  1391. begin
  1392. form.OnKeyPress := Value;
  1393. end;
  1394. procedure TSynBaseCompletion.SetOnMeasureItem(
  1395. const AValue: TSynBaseCompletionMeasureItem);
  1396. begin
  1397. Form.OnMeasureItem := AValue;
  1398. end;
  1399. procedure TSynBaseCompletion.SetOnPositionChanged(const AValue: TNotifyEvent);
  1400. begin
  1401. Form.OnPositionChanged := AValue;
  1402. end;
  1403. procedure TSynBaseCompletion.SetOnPaintItem(const Value: TSynBaseCompletionPaintItem);
  1404. begin
  1405. form.OnPaintItem := Value;
  1406. end;
  1407. procedure TSynBaseCompletion.SetPosition(const Value: Integer);
  1408. begin
  1409. form.Position := Value;
  1410. end;
  1411. procedure TSynBaseCompletion.SetOnValidate(const Value: TValidateEvent);
  1412. begin
  1413. form.OnValidate := Value;
  1414. end;
  1415. function TSynBaseCompletion.GetClSelect: TColor;
  1416. begin
  1417. Result := Form.ClSelect;
  1418. end;
  1419. function TSynBaseCompletion.GetDoubleClickSelects: Boolean;
  1420. begin
  1421. Result := Form.DoubleClickSelects;
  1422. end;
  1423. function TSynBaseCompletion.GetLongLineHintTime: Integer;
  1424. begin
  1425. Result := Form.LongLineHintTime;
  1426. end;
  1427. function TSynBaseCompletion.GetLongLineHintType: TSynCompletionLongHintType;
  1428. begin
  1429. Result := Form.LongLineHintType;
  1430. end;
  1431. function TSynBaseCompletion.GetOnKeyDown: TKeyEvent;
  1432. begin
  1433. Result:=Form.OnKeyDown;
  1434. end;
  1435. function TSynBaseCompletion.GetCaseSensitive: boolean;
  1436. begin
  1437. Result := Form.CaseSensitive;
  1438. end;
  1439. function TSynBaseCompletion.GetOnMeasureItem: TSynBaseCompletionMeasureItem;
  1440. begin
  1441. Result := Form.OnMeasureItem;
  1442. end;
  1443. function TSynBaseCompletion.GetOnPositionChanged: TNotifyEvent;
  1444. begin
  1445. Result := Form.OnPositionChanged;
  1446. end;
  1447. function TSynBaseCompletion.GetShowSizeDrag: Boolean;
  1448. begin
  1449. Result := Form.ShowSizeDrag;
  1450. end;
  1451. procedure TSynBaseCompletion.SetCaseSensitive(const AValue: boolean);
  1452. begin
  1453. Form.CaseSensitive := AValue;
  1454. end;
  1455. procedure TSynBaseCompletion.SetClSelect(const Value: TColor);
  1456. begin
  1457. Form.ClSelect := Value;
  1458. end;
  1459. function TSynBaseCompletion.GetOnKeyDelete: TNotifyEvent;
  1460. begin
  1461. result := Form.OnKeyDelete;
  1462. end;
  1463. procedure TSynBaseCompletion.SetOnKeyDelete(const Value: TNotifyEvent);
  1464. begin
  1465. form.OnKeyDelete := Value;
  1466. end;
  1467. procedure TSynBaseCompletion.SetShowSizeDrag(const AValue: Boolean);
  1468. begin
  1469. Form.ShowSizeDrag := AValue;
  1470. end;
  1471. procedure TSynBaseCompletion.SetWidth(Value: Integer);
  1472. begin
  1473. FWidth := Value;
  1474. Form.Width := FWidth;
  1475. Form.SetNbLinesInWindow(Form.FNbLinesInWindow);
  1476. end;
  1477. procedure TSynBaseCompletion.Deactivate;
  1478. var
  1479. CurSynEdit: TCustomSynEdit;
  1480. begin
  1481. if FAddedPersistentCaret and
  1482. (Form<>nil) and (Form.CurrentEditor is TCustomSynEdit)
  1483. then begin
  1484. CurSynEdit:=TCustomSynEdit(Form.CurrentEditor);
  1485. CurSynEdit.Options:=CurSynEdit.Options-[eoPersistentCaret];
  1486. end;
  1487. if Assigned(Form) then Form.Deactivate;
  1488. end;
  1489. function TSynBaseCompletion.IsActive: boolean;
  1490. begin
  1491. Result:=(Form<>nil) and (Form.Visible);
  1492. end;
  1493. function TSynBaseCompletion.TheForm: TSynBaseCompletionForm;
  1494. begin
  1495. Result:=Form;
  1496. end;
  1497. procedure PrettyTextOut(c: TCanvas; x, y: integer; s: string);
  1498. var
  1499. i: integer;
  1500. OldFontColor: TColor;
  1501. OldFontStyle: TFontStyles;
  1502. begin
  1503. OldFontColor:=c.Font.Color;
  1504. OldFontStyle:=c.Font.Style;
  1505. c.Font.Style:=[];
  1506. c.Font.Color:=clBlack;
  1507. try
  1508. i := 1;
  1509. while i <= Length(s) do
  1510. case s[i] of
  1511. #1: begin
  1512. C.Font.Color := (Ord(s[i + 3]) shl 8 + Ord(s[i + 2])) shl 8 + Ord(s[i + 1]);
  1513. inc(i, 4);
  1514. end;
  1515. #2: begin
  1516. C.Font.Color := (Ord(s[i + 3]) shl 8 + Ord(s[i + 2])) shl 8 + Ord(s[i + 1]);
  1517. inc(i, 4);
  1518. end;
  1519. #3: begin
  1520. case s[i + 1] of
  1521. 'B': c.Font.Style := c.Font.Style + [fsBold];
  1522. 'b': c.Font.Style := c.Font.Style - [fsBold];
  1523. 'U': c.Font.Style := c.Font.Style + [fsUnderline];
  1524. 'u': c.Font.Style := c.Font.Style - [fsUnderline];
  1525. 'I': c.Font.Style := c.Font.Style + [fsItalic];
  1526. 'i': c.Font.Style := c.Font.Style - [fsItalic];
  1527. end;
  1528. inc(i, 2);
  1529. end;
  1530. else
  1531. C.TextOut(x, y, s[i]);
  1532. x := x + c.TextWidth(s[i]);
  1533. inc(i);
  1534. end;
  1535. except
  1536. end;
  1537. c.Font.Color:=OldFontColor;
  1538. c.Font.Style:=OldFontStyle;
  1539. end;
  1540. { TSynCompletion }
  1541. procedure TSynCompletion.OnFormPaint(Sender: TObject);
  1542. begin
  1543. end;
  1544. procedure TSynCompletion.Cancel(Sender: TObject);
  1545. var
  1546. F: TSynBaseCompletionForm;
  1547. begin
  1548. F := Sender as TSynBaseCompletionForm;
  1549. if F.CurrentEditor <> nil then begin
  1550. if (F.CurrentEditor as TCustomSynEdit).Owner is TWinControl then
  1551. TWinControl((F.CurrentEditor as TCustomSynEdit).Owner).SetFocus;
  1552. (F.CurrentEditor as TCustomSynEdit).SetFocus;
  1553. end;
  1554. end;
  1555. procedure TSynCompletion.Validate(Sender: TObject; KeyChar: TUTF8Char;
  1556. Shift: TShiftState);
  1557. var
  1558. F: TSynBaseCompletionForm;
  1559. Value, CurLine: string;
  1560. NewBlockBegin, NewBlockEnd: TPoint;
  1561. LogCaret: TPoint;
  1562. HighlighterIdentChars: TSynIdentChars;
  1563. begin
  1564. //debugln('TSynCompletion.Validate ',dbgsName(Sender),' ',dbgs(Shift),' Position=',dbgs(Position));
  1565. F := Sender as TSynBaseCompletionForm;
  1566. // Note: Form.Visible can be false, for example when completion only contains one item
  1567. if F.CurrentEditor is TCustomSynEdit then
  1568. with TCustomSynEdit(F.CurrentEditor) do begin
  1569. BeginUndoBlock{$IFDEF SynUndoDebugBeginEnd}('TSynCompletion.Validate'){$ENDIF};
  1570. BeginUpdate;
  1571. try
  1572. if Editor.Highlighter<>nil then
  1573. HighlighterIdentChars := Editor.Highlighter.IdentChars
  1574. else
  1575. HighlighterIdentChars := [];
  1576. LogCaret := LogicalCaretXY;
  1577. NewBlockBegin:=LogCaret;
  1578. CurLine:=Lines[NewBlockBegin.Y - 1];
  1579. while (NewBlockBegin.X>1) and (NewBlockBegin.X-1<=length(CurLine))
  1580. and ((IsIdentifierChar(@CurLine[NewBlockBegin.X-1]))
  1581. or (CurLine[NewBlockBegin.X-1] in HighlighterIdentChars))
  1582. do
  1583. dec(NewBlockBegin.X);
  1584. //BlockBegin:=NewBlockBegin;
  1585. if ssShift in Shift then begin
  1586. // replace only prefix
  1587. NewBlockEnd := LogCaret;
  1588. end else begin
  1589. // replace the whole word
  1590. NewBlockEnd := LogCaret;
  1591. CurLine:=Lines[NewBlockEnd.Y - 1];
  1592. while (NewBlockEnd.X<=length(CurLine))
  1593. and ((IsIdentifierChar(@CurLine[NewBlockEnd.X]))
  1594. or (CurLine[NewBlockEnd.X] in HighlighterIdentChars))
  1595. do
  1596. inc(NewBlockEnd.X);
  1597. end;
  1598. //debugln('TSynCompletion.Validate B Position=',dbgs(Position));
  1599. if Position>=0 then begin
  1600. if Assigned(FOnCodeCompletion) then
  1601. begin
  1602. Value := ItemList[Position];
  1603. FOnCodeCompletion(Value, TextBetweenPoints[NewBlockBegin, NewBlockEnd],
  1604. NewBlockBegin, NewBlockEnd, KeyChar, Shift);
  1605. if (CompareCarets(NewBlockBegin, NewBlockEnd) <> 0) or (Value <> '') then
  1606. begin
  1607. TextBetweenPointsEx[NewBlockBegin, NewBlockEnd, scamEnd] := Value;
  1608. TCustomSynEdit(F.CurrentEditor).SetFocus;
  1609. end;
  1610. end else begin
  1611. TextBetweenPointsEx[NewBlockBegin, NewBlockEnd, scamEnd] := ItemList[Position];
  1612. TCustomSynEdit(F.CurrentEditor).SetFocus;
  1613. end;
  1614. end
  1615. else
  1616. if (ItemList.Count = 0) then
  1617. Cancel(Sender);
  1618. finally
  1619. EndUpdate;
  1620. EndUndoBlock{$IFDEF SynUndoDebugBeginEnd}('TSynCompletion.Validate'){$ENDIF};
  1621. end;
  1622. end;
  1623. end;
  1624. constructor TSynCompletion.Create(AOwner: TComponent);
  1625. begin
  1626. inherited Create(AOwner);
  1627. Form.OnValidate := @Validate;
  1628. Form.OnCancel := @Cancel;
  1629. Form.OnPaint:=@OnFormPaint;
  1630. FEndOfTokenChr := '()[].';
  1631. fShortCut := Menus.ShortCut(Ord(' '), [ssCtrl]);
  1632. FExecCommandID := ecSynCompletionExecute;
  1633. end;
  1634. procedure TSynCompletion.SetShortCut(Value: TShortCut);
  1635. begin
  1636. FShortCut := Value;
  1637. end;
  1638. procedure TSynCompletion.TranslateKey(Sender: TObject; Code: word; SState: TShiftState;
  1639. var Data: pointer; var IsStartOfCombo: boolean; var Handled: boolean;
  1640. var Command: TSynEditorCommand; FinishComboOnly: Boolean;
  1641. var ComboKeyStrokes: TSynEditKeyStrokes);
  1642. var
  1643. i: integer;
  1644. ShortCutKey: Word;
  1645. ShortCutShift: TShiftState;
  1646. begin
  1647. if (Code = VK_UNKNOWN) or Handled or FinishComboOnly or (FExecCommandID = ecNone) then exit;
  1648. i := IndexOfEditor(Sender as TCustomSynEdit);
  1649. if i >= 0 then begin
  1650. ShortCutToKey(FShortCut, ShortCutKey, ShortCutShift);
  1651. if (SState = ShortCutShift) and (Code = ShortCutKey) then begin
  1652. Command := FExecCommandID;
  1653. Handled := True;
  1654. end;
  1655. end;
  1656. end;
  1657. procedure TSynCompletion.ProcessSynCommand(Sender: TObject; AfterProcessing: boolean;
  1658. var Handled: boolean; var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer;
  1659. HandlerData: pointer);
  1660. var
  1661. p: TPoint;
  1662. i: integer;
  1663. begin
  1664. if Handled or (Command <> FExecCommandID) then
  1665. exit;
  1666. i := IndexOfEditor(Sender as TCustomSynEdit);
  1667. if i >= 0 then begin
  1668. with sender as TCustomSynEdit do begin
  1669. if not ReadOnly then begin
  1670. p := ClientToScreen(Point(CaretXPix, CaretYPix + LineHeight + 1));
  1671. Editor := Sender as TCustomSynEdit; // Will set Form.SetCurrentEditor
  1672. Execute(GetPreviousToken(Sender as TCustomSynEdit), p.x, p.y);
  1673. Handled := True;
  1674. end;
  1675. end;
  1676. end;
  1677. end;
  1678. function TSynCompletion.GetCompletionFormClass: TSynBaseCompletionFormClass;
  1679. begin
  1680. Result := TSynCompletionForm;
  1681. end;
  1682. function TSynCompletion.GetPreviousToken(FEditor: TCustomSynEdit): string;
  1683. var
  1684. s: string;
  1685. i: integer;
  1686. begin
  1687. if FEditor <> nil then begin
  1688. s := FEditor.LineText;
  1689. i := FEditor.LogicalCaretXY.X - 1;
  1690. if i > length(s) then
  1691. result := ''
  1692. else begin
  1693. while (i > 0) and (s[i] > ' ') and (pos(s[i], FEndOfTokenChr) = 0) do
  1694. Begin
  1695. dec(i);
  1696. end;
  1697. result := copy(s, i + 1, FEditor.LogicalCaretXY.X - i - 1);
  1698. end;
  1699. end
  1700. else
  1701. result := '';
  1702. end;
  1703. procedure TSynCompletion.DoEditorAdded(AValue: TCustomSynEdit);
  1704. begin
  1705. inherited DoEditorAdded(AValue);
  1706. AValue.RegisterCommandHandler(@ProcessSynCommand, nil);
  1707. AValue.RegisterKeyTranslationHandler(@TranslateKey);
  1708. end;
  1709. procedure TSynCompletion.DoEditorRemoving(AValue: TCustomSynEdit);
  1710. begin
  1711. inherited DoEditorRemoving(AValue);
  1712. if Form.CurrentEditor = AValue then
  1713. Form.SetCurrentEditor(nil);
  1714. AValue.UnregisterCommandHandler(@ProcessSynCommand);
  1715. AValue.UnRegisterKeyTranslationHandler(@TranslateKey);
  1716. end;
  1717. procedure TSynCompletion.SetEditor(const Value: TCustomSynEdit);
  1718. begin
  1719. inherited SetEditor(Value);
  1720. Form.SetCurrentEditor(Value);
  1721. end;
  1722. function TSynCompletion.EditorsCount: integer;
  1723. begin
  1724. result := EditorCount;
  1725. end;
  1726. procedure TSynCompletion.AddCharAtCursor(AUtf8Char: TUTF8Char);
  1727. begin
  1728. Form.AddCharAtCursor(AUtf8Char);
  1729. end;
  1730. procedure TSynCompletion.DeleteCharBeforoCursor;
  1731. begin
  1732. Form.DeleteCharBeforeCursor;
  1733. end;
  1734. { TSynAutoComplete }
  1735. constructor TSynAutoComplete.Create(AOwner: TComponent);
  1736. begin
  1737. inherited;
  1738. FEndOfTokenChr := '()[].';
  1739. fAutoCompleteList := TStringList.Create;
  1740. fShortCut := Menus.ShortCut(Ord(' '), [ssShift]);
  1741. FExecCommandID := ecSynAutoCompletionExecute;
  1742. end;
  1743. procedure TSynAutoComplete.SetShortCut(Value: TShortCut);
  1744. begin
  1745. FShortCut := Value;
  1746. end;
  1747. destructor TSynAutoComplete.destroy;
  1748. begin
  1749. FreeAndNil(fAutoCompleteList);
  1750. inherited;
  1751. end;
  1752. function TSynAutoComplete.EditorsCount: integer;
  1753. begin
  1754. Result := EditorCount;
  1755. end;
  1756. procedure TSynAutoComplete.Execute(token: string; aEditor: TCustomSynEdit);
  1757. var
  1758. Temp: string;
  1759. i, j, prevspace: integer;
  1760. StartOfBlock: tpoint;
  1761. begin
  1762. //Writeln('[TSynAutoComplete.Execute] Token is "',Token,'"');
  1763. i := AutoCompleteList.IndexOf(token);
  1764. if i <> -1 then begin
  1765. for j := 1 to length(token) do
  1766. aEditor.CommandProcessor(ecDeleteLastChar, ' ', nil);
  1767. inc(i);
  1768. StartOfBlock := Point(-1, -1);
  1769. PrevSpace := 0;
  1770. while (i < AutoCompleteList.Count) and
  1771. (length(AutoCompleteList[i]) > 0) and
  1772. (AutoCompleteList[i][1] = '=') do begin
  1773. for j := 0 to PrevSpace - 1 do
  1774. aEditor.CommandProcessor(ecDeleteLastChar, ' ', nil);
  1775. Temp := AutoCompleteList[i];
  1776. PrevSpace := 0;
  1777. while (length(temp) >= PrevSpace + 2) and (temp[PrevSpace + 2] <= ' ') do
  1778. inc(PrevSpace);
  1779. for j := 2 to length(Temp) do begin
  1780. aEditor.CommandProcessor(ecChar, Temp[j], nil);
  1781. if Temp[j] = '|' then
  1782. StartOfBlock := aEditor.CaretXY
  1783. end;
  1784. inc(i);
  1785. if (i < AutoCompleteList.Count) and
  1786. (length(AutoCompleteList[i]) > 0) and
  1787. (AutoCompleteList[i][1] = '=') then
  1788. aEditor.CommandProcessor(ecLineBreak, ' ', nil);
  1789. end;
  1790. if (StartOfBlock.x <> -1) and (StartOfBlock.y <> -1) then begin
  1791. aEditor.CaretXY := StartOfBlock;
  1792. aEditor.CommandProcessor(ecDeleteLastChar, ' ', nil);
  1793. end;
  1794. end;
  1795. end;
  1796. function TSynAutoComplete.GetPreviousToken(aEditor: TCustomSynEdit): string;
  1797. var
  1798. s: string;
  1799. i: integer;
  1800. begin
  1801. if aEditor <> nil then begin
  1802. s := aEditor.LineText;
  1803. i := aEditor.LogicalCaretXY.X - 1;
  1804. if i > length(s) then
  1805. result := ''
  1806. else begin
  1807. while (i > 0) and (s[i] > ' ') and (pos(s[i], FEndOfTokenChr) = 0) do
  1808. dec(i);
  1809. result := copy(s, i + 1, aEditor.LogicalCaretXY.X - i - 1);
  1810. end;
  1811. end
  1812. else
  1813. result := '';
  1814. end;
  1815. procedure TSynAutoComplete.TranslateKey(Sender: TObject; Code: word; SState: TShiftState;
  1816. var Data: pointer; var IsStartOfCombo: boolean; var Handled: boolean;
  1817. var Command: TSynEditorCommand; FinishComboOnly: Boolean;
  1818. var ComboKeyStrokes: TSynEditKeyStrokes);
  1819. var
  1820. i: integer;
  1821. ShortCutKey: Word;
  1822. ShortCutShift: TShiftState;
  1823. begin
  1824. if (Code = VK_UNKNOWN) or Handled or FinishComboOnly or (FExecCommandID = ecNone) then exit;
  1825. i := IndexOfEditor(Sender as TCustomSynEdit);
  1826. if i >= 0 then begin
  1827. ShortCutToKey(FShortCut, ShortCutKey, ShortCutShift);
  1828. if (SState = ShortCutShift) and (Code = ShortCutKey) then begin
  1829. Command := FExecCommandID;
  1830. Handled := True;
  1831. end;
  1832. end;
  1833. end;
  1834. procedure TSynAutoComplete.ProcessSynCommand(Sender: TObject; AfterProcessing: boolean;
  1835. var Handled: boolean; var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer;
  1836. HandlerData: pointer);
  1837. var
  1838. i: integer;
  1839. begin
  1840. if Handled or (Command <> FExecCommandID) then
  1841. exit;
  1842. i := IndexOfEditor(Sender as TCustomSynEdit);
  1843. if i >= 0 then begin
  1844. with sender as TCustomSynEdit do begin
  1845. if not ReadOnly then begin
  1846. Editor := Sender as TCustomSynEdit; // Will set Form.SetCurrentEditor
  1847. Execute(GetPreviousToken(Sender as TCustomSynEdit), Sender as TCustomSynEdit);
  1848. Handled := True;
  1849. end;
  1850. end;
  1851. end;
  1852. end;
  1853. procedure TSynAutoComplete.SetAutoCompleteList(List: TStrings);
  1854. begin
  1855. fAutoCompleteList.Assign(List);
  1856. end;
  1857. procedure TSynAutoComplete.DoEditorAdded(AValue: TCustomSynEdit);
  1858. begin
  1859. inherited DoEditorAdded(AValue);
  1860. AValue.RegisterCommandHandler(@ProcessSynCommand, nil);
  1861. AValue.RegisterKeyTranslationHandler(@TranslateKey);
  1862. end;
  1863. procedure TSynAutoComplete.DoEditorRemoving(AValue: TCustomSynEdit);
  1864. begin
  1865. inherited DoEditorRemoving(AValue);
  1866. AValue.UnregisterCommandHandler(@ProcessSynCommand);
  1867. AValue.UnRegisterKeyTranslationHandler(@TranslateKey);
  1868. end;
  1869. function TSynAutoComplete.GetTokenList: string;
  1870. var
  1871. List: TStringList;
  1872. i: integer;
  1873. begin
  1874. Result := '';
  1875. if AutoCompleteList.Count < 1 then Exit;
  1876. List := TStringList.Create;
  1877. i := 0;
  1878. while (i < AutoCompleteList.Count) do begin
  1879. if (length(AutoCompleteList[i]) > 0) and (AutoCompleteList[i][1] <> '=') then
  1880. List.Add(Trim(AutoCompleteList[i]));
  1881. inc(i);
  1882. end;
  1883. Result := List.Text;
  1884. List.Free;
  1885. end;
  1886. function TSynAutoComplete.GetTokenValue(Token: string): string;
  1887. var
  1888. i: integer;
  1889. List: TStringList;
  1890. begin
  1891. Result := '';
  1892. i := AutoCompleteList.IndexOf(Token);
  1893. if i <> -1 then begin
  1894. List := TStringList.Create;
  1895. Inc(i);
  1896. while (i < AutoCompleteList.Count) and
  1897. (length(AutoCompleteList[i]) > 0) and
  1898. (AutoCompleteList[i][1] = '=') do begin
  1899. if Length(AutoCompleteList[i]) = 1 then
  1900. List.Add('')
  1901. else
  1902. List.Add(Copy(AutoCompleteList[i], 2, Length(AutoCompleteList[i])));
  1903. inc(i);
  1904. end;
  1905. Result := List.Text;
  1906. List.Free;
  1907. end;
  1908. end;
  1909. { TSynBaseCompletionHint }
  1910. procedure TSynBaseCompletionHint.Paint;
  1911. var
  1912. R: TRect;
  1913. begin
  1914. if FCompletionForm.Position = FIndex then
  1915. Canvas.Brush.Color := FCompletionForm.ClSelect
  1916. else
  1917. Canvas.Brush.Color := Color;
  1918. Canvas.Pen.Width := 1;
  1919. R := ClientRect;
  1920. Canvas.FillRect(R);
  1921. DrawEdge(Canvas.Handle, R, BDR_RAISEDOUTER, BF_RECT);
  1922. Canvas.Font.Color := FCompletionForm.TextColor;
  1923. if not Assigned(FCompletionForm.OnPaintItem)
  1924. or not FCompletionForm.OnPaintItem(Caption, Canvas, 1, 1,
  1925. FCompletionForm.Position = FIndex, FIndex)
  1926. then
  1927. Canvas.TextOut(2, 2, Caption);
  1928. end;
  1929. constructor TSynBaseCompletionHint.Create(AOwner: TComponent);
  1930. begin
  1931. inherited Create(AOwner);
  1932. Canvas.Brush.Style := bsSolid;
  1933. FCompletionForm := AOwner as TSynBaseCompletionForm;
  1934. Color := FCompletionForm.BackgroundColor;
  1935. AutoHide := False;
  1936. Visible := False;
  1937. end;
  1938. function TSynBaseCompletionHint.CalcHintRect(MaxWidth: Integer; const AHint: string;
  1939. AData: pointer): TRect;
  1940. var
  1941. P: TPoint;
  1942. begin
  1943. if Assigned(FCompletionForm.OnMeasureItem) then
  1944. begin
  1945. Result.TopLeft := Point(0, 0);
  1946. P := FCompletionForm.OnMeasureItem(AHint, Canvas,
  1947. FCompletionForm.Position = FIndex, FIndex);
  1948. Result.Bottom := P.Y + 2;
  1949. Result.Right := P.X + 4;
  1950. end
  1951. else
  1952. Result := Rect(0, 0, Canvas.TextWidth(AHint) + 4, FCompletionForm.FontHeight);
  1953. end;
  1954. const
  1955. SynComplutionCommandStrs: array[0..1] of TIdentMapEntry = (
  1956. (Value: ecSynCompletionExecute; Name: 'ecSynCompletionExecute'),
  1957. (Value: ecSynAutoCompletionExecute; Name: 'ecSynAutoCompletionExecute')
  1958. );
  1959. function IdentToSynCompletionCommand(const Ident: string; var Cmd: longint): boolean;
  1960. begin
  1961. Result := IdentToInt(Ident, Cmd, SynComplutionCommandStrs);
  1962. end;
  1963. function SynCompletionCommandToIdent(Cmd: longint; var Ident: string): boolean;
  1964. begin
  1965. Result := (Cmd >= ecPluginFirstCompletion) and (Cmd - ecPluginFirstCompletion < ecSynCompletionCount);
  1966. if not Result then exit;
  1967. Result := IntToIdent(Cmd, Ident, SynComplutionCommandStrs);
  1968. end;
  1969. procedure GetEditorCommandValues(Proc: TGetStrProc);
  1970. var
  1971. i: integer;
  1972. begin
  1973. for i := Low(SynComplutionCommandStrs) to High(SynComplutionCommandStrs) do
  1974. Proc(SynComplutionCommandStrs[I].Name);
  1975. end;
  1976. initialization
  1977. RegisterKeyCmdIdentProcs(@IdentToSynCompletionCommand,
  1978. @SynCompletionCommandToIdent);
  1979. RegisterExtraGetEditorCommandValues(@GetEditorCommandValues);
  1980. end.