1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-22 01:02:17 -05:00

Merge branch 'external-editor'

Conflicts:
	Projects/Simba/simbaunit.pas
This commit is contained in:
Merlijn Wajer 2011-02-23 12:26:48 +01:00
commit 4c1d67d1b6
3 changed files with 105 additions and 30 deletions

View File

@ -83,9 +83,13 @@ type
procedure undo; procedure undo;
procedure redo; procedure redo;
procedure HandleErrorData; procedure HandleErrorData;
function GetReadOnly: Boolean;
procedure SetReadOnly(ReadOnly: Boolean);
procedure MakeActiveScriptFrame; procedure MakeActiveScriptFrame;
procedure ScriptThreadTerminate(Sender: TObject); procedure ScriptThreadTerminate(Sender: TObject);
constructor Create(TheOwner: TComponent); override; constructor Create(TheOwner: TComponent); override;
procedure ReloadScript;
{ public declarations } { public declarations }
end; end;
@ -644,6 +648,37 @@ begin
AddKey(SynEdit,ecCodeHints,VK_SPACE,[ssCtrl,ssShift]); AddKey(SynEdit,ecCodeHints,VK_SPACE,[ssCtrl,ssShift]);
end; end;
function TScriptFrame.GetReadOnly: Boolean;
begin
Result := SynEdit.ReadOnly;
end;
procedure TScriptFrame.SetReadOnly(ReadOnly: Boolean);
begin
SynEdit.ReadOnly := ReadOnly;
SynEdit.Enabled := not ReadOnly;
if not ReadOnly and SynEdit.CanFocus then
SynEdit.SetFocus;
end;
procedure TScriptFrame.ReloadScript;
var
newScript: String;
ExternScript: TFileStream;
begin
try
ExternScript := TFileStream.Create(ScriptFile, fmOpenRead);
ExternScript.Read(NewScript, ExternScript.Size);
SynEdit.Lines.SetText(PChar(NewScript));
except
on EFOpenError do
begin
formWriteln('Could not open extern script :' + ScriptFile);
end;
end;
end;
initialization initialization
{$R *.lfm} {$R *.lfm}

View File

@ -5,7 +5,7 @@ object SimbaForm: TSimbaForm
Width = 660 Width = 660
AllowDropFiles = True AllowDropFiles = True
Caption = 'THA FUKING Simba' Caption = 'THA FUKING Simba'
ClientHeight = 603 ClientHeight = 598
ClientWidth = 660 ClientWidth = 660
KeyPreview = True KeyPreview = True
Menu = MainMenu Menu = MainMenu
@ -207,8 +207,8 @@ object SimbaForm: TSimbaForm
end end
object StatusBar: TStatusBar object StatusBar: TStatusBar
Left = 0 Left = 0
Height = 23 Height = 21
Top = 580 Top = 577
Width = 660 Width = 660
Panels = < Panels = <
item item
@ -230,7 +230,7 @@ object SimbaForm: TSimbaForm
object PanelMemo: TPanel object PanelMemo: TPanel
Left = 0 Left = 0
Height = 154 Height = 154
Top = 426 Top = 423
Width = 660 Width = 660
Align = alBottom Align = alBottom
ClientHeight = 154 ClientHeight = 154
@ -253,19 +253,19 @@ object SimbaForm: TSimbaForm
Cursor = crVSplit Cursor = crVSplit
Left = 0 Left = 0
Height = 5 Height = 5
Top = 421 Top = 418
Width = 660 Width = 660
Align = alBottom Align = alBottom
ResizeAnchor = akBottom ResizeAnchor = akBottom
end end
object ScriptPanel: TPanel object ScriptPanel: TPanel
Left = 0 Left = 0
Height = 397 Height = 394
Top = 24 Top = 24
Width = 660 Width = 660
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 397 ClientHeight = 394
ClientWidth = 660 ClientWidth = 660
DockSite = True DockSite = True
TabOrder = 4 TabOrder = 4
@ -273,7 +273,7 @@ object SimbaForm: TSimbaForm
OnDockOver = ScriptPanelDockOver OnDockOver = ScriptPanelDockOver
object PageControl1: TPageControl object PageControl1: TPageControl
Left = 155 Left = 155
Height = 362 Height = 359
Top = 0 Top = 0
Width = 505 Width = 505
Align = alClient Align = alClient
@ -292,7 +292,7 @@ object SimbaForm: TSimbaForm
object SearchPanel: TPanel object SearchPanel: TPanel
Left = 0 Left = 0
Height = 35 Height = 35
Top = 362 Top = 359
Width = 660 Width = 660
Align = alBottom Align = alBottom
BevelOuter = bvSpace BevelOuter = bvSpace
@ -387,7 +387,7 @@ object SimbaForm: TSimbaForm
end end
object LabeledEditSearch: TLabeledEdit object LabeledEditSearch: TLabeledEdit
Left = 104 Left = 104
Height = 21 Height = 27
Top = 6 Top = 6
Width = 80 Width = 80
EditLabel.AnchorSideLeft.Control = LabeledEditSearch EditLabel.AnchorSideLeft.Control = LabeledEditSearch
@ -395,10 +395,10 @@ object SimbaForm: TSimbaForm
EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideTop.Side = asrCenter
EditLabel.AnchorSideRight.Control = LabeledEditSearch EditLabel.AnchorSideRight.Control = LabeledEditSearch
EditLabel.AnchorSideBottom.Control = LabeledEditSearch EditLabel.AnchorSideBottom.Control = LabeledEditSearch
EditLabel.Left = 73 EditLabel.Left = 67
EditLabel.Height = 14 EditLabel.Height = 18
EditLabel.Top = 9 EditLabel.Top = 10
EditLabel.Width = 28 EditLabel.Width = 34
EditLabel.Caption = 'Find: ' EditLabel.Caption = 'Find: '
EditLabel.ParentColor = False EditLabel.ParentColor = False
LabelPosition = lpLeft LabelPosition = lpLeft
@ -411,9 +411,9 @@ object SimbaForm: TSimbaForm
end end
object CheckBoxMatchCase: TCheckBox object CheckBoxMatchCase: TCheckBox
Left = 320 Left = 320
Height = 17 Height = 22
Top = 7 Top = 7
Width = 72 Width = 97
Caption = 'Match case' Caption = 'Match case'
OnClick = CheckBoxMatchCaseClick OnClick = CheckBoxMatchCaseClick
TabOrder = 1 TabOrder = 1
@ -421,34 +421,38 @@ object SimbaForm: TSimbaForm
end end
object SplitterFunctionList: TSplitter object SplitterFunctionList: TSplitter
Left = 150 Left = 150
Height = 362 Height = 359
Top = 0 Top = 0
Width = 5 Width = 5
OnCanResize = SplitterFunctionListCanResize OnCanResize = SplitterFunctionListCanResize
Visible = False Visible = False
end end
inline frmFunctionList: TFunctionListFrame inline frmFunctionList: TFunctionListFrame
Height = 362 Height = 359
Width = 150 Width = 150
ClientHeight = 362 ClientHeight = 359
ClientWidth = 150 ClientWidth = 150
OnEndDock = nil OnEndDock = nil
TabOrder = 3 TabOrder = 3
inherited FunctionList: TTreeView inherited FunctionList: TTreeView
Height = 323 Height = 310
Top = 22
Width = 150 Width = 150
DefaultItemHeight = 19
OnChange = FunctionListChange OnChange = FunctionListChange
OnEnter = FunctionListEnter OnEnter = FunctionListEnter
OnExit = FunctionListExit OnExit = FunctionListExit
end end
inherited editSearchList: TEdit inherited editSearchList: TEdit
Top = 341 Height = 27
Top = 332
Width = 150 Width = 150
OnExit = editSearchListExit OnExit = editSearchListExit
OnKeyDown = editSearchListKeyDown OnKeyDown = editSearchListKeyDown
OnKeyPress = editSearchListKeyPress OnKeyPress = editSearchListKeyPress
end end
inherited FunctionListLabel: TLabel inherited FunctionListLabel: TLabel
Height = 18
Width = 146 Width = 146
end end
end end
@ -2839,6 +2843,10 @@ object SimbaForm: TSimbaForm
Caption = 'Close Other Tabs' Caption = 'Close Other Tabs'
OnClick = MenuItemTabCloseOthersClick OnClick = MenuItemTabCloseOthersClick
end end
object MenuItemReadOnlyTab: TMenuItem
Caption = 'Read Only'
OnClick = MenuItemReadOnlyTabClick
end
end end
object ActionList: TActionList object ActionList: TActionList
Images = Mufasa_Image_List Images = Mufasa_Image_List

View File

@ -30,7 +30,7 @@ unit SimbaUnit;
interface interface
uses uses
{$ifdef linux}cthreads,{$endif}Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, {$ifdef linux}cthreads,cmem,{$endif}Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Menus, ComCtrls, ExtCtrls, SynEdit, SynHighlighterPas, StdCtrls, Menus, ComCtrls, ExtCtrls, SynEdit, SynHighlighterPas,
//Client, //Client,
MufasaTypes, MufasaTypes,
@ -116,6 +116,7 @@ type
MenuHelp: TMenuItem; MenuHelp: TMenuItem;
MenuDivider7: TMenuItem; MenuDivider7: TMenuItem;
MenuInterpreters: TMenuItem; MenuInterpreters: TMenuItem;
MenuItemReadOnlyTab: TMenuItem;
MenuItemGoto: TMenuItem; MenuItemGoto: TMenuItem;
MenuItemDivider50: TMenuItem; MenuItemDivider50: TMenuItem;
MenuItemPascalScript: TMenuItem; MenuItemPascalScript: TMenuItem;
@ -288,6 +289,7 @@ type
procedure FunctionListEnter(Sender: TObject); procedure FunctionListEnter(Sender: TObject);
procedure FunctionListExit(Sender: TObject); procedure FunctionListExit(Sender: TObject);
procedure FunctionListTimerTimer(Sender: TObject); procedure FunctionListTimerTimer(Sender: TObject);
procedure MenuItemReadOnlyTabClick(Sender: TObject);
procedure MenuItemBitmapConvClick(Sender: TObject); procedure MenuItemBitmapConvClick(Sender: TObject);
procedure MenuItemHandbookClick(Sender: TObject); procedure MenuItemHandbookClick(Sender: TObject);
procedure MenuItemColourHistoryClick(Sender: TObject); procedure MenuItemColourHistoryClick(Sender: TObject);
@ -408,7 +410,7 @@ type
procedure SetScriptState(const State: TScriptState); procedure SetScriptState(const State: TScriptState);
function CreateSetting(const Key, Value : string) : string; function CreateSetting(const Key, Value : string) : string;
procedure SetSetting(const key,Value : string; save : boolean = false); procedure SetSetting(const key,Value : string; save : boolean = false);
function SettingExtists(const key : string) : boolean; function SettingExists(const key : string) : boolean;
procedure FontUpdate; procedure FontUpdate;
public public
DebugStream: String; DebugStream: String;
@ -1191,7 +1193,8 @@ begin
if Self.Showing then if Self.Showing then
if Tab.TabSheet.TabIndex = Self.PageControl1.TabIndex then if Tab.TabSheet.TabIndex = Self.PageControl1.TabIndex then
if CurrScript.SynEdit.CanFocus then if CurrScript.SynEdit.CanFocus then
CurrScript.SynEdit.SetFocus; CurrScript.SynEdit.SetFocus; // XXX: This is never called
StopCodeCompletion;//To set the highlighting back to normal; StopCodeCompletion;//To set the highlighting back to normal;
frmFunctionList.LoadScriptTree(CurrScript.SynEdit.Text); frmFunctionList.LoadScriptTree(CurrScript.SynEdit.Text);
with CurrScript.SynEdit do with CurrScript.SynEdit do
@ -1204,6 +1207,7 @@ begin
LabeledEditSearch.SelLength:= 0; LabeledEditSearch.SelLength:= 0;
LabeledEditSearch.Color:= clWindow; LabeledEditSearch.Color:= clWindow;
LabeledEditSearch.Font.Color:= clWindowText; LabeledEditSearch.Font.Color:= clWindowText;
//Set tha edit buttons right //Set tha edit buttons right
SetEditActions; SetEditActions;
end; end;
@ -1294,7 +1298,7 @@ begin
else else
// if str = 'normal' then // if str = 'normal' then
Self.WindowState := wsNormal; Self.WindowState := wsNormal;
if SettingExtists('LastConfig/MainForm/RecentFiles/Count') then if SettingExists('LastConfig/MainForm/RecentFiles/Count') then
begin; begin;
ii := StrToIntDef(LoadSettingDef('LastConfig/MainForm/RecentFiles/Count','-1'),-1); ii := StrToIntDef(LoadSettingDef('LastConfig/MainForm/RecentFiles/Count','-1'),-1);
for i := 0 to ii do for i := 0 to ii do
@ -1385,7 +1389,7 @@ var
if (number < 0) or (number >= extCount) then if (number < 0) or (number >= extCount) then
exit; exit;
path := 'Extensions/Extension' + inttostr(number); path := 'Extensions/Extension' + inttostr(number);
if SettingExtists(Path) = false then if SettingExists(Path) = false then
exit; exit;
ExtPath := LoadSettingDef(Path + '/Path',''); ExtPath := LoadSettingDef(Path + '/Path','');
if ExtPath = '' then if ExtPath = '' then
@ -1454,8 +1458,16 @@ var
Se: TMMLSettingsSandbox; Se: TMMLSettingsSandbox;
loadFontsOnScriptStart: boolean; loadFontsOnScriptStart: boolean;
Continue : boolean; Continue : boolean;
begin begin
if (CurrScript.ScriptFile <> '') and CurrScript.GetReadOnly() then
begin
formWriteln('Reloading read only script');
CurrScript.ReloadScript;
end;
Script := CurrScript.SynEdit.Lines.Text; Script := CurrScript.SynEdit.Lines.Text;
if Assigned(OnScriptStart) then if Assigned(OnScriptStart) then
begin begin
Continue := True; Continue := True;
@ -1480,6 +1492,7 @@ begin
Thread.SetDebug(@formWriteln); Thread.SetDebug(@formWriteln);
{$ENDIF} {$ENDIF}
Thread.SetScript(Script); Thread.SetScript(Script);
Thread.ErrorData:= @CurrScript.ErrorData; Thread.ErrorData:= @CurrScript.ErrorData;
Thread.OnError:= @CurrScript.HandleErrorData; Thread.OnError:= @CurrScript.HandleErrorData;
FormCallBackData.FormCallBack:= @self.FormCallBack; FormCallBackData.FormCallBack:= @self.FormCallBack;
@ -2081,7 +2094,7 @@ end;
procedure TSimbaForm.MenuItemHandbookClick(Sender: TObject); procedure TSimbaForm.MenuItemHandbookClick(Sender: TObject);
begin begin
OpenURL('http://wizzup.org/simbadoc/'); OpenURL('http://docs.wizzup.org/simba/');
end; end;
procedure TSimbaForm.MenuItemColourHistoryClick(Sender: TObject); procedure TSimbaForm.MenuItemColourHistoryClick(Sender: TObject);
@ -2571,6 +2584,17 @@ begin
CloseTabs(PopupTab); CloseTabs(PopupTab);
end; end;
procedure TSimbaForm.MenuItemReadOnlyTabClick(Sender: TObject);
var
Tab: TMufasaTab;
begin
Tab := TMufasaTab(Tabs[PopupTab]);
Tab.ScriptFrame.SetReadOnly(not Tab.ScriptFrame.GetReadOnly());
MenuItemReadOnlyTab.Checked := not Tab.ScriptFrame.GetReadOnly();
end;
procedure TSimbaForm.MenuItemFunctionListClick(Sender: TObject); procedure TSimbaForm.MenuItemFunctionListClick(Sender: TObject);
begin begin
FunctionListShown(not MenuItemFunctionList.Checked); FunctionListShown(not MenuItemFunctionList.Checked);
@ -2684,6 +2708,9 @@ begin
begin begin
mDebugLn('We couldn''t find which tab you clicked on, closing the popup'); mDebugLn('We couldn''t find which tab you clicked on, closing the popup');
Handled := true; Handled := true;
end else
begin
MenuItemReadOnlyTab.Checked := TMufasaTab(Tabs[PopupTab]).ScriptFrame.GetReadOnly();
end; end;
end; end;
@ -2874,7 +2901,7 @@ begin
SettingsForm.Settings.SaveToXML(SimbaSettingsFile); SettingsForm.Settings.SaveToXML(SimbaSettingsFile);
end; end;
function TSimbaForm.SettingExtists(const key: string): boolean; function TSimbaForm.SettingExists(const key: string): boolean;
begin begin
result :=SettingsForm.Settings.KeyExists(key); result :=SettingsForm.Settings.KeyExists(key);
end; end;
@ -3065,7 +3092,7 @@ end;
procedure TSimbaForm.UpdateTitle; procedure TSimbaForm.UpdateTitle;
begin begin
Application.Title:= PChar('Simba'); Application.Title:= PChar('Simba'); // XXX - Sure you want to do this for Disguise?
if CurrScript.ScriptChanged then if CurrScript.ScriptChanged then
begin; begin;
CurrTab.TabSheet.Caption:= CurrScript.ScriptName + '*'; CurrTab.TabSheet.Caption:= CurrScript.ScriptName + '*';
@ -3165,6 +3192,11 @@ end;
function TSimbaForm.SaveCurrentScript: boolean; function TSimbaForm.SaveCurrentScript: boolean;
begin begin
if CurrScript.GetReadOnly() then
begin
formWriteln('Script is in read-only/external editor mode. Not saving!');
exit(false);
end;
if not CurrScript.ScriptChanged then if not CurrScript.ScriptChanged then
begin begin
writeln('SaveScript - no changes.'); writeln('SaveScript - no changes.');