1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-29 04:22:16 -05:00

Merge ssh://villavu.com:54367/simba

This commit is contained in:
Niels 2010-04-01 07:45:13 +02:00
commit 1d001eb8d7
21 changed files with 1137 additions and 316 deletions

View File

@ -12,6 +12,7 @@ end;
procedure Attach; procedure Attach;
begin; begin;
Settings.SetKeyValue('TestSetting','1337');
Writeln('Your extension has been enabled, do stuff here'); Writeln('Your extension has been enabled, do stuff here');
end; end;

View File

@ -11,22 +11,57 @@ type
PTPoint = ^TPoint; PTPoint = ^TPoint;
PPDTM = ^PDTM; PPDTM = ^PDTM;
Const
RESULT_OK = 0;
RESULT_ERROR = 1;
var var
C: TClient; 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 begin
result := PChar('hello world'); result := PChar('hello world');
raise exception.Create('wat');
end; end;
procedure init; { Mouse }
function getmousepos(var t: tpoint): integer; cdecl;
begin 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; end;
function getmousepos: tpoint; cdecl; {function ConvIntClickType(Int : Integer) : TClickType;inline;
begin begin;
C.IOManager.GetMousePos(result.x,result.y); 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;
end; }
function returnpoints: PTPoint; cdecl; function returnpoints: PTPoint; cdecl;
@ -54,12 +89,84 @@ function givedtm:PPDTM; cdecl;
var var
dtm: PPDTM; dtm: PPDTM;
begin begin
writeln('Size: ' + inttostr(sizeof(pdtm)));
writeln('Size: ' + inttostr(sizeof(ptruint)));
dtm := AllocMem(sizeof(pdtm)); dtm := AllocMem(sizeof(pdtm));
initdtm(dtm^,2); initdtm(dtm^,2);
result:=dtm; result:=dtm;
dtm^.n := PChar('wat'); dtm^.n := PChar('wat');
end; 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 exports
test, test,
init, init,
@ -67,7 +174,13 @@ exports
returnpoints, returnpoints,
printpoints, printpoints,
hoi, hoi,
givedtm; givedtm,
givedtm2,
returnarray,
printarray,
fpc_freemem_,
fpc_allocmem_,
fpc_reallocmem_;
begin begin

31
Projects/MMLLib/pymml/mml.py Executable file
View File

@ -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

View File

@ -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

View File

@ -0,0 +1,9 @@
from ctypes import *
class POINT(Structure):
_fields_ = [('x', c_int),
('y', c_int)]
PPOINT = POINTER(POINT)

View File

@ -28,7 +28,7 @@ type
StartDisabled : boolean; StartDisabled : boolean;
property OnChange : TNotifyEvent read FOnChange write SetOnchange; property OnChange : TNotifyEvent read FOnChange write SetOnchange;
function GetExtensionIndex(Filename : string) : integer; 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 LoadPSExtensionsDir(Directory,ext : string) : boolean;
function HandleHook(HookName: String; Args: Array of Variant): Variant; function HandleHook(HookName: String; Args: Array of Variant): Variant;
end; end;
@ -38,7 +38,7 @@ var
implementation implementation
uses uses
TestUnit; TestUnit, settingssandbox,simbasettings;
procedure TExtensionManager.SetOnchange(const AValue: TNotifyEvent); procedure TExtensionManager.SetOnchange(const AValue: TNotifyEvent);
var var
@ -76,7 +76,7 @@ begin
result := -1; result := -1;
end; end;
function TExtensionManager.LoadPSExtension(Filename: string): boolean; function TExtensionManager.LoadPSExtension(Filename: string; enabled: boolean): boolean;
var var
Ext : TExtension; Ext : TExtension;
begin begin
@ -84,12 +84,17 @@ begin
exit(true); exit(true);
Result := False; Result := False;
try try
Ext := TSimbaPSExtension.Create(filename,startdisabled); Ext := TSimbaPSExtension.Create(filename,True);
result := TSimbaPSExtension(ext).Working; // result := TSimbaPSExtension(ext).Working;
Extensions.Add(ext); 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; ext.OnChange:= FOnChange;
if assigned(FOnChange) then if assigned(FOnChange) then
FOnChange(Self); FOnChange(Self);
Result := True;
except except
on e : exception do on e : exception do
formWritelnex(format('Error in LoadPSExtension(%s): %s',[FileName, e.message])); formWritelnex(format('Error in LoadPSExtension(%s): %s',[FileName, e.message]));
@ -127,7 +132,7 @@ begin
Directory := IncludeTrailingPathDelimiter(directory); Directory := IncludeTrailingPathDelimiter(directory);
Files := GetFiles(Directory,ext); Files := GetFiles(Directory,ext);
for i := 0 to high(Files) do 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; FOnChange := Tempevent;
if Assigned(FOnChange) then if Assigned(FOnChange) then
FOnChange(self); FOnChange(self);

View File

@ -597,6 +597,7 @@ object ScriptFrame: TScriptFrame
Options = [eoAutoIndent, eoGroupUndo, eoScrollPastEol, eoSmartTabs, eoTabIndent, eoTabsToSpaces, eoTrimTrailingSpaces, eoBracketHighlight] Options = [eoAutoIndent, eoGroupUndo, eoScrollPastEol, eoSmartTabs, eoTabIndent, eoTabsToSpaces, eoTrimTrailingSpaces, eoBracketHighlight]
BracketHighlightStyle = sbhsBoth BracketHighlightStyle = sbhsBoth
OnChange = SynEditChange OnChange = SynEditChange
OnCommandProcessed = SynEditCommandProcessed
OnProcessCommand = SynEditProcessCommand OnProcessCommand = SynEditProcessCommand
OnProcessUserCommand = SynEditProcessUserCommand OnProcessUserCommand = SynEditProcessUserCommand
OnSpecialLineColors = SynEditSpecialLineColors OnSpecialLineColors = SynEditSpecialLineColors

View File

@ -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' +'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 +'ent'#11'eoGroupUndo'#15'eoScrollPastEol'#11'eoSmartTabs'#11'eoTabIndent'#14
+'eoTabsToSpaces'#20'eoTrimTrailingSpaces'#18'eoBracketHighlight'#0#21'Bracke' +'eoTabsToSpaces'#20'eoTrimTrailingSpaces'#18'eoBracketHighlight'#0#21'Bracke'
+'tHighlightStyle'#7#8'sbhsBoth'#8'OnChange'#7#13'SynEditChange'#16'OnProcess' +'tHighlightStyle'#7#8'sbhsBoth'#8'OnChange'#7#13'SynEditChange'#18'OnCommand'
+'Command'#7#21'SynEditProcessCommand'#20'OnProcessUserCommand'#7#25'SynEditP' +'Processed'#7#23'SynEditCommandProcessed'#16'OnProcessCommand'#7#21'SynEditP'
+'rocessUserCommand'#19'OnSpecialLineColors'#7#24'SynEditSpecialLineColors'#14 +'rocessCommand'#20'OnProcessUserCommand'#7#25'SynEditProcessUserCommand'#19
+'OnStatusChange'#7#19'SynEditStatusChange'#0#244#18'TSynGutterPartList'#0#0 +'OnSpecialLineColors'#7#24'SynEditSpecialLineColors'#14'OnStatusChange'#7#19
+#15'TSynGutterMarks'#0#5'Width'#2#23#0#0#20'TSynGutterLineNumber'#0#5'Width' +'SynEditStatusChange'#0#244#18'TSynGutterPartList'#0#0#15'TSynGutterMarks'#0
+#2#17#12'MouseActions'#14#0#21'MarkupInfo.Background'#7#9'clBtnFace'#21'Mark' +#5'Width'#2#23#0#0#20'TSynGutterLineNumber'#0#5'Width'#2#17#12'MouseActions'
+'upInfo.Foreground'#7#6'clNone'#10'DigitCount'#2#2#30'ShowOnlyLineNumbersMul' +#14#0#21'MarkupInfo.Background'#7#9'clBtnFace'#21'MarkupInfo.Foreground'#7#6
+'tiplesOf'#2#1#9'ZeroStart'#8#12'LeadingZeros'#8#0#0#17'TSynGutterChanges'#0 +'clNone'#10'DigitCount'#2#2#30'ShowOnlyLineNumbersMultiplesOf'#2#1#9'ZeroSta'
+#5'Width'#2#4#13'ModifiedColor'#4#252#233#0#0#10'SavedColor'#7#7'clGreen'#0#0 +'rt'#8#12'LeadingZeros'#8#0#0#17'TSynGutterChanges'#0#5'Width'#2#4#13'Modifi'
,#19'TSynGutterSeparator'#0#5'Width'#2#2#0#0#21'TSynGutterCodeFolding'#0#12'M' ,'edColor'#4#252#233#0#0#10'SavedColor'#7#7'clGreen'#0#0#19'TSynGutterSeparat'
+'ouseActions'#14#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#7'mbRight'#10 +'or'#0#5'Width'#2#2#0#0#21'TSynGutterCodeFolding'#0#12'MouseActions'#14#1#5
+'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#4'cdUp'#7'Command'#2#16#9'MoveCaret' +'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#7'mbRight'#10'ClickCount'#7#8'ccS'
+#8#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#7'ssShift' +'ingle'#8'ClickDir'#7#4'cdUp'#7'Command'#2#16#9'MoveCaret'#8#6'Option'#2#0#8
+#0#6'Button'#7#8'mbMiddle'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown' +'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#7'ssShift'#0#6'Button'#7#8
+#7'Command'#2#14#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11 +'mbMiddle'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#14
+#7'ssShift'#0#9'ShiftMask'#11#7'ssShift'#0#6'Button'#7#8'mbMiddle'#10'ClickC' +#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#7'ssShift'#0#9
+'ount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#14#9'MoveCaret'#8#6'O' +'ShiftMask'#11#7'ssShift'#0#6'Button'#7#8'mbMiddle'#10'ClickCount'#7#5'ccAny'
+'ption'#2#1#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6 +#8'ClickDir'#7#6'cdDown'#7'Command'#2#14#9'MoveCaret'#8#6'Option'#2#1#8'Prio'
+'mbLeft'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#0#9 +'rity'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'Clic'
+'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#0#21'MarkupInfo.Background'#7#6 +'kCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#0#9'MoveCaret'#8#6
+'clNone'#21'MarkupInfo.Foreground'#7#6'clGray'#20'MouseActionsExpanded'#14#1 +'Option'#2#0#8'Priority'#2#0#0#0#21'MarkupInfo.Background'#7#6'clNone'#21'Ma'
+#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5'cc' +'rkupInfo.Foreground'#7#6'clGray'#20'MouseActionsExpanded'#14#1#5'Shift'#11#0
+'Any'#8'ClickDir'#7#6'cdDown'#7'Command'#2#14#9'MoveCaret'#8#6'Option'#2#0#8 +#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5'ccAny'#8'ClickDi'
+'Priority'#2#0#0#0#21'MouseActionsCollapsed'#14#1#5'Shift'#11#6'ssCtrl'#0#9 +'r'#7#6'cdDown'#7'Command'#2#14#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0
+'ShiftMask'#11#6'ssCtrl'#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5'ccAny'#8 +#0#0#21'MouseActionsCollapsed'#14#1#5'Shift'#11#6'ssCtrl'#0#9'ShiftMask'#11#6
+'ClickDir'#7#6'cdDown'#7'Command'#2#15#9'MoveCaret'#8#6'Option'#2#0#8'Priori' +'ssCtrl'#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'c'
+'ty'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#6'ssCtrl'#0#6'Button'#7#6'mbLeft' +'dDown'#7'Command'#2#15#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#1#5'S'
+#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#15#9'MoveCar' +'hift'#11#0#9'ShiftMask'#11#6'ssCtrl'#0#6'Button'#7#6'mbLeft'#10'ClickCount'
+'et'#8#6'Option'#2#1#8'Priority'#2#0#0#0#0#0#0#0#17'TSynFreePascalSyn'#17'Sy' +#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#15#9'MoveCaret'#8#6'Option'
+'nFreePascalSyn1'#7'Enabled'#8#23'CommentAttri.Foreground'#7#6'clBlue'#18'Co' +#2#1#8'Priority'#2#0#0#0#0#0#0#0#17'TSynFreePascalSyn'#17'SynFreePascalSyn1'
+'mmentAttri.Style'#11#6'fsBold'#0#26'IdentifierAttri.Foreground'#7#9'clDefau' +#7'Enabled'#8#23'CommentAttri.Foreground'#7#6'clBlue'#18'CommentAttri.Style'
+'lt'#22'NumberAttri.Foreground'#7#6'clNavy'#22'StringAttri.Foreground'#7#6'c' +#11#6'fsBold'#0#26'IdentifierAttri.Foreground'#7#9'clDefault'#22'NumberAttri'
+'lBlue'#22'SymbolAttri.Foreground'#7#5'clRed'#25'DirectiveAttri.Foreground'#7 +'.Foreground'#7#6'clNavy'#22'StringAttri.Foreground'#7#6'clBlue'#22'SymbolAt'
+#5'clRed'#20'DirectiveAttri.Style'#11#6'fsBold'#0#12'CompilerMode'#7#9'pcmOb' +'tri.Foreground'#7#5'clRed'#25'DirectiveAttri.Foreground'#7#5'clRed'#20'Dire'
+'jFPC'#14'NestedComments'#9#4'left'#3'@'#1#3'top'#2#16#0#0#0 +'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
]); ]);

View File

@ -29,9 +29,10 @@ interface
uses uses
Classes, SysUtils, FileUtil, LResources, Forms, SynHighlighterPas, SynEdit, SynEditMarkupHighAll, Classes, SysUtils, FileUtil, LResources, Forms, SynHighlighterPas, SynEdit, SynEditMarkupHighAll,
mmlpsthread,ComCtrls, SynEditKeyCmds, LCLType,MufasaBase, SynEditMarkupSpecialLine, Graphics, Controls, mmlpsthread,ComCtrls, SynEditKeyCmds, LCLType,MufasaBase, SynEditMarkupSpecialLine, Graphics, Controls,
v_ideCodeInsight, v_ideCodeParser, CastaliaPasLexTypes, CastaliaSimplePasPar, SynEditHighlighter; v_ideCodeInsight, v_ideCodeParser, CastaliaPasLexTypes, CastaliaSimplePasPar, SynEditHighlighter,synedittextbase;
const const
ecCodeCompletion = ecUserFirst; ecCodeCompletion = ecUserFirst;
ecCodeHints = ecUserFirst + 1;
type type
TScriptState = (ss_None,ss_Running,ss_Paused,ss_Stopping); TScriptState = (ss_None,ss_Running,ss_Paused,ss_Stopping);
{ {
@ -49,6 +50,8 @@ type
procedure SynEditChange(Sender: TObject); procedure SynEditChange(Sender: TObject);
procedure SynEditClickLink(Sender: TObject; Button: TMouseButton; procedure SynEditClickLink(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); 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 SynEditDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure SynEditDragOver(Sender, Source: TObject; X, Y: Integer; procedure SynEditDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean); State: TDragState; var Accept: Boolean);
@ -124,6 +127,28 @@ begin
Result := Copy(s, sp, ep - sp + 1); Result := Copy(s, sp, ep - sp + 1);
end; 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 } { TScriptFrame }
procedure TScriptFrame.SynEditChange(Sender: TObject); procedure TScriptFrame.SynEditChange(Sender: TObject);
@ -186,6 +211,18 @@ begin
end; end;
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); procedure TScriptFrame.SynEditDragDrop(Sender, Source: TObject; X, Y: Integer);
begin begin
if Source is TFunctionListFrame then if Source is TFunctionListFrame then
@ -213,6 +250,8 @@ begin
Form1.ActionFindNextExecute(Sender); Form1.ActionFindNextExecute(Sender);
key := 0; key := 0;
end; end;
if key = VK_ESCAPE then
Form1.ParamHint.Hide;
Form1.CodeCompletionForm.HandleKeyDown(Sender, Key, Shift); Form1.CodeCompletionForm.HandleKeyDown(Sender, Key, Shift);
end; end;
@ -256,10 +295,12 @@ var
mp: TCodeInsight; mp: TCodeInsight;
ms: TMemoryStream; ms: TMemoryStream;
ItemList, InsertList: TStringList; ItemList, InsertList: TStringList;
sp, ep: Integer; sp, ep,bcc,cc,bck,posi,bracketpos: Integer;
p: TPoint; p: TPoint;
s, Filter: string; s, Filter: string;
Attri: TSynHighlighterAttributes; Attri: TSynHighlighterAttributes;
d: TDeclaration;
dd: TDeclaration;
begin begin
if (Command = ecCodeCompletion) and ((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 begin
@ -338,7 +379,67 @@ begin
InsertList.Free; InsertList.Free;
end; end;
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;
ms := TMemoryStream.Create;
synedit.Lines.SaveToStream(ms);
try
Synedit.GetWordBoundsAtRowCol(Synedit.CaretXY, sp, ep);
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);
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
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;
//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('<no parameters expected>');
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 if Form1.CodeCompletionForm.Visible then
case Command of case Command of
ecDeleteChar, ecDeleteWord, ecDeleteEOL: ecDeleteChar, ecDeleteWord, ecDeleteEOL:
@ -353,7 +454,6 @@ begin
Exit; Exit;
end; end;
end; end;
Form1.CodeCompletionForm.Hide; Form1.CodeCompletionForm.Hide;
end; end;
end; end;
@ -522,6 +622,7 @@ begin
MarkCaret.IgnoreKeywords := true; MarkCaret.IgnoreKeywords := true;
end; end;
AddKey(SynEdit,ecCodeCompletion,VK_SPACE,[ssCtrl]); AddKey(SynEdit,ecCodeCompletion,VK_SPACE,[ssCtrl]);
AddKey(SynEdit,ecCodeHints,VK_SPACE,[ssCtrl,ssShift]);
// TSynPasSyn(SynEdit.Highlighter).NestedComments:= false; Does not work :( // TSynPasSyn(SynEdit.Highlighter).NestedComments:= false; Does not work :(
end; end;

View File

@ -27,6 +27,8 @@ type
function FreeScript: boolean; function FreeScript: boolean;
function InitScript: Boolean; function InitScript: Boolean;
procedure OutputMessages; procedure OutputMessages;
procedure SIRegister_Settings(Cl: TPSPascalCompiler);
procedure RIRegister_Settings(Cl: TPSRuntimeClassImporter);
public public
function HookExists(HookName: String): Boolean;override; function HookExists(HookName: String): Boolean;override;
@ -47,7 +49,7 @@ uses
uPSC_extctrls,uPSC_menus, //Compile libs uPSC_extctrls,uPSC_menus, //Compile libs
uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms, uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms,
uPSR_extctrls,uPSR_menus, //Runtime-libs uPSR_extctrls,uPSR_menus, //Runtime-libs
testunit//Writeln testunit,updateform,settingssandbox//Writeln
; ;
function TSimbaPSExtension.HookExists(HookName: String): Boolean; function TSimbaPSExtension.HookExists(HookName: String): Boolean;
@ -110,10 +112,13 @@ begin
result := ExecuteHook('Free',[],bla) = SExt_ok; result := ExecuteHook('Free',[],bla) = SExt_ok;
end; end;
{$I ../../Units/MMLAddon/PSInc/Wrappers/extensions.inc}
procedure TSimbaPSExtension.RegisterMyMethods(Sender: TPSScript); procedure TSimbaPSExtension.RegisterMyMethods(Sender: TPSScript);
begin begin
Sender.AddFunction(@formWritelnEx,'procedure Writeln(s : string)'); 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','TForm');
Sender.AddRegisteredVariable('Simba_MainMenu','TMainMenu'); Sender.AddRegisteredVariable('Simba_MainMenu','TMainMenu');
end; end;
@ -122,6 +127,7 @@ procedure TSimbaPSExtension.OnPSExecute(Sender: TPSScript);
begin begin
Sender.SetVarToInstance('simba',Form1); Sender.SetVarToInstance('simba',Form1);
Sender.SetVarToInstance('Simba_MainMenu',Form1.MainMenu); Sender.SetVarToInstance('Simba_MainMenu',Form1.MainMenu);
Sender.SetPointerToData('Settings',@Self.Settings,Sender.FindNamedType('TMMLSettingsSandbox'));
end; end;
procedure TSimbaPSExtension.SetEnabled(bool: boolean); procedure TSimbaPSExtension.SetEnabled(bool: boolean);
@ -148,6 +154,41 @@ begin
inherited SetEnabled(bool); inherited SetEnabled(bool);
end; 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); procedure TSimbaPSExtension.RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
begin begin
SIRegister_Std(x); SIRegister_Std(x);
@ -158,6 +199,7 @@ begin
SIRegister_Forms(x); SIRegister_Forms(x);
SIRegister_ExtCtrls(x); SIRegister_ExtCtrls(x);
SIRegister_Menus(x); SIRegister_Menus(x);
SIRegister_Settings(x);
end; end;
procedure TSimbaPSExtension.RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); procedure TSimbaPSExtension.RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
@ -170,6 +212,7 @@ begin
RIRegister_Forms(x); RIRegister_Forms(x);
RIRegister_ExtCtrls(x); RIRegister_ExtCtrls(x);
RIRegister_Menus(x); RIRegister_Menus(x);
RIRegister_Settings(x);
end; end;
destructor TSimbaPSExtension.Destroy; destructor TSimbaPSExtension.Destroy;
@ -224,6 +267,5 @@ begin
end; end;
end. end.

View File

@ -40,13 +40,13 @@ uses
colourpicker, framescript, windowselector, lcltype, ActnList, colourpicker, framescript, windowselector, lcltype, ActnList,
SynExportHTML, SynEditKeyCmds, SynEditHighlighter, SynExportHTML, SynEditKeyCmds, SynEditHighlighter,
SynEditMarkupHighAll, LMessages, Buttons,mmisc, SynEditMarkupHighAll, LMessages, Buttons,mmisc,
stringutil,mufasatypesutil,mufasabase, stringutil,mufasatypesutil,mufasabase, v_ideCodeParser,
about, framefunctionlist, ocr, updateform, simbasettings, psextension, virtualextension, about, framefunctionlist, ocr, updateform, simbasettings, psextension, virtualextension,
extensionmanager, settingssandbox, v_ideCodeInsight, CastaliaPasLexTypes, extensionmanager, settingssandbox, v_ideCodeInsight, CastaliaPasLexTypes,
CastaliaSimplePasPar, v_AutoCompleteForm, PSDump; CastaliaSimplePasPar, v_AutoCompleteForm, PSDump;
const const
SimbaVersion = 600; SimbaVersion = 602;
type type
@ -330,12 +330,15 @@ type
function GetFontPath: String; function GetFontPath: String;
function GetIncludePath: String; function GetIncludePath: String;
function GetScriptState: TScriptState; function GetScriptState: TScriptState;
function GetShowHintAuto: boolean;
procedure SetFontPath(const AValue: String); procedure SetFontPath(const AValue: String);
procedure SetIncludePath(const AValue: String); procedure SetIncludePath(const AValue: String);
procedure SetShowHintAuto(const AValue: boolean);
procedure SetScriptState(const State: TScriptState); procedure SetScriptState(const State: TScriptState);
function LoadSettingDef(Key : string; Def : string) : string; function LoadSettingDef(Key : string; Def : string) : string;
function CreateSetting(Key : string; Value : 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; procedure FontUpdate;
public public
DebugStream: String; DebugStream: String;
@ -344,6 +347,7 @@ type
CurrTab : TMufasaTab; //The current TMufasaTab CurrTab : TMufasaTab; //The current TMufasaTab
CodeCompletionForm: TAutoCompletePopup; CodeCompletionForm: TAutoCompletePopup;
CodeCompletionStart: TPoint; CodeCompletionStart: TPoint;
ParamHint : TParamHint;
Tabs : TList; Tabs : TList;
Manager: TIOManager; Manager: TIOManager;
OCR_Fonts: TMOCR; OCR_Fonts: TMOCR;
@ -382,6 +386,7 @@ type
procedure InitalizeTMThread(var Thread : TMThread); procedure InitalizeTMThread(var Thread : TMThread);
procedure HandleParameters; procedure HandleParameters;
procedure OnSaveScript(const Filename : string); procedure OnSaveScript(const Filename : string);
property ShowHintAuto : boolean read GetShowHintAuto write SetShowHintAuto;
property IncludePath : String read GetIncludePath write SetIncludePath; property IncludePath : String read GetIncludePath write SetIncludePath;
property FontPath : String read GetFontPath write SetFontPath; property FontPath : String read GetFontPath write SetFontPath;
end; end;
@ -990,6 +995,7 @@ begin
CreateSetting('Settings/General/MaxRecentFiles','10'); CreateSetting('Settings/General/MaxRecentFiles','10');
CreateSetting('Settings/MainForm/NormalSize','739:555'); CreateSetting('Settings/MainForm/NormalSize','739:555');
CreateSetting('Settings/FunctionList/ShowOnStart','True'); CreateSetting('Settings/FunctionList/ShowOnStart','True');
CreateSetting('Settings/CodeHints/ShowAutomatically','True');
CreateSetting('Settings/Updater/RemoteLink',SimbaURL + 'Simba'{$IFDEF WINDOWS} +'.exe'{$ENDIF}); CreateSetting('Settings/Updater/RemoteLink',SimbaURL + 'Simba'{$IFDEF WINDOWS} +'.exe'{$ENDIF});
CreateSetting('Settings/Updater/RemoteVersionLink',SimbaURL + 'Version'); CreateSetting('Settings/Updater/RemoteVersionLink',SimbaURL + 'Version');
@ -999,6 +1005,7 @@ begin
{Creates the paths and returns the path} {Creates the paths and returns the path}
PluginsPath := CreateSetting('Settings/Plugins/Path', ExpandFileName(MainDir+ DS+ 'Plugins' + DS)); PluginsPath := CreateSetting('Settings/Plugins/Path', ExpandFileName(MainDir+ DS+ 'Plugins' + DS));
extensionsPath := CreateSetting('Settings/Extensions/Path',ExpandFileName(MainDir +DS + 'Extensions' + DS)); extensionsPath := CreateSetting('Settings/Extensions/Path',ExpandFileName(MainDir +DS + 'Extensions' + DS));
CreateSetting('Extensions/ExtensionCount','0');
CreateSetting('LastConfig/MainForm/Position',''); CreateSetting('LastConfig/MainForm/Position','');
CreateSetting('LastConfig/MainForm/State','Normal'); CreateSetting('LastConfig/MainForm/State','Normal');
{$ifdef MSWindows} {$ifdef MSWindows}
@ -1020,6 +1027,41 @@ begin
end; end;
procedure TForm1.LoadFormSettings; 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 var
str,str2 : string; str,str2 : string;
Data : TStringArray; Data : TStringArray;
@ -1063,65 +1105,58 @@ begin
else else
ShowConsole(false); ShowConsole(false);
{$endif} {$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)); str := LoadSettingDef('Settings/Extensions/Path',ExpandFileName(MainDir +DS + 'Extensions' + DS));
str2 := LoadSettingDef('Settings/Extensions/FileExtension','sex'); str2 := LoadSettingDef('Settings/Extensions/FileExtension','sex');
ExtManager.LoadPSExtensionsDir(str,str2); 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; end;
procedure TForm1.SaveFormSettings; procedure TForm1.SaveFormSettings;
var var
Data : TStringArray; Data : TStringArray;
path : string;
i : integer; i : integer;
begin begin
with SettingsForm.Settings do with SettingsForm.Settings do
begin begin
if Self.WindowState = wsMaximized then if Self.WindowState = wsMaximized then
SetKeyValue('LastConfig/MainForm/State','maximized') SetSetting('LastConfig/MainForm/State','maximized')
else else
begin; //Only save the form position if its non maximized. 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)]); 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; end;
if RecentFiles.Count > 0 then if RecentFiles.Count > 0 then
begin begin
SetLength(data,RecentFiles.Count); SetLength(data,RecentFiles.Count);
for i := 0 to high(data) do //First entry should be the last-opened for i := 0 to high(data) do //First entry should be the last-opened
data[high(data) - i] := RecentFiles[i]; data[high(data) - i] := RecentFiles[i];
SetKeyValue('LastConfig/MainForm/RecentFiles',implode(';',data)); SetSetting('LastConfig/MainForm/RecentFiles',implode(';',data));
end else end else
SetKeyValue('LastConfig/MainForm/RecentFiles',''); SetSetting('LastConfig/MainForm/RecentFiles','');
if MenuItemFunctionList.Checked then if MenuItemFunctionList.Checked then
SetKeyValue('LastConfig/MainForm/FunctionListShown','True') SetSetting('LastConfig/MainForm/FunctionListShown','True')
else else
SetKeyValue('LastConfig/MainForm/FunctionListShown','False'); SetSetting('LastConfig/MainForm/FunctionListShown','False');
{$ifdef MSWindows} {$ifdef MSWindows}
if ConsoleVisible then if ConsoleVisible then
SetKeyValue('LastConfig/Console/Visible','True') SetSetting('LastConfig/Console/Visible','True')
else else
SetKeyValue('LastConfig/Console/Visible','false'); SetSetting('LastConfig/Console/Visible','false');
{$endif} {$endif}
if ExtManager.Extensions.Count > 0 then SetSetting('Extensions/ExtensionCount',inttostr(ExtManager.Extensions.Count));
begin
SetLength(data,0);
for i := 0 to ExtManager.Extensions.Count-1 do for i := 0 to ExtManager.Extensions.Count-1 do
if TVirtualSimbaExtension(ExtManager.Extensions[i]).Enabled then begin;
begin
setlength(data,length(data)+1); path :='Extensions/Extension' + inttostr(I);
data[high(data)] := TVirtualSimbaExtension(ExtManager.Extensions[i]).FileName; SetSetting(Path + '/Path',TVirtualSimbaExtension(ExtManager.Extensions[i]).Filename);
SetSetting(Path + '/Enabled',BoolToStr(TVirtualSimbaExtension(ExtManager.Extensions[i]).Enabled,True));
end; end;
SetKeyValue('LastConfig/Extensions/EnabledExts',Implode(';',data));
end else
SetKeyValue('LastConfig/Extensions/EnabledExts','');
SaveToXML(SimbaSettingsFile); SaveToXML(SimbaSettingsFile);
end; end;
end; end;
@ -1217,7 +1252,7 @@ begin
Thread.Client.MOCR.SetFonts(OCR_Fonts.GetFonts); Thread.Client.MOCR.SetFonts(OCR_Fonts.GetFonts);
Se := TMMLSettingsSandbox.Create(SettingsForm.Settings); Se := TMMLSettingsSandbox.Create(SettingsForm.Settings);
Se.SetPrefix('Scripts/'); Se.Prefix := 'Scripts/';
Thread.SetSettings(Se); Thread.SetSettings(Se);
end; end;
@ -1831,6 +1866,8 @@ begin
CodeCompletionForm := TAutoCompletePopup.Create(Self); CodeCompletionForm := TAutoCompletePopup.Create(Self);
CodeCompletionForm.InsertProc := @OnCompleteCode; CodeCompletionForm.InsertProc := @OnCompleteCode;
ParamHint := TParamHint.Create(self);
{$ifdef MSWindows} {$ifdef MSWindows}
ConsoleVisible := True; ConsoleVisible := True;
PrevWndProc := Windows.WNDPROC(GetWindowLong(self.handle,GWL_WNDPROC)); PrevWndProc := Windows.WNDPROC(GetWindowLong(self.handle,GWL_WNDPROC));
@ -1907,6 +1944,7 @@ begin
SetLength(DebugStream, 0); SetLength(DebugStream, 0);
RecentFiles.Free; RecentFiles.Free;
DebugCriticalSection.Free; DebugCriticalSection.Free;
ParamHint.Free;
{$ifdef MSWindows} {$ifdef MSWindows}
if not UnRegisterHotkey(Self.Handle,0) then if not UnRegisterHotkey(Self.Handle,0) then
mDebugLn('Unable to unregister ctrl + alt + s as global hotkey'); mDebugLn('Unable to unregister ctrl + alt + s as global hotkey');
@ -2213,17 +2251,8 @@ begin
end; end;
procedure TForm1.ButtonTrayClick(Sender: TObject); procedure TForm1.ButtonTrayClick(Sender: TObject);
{var
ms : TMemoryStream;
fs : TFileStream;}
begin begin
{ self.hide;
fs := TFileStream.Create('c:\remake\fonts.tar.bz2',fmOpenRead);
ms := DecompressBZip2(fs);
fs.free;
UnTar(ms,'c:\remake\fonttest\',true);
ms.free;}
Form1.Hide;
end; end;
procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean
@ -2299,9 +2328,14 @@ begin
result := CurrScript.FScriptState; result := CurrScript.FScriptState;
end; end;
function TForm1.GetShowHintAuto: boolean;
begin
Result := LowerCase(LoadSettingDef('Settings/CodeHints/ShowAutomatically','True')) = 'true';
end;
procedure TForm1.SetFontPath(const AValue: String); procedure TForm1.SetFontPath(const AValue: String);
begin begin
SetSetting('Settings/Fonts/Path',AValue); SetSetting('Settings/Fonts/Path',AValue,true);
end; end;
function TForm1.GetFontPath: String; function TForm1.GetFontPath: String;
@ -2316,7 +2350,7 @@ end;
procedure TForm1.SetIncludePath(const AValue: String); procedure TForm1.SetIncludePath(const AValue: String);
begin begin
SetSetting('Settings/Includes/Path',AValue); SetSetting('Settings/Includes/Path',AValue,true);
end; end;
procedure TForm1.SetScriptState(const State: TScriptState); procedure TForm1.SetScriptState(const State: TScriptState);
@ -2349,22 +2383,25 @@ end;
function TForm1.LoadSettingDef(Key: string; Def: string): string; function TForm1.LoadSettingDef(Key: string; Def: string): string;
begin begin
result := SettingsForm.Settings.GetSetLoadSaveDefaultKeyValueIfNotExists(Key,def,SimbaSettingsFile); result := SettingsForm.Settings.GetKeyValueDefLoad(Key,def,SimbaSettingsFile);
end; end;
function TForm1.CreateSetting(Key: string; Value: string): string; function TForm1.CreateSetting(Key: string; Value: string): string;
begin begin
result := SettingsForm.Settings.GetSetDefaultKeyValue(Key,value); result := SettingsForm.Settings.GetKeyValueDef(Key,value);
end; end;
procedure TForm1.SetSetting(key: string; Value: string); procedure TForm1.SetSetting(key: string; Value: string; save : boolean);
begin begin
//Creates the setting if needed //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); SettingsForm.Settings.SetKeyValue(key,value);
if save then
SettingsForm.Settings.SaveToXML(SimbaSettingsFile); SettingsForm.Settings.SaveToXML(SimbaSettingsFile);
end; end;
function TForm1.SettingExtists(key: string): boolean;
begin
result :=SettingsForm.Settings.KeyExists(key);
end; end;
procedure TForm1.FontUpdate; procedure TForm1.FontUpdate;
@ -2397,7 +2434,7 @@ begin
if UnTar(decompressed, FontPath,true) then if UnTar(decompressed, FontPath,true) then
begin; begin;
FormWriteln('Succesfully installed the new fonts!'); 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 if Assigned(self.OCR_Fonts) then
self.OCR_Fonts.Free; self.OCR_Fonts.Free;
Self.OCR_Fonts := TMOCR.Create(nil); Self.OCR_Fonts := TMOCR.Create(nil);
@ -2412,6 +2449,11 @@ begin
UpdatingFonts := False; UpdatingFonts := False;
end; end;
procedure TForm1.SetShowHintAuto(const AValue: boolean);
begin
SetSetting('Settings/CodeHints/ShowAutomatically',Booltostr(AValue,true));
end;
{$ifdef mswindows} {$ifdef mswindows}
function GetConsoleWindow: HWND; stdcall; external kernel32 name 'GetConsoleWindow'; function GetConsoleWindow: HWND; stdcall; external kernel32 name 'GetConsoleWindow';

View File

@ -94,7 +94,7 @@ begin
if FontVersionThread = nil then//Create thread (only if no-other one is already running) if FontVersionThread = nil then//Create thread (only if no-other one is already running)
begin begin
FontVersionThread := TDownloadThread.Create(true); FontVersionThread := TDownloadThread.Create(true);
FontVersionThread.InputURL := SettingsForm.Settings.GetSetLoadSaveDefaultKeyValueIfNotExists( FontVersionThread.InputURL := SettingsForm.Settings.GetKeyValueDefLoad(
'Settings/Fonts/VersionLink',FontURL + 'Version',SimbaSettingsFile); 'Settings/Fonts/VersionLink',FontURL + 'Version',SimbaSettingsFile);
FontVersionThread.Resume; FontVersionThread.Resume;
while FontVersionThread.Done = false do//Wait till thread is done while FontVersionThread.Done = false do//Wait till thread is done
@ -123,7 +123,7 @@ begin
begin begin
SimbaVersionThread := TDownloadThread.Create(true); SimbaVersionThread := TDownloadThread.Create(true);
SimbaVersionThread.InputURL := SettingsForm.Settings.GetSetLoadSaveDefaultKeyValueIfNotExists( SimbaVersionThread.InputURL := SettingsForm.Settings.GetKeyValueDefLoad(
'Settings/Updater/RemoteVersionLink',SimbaURL + 'Version',SimbaSettingsFile); 'Settings/Updater/RemoteVersionLink',SimbaURL + 'Version',SimbaSettingsFile);
SimbaVersionThread.Resume; SimbaVersionThread.Resume;
while SimbaVersionThread.Done = false do//Wait till thread is done while SimbaVersionThread.Done = false do//Wait till thread is done
@ -214,7 +214,7 @@ begin
FCancelling := False; FCancelling := False;
FCancelled := False; FCancelled := False;
Updater.FileURL := SettingsForm.Settings.GetSetLoadSaveDefaultKeyValueIfNotExists( Updater.FileURL := SettingsForm.Settings.GetKeyValueDefLoad(
'Settings/Updater/RemoteLink', 'Settings/Updater/RemoteLink',
SimbaURL + 'Simba'{$IFDEF WINDOWS} +'.exe'{$ENDIF}, SimbaURL + 'Simba'{$IFDEF WINDOWS} +'.exe'{$ENDIF},
SimbaSettingsFile SimbaSettingsFile

View File

@ -5,7 +5,7 @@ unit virtualextension;
interface interface
uses uses
Classes, SysUtils; Classes, SysUtils,settingssandbox;
type type
{ TVirtualSimbaExtension } { TVirtualSimbaExtension }
@ -16,6 +16,7 @@ type
FVersion : string; FVersion : string;
FFilename : string; FFilename : string;
FEnabled : boolean; FEnabled : boolean;
FSettings : TMMLSettingsSandbox;
procedure SetEnabled(bool : boolean); virtual; procedure SetEnabled(bool : boolean); virtual;
public public
OnChange : TNotifyEvent; OnChange : TNotifyEvent;
@ -27,6 +28,7 @@ type
function GetName : string; function GetName : string;
function GetVersion : String; function GetVersion : String;
property Settings : TMMLSettingsSandbox read FSettings write FSettings;
property Filename : string read FFilename write FFilename; property Filename : string read FFilename write FFilename;
property Enabled : boolean read FEnabled write SetEnabled; property Enabled : boolean read FEnabled write SetEnabled;
end; end;

View File

@ -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 <http://www.gnu.org/licenses/>.
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;

View File

@ -21,7 +21,7 @@
Settings.inc for the Mufasa Macro Library Settings.inc for the Mufasa Macro Library
} }
function SettingsIsKey(KeyName: String): Boolean; function KeyIsSetting(KeyName: String): Boolean;
begin begin
if CurrThread.Sett <> nil then if CurrThread.Sett <> nil then
result:= CurrThread.Sett.IsKey(KeyName) result:= CurrThread.Sett.IsKey(KeyName)
@ -29,7 +29,7 @@ begin
result:=false; result:=false;
end; end;
function SettingsIsDirectory(KeyName: String): Boolean; function KeyIsDirectory(KeyName: String): Boolean;
begin begin
if CurrThread.Sett <> nil then if CurrThread.Sett <> nil then
result:= CurrThread.Sett.IsDirectory(KeyName) result:= CurrThread.Sett.IsDirectory(KeyName)
@ -37,7 +37,7 @@ begin
result := false; result := false;
end; end;
function SettingsGetKeyValue(KeyName: String): String; function GetSettingValue(KeyName: String): String;
begin begin
if CurrThread.Sett <> nil then if CurrThread.Sett <> nil then
result:= CurrThread.Sett.GetKeyValue(KeyName) result:= CurrThread.Sett.GetKeyValue(KeyName)
@ -45,23 +45,23 @@ begin
result:=''; result:='';
end; end;
function SettingsGetSetDefaultKeyValue(KeyName, defVal: String): String; function GetSettingValueDef(KeyName, defVal: String): String;
begin begin
if CurrThread.Sett <> nil then if CurrThread.Sett <> nil then
result:= CurrThread.Sett.GetSetDefaultKeyValue(KeyName, defVal) result:= CurrThread.Sett.GetKeyValueDef(KeyName, defVal)
else else
result:=''; result:='';
end; end;
procedure SettingsListKeys(KeyName: String; var KeyReturn: TStringArray); function ListSettings(KeyName: String; var KeyReturn: TStringArray) : boolean;
begin begin
if CurrThread.Sett <> nil then if CurrThread.Sett <> nil then
KeyReturn := CurrThread.Sett.ListKeys(KeyName) Result := CurrThread.Sett.ListKeys(KeyName,keyReturn)
else else
setlength(KeyReturn, 0); result := false;
end; end;
function SettingsDeleteKey(KeyName: String): Boolean; function DeleteSetting(KeyName: String): Boolean;
begin begin
if CurrThread.Sett <> nil then if CurrThread.Sett <> nil then
Result := CurrThread.Sett.DeleteKey(KeyName) Result := CurrThread.Sett.DeleteKey(KeyName)
@ -69,7 +69,7 @@ begin
result := False; result := False;
end; end;
function SettingsDeleteSubKeys(KeyName: String): Boolean; function DeleteSubSettings(KeyName: String): Boolean;
begin begin
if CurrThread.Sett <> nil then if CurrThread.Sett <> nil then
Result := CurrThread.Sett.DeleteSubKeys(KeyName) Result := CurrThread.Sett.DeleteSubKeys(KeyName)

View File

@ -367,11 +367,10 @@ AddFunction(@SameTPA,'function SameTPA(aTPA, bTPA: TPointArray): Boolean;');
AddFunction(@TPAInATPA,'function TPAInATPA(TPA: TPointArray; InATPA: T2DPointArray; var Index: LongInt): Boolean;'); AddFunction(@TPAInATPA,'function TPAInATPA(TPA: TPointArray; InATPA: T2DPointArray; var Index: LongInt): Boolean;');
SetCurrSection('Settings'); SetCurrSection('Settings');
AddFunction(@SettingsIsKey, 'function SettingsIsKey(KeyName: String): Boolean;'); AddFunction(@KeyIsSetting, 'function KeyIsSetting(KeyName: String): Boolean;');
AddFunction(@SettingsIsDirectory, 'function SettingsIsDirectory(KeyName: String): Boolean;'); AddFunction(@KeyIsDirectory, 'function KeyIsDirectory(KeyName: String): Boolean;');
AddFunction(@SettingsGetKeyValue, 'function SettingsGetKeyValue(KeyName: String): String;'); AddFunction(@GetSettingValue, 'function GetSettingValue(KeyName: String): String;');
AddFunction(@SettingsGetSetDefaultKeyValue, 'function SettingsGetSetDefaultKeyValue(KeyName, defVal: String): String;'); AddFunction(@GetSettingValueDef, 'function GetSettingValueDef(KeyName, defVal: String): String;');
AddFunction(@SettingsListKeys, 'procedure SettingsListKeys(KeyName: String; var KeyReturn: TStringArray);'); AddFunction(@ListSettings, 'function ListSettings(KeyName: String; var KeyReturn: TStringArray) : boolean;');
AddFunction(@DeleteSetting, 'function DeleteSetting(KeyName: String): Boolean;');
AddFunction(@SettingsDeleteKey, 'function SettingsDeleteKey(KeyName: String): Boolean;'); AddFunction(@DeleteSubSettings, 'function DeleteSubSettings(KeyName: String): Boolean;');
AddFunction(@SettingsDeleteSubKeys, 'function SettingsDeleteSubKeys(KeyName: String): Boolean;');

View File

@ -57,11 +57,6 @@ type
} }
TMMLSettings = class(TObject) TMMLSettings = class(TObject)
public
constructor Create(aNodes: TTreeNodes);
destructor Destroy; override;
private private
Nodes: TTreeNodes; Nodes: TTreeNodes;
function KeyNameToKeys(KeyName: String): TStringArray; function KeyNameToKeys(KeyName: String): TStringArray;
@ -73,10 +68,12 @@ type
var XMLChild: TDOMNode; var C: Integer); var XMLChild: TDOMNode; var C: Integer);
procedure WalkTree(Node: TTreeNode; XMLNode: TDOMNode; XMLDoc: TXMLDocument; procedure WalkTree(Node: TTreeNode; XMLNode: TDOMNode; XMLDoc: TXMLDocument;
var C: Integer); var C: Integer);
function GetKeyValueDefLoadFirst(KeyName, defVal, fileName: String): String;
public public
constructor Create(aNodes: TTreeNodes);
destructor Destroy; override;
function GetNodePath(Node: TTreeNode): String; function GetNodePath(Node: TTreeNode): String;
function ListKeys(KeyName: String): TStringArray; function ListKeys(KeyName: String; out Keys :TStringArray) : boolean;
function KeyExists(KeyName: String): Boolean; function KeyExists(KeyName: String): Boolean;
function IsKey(KeyName: String): Boolean; function IsKey(KeyName: String): Boolean;
@ -85,23 +82,15 @@ type
function DeleteKey(KeyName: String): Boolean; function DeleteKey(KeyName: String): Boolean;
function DeleteSubKeys(KeyName: String): Boolean; function DeleteSubKeys(KeyName: String): Boolean;
procedure SetKeyValue(KeyName: String; KeyValue: String); function CreateKey(KeyName: String; CreatePath: Boolean = True): Boolean;
function CreateKey(KeyName: String; CreatePath: Boolean = False): Boolean; function SetKeyValue(KeyName: String; KeyValue: String; CreatePath : boolean = true) : boolean;
function GetKeyValue(KeyName: String): String; function GetKeyValue(KeyName: String): String;
function GetKeyValueDef(KeyName, defVal: String): String;
function RenameKey(oldKey,newKey : string) : boolean;
function GetKeyValueDefLoad(KeyName, defVal, fileName: 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 LoadFromXML(fileName: String);
procedure SaveToXML(fileName: String); procedure SaveToXML(fileName: String);
end; end;
implementation implementation
@ -255,19 +244,19 @@ end;
Equivalent to 'ls' or 'dir'. It lists the keys in a certain key (directory) 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 var
N: TTreeNode; N: TTreeNode;
begin begin
SetLength(Result, 0); SetLength(Keys, 0);
N := WalkToNode(KeyName); N := WalkToNode(KeyName);
if N <> nil then if N <> nil then
N := N.GetFirstChild; N := N.GetFirstChild;
result := n <> nil;
while N <> nil do while N <> nil do
begin begin
setlength(result,length(result)+1); setlength(Keys,length(Keys)+1);
result[high(result)] := N.Text; Keys[high(Keys)] := N.Text;
N := N.GetNextSibling; N := N.GetNextSibling;
end; end;
end; end;
@ -345,13 +334,41 @@ begin
Exit(''); Exit('');
end; 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 the key exists - return the value.
If it does not exist, create the key - with a possible path, set it to If it does not exist, create the key - with a possible path, set it to
defVal and return defVal. defVal and return defVal.
} }
function TMMLSettings.GetSetDefaultKeyValue(KeyName, defVal: String): String; function TMMLSettings.GetKeyValueDef(KeyName, defVal: String): String;
var var
Res: String; Res: String;
begin begin
@ -421,26 +438,26 @@ begin
end; 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 begin
Nodes.Clear; Nodes.Clear;
LoadFromXML(fileName); LoadFromXML(fileName);
Result := GetSetDefaultKeyValue(KeyName, defVal); Result := GetKeyValueDef(KeyName, defVal);
SaveToXML(fileName); SaveToXML(fileName);
end; 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 begin
if KeyExists(KeyName) then if KeyExists(KeyName) then
Exit(GetSetDefaultKeyValue(KeyName, defVal)) Exit(GetKeyValueDef(KeyName, defVal))
else else
Exit(GetSetLoadSaveDefaultKeyValue(KeyName, defVal, fileName)); Exit(GetKeyValueDefLoadFirst(KeyName, defVal, fileName));
end; end;
{ {
@ -449,7 +466,7 @@ end;
and CreatePath = True, then b,c,d and e are all created. 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 var
N, newN, nParent: TTreeNode; N, newN, nParent: TTreeNode;
Path: TStringArray; Path: TStringArray;
@ -524,15 +541,18 @@ end;
Set the value of a key. Set the value of a key.
} }
procedure TMMLSettings.SetKeyValue(KeyName: String; KeyValue: String); function TMMLSettings.SetKeyValue(KeyName: String; KeyValue: String; CreatePath: boolean) : boolean;
var var
N, NN: TTreeNode; N, NN: TTreeNode;
begin begin
if not KeyExists(KeyName) then result := false;
if not KeyExists(KeyName) and not CreatePath then
begin begin
mDebugLn('SetKeyValue - Key does not exist'); mDebugLn('SetKeyValue - Key does not exist');
Exit; Exit;
end; end else
if not KeyExists(keyname) then
CreateKey(keyname);
if not IsKey(KeyName) then if not IsKey(KeyName) then
begin begin
mDebugLn('SetKeyValue - IsKey returned false'); mDebugLn('SetKeyValue - IsKey returned false');
@ -558,6 +578,7 @@ begin
mDebugLn('Setting ' + KeyName + ' to ' + KeyValue); mDebugLn('Setting ' + KeyName + ' to ' + KeyValue);
N := N.GetNextSibling; N := N.GetNextSibling;
end; end;
result := true;
end; end;

View File

@ -30,26 +30,28 @@ uses
Classes, SysUtils, settings, strutils, mufasatypes; Classes, SysUtils, settings, strutils, mufasatypes;
type type
{ TMMLSettingsSandbox }
TMMLSettingsSandbox = class(TObject) TMMLSettingsSandbox = class(TObject)
private
ST: TMMLSettings;
FPrefix: String;
function GetPrefix: String;
procedure SetPrefix(s: String);
public public
constructor Create(sett: TMMLSettings); constructor Create(sett: TMMLSettings);
destructor Destroy; override; destructor Destroy; override;
function IsKey(KeyName: String): Boolean; function IsKey(KeyName: String): Boolean;
function IsDirectory(KeyName: String): Boolean; function IsDirectory(KeyName: String): Boolean;
function SetKeyValue(Keyname : string; Value : string) : boolean;
function GetKeyValue(KeyName: String): String; function GetKeyValue(KeyName: String): String;
function GetSetDefaultKeyValue(KeyName, defVal: String): String; function GetKeyValueDef(KeyName, defVal: String): String;
function ListKeys(KeyName: String): TStringArray; function ListKeys(KeyName: String; out Keys : TStringArray): boolean;
function DeleteKey(KeyName: String): Boolean; function DeleteKey(KeyName: String): Boolean;
function DeleteSubKeys(KeyName: String): Boolean; function DeleteSubKeys(KeyName: String): Boolean;
public property prefix : string read GetPrefix write SetPrefix;
function GetPrefix: String;
procedure SetPrefix(s: String);
private
ST: TMMLSettings;
Prefix: String;
end; end;
implementation implementation
@ -70,17 +72,17 @@ end;
function TMMLSettingsSandbox.GetPrefix: String; function TMMLSettingsSandbox.GetPrefix: String;
begin begin
result := Prefix; result := FPrefix;
end; end;
procedure TMMLSettingsSandbox.SetPrefix(s: String); procedure TMMLSettingsSandbox.SetPrefix(s: String);
begin begin
Prefix := s; FPrefix := s;
end; end;
function TMMLSettingsSandbox.ListKeys(KeyName: String): TStringArray; function TMMLSettingsSandbox.ListKeys(KeyName: String; out Keys :TStringArray): boolean;
begin begin
exit(ST.ListKeys(Prefix + KeyName)) exit(ST.ListKeys(Prefix + KeyName,keys))
end; end;
function TMMLSettingsSandbox.GetKeyValue(KeyName: String): String; function TMMLSettingsSandbox.GetKeyValue(KeyName: String): String;
@ -88,9 +90,9 @@ begin
exit(ST.GetKeyValue(Prefix + KeyName)) exit(ST.GetKeyValue(Prefix + KeyName))
end; end;
function TMMLSettingsSandbox.GetSetDefaultKeyValue(KeyName, defVal: String): String; function TMMLSettingsSandbox.GetKeyValueDef(KeyName, defVal: String): String;
begin begin
exit(ST.GetSetDefaultKeyValue(Prefix + KeyName, defVal)) exit(ST.GetKeyValueDef(Prefix + KeyName, defVal))
end; end;
function TMMLSettingsSandbox.IsKey(KeyName: String): Boolean; function TMMLSettingsSandbox.IsKey(KeyName: String): Boolean;
@ -103,6 +105,14 @@ begin
exit(ST.IsDirectory(Prefix + KeyName)) exit(ST.IsDirectory(Prefix + KeyName))
end; 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; function TMMLSettingsSandbox.DeleteKey(KeyName: String): Boolean;
begin begin
exit(ST.DeleteKey(Prefix + KeyName)); exit(ST.DeleteKey(Prefix + KeyName));

View File

@ -6,11 +6,12 @@ interface
uses uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, SynEdit, SynEditKeyCmds, StdCtrls, ExtCtrls, SynEdit, SynEditKeyCmds, v_ideCodeParser, v_ideCodeInsight,
{$IFDEF FPC} {$IFDEF FPC}
LMessages, LMessages,
lcltype lcltype,
mPasLex
{$ELSE} {$ELSE}
Windows, Windows,
Messages Messages
@ -81,16 +82,34 @@ type
property InsertProc: TInsertProc read getInsertProc write setInsertProc; property InsertProc: TInsertProc read getInsertProc write setInsertProc;
end; end;
{ TParamHint }
TParamHint = class(THintWindow) 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 public
constructor Create(TheOwner: TComponent); override; constructor Create(TheOwner: TComponent); override;
procedure CalculateBounds;
procedure UpdateHint;
procedure Paint; override; procedure Paint; override;
procedure Show(StartPoint,BracketPoint : TPoint;Decl : TciProcedureDeclaration; Editor : TSynedit; mp : TCodeInsight); reintroduce;
end; end;
implementation implementation
uses uses
StrUtils {$IFDEF FPC}, lclintf{$ENDIF}, Themes; StrUtils {$IFDEF FPC}, lclintf{$ENDIF},math, Themes;
procedure TAutoCompleteListBox.setItemList(List: TStrings); procedure TAutoCompleteListBox.setItemList(List: TStrings);
begin begin
@ -552,61 +571,394 @@ begin
Editor.SetFocus; Editor.SetFocus;
end; 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;
CursorXY : TPoint;
begin
result := -1;
MustHide := True;
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
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); constructor TParamHint.Create(TheOwner: TComponent);
begin begin
inherited; inherited;
{$IFDEF FPC} {$IFDEF FPC}
AutoHide := False; AutoHide := False;
{$ENDIF} {$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)<FBracketPoint.X) or (not (Line[FBracketPoint.X] in ['(','['])) then
exit;
if PrepareParamString(Line,MustHide) = LastParameterIndex then
exit
else if not MustHide then
Self.Invalidate;
finally
if MustHide then
Self.hide;
end;
end;
procedure TParamHint.ParamHintHide(Sender: TObject);
begin
if FMP <> 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.X<AHintRect.Right) then //Fill the rest of the area with blank info,
//since we are going to draw this text on the next line
Canvas.FillRect(Rect(TokenPos.X,TokenPos.Y-VerticalSpace,
AHintRect.Right,TokenPos.Y+LineHeight+VerticalSpace));
TokenPos:=Point(ATextRect.Left,TokenPos.y+LineHeight+VerticalSpace);//Lets start on the left side, one row below ;)
LineHeight:=0;
end;
OffsetRect(TokenRect,TokenPos.x,TokenPos.y); //Move the tokenrectangle to the tokenposition
if Draw then
begin
Canvas.FillRect(Rect(TokenRect.Left,TokenRect.Top-VerticalSpace,
TokenRect.Right,TokenRect.Bottom+VerticalSpace));//Fill the entire rect (means including the spaces above and below
DrawText(Canvas.Handle,@Line[StartPos],Pos-StartPos + 1,
TokenRect,DT_SINGLELINE+DT_NOCLIP); //Draw the text!
end;
if LineHeight<TokenSize.y then
LineHeight:=TokenSize.y; //the line has a bigger height than before.. The text H is bigger.
inc(TokenPos.X,TokenSize.x); //Move the tokenposition text-width to the right
if UsedWidth<TokenPos.X then //Calculate the max-width we've used!
UsedWidth:=TokenPos.X;
end;
if Draw and (TokenPos.X<AHintRect.Right) and (LineHeight>0) 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<MaxHeight then
Canvas.FillRect(Rect(0,CurHintRect.Bottom,MaxWidth,MaxHeight));
// draw frame around window
Canvas.Frame(Rect(0,0,MaxWidth-1,MaxHeight-1));
end;
if not Draw then //Adjust the maxwidth/maxheight needed to draw this thingy!
begin
if CurHintRect.right<MaxWidth then
MaxWidth:=CurHintRect.right;
if CurHintRect.Bottom<MaxHeight then
MaxHeight:=CurHintRect.Bottom;
end;
end; end;
procedure TParamHint.Paint; procedure TParamHint.Paint;
function GetDrawTextFlags: Cardinal;
var var
EffectiveAlignment: TAlignment; MaxWidth,MaxHeight : integer;
begin begin
Result := DT_NOPREFIX or DT_VCENTER or DT_WORDBREAK; MaxWidth:= ClientWidth;
EffectiveAlignment := Alignment; MaxHeight := ClientHeight;
if BiDiMode <> bdLeftToRight then DrawHints(MaxWidth,MaxHeight,True);
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;
end; end;
var procedure TParamHint.Show(StartPoint,BracketPoint: TPoint;Decl : TciProcedureDeclaration; Editor: TSynedit; mp : TCodeInsight);
ARect: TRect;
Details: TThemedElementDetails;
begin begin
ARect := ClientRect; if self.Visible then
if Color = clInfoBk then // draw using themes self.hide;
begin FDecl := Decl;
Details := ThemeServices.GetElementDetails(tttStandardLink); Fmp := mp;
ThemeServices.DrawElement(Canvas.Handle, Details, ARect); FParameters:= Decl.GetParamDeclarations;
end if Length(FParameters) = 0 then //Method has no Parameters
else exit;
begin FSynEdit := Editor;
Canvas.Brush.Color := Color; FStartPoint:= StartPoint;
Canvas.Pen.Width := 1; FBracketPoint:= BracketPoint;
Canvas.FillRect(ARect); CalculateBounds; //Calculate the size we need!
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDOUTER, BF_RECT); self.Visible := true;
end; end;
InflateRect(ARect, - 4, - 4);
Canvas.TextOut(ARect.Left, ARect.Top, Caption);
procedure TParamHint.ApplicationIdle(Sender: TObject; var Done: Boolean);
begin
if not Visible then exit;
UpdateHint;
end; end;
end. end.

View File

@ -16,6 +16,8 @@ type
TOnFindInclude = function(Sender: TObject; var FileName: string): Boolean of object; TOnFindInclude = function(Sender: TObject; var FileName: string): Boolean of object;
{ TCodeInsight }
TCodeInsight = class(TCodeParser) TCodeInsight = class(TCodeParser)
protected protected
fFileName: string; fFileName: string;
@ -49,6 +51,7 @@ type
function GetFuncType(FuncName, FuncClass: string; out Decl: TDeclaration; Return: TVarBase): Boolean; function GetFuncType(FuncName, FuncClass: string; out Decl: TDeclaration; Return: TVarBase): Boolean;
function FindStruct(s: string; out Decl: TDeclaration; Return: TVarBase; var ArrayCount: Integer): Boolean; function FindStruct(s: string; out Decl: TDeclaration; Return: TVarBase; var ArrayCount: Integer): Boolean;
public 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(var BraceCount, BracketCount, CommaCount: Integer; IgnoreBrackets: Boolean = False): string; overload;
function GetExpressionAtPos: string; overload; function GetExpressionAtPos: string; overload;
function FindVarBase(s: string; GetStruct: Boolean = False; Return: TVarBase = vbName): TDeclaration; function FindVarBase(s: string; GetStruct: Boolean = False; Return: TVarBase = vbName): TDeclaration;
@ -545,7 +548,7 @@ begin
end; end;
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 var
i, StartPos, EndPos: Integer; i, StartPos, EndPos: Integer;
s: string; s: string;
@ -636,10 +639,17 @@ begin
LastWasDot := False; LastWasDot := False;
Dec(StartPos); Dec(StartPos);
end; end;
sp := startpos + d.StartPos;
Result := CompressWhiteSpace(Copy(s, StartPos + 1, EndPos - StartPos)); Result := CompressWhiteSpace(Copy(s, StartPos + 1, EndPos - StartPos));
end; 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; function TCodeInsight.GetExpressionAtPos: string;
var var
bcc, bkc, cc: Integer; bcc, bkc, cc: Integer;

View File

@ -864,17 +864,16 @@ begin
a := GetParamDeclarations; a := GetParamDeclarations;
for i := Low(a) to High(a) do for i := Low(a) to High(a) do
begin begin
if (fItems[i] is TciConstParameter) then if (a[i] is TciConstParameter) then
s := 'const ' s := 'const '
else if (fItems[i] is TciOutParameter) then else if (a[i] is TciOutParameter) then
s := 'out ' s := 'out '
else if (fItems[i] is TciInParameter) then else if (a[i] is TciInParameter) then
s := 'in ' s := 'in '
else if (fItems[i] is TciVarParameter) then else if (a[i] is TciVarParameter) then
s := 'var ' s := 'var '
else else
s := ''; s := '';
d := a[i].Items.GetFirstItemOfClass(TciParameterType); d := a[i].Items.GetFirstItemOfClass(TciParameterType);
if (d <> nil) then if (d <> nil) then
t := ': ' + d.ShortText t := ': ' + d.ShortText