mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-26 22:03:41 +02:00
332 lines
8.3 KiB
ObjectPascal
332 lines
8.3 KiB
ObjectPascal
unit FPCodCmp; { CodeComplete }
|
|
|
|
interface
|
|
|
|
uses Objects,Drivers,Dialogs,
|
|
WUtils,WViews;
|
|
|
|
type
|
|
PCodeCompleteWordList = ^TCodeCompleteWordList;
|
|
TCodeCompleteWordList = object(TTextCollection)
|
|
end;
|
|
|
|
PCodeCompleteDialog = ^TCodeCompleteDialog;
|
|
TCodeCompleteDialog = object(TCenterDialog)
|
|
constructor Init;
|
|
function Execute: Word; virtual;
|
|
procedure HandleEvent(var Event: TEvent); virtual;
|
|
private
|
|
CodeCompleteLB : PAdvancedListBox;
|
|
RB : PRadioButtons;
|
|
procedure Add;
|
|
procedure Edit;
|
|
procedure Delete;
|
|
end;
|
|
|
|
function FPCompleteCodeWord(const WordS: string; var Text: string): boolean;
|
|
|
|
procedure InitCodeComplete;
|
|
function LoadCodeComplete(var S: TStream): boolean;
|
|
function StoreCodeComplete(var S: TStream): boolean;
|
|
procedure DoneCodeComplete;
|
|
|
|
const CodeCompleteWords : PCodeCompleteWordList = nil;
|
|
type
|
|
TCodeCompleteCase = (ccc_unchanged, ccc_lower, ccc_upper, ccc_mixed);
|
|
const
|
|
CodeCompleteCase : TCodeCompleteCase = ccc_unchanged;
|
|
|
|
procedure RegisterCodeComplete;
|
|
|
|
implementation
|
|
|
|
uses Views,MsgBox,
|
|
{$ifdef FVISION}
|
|
FVConsts,
|
|
{$else}
|
|
Commands,
|
|
{$endif}
|
|
WEditor,
|
|
FPConst,FPString,FPViews;
|
|
|
|
{$ifndef NOOBJREG}
|
|
const
|
|
RCodeCompleteWordList: TStreamRec = (
|
|
ObjType: 14401;
|
|
VmtLink: Ofs(TypeOf(TCodeCompleteWordList)^);
|
|
Load: @TCodeCompleteWordList.Load;
|
|
Store: @TCodeCompleteWordList.Store
|
|
);
|
|
{$endif}
|
|
|
|
function FPCompleteCodeWord(const WordS: string; var Text: string): boolean;
|
|
var OK: boolean;
|
|
Index: sw_integer;
|
|
begin
|
|
OK:=Assigned(CodeCompleteWords);
|
|
if OK then
|
|
begin
|
|
Text:=CodeCompleteWords^.Lookup(WordS,Index);
|
|
OK:=(Index<>-1) and (length(Text)<>length(WordS));
|
|
end;
|
|
if OK=false then Text:=''
|
|
else case CodeCompleteCase of
|
|
ccc_upper : Text:=UpcaseStr(Text);
|
|
ccc_lower : Text:=LowcaseStr(Text);
|
|
ccc_mixed : Text:=UpCase(Text[1])+LowCaseStr(Copy(Text,2,High(Text)));
|
|
end;
|
|
FPCompleteCodeWord:=OK;
|
|
end;
|
|
|
|
procedure InitCodeComplete;
|
|
var I:integer;
|
|
S: string;
|
|
begin
|
|
if Assigned(CodeCompleteWords) then Exit;
|
|
|
|
New(CodeCompleteWords, Init(10,10));
|
|
for I:=0 to GetReservedWordCount-1 do
|
|
begin
|
|
S:=LowCaseStr(GetReservedWord(I));
|
|
if length(S)>=CodeCompleteMinLen then
|
|
CodeCompleteWords^.Insert(NewStr(S));
|
|
end;
|
|
{
|
|
there should be also a user front-end for customizing CodeComplete !
|
|
any volunteers to implement? ;) - Gabor
|
|
}
|
|
end;
|
|
|
|
function LoadCodeComplete(var S: TStream): boolean;
|
|
var C: PCodeCompleteWordList;
|
|
OK: boolean;
|
|
begin
|
|
New(C, Load(S));
|
|
OK:=Assigned(C) and (S.Status=stOk);
|
|
if OK then
|
|
begin
|
|
if Assigned(CodeCompleteWords) then Dispose(CodeCompleteWords, Done);
|
|
CodeCompleteWords:=C;
|
|
S.Read(CodeCompleteCase,Sizeof(TCodeCompleteCase));
|
|
end
|
|
else
|
|
if Assigned(C) then
|
|
Dispose(C, Done);
|
|
LoadCodeComplete:=OK;
|
|
end;
|
|
|
|
function StoreCodeComplete(var S: TStream): boolean;
|
|
var OK: boolean;
|
|
begin
|
|
OK:=Assigned(CodeCompleteWords);
|
|
if OK then
|
|
begin
|
|
CodeCompleteWords^.Store(S);
|
|
S.Write(CodeCompleteCase,Sizeof(TCodeCompleteCase));
|
|
OK:=OK and (S.Status=stOK);
|
|
end;
|
|
StoreCodeComplete:=OK;
|
|
end;
|
|
|
|
procedure DoneCodeComplete;
|
|
begin
|
|
if Assigned(CodeCompleteWords) then Dispose(CodeCompleteWords, Done);
|
|
CodeCompleteWords:=nil;
|
|
end;
|
|
|
|
constructor TCodeCompleteDialog.Init;
|
|
var R,R2,R3: TRect;
|
|
Items: PSItem;
|
|
SB: PScrollBar;
|
|
begin
|
|
R.Assign(0,0,46,20);
|
|
inherited Init(R,dialog_codecomplete);
|
|
HelpCtx:=hcCodeCompleteOptions;
|
|
GetExtent(R); R.Grow(-3,-2); Inc(R.A.Y); R3.Copy(R); Dec(R.B.X,12);
|
|
Dec(R.B.Y,5);
|
|
R2.Copy(R); R2.Move(1,0); R2.A.X:=R2.B.X-1;
|
|
New(SB, Init(R2)); Insert(SB);
|
|
New(CodeCompleteLB, Init(R,1,SB));
|
|
Insert(CodeCompleteLB);
|
|
R2.Copy(R); R2.Move(0,-1); R2.B.Y:=R2.A.Y+1; Dec(R2.A.X);
|
|
Insert(New(PLabel, Init(R2, label_codecomplete_keywords, CodeCompleteLB)));
|
|
|
|
R.Copy(R3); R.A.Y:=R.B.Y-4; Dec(R.B.X,14); Inc(R.A.X);
|
|
Items:=NewSItem('Unc~h~anged',
|
|
NewSItem('~L~ower',
|
|
NewSItem('~U~pper',
|
|
NewSItem('~M~ixed',nil))));
|
|
RB:=New(PRadioButtons,Init(R,Items));
|
|
RB^.SetData(ord(CodeCompleteCase));
|
|
R2.Copy(R); R2.Move(0,-1); R2.B.Y:=R2.A.Y+1; Dec(R2.A.X);
|
|
Insert(New(PLabel, Init(R2, 'Case handling', RB)));
|
|
Insert(RB);
|
|
|
|
R.Copy(R3); R.A.X:=R.B.X-10; R.B.Y:=R.A.Y+2;
|
|
Insert(New(PButton, Init(R, button_OK, cmOK, bfNormal)));
|
|
R.Move(0,2);
|
|
Insert(New(PButton, Init(R, button_Edit, cmEditItem, bfDefault)));
|
|
R.Move(0,2);
|
|
Insert(New(PButton, Init(R, button_New, cmAddItem, bfNormal)));
|
|
R.Move(0,2);
|
|
Insert(New(PButton, Init(R, button_Delete, cmDeleteItem, bfNormal)));
|
|
R.Move(0,2);
|
|
Insert(New(PButton, Init(R, button_Cancel, cmCancel, bfNormal)));
|
|
SelectNext(false);
|
|
end;
|
|
|
|
procedure TCodeCompleteDialog.HandleEvent(var Event: TEvent);
|
|
var DontClear: boolean;
|
|
begin
|
|
case Event.What of
|
|
evKeyDown :
|
|
begin
|
|
DontClear:=false;
|
|
case Event.KeyCode of
|
|
kbIns :
|
|
Message(@Self,evCommand,cmAddItem,nil);
|
|
kbDel :
|
|
Message(@Self,evCommand,cmDeleteItem,nil);
|
|
else DontClear:=true;
|
|
end;
|
|
if DontClear=false then ClearEvent(Event);
|
|
end;
|
|
evBroadcast :
|
|
case Event.Command of
|
|
cmListItemSelected :
|
|
if Event.InfoPtr=pointer(CodeCompleteLB) then
|
|
Message(@Self,evCommand,cmEditItem,nil);
|
|
end;
|
|
evCommand :
|
|
begin
|
|
DontClear:=false;
|
|
case Event.Command of
|
|
cmAddItem : Add;
|
|
cmDeleteItem : Delete;
|
|
cmEditItem : Edit;
|
|
else DontClear:=true;
|
|
end;
|
|
if DontClear=false then ClearEvent(Event);
|
|
end;
|
|
end;
|
|
inherited HandleEvent(Event);
|
|
end;
|
|
|
|
function TCodeCompleteDialog.Execute: Word;
|
|
var R: word;
|
|
C: PCodeCompleteWordList;
|
|
I: integer;
|
|
begin
|
|
New(C, Init(10,20));
|
|
if Assigned(CodeCompleteWords) then
|
|
for I:=0 to CodeCompleteWords^.Count-1 do
|
|
C^.Insert(NewStr(GetStr(CodeCompleteWords^.At(I))));
|
|
CodeCompleteLB^.NewList(C);
|
|
R:=inherited Execute;
|
|
if R=cmOK then
|
|
begin
|
|
if Assigned(CodeCompleteWords) then Dispose(CodeCompleteWords, Done);
|
|
CodeCompleteWords:=C;
|
|
CodeCompleteCase:=TCodeCompleteCase(RB^.Value);
|
|
end
|
|
else
|
|
Dispose(C, Done);
|
|
Execute:=R;
|
|
end;
|
|
|
|
procedure TCodeCompleteDialog.Add;
|
|
var IC: boolean;
|
|
S: string;
|
|
P: PString;
|
|
Cmd: word;
|
|
CanExit: boolean;
|
|
I: sw_integer;
|
|
begin
|
|
IC:=CodeCompleteLB^.Range=0;
|
|
if IC=false then
|
|
S:=GetStr(CodeCompleteLB^.List^.At(CodeCompleteLB^.Focused))
|
|
else
|
|
S:='';
|
|
|
|
repeat
|
|
Cmd:=InputBox(dialog_codecomplete_add,label_codecomplete_add_keyword,S,255);
|
|
CanExit:=Cmd<>cmOK;
|
|
if CanExit=false then
|
|
begin
|
|
CanExit:=PCodeCompleteWordList(CodeCompleteLB^.List)^.Search(@S,I)=false;
|
|
if CanExit=false then
|
|
begin
|
|
ClearFormatParams; AddFormatParamStr(S);
|
|
ErrorBox(msg_codecomplete_alreadyinlist,@FormatParams);
|
|
end;
|
|
end;
|
|
until CanExit;
|
|
|
|
if Cmd=cmOK then
|
|
begin
|
|
P:=NewStr(S);
|
|
with CodeCompleteLB^ do
|
|
begin
|
|
List^.Insert(P);
|
|
SetRange(List^.Count);
|
|
SetFocusedItem(P);
|
|
end;
|
|
ReDraw;
|
|
end;
|
|
end;
|
|
|
|
procedure TCodeCompleteDialog.Edit;
|
|
var S: string;
|
|
I,T: sw_integer;
|
|
Cmd: word;
|
|
CanExit: boolean;
|
|
P: PString;
|
|
begin
|
|
if CodeCompleteLB^.Range=0 then Exit;
|
|
I:=CodeCompleteLB^.Focused;
|
|
S:=GetStr(CodeCompleteLB^.List^.At(I));
|
|
repeat
|
|
Cmd:=InputBox(dialog_codecomplete_edit,label_codecomplete_edit_keyword,S,255);
|
|
CanExit:=Cmd<>cmOK;
|
|
if CanExit=false then
|
|
begin
|
|
CanExit:=PCodeCompleteWordList(CodeCompleteLB^.List)^.Search(@S,T)=false;
|
|
CanExit:=CanExit or (T=I);
|
|
if CanExit=false then
|
|
begin
|
|
ClearFormatParams; AddFormatParamStr(S);
|
|
ErrorBox(msg_codecomplete_alreadyinlist,@FormatParams);
|
|
end;
|
|
end;
|
|
until CanExit;
|
|
|
|
if Cmd=cmOK then
|
|
begin
|
|
P:=NewStr(S);
|
|
with CodeCompleteLB^ do
|
|
begin
|
|
List^.AtFree(I);
|
|
List^.Insert(P);
|
|
SetFocusedItem(P);
|
|
end;
|
|
ReDraw;
|
|
end;
|
|
end;
|
|
|
|
procedure TCodeCompleteDialog.Delete;
|
|
begin
|
|
if CodeCompleteLB^.Range=0 then Exit;
|
|
CodeCompleteLB^.List^.AtFree(CodeCompleteLB^.Focused);
|
|
CodeCompleteLB^.SetRange(CodeCompleteLB^.List^.Count);
|
|
ReDraw;
|
|
end;
|
|
|
|
procedure RegisterCodeComplete;
|
|
begin
|
|
{$ifndef NOOBJREG}
|
|
RegisterType(RCodeCompleteWordList);
|
|
{$endif}
|
|
end;
|
|
|
|
END.
|