fpcodcmp.pas 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666
  1. {
  2. This file is part of the Free Pascal Integrated Development Environment
  3. Copyright (c) 1998 by Berczi Gabor
  4. Code Complete routines
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. unit FPCodCmp; { CodeComplete }
  12. {$ifdef cpullvm}
  13. {$modeswitch nestedprocvars}
  14. {$endif}
  15. interface
  16. uses Objects,Drivers,Dialogs,
  17. WEditor,WUtils,WViews;
  18. type
  19. PCodeCompleteWordList = ^TCodeCompleteWordList;
  20. TCodeCompleteWordList = object(TTextCollection)
  21. end;
  22. PCodeCompleteDialog = ^TCodeCompleteDialog;
  23. TCodeCompleteDialog = object(TCenterDialog)
  24. constructor Init;
  25. function Execute: Word; virtual;
  26. procedure HandleEvent(var Event: TEvent); virtual;
  27. private
  28. CodeCompleteLB : PAdvancedListBox;
  29. RB : PRadioButtons;
  30. CB : PCheckBoxes;
  31. MinInputL,InputL : PEditorInputLine;
  32. procedure Add;
  33. procedure Edit;
  34. procedure Delete;
  35. end;
  36. function FPCompleteCodeWord(const WordS: string; var Text: string): boolean;
  37. procedure InitCodeComplete;
  38. function LoadCodeComplete(var S: TStream): boolean;
  39. procedure AddStandardUnitsToCodeComplete;
  40. procedure AddAvailableUnitsToCodeComplete(OnlyStandard : boolean);
  41. function StoreCodeComplete(var S: TStream): boolean;
  42. procedure DoneCodeComplete;
  43. const CodeCompleteWords : PCodeCompleteWordList = nil;
  44. type
  45. TCodeCompleteCase = (ccc_unchanged, ccc_lower, ccc_upper, ccc_mixed);
  46. const
  47. CodeCompleteCase : TCodeCompleteCase = ccc_unchanged;
  48. UnitsCodeCompleteWords : PCodeCompleteWordList = nil;
  49. procedure RegisterCodeComplete;
  50. implementation
  51. uses App,Views,MsgBox,Validate,
  52. FVConsts,
  53. systems, BrowCol,
  54. FPSwitch, FPCompil,
  55. FPVars, FPSymbol,
  56. FPConst,FPViews;
  57. {$ifndef NOOBJREG}
  58. const
  59. RCodeCompleteWordList: TStreamRec = (
  60. ObjType: 14401;
  61. VmtLink: Ofs(TypeOf(TCodeCompleteWordList)^);
  62. Load: @TCodeCompleteWordList.Load;
  63. Store: @TCodeCompleteWordList.Store
  64. );
  65. {$endif}
  66. {$ifdef useresstrings}
  67. resourcestring
  68. {$else}
  69. const
  70. {$endif}
  71. { CodeComplete dialog }
  72. dialog_codecomplete = 'CodeComplete';
  73. label_codecomplete_keywords = '~K~eywords';
  74. dialog_codecomplete_add = 'Add new keyword';
  75. label_codecomplete_add_keyword = 'Keyword';
  76. dialog_codecomplete_edit = 'Edit keyword';
  77. label_codecomplete_edit_keyword = 'Keyword';
  78. msg_codecomplete_alreadyinlist = '"%s" is already in the list';
  79. { standard button texts }
  80. button_OK = 'O~K~';
  81. button_Cancel = 'Cancel';
  82. button_New = '~N~ew';
  83. button_Edit = '~E~dit';
  84. button_Delete = '~D~elete';
  85. function FPCompleteCodeWord(const WordS: string; var Text: string): boolean;
  86. var OK: boolean;
  87. CIndex, Index, i : sw_integer;
  88. St, UpWordS : string;
  89. begin
  90. if ShowOnlyUnique then
  91. UpWordS:=UpCaseStr(WordS);
  92. OK:=Assigned(CodeCompleteWords);
  93. if OK then
  94. begin
  95. Text:=CodeCompleteWords^.Lookup(WordS,CIndex);
  96. OK:=(CIndex<>-1) and (length(Text)<>length(WordS));
  97. Index:=-1;
  98. if OK and ShowOnlyUnique and (CIndex<CodeCompleteWords^.Count-1) then
  99. begin
  100. St:=PString(CodeCompleteWords^.At(CIndex+1))^;
  101. if (UpCaseStr(Copy(St,1,length(WordS)))=UpWordS) then
  102. begin
  103. {if UpCase(st[Length(UpWordS)+1])<>Upcase(Text[Length(UpWordS)+1]) then}
  104. begin
  105. Text:='';
  106. FPCompleteCodeWord:=false;
  107. exit;
  108. (* end
  109. else
  110. { only give the common part }
  111. begin
  112. i:=Length(UpWordS)+1;
  113. while (i<=length(st)) and (i<=length(text)) and (UpCase(st[i])=Upcase(Text[i])) do
  114. inc(i);
  115. SetLength(Text,i-1); *)
  116. end;
  117. end;
  118. end;
  119. end;
  120. if (ShowOnlyUnique or not OK) and Assigned(UnitsCodeCompleteWords) then
  121. begin
  122. Text:=UnitsCodeCompleteWords^.Lookup(WordS,Index);
  123. OK:=(Index<>-1) and (length(Text)<>length(WordS));
  124. if ShowOnlyUnique and (Index<UnitsCodeCompleteWords^.Count-1) then
  125. begin
  126. St:=PString(UnitsCodeCompleteWords^.At(Index+1))^;
  127. if UpCaseStr(Copy(St,1,length(WordS)))=UpWordS then
  128. begin
  129. {if UpCase(st[Length(UpWordS)+1])<>Upcase(Text[Length(UpWordS)+1]) then}
  130. begin
  131. Text:='';
  132. FPCompleteCodeWord:=false;
  133. exit;
  134. (* end
  135. else
  136. { only give the common part }
  137. begin
  138. i:=Length(UpWordS)+1;
  139. while (i<=length(st)) and (i<=length(text)) and (UpCase(st[i])=Upcase(Text[i])) do
  140. inc(i);
  141. SetLength(Text,i-1); *)
  142. end;
  143. end;
  144. end;
  145. end;
  146. if ShowOnlyUnique and (Index<>-1) and (CIndex<>-1) then
  147. begin
  148. {St:=PString(CodeCompleteWords^.At(CIndex+1))^;
  149. Was wrong, CIndex+1 could be above count => collection.error
  150. generated RTE 213
  151. if UpCase(st[Length(UpWordS)+1])<>Upcase(Text[Length(UpWordS)+1]) then}
  152. begin
  153. Text:='';
  154. FPCompleteCodeWord:=false;
  155. exit;
  156. (* end
  157. else
  158. { only give the common part }
  159. begin
  160. i:=Length(UpWordS)+1;
  161. while (i<=length(st)) and (i<=length(text)) and (UpCase(st[i])=Upcase(Text[i])) do
  162. inc(i);
  163. SetLength(Text,i-1); *)
  164. end;
  165. end;
  166. if OK=false then Text:=''
  167. else case CodeCompleteCase of
  168. ccc_upper : Text:=UpcaseStr(Text);
  169. ccc_lower : Text:=LowcaseStr(Text);
  170. ccc_mixed : Text:=UpCase(Text[1])+LowCaseStr(Copy(Text,2,High(Text)));
  171. end;
  172. FPCompleteCodeWord:=OK;
  173. end;
  174. procedure InitCodeComplete;
  175. var I:integer;
  176. S: string;
  177. begin
  178. if Assigned(CodeCompleteWords) then
  179. Dispose(CodeCompleteWords, Done);
  180. New(CodeCompleteWords, Init(10,10));
  181. for I:=0 to GetReservedWordCount-1 do
  182. begin
  183. S:=LowCaseStr(GetReservedWord(I));
  184. if length(S)>=CodeCompleteMinLen then
  185. CodeCompleteWords^.Insert(NewStr(S));
  186. end;
  187. {
  188. there should be also a user front-end for customizing CodeComplete !
  189. any volunteers to implement? ;) - Gabor
  190. }
  191. end;
  192. procedure AddAvailableUnitsToCodeComplete(OnlyStandard : boolean);
  193. var
  194. I : sw_integer;
  195. Overflow: boolean;
  196. Level : longint;
  197. UpStandardUnits : string;
  198. procedure InsertInS(P: PSymbol);
  199. procedure InsertItemsInS(P: PSymbolCollection);
  200. var I: Sw_integer;
  201. begin
  202. for I:=0 to P^.Count-1 do
  203. InsertInS(P^.At(I));
  204. end;
  205. Var
  206. st : string;
  207. CIndex : sw_integer;
  208. begin
  209. Inc(level);
  210. if UnitsCodeCompleteWords^.Count=MaxCollectionSize then
  211. begin Overflow:=true; Exit; end;
  212. st:=P^.GetName;
  213. if Length(st)>=CodeCompleteMinLen then
  214. if not ((level=1) and OnlyStandard and (st=UpCaseStr(CodeCompleteUnitName))) then
  215. begin
  216. st:=Lowcasestr(st);
  217. UnitsCodeCompleteWords^.LookUp(st,CIndex);
  218. if CIndex<>-1 then
  219. UnitsCodeCompleteWords^.Insert(NewStr(st));
  220. end;
  221. { this is wrong because it inserted args or locals of proc
  222. in the globals list !! PM}
  223. if (P^.Items<>nil) and (level=1) and
  224. ((not OnlyStandard or (Pos(P^.GetName+',',UpStandardUnits)>0) or
  225. { don't exclude system unit ... }
  226. (Pos('SYS',P^.GetName)>0))) then
  227. InsertItemsInS(P^.Items);
  228. Dec(level);
  229. end;
  230. begin
  231. if OnlyStandard then
  232. UpStandardunits:=UpCaseStr(StandardUnits)+',';
  233. if IsSymbolInfoAvailable then
  234. begin
  235. if Assigned(UnitsCodeCompleteWords) then
  236. begin
  237. Dispose(UnitsCodeCompleteWords,done);
  238. UnitsCodeCompleteWords:=nil;
  239. end;
  240. New(UnitsCodeCompleteWords, Init(10,10));
  241. level:=0;
  242. Overflow:=false;
  243. BrowCol.Modules^.ForEach(TCallbackProcParam(@InsertInS));
  244. { if Overflow then
  245. WarningBox(msg_toomanysymbolscantdisplayall,nil); }
  246. end;
  247. end;
  248. procedure AddStandardUnitsToCodeComplete;
  249. var
  250. HiddenSource : PSourceWindow;
  251. R : TRect;
  252. StoreBrowserSwitchesConfig : string;
  253. begin
  254. Desktop^.GetExtent(R);
  255. New(HiddenSource,init(R,'*'));
  256. HiddenSource^.NoNameCount:=0;
  257. HiddenSource^.UpdateTitle;
  258. HiddenSource^.Hide;
  259. CompilingHiddenFile:=HiddenSource;
  260. { compile a dummy file to get symbol info }
  261. with HiddenSource^.Editor^ do
  262. begin
  263. FileName:=CodeCompleteUnitName+'.pp';
  264. Addline('unit '+CodeCompleteUnitName+';');
  265. Addline('interface');
  266. if StandardUnits<>'' then
  267. begin
  268. AddLine('uses');
  269. Addline(StandardUnits);
  270. Addline(' ;');
  271. end;
  272. Addline('implementation');
  273. Addline('end.');
  274. SetModified(true);
  275. // SaveFile;
  276. end;
  277. StoreBrowserSwitchesConfig:=BrowserSwitches^.GetCurrSelParam;
  278. BrowserSwitches^.ReadItemsCfg('+');
  279. DoCompile(cCompile);
  280. BrowserSwitches^.SetCurrSelParam(StoreBrowserSwitchesConfig);
  281. AddAvailableUnitsToCodeComplete(true);
  282. { Now add the interface declarations to the Code Complete list }
  283. CompilingHiddenFile:=nil;
  284. Dispose(HiddenSource,Done);
  285. end;
  286. function LoadCodeComplete(var S: TStream): boolean;
  287. var C: PCodeCompleteWordList;
  288. OK: boolean;
  289. NewCodeCompleteMinLen : byte;
  290. NewUseStandardUnitsInCodeComplete,
  291. NewUseAllUnitsInCodeComplete,
  292. NewShowOnlyUnique : boolean;
  293. NewCodeCompleteCase : TCodeCompleteCase;
  294. StPtr : PString;
  295. begin
  296. New(C, Load(S));
  297. OK:=Assigned(C) and (S.Status=stOk);
  298. if OK then
  299. begin
  300. if Assigned(CodeCompleteWords) then Dispose(CodeCompleteWords, Done);
  301. CodeCompleteWords:=C;
  302. S.Read(NewCodeCompleteCase,Sizeof(TCodeCompleteCase));
  303. OK:=(S.Status=stOk);
  304. if OK then
  305. CodeCompleteCase:=NewCodeCompleteCase;
  306. { Old version of Code complete, also OK PM }
  307. if not OK or (S.getPos=S.getSize) then
  308. begin
  309. LoadCodeComplete:=OK;
  310. exit;
  311. end;
  312. if S.Status=stOK then
  313. S.Read(NewUseStandardUnitsInCodeComplete,Sizeof(UseStandardUnitsInCodeComplete));
  314. if S.Status=stOK then
  315. UseStandardUnitsInCodeComplete:=NewUseStandardUnitsInCodeComplete;
  316. if S.Status=stOK then
  317. S.Read(NewUseAllUnitsInCodeComplete,Sizeof(UseAllUnitsInCodeComplete));
  318. if S.Status=stOK then
  319. UseAllUnitsInCodeComplete:=NewUseAllUnitsInCodeComplete;
  320. if S.Status=stOK then
  321. S.Read(NewShowOnlyUnique,Sizeof(ShowOnlyUnique));
  322. if S.Status=stOK then
  323. ShowOnlyUnique:=NewShowOnlyUnique;
  324. if S.Status=stOK then
  325. S.Read(NewCodeCompleteMinLen,Sizeof(CodeCompleteMinLen));
  326. if S.Status=stOK then
  327. CodeCompleteMinLen:=NewCodeCompleteMinLen;
  328. if S.Status=stOK then
  329. StPtr:=S.ReadStr
  330. else
  331. StPtr:=nil;
  332. if (S.Status=stOK) then
  333. StandardUnits:=GetStr(StPtr);
  334. if assigned(StPtr) then
  335. FreeMem(StPtr,Length(StandardUnits)+1);
  336. OK:=S.Status=stOK;
  337. end
  338. else
  339. if Assigned(C) then
  340. Dispose(C, Done);
  341. LoadCodeComplete:=OK;
  342. end;
  343. function StoreCodeComplete(var S: TStream): boolean;
  344. var OK: boolean;
  345. begin
  346. OK:=Assigned(CodeCompleteWords);
  347. if OK then
  348. begin
  349. CodeCompleteWords^.Store(S);
  350. S.Write(CodeCompleteCase,Sizeof(TCodeCompleteCase));
  351. { New fields added }
  352. S.Write(UseStandardUnitsInCodeComplete,Sizeof(UseStandardUnitsInCodeComplete));
  353. S.Write(UseAllUnitsInCodeComplete,Sizeof(UseAllUnitsInCodeComplete));
  354. S.Write(ShowOnlyUnique,Sizeof(ShowOnlyUnique));
  355. S.Write(CodeCompleteMinLen,Sizeof(CodeCompleteMinLen));
  356. S.WriteStr(@StandardUnits);
  357. OK:=OK and (S.Status=stOK);
  358. end;
  359. StoreCodeComplete:=OK;
  360. end;
  361. procedure DoneCodeComplete;
  362. begin
  363. if Assigned(CodeCompleteWords) then
  364. begin
  365. Dispose(CodeCompleteWords, Done);
  366. CodeCompleteWords:=nil;
  367. end;
  368. if Assigned(UnitsCodeCompleteWords) then
  369. begin
  370. Dispose(UnitsCodeCompleteWords,done);
  371. UnitsCodeCompleteWords:=nil;
  372. end;
  373. end;
  374. constructor TCodeCompleteDialog.Init;
  375. var R,R2,R3: TRect;
  376. Items: PSItem;
  377. SB: PScrollBar;
  378. begin
  379. R.Assign(0,0,50,22);
  380. inherited Init(R,dialog_codecomplete);
  381. HelpCtx:=hcCodeCompleteOptions;
  382. { name list dialog }
  383. GetExtent(R); R.Grow(-3,-2); Inc(R.A.Y); R3.Copy(R); Dec(R.B.X,12);
  384. Dec(R.B.Y,7);
  385. R2.Copy(R); R2.Move(1,0); R2.A.X:=R2.B.X-1;
  386. New(SB, Init(R2)); Insert(SB);
  387. New(CodeCompleteLB, Init(R,1,SB));
  388. Insert(CodeCompleteLB);
  389. R2.Copy(R); R2.Move(0,-1); R2.B.Y:=R2.A.Y+1; Dec(R2.A.X);
  390. Insert(New(PLabel, Init(R2, label_codecomplete_keywords, CodeCompleteLB)));
  391. { Case choice }
  392. R.Copy(R3); Dec(R.B.Y,2); R.A.Y:=R.B.Y-4; Inc(R.A.X); R.B.X:=R.A.X+15;
  393. Items:=NewSItem('Unc~h~anged',
  394. NewSItem('~L~ower',
  395. NewSItem('~U~pper',
  396. NewSItem('~M~ixed',nil))));
  397. RB:=New(PRadioButtons,Init(R,Items));
  398. RB^.SetData(ord(CodeCompleteCase));
  399. R2.Copy(R); R2.Move(0,-1); R2.B.Y:=R2.A.Y+1; Dec(R2.A.X);
  400. Insert(New(PLabel, Init(R2, 'Case handling', RB)));
  401. Insert(RB);
  402. { Mininum length inputline }
  403. R.Copy(R3); R.A.Y:=R.B.Y-7;R.B.Y:=R.A.Y+1; Dec(R.B.X); R.A.X:=R.B.X -5;
  404. New(MinInputL, Init(R,5));
  405. MinInputL^.SetValidator(New(PRangeValidator, Init(1,255)));
  406. Insert(MinInputL);
  407. R2.Copy(R); R2.A.X:=20;Dec(R2.B.X,5);
  408. Insert(New(PLabel, Init(R2, 'Min. length', MinInputL)));
  409. { Standard/all units booleans }
  410. Items:=nil;
  411. Items:=NewSItem('Add standard units', Items);
  412. Items:=NewSItem('Add all units', Items);
  413. Items:=NewSItem('Show only unique', Items);
  414. R.Copy(R3); R.A.Y:=R.B.Y-5;R.B.Y:=R.A.Y+3; Inc(R.A.X,18); Dec(R.B.X);
  415. New(CB, Init(R, Items));
  416. Insert(CB);
  417. R2.Copy(R); R2.Move(0,-1); R2.B.Y:=R2.A.Y+1; Dec(R2.A.X);
  418. Insert(New(PLabel, Init(R2, 'Unit handling', CB)));
  419. R2.Copy(R); R2.Move(0,-1); R2.B.Y:=R2.A.Y+1;
  420. If ShowOnlyUnique then
  421. CB^.Press(0);
  422. If UseAllUnitsInCodeComplete then
  423. CB^.Press(1);
  424. If UseStandardUnitsInCodeComplete then
  425. CB^.Press(2);
  426. { Standard unit name boolean }
  427. R.Copy(R3); R.A.Y:=R.B.Y-1; Inc(R.A.X); Dec(R.B.X);
  428. New(InputL,Init(R,255));
  429. Insert(InputL);
  430. InputL^.SetValidator(New(PFilterValidator,Init(NumberChars+AlphaChars+[','])));
  431. R2.Copy(R); R2.Move(0,-1); R2.B.Y:=R2.A.Y+1; Dec(R2.A.X);R2.B.X:=R2.A.X+25;
  432. Insert(New(PLabel, Init(R2, '~S~tandard unit list', InputL)));
  433. R.Copy(R3); R.A.X:=R.B.X-10; R.B.Y:=R.A.Y+2;
  434. Insert(New(PButton, Init(R, button_OK, cmOK, bfNormal)));
  435. R.Move(0,2);
  436. Insert(New(PButton, Init(R, button_Edit, cmEditItem, bfDefault)));
  437. R.Move(0,2);
  438. Insert(New(PButton, Init(R, button_New, cmAddItem, bfNormal)));
  439. R.Move(0,2);
  440. Insert(New(PButton, Init(R, button_Delete, cmDeleteItem, bfNormal)));
  441. R.Move(0,2);
  442. Insert(New(PButton, Init(R, button_Cancel, cmCancel, bfNormal)));
  443. SelectNext(false);
  444. end;
  445. procedure TCodeCompleteDialog.HandleEvent(var Event: TEvent);
  446. var DontClear: boolean;
  447. begin
  448. case Event.What of
  449. evKeyDown :
  450. begin
  451. DontClear:=false;
  452. case Event.KeyCode of
  453. kbIns :
  454. Message(@Self,evCommand,cmAddItem,nil);
  455. kbDel :
  456. Message(@Self,evCommand,cmDeleteItem,nil);
  457. else DontClear:=true;
  458. end;
  459. if DontClear=false then ClearEvent(Event);
  460. end;
  461. evBroadcast :
  462. case Event.Command of
  463. cmListItemSelected :
  464. if Event.InfoPtr=pointer(CodeCompleteLB) then
  465. Message(@Self,evCommand,cmEditItem,nil);
  466. end;
  467. evCommand :
  468. begin
  469. DontClear:=false;
  470. case Event.Command of
  471. cmAddItem : Add;
  472. cmDeleteItem : Delete;
  473. cmEditItem : Edit;
  474. else DontClear:=true;
  475. end;
  476. if DontClear=false then ClearEvent(Event);
  477. end;
  478. end;
  479. inherited HandleEvent(Event);
  480. end;
  481. function TCodeCompleteDialog.Execute: Word;
  482. var R: word;
  483. C: PCodeCompleteWordList;
  484. NewVal, I: integer;
  485. NewValStr : string;
  486. begin
  487. New(C, Init(10,20));
  488. if Assigned(CodeCompleteWords) then
  489. for I:=0 to CodeCompleteWords^.Count-1 do
  490. C^.Insert(NewStr(GetStr(CodeCompleteWords^.At(I))));
  491. CodeCompleteLB^.NewList(C);
  492. InputL^.SetData(StandardUnits);
  493. NewValStr:=IntToStr(CodeCompleteMinLen);
  494. MinInputL^.SetData(NewValStr);
  495. R:=inherited Execute;
  496. if R=cmOK then
  497. begin
  498. if Assigned(CodeCompleteWords) then Dispose(CodeCompleteWords, Done);
  499. CodeCompleteWords:=C;
  500. CodeCompleteCase:=TCodeCompleteCase(RB^.Value);
  501. MinInputL^.GetData(NewValStr);
  502. NewVal:=StrToInt(NewValStr);
  503. if (NewVal>0) and (NewVal<>CodeCompleteMinLen) then
  504. begin
  505. CodeCompleteMinLen:=NewVal;
  506. InitCodeComplete;
  507. end;
  508. ShowOnlyUnique:=CB^.Mark(0);
  509. UseAllUnitsInCodeComplete:=CB^.Mark(1);
  510. UseStandardUnitsInCodeComplete:=CB^.Mark(2);
  511. if UseStandardUnitsInCodeComplete and (not UseAllUnitsInCodeComplete or not assigned(UnitsCodeCompleteWords)) and
  512. ((StandardUnits<>GetStr(InputL^.Data)) or not assigned(UnitsCodeCompleteWords)) then
  513. begin
  514. InputL^.GetData(StandardUnits);
  515. AddStandardUnitsToCodeComplete;
  516. end
  517. else
  518. InputL^.GetData(StandardUnits);
  519. end
  520. else
  521. Dispose(C, Done);
  522. Execute:=R;
  523. end;
  524. procedure TCodeCompleteDialog.Add;
  525. var IC: boolean;
  526. S: string;
  527. P: PString;
  528. Cmd: word;
  529. CanExit: boolean;
  530. I: sw_integer;
  531. begin
  532. IC:=CodeCompleteLB^.Range=0;
  533. if IC=false then
  534. S:=GetStr(CodeCompleteLB^.List^.At(CodeCompleteLB^.Focused))
  535. else
  536. S:='';
  537. repeat
  538. Cmd:=InputBox(dialog_codecomplete_add,label_codecomplete_add_keyword,S,255);
  539. CanExit:=Cmd<>cmOK;
  540. if CanExit=false then
  541. begin
  542. CanExit:=PCodeCompleteWordList(CodeCompleteLB^.List)^.Search(@S,I)=false;
  543. if CanExit=false then
  544. begin
  545. ClearFormatParams; AddFormatParamStr(S);
  546. ErrorBox(msg_codecomplete_alreadyinlist,@FormatParams);
  547. end;
  548. end;
  549. until CanExit;
  550. if Cmd=cmOK then
  551. begin
  552. P:=NewStr(S);
  553. with CodeCompleteLB^ do
  554. begin
  555. List^.Insert(P);
  556. SetRange(List^.Count);
  557. SetFocusedItem(P);
  558. end;
  559. ReDraw;
  560. end;
  561. end;
  562. procedure TCodeCompleteDialog.Edit;
  563. var S: string;
  564. I,T: sw_integer;
  565. Cmd: word;
  566. CanExit: boolean;
  567. P: PString;
  568. begin
  569. if CodeCompleteLB^.Range=0 then Exit;
  570. I:=CodeCompleteLB^.Focused;
  571. S:=GetStr(CodeCompleteLB^.List^.At(I));
  572. repeat
  573. Cmd:=InputBox(dialog_codecomplete_edit,label_codecomplete_edit_keyword,S,255);
  574. CanExit:=Cmd<>cmOK;
  575. if CanExit=false then
  576. begin
  577. CanExit:=PCodeCompleteWordList(CodeCompleteLB^.List)^.Search(@S,T)=false;
  578. CanExit:=CanExit or (T=I);
  579. if CanExit=false then
  580. begin
  581. ClearFormatParams; AddFormatParamStr(S);
  582. ErrorBox(msg_codecomplete_alreadyinlist,@FormatParams);
  583. end;
  584. end;
  585. until CanExit;
  586. if Cmd=cmOK then
  587. begin
  588. P:=NewStr(S);
  589. with CodeCompleteLB^ do
  590. begin
  591. List^.AtFree(I);
  592. List^.Insert(P);
  593. SetFocusedItem(P);
  594. end;
  595. ReDraw;
  596. end;
  597. end;
  598. procedure TCodeCompleteDialog.Delete;
  599. begin
  600. if CodeCompleteLB^.Range=0 then Exit;
  601. CodeCompleteLB^.List^.AtFree(CodeCompleteLB^.Focused);
  602. CodeCompleteLB^.SetRange(CodeCompleteLB^.List^.Count);
  603. ReDraw;
  604. end;
  605. procedure RegisterCodeComplete;
  606. begin
  607. {$ifndef NOOBJREG}
  608. RegisterType(RCodeCompleteWordList);
  609. {$endif}
  610. end;
  611. END.