From 4748f5611d4542f83b0fc87766eeee8033479cc8 Mon Sep 17 00:00:00 2001 From: Raymond Date: Tue, 30 Mar 2010 19:58:41 +0200 Subject: [PATCH 1/7] Fixed small bug in Code Insight + made a start with code hints. --- Projects/SAMufasaGUI/framescript.pas | 200 +++++++++++++++++---------- Projects/SAMufasaGUI/testunit.pas | 13 +- Units/Misc/v_ideCodeParser.pas | 9 +- 3 files changed, 135 insertions(+), 87 deletions(-) diff --git a/Projects/SAMufasaGUI/framescript.pas b/Projects/SAMufasaGUI/framescript.pas index 969756b..06ade76 100644 --- a/Projects/SAMufasaGUI/framescript.pas +++ b/Projects/SAMufasaGUI/framescript.pas @@ -32,6 +32,7 @@ uses v_ideCodeInsight, v_ideCodeParser, CastaliaPasLexTypes, CastaliaSimplePasPar, SynEditHighlighter; const ecCodeCompletion = ecUserFirst; + ecCodeHints = ecUserFirst + 1; type TScriptState = (ss_None,ss_Running,ss_Paused,ss_Stopping); { @@ -256,89 +257,145 @@ var mp: TCodeInsight; ms: TMemoryStream; ItemList, InsertList: TStringList; - sp, ep: Integer; + sp, ep,bcc,cc,bck: Integer; p: TPoint; s, Filter: string; Attri: TSynHighlighterAttributes; + d: TDeclaration; + dd: TDeclaration; begin - if (Command = ecCodeCompletion) and ((not SynEdit.GetHighlighterAttriAtRowCol(SynEdit.CaretXY, s, Attri)) or (Attri.Name = 'Identifier')) then + if ((not SynEdit.GetHighlighterAttriAtRowCol(SynEdit.CaretXY, s, Attri)) or (Attri.Name = 'Identifier')) then begin - {form1.FunctionListShown(True); - with form1.frmFunctionList do - if editSearchList.CanFocus then - begin; - editSearchList.SetFocus; - LineText := SynEdit.LineText; - Caret:=SynEdit.LogicalCaretXY; - i := Caret.X - 1; - endi := caret.x; - if (i > length(LineText)) or ((i = 0) and (length(lineText) = 0)) then + if (Command = ecCodeCompletion) then + begin; + {form1.FunctionListShown(True); + with form1.frmFunctionList do + if editSearchList.CanFocus then + begin; + editSearchList.SetFocus; + LineText := SynEdit.LineText; + Caret:=SynEdit.LogicalCaretXY; + i := Caret.X - 1; + endi := caret.x; + if (i > length(LineText)) or ((i = 0) and (length(lineText) = 0)) then + begin + SearchText:= ''; + CompletionLine := PadRight(linetext,caret.x); + end + else begin + while (i > 0) and (LineText[i] in ['a'..'z','A'..'Z','0'..'9','_']) do + dec(i); + while LineText[endi] in ['a'..'z','A'..'Z','0'..'9','_'] do + inc(endi); + SearchText := Trim(copy(LineText, i + 1, Caret.X - i - 1)); + CompletionLine := LineText; + end; + CompletionStart:= LineText; + Delete(CompletionLine,i+1,endi - i - 1); + Insert('%s',CompletionLine,i+1); + CompletionCaret := Point(endi,Caret.y); + StartWordCompletion:= Point(i+1,caret.y); + mDebugLn(CompletionLine); + mDebugLn(CompletionStart); + InCodeCompletion := true; + editSearchList.Text:= SearchText; + editSearchList.SelStart:= Length(searchText); + SynEdit.SelectedColor.Style:= [fsUnderline]; + SynEdit.SelectedColor.Foreground:= clBlack; + SynEdit.SelectedColor.Background:= clWhite; + Synedit.MarkupByClass[TSynEditMarkupHighlightAllCaret].TempDisable; + end;} + mp := TCodeInsight.Create; + mp.FileName := ScriptFile; + mp.OnMessage := @Form1.OnCCMessage; + mp.OnFindInclude := @Form1.OnCCFindInclude; + + ms := TMemoryStream.Create; + ItemList := TStringList.Create; + InsertList := TStringList.Create; + InsertList.Sorted := True; + + Synedit.Lines.SaveToStream(ms); + + try + Filter := WordAtCaret(Synedit, sp, ep); + Form1.CodeCompletionStart := Point(sp, Synedit.CaretY); + mp.Run(ms, nil, Synedit.SelStart + (ep - Synedit.CaretX) - 1); + + s := mp.GetExpressionAtPos; + if (s <> '') then begin - SearchText:= ''; - CompletionLine := PadRight(linetext,caret.x); - end - else begin - while (i > 0) and (LineText[i] in ['a'..'z','A'..'Z','0'..'9','_']) do - dec(i); - while LineText[endi] in ['a'..'z','A'..'Z','0'..'9','_'] do - inc(endi); - SearchText := Trim(copy(LineText, i + 1, Caret.X - i - 1)); - CompletionLine := LineText; + sp := LastDelimiter('.', s); + if (sp > 0) then + Delete(s, sp, Length(s) - sp + 1) + else + s := ''; end; - CompletionStart:= LineText; - Delete(CompletionLine,i+1,endi - i - 1); - Insert('%s',CompletionLine,i+1); - CompletionCaret := Point(endi,Caret.y); - StartWordCompletion:= Point(i+1,caret.y); - mDebugLn(CompletionLine); - mDebugLn(CompletionStart); - InCodeCompletion := true; - editSearchList.Text:= SearchText; - editSearchList.SelStart:= Length(searchText); - SynEdit.SelectedColor.Style:= [fsUnderline]; - SynEdit.SelectedColor.Foreground:= clBlack; - SynEdit.SelectedColor.Background:= clWhite; - Synedit.MarkupByClass[TSynEditMarkupHighlightAllCaret].TempDisable; - end;} - mp := TCodeInsight.Create; - mp.FileName := ScriptFile; - mp.OnMessage := @Form1.OnCCMessage; - mp.OnFindInclude := @Form1.OnCCFindInclude; - ms := TMemoryStream.Create; - ItemList := TStringList.Create; - InsertList := TStringList.Create; - InsertList.Sorted := True; - - Synedit.Lines.SaveToStream(ms); - - try - Filter := WordAtCaret(Synedit, sp, ep); - Form1.CodeCompletionStart := Point(sp, Synedit.CaretY); - mp.Run(ms, nil, Synedit.SelStart + (ep - Synedit.CaretX) - 1); - - s := mp.GetExpressionAtPos; - if (s <> '') then - begin - sp := LastDelimiter('.', s); - if (sp > 0) then - Delete(s, sp, Length(s) - sp + 1) - else - s := ''; + mp.FillSynCompletionProposal(ItemList, InsertList, s); + p := SynEdit.ClientToScreen(SynEdit.RowColumnToPixels(Point(ep, SynEdit.CaretY))); + p.y := p.y + SynEdit.LineHeight; + Form1.CodeCompletionForm.Show(p, ItemList, InsertList, Filter, SynEdit); + finally + FreeAndNil(ms); + FreeAndNil(mp); + ItemList.Free; + InsertList.Free; end; + end else + if command = ecCodeHints then + begin + mp := TCodeInsight.Create; + mp.OnMessage := @form1.OnCCMessage; + mp.OnFindInclude := @form1.OnCCFindInclude; - mp.FillSynCompletionProposal(ItemList, InsertList, s); - p := SynEdit.ClientToScreen(SynEdit.RowColumnToPixels(Point(ep, SynEdit.CaretY))); - p.y := p.y + SynEdit.LineHeight; - Form1.CodeCompletionForm.Show(p, ItemList, InsertList, Filter, SynEdit); - finally - FreeAndNil(ms); - FreeAndNil(mp); - ItemList.Free; - InsertList.Free; + ms := TMemoryStream.Create; + synedit.Lines.SaveToStream(ms); + + try + Synedit.GetWordBoundsAtRowCol(Synedit.CaretXY, sp, ep); + mp.Run(ms, nil, Synedit.SelStart + (ep - Synedit.CaretX) - 1); + //mp.Position := Synedit.SelStart + (ep - Synedit.CaretX) - 1; + + bcc := 1; + bck := 0; + cc := 0; + s := mp.GetExpressionAtPos(bcc, bck, cc, True); + if (s <> '') then + Delete(s, Length(s), 1); + + d := mp.FindVarBase(s); + dd := nil; + while (d <> nil) and (d <> dd) and (d.Owner <> nil) and (not ((d is TciProcedureDeclaration) or (d.Owner is TciProcedureDeclaration))) do + begin + dd := d; + d := d.Owner.Items.GetFirstItemOfClass(TciTypeKind); + if (d <> nil) then + begin + d := TciTypeKind(d).GetRealType; + if (d is TciReturnType) then + d := d.Owner; + end; + if (d <> nil) and (d.Owner <> nil) and (not ((d is TciProcedureDeclaration) or (d.Owner is TciProcedureDeclaration))) then + d := mp.FindVarBase(d.CleanText) + else + Break; + end; + if (d <> nil) and (d <> dd) and (d.Owner <> nil) and ((d is TciProcedureDeclaration) or (d.Owner is TciProcedureDeclaration)) then + begin + if (not (d is TciProcedureDeclaration)) and (d.Owner is TciProcedureDeclaration) then + d := d.Owner; + if (TciProcedureDeclaration(d).SynParams <> '') then + formWriteln(TciProcedureDeclaration(d).SynParams) + else + FormWriteln(''); + end; + finally + FreeAndNil(ms); + FreeAndNil(mp); + end; end; end; - if Form1.CodeCompletionForm.Visible then case Command of ecDeleteChar, ecDeleteWord, ecDeleteEOL: @@ -522,6 +579,7 @@ begin MarkCaret.IgnoreKeywords := true; end; AddKey(SynEdit,ecCodeCompletion,VK_SPACE,[ssCtrl]); + AddKey(SynEdit,ecCodeHints,VK_SPACE,[ssCtrl,ssShift]); // TSynPasSyn(SynEdit.Highlighter).NestedComments:= false; Does not work :( end; diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index 1efe285..2d6c2fc 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -40,7 +40,7 @@ uses colourpicker, framescript, windowselector, lcltype, ActnList, SynExportHTML, SynEditKeyCmds, SynEditHighlighter, SynEditMarkupHighAll, LMessages, Buttons,mmisc, - stringutil,mufasatypesutil,mufasabase, + stringutil,mufasatypesutil,mufasabase, v_ideCodeParser, about, framefunctionlist, ocr, updateform, simbasettings, psextension, virtualextension, extensionmanager, settingssandbox, v_ideCodeInsight, CastaliaPasLexTypes, CastaliaSimplePasPar, v_AutoCompleteForm, PSDump; @@ -2213,17 +2213,8 @@ begin end; procedure TForm1.ButtonTrayClick(Sender: TObject); -{var - ms : TMemoryStream; - fs : TFileStream;} begin -{ - fs := TFileStream.Create('c:\remake\fonts.tar.bz2',fmOpenRead); - ms := DecompressBZip2(fs); - fs.free; - UnTar(ms,'c:\remake\fonttest\',true); - ms.free;} - Form1.Hide; + self.hide; end; procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean diff --git a/Units/Misc/v_ideCodeParser.pas b/Units/Misc/v_ideCodeParser.pas index 52f3af4..4a5224b 100644 --- a/Units/Misc/v_ideCodeParser.pas +++ b/Units/Misc/v_ideCodeParser.pas @@ -864,17 +864,16 @@ begin a := GetParamDeclarations; for i := Low(a) to High(a) do begin - if (fItems[i] is TciConstParameter) then + if (a[i] is TciConstParameter) then s := 'const ' - else if (fItems[i] is TciOutParameter) then + else if (a[i] is TciOutParameter) then s := 'out ' - else if (fItems[i] is TciInParameter) then + else if (a[i] is TciInParameter) then s := 'in ' - else if (fItems[i] is TciVarParameter) then + else if (a[i] is TciVarParameter) then s := 'var ' else s := ''; - d := a[i].Items.GetFirstItemOfClass(TciParameterType); if (d <> nil) then t := ': ' + d.ShortText From 605ef21bfec8d717aca12362b4be128d43454e0a Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Wed, 31 Mar 2010 00:24:16 +0200 Subject: [PATCH 2/7] First real pyMML code. --- Projects/MMLLib/libmml.lpr | 129 ++++++++++++++++++++++++++++-- Projects/MMLLib/pymml/mml.py | 31 +++++++ Projects/MMLLib/pymml/mmlmouse.py | 44 ++++++++++ 3 files changed, 196 insertions(+), 8 deletions(-) create mode 100755 Projects/MMLLib/pymml/mml.py create mode 100644 Projects/MMLLib/pymml/mmlmouse.py diff --git a/Projects/MMLLib/libmml.lpr b/Projects/MMLLib/libmml.lpr index 2c208ae..da42b68 100644 --- a/Projects/MMLLib/libmml.lpr +++ b/Projects/MMLLib/libmml.lpr @@ -11,22 +11,57 @@ type PTPoint = ^TPoint; PPDTM = ^PDTM; + +Const + RESULT_OK = 0; + RESULT_ERROR = 1; + var C: TClient; -function test: pchar; + gr: Pointer; + last_error: PChar; + + +function init: integer; cdecl; +begin + C:=TClient.Create(''); + result:=0; +end; + +function test: pchar; cdecl; begin result := PChar('hello world'); + raise exception.Create('wat'); end; -procedure init; +{ Mouse } + +function getmousepos(var t: tpoint): integer; cdecl; + begin - C:=TCLient.Create(''); + try + C.IOManager.GetMousePos(t.x,t.y); + result := RESULT_OK; + except on e : Exception do + begin + result := RESULT_ERROR; + last_error := PChar(e.Message); + end; + end; end; -function getmousepos: tpoint; cdecl; -begin - C.IOManager.GetMousePos(result.x,result.y); -end; +{function ConvIntClickType(Int : Integer) : TClickType;inline; +begin; + case int of + ps_mouse_right : result := mouse_Right; + ps_mouse_left : result := mouse_left; + ps_mouse_middle: result := mouse_middle; + else + raise exception.CreateFMT('Unknown Clicktype (%d) passed.',[int]); + end; +end; } + + function returnpoints: PTPoint; cdecl; @@ -54,12 +89,84 @@ function givedtm:PPDTM; cdecl; var dtm: PPDTM; begin + writeln('Size: ' + inttostr(sizeof(pdtm))); + writeln('Size: ' + inttostr(sizeof(ptruint))); dtm := AllocMem(sizeof(pdtm)); initdtm(dtm^,2); result:=dtm; dtm^.n := PChar('wat'); end; +function givedtm2:PDTM; cdecl; + +var + dtm: pdtm; +begin + initdtm(dtm,2); + result:=dtm; + //result.n := PChar('wat'); + //writeln('woohoo'); +end; + +function returnarray: tpointarray; cdecl; +var + i:integer; +begin + setlength(result,5); + for i := 0 to high(result) do + result[i] := Point(i * 50, i + 50); + writeln('res: ' + IntToStr(PtrUInt(result))); + gr := @result[0]; +end; + +procedure printarray2(var arr: TPointArray); cdecl; +var i:integer; +begin + for i := 0 to high(arr) do + writeln(inttostr(arr[i].x) + ',' + inttostr(arr[i].y)); + setlength(arr,0); + writeln('GR: ' + inttostr(tpoint(tpointarray(gr)[0]).y)); +end; + +procedure printarray(arr: PTPoint); cdecl; +var + i:integer; + arr2: TPointArray; +begin + writeln('arr: ' + IntToStr(PtrUInt(@arr[0]))); + setlength(arr2,0); + arr2 := @arr[0]; + writeln('arr2: ' + IntToStr(PtrUInt(@arr2[0]))); + { for i := 0 to 4 do + writeln(inttostr(arr[i].x) + ',' + inttostr(arr[i].y)); + + writeln(length(arr2)); + for i := 0 to high(arr2) do + writeln(inttostr(arr2[i].x) + ',' + inttostr(arr2[i].y)); } + + printarray2(arr2); + writeln(inttostr(length(arr2))); + writeln(inttostr(arr[0].x) + ',' + inttostr(arr[0].y)); +end; + +procedure fpc_freemem_(p:pointer); cdecl; +begin + writeln('free: ' + inttostr(qword(p))); + freemem(pointer(ptruint(p))); +end; + +function fpc_allocmem_(size: ptruint): pointer; cdecl; +begin + result:=AllocMem(size); + writeln('alloc: ' + inttostr(qword(result))); +end; + +function fpc_reallocmem_(size: ptruint; ptr: pointer): pointer; +begin + result:=ReAllocMem(ptr, size); +end; + + exports test, init, @@ -67,7 +174,13 @@ exports returnpoints, printpoints, hoi, - givedtm; + givedtm, + givedtm2, + returnarray, + printarray, + fpc_freemem_, + fpc_allocmem_, + fpc_reallocmem_; begin diff --git a/Projects/MMLLib/pymml/mml.py b/Projects/MMLLib/pymml/mml.py new file mode 100755 index 0000000..22de916 --- /dev/null +++ b/Projects/MMLLib/pymml/mml.py @@ -0,0 +1,31 @@ +#!/usr/bin/env python + +from ctypes import * +import platform +from mmlmouse import Mouse + +class MMLCoreException(Exception): + def __init__(self, err): + Exception.__init__(self, err) + +class MMLCore(object): + def __init__(self, dllpath): + self.dll = CDLL(dllpath) + + self.dll.init.restype = c_int + self.dll.init.argtypes = None + if self.dll.init() != 0: + del self.dll + raise MMLCoreException("Could not initialize the DLL") + + def __del__(self): + del self.dll + +DLL = MMLCore('../libmml.so') + +m = Mouse(DLL) +print m._getMousePos() + +del DLL + + diff --git a/Projects/MMLLib/pymml/mmlmouse.py b/Projects/MMLLib/pymml/mmlmouse.py new file mode 100644 index 0000000..cb3c3dd --- /dev/null +++ b/Projects/MMLLib/pymml/mmlmouse.py @@ -0,0 +1,44 @@ +from ctypes import * +from mml import +from mmltypes import POINT + +# Usage: +class Mouse(object): + # _mc = MMLCore reference. + _mc = None + + # last pointer position + _lpp = (0, 0) + + def __init__(self, MC): + '''Initialize the Mouse object''' + self._mc = MC + self._initialiseDLLFuncs() + pass + + def _initialiseDLLFuncs(self): + self._mc.dll.getmousepos.restype = c_int + self._mc.dll.getmousepos.argtypes = [PPOINT] + pass + + # Will be used to get the states of the mouse + def __getitem__(self, item): + pass + + # Will be used to set states of the mouse + def __setitem__(self, item, value): + pass + + # internal function + def _getMousePos(self): + ret = POINT() + ok = self._mc.dll.getmousepos(byref(ret)) + # FIXME: Perhaps use some sort of assertion? + # We should print dll.last_error is ok != 0 + + self._lpp = (ret.x, ret.y) + return (ret.x, ret.y) + + # internal function + def _getMouseButtonState(self, button): + pass From 422fc0b923a9ce20f41a5ec519fcd183cb5a797a Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Wed, 31 Mar 2010 00:28:36 +0200 Subject: [PATCH 3/7] Forgot this file --- Projects/MMLLib/pymml/mmltypes.py | 9 +++++++++ 1 file changed, 9 insertions(+) create mode 100644 Projects/MMLLib/pymml/mmltypes.py diff --git a/Projects/MMLLib/pymml/mmltypes.py b/Projects/MMLLib/pymml/mmltypes.py new file mode 100644 index 0000000..c5cef85 --- /dev/null +++ b/Projects/MMLLib/pymml/mmltypes.py @@ -0,0 +1,9 @@ +from ctypes import * + +class POINT(Structure): + _fields_ = [('x', c_int), + ('y', c_int)] + +PPOINT = POINTER(POINT) + + From d5c29d57ef635d1e00a0926046333d573ee9f862 Mon Sep 17 00:00:00 2001 From: Raymond Date: Wed, 31 Mar 2010 20:23:39 +0200 Subject: [PATCH 4/7] Code hints work! Press ctrl + shift + space to activate it :). --- Projects/SAMufasaGUI/framescript.pas | 194 +++++++----- Projects/SAMufasaGUI/testunit.pas | 4 + Units/Misc/v_autocompleteform.pas | 441 ++++++++++++++++++++++++--- Units/Misc/v_ideCodeInsight.pas | 14 +- 4 files changed, 521 insertions(+), 132 deletions(-) diff --git a/Projects/SAMufasaGUI/framescript.pas b/Projects/SAMufasaGUI/framescript.pas index 06ade76..be99ab4 100644 --- a/Projects/SAMufasaGUI/framescript.pas +++ b/Projects/SAMufasaGUI/framescript.pas @@ -29,7 +29,7 @@ interface uses Classes, SysUtils, FileUtil, LResources, Forms, SynHighlighterPas, SynEdit, SynEditMarkupHighAll, mmlpsthread,ComCtrls, SynEditKeyCmds, LCLType,MufasaBase, SynEditMarkupSpecialLine, Graphics, Controls, - v_ideCodeInsight, v_ideCodeParser, CastaliaPasLexTypes, CastaliaSimplePasPar, SynEditHighlighter; + v_ideCodeInsight, v_ideCodeParser, CastaliaPasLexTypes, CastaliaSimplePasPar, SynEditHighlighter,synedittextbase; const ecCodeCompletion = ecUserFirst; ecCodeHints = ecUserFirst + 1; @@ -125,6 +125,28 @@ begin Result := Copy(s, sp, ep - sp + 1); end; +function PosToCaretXY(e : TSynEdit; pos : integer) : TPoint; + function llen(const data: string): integer; + begin + result := length(Data) + length(LineEnding); + end; + +var + loop: integer; + count: integer; + Lines : TStrings; +begin + loop := 0; + count := 0; + Lines := e.Lines; + while (loop < Lines.Count) and (count + llen(Lines[loop]) < pos) do begin + count := count + llen(Lines[loop]); + inc(loop); + end; + result.x := pos - count; + result.y := loop + 1; +end; + { TScriptFrame } procedure TScriptFrame.SynEditChange(Sender: TObject); @@ -214,13 +236,15 @@ begin Form1.ActionFindNextExecute(Sender); key := 0; end; + if key = VK_ESCAPE then + Form1.ParamHint.Hide; Form1.CodeCompletionForm.HandleKeyDown(Sender, Key, Shift); end; procedure TScriptFrame.SynEditKeyPress(Sender: TObject; var Key: char); begin - Form1.CodeCompletionForm.HandleKeyPress(Sender, Key); + Form1.CodeCompletionForm.HandleKeyPress(Sender, Key); end; procedure TScriptFrame.SynEditMouseLink(Sender: TObject; X, Y: Integer; @@ -257,17 +281,15 @@ var mp: TCodeInsight; ms: TMemoryStream; ItemList, InsertList: TStringList; - sp, ep,bcc,cc,bck: Integer; + sp, ep,bcc,cc,bck,posi,bracketpos: Integer; p: TPoint; s, Filter: string; Attri: TSynHighlighterAttributes; d: TDeclaration; dd: TDeclaration; begin - if ((not SynEdit.GetHighlighterAttriAtRowCol(SynEdit.CaretXY, s, Attri)) or (Attri.Name = 'Identifier')) then + if (Command = ecCodeCompletion) and ((not SynEdit.GetHighlighterAttriAtRowCol(SynEdit.CaretXY, s, Attri)) or (Attri.Name = 'Identifier')) then begin - if (Command = ecCodeCompletion) then - begin; {form1.FunctionListShown(True); with form1.frmFunctionList do if editSearchList.CanFocus then @@ -305,95 +327,100 @@ begin SynEdit.SelectedColor.Background:= clWhite; Synedit.MarkupByClass[TSynEditMarkupHighlightAllCaret].TempDisable; end;} - mp := TCodeInsight.Create; - mp.FileName := ScriptFile; - mp.OnMessage := @Form1.OnCCMessage; - mp.OnFindInclude := @Form1.OnCCFindInclude; + mp := TCodeInsight.Create; + mp.FileName := ScriptFile; + mp.OnMessage := @Form1.OnCCMessage; + mp.OnFindInclude := @Form1.OnCCFindInclude; - ms := TMemoryStream.Create; - ItemList := TStringList.Create; - InsertList := TStringList.Create; - InsertList.Sorted := True; + ms := TMemoryStream.Create; + ItemList := TStringList.Create; + InsertList := TStringList.Create; + InsertList.Sorted := True; - Synedit.Lines.SaveToStream(ms); + Synedit.Lines.SaveToStream(ms); - try - Filter := WordAtCaret(Synedit, sp, ep); - Form1.CodeCompletionStart := Point(sp, Synedit.CaretY); - mp.Run(ms, nil, Synedit.SelStart + (ep - Synedit.CaretX) - 1); + try + Filter := WordAtCaret(Synedit, sp, ep); + Form1.CodeCompletionStart := Point(sp, Synedit.CaretY); + mp.Run(ms, nil, Synedit.SelStart + (ep - Synedit.CaretX) - 1); - s := mp.GetExpressionAtPos; - if (s <> '') then - begin - sp := LastDelimiter('.', s); - if (sp > 0) then - Delete(s, sp, Length(s) - sp + 1) - else - s := ''; - end; - - mp.FillSynCompletionProposal(ItemList, InsertList, s); - p := SynEdit.ClientToScreen(SynEdit.RowColumnToPixels(Point(ep, SynEdit.CaretY))); - p.y := p.y + SynEdit.LineHeight; - Form1.CodeCompletionForm.Show(p, ItemList, InsertList, Filter, SynEdit); - finally - FreeAndNil(ms); - FreeAndNil(mp); - ItemList.Free; - InsertList.Free; + s := mp.GetExpressionAtPos; + if (s <> '') then + begin + sp := LastDelimiter('.', s); + if (sp > 0) then + Delete(s, sp, Length(s) - sp + 1) + else + s := ''; end; - end else - if command = ecCodeHints then - begin - mp := TCodeInsight.Create; - mp.OnMessage := @form1.OnCCMessage; - mp.OnFindInclude := @form1.OnCCFindInclude; - ms := TMemoryStream.Create; - synedit.Lines.SaveToStream(ms); + mp.FillSynCompletionProposal(ItemList, InsertList, s); + p := SynEdit.ClientToScreen(SynEdit.RowColumnToPixels(Point(ep, SynEdit.CaretY))); + p.y := p.y + SynEdit.LineHeight; + Form1.CodeCompletionForm.Show(p, ItemList, InsertList, Filter, SynEdit); + finally + FreeAndNil(ms); + FreeAndNil(mp); + ItemList.Free; + InsertList.Free; + end; + end; + if command = ecCodeHints then + begin + if Form1.ParamHint.Visible = true then + form1.ParamHint.hide; + mp := TCodeInsight.Create; + mp.OnMessage := @form1.OnCCMessage; + mp.OnFindInclude := @form1.OnCCFindInclude; - try - Synedit.GetWordBoundsAtRowCol(Synedit.CaretXY, sp, ep); - mp.Run(ms, nil, Synedit.SelStart + (ep - Synedit.CaretX) - 1); - //mp.Position := Synedit.SelStart + (ep - Synedit.CaretX) - 1; + ms := TMemoryStream.Create; + synedit.Lines.SaveToStream(ms); + try + Synedit.GetWordBoundsAtRowCol(Synedit.CaretXY, sp, ep); + mp.Run(ms, nil, Synedit.SelStart + (ep - Synedit.CaretX) - 1,true); - bcc := 1; - bck := 0; - cc := 0; - s := mp.GetExpressionAtPos(bcc, bck, cc, True); - if (s <> '') then - Delete(s, Length(s), 1); - - d := mp.FindVarBase(s); - dd := nil; - while (d <> nil) and (d <> dd) and (d.Owner <> nil) and (not ((d is TciProcedureDeclaration) or (d.Owner is TciProcedureDeclaration))) do + bcc := 1;bck := 0;cc := 0; + s := mp.GetExpressionAtPos(bcc, bck, cc,posi, true); + bracketpos := posi + length(s); + if pos('(',s) > 0 then + begin; + bracketpos := pos('(',s) + posi; + delete(s,pos('(',s),length(s) - pos('(',s) + 1); + end; + d := mp.FindVarBase(s); + dd := nil; + //Find the declaration -> For example if one uses var x : TNotifyEvent.. + //You have to get the owner of x, to find the declaration of TNotifyEvent etc.. + while (d <> nil) and (d <> dd) and (d.Owner <> nil) and (not ((d is TciProcedureDeclaration) or (d.Owner is TciProcedureDeclaration))) do + begin + dd := d; + d := d.Owner.Items.GetFirstItemOfClass(TciTypeKind); + if (d <> nil) then begin - dd := d; - d := d.Owner.Items.GetFirstItemOfClass(TciTypeKind); - if (d <> nil) then - begin - d := TciTypeKind(d).GetRealType; - if (d is TciReturnType) then - d := d.Owner; - end; - if (d <> nil) and (d.Owner <> nil) and (not ((d is TciProcedureDeclaration) or (d.Owner is TciProcedureDeclaration))) then - d := mp.FindVarBase(d.CleanText) - else - Break; - end; - if (d <> nil) and (d <> dd) and (d.Owner <> nil) and ((d is TciProcedureDeclaration) or (d.Owner is TciProcedureDeclaration)) then - begin - if (not (d is TciProcedureDeclaration)) and (d.Owner is TciProcedureDeclaration) then + d := TciTypeKind(d).GetRealType; + if (d is TciReturnType) then d := d.Owner; - if (TciProcedureDeclaration(d).SynParams <> '') then - formWriteln(TciProcedureDeclaration(d).SynParams) - else - FormWriteln(''); end; - finally - FreeAndNil(ms); - FreeAndNil(mp); + if (d <> nil) and (d.Owner <> nil) and (not ((d is TciProcedureDeclaration) or (d.Owner is TciProcedureDeclaration))) then + d := mp.FindVarBase(d.CleanText) + else + Break; end; + //Yeah, we should have found the procedureDeclaration now! + if (d <> nil) and (d <> dd) and (d.Owner <> nil) and ((d is TciProcedureDeclaration) or (d.Owner is TciProcedureDeclaration)) then + begin + if (not (d is TciProcedureDeclaration)) and (d.Owner is TciProcedureDeclaration) then + d := d.Owner; + if (TciProcedureDeclaration(d).Params <> '') then + Form1.ParamHint.Show(PosToCaretXY(synedit,posi + 1), PosToCaretXY(synedit,bracketpos), + TciProcedureDeclaration(d), synedit,mp) + else + FormWriteln(''); + end; + except + on e : exception do + mDebugLn(e.message); + //Do not free the MP, we need to use this. end; end; if Form1.CodeCompletionForm.Visible then @@ -410,7 +437,6 @@ begin Exit; end; end; - Form1.CodeCompletionForm.Hide; end; end; diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index 2d6c2fc..751848d 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -344,6 +344,7 @@ type CurrTab : TMufasaTab; //The current TMufasaTab CodeCompletionForm: TAutoCompletePopup; CodeCompletionStart: TPoint; + ParamHint : TParamHint; Tabs : TList; Manager: TIOManager; OCR_Fonts: TMOCR; @@ -1831,6 +1832,8 @@ begin CodeCompletionForm := TAutoCompletePopup.Create(Self); CodeCompletionForm.InsertProc := @OnCompleteCode; + ParamHint := TParamHint.Create(self); + {$ifdef MSWindows} ConsoleVisible := True; PrevWndProc := Windows.WNDPROC(GetWindowLong(self.handle,GWL_WNDPROC)); @@ -1907,6 +1910,7 @@ begin SetLength(DebugStream, 0); RecentFiles.Free; DebugCriticalSection.Free; + ParamHint.Free; {$ifdef MSWindows} if not UnRegisterHotkey(Self.Handle,0) then mDebugLn('Unable to unregister ctrl + alt + s as global hotkey'); diff --git a/Units/Misc/v_autocompleteform.pas b/Units/Misc/v_autocompleteform.pas index 204d3af..cf46c0a 100644 --- a/Units/Misc/v_autocompleteform.pas +++ b/Units/Misc/v_autocompleteform.pas @@ -6,11 +6,12 @@ interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, - StdCtrls, ExtCtrls, SynEdit, SynEditKeyCmds, + StdCtrls, ExtCtrls, SynEdit, SynEditKeyCmds, v_ideCodeParser, v_ideCodeInsight, {$IFDEF FPC} LMessages, - lcltype + lcltype, + mPasLex {$ELSE} Windows, Messages @@ -81,16 +82,34 @@ type property InsertProc: TInsertProc read getInsertProc write setInsertProc; end; + { TParamHint } + TParamHint = class(THintWindow) + private + fPreparedString : string; + LastParameterIndex : integer; + FSynEdit : TSynedit; + FStartPoint : TPoint; + FBracketPoint : TPoint; + FMP : TCodeInsight; + FDecl : TciProcedureDeclaration; + FParameters : TDeclarationArray; + procedure ParamHintHide(Sender: TObject); + procedure ApplicationIdle(Sender: TObject; var Done: Boolean); + procedure DrawHints(var MaxWidth, MaxHeight: Integer; Draw: boolean); + function PrepareParamString(out Str : string; out MustHide : boolean) : integer; public constructor Create(TheOwner: TComponent); override; + procedure CalculateBounds; + procedure UpdateHint; procedure Paint; override; + procedure Show(StartPoint,BracketPoint : TPoint;Decl : TciProcedureDeclaration; Editor : TSynedit; mp : TCodeInsight); reintroduce; end; implementation uses - StrUtils {$IFDEF FPC}, lclintf{$ENDIF}, Themes; + StrUtils {$IFDEF FPC}, lclintf{$ENDIF},math, Themes; procedure TAutoCompleteListBox.setItemList(List: TStrings); begin @@ -553,61 +572,391 @@ begin Editor.SetFocus; end; +function StringListPartToText(BeginPos, EndPos : TPoint; Strings :TStrings) : string; +var + i : integer; +begin; + result := ''; + if endpos.y < beginpos.y then + exit; + if endpos.y >= strings.Count then + exit; + if beginpos.x > length(strings[beginpos.y]) then + exit; + if endpos.x > length(strings[endpos.y]) then + exit; + result := copy(strings[beginpos.y],beginpos.x, length(strings[beginpos.y]) - beginpos.x + 1); + for i := beginpos.y + 1 to endpos.y-1 do + result := result + strings[i]; + if endpos.y <> beginpos.y then + result := result + copy(strings[endpos.y],0,endpos.x); +end; + +function TParamHint.PrepareParamString(out Str: string; out MustHide : boolean): Integer; +var + Parser : TmwPasLex; + bracketcount, parameterindex,ParamC : integer; + ParamNames : TDeclarationArray; + typedecl : TDeclaration; + s,TypeStr,Params : string;// + i,ii :integer; +begin + result := -1; + MustHide := True; + Parser := TmwPasLex.Create; + parser.Origin:= PChar( StringListPartToText(Point(FBracketPoint.x,FBracketPoint.y-1),point(min(FSynEdit.LogicalCaretXY.x-1,length(FSynEdit.LineText)),FSynEdit.logicalcaretxy.y-1),FSynEdit.lines)); + bracketcount := 0; + ParameterIndex := -1; + while parser.TokenID <> tkNull do + begin + case parser.tokenID of + tkRoundOpen,tkSquareOpen: + begin + inc(BracketCount); + if BracketCount = 1 then + ParameterIndex := 0; + end; + tkRoundClose, tkSquareClose: + begin + dec(BracketCount); + if bracketcount =0 then + exit; + end; + tkComma: + begin + if bracketcount = 1 then + inc(parameterIndex); + end; + end; + parser.NextNoJunk; + end; + if parameterindex = -1 then + exit; + if parameterindex = LastParameterIndex then + begin + mustHide := false; + str := fPreparedString; + result := parameterindex; + exit; + end; + str := ''; + ParamC := 0; + typedecl := FDecl.Name; + if typedecl = nil then + exit; + if typedecl.shorttext = '' then + exit; + for i := 0 to high(FParameters) do + begin + if (FParameters[i] is TciConstParameter) then + s := 'const ' + else if (FParameters[i] is TciOutParameter) then + s := 'out ' + else if (FParameters[i] is TciInParameter) then + s := 'in ' + else if (FParameters[i] is TciVarParameter) then + s := 'var ' + else + s := ''; + ParamNames:= FParameters[i].Items.GetItemsOfClass(TciParameterName); + TypeDecl := FParameters[i].Items.GetFirstItemOfClass(TciParameterType); + if TypeDecl <> nil then + TypeStr := ': ' + typedecl.ShortText + else + TypeStr := ''; + Params := ''; + for ii := 0 to high(ParamNames) do + begin; + if parameterindex = ParamC then //Found the current parameter index in the parameterdecl! + begin; + if s <> '' then + s := '\' + s + '\'; //If it has a const/var/in/out thingy, bold this as well + if TypeStr <> '' then //If has a type then bold the type + TypeStr := '\' + TypeStr + '\'; + if Params <> '' then + Params := Params +', \' + ParamNames[ii].ShortText + '\' + else + Params := '\' + ParamNames[ii].ShortText + '\'; + end else + begin; + if Params <> '' then + Params := Params +', ' + ParamNames[ii].ShortText + else + Params := ParamNames[ii].ShortText; + end; + inc(ParamC); + end; + if str <> '' then + str := str + ';' + s + Params + typestr + else + str := s + params + typestr; + end; + TypeDecl := FDecl.Items.GetFirstItemOfClass(TciReturnType); + if TypeDecl <> nil then + TypeStr := ': ' + typedecl.ShortText + else + TypeStr := ''; + str := FDecl.Name.ShortText + '(' + str + ')' + TypeStr + ';'; + str := StringReplace(str,'\\','',[rfReplaceAll]); //Delete all the \\, something like \const \\x\ is the same as \const x\ + MustHide := False; + Result := parameterindex; + fPreparedString := str; + Parser.Free; +end; + + constructor TParamHint.Create(TheOwner: TComponent); begin inherited; - {$IFDEF FPC} AutoHide := False; {$ENDIF} + OnHide:=@ParamHintHide; + LastParameterIndex:= -1; + Application.AddOnIdleHandler(@ApplicationIdle); +end; + +procedure TParamHint.CalculateBounds; +var + DrawWidth: LongInt; + DrawHeight: LongInt; + ScreenTextXY: TPoint; + ClientXY: TPoint; + ScreenXY: TPoint; +begin + ScreenTextXY := FSynEdit.LogicalToPhysicalPos(FStartPoint); + ClientXY := FSynEdit.RowColumnToPixels(ScreenTextXY); + DrawWidth := FSynEdit.ClientWidth; //Maximum width it can have.. + DrawHeight := ClientXY.y; //Maximum height it can have.. + DrawHints(DrawWidth,DrawHeight,false); //Calculate the max size we need! + if DrawWidth<20 then DrawWidth:=20; //Some default values! + if DrawHeight<5 then DrawHeight:=5; + + if ClientXY.X+DrawWidth>FSynedit.ClientWidth then //If we go out of bounds, lets put it to the left a bit. + ClientXY.X:=FSynedit.ClientWidth-DrawWidth; + if ClientXY.X<0 then //If we go to the left a lil bit to much, go to the right! + ClientXY.X:=0; + dec(ClientXY.Y,DrawHeight); //Move this a lil bit up! + if ClientXY.y < 0 then + ClientXY.y := 0; + + ScreenXY:=FSynedit.ClientToScreen(ClientXY); //Position on the screen + dec(ScreenXY.Y,4); //Move it up a lilttle bit above your text, to make the shade come out better? + + //Set the new position + BoundsRect:=Bounds(ScreenXY.X,ScreenXY.Y,DrawWidth,DrawHeight); +end; + +procedure TParamHint.UpdateHint; +var + MustHide : boolean; + CursorXY : TPoint; + Line : string; +begin + if not self.Visible then + exit; + try + MustHide := True; + if not Assigned(FSynEdit) then + exit; + if FSynEdit.Focused = false then //No focus, hide this hint + exit; //Exits to the finally statement ;) + CursorXY := FSynEdit.LogicalCaretXY; + if (CursorXY.x <= FBracketPoint.x) and (CursorXY.y <= FBracketPoint.y) then //Cursor moved in front of the bracket + exit; + Line:=FSynEdit.Lines[FBracketPoint.Y-1]; + if (length(Line) nil then + freeandnil(Fmp); +end; + +procedure TParamHint.DrawHints(var MaxWidth, MaxHeight: Integer; + Draw: boolean); +var + HorizontalSpace: Integer; + VerticalSpace: Integer; + BackgroundColor, TextGrayColor, TextColor, PenColor: TColor; + TextGrayStyle, TextStyle: TFontStyles; + + procedure DrawHint(const Line: string; var AHintRect: TRect); + var + ATextRect: TRect; //The area we can use + TokenRect: TRect; //The area the text takes up + TokenSize: TPoint; //The W/H the text takes up + TokenPos: TPoint; //The position where the text is drawn + UsedWidth: Integer; // maximum right token position + LineHeight: Integer; // Current line height + Bolding : boolean; //If we are in a bolding part. + Pos : integer; + StartPos : integer; + //Text takes up it's own Width/Height + the space around the text. + begin + ATextRect:=Rect(AHintRect.Left+HorizontalSpace, + AHintRect.Top+VerticalSpace, + AHintRect.Right-HorizontalSpace, + AHintRect.Bottom-VerticalSpace);//Possible area! + UsedWidth:=0; + LineHeight:=0; + TokenPos:=Point(ATextRect.Left,ATextRect.Top); //StartPoint like (0,0) + Bolding := False; + Pos := 0; + //Split the drawing up in words, that way we can split the function if it gets to long ;). + while (Pos < Length(Line)) do + begin + inc(Pos); + if (Line[Pos] = '\') then //Bold from now + begin; + if Draw then + begin + if not Bolding then + begin + Canvas.Font.Color := TextColor; + Canvas.Font.Style := TextStyle; + end else + begin + Canvas.Font.Color := TextGrayColor; + Canvas.Font.Style := TextGrayStyle; + end; + Bolding := not Bolding; + end; + continue; + end; + StartPos := Pos; + if (Line[Pos] in ['a'..'z', 'A'..'Z', '0'..'9', '_']) then //We are in a word, lets draw that completely ;) + begin + while ((Pos < length(line)) and (Line[Pos + 1] in ['a'..'z', 'A'..'Z', '0'..'9', '_'])) do + inc(pos); + end else + while ((Pos < length(line)) and not(Line[Pos + 1] in ['a'..'z', 'A'..'Z', '0'..'9', '_','\'])) do + inc(pos); + TokenRect:=Bounds(0,0,12345,1234); //Random rect + DrawText(Canvas.Handle,@Line[StartPos],Pos-StartPos + 1,TokenRect, + DT_SINGLELINE+DT_CALCRECT+DT_NOCLIP); //Calculate the size it takes to draw this text + TokenSize:=Point(TokenRect.Right,TokenRect.Bottom); //The size it takes to draw this text + if (LineHeight>0) and (TokenPos.X+TokenSize.X>ATextRect.Right) then //It doesn't fit.. Text = 2 long + begin + if Draw and (TokenPos.X0) then //Fill the rest of the unused area + Canvas.FillRect(Rect(TokenPos.X,TokenPos.Y-VerticalSpace, + AHintRect.Right,TokenPos.Y+LineHeight+VerticalSpace)); + if (not Draw) and (UsedWidth>0) then + AHintRect.Right:=UsedWidth+HorizontalSpace; //Calculate the width we actually need + AHintRect.Bottom:=TokenPos.Y+LineHeight+VerticalSpace; + end; + +var + CurHintRect: TRect; + MustHide : boolean; + hintstr: string; +begin + if Draw then + begin + BackgroundColor:=clInfoBk; + TextGrayColor:=clInfoText; + TextGrayStyle:=[]; + TextColor:=clInfoText; + TextStyle:=[fsBold]; + PenColor:=clBlack; + end; + HorizontalSpace:=2; //The spaces around the text + VerticalSpace:=2; + + if Draw then begin + Canvas.Brush.Color:=BackgroundColor; + Canvas.Font.Color:=TextGrayColor; + Canvas.Font.Style:=TextGrayStyle; + Canvas.Pen.Color:=PenColor; + end else begin + Canvas.Font.Style:=[fsBold]; //Let us calculate the maximum width we need :) + end; + CurHintRect:=Rect(0,0,MaxWidth,MaxHeight); + PrepareParamString(HintStr,MustHide); + if MustHide then + begin; + Self.Hide; + exit; + end; + DrawHint(HintStr, CurHintRect); + + if Draw then //Fill the rest if needed.. (Possible if we calculated we need 2 rows, but turns out we need only 1 this time). + begin + if CurHintRect.Bottom bdLeftToRight then - begin - Result := Result or DT_RTLREADING; - //change alignment if is RTL - if BiDiMode = bdRightToLeft then - begin - case Alignment of - taLeftJustify: EffectiveAlignment := taRightJustify; - taRightJustify: EffectiveAlignment := taLeftJustify; - end; - end; - end; - case EffectiveAlignment of - taLeftJustify: Result := Result or DT_LEFT; - taCenter: Result := Result or DT_CENTER; - taRightJustify: Result := Result or DT_RIGHT; - end; +var + MaxWidth,MaxHeight : integer; +begin + MaxWidth:= ClientWidth; + MaxHeight := ClientHeight; + DrawHints(MaxWidth,MaxHeight,True); end; -var - ARect: TRect; - Details: TThemedElementDetails; +procedure TParamHint.Show(StartPoint,BracketPoint: TPoint;Decl : TciProcedureDeclaration; Editor: TSynedit; mp : TCodeInsight); begin - ARect := ClientRect; - if Color = clInfoBk then // draw using themes - begin - Details := ThemeServices.GetElementDetails(tttStandardLink); - ThemeServices.DrawElement(Canvas.Handle, Details, ARect); - end - else - begin - Canvas.Brush.Color := Color; - Canvas.Pen.Width := 1; - Canvas.FillRect(ARect); - DrawEdge(Canvas.Handle, ARect, BDR_RAISEDOUTER, BF_RECT); - end; - InflateRect(ARect, - 4, - 4); - Canvas.TextOut(ARect.Left, ARect.Top, Caption); + if self.Visible then + self.hide; + FDecl := Decl; + Fmp := mp; + FParameters:= Decl.GetParamDeclarations; + if Length(FParameters) = 0 then //Method has no Parameters + exit; + FSynEdit := Editor; + FStartPoint:= StartPoint; + FBracketPoint:= BracketPoint; + CalculateBounds; //Calculate the size we need! + self.Visible := true; +end; + + +procedure TParamHint.ApplicationIdle(Sender: TObject; var Done: Boolean); +begin + if not Visible then exit; + UpdateHint; end; end. diff --git a/Units/Misc/v_ideCodeInsight.pas b/Units/Misc/v_ideCodeInsight.pas index 57eafb7..9ab8d10 100644 --- a/Units/Misc/v_ideCodeInsight.pas +++ b/Units/Misc/v_ideCodeInsight.pas @@ -16,6 +16,8 @@ type TOnFindInclude = function(Sender: TObject; var FileName: string): Boolean of object; + { TCodeInsight } + TCodeInsight = class(TCodeParser) protected fFileName: string; @@ -49,6 +51,7 @@ type function GetFuncType(FuncName, FuncClass: string; out Decl: TDeclaration; Return: TVarBase): Boolean; function FindStruct(s: string; out Decl: TDeclaration; Return: TVarBase; var ArrayCount: Integer): Boolean; public + function GetExpressionAtPos(var BraceCount, BracketCount, CommaCount: Integer; out sp : Integer; IgnoreBrackets: Boolean = False): string; overload; function GetExpressionAtPos(var BraceCount, BracketCount, CommaCount: Integer; IgnoreBrackets: Boolean = False): string; overload; function GetExpressionAtPos: string; overload; function FindVarBase(s: string; GetStruct: Boolean = False; Return: TVarBase = vbName): TDeclaration; @@ -545,7 +548,7 @@ begin end; end; -function TCodeInsight.GetExpressionAtPos(var BraceCount, BracketCount, CommaCount: Integer; IgnoreBrackets: Boolean = False): string; +function TCodeInsight.GetExpressionAtPos(var BraceCount, BracketCount,CommaCount: Integer; out sp: Integer; IgnoreBrackets: Boolean): string; var i, StartPos, EndPos: Integer; s: string; @@ -636,10 +639,17 @@ begin LastWasDot := False; Dec(StartPos); end; - + sp := startpos + d.StartPos; Result := CompressWhiteSpace(Copy(s, StartPos + 1, EndPos - StartPos)); end; +function TCodeInsight.GetExpressionAtPos(var BraceCount, BracketCount, CommaCount: Integer; IgnoreBrackets: Boolean = False): string; +var + sp : integer; +begin + result := GetExpressionAtPos(bracecount,bracketcount,commacount,sp,ignorebrackets); +end; + function TCodeInsight.GetExpressionAtPos: string; var bcc, bkc, cc: Integer; From bd27789eb28c5c235bd382c00d3f362f20da8273 Mon Sep 17 00:00:00 2001 From: Raymond Date: Wed, 31 Mar 2010 21:40:53 +0200 Subject: [PATCH 5/7] Fixed codehints (you can now actually space ;)) --- Projects/SAMufasaGUI/framescript.lfm | 1 + Projects/SAMufasaGUI/framescript.lrs | 71 ++++++++++++++-------------- Projects/SAMufasaGUI/framescript.pas | 21 +++++++- Projects/SAMufasaGUI/testunit.pas | 14 ++++++ Units/Misc/v_autocompleteform.pas | 7 ++- 5 files changed, 75 insertions(+), 39 deletions(-) diff --git a/Projects/SAMufasaGUI/framescript.lfm b/Projects/SAMufasaGUI/framescript.lfm index e46736a..cb8b4e4 100644 --- a/Projects/SAMufasaGUI/framescript.lfm +++ b/Projects/SAMufasaGUI/framescript.lfm @@ -597,6 +597,7 @@ object ScriptFrame: TScriptFrame Options = [eoAutoIndent, eoGroupUndo, eoScrollPastEol, eoSmartTabs, eoTabIndent, eoTabsToSpaces, eoTrimTrailingSpaces, eoBracketHighlight] BracketHighlightStyle = sbhsBoth OnChange = SynEditChange + OnCommandProcessed = SynEditCommandProcessed OnProcessCommand = SynEditProcessCommand OnProcessUserCommand = SynEditProcessUserCommand OnSpecialLineColors = SynEditSpecialLineColors diff --git a/Projects/SAMufasaGUI/framescript.lrs b/Projects/SAMufasaGUI/framescript.lrs index f1a2e42..f103b62 100644 --- a/Projects/SAMufasaGUI/framescript.lrs +++ b/Projects/SAMufasaGUI/framescript.lrs @@ -120,39 +120,40 @@ LazarusResources.Add('TScriptFrame','FORMDATA',[ +'ngs'#1#6#12'program new;'#6#5'begin'#6#4'end.'#0#7'Options'#11#12'eoAutoInd' +'ent'#11'eoGroupUndo'#15'eoScrollPastEol'#11'eoSmartTabs'#11'eoTabIndent'#14 +'eoTabsToSpaces'#20'eoTrimTrailingSpaces'#18'eoBracketHighlight'#0#21'Bracke' - +'tHighlightStyle'#7#8'sbhsBoth'#8'OnChange'#7#13'SynEditChange'#16'OnProcess' - +'Command'#7#21'SynEditProcessCommand'#20'OnProcessUserCommand'#7#25'SynEditP' - +'rocessUserCommand'#19'OnSpecialLineColors'#7#24'SynEditSpecialLineColors'#14 - +'OnStatusChange'#7#19'SynEditStatusChange'#0#244#18'TSynGutterPartList'#0#0 - +#15'TSynGutterMarks'#0#5'Width'#2#23#0#0#20'TSynGutterLineNumber'#0#5'Width' - +#2#17#12'MouseActions'#14#0#21'MarkupInfo.Background'#7#9'clBtnFace'#21'Mark' - +'upInfo.Foreground'#7#6'clNone'#10'DigitCount'#2#2#30'ShowOnlyLineNumbersMul' - +'tiplesOf'#2#1#9'ZeroStart'#8#12'LeadingZeros'#8#0#0#17'TSynGutterChanges'#0 - +#5'Width'#2#4#13'ModifiedColor'#4#252#233#0#0#10'SavedColor'#7#7'clGreen'#0#0 - ,#19'TSynGutterSeparator'#0#5'Width'#2#2#0#0#21'TSynGutterCodeFolding'#0#12'M' - +'ouseActions'#14#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#7'mbRight'#10 - +'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#4'cdUp'#7'Command'#2#16#9'MoveCaret' - +#8#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#7'ssShift' - +#0#6'Button'#7#8'mbMiddle'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown' - +#7'Command'#2#14#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11 - +#7'ssShift'#0#9'ShiftMask'#11#7'ssShift'#0#6'Button'#7#8'mbMiddle'#10'ClickC' - +'ount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#14#9'MoveCaret'#8#6'O' - +'ption'#2#1#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6 - +'mbLeft'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#0#9 - +'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#0#21'MarkupInfo.Background'#7#6 - +'clNone'#21'MarkupInfo.Foreground'#7#6'clGray'#20'MouseActionsExpanded'#14#1 - +#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5'cc' - +'Any'#8'ClickDir'#7#6'cdDown'#7'Command'#2#14#9'MoveCaret'#8#6'Option'#2#0#8 - +'Priority'#2#0#0#0#21'MouseActionsCollapsed'#14#1#5'Shift'#11#6'ssCtrl'#0#9 - +'ShiftMask'#11#6'ssCtrl'#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5'ccAny'#8 - +'ClickDir'#7#6'cdDown'#7'Command'#2#15#9'MoveCaret'#8#6'Option'#2#0#8'Priori' - +'ty'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#6'ssCtrl'#0#6'Button'#7#6'mbLeft' - +#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#15#9'MoveCar' - +'et'#8#6'Option'#2#1#8'Priority'#2#0#0#0#0#0#0#0#17'TSynFreePascalSyn'#17'Sy' - +'nFreePascalSyn1'#7'Enabled'#8#23'CommentAttri.Foreground'#7#6'clBlue'#18'Co' - +'mmentAttri.Style'#11#6'fsBold'#0#26'IdentifierAttri.Foreground'#7#9'clDefau' - +'lt'#22'NumberAttri.Foreground'#7#6'clNavy'#22'StringAttri.Foreground'#7#6'c' - +'lBlue'#22'SymbolAttri.Foreground'#7#5'clRed'#25'DirectiveAttri.Foreground'#7 - +#5'clRed'#20'DirectiveAttri.Style'#11#6'fsBold'#0#12'CompilerMode'#7#9'pcmOb' - +'jFPC'#14'NestedComments'#9#4'left'#3'@'#1#3'top'#2#16#0#0#0 + +'tHighlightStyle'#7#8'sbhsBoth'#8'OnChange'#7#13'SynEditChange'#18'OnCommand' + +'Processed'#7#23'SynEditCommandProcessed'#16'OnProcessCommand'#7#21'SynEditP' + +'rocessCommand'#20'OnProcessUserCommand'#7#25'SynEditProcessUserCommand'#19 + +'OnSpecialLineColors'#7#24'SynEditSpecialLineColors'#14'OnStatusChange'#7#19 + +'SynEditStatusChange'#0#244#18'TSynGutterPartList'#0#0#15'TSynGutterMarks'#0 + +#5'Width'#2#23#0#0#20'TSynGutterLineNumber'#0#5'Width'#2#17#12'MouseActions' + +#14#0#21'MarkupInfo.Background'#7#9'clBtnFace'#21'MarkupInfo.Foreground'#7#6 + +'clNone'#10'DigitCount'#2#2#30'ShowOnlyLineNumbersMultiplesOf'#2#1#9'ZeroSta' + +'rt'#8#12'LeadingZeros'#8#0#0#17'TSynGutterChanges'#0#5'Width'#2#4#13'Modifi' + ,'edColor'#4#252#233#0#0#10'SavedColor'#7#7'clGreen'#0#0#19'TSynGutterSeparat' + +'or'#0#5'Width'#2#2#0#0#21'TSynGutterCodeFolding'#0#12'MouseActions'#14#1#5 + +'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#7'mbRight'#10'ClickCount'#7#8'ccS' + +'ingle'#8'ClickDir'#7#4'cdUp'#7'Command'#2#16#9'MoveCaret'#8#6'Option'#2#0#8 + +'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#7'ssShift'#0#6'Button'#7#8 + +'mbMiddle'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#14 + +#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#7'ssShift'#0#9 + +'ShiftMask'#11#7'ssShift'#0#6'Button'#7#8'mbMiddle'#10'ClickCount'#7#5'ccAny' + +#8'ClickDir'#7#6'cdDown'#7'Command'#2#14#9'MoveCaret'#8#6'Option'#2#1#8'Prio' + +'rity'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'Clic' + +'kCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#0#9'MoveCaret'#8#6 + +'Option'#2#0#8'Priority'#2#0#0#0#21'MarkupInfo.Background'#7#6'clNone'#21'Ma' + +'rkupInfo.Foreground'#7#6'clGray'#20'MouseActionsExpanded'#14#1#5'Shift'#11#0 + +#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5'ccAny'#8'ClickDi' + +'r'#7#6'cdDown'#7'Command'#2#14#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0 + +#0#0#21'MouseActionsCollapsed'#14#1#5'Shift'#11#6'ssCtrl'#0#9'ShiftMask'#11#6 + +'ssCtrl'#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'c' + +'dDown'#7'Command'#2#15#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#1#5'S' + +'hift'#11#0#9'ShiftMask'#11#6'ssCtrl'#0#6'Button'#7#6'mbLeft'#10'ClickCount' + +#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#15#9'MoveCaret'#8#6'Option' + +#2#1#8'Priority'#2#0#0#0#0#0#0#0#17'TSynFreePascalSyn'#17'SynFreePascalSyn1' + +#7'Enabled'#8#23'CommentAttri.Foreground'#7#6'clBlue'#18'CommentAttri.Style' + +#11#6'fsBold'#0#26'IdentifierAttri.Foreground'#7#9'clDefault'#22'NumberAttri' + +'.Foreground'#7#6'clNavy'#22'StringAttri.Foreground'#7#6'clBlue'#22'SymbolAt' + +'tri.Foreground'#7#5'clRed'#25'DirectiveAttri.Foreground'#7#5'clRed'#20'Dire' + +'ctiveAttri.Style'#11#6'fsBold'#0#12'CompilerMode'#7#9'pcmObjFPC'#14'NestedC' + +'omments'#9#4'left'#3'@'#1#3'top'#2#16#0#0#0 ]); diff --git a/Projects/SAMufasaGUI/framescript.pas b/Projects/SAMufasaGUI/framescript.pas index be99ab4..f816fa3 100644 --- a/Projects/SAMufasaGUI/framescript.pas +++ b/Projects/SAMufasaGUI/framescript.pas @@ -50,6 +50,8 @@ type procedure SynEditChange(Sender: TObject); procedure SynEditClickLink(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure SynEditCommandProcessed(Sender: TObject; + var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer); procedure SynEditDragDrop(Sender, Source: TObject; X, Y: Integer); procedure SynEditDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); @@ -209,6 +211,18 @@ begin end; end; +procedure TScriptFrame.SynEditCommandProcessed(Sender: TObject; + var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer); +var + Command2 : TSynEditorCommand; +begin + if (Command = ecChar) and (AChar = '(') and (Form1.ParamHint.Visible = false) and (Form1.ShowHintAuto) then + begin + Command2:= ecCodeHints; + SynEditProcessUserCommand(sender,command2,achar,nil); + end; +end; + procedure TScriptFrame.SynEditDragDrop(Sender, Source: TObject; X, Y: Integer); begin if Source is TFunctionListFrame then @@ -377,8 +391,11 @@ begin synedit.Lines.SaveToStream(ms); try Synedit.GetWordBoundsAtRowCol(Synedit.CaretXY, sp, ep); - mp.Run(ms, nil, Synedit.SelStart + (ep - Synedit.CaretX) - 1,true); - + s := SynEdit.Lines[SynEdit.Carety-1]; + if ep > length(s) then //We are outside the real text, go back to the last char + mp.Run(ms, nil, Synedit.SelStart - ep + length(s),true) + else + mp.Run(ms, nil, Synedit.SelStart + (ep - Synedit.CaretX) - 1,true); bcc := 1;bck := 0;cc := 0; s := mp.GetExpressionAtPos(bcc, bck, cc,posi, true); bracketpos := posi + length(s); diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index 751848d..d9db9a4 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -330,8 +330,10 @@ type function GetFontPath: String; function GetIncludePath: String; function GetScriptState: TScriptState; + function GetShowHintAuto: boolean; procedure SetFontPath(const AValue: String); procedure SetIncludePath(const AValue: String); + procedure SetShowHintAuto(const AValue: boolean); procedure SetScriptState(const State: TScriptState); function LoadSettingDef(Key : string; Def : string) : string; function CreateSetting(Key : string; Value : string) : string; @@ -383,6 +385,7 @@ type procedure InitalizeTMThread(var Thread : TMThread); procedure HandleParameters; procedure OnSaveScript(const Filename : string); + property ShowHintAuto : boolean read GetShowHintAuto write SetShowHintAuto; property IncludePath : String read GetIncludePath write SetIncludePath; property FontPath : String read GetFontPath write SetFontPath; end; @@ -991,6 +994,7 @@ begin CreateSetting('Settings/General/MaxRecentFiles','10'); CreateSetting('Settings/MainForm/NormalSize','739:555'); CreateSetting('Settings/FunctionList/ShowOnStart','True'); + CreateSetting('Settings/CodeHints/ShowAutomatically','True'); CreateSetting('Settings/Updater/RemoteLink',SimbaURL + 'Simba'{$IFDEF WINDOWS} +'.exe'{$ENDIF}); CreateSetting('Settings/Updater/RemoteVersionLink',SimbaURL + 'Version'); @@ -2294,6 +2298,11 @@ begin result := CurrScript.FScriptState; end; +function TForm1.GetShowHintAuto: boolean; +begin + Result := LowerCase(LoadSettingDef('Settings/CodeHints/ShowAutomatically','True')) = 'true'; +end; + procedure TForm1.SetFontPath(const AValue: String); begin SetSetting('Settings/Fonts/Path',AValue); @@ -2407,6 +2416,11 @@ begin UpdatingFonts := False; end; +procedure TForm1.SetShowHintAuto(const AValue: boolean); +begin + SetSetting('Settings/CodeHints/ShowAutomatically',Booltostr(AValue,true)); +end; + {$ifdef mswindows} function GetConsoleWindow: HWND; stdcall; external kernel32 name 'GetConsoleWindow'; diff --git a/Units/Misc/v_autocompleteform.pas b/Units/Misc/v_autocompleteform.pas index cf46c0a..df5e878 100644 --- a/Units/Misc/v_autocompleteform.pas +++ b/Units/Misc/v_autocompleteform.pas @@ -600,11 +600,14 @@ var typedecl : TDeclaration; s,TypeStr,Params : string;// i,ii :integer; + CursorXY : TPoint; begin result := -1; MustHide := True; - Parser := TmwPasLex.Create; - parser.Origin:= PChar( StringListPartToText(Point(FBracketPoint.x,FBracketPoint.y-1),point(min(FSynEdit.LogicalCaretXY.x-1,length(FSynEdit.LineText)),FSynEdit.logicalcaretxy.y-1),FSynEdit.lines)); + Parser := TmwPasLex.Create; //The position of the bracket + parser.Origin:= PChar(StringListPartToText(Point(FBracketPoint.x,FBracketPoint.y-1), + point(min(FSynEdit.CaretX,length(FSynEdit.Lines[FSynEdit.CaretY - 1])),FSynEdit.CaretY-1), + FSynEdit.lines)); bracketcount := 0; ParameterIndex := -1; while parser.TokenID <> tkNull do From 001a593789b80a37eb9aebd5a73ee1a48f134b93 Mon Sep 17 00:00:00 2001 From: Raymond Date: Thu, 1 Apr 2010 00:22:46 +0200 Subject: [PATCH 6/7] Added settings to the extensions.. Should work allright, however there is some bug in Pascalscript that makes it fail, for now.. Renamed all the setting methods.. --- Extensions/test.sex | 1 + Projects/SAMufasaGUI/extensionmanager.pas | 43 +++--- Projects/SAMufasaGUI/psextension.pas | 46 ++++++- Projects/SAMufasaGUI/testunit.pas | 119 ++++++++++------ Projects/SAMufasaGUI/updateform.pas | 6 +- Projects/SAMufasaGUI/virtualextension.pas | 4 +- Units/MMLAddon/PSInc/Wrappers/extensions.inc | 38 ++++++ Units/MMLAddon/PSInc/Wrappers/settings.inc | 20 +-- Units/MMLAddon/PSInc/psexportedmethods.inc | 15 +-- Units/MMLAddon/settings.pas | 135 +++++++++++-------- Units/MMLAddon/settingssandbox.pas | 58 ++++---- 11 files changed, 318 insertions(+), 167 deletions(-) create mode 100644 Units/MMLAddon/PSInc/Wrappers/extensions.inc diff --git a/Extensions/test.sex b/Extensions/test.sex index d4d1000..3c4ae0e 100644 --- a/Extensions/test.sex +++ b/Extensions/test.sex @@ -12,6 +12,7 @@ end; procedure Attach; begin; + Settings.SetKeyValue('TestSetting','1337'); Writeln('Your extension has been enabled, do stuff here'); end; diff --git a/Projects/SAMufasaGUI/extensionmanager.pas b/Projects/SAMufasaGUI/extensionmanager.pas index 2956e94..5f3eeba 100644 --- a/Projects/SAMufasaGUI/extensionmanager.pas +++ b/Projects/SAMufasaGUI/extensionmanager.pas @@ -28,7 +28,7 @@ type StartDisabled : boolean; property OnChange : TNotifyEvent read FOnChange write SetOnchange; function GetExtensionIndex(Filename : string) : integer; - function LoadPSExtension(Filename : string) : boolean; + function LoadPSExtension(Filename : string; enabled : boolean=false) : boolean; function LoadPSExtensionsDir(Directory,ext : string) : boolean; function HandleHook(HookName: String; Args: Array of Variant): Variant; end; @@ -38,7 +38,7 @@ var implementation uses - TestUnit; + TestUnit, settingssandbox,simbasettings; procedure TExtensionManager.SetOnchange(const AValue: TNotifyEvent); var @@ -76,7 +76,7 @@ begin result := -1; end; -function TExtensionManager.LoadPSExtension(Filename: string): boolean; +function TExtensionManager.LoadPSExtension(Filename: string; enabled: boolean): boolean; var Ext : TExtension; begin @@ -84,12 +84,17 @@ begin exit(true); Result := False; try - Ext := TSimbaPSExtension.Create(filename,startdisabled); - result := TSimbaPSExtension(ext).Working; + Ext := TSimbaPSExtension.Create(filename,True); +// result := TSimbaPSExtension(ext).Working; Extensions.Add(ext); + ext.Settings := TMMLSettingsSandbox.Create(SettingsForm.Settings); + ext.Settings.Prefix := format('Extensions/Extension%d/Settings/',[Extensions.Count - 1]); + if enabled then + ext.Enabled := true; ext.OnChange:= FOnChange; if assigned(FOnChange) then FOnChange(Self); + Result := True; except on e : exception do formWritelnex(format('Error in LoadPSExtension(%s): %s',[FileName, e.message])); @@ -98,22 +103,22 @@ end; function GetFiles(Path, Ext: string): TstringArray; var - SearchRec : TSearchRec; - c : integer; + SearchRec : TSearchRec; + c : integer; begin - c := 0; - if FindFirst(Path + '*.' + ext, faAnyFile, SearchRec) = 0 then - begin - repeat - inc(c); - SetLength(Result,c); - Result[c-1] := SearchRec.Name; - until FindNext(SearchRec) <> 0; - SysUtils.FindClose(SearchRec); - end; + c := 0; + if FindFirst(Path + '*.' + ext, faAnyFile, SearchRec) = 0 then + begin + repeat + inc(c); + SetLength(Result,c); + Result[c-1] := SearchRec.Name; + until FindNext(SearchRec) <> 0; + SysUtils.FindClose(SearchRec); + end; end; -function TExtensionManager.LoadPSExtensionsDir(Directory,ext: string): boolean; +function TExtensionManager.LoadPSExtensionsDir(Directory, ext: string): boolean; var Files : TstringArray; i : integer; @@ -127,7 +132,7 @@ begin Directory := IncludeTrailingPathDelimiter(directory); Files := GetFiles(Directory,ext); for i := 0 to high(Files) do - result := result or LoadPSExtension(Directory + files[i]); + result := LoadPSExtension(Directory + files[i],not StartDisabled) or result; FOnChange := Tempevent; if Assigned(FOnChange) then FOnChange(self); diff --git a/Projects/SAMufasaGUI/psextension.pas b/Projects/SAMufasaGUI/psextension.pas index 0624949..179bc7b 100644 --- a/Projects/SAMufasaGUI/psextension.pas +++ b/Projects/SAMufasaGUI/psextension.pas @@ -27,6 +27,8 @@ type function FreeScript: boolean; function InitScript: Boolean; procedure OutputMessages; + procedure SIRegister_Settings(Cl: TPSPascalCompiler); + procedure RIRegister_Settings(Cl: TPSRuntimeClassImporter); public function HookExists(HookName: String): Boolean;override; @@ -47,7 +49,7 @@ uses uPSC_extctrls,uPSC_menus, //Compile libs uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms, uPSR_extctrls,uPSR_menus, //Runtime-libs - testunit//Writeln + testunit,updateform,settingssandbox//Writeln ; function TSimbaPSExtension.HookExists(HookName: String): Boolean; @@ -110,10 +112,13 @@ begin result := ExecuteHook('Free',[],bla) = SExt_ok; end; +{$I ../../Units/MMLAddon/PSInc/Wrappers/extensions.inc} procedure TSimbaPSExtension.RegisterMyMethods(Sender: TPSScript); begin Sender.AddFunction(@formWritelnEx,'procedure Writeln(s : string)'); + Sender.AddFunction(@ext_GetPage,'function GetPage(url : string) : string'); + Sender.AddRegisteredPTRVariable('Settings','TMMLSettingsSandbox'); Sender.AddRegisteredVariable('Simba','TForm'); Sender.AddRegisteredVariable('Simba_MainMenu','TMainMenu'); end; @@ -122,6 +127,7 @@ procedure TSimbaPSExtension.OnPSExecute(Sender: TPSScript); begin Sender.SetVarToInstance('simba',Form1); Sender.SetVarToInstance('Simba_MainMenu',Form1.MainMenu); + Sender.SetPointerToData('Settings',@Self.Settings,Sender.FindNamedType('TMMLSettingsSandbox')); end; procedure TSimbaPSExtension.SetEnabled(bool: boolean); @@ -148,6 +154,41 @@ begin inherited SetEnabled(bool); end; +procedure TSimbaPSExtension.SIRegister_Settings(Cl: TPSPascalCompiler); +begin + with cl.AddClassN(nil,'TMMLSettingsSandbox') do + begin; + RegisterMethod('function IsKey(KeyName: String): Boolean;'); + RegisterMethod('function IsDirectory(KeyName: String): Boolean;'); + RegisterMethod('function SetKeyValue(Keyname : string; Value : string) : boolean;'); + RegisterMethod('function GetKeyValue(KeyName: String): String;'); + RegisterMethod('function GetKeyValueDef(KeyName, defVal: String): String;'); + RegisterMethod('function ListKeys(KeyName: String): TStringArray;'); + RegisterMethod('function DeleteKey(KeyName: String): Boolean;'); + RegisterMethod('function DeleteSubKeys(KeyName: String): Boolean;'); + RegisterProperty('Prefix','String',iptR); + end; +end; + +procedure SettingsPrefix(self : TMMLSettingsSandbox; var Prefix : String); +begin; Prefix := self.Prefix; end; + +procedure TSimbaPSExtension.RIRegister_Settings(Cl: TPSRuntimeClassImporter); +begin + with cl.Add(TMMLSettingsSandbox) do + begin + RegisterMethod(@TMMLSettingsSandbox.IsKey,'ISKEY'); + RegisterMethod(@TMMLSettingsSandbox.IsDirectory,'ISDIRECTORY'); + RegisterMethod(@TMMLSettingsSandbox.SetKeyValue,'SETKEYVALUE'); + RegisterMethod(@TMMLSettingsSandbox.GetKeyValue,'GETKEYVALUE'); + RegisterMethod(@TMMLSettingsSandbox.GetKeyValueDef,'GETKEYVALUEDEF'); + RegisterMethod(@TMMLSettingsSandbox.ListKeys,'LISTKEYS'); + RegisterMethod(@TMMLSettingsSandbox.DeleteKey,'DELETEKEY'); + RegisterMethod(@TMMLSettingsSandbox.DeleteSubKeys,'DELETESUBKEYS'); + RegisterPropertyHelper(@SettingsPrefix,nil,'Prefix'); + end; +end; + procedure TSimbaPSExtension.RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler); begin SIRegister_Std(x); @@ -158,6 +199,7 @@ begin SIRegister_Forms(x); SIRegister_ExtCtrls(x); SIRegister_Menus(x); + SIRegister_Settings(x); end; procedure TSimbaPSExtension.RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); @@ -170,6 +212,7 @@ begin RIRegister_Forms(x); RIRegister_ExtCtrls(x); RIRegister_Menus(x); + RIRegister_Settings(x); end; destructor TSimbaPSExtension.Destroy; @@ -224,6 +267,5 @@ begin end; - end. diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index d9db9a4..af167e7 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -337,7 +337,8 @@ type procedure SetScriptState(const State: TScriptState); function LoadSettingDef(Key : string; Def : string) : string; function CreateSetting(Key : string; Value : string) : string; - procedure SetSetting(key : string; Value : string); + procedure SetSetting(key : string; Value : string; save : boolean = false); + function SettingExtists(key : string) : boolean; procedure FontUpdate; public DebugStream: String; @@ -1004,6 +1005,7 @@ begin {Creates the paths and returns the path} PluginsPath := CreateSetting('Settings/Plugins/Path', ExpandFileName(MainDir+ DS+ 'Plugins' + DS)); extensionsPath := CreateSetting('Settings/Extensions/Path',ExpandFileName(MainDir +DS + 'Extensions' + DS)); + CreateSetting('Extensions/ExtensionCount','0'); CreateSetting('LastConfig/MainForm/Position',''); CreateSetting('LastConfig/MainForm/State','Normal'); {$ifdef MSWindows} @@ -1025,6 +1027,41 @@ begin end; procedure TForm1.LoadFormSettings; +var + extCount : integer; + function LoadExtension(Number : integer) : boolean; + var + Path : string; + ExtPath : string; + ExtEnabled : boolean; + begin; + result := false; + if (number < 0) or (number >= extCount) then + exit; + path := 'Extensions/Extension' + inttostr(number); + if SettingExtists(Path) = false then + exit; + ExtPath := LoadSettingDef(Path + '/Path',''); + if ExtPath = '' then + exit; + ExtEnabled := StrToBoolDef(LoadSettingDef(Path + '/Enabled','false'),false); + if ExtManager.LoadPSExtension(ExtPath,ExtEnabled) = false then + exit; + Result := true; + end; + procedure DeleteExtension(number : integer); + var + i : integer; + path : string; + begin; + path := 'Extensions/Extension'; + SettingsForm.Settings.DeleteKey(path + inttostr(number)); + for i := number + 1 to extCount - 1 do + SettingsForm.Settings.RenameKey(path + inttostr(i),'Extension' + inttostr(i-1)); + SetSetting('Extensions/ExtensionCount',inttostr(extCount - 1),true); + dec(extCount); + end; + var str,str2 : string; Data : TStringArray; @@ -1068,65 +1105,58 @@ begin else ShowConsole(false); {$endif} + extCount := StrToIntDef(LoadSettingDef('Extensions/ExtensionCount/','0'),0); + for i := 0 to extCount - 1 do + while (i < extCount) and not LoadExtension(i) do + DeleteExtension(i); + SetSetting('Extensions/ExtensionCount',inttostr(extCount)); str := LoadSettingDef('Settings/Extensions/Path',ExpandFileName(MainDir +DS + 'Extensions' + DS)); str2 := LoadSettingDef('Settings/Extensions/FileExtension','sex'); ExtManager.LoadPSExtensionsDir(str,str2); - str := LoadSettingDef('LastConfig/Extensions/EnabledExts',''); - if str <> '' then - begin - data := Explode(';',str); - for i := 0 to high(data) do - for ii := 0 to ExtManager.Extensions.Count - 1 do - if data[i] = TVirtualSimbaExtension(ExtManager.Extensions[ii]).Filename then - TVirtualSimbaExtension(ExtManager.Extensions[ii]).Enabled := true; - end; end; procedure TForm1.SaveFormSettings; var Data : TStringArray; + path : string; i : integer; begin with SettingsForm.Settings do begin if Self.WindowState = wsMaximized then - SetKeyValue('LastConfig/MainForm/State','maximized') + SetSetting('LastConfig/MainForm/State','maximized') else begin; //Only save the form position if its non maximized. - SetKeyValue('LastConfig/MainForm/State','normal'); + SetSetting('LastConfig/MainForm/State','normal'); Data := ConvArr([inttostr(Self.left),inttostr(self.top),inttostr(self.width),inttostr(self.height)]); - SetKeyValue('LastConfig/MainForm/Position', Implode(':',Data )); + SetSetting('LastConfig/MainForm/Position', Implode(':',Data )); end; if RecentFiles.Count > 0 then begin SetLength(data,RecentFiles.Count); for i := 0 to high(data) do //First entry should be the last-opened data[high(data) - i] := RecentFiles[i]; - SetKeyValue('LastConfig/MainForm/RecentFiles',implode(';',data)); + SetSetting('LastConfig/MainForm/RecentFiles',implode(';',data)); end else - SetKeyValue('LastConfig/MainForm/RecentFiles',''); + SetSetting('LastConfig/MainForm/RecentFiles',''); if MenuItemFunctionList.Checked then - SetKeyValue('LastConfig/MainForm/FunctionListShown','True') + SetSetting('LastConfig/MainForm/FunctionListShown','True') else - SetKeyValue('LastConfig/MainForm/FunctionListShown','False'); + SetSetting('LastConfig/MainForm/FunctionListShown','False'); {$ifdef MSWindows} if ConsoleVisible then - SetKeyValue('LastConfig/Console/Visible','True') + SetSetting('LastConfig/Console/Visible','True') else - SetKeyValue('LastConfig/Console/Visible','false'); + SetSetting('LastConfig/Console/Visible','false'); {$endif} - if ExtManager.Extensions.Count > 0 then - begin - SetLength(data,0); - for i := 0 to ExtManager.Extensions.Count-1 do - if TVirtualSimbaExtension(ExtManager.Extensions[i]).Enabled then - begin - setlength(data,length(data)+1); - data[high(data)] := TVirtualSimbaExtension(ExtManager.Extensions[i]).FileName; - end; - SetKeyValue('LastConfig/Extensions/EnabledExts',Implode(';',data)); - end else - SetKeyValue('LastConfig/Extensions/EnabledExts',''); + SetSetting('Extensions/ExtensionCount',inttostr(ExtManager.Extensions.Count)); + for i := 0 to ExtManager.Extensions.Count-1 do + begin; + + path :='Extensions/Extension' + inttostr(I); + SetSetting(Path + '/Path',TVirtualSimbaExtension(ExtManager.Extensions[i]).Filename); + SetSetting(Path + '/Enabled',BoolToStr(TVirtualSimbaExtension(ExtManager.Extensions[i]).Enabled,True)); + end; SaveToXML(SimbaSettingsFile); end; end; @@ -1222,7 +1252,7 @@ begin Thread.Client.MOCR.SetFonts(OCR_Fonts.GetFonts); Se := TMMLSettingsSandbox.Create(SettingsForm.Settings); - Se.SetPrefix('Scripts/'); + Se.Prefix := 'Scripts/'; Thread.SetSettings(Se); end; @@ -2305,7 +2335,7 @@ end; procedure TForm1.SetFontPath(const AValue: String); begin - SetSetting('Settings/Fonts/Path',AValue); + SetSetting('Settings/Fonts/Path',AValue,true); end; function TForm1.GetFontPath: String; @@ -2320,7 +2350,7 @@ end; procedure TForm1.SetIncludePath(const AValue: String); begin - SetSetting('Settings/Includes/Path',AValue); + SetSetting('Settings/Includes/Path',AValue,true); end; procedure TForm1.SetScriptState(const State: TScriptState); @@ -2353,22 +2383,25 @@ end; function TForm1.LoadSettingDef(Key: string; Def: string): string; begin - result := SettingsForm.Settings.GetSetLoadSaveDefaultKeyValueIfNotExists(Key,def,SimbaSettingsFile); + result := SettingsForm.Settings.GetKeyValueDefLoad(Key,def,SimbaSettingsFile); end; function TForm1.CreateSetting(Key: string; Value: string): string; begin - result := SettingsForm.Settings.GetSetDefaultKeyValue(Key,value); + result := SettingsForm.Settings.GetKeyValueDef(Key,value); end; -procedure TForm1.SetSetting(key: string; Value: string); +procedure TForm1.SetSetting(key: string; Value: string; save : boolean); begin - //Creates the setting if needed - if CreateSetting(key,value) <> value then //The setting already occurs, and has a different value.. Lets change it - begin; - SettingsForm.Settings.SetKeyValue(key,value); + //Creates the setting if needed + SettingsForm.Settings.SetKeyValue(key,value); + if save then SettingsForm.Settings.SaveToXML(SimbaSettingsFile); - end; +end; + +function TForm1.SettingExtists(key: string): boolean; +begin + result :=SettingsForm.Settings.KeyExists(key); end; procedure TForm1.FontUpdate; @@ -2401,7 +2434,7 @@ begin if UnTar(decompressed, FontPath,true) then begin; FormWriteln('Succesfully installed the new fonts!'); - SetSetting('Settings/Fonts/Version',IntToStr(LatestVersion)); + SetSetting('Settings/Fonts/Version',IntToStr(LatestVersion),true); if Assigned(self.OCR_Fonts) then self.OCR_Fonts.Free; Self.OCR_Fonts := TMOCR.Create(nil); diff --git a/Projects/SAMufasaGUI/updateform.pas b/Projects/SAMufasaGUI/updateform.pas index 12784a6..7effec1 100644 --- a/Projects/SAMufasaGUI/updateform.pas +++ b/Projects/SAMufasaGUI/updateform.pas @@ -94,7 +94,7 @@ begin if FontVersionThread = nil then//Create thread (only if no-other one is already running) begin FontVersionThread := TDownloadThread.Create(true); - FontVersionThread.InputURL := SettingsForm.Settings.GetSetLoadSaveDefaultKeyValueIfNotExists( + FontVersionThread.InputURL := SettingsForm.Settings.GetKeyValueDefLoad( 'Settings/Fonts/VersionLink',FontURL + 'Version',SimbaSettingsFile); FontVersionThread.Resume; while FontVersionThread.Done = false do//Wait till thread is done @@ -123,7 +123,7 @@ begin begin SimbaVersionThread := TDownloadThread.Create(true); - SimbaVersionThread.InputURL := SettingsForm.Settings.GetSetLoadSaveDefaultKeyValueIfNotExists( + SimbaVersionThread.InputURL := SettingsForm.Settings.GetKeyValueDefLoad( 'Settings/Updater/RemoteVersionLink',SimbaURL + 'Version',SimbaSettingsFile); SimbaVersionThread.Resume; while SimbaVersionThread.Done = false do//Wait till thread is done @@ -214,7 +214,7 @@ begin FCancelling := False; FCancelled := False; - Updater.FileURL := SettingsForm.Settings.GetSetLoadSaveDefaultKeyValueIfNotExists( + Updater.FileURL := SettingsForm.Settings.GetKeyValueDefLoad( 'Settings/Updater/RemoteLink', SimbaURL + 'Simba'{$IFDEF WINDOWS} +'.exe'{$ENDIF}, SimbaSettingsFile diff --git a/Projects/SAMufasaGUI/virtualextension.pas b/Projects/SAMufasaGUI/virtualextension.pas index c286a65..90a5633 100644 --- a/Projects/SAMufasaGUI/virtualextension.pas +++ b/Projects/SAMufasaGUI/virtualextension.pas @@ -5,7 +5,7 @@ unit virtualextension; interface uses - Classes, SysUtils; + Classes, SysUtils,settingssandbox; type { TVirtualSimbaExtension } @@ -16,6 +16,7 @@ type FVersion : string; FFilename : string; FEnabled : boolean; + FSettings : TMMLSettingsSandbox; procedure SetEnabled(bool : boolean); virtual; public OnChange : TNotifyEvent; @@ -27,6 +28,7 @@ type function GetName : string; function GetVersion : String; + property Settings : TMMLSettingsSandbox read FSettings write FSettings; property Filename : string read FFilename write FFilename; property Enabled : boolean read FEnabled write SetEnabled; end; diff --git a/Units/MMLAddon/PSInc/Wrappers/extensions.inc b/Units/MMLAddon/PSInc/Wrappers/extensions.inc new file mode 100644 index 0000000..cad4cfa --- /dev/null +++ b/Units/MMLAddon/PSInc/Wrappers/extensions.inc @@ -0,0 +1,38 @@ +{ + This file is part of the Mufasa Macro Library (MML) + Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer + + MML is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + MML is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with MML. If not, see . + + See the file COPYING, included in this distribution, + for details about the copyright. + + extensions.inc for the Mufasa Macro Library +} + + +function ext_GetPage(url : string) : string; +var + t: TDownloadThread; +begin + t := TDownloadThread.Create(true); + t.InputURL:='url'; + t.Resume; + while not t.done do + begin + Application.ProcessMessages; + Sleep(25); + end; + Exit(t.ResultStr); +end; diff --git a/Units/MMLAddon/PSInc/Wrappers/settings.inc b/Units/MMLAddon/PSInc/Wrappers/settings.inc index 2a2552d..7618cb7 100644 --- a/Units/MMLAddon/PSInc/Wrappers/settings.inc +++ b/Units/MMLAddon/PSInc/Wrappers/settings.inc @@ -21,7 +21,7 @@ Settings.inc for the Mufasa Macro Library } -function SettingsIsKey(KeyName: String): Boolean; +function KeyIsSetting(KeyName: String): Boolean; begin if CurrThread.Sett <> nil then result:= CurrThread.Sett.IsKey(KeyName) @@ -29,7 +29,7 @@ begin result:=false; end; -function SettingsIsDirectory(KeyName: String): Boolean; +function KeyIsDirectory(KeyName: String): Boolean; begin if CurrThread.Sett <> nil then result:= CurrThread.Sett.IsDirectory(KeyName) @@ -37,7 +37,7 @@ begin result := false; end; -function SettingsGetKeyValue(KeyName: String): String; +function GetSettingValue(KeyName: String): String; begin if CurrThread.Sett <> nil then result:= CurrThread.Sett.GetKeyValue(KeyName) @@ -45,23 +45,23 @@ begin result:=''; end; -function SettingsGetSetDefaultKeyValue(KeyName, defVal: String): String; +function GetSettingValueDef(KeyName, defVal: String): String; begin if CurrThread.Sett <> nil then - result:= CurrThread.Sett.GetSetDefaultKeyValue(KeyName, defVal) + result:= CurrThread.Sett.GetKeyValueDef(KeyName, defVal) else result:=''; end; -procedure SettingsListKeys(KeyName: String; var KeyReturn: TStringArray); +function ListSettings(KeyName: String; var KeyReturn: TStringArray) : boolean; begin if CurrThread.Sett <> nil then - KeyReturn := CurrThread.Sett.ListKeys(KeyName) + Result := CurrThread.Sett.ListKeys(KeyName,keyReturn) else - setlength(KeyReturn, 0); + result := false; end; -function SettingsDeleteKey(KeyName: String): Boolean; +function DeleteSetting(KeyName: String): Boolean; begin if CurrThread.Sett <> nil then Result := CurrThread.Sett.DeleteKey(KeyName) @@ -69,7 +69,7 @@ begin result := False; end; -function SettingsDeleteSubKeys(KeyName: String): Boolean; +function DeleteSubSettings(KeyName: String): Boolean; begin if CurrThread.Sett <> nil then Result := CurrThread.Sett.DeleteSubKeys(KeyName) diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc index ad851f6..6c2fa22 100644 --- a/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/Units/MMLAddon/PSInc/psexportedmethods.inc @@ -367,11 +367,10 @@ AddFunction(@SameTPA,'function SameTPA(aTPA, bTPA: TPointArray): Boolean;'); AddFunction(@TPAInATPA,'function TPAInATPA(TPA: TPointArray; InATPA: T2DPointArray; var Index: LongInt): Boolean;'); SetCurrSection('Settings'); -AddFunction(@SettingsIsKey, 'function SettingsIsKey(KeyName: String): Boolean;'); -AddFunction(@SettingsIsDirectory, 'function SettingsIsDirectory(KeyName: String): Boolean;'); -AddFunction(@SettingsGetKeyValue, 'function SettingsGetKeyValue(KeyName: String): String;'); -AddFunction(@SettingsGetSetDefaultKeyValue, 'function SettingsGetSetDefaultKeyValue(KeyName, defVal: String): String;'); -AddFunction(@SettingsListKeys, 'procedure SettingsListKeys(KeyName: String; var KeyReturn: TStringArray);'); - -AddFunction(@SettingsDeleteKey, 'function SettingsDeleteKey(KeyName: String): Boolean;'); -AddFunction(@SettingsDeleteSubKeys, 'function SettingsDeleteSubKeys(KeyName: String): Boolean;'); +AddFunction(@KeyIsSetting, 'function KeyIsSetting(KeyName: String): Boolean;'); +AddFunction(@KeyIsDirectory, 'function KeyIsDirectory(KeyName: String): Boolean;'); +AddFunction(@GetSettingValue, 'function GetSettingValue(KeyName: String): String;'); +AddFunction(@GetSettingValueDef, 'function GetSettingValueDef(KeyName, defVal: String): String;'); +AddFunction(@ListSettings, 'function ListSettings(KeyName: String; var KeyReturn: TStringArray) : boolean;'); +AddFunction(@DeleteSetting, 'function DeleteSetting(KeyName: String): Boolean;'); +AddFunction(@DeleteSubSettings, 'function DeleteSubSettings(KeyName: String): Boolean;'); diff --git a/Units/MMLAddon/settings.pas b/Units/MMLAddon/settings.pas index 50ff9cd..b142b79 100644 --- a/Units/MMLAddon/settings.pas +++ b/Units/MMLAddon/settings.pas @@ -57,51 +57,40 @@ type } TMMLSettings = class(TObject) + private + Nodes: TTreeNodes; + function KeyNameToKeys(KeyName: String): TStringArray; + function WalkToNode(KeyName: String): TTreeNode; - public - constructor Create(aNodes: TTreeNodes); - destructor Destroy; override; + procedure InternalLoadFromXML(XMLDoc: TXMLDocument); + procedure WriteXMLData(n: TTreeNode; + XMLNode: TDOMNode; XMLDoc: TXMLDocument; + var XMLChild: TDOMNode; var C: Integer); + procedure WalkTree(Node: TTreeNode; XMLNode: TDOMNode; XMLDoc: TXMLDocument; + var C: Integer); + function GetKeyValueDefLoadFirst(KeyName, defVal, fileName: String): String; + public + constructor Create(aNodes: TTreeNodes); + destructor Destroy; override; + function GetNodePath(Node: TTreeNode): String; + function ListKeys(KeyName: String; out Keys :TStringArray) : boolean; - private - Nodes: TTreeNodes; - function KeyNameToKeys(KeyName: String): TStringArray; - function WalkToNode(KeyName: String): TTreeNode; + function KeyExists(KeyName: String): Boolean; + function IsKey(KeyName: String): Boolean; + function IsDirectory(KeyName: String): Boolean; - procedure InternalLoadFromXML(XMLDoc: TXMLDocument); - procedure WriteXMLData(n: TTreeNode; - XMLNode: TDOMNode; XMLDoc: TXMLDocument; - var XMLChild: TDOMNode; var C: Integer); - procedure WalkTree(Node: TTreeNode; XMLNode: TDOMNode; XMLDoc: TXMLDocument; - var C: Integer); + function DeleteKey(KeyName: String): Boolean; + function DeleteSubKeys(KeyName: String): Boolean; - public - function GetNodePath(Node: TTreeNode): String; - function ListKeys(KeyName: String): TStringArray; - - function KeyExists(KeyName: String): Boolean; - function IsKey(KeyName: String): Boolean; - function IsDirectory(KeyName: String): Boolean; - - function DeleteKey(KeyName: String): Boolean; - function DeleteSubKeys(KeyName: String): Boolean; - - procedure SetKeyValue(KeyName: String; KeyValue: String); - function CreateKey(KeyName: String; CreatePath: Boolean = False): Boolean; - function GetKeyValue(KeyName: String): String; - - // Horrible name - function GetSetDefaultKeyValue(KeyName, defVal: String): String; - private - // /facepalm - function GetSetLoadSaveDefaultKeyValue(KeyName, defVal, fileName: String): String; - public - // AAAAAAAAAAAHG?? - function GetSetLoadSaveDefaultKeyValueIfNotExists(KeyName, defVal, fileName: String): String; - - public - procedure LoadFromXML(fileName: String); - procedure SaveToXML(fileName: String); + function CreateKey(KeyName: String; CreatePath: Boolean = True): Boolean; + function SetKeyValue(KeyName: String; KeyValue: String; CreatePath : boolean = true) : boolean; + function GetKeyValue(KeyName: String): String; + function GetKeyValueDef(KeyName, defVal: String): String; + function RenameKey(oldKey,newKey : string) : boolean; + function GetKeyValueDefLoad(KeyName, defVal, fileName: String): String; + procedure LoadFromXML(fileName: String); + procedure SaveToXML(fileName: String); end; implementation @@ -255,19 +244,19 @@ end; Equivalent to 'ls' or 'dir'. It lists the keys in a certain key (directory) } -function TMMLSettings.ListKeys(KeyName: String): TStringArray; +function TMMLSettings.ListKeys(KeyName: String; out Keys: TStringArray): boolean; var N: TTreeNode; begin - SetLength(Result, 0); + SetLength(Keys, 0); N := WalkToNode(KeyName); if N <> nil then N := N.GetFirstChild; - + result := n <> nil; while N <> nil do begin - setlength(result,length(result)+1); - result[high(result)] := N.Text; + setlength(Keys,length(Keys)+1); + Keys[high(Keys)] := N.Text; N := N.GetNextSibling; end; end; @@ -345,13 +334,41 @@ begin Exit(''); end; +function TMMLSettings.RenameKey(oldKey, newKey: string): boolean; +var + Node : TTreeNode; + Path : TstringArray; + newstr : string; + i : integer; +begin + result := false; + Path := KeyNameToKeys(OldKey); + if length(path) = 1 then + exit; + if pos('/',newKey) > 0 then + exit; + if not KeyExists(oldkey) then + exit; + for i := length(oldKey) downto 1 do + if oldkey[i] = '/' then + begin + newstr:= Copy(oldkey,1,i) + NewKey; + break; + end; + if KeyExists(NewKey) then + exit; + Node := WalkToNode(oldKey); + Node.Text:= NewKey; + result := true; +end; + { If the key exists - return the value. If it does not exist, create the key - with a possible path, set it to defVal and return defVal. } -function TMMLSettings.GetSetDefaultKeyValue(KeyName, defVal: String): String; +function TMMLSettings.GetKeyValueDef(KeyName, defVal: String): String; var Res: String; begin @@ -421,26 +438,26 @@ begin end; { - Clear the entire tree. Load from fileName. call GetSetDefaultKeyValue. + Clear the entire tree. Load from fileName. call GetKeyValueDef. } -function TMMLSettings.GetSetLoadSaveDefaultKeyValue(KeyName, defVal, fileName: String): String; +function TMMLSettings.GetKeyValueDefLoadFirst(KeyName, defVal, fileName: String): String; begin Nodes.Clear; LoadFromXML(fileName); - Result := GetSetDefaultKeyValue(KeyName, defVal); + Result := GetKeyValueDef(KeyName, defVal); SaveToXML(fileName); end; { - If Key exists, call getSetDefaultKeyValue, else call GetSetLoadSaveDefaultKeyValue + If Key exists, call GetKeyValueDef, else call GetSetLoadSaveDefaultKeyValue } -function TMMLSettings.GetSetLoadSaveDefaultKeyValueIfNotExists(KeyName, defVal, fileName: String): String; +function TMMLSettings.GetKeyValueDefLoad(KeyName, defVal, fileName: String): String; begin if KeyExists(KeyName) then - Exit(GetSetDefaultKeyValue(KeyName, defVal)) + Exit(GetKeyValueDef(KeyName, defVal)) else - Exit(GetSetLoadSaveDefaultKeyValue(KeyName, defVal, fileName)); + Exit(GetKeyValueDefLoadFirst(KeyName, defVal, fileName)); end; { @@ -449,7 +466,7 @@ end; and CreatePath = True, then b,c,d and e are all created. } -function TMMLSettings.CreateKey(KeyName: String; CreatePath: Boolean = False): Boolean; +function TMMLSettings.CreateKey(KeyName: String; CreatePath: Boolean = True): Boolean; var N, newN, nParent: TTreeNode; Path: TStringArray; @@ -524,15 +541,18 @@ end; Set the value of a key. } -procedure TMMLSettings.SetKeyValue(KeyName: String; KeyValue: String); +function TMMLSettings.SetKeyValue(KeyName: String; KeyValue: String; CreatePath: boolean) : boolean; var N, NN: TTreeNode; begin - if not KeyExists(KeyName) then + result := false; + if not KeyExists(KeyName) and not CreatePath then begin mDebugLn('SetKeyValue - Key does not exist'); Exit; - end; + end else + if not KeyExists(keyname) then + CreateKey(keyname); if not IsKey(KeyName) then begin mDebugLn('SetKeyValue - IsKey returned false'); @@ -558,6 +578,7 @@ begin mDebugLn('Setting ' + KeyName + ' to ' + KeyValue); N := N.GetNextSibling; end; + result := true; end; diff --git a/Units/MMLAddon/settingssandbox.pas b/Units/MMLAddon/settingssandbox.pas index a5b20e9..e2e0355 100644 --- a/Units/MMLAddon/settingssandbox.pas +++ b/Units/MMLAddon/settingssandbox.pas @@ -30,26 +30,28 @@ uses Classes, SysUtils, settings, strutils, mufasatypes; type + + { TMMLSettingsSandbox } + TMMLSettingsSandbox = class(TObject) - public - constructor Create(sett: TMMLSettings); - destructor Destroy; override; - - function IsKey(KeyName: String): Boolean; - function IsDirectory(KeyName: String): Boolean; - function GetKeyValue(KeyName: String): String; - function GetSetDefaultKeyValue(KeyName, defVal: String): String; - function ListKeys(KeyName: String): TStringArray; - - function DeleteKey(KeyName: String): Boolean; - function DeleteSubKeys(KeyName: String): Boolean; - public - function GetPrefix: String; - procedure SetPrefix(s: String); - private - ST: TMMLSettings; - Prefix: String; + private + ST: TMMLSettings; + FPrefix: String; + function GetPrefix: String; + procedure SetPrefix(s: String); + public + constructor Create(sett: TMMLSettings); + destructor Destroy; override; + function IsKey(KeyName: String): Boolean; + function IsDirectory(KeyName: String): Boolean; + function SetKeyValue(Keyname : string; Value : string) : boolean; + function GetKeyValue(KeyName: String): String; + function GetKeyValueDef(KeyName, defVal: String): String; + function ListKeys(KeyName: String; out Keys : TStringArray): boolean; + function DeleteKey(KeyName: String): Boolean; + function DeleteSubKeys(KeyName: String): Boolean; + property prefix : string read GetPrefix write SetPrefix; end; implementation @@ -70,17 +72,17 @@ end; function TMMLSettingsSandbox.GetPrefix: String; begin - result := Prefix; + result := FPrefix; end; procedure TMMLSettingsSandbox.SetPrefix(s: String); begin - Prefix := s; + FPrefix := s; end; -function TMMLSettingsSandbox.ListKeys(KeyName: String): TStringArray; +function TMMLSettingsSandbox.ListKeys(KeyName: String; out Keys :TStringArray): boolean; begin - exit(ST.ListKeys(Prefix + KeyName)) + exit(ST.ListKeys(Prefix + KeyName,keys)) end; function TMMLSettingsSandbox.GetKeyValue(KeyName: String): String; @@ -88,9 +90,9 @@ begin exit(ST.GetKeyValue(Prefix + KeyName)) end; -function TMMLSettingsSandbox.GetSetDefaultKeyValue(KeyName, defVal: String): String; +function TMMLSettingsSandbox.GetKeyValueDef(KeyName, defVal: String): String; begin - exit(ST.GetSetDefaultKeyValue(Prefix + KeyName, defVal)) + exit(ST.GetKeyValueDef(Prefix + KeyName, defVal)) end; function TMMLSettingsSandbox.IsKey(KeyName: String): Boolean; @@ -103,6 +105,14 @@ begin exit(ST.IsDirectory(Prefix + KeyName)) end; +function TMMLSettingsSandbox.SetKeyValue(Keyname: string; Value: string + ): boolean; +begin + Writeln(KeyName); + Writeln(Value); + exit(ST.SetKeyValue(prefix + keyname,value,true)); +end; + function TMMLSettingsSandbox.DeleteKey(KeyName: String): Boolean; begin exit(ST.DeleteKey(Prefix + KeyName)); From a9e6dc0e2589eda14c7f948a3e6c880f3fcbc28f Mon Sep 17 00:00:00 2001 From: Raymond Date: Thu, 1 Apr 2010 00:27:37 +0200 Subject: [PATCH 7/7] Changed rev ;) --- Projects/SAMufasaGUI/testunit.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index af167e7..6bec6e5 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -46,7 +46,7 @@ uses CastaliaSimplePasPar, v_AutoCompleteForm, PSDump; const - SimbaVersion = 600; + SimbaVersion = 602; type