{ This file is part of the Mufasa Macro Library (MML) Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer MML is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. MML is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with MML. If not, see . See the file COPYING, included in this distribution, for details about the copyright. TestUnit/GUI for the Mufasa Macro Library } unit TestUnit; {$undef EditButtons} {$Undef ProcessMessages} //Define this for processmessages in ThreadSafeCall {$mode objfpc}{$H+} interface uses {$ifdef linux}cthreads,{$endif}Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Menus, ComCtrls, ExtCtrls, SynEdit, SynHighlighterPas, //Client, MufasaTypes, mmlpsthread,synedittypes, {$IFDEF MSWINDOWS} os_windows, windows,{$ENDIF} //For ColorPicker etc. {$IFDEF LINUX} os_linux, {$ENDIF} //For ColorPicker etc. colourpicker, framescript, windowselector, lcltype, ActnList, SynExportHTML, SynEditKeyCmds, SynEditHighlighter, SynEditMarkupHighAll, LMessages, Buttons,mmisc, stringutil,mufasatypesutil,mufasabase, v_ideCodeParser, about, framefunctionlist, ocr, updateform, simbasettings, psextension, virtualextension, extensionmanager, settingssandbox, v_ideCodeInsight, CastaliaPasLexTypes, CastaliaSimplePasPar, v_AutoCompleteForm, PSDump; const SimbaVersion = 620; type { TMufasaTab } TMufasaTab = class(Tobject) private PageCtrl : TPageControl; public TabSheet : TTabsheet; ScriptFrame : TScriptFrame; procedure Clear;//This will 'reset' the ScriptFrame constructor Create(Page : TPageControl); destructor Destroy; override; end; // Tab { TForm1 } TForm1 = class(TForm) ActionConsole: TAction; ActionNormalSize: TAction; ActionCompileScript: TAction; ActionExit: TAction; ActionReplace: TAction; ActionFindNext: TAction; ActionRedo: TAction; ActionUndo: TAction; ActionSelectAll: TAction; ActionDelete: TAction; ActionPaste: TAction; ActionCopy: TAction; ActionCut: TAction; ActionFindStart: TAction; ActionClearDebug: TAction; ActionSaveAll: TAction; ActionStopScript: TAction; ActionSaveScript: TAction; ActionSaveScriptAs: TAction; ActionRunScript: TAction; ActionPauseScript: TAction; ActionNewScript: TAction; ActionOpenScript: TAction; ActionNewTab: TAction; ActionCloseTab: TAction; ActionTabLast: TAction; ActionTabNext: TAction; ActionList: TActionList; CheckBoxMatchCase: TCheckBox; LazHighlighter: TSynFreePascalSyn; frmFunctionList: TFunctionListFrame; LabeledEditSearch: TLabeledEdit; MainMenu: TMainMenu; Memo1: TMemo; MenuFile: TMenuItem; MenuEdit: TMenuItem; MenuHelp: TMenuItem; MenuItemExtensions: TMenuItem; MenuItemSettingsButton: TMenuItem; MenuItemDivider10: TMenuItem; MenuTools: TMenuItem; MenuItemOpenRecent: TMenuItem; MenuItemCompile: TMenuItem; MenuItemHandbook: TMenuItem; MenuItemAbout: TMenuItem; MenuItemReportBug: TMenuItem; MenuItemExportHTML: TMenuItem; MenuItemDivider9: TMenuItem; MouseTimer: TTimer; NewsTimer: TTimer; SCARHighlighter: TSynFreePascalSyn; FunctionListTimer: TTimer; TT_Console: TToolButton; TT_Cut: TToolButton; TT_Copy: TToolButton; TT_Paste: TToolButton; ToolButton9: TToolButton; UpdateTimer: TTimer; ToolButton3: TToolButton; TT_Update: TToolButton; UpdateMenuButton: TMenuItem; MenuitemFillFunctionList: TMenuItem; MenuItemFunctionList: TMenuItem; MenuItemHide: TMenuItem; MenuItemDebugImage: TMenuItem; MenuItemMainExit: TMenuItem; MenuItemDivider6: TMenuItem; PopupItemReplace: TMenuItem; MenuItemReplace: TMenuItem; dlgReplace: TReplaceDialog; MenuItemColourHistory: TMenuItem; MenuView: TMenuItem; MenuItemFindNext: TMenuItem; PopupItemDelete: TMenuItem; MenuItemDelete: TMenuItem; MenuItemDivider5: TMenuItem; MenuItemSelectAll: TMenuItem; PopupItemSelectAll: TMenuItem; PopupItemDivider2: TMenuItem; PopupItemPaste: TMenuItem; PopupItemCopy: TMenuItem; PopupItemCut: TMenuItem; PopupItemDivider1: TMenuItem; PopupItemRedo: TMenuItem; PopupItemUndo: TMenuItem; PopupItemDivider3: TMenuItem; PopupItemFind: TMenuItem; MenuItemFind: TMenuItem; MenuItemDivider4: TMenuItem; MenuItemDivider3: TMenuItem; MenuItemCopy: TMenuItem; MenuItemSaveAll: TMenuItem; MenuItemTabCloseOthers: TMenuItem; MenuItemTabAdd: TMenuItem; MenuItemTabClose: TMenuItem; MenuItemCloseTabs: TMenuItem; MenuItemCloseTab: TMenuItem; MenuItemNewTab: TMenuItem; MenuItemDivider2: TMenuItem; MenuItemDivider: TMenuItem; PageControl1: TPageControl; ScriptPopup: TPopupMenu; SearchPanel: TPanel; ScriptPanel: TPanel; SpeedButtonSearch: TSpeedButton; SplitterFunctionList: TSplitter; TabPopup: TPopupMenu; TB_SaveAll: TToolButton; DebugTimer: TTimer; TrayDivider: TMenuItem; TrayPlay: TMenuItem; TrayStop: TMenuItem; TrayPause: TMenuItem; MenuItemPause: TMenuItem; MenuItemStop: TMenuItem; MenuItemShow: TMenuItem; MenuItemExit: TMenuItem; MenuItemCut: TMenuItem; MenuItemPaste: TMenuItem; MenuItemNew: TMenuItem; MenuItemSaveAs: TMenuItem; MenuItemOpen: TMenuItem; MenuItemRedo: TMenuItem; MenuItemUndo: TMenuItem; MenuItemSave: TMenuItem; Mufasa_Image_List: TImageList; MenuItemScript: TMenuItem; MenuItemRun: TMenuItem; PanelMemo: TPanel; SplitterMemoSynedit: TSplitter; TrayPopup: TPopupMenu; StatusBar: TStatusBar; ToolBar1: TToolBar; TB_Run: TToolButton; TB_Pause: TToolButton; TB_Stop: TToolButton; ToolButton1: TToolButton; TB_ReloadPlugins: TToolButton; TB_Tray: TToolButton; TB_NewTab: TToolButton; TB_CloseTab: TToolButton; TB_New: TToolButton; ToolButton2: TToolButton; TB_Open: TToolButton; TB_Save: TToolButton; ToolButton4: TToolButton; TB_ClearDebug: TToolButton; TB_PickColour: TToolButton; TB_SelectClient: TToolButton; ToolButton8: TToolButton; MTrayIcon: TTrayIcon; procedure ActionClearDebugExecute(Sender: TObject); procedure ActionCloseTabExecute(Sender: TObject); procedure ActionCompileScriptExecute(Sender: TObject); procedure ActionConsoleExecute(Sender: TObject); procedure ActionCopyExecute(Sender: TObject); procedure ActionCutExecute(Sender: TObject); procedure ActionDeleteExecute(Sender: TObject); procedure ActionExitExecute(Sender: TObject); procedure ActionFindNextExecute(Sender: TObject); procedure ActionFindstartExecute(Sender: TObject); procedure ActionNewExecute(Sender: TObject); procedure ActionNewTabExecute(Sender: TObject); procedure ActionNormalSizeExecute(Sender: TObject); procedure ActionOpenExecute(Sender: TObject); procedure ActionPasteExecute(Sender: TObject); procedure ActionPauseExecute(Sender: TObject); procedure ActionRedoExecute(Sender: TObject); procedure ActionReplaceExecute(Sender: TObject); procedure ActionRunExecute(Sender: TObject); procedure ActionSaveAllExecute(Sender: TObject); procedure ActionSaveAsExecute(Sender: TObject); procedure ActionSaveExecute(Sender: TObject); procedure ActionSelectAllExecute(Sender: TObject); procedure ActionStopExecute(Sender: TObject); procedure ActionTabLastExecute(Sender: TObject); procedure ActionTabNextExecute(Sender: TObject); procedure ActionUndoExecute(Sender: TObject); procedure ChangeMouseStatus(Sender: TObject); procedure CheckBoxMatchCaseClick(Sender: TObject); procedure CloseFindPanel; procedure editSearchListExit(Sender: TObject); procedure editSearchListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure editSearchListKeyPress(Sender: TObject; var Key: char); procedure FormDropFiles(Sender: TObject; const FileNames: array of String); procedure FunctionListChange(Sender: TObject; Node: TTreeNode); procedure FunctionListEnter(Sender: TObject); procedure FunctionListExit(Sender: TObject); procedure FunctionListTimerTimer(Sender: TObject); procedure MenuItemExtensionsClick(Sender: TObject); procedure MenuItemHandbookClick(Sender: TObject); procedure MenuItemColourHistoryClick(Sender: TObject); procedure dlgReplaceFind(Sender: TObject); procedure dlgReplaceReplace(Sender: TObject); procedure EditSearchChange(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormShortCuts(var Msg: TLMKey; var Handled: Boolean); procedure LabeledEditSearchEnter(Sender: TObject); procedure LabeledEditSearchExit(Sender: TObject); procedure LabeledEditSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure LabeledEditSearchKeyPress(Sender: TObject; var Key: char); procedure MenuEditClick(Sender: TObject); procedure MenuItemAboutClick(Sender: TObject); procedure MenuItemCloseTabsClick(Sender: TObject); procedure MenuItemDebugImageClick(Sender: TObject); procedure MenuItemExportHTMLClick(Sender: TObject); procedure MenuitemFillFunctionListClick(Sender: TObject); procedure MenuItemHideClick(Sender: TObject); procedure MenuItemReportBugClick(Sender: TObject); procedure MenuItemSettingsButtonClick(Sender: TObject); procedure MenuItemShowClick(Sender: TObject); procedure MenuItemTabCloseClick(Sender: TObject); procedure MenuItemTabCloseOthersClick(Sender: TObject); procedure MenuItemFunctionListClick(Sender: TObject); procedure NewsTimerTimer(Sender: TObject); procedure OnLinePSScript(Sender: TObject); procedure ButtonPickClick(Sender: TObject); procedure ButtonSelectorDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure NoTray(Sender: TObject); procedure PageControl1Change(Sender: TObject); procedure ButtonTrayClick(Sender: TObject); procedure PageControl1Changing(Sender: TObject; var AllowChange: Boolean); procedure PageControl1ContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); procedure PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer); procedure PageControl1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure PageControl1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure PageControl1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure PickerPick(Sender: TObject; const Colour, colourx, coloury: integer); procedure PopupItemFindClick(Sender: TObject); procedure ProcessDebugStream(Sender: TObject); procedure RecentFileItemsClick(Sender: TObject); procedure ScriptPanelDockDrop(Sender: TObject; Source: TDragDockObject; X, Y: Integer); procedure ScriptPanelDockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ScriptPopupPopup(Sender: TObject); procedure SpeedButtonSearchClick(Sender: TObject); procedure SplitterFunctionListCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); procedure TB_ReloadPluginsClick(Sender: TObject); procedure ThreadOpenConnectionEvent(Sender: TObject; var url: string; var Continue: boolean); procedure ThreadOpenFileEvent(Sender: TObject; var Filename: string; var Continue: boolean); procedure ThreadWriteFileEvent(Sender: TObject; var Filename: string; var Continue: boolean); procedure ScriptStartEvent(Sender: TObject; var Script : string; var Continue : boolean); procedure TrayPopupPopup(Sender: TObject); procedure TT_UpdateClick(Sender: TObject); procedure UpdateMenuButtonClick(Sender: TObject); procedure UpdateTimerCheck(Sender: TObject); procedure OnCCMessage(Sender: TObject; const Typ: TMessageEventType; const Msg: string; X, Y: Integer); procedure OnCompleteCode(Str: string); function OnCCFindInclude(Sender: TObject; var FileName: string): Boolean; private PopupTab : integer; RecentFileItems : array of TMenuItem; RecentFiles : TStringList; FirstRun : boolean;//Only show the warnings the first run (path not existing one's) SearchStart : TPoint; LastTab : integer; UpdatingFonts : boolean; OpenConnectionData : TOpenConnectionData; OpenFileData : TOpenFileData; WriteFileData : TWriteFileData; ScriptStartData : TScriptStartData; procedure HandleConnectionData; procedure HandleOpenFileData; procedure HandleWriteFileData; procedure HandleScriptStartData; function GetExtPath: string; function GetFontPath: String; function GetHighlighter: TSynCustomHighlighter; function GetIncludePath: String; function GetPluginPath: string; function GetScriptState: TScriptState; function GetShowHintAuto: boolean; function GetSimbaNews: String; procedure SetExtPath(const AValue: string); procedure SetFontPath(const AValue: String); procedure SetIncludePath(const AValue: String); procedure SetPluginPath(const AValue: string); procedure SetShowHintAuto(const AValue: boolean); procedure SetScriptState(const State: TScriptState); function LoadSettingDef(const Key, Def : string) : string; function CreateSetting(const Key, Value : string) : string; procedure SetSetting(const key,Value : string; save : boolean = false); function SettingExtists(const key : string) : boolean; procedure FontUpdate; public DebugStream: String; SearchString : string; CurrScript : TScriptFrame; //The current scriptframe CurrTab : TMufasaTab; //The current TMufasaTab CodeCompletionForm: TAutoCompletePopup; CodeCompletionStart: TPoint; ParamHint : TParamHint; Tabs : TList; Manager: TIOManager; OCR_Fonts: TMOCR; Picker: TMColorPicker; Selector: TMWindowSelector; OnScriptStart : TScriptStartEvent; {$ifdef mswindows} ConsoleVisible : boolean; procedure ShowConsole( ShowIt : boolean); {$endif} procedure FunctionListShown( ShowIt : boolean); property ScriptState : TScriptState read GetScriptState write SetScriptState; procedure SafeCallThread; function OpenScript : boolean; function LoadScriptFile(filename : string; AlwaysOpenInNewTab : boolean = false; CheckOtherTabs : boolean = true) : boolean; function SaveCurrentScript : boolean; function SaveCurrentScriptAs : boolean; function CanExitOrOpen : boolean; function ClearScript : boolean; procedure RunScript; procedure PauseScript; procedure StopScript; procedure AddTab; procedure StopCodeCompletion; function FindTab(filename : string) : integer; function DeleteTab( TabIndex : integer; CloseLast : boolean; Silent : boolean = false) : boolean; procedure ClearTab( TabIndex : integer); procedure CloseTabs(Exclude: integer = -1; Silent : boolean = false); //-1 for no exclusion procedure SetEditActions; procedure DoSearch(Next : boolean; HighlightAll : boolean); procedure RefreshTab;//Refreshes all the form items that depend on the Script (Panels, title etc.) procedure RefreshTabSender(sender : PtrInt); procedure CreateDefaultEnvironment; procedure LoadFormSettings; procedure SaveFormSettings; procedure LoadExtensions; procedure AddRecentFile(const filename : string); procedure InitalizeTMThread(var Thread : TMThread); procedure HandleParameters; procedure OnSaveScript(const Filename : string); property ShowHintAuto : boolean read GetShowHintAuto write SetShowHintAuto; property IncludePath : String read GetIncludePath write SetIncludePath; property FontPath : String read GetFontPath write SetFontPath; property PluginPath : string read GetPluginPath write SetPluginPath; property ExtPath : string read GetExtPath write SetExtPath; property CurrHighlighter : TSynCustomHighlighter read GetHighlighter; end; procedure ClearDebug; procedure formWriteln( S : String); procedure formWritelnEx( S : String); function GetMethodName( Decl : string; PlusNextChar : boolean) : string; const // Rip Mufasa -> Simba ftw //WindowTitle = 'Mufasa v2 - %s';//Title, where %s = the place of the filename. WindowTitle = 'Simba - %s';//Title, where %s = the place of the filename. Panel_State = 0; Panel_Coords = 1; Panel_ScriptName = 2; Panel_ScriptPath = 3; Image_Stop = 7; Image_Terminate = 19; var Form1: TForm1; MainDir : string; {$ifdef MSWindows} PrevWndProc : WNDPROC; {$endif} CurrentSyncInfo : TSyncInfo;//We need this for SafeCallThread implementation uses lclintf, syncobjs, // for the critical sections debugimage, files, extensionmanagergui, colourhistory, math; {$ifdef mswindows} function ConsoleHandler( eventType : DWord) : WINBOOL;stdcall; begin TThread.Synchronize(nil,@Form1.Close); Result := true; end; function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam; lParam: LParam): LRESULT stdcall; begin if uMsg = WM_HOTKEY then begin Form1.ActionStopScript.Execute; Result := 0; end else Result := Windows.CallWindowProc(PrevWndProc,Ahwnd, uMsg, WParam, LParam); end; {$endif} var DebugCriticalSection: syncobjs.TCriticalSection; procedure TForm1.OnCCMessage(Sender: TObject; const Typ: TMessageEventType; const Msg: string; X, Y: Integer); begin if (Typ = meNotSupported) then Exit; if (Sender is TmwSimplePasPar) then if (TmwSimplePasPar(Sender).Lexer.TokenID = tok_DONE) then Exit; mDebugLn('ERROR: '+Format('%d:%d %s', [Y + 1, X, Msg])+' in '+TCodeInsight(Sender).FileName); end; procedure TForm1.OnCompleteCode(Str: string); var sp, ep: Integer; s: string; begin if (Str <> '') then begin s := WordAtCaret(CurrScript.SynEdit, sp, ep); if (s <> '') then begin CurrScript.SynEdit.SelStart := CurrScript.SynEdit.SelStart + (sp - CurrScript.SynEdit.CaretX); CurrScript.SynEdit.SelEnd := CurrScript.SynEdit.SelStart + (ep - CurrScript.SynEdit.CaretX) + 1; CurrScript.SynEdit.SelText := Str; end else CurrScript.SynEdit.InsertTextAtCaret(Str); end; end; function TForm1.OnCCFindInclude(Sender: TObject; var FileName: string): Boolean; var Temp : string; begin Temp := FindFile(filename,[MainDir+DS,IncludePath]); if temp <> '' then begin; filename := temp; result := true; end else result := false; end; procedure TForm1.HandleConnectionData; var Args : TVariantArray; begin SetLength(Args,2); Args[0] := OpenConnectionData.URL^; Args[1] := OpenConnectionData.Continue^; try ExtManager.HandleHook(EventHooks[SExt_onOpenConnection].HookName,Args); OpenConnectionData.URL^ := Args[0]; OpenConnectionData.Continue^ := Args[1]; except on e : Exception do mDebugLn('ERROR in HandleConnectiondata: ' + e.message); end; end; procedure TForm1.HandleOpenFileData; var Args : TVariantArray; begin SetLength(Args,2); Args[0] := OpenFileData.FileName^; Args[1] := OpenFileData.Continue^; try ExtManager.HandleHook(EventHooks[SExt_onOpenFile].HookName,Args); OpenFileData.FileName^ := Args[0]; OpenFileData.Continue^ := Args[1]; except on e : Exception do mDebugLn('ERROR in HandleOpenFileData: ' + e.message); end; end; procedure TForm1.HandleWriteFileData; var Args : TVariantArray; begin SetLength(Args,2); Args[0] := WriteFileData.FileName^; Args[1] := WriteFileData.Continue^; try ExtManager.HandleHook(EventHooks[SExt_onWriteFile].HookName,Args); WriteFileData.FileName^ := Args[0]; WriteFileData.Continue^ := Args[1]; except on e : Exception do mDebugLn('ERROR in HandleWriteFileData: ' + e.message); end; end; procedure TForm1.HandleScriptStartData; var Args : TVariantArray; begin SetLength(Args,2); Args[0] := ScriptStartData.Script^; Args[1] := ScriptStartData.Continue^; try ExtManager.HandleHook(EventHooks[SExt_onScriptStart].HookName,Args); ScriptStartData.Script^ := Args[0]; ScriptStartData.Continue^ := Args[1]; except on e : Exception do mDebugLn('ERROR in HandleScriptStartData: ' + e.message); end; end; procedure TForm1.ProcessDebugStream(Sender: TObject); begin if length(DebugStream) = 0 then Exit; // cut off 1 newline char DebugCriticalSection.Enter; try setlength(DebugStream, length(DebugStream) - 1); Memo1.Lines.Add(DebugStream); SetLength(DebugStream, 0); finally DebugCriticalSection.Leave; end; end; procedure TForm1.RecentFileItemsClick(Sender: TObject); var i : integer; begin for i := 0 to high(RecentFileItems) do if RecentFileItems[i] = sender then begin; LoadScriptFile(RecentFiles[RecentFiles.Count - 1 -i]);//Inverse order exit; end; end; procedure TForm1.ScriptPanelDockDrop(Sender: TObject; Source: TDragDockObject; X, Y: Integer); begin if(X <= (ScriptPanel.Width div 2))then begin frmFunctionList.Align := alLeft; PageControl1.Align := alRight; SplitterFunctionList.ResizeAnchor := akLeft; SplitterFunctionList.Align := alLeft; SplitterFunctionList.Left := frmFunctionList.Left + frmFunctionList.Width; end else begin frmFunctionList.Align := alRight; PageControl1.Align := alLeft; SplitterFunctionList.ResizeAnchor := akRight; SplitterFunctionList.Align := alRight; SplitterFunctionList.Left := frmFunctionList.Left; end; PageControl1.Width := ScriptPanel.Width - (Source.DockRect.Right - Source.DockRect.Left); frmFunctionList.Width := ScriptPanel.Width - PageControl1.Width; PageControl1.Align := alClient; SplitterFunctionList.Show; end; procedure TForm1.ScriptPanelDockOver(Sender: TObject; Source: TDragDockObject; //is there a better way to do all of this? X, Y: Integer; State: TDragState; var Accept: Boolean); var P: TPoint; begin Accept := frmFunctionList.DragKind = dkDock; if(Accept)then begin P := ScriptPanel.ClientToScreen(Classes.Point(0, 0)); if(X <= (ScriptPanel.Width div 2))then Source.DockRect := Classes.Rect(P.x, P.y, min(P.x + frmFunctionList.Width, P.x + (ScriptPanel.Width div 2)), P.y + ScriptPanel.Height) else Source.DockRect := Classes.Rect(max(P.x + ScriptPanel.Width - frmFunctionList.Width, P.x + (ScriptPanel.Width div 2)), P.y, P.x + ScriptPanel.Width, P.y + ScriptPanel.Height); end; end; procedure TForm1.ScriptPopupPopup(Sender: TObject); begin SetEditActions; end; procedure TForm1.SpeedButtonSearchClick(Sender: TObject); begin CloseFindPanel; end; procedure TForm1.SplitterFunctionListCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin if(NewSize > ScriptPanel.Width div 2)then NewSize := ScriptPanel.Width div 2; end; procedure TForm1.TB_ReloadPluginsClick(Sender: TObject); begin // PluginsGlob.FreePlugins; end; procedure TForm1.ThreadOpenConnectionEvent(Sender: TObject; var url: string;var Continue: boolean); begin OpenConnectionData.Sender := Sender; OpenConnectionData.URL:= @URL; OpenConnectionData.Continue:= @Continue; TThread.Synchronize(nil,@HandleConnectionData); end; procedure TForm1.ThreadOpenFileEvent(Sender: TObject; var Filename: string; var Continue: boolean); begin OpenFileData.Sender := Sender; OpenFileData.FileName:= @FileName; OpenFileData.Continue:= @Continue; TThread.Synchronize(nil,@HandleOpenFileData); end; procedure TForm1.ThreadWriteFileEvent(Sender: TObject; var Filename: string; var Continue: boolean); begin WriteFileData.Sender := Sender; WriteFileData.FileName:= @FileName; WriteFileData.Continue:= @Continue; TThread.Synchronize(nil,@HandleWriteFileData); end; procedure TForm1.TrayPopupPopup(Sender: TObject); begin MenuItemHide.enabled:= Form1.Visible; {$ifdef MSWindows} MenuItemShow.Enabled:= not Form1.Visible; if Form1.Visible then if Form1.CanFocus then form1.SetFocus; {$endif} end; procedure TForm1.TT_UpdateClick(Sender: TObject); begin SimbaUpdateForm.ShowModal; TT_Update.Visible:=False; end; procedure TForm1.UpdateTimerCheck(Sender: TObject); var chk: String; time:integer; LatestVersion : integer; begin UpdateTimer.Interval:= MaxInt; FontUpdate; chk := LowerCase(LoadSettingDef('Settings/Updater/CheckForUpdates','True')); if chk <> 'true' then Exit; LatestVersion:= SimbaUpdateForm.GetLatestSimbaVersion; if LatestVersion > SimbaVersion then begin; TT_Update.Visible:=True; formWritelnEx('A new update of Simba is available!'); formWritelnEx(format('Current version is %d. Latest version is %d',[SimbaVersion,LatestVersion])); end else begin mDebugLn(format('Current Simba version: %d',[SimbaVersion])); mDebugLn('Latest Simba Version: ' + IntToStr(LatestVersion)); end; time := StrToIntDef(LoadSettingDef('Settings/Updater/CheckEveryXMinutes','30'),30); UpdateTimer.Interval:= time {mins} * 60 {secs} * 1000 {ms};//Every half hour end; procedure TForm1.UpdateMenuButtonClick(Sender: TObject); begin SimbaUpdateForm.ShowModal; end; procedure ClearDebug; begin {$IFNDEF MSWINDOWS} Form1.ProcessDebugStream(nil); {$ENDIF} TThread.Synchronize(nil,@Form1.Memo1.Clear); end; procedure formWriteln( S : String); begin mDebugLn('formWriteln: ' + s); {$ifdef MSWindows} //Ha, we cán acces the debugmemo Form1.Memo1.Lines.Add(s); {$else} DebugCriticalSection.Enter; try s := s + MEOL; Form1.DebugStream:= Form1.DebugStream + s; finally DebugCriticalSection.Leave; end; {$endif} end; //{$ENDIF} procedure TForm1.RunScript; begin with CurrScript do begin if ScriptState = ss_Paused then begin; ScriptThread.Resume; ScriptState := ss_Running; Exit; end else if ScriptState <> ss_None then begin; FormWritelnEx('The script hasn''t stopped yet, so we cannot start a new one.'); exit; end; InitalizeTMThread(scriptthread); ScriptThread.CompileOnly:= false; ScriptThread.OnTerminate:=@ScriptThreadTerminate; ScriptState:= ss_Running; FirstRun := false; //Lets run it! ScriptThread.Resume; end; end; procedure TForm1.PauseScript; begin with CurrScript do begin; if ScriptState = ss_Running then begin; {$ifdef MSWindows} ScriptThread.Suspended:= True; ScriptState:= ss_Paused; {$else} mDebugLn('Linux users are screwed, no pause button for u!'); {$endif} end else if ScriptState = ss_Paused then begin; ScriptThread.Resume; ScriptState := ss_Running; end; end; end; procedure TForm1.StopScript; begin with CurrScript do begin; case ScriptState of ss_Stopping: begin //Terminate the thread the tough way. mDebugLn('Terminating the Scriptthread'); mDebugLn('Exit code terminate: ' +inttostr(KillThread(ScriptThread.Handle))); WaitForThreadTerminate(ScriptThread.Handle, 0); ScriptThread.Free; ScriptState := ss_None; end; ss_Running: begin ScriptThread.Terminate; ScriptState := ss_Stopping; end; ss_Paused: begin ScriptThread.Resume; ScriptThread.Terminate; ScriptState:= ss_Stopping; end; end; end; end; procedure TForm1.AddTab; var Tab : TMufasaTab; begin; Tab := TMufasaTab.Create(Self.PageControl1); Tabs.Add(Tab); Tab.TabSheet.ImageIndex:= 8; // Tab.TabSheet.OnContextPopup:= @TabPopup; PageControl1.TabIndex:= Tabs.Count - 1; RefreshTab; if tabs.count > 1 then begin; TB_SaveAll.Enabled:= True; MenuItemSaveAll.Enabled:= True; end; end; function TForm1.DeleteTab(TabIndex: integer; CloseLast : boolean; Silent : boolean = false) : boolean; var Tab : TMufasaTab; OldIndex : integer;//So that we can switch back, if needed. begin if not Silent then begin; OldIndex := PageControl1.TabIndex; if TabIndex = OldIndex then begin; if lowercase(LoadSettingDef('Settings/Tabs/OpenNextOnClose','False')) = 'false' then OldIndex := LastTab //We are closing the 'current' tab, lets go back in history else OldIndex := Min(Tabs.Count - 1,OldIndex + 1); end; PageControl1.TabIndex:= TabIndex; end; //ScriptFrame now is now correct ;-D result := CanExitOrOpen; if not result then exit; Tab := TMufasaTab(Tabs[TabIndex]); if (Tabs.Count = 1) and (not CloseLast) then Tab.Clear else begin; Tab.Free; Tabs.Delete(TabIndex); if not Silent then begin; if OldIndex > TabIndex then PageControl1.TabIndex := OldIndex - 1 else if OldIndex < TabIndex then PageControl1.TabIndex := OldIndex; end; end; if tabs.count <= 1 then begin; TB_SaveAll.Enabled:= false; MenuItemSaveAll.Enabled:= false; end; if not silent then RefreshTab; end; procedure TForm1.ClearTab(TabIndex: integer); begin TMufasaTab(Tabs[TabIndex]).Clear; end; procedure TForm1.CloseTabs(Exclude: integer = -1; Silent : boolean = false); var I : integer; begin for i := tabs.count - 1 downto 0 do if i <> exclude then if not DeleteTab(i,false,silent) then exit; end; procedure TForm1.SetEditActions; procedure EditActions(Undo,Redo,Cut,Copy,Paste,Delete : boolean); begin; ActionUndo.Enabled:= Undo; ActionRedo.Enabled:= Redo; ActionCut.Enabled:= Cut; ActionCopy.Enabled:= Copy; ActionPaste.Enabled:= Paste; ActionDelete.Enabled:= Delete; {$ifdef UpdateEditButtons} TT_Cut.Enabled:= Cut; TT_Paste.Enabled:=Paste; TT_Copy.enabled := Copy; {$endif} end; var S: String; B: Boolean; begin if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then begin with CurrScript.SynEdit do begin EditActions(CanUndo,CanRedo,SelText <> '',SelText <> '',CanPaste,SelText <> ''); // B:= SelText <> ''; B := SelAvail; PopupItemFind.Enabled:= B; PopupItemReplace.Enabled:= B; if(B)then begin s := SelText; if(Length(S) > 13)then S:= Format('"%s"', [Copy(S, 1, 10) + '...']) else S:= Format('"%s"', [S]); PopupItemFind.Caption:= 'Find next: ' + S; PopupItemReplace.Caption:= 'Replace: ' + S; end; end end else if Memo1.Focused then with Memo1 do EditActions(CanUndo,False,SelText <>'',SelText <> '',True,SelText <> '') else EditActions(false,false,false,false,false,false); end; procedure TForm1.DoSearch(Next: boolean; HighlightAll : boolean); var Res : integer; CurrPos : TPoint; SearchOptions : TSynSearchOptions; begin SearchOptions:= []; if CheckBoxMatchCase.Checked then SearchOptions := [ssoMatchCase]; if SearchString = '' then begin res := -1; CurrScript.Synedit.SetHighlightSearch('',[]); // CurrScript.SynEdit.SelectionMode:= // CurrScript.SynEdit.CaretXY := CurrScript.SynEdit.CaretXY; CurrScript.SynEdit.LogicalCaretXY := SearchStart; end else begin mDebugLn('Searching: ' + SearchString); if next then CurrPos := CurrScript.SynEdit.LogicalCaretXY else CurrPos := SearchStart; Res := CurrScript.SynEdit.SearchReplaceEx(SearchString,'',SearchOptions,CurrPos); if res = 0 then begin res := CurrScript.SynEdit.SearchReplaceEx(SearchString,'',SearchOptions,Classes.Point(0,0)); if res > 0 then begin; mDebugLn('End of document reached'); SearchStart.x := 0; SearchStart.Y := CurrScript.SynEdit.LogicalCaretXY.y; end; end; end; if res = 0 then begin; LabeledEditSearch.Color := 6711039; LabeledEditSearch.Font.Color:= clWhite; CurrScript.Synedit.SetHighlightSearch('',[]); CurrScript.SynEdit.LogicalCaretXY := SearchStart; end else begin LabeledEditSearch.Color:= clWindow; LabeledEditSearch.Font.Color:= clWindowText; with CurrScript.SynEdit do begin HighlightAllColor.Background:= clYellow; if HighlightAll then SetHighlightSearch(SearchString,[]) else SetHighlightSearch('',[]); end; end; end; procedure TForm1.RefreshTab; var Tab : TMufasaTab; Script : TScriptFrame; NewTab : integer; begin if tabs.Count < 1 then begin; mDebugLn('Cannot refresh tab, since there are no tabs.'); exit; end; NewTab := PageControl1.TabIndex; Tab := TMufasaTab(Tabs[Newtab]); Script := Tab.ScriptFrame; Self.CurrScript := Script; Self.CurrTab := Tab; if Script.ScriptChanged then begin; Tab.TabSheet.Caption:= Script.ScriptName + '*'; Self.Caption := Format(WindowTitle,[Script.ScriptName + '*']) end else begin; Tab.TabSheet.Caption:= Script.ScriptName; Self.Caption := Format(WindowTitle,[Script.ScriptName]); end; StatusBar.Panels[Panel_ScriptName].Text:= Script.ScriptName; StatusBar.Panels[Panel_ScriptPath].text:= Script.ScriptFile; SetScriptState(Tab.ScriptFrame.FScriptState);//To set the buttons right if Self.Showing then if Tab.TabSheet.TabIndex = Self.PageControl1.TabIndex then if CurrScript.SynEdit.CanFocus then CurrScript.SynEdit.SetFocus; StopCodeCompletion;//To set the highlighting back to normal; frmFunctionList.LoadScriptTree(CurrScript.SynEdit.Text); with CurrScript.SynEdit do begin SetHighlightSearch('',[]); UseIncrementalColor:= false; MarkupByClass[TSynEditMarkupHighlightAllCaret].TempEnable; Invalidate; end; LabeledEditSearch.SelLength:= 0; LabeledEditSearch.Color:= clWindow; LabeledEditSearch.Font.Color:= clWindowText; //Set tha edit buttons right SetEditActions; end; procedure TForm1.RefreshTabSender(sender: PtrInt); begin RefreshTab; end; procedure TForm1.CreateDefaultEnvironment; var PluginsPath,extensionsPath : string; FontUpdater : TProcThread; begin CreateSetting('Settings/Updater/CheckForUpdates','True'); CreateSetting('Settings/Updater/CheckEveryXMinutes','30'); CreateSetting('Settings/Interpreter/UseCPascal', 'False'); CreateSetting('Settings/Fonts/LoadOnStartUp', 'True'); CreateSetting('Settings/Fonts/Version','-1'); CreateSetting('Settings/Tabs/OpenNextOnClose','False'); CreateSetting('Settings/Tabs/OpenScriptInNewTab','True'); CreateSetting('Settings/Tabs/CheckTabsBeforeOpen','True'); CreateSetting('Settings/ColourPicker/ShowHistoryOnPick', 'True'); CreateSetting('Settings/General/MaxRecentFiles','10'); CreateSetting('Settings/MainForm/NormalSize','739:555'); CreateSetting('Settings/FunctionList/ShowOnStart','True'); CreateSetting('Settings/CodeHints/ShowAutomatically','True'); CreateSetting('Settings/SourceEditor/LazColors','True'); CreateSetting('Settings/Extensions/FileExtension','sex'); CreateSetting('Settings/Updater/RemoteLink',SimbaURL + 'Simba'{$IFDEF WINDOWS} +'.exe'{$ENDIF}); CreateSetting('Settings/Updater/RemoteVersionLink',SimbaURL + 'Version'); CreateSetting('Settings/Fonts/VersionLink', FontURL + 'Version'); CreateSetting('Settings/Fonts/UpdateLink', FontURL + 'Fonts.tar.bz2'); CreateSetting('Settings/News/URL', 'http://simba.villavu.com/bin/news'); {Creates the paths and returns the path} PluginsPath := CreateSetting('Settings/Plugins/Path', ExpandFileName(MainDir+ DS+ 'Plugins' + DS)); extensionsPath := CreateSetting('Settings/Extensions/Path',ExpandFileName(MainDir +DS + 'Extensions' + DS)); CreateSetting('Extensions/ExtensionCount','0'); CreateSetting('LastConfig/MainForm/Position',''); CreateSetting('LastConfig/MainForm/State','Normal'); {$ifdef MSWindows} CreateSetting('LastConfig/Console/Visible','True'); ShowConsole(True); {$endif} if not DirectoryExists(IncludePath) then CreateDir(IncludePath); if not DirectoryExists(FontPath) then CreateDir(FontPath); if not DirectoryExists(PluginsPath) then CreateDir(PluginsPath); if not DirectoryExists(extensionsPath) then CreateDir(extensionsPath); SettingsForm.SettingsTreeView.Items.GetFirstNode.Expand(false); SettingsForm.SaveCurrent; LoadFormSettings; UpdateTimer.Interval:=25; end; procedure TForm1.LoadFormSettings; var str,str2 : string; Data : TStringArray; i,ii : integer; begin str := LoadSettingDef('LastConfig/MainForm/Position',''); if str <> '' then begin; Data := Explode(':',str); if length(Data) <> 4 then Exit; Self.Left:= StrToIntDef(Data[0],Self.Left); Self.Top:= StrToIntDef(Data[1],self.top); Self.Width:= StrToIntDef(Data[2],self.width); Self.Height:= StrToIntDef(Data[3],self.height); end; str := lowercase(LoadSettingDef('LastConfig/MainForm/State','Normal')); if str = 'maximized' then self.windowstate := wsMaximized else // if str = 'normal' then Self.WindowState := wsNormal; str := LoadSettingDef('LastConfig/MainForm/RecentFiles',''); if str <> '' then begin Data := Explode(';',str); for i := high(data) downto 0 do//First = entry should be added as last AddRecentFile(data[i]); end; str := LowerCase(LoadSettingDef('Settings/FunctionList/ShowOnStart','True')); str2 := lowercase(LoadSettingDef('LastConfig/MainForm/FunctionListShown','')); if (str = 'true') or (str2 = 'true') then FunctionListShown(True) else FunctionListShown(false); {$ifdef MSWindows} str := LowerCase(LoadSettingDef('LastConfig/Console/Visible','True')); if str = 'true' then ShowConsole(True) else ShowConsole(false); {$endif} end; procedure TForm1.SaveFormSettings; var Data : TStringArray; path : string; i : integer; begin with SettingsForm.Settings do begin if Self.WindowState = wsMaximized then SetSetting('LastConfig/MainForm/State','maximized') else begin; //Only save the form position if its non maximized. SetSetting('LastConfig/MainForm/State','normal'); Data := ConvArr([inttostr(Self.left),inttostr(self.top),inttostr(self.width),inttostr(self.height)]); SetSetting('LastConfig/MainForm/Position', Implode(':',Data )); end; if RecentFiles.Count > 0 then begin SetLength(data,RecentFiles.Count); for i := 0 to high(data) do //First entry should be the last-opened data[high(data) - i] := RecentFiles[i]; SetSetting('LastConfig/MainForm/RecentFiles',implode(';',data)); end else SetSetting('LastConfig/MainForm/RecentFiles',''); if MenuItemFunctionList.Checked then SetSetting('LastConfig/MainForm/FunctionListShown','True') else SetSetting('LastConfig/MainForm/FunctionListShown','False'); {$ifdef MSWindows} if ConsoleVisible then SetSetting('LastConfig/Console/Visible','True') else SetSetting('LastConfig/Console/Visible','false'); {$endif} SetSetting('Extensions/ExtensionCount',inttostr(ExtManager.Extensions.Count)); for i := 0 to ExtManager.Extensions.Count-1 do begin; path :='Extensions/Extension' + inttostr(I); SetSetting(Path + '/Path',TVirtualSimbaExtension(ExtManager.Extensions[i]).Filename); SetSetting(Path + '/Enabled',BoolToStr(TVirtualSimbaExtension(ExtManager.Extensions[i]).Enabled,True)); end; SaveToXML(SimbaSettingsFile); end; end; procedure TForm1.LoadExtensions; var extCount : integer; function LoadExtension(Number : integer) : boolean; var Path : string; ExtPath : string; ExtEnabled : boolean; begin; result := false; if (number < 0) or (number >= extCount) then exit; path := 'Extensions/Extension' + inttostr(number); if SettingExtists(Path) = false then exit; ExtPath := LoadSettingDef(Path + '/Path',''); if ExtPath = '' then exit; ExtEnabled := StrToBoolDef(LoadSettingDef(Path + '/Enabled','false'),false); if ExtManager.LoadPSExtension(ExtPath,ExtEnabled) = false then exit; Result := true; end; procedure DeleteExtension(number : integer); var i : integer; path : string; begin; path := 'Extensions/Extension'; SettingsForm.Settings.DeleteKey(path + inttostr(number)); for i := number + 1 to extCount - 1 do SettingsForm.Settings.RenameKey(path + inttostr(i),'Extension' + inttostr(i-1)); SetSetting('Extensions/ExtensionCount',inttostr(extCount - 1),true); dec(extCount); end; var str,str2 : string; i : integer; begin extCount := StrToIntDef(LoadSettingDef('Extensions/ExtensionCount/','0'),0); for i := 0 to extCount - 1 do while (i < extCount) and not LoadExtension(i) do DeleteExtension(i); SetSetting('Extensions/ExtensionCount',inttostr(extCount)); str := LoadSettingDef('Settings/Extensions/Path',ExpandFileName(MainDir +DS + 'Extensions' + DS)); str2 := LoadSettingDef('Settings/Extensions/FileExtension','sex'); ExtManager.LoadPSExtensionsDir(str,str2); end; procedure TForm1.AddRecentFile(const filename: string); var MaxRecentFiles : integer; Len,i : integer; begin MaxRecentFiles:= StrToIntDef(LoadSettingDef('Settings/General/MaxRecentFiles','10'),10); i := RecentFiles.IndexOf(filename); if i <> -1 then RecentFiles.Delete(i); if RecentFiles.Count = MaxRecentFiles then RecentFiles.Delete(0); RecentFiles.Add(filename); Len := RecentFiles.Count; if len <> length(RecentFileItems) then //Not reached maximum yet, add those files! begin SetLength(RecentFileItems,len); RecentFileItems[len-1] := TMenuItem.Create(MenuItemOpenRecent); RecentFileItems[len-1].OnClick:=@RecentFileItemsClick; MenuItemOpenRecent.Add(RecentFileItems[len-1]); end; for i := 0 to len - 1 do RecentFileItems[len - 1-i].Caption:= ExtractFileName(RecentFiles[i]); end; procedure TForm1.InitalizeTMThread(var Thread: TMThread); var DbgImgInfo : TDbgImgInfo; AppPath : string; ScriptPath : string; UseCPascal: String; Script : string; Se: TMMLSettingsSandbox; loadFontsOnScriptStart: boolean; Continue : boolean; begin Script :=CurrScript.SynEdit.Lines.Text; if Assigned(OnScriptStart) then begin Continue := True; OnScriptStart(Self,script,continue); if not Continue then exit; end; AppPath:= MainDir + DS; CurrScript.ScriptErrorLine:= -1; CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread; UseCPascal := LoadSettingDef('Settings/Interpreter/UseCPascal', 'False'); try if lowercase(UseCPascal) = 'true' then Thread := TCPThread.Create(True,@CurrentSyncInfo,PluginPath) else Thread := TPSThread.Create(True,@CurrentSyncInfo,PluginPath); except mDebugLn('Failed to initialise the library!'); Exit; end; {$IFNDEF TERMINALWRITELN} Thread.SetDebug(@formWriteln); Thread.SetDebugClear(@ClearDebug); {$ENDIF} Thread.SetScript(Script); DbgImgInfo.DispSize := @DebugImgForm.DispSize; DbgImgInfo.ShowForm := @DebugImgForm.ShowDebugImgForm; DbgImgInfo.ToDrawBitmap:= @DebugImgForm.ToDrawBmp; DbgImgInfo.DrawBitmap:= @DebugImgForm.DrawBitmap; DbgImgInfo.GetDebugBitmap:= @DebugImgForm.GetDbgBmp; DbgImgInfo.GetBitmap:= @DebugImgForm.GetDebugImage; Thread.SetDbgImg(DbgImgInfo); Thread.ErrorData:= @CurrScript.ErrorData; Thread.OnError:= @CurrScript.HandleErrorData; if CurrScript.ScriptFile <> '' then ScriptPath := IncludeTrailingPathDelimiter(ExtractFileDir(CurrScript.ScriptFile)); if DirectoryExists(PluginPath) then PluginsGlob.AddPath(PluginPath); if not DirectoryExists(IncludePath) then if FirstRun then FormWritelnEx('Warning: The include directory specified in the Settings isn''t valid.'); if not DirectoryExists(fontPath) then if FirstRun then FormWritelnEx('Warning: The font directory specified in the Settings isn''t valid. Can''t load fonts now'); Thread.SetPaths(ScriptPath,AppPath,Includepath,PluginPath,fontPath); if selector.haspicked then Thread.Client.IOManager.SetTarget(Selector.LastPick); loadFontsOnScriptStart := (lowercase(LoadSettingDef('Settings/Fonts/LoadOnStartUp', 'True')) = 'true'); // Copy our current fonts if not assigned(Self.OCR_Fonts) and loadFontsOnScriptStart and DirectoryExists(fontPath) then begin Self.OCR_Fonts := TMOCR.Create(Thread.Client); OCR_Fonts.InitTOCR(fontPath); Thread.Client.MOCR.Fonts := OCR_Fonts.Fonts end else if assigned(Self.OCR_Fonts) and loadFontsOnScriptStart then Thread.Client.MOCR.Fonts := OCR_Fonts.Fonts; Se := TMMLSettingsSandbox.Create(SettingsForm.Settings); Se.Prefix := 'Scripts/'; Thread.SetSettings(Se); Thread.OpenConnectionEvent:=@ThreadOpenConnectionEvent; Thread.WriteFileEvent:=@ThreadWriteFileEvent; Thread.OpenFileEvent:=@ThreadOpenFileEvent; end; procedure TForm1.HandleParameters; var DoRun : Boolean; ErrorMsg : string; begin DoRun := false; if Paramcount = 1 then begin if FileExists(ParamStr(1)) then LoadScriptFile(paramstr(1)); end else begin; ErrorMsg:=Application.CheckOptions('ro:','run open:'); if ErrorMsg <> '' then mDebugLn(ErrorMSG) else begin if Application.HasOption('o','open') then begin; LoadScriptFile(Application.GetOptionValue('o','open')); DoRun:= Application.HasOption('r','run'); end; end; end; if DoRun then Self.RunScript; end; procedure TForm1.OnSaveScript(const Filename: string); begin with CurrScript do begin ScriptFile:= SetDirSeparators(Filename); ScriptName:= ExtractFileNameOnly(ScriptFile); mDebugLn('Script name will be: ' + ScriptName); FormWritelnEx('Succesfully saved: ' + ScriptFile); StartText:= SynEdit.Lines.Text; ScriptChanged := false; SynEdit.MarkTextAsSaved; Self.Caption:= Format(WindowTitle,[ScriptName]); CurrTab.TabSheet.Caption:= ScriptName; Self.AddRecentFile(ScriptFile); StatusBar.Panels[Panel_ScriptName].Text:= ScriptName; StatusBar.Panels[Panel_ScriptPath].text:= ScriptFile; end; end; procedure TForm1.ActionTabLastExecute(Sender: TObject); var CurrIndex : integer; begin CurrIndex := PageControl1.TabIndex; if CurrIndex = 0 then CurrIndex := Tabs.count - 1 else Dec(CurrIndex); PageControl1.TabIndex:= CurrIndex; end; procedure TForm1.ActionCloseTabExecute(Sender: TObject); begin if(PageControl1.PageCount > 1)then Self.DeleteTab(PageControl1.TabIndex,false) else Self.ClearScript; //DeleteTab would take care of this already, but yeah, it's neater this way. end; procedure TForm1.ActionCompileScriptExecute(Sender: TObject); var TempThread : TMThread; begin InitalizeTMThread(TempThread); TempThread.CompileOnly:= true; TempThread.Resume; end; procedure TForm1.ActionConsoleExecute(Sender: TObject); begin {$ifdef mswindows} ShowConsole(not ConsoleVisible); {$endif} end; procedure TForm1.ActionCopyExecute(Sender: TObject); begin if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then CurrScript.SynEdit.CopyToClipboard else if Memo1.Focused then Memo1.CopyToClipboard; end; procedure TForm1.ActionCutExecute(Sender: TObject); begin if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then CurrScript.SynEdit.CutToClipboard else if Memo1.Focused then Memo1.CutToClipboard; end; procedure TForm1.ActionDeleteExecute(Sender: TObject); begin if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then CurrScript.SynEdit.ClearSelection else if Memo1.Focused then Memo1.ClearSelection; end; procedure TForm1.ActionExitExecute(Sender: TObject); begin Self.Close; end; procedure TForm1.ActionFindNextExecute(Sender: TObject); begin DoSearch(true, false); end; procedure TForm1.ActionFindstartExecute(Sender: TObject); begin if frmFunctionList.Focused or frmFunctionList.FunctionList.Focused or frmFunctionList.editSearchList.Focused then begin if frmFunctionList.editSearchList.CanFocus then frmFunctionList.editSearchList.SetFocus; end else begin SearchPanel.Visible:= true; if LabeledEditSearch.CanFocus then LabeledEditSearch.SetFocus; end; end; procedure TForm1.ActionClearDebugExecute(Sender: TObject); begin Memo1.Clear; end; procedure TForm1.ActionNewExecute(Sender: TObject); begin //Self.ClearScript; Self.AddTab; end; procedure TForm1.ActionNewTabExecute(Sender: TObject); begin Self.AddTab; end; procedure TForm1.ActionNormalSizeExecute(Sender: TObject); var SizeStr : string; Data : TStringArray; begin SizeStr := LoadSettingDef('Settings/MainForm/NormalSize','739:555'); Data := Explode(':',SizeStr); if length(Data) = 2 then begin Self.Width:= StrToIntDef(Data[0],739); Self.Height:= StrToIntDef(Data[1],555); end else begin; self.width := 739; self.height := 555; end; end; procedure TForm1.ActionOpenExecute(Sender: TObject); begin Self.OpenScript; end; procedure TForm1.ActionPasteExecute(Sender: TObject); begin if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then CurrScript.SynEdit.PasteFromClipboard else if Memo1.Focused then Memo1.PasteFromClipboard else if LabeledEditSearch.Focused then LabeledEditSearch.PasteFromClipboard else if frmFunctionList.editSearchList.Focused then frmFunctionList.editSearchList.PasteFromClipboard; end; procedure TForm1.ActionPauseExecute(Sender: TObject); begin Self.PauseScript; end; procedure TForm1.ActionRedoExecute(Sender: TObject); begin if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then CurrScript.Redo else if Memo1.Focused then Memo1.Undo; //? end; procedure TForm1.ActionReplaceExecute(Sender: TObject); begin if(ScriptPopup.HandleAllocated)then dlgReplace.FindText:= CurrScript.SynEdit.SelText; dlgReplace.Execute; end; procedure TForm1.ActionRunExecute(Sender: TObject); begin Self.RunScript; end; procedure TForm1.ActionSaveAllExecute(Sender: TObject); var i : integer; OldIndex : integer; begin OldIndex := PageControl1.TabIndex; for i := 0 to Tabs.Count - 1 do begin; PageControl1.TabIndex:= i; SaveCurrentScript; end; PageControl1.TabIndex:= oldindex; end; procedure TForm1.ActionSaveAsExecute(Sender: TObject); begin Self.SaveCurrentScriptAs; end; procedure TForm1.ActionSaveExecute(Sender: TObject); begin Self.SaveCurrentScript; end; procedure TForm1.ActionSelectAllExecute(Sender: TObject); begin if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then CurrScript.SynEdit.SelectAll else if Memo1.Focused then Memo1.SelectAll else if LabeledEditSearch.Focused then LabeledEditSearch.SelectAll; end; procedure TForm1.ActionStopExecute(Sender: TObject); begin Self.StopScript; end; procedure TForm1.ActionTabNextExecute(Sender: TObject); var CurrIndex : integer; begin CurrIndex := PageControl1.TabIndex; if CurrIndex = Tabs.count - 1 then CurrIndex := 0 else Inc(CurrIndex); PageControl1.TabIndex:= CurrIndex; end; procedure TForm1.ActionUndoExecute(Sender: TObject); begin if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then CurrScript.Undo else if Memo1.Focused then Memo1.Undo; end; procedure TForm1.ChangeMouseStatus(Sender: TObject); var x, y: Integer; begin if Self.Manager.TargetValid = false then self.Manager.SetDesktop; Self.Manager.GetMousePos(x, y); if self.Manager.ReceivedError() then begin FormWritelnEx('Our window no longer exists -> Resetting to desktop'); self.Manager.SetDesktop; self.Manager.ResetError; end; StatusBar.Panels[Panel_Coords].Text := Format('(%d, %d)', [x, y]); end; procedure TForm1.CheckBoxMatchCaseClick(Sender: TObject); begin RefreshTab; CurrScript.SynEdit.MarkupByClass[TSynEditMarkupHighlightAllCaret].TempDisable; SearchString := LabeledEditSearch.Text; DoSearch(false, true); CurrScript.SynEdit.UseIncrementalColor:= true; LabeledEditSearch.SetFocus; end; procedure TForm1.CloseFindPanel; begin SearchPanel.Visible:= false; if CurrScript.SynEdit.CanFocus then CurrScript.SynEdit.SetFocus; end; procedure TForm1.StopCodeCompletion; begin CodeCompletionForm.Hide; if frmFunctionList.InCodeCompletion then with CurrScript,frmFunctionList do begin; editSearchList.Color:= clWhite; if FilterTree.Focused then begin; mDebugLn('This is currently not supported'); SynEdit.Lines[CompletionCaret.y - 1] := CompletionStart; SynEdit.LogicalCaretXY:= Classes.point(CompletionCaret.x,CompletionCaret.y); SynEdit.SelEnd:= SynEdit.SelStart; end; InCodeCompletion:= false; SynEdit.SelectedColor.Style:= []; SynEdit.SelectedColor.Foreground:= clHighlightText; SynEdit.SelectedColor.Background:= clHighlight; Synedit.MarkupByClass[TSynEditMarkupHighlightAllCaret].TempEnable; end; end; function TForm1.FindTab(filename: string): integer; var i : integer; begin FileName := SetDirSeparators(filename); for i := 0 to Form1.Tabs.Count - 1 do {$ifdef MSWindows} //Case insensitive if lowercase(TMufasaTab(Tabs[i]).ScriptFrame.ScriptFile) = lowercase(filename) then {$else} if TMufasaTab(Tabs[i]).ScriptFrame.ScriptFile = filename then {$endif} exit(i); result := -1; end; procedure TForm1.editSearchListExit(Sender: TObject); begin frmFunctionList.editSearchList.Color := clWhite; StopCodeCompletion; end; procedure TForm1.editSearchListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if key = vk_up then begin frmFunctionList.Find(True,true); key := 0; end else if key = vk_down then begin frmFunctionList.Find(true); key := 0; end; end; procedure TForm1.editSearchListKeyPress(Sender: TObject; var Key: char); var linetext : string; begin if key = #13 then//enter begin; key := #0; frmFunctionList.Find(True); end else if frmFunctionList.InCodeCompletion then begin; if key = #27 then//esc -> C'est error! begin key := #0; StopCodeCompletion; CurrScript.SynEdit.Lines[frmFunctionList.CompletionCaret.y - 1] := frmFunctionList.CompletionStart; CurrScript.SynEdit.LogicalCaretXY:= Classes.point(frmFunctionList.CompletionCaret.x,frmFunctionList.CompletionCaret.y); CurrScript.SynEdit.SelEnd:= CurrScript.SynEdit.SelStart; CurrScript.SynEdit.SetFocus; end else if key in [' ',',','.','(',')'] then //on on these chars we will insert the function! begin; StopCodeCompletion; linetext := CurrScript.SynEdit.Lines[frmFunctionList.CompletionCaret.y - 1]; while (frmFunctionList.CompletionCaret.x <= length(linetext)) and (linetext[frmFunctionList.CompletionCaret.x] in ['a'..'z','A'..'Z','0'..'9','_']) do inc(frmFunctionList.CompletionCaret.x); CurrScript.SynEdit.LogicalCaretXY:= frmFunctionList.CompletionCaret; CurrScript.SynEdit.SelStart:= CurrScript.SynEdit.SelEnd; CurrScript.SynEdit.ExecuteCommand(ecChar,key,nil); CurrScript.SynEdit.SetFocus; key := #0; end; end; end; procedure TForm1.FormDropFiles(Sender: TObject; const FileNames: array of String ); var i : integer; begin if (length(FileNames) = 1) then begin LoadScriptFile(FileNames[0]); //One file saves us some work exit; end; if (length(FileNames) > 5) then //> 5 seems nice to me, cant imagine you want to open that many scripts on a regular base case MessageDlg('Are you sure you want to open '+inttostr(length(filenames))+ ' scripts?', mtConfirmation, mbYesNo, 0) of IDNO: exit; end; {$IfDef WINDOWS} //Fix for the really old Windows kernel bug which probably will never be fixed for i := 1 to high(filenames) do LoadScriptFile(FileNames[i],true); LoadScriptFile(FileNames[0],true); {$Else} //in this case its tolerable as Windows is the only OS with this bug for i := 0 to high(filenames) do LoadScriptFile(FileNames[i],true); {$EndIf}; end; procedure TForm1.FunctionListChange(Sender: TObject; Node: TTreeNode); var MethodInfo : TMethodInfo; begin if node = nil then exit; if Node.level = 0 then StatusBar.Panels[Panel_ScriptPath].Text := 'Section: ' + Node.Text; if (Node.Level > 0) and (Node.Data <> nil) then begin MethodInfo := PMethodInfo(node.Data)^; StatusBar.Panels[Panel_ScriptPath].Text := MethodInfo.MethodStr; if frmFunctionList.DraggingNode = node then if (MethodInfo.BeginPos > 0) then begin; if MethodInfo.Filename <> nil then if MethodInfo.Filename <> '' then begin; // Writeln(MethodInfo.filename); LoadScriptFile(MethodInfo.Filename,true,true); end; CurrScript.SynEdit.SelStart := MethodInfo.BeginPos + 1; CurrScript.SynEdit.SelEnd := MethodInfo.EndPos + 1; end; end; end; procedure TForm1.FunctionListEnter(Sender: TObject); begin frmFunctionList.LoadScriptTree(CurrScript.SynEdit.Text); end; procedure TForm1.FunctionListExit(Sender: TObject); begin // StatusBar.Panels[2].Text:= ''; end; procedure TForm1.FunctionListTimerTimer(Sender: TObject); begin if Self.Visible and (CurrScript <> nil) then frmFunctionList.LoadScriptTree(CurrScript.SynEdit.Text); end; procedure TForm1.MenuItemExtensionsClick(Sender: TObject); begin ExtensionsForm.Show; end; procedure TForm1.MenuItemHandbookClick(Sender: TObject); begin OpenURL('http://wizzup.org/static/simba/doc/ps_handbook/'); end; procedure TForm1.MenuItemColourHistoryClick(Sender: TObject); begin MenuItemColourHistory.Checked := not ColourHistoryForm.Visible; if MenuItemColourHistory.Checked then ColourHistoryForm.Show else ColourHistoryForm.Hide; end; procedure TForm1.dlgReplaceFind(Sender: TObject); begin SearchString := dlgReplace.FindText; DoSearch(True, False); end; procedure TForm1.dlgReplaceReplace(Sender: TObject); var SOptions: TSynSearchOptions; P: TPoint; Y: Boolean; Btns: TMsgDlgButtons; procedure Replace; begin CurrScript.SynEdit.SearchReplaceEx(dlgReplace.FindText, dlgReplace.ReplaceText, SOptions + [ssoReplace], P); end; begin Y:= False; SOptions:= []; if(frMatchCase in dlgReplace.Options)then SOptions:= [ssoMatchCase]; if(frWholeWord in dlgReplace.Options)then SOptions+= [ssoWholeWord]; with CurrScript.SynEdit do begin Btns:= [mbYes, mbNo]; if(frReplaceAll in dlgReplace.Options)then Btns+= [mbYesToAll]; if(frEntireScope in dlgReplace.Options)then P:= Classes.Point(0, 0) else P:= CaretXY; while SearchReplaceEx(dlgReplace.FindText, '', SOptions, P) > 0 do begin if(Y)then Replace else case MessageDlg('Replace', Format('Do you want to replace "%s" with "%s"?', [dlgReplace.FindText, dlgReplace.ReplaceText]), mtConfirmation, Btns, 0) of mrYes: Replace; mrYesToAll: begin Replace; Y:= True; end; end; if(not(frReplaceAll in dlgReplace.Options))then exit; P:= CaretXY; end; end; end; procedure TForm1.EditSearchChange(Sender: TObject); begin SearchString :=LabeledEditSearch.Text; DoSearch(false, true); end; procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction); var i : integer; begin Self.SaveFormSettings; for i := Tabs.Count - 1 downto 0 do if not DeleteTab(i,true) then begin; CloseAction := caNone; exit; end; FunctionListTimer.Enabled:= false; FreeAndNil(ExtManager); end; procedure CCFillCore; var t: TMThread; a: TPSScriptExtension; b: TStringList; ms: TMemoryStream; begin if form1.UpdatingFonts then begin mDebugLn('Updating the fonts, thus waiting a bit till we init the OCR.'); while form1.UpdatingFonts do begin if GetCurrentThreadId = MainThreadID then Application.ProcessMessages; sleep(25); end; end; form1.InitalizeTMThread(t); KillThread(t.ThreadID); if (t is TPSThread) then try a := TPSScriptExtension.Create(form1); b := TStringList.Create; ms := TMemoryStream.Create; try with TPSThread(t).PSScript do begin a.OnCompile := OnCompile; a.OnCompImport := OnCompImport; a.OnExecImport := OnExecImport; end; a.GetValueDefs(b); SetLength(CoreBuffer, 1); CoreBuffer[0] := TCodeInsight.Create; with CoreBuffer[0] do begin OnMessage := @form1.OnCCMessage; b.SaveToStream(ms); Run(ms, nil, -1, True); FileName := '!PSCORE!'; end; finally b.Free; a.Free; end; finally //KillThread(t.ThreadID); t.Free; end; end; procedure TForm1.FormCreate(Sender: TObject); var FillThread : TProcThread; begin Randomize; DecimalSeparator := '.'; MainDir:= ExtractFileDir(Application.ExeName); RecentFiles := TStringList.Create; SimbaSettingsFile := MainDir + DS + 'settings.xml'; //AutoCompletionStart := Point(-1, -1); CodeCompletionForm := TAutoCompletePopup.Create(Self); CodeCompletionForm.InsertProc := @OnCompleteCode; ParamHint := TParamHint.Create(self); {$ifdef MSWindows} ConsoleVisible := True; PrevWndProc := Windows.WNDPROC(GetWindowLong(self.handle,GWL_WNDPROC)); SetWindowLong(Self.Handle,GWL_WNDPROC,PtrInt(@WndCallback)); if not RegisterHotkey(Self.Handle,0,MOD_CONTROL or MOD_ALT,VK_S) then mDebugLn('Unable to register ctrl + alt + s as global hotkey'); {$else} TT_Console.Visible:= false; {$endif} InitmDebug; Self.OnScriptStart:= @ScriptStartEvent; FillThread := TProcThread.Create(true); FillThread.FreeOnTerminate:= True; FillThread.NormalProc:= @CCFillCore; UpdateTimer.OnTimer:= @UpdateTimerCheck; Application.CreateForm(TSimbaUpdateForm, SimbaUpdateForm); if FileExists(SimbaSettingsFile) then begin Application.CreateForm(TSettingsForm,SettingsForm); Self.LoadFormSettings; end else begin Application.CreateForm(TSettingsForm,SettingsForm); Self.CreateDefaultEnvironment; FillThread.StartWait:= 250; end; //Show close buttons @ tabs PageControl1.Options:=PageControl1.Options+[nboShowCloseButtons]; PageControl1.OnCloseTabClicked:=ActionCloseTab.OnExecute; Tabs := TList.Create; AddTab;//Give it alteast 1 tab ;-). Manager := TIOManager.Create; //No need to load plugins for the Global manager Picker := TMColorPicker.Create(Manager); Picker.OnPick:=@PickerPick; Selector := TMWindowSelector.Create(Manager); { For writeln } SetLength(DebugStream, 0); DebugCriticalSection := syncobjs.TCriticalSection.Create; {$ifdef mswindows} DebugTimer.Enabled:= false; {$endif} Application.QueueAsyncCall(@RefreshTabSender,0); {$ifdef mswindows} if FileExists(Application.ExeName+'_old_') then begin mDebugLn('We still have an out-dated exe file in the dir, lets remove!'); mDebugLn(format('Sucesfully deleted the file? %s',[BoolToStr(DeleteFile(PChar(Application.ExeName + '_old_')),true)])); end; SetConsoleCtrlHandler(@ConsoleHandler,true); {$endif} frmFunctionList.OnEndDock:= @frmFunctionList.FrameEndDock; FirstRun := true;//Our next run is the first run. HandleParameters; TT_Update.Visible:= false; //Fill the codeinsight buffer FillThread.Resume; //Load the extensions LoadExtensions; end; procedure TForm1.FormDestroy(Sender: TObject); var i : integer; begin for i := Tabs.Count - 1 downto 0 do TMufasaTab(Tabs[i]).Free; for i := 0 to high(RecentFileItems) do RecentFileItems[i].Free; if ExtManager <> nil then ExtManager.free; Tabs.free; Selector.Free; Picker.Free; Manager.Free; PluginsGlob.Free; SetLength(DebugStream, 0); RecentFiles.Free; DebugCriticalSection.Free; ParamHint.Free; {$ifdef MSWindows} if not UnRegisterHotkey(Self.Handle,0) then mDebugLn('Unable to unregister ctrl + alt + s as global hotkey'); {$endif} end; procedure TForm1.FormShortCuts(var Msg: TLMKey; var Handled: Boolean); begin SetEditActions; Handled := ActionList.IsShortCut(Msg); end; procedure TForm1.LabeledEditSearchEnter(Sender: TObject); begin SearchStart := CurrScript.SynEdit.LogicalCaretXY; with CurrScript.SynEdit do begin UseIncrementalColor:= true; MarkupByClass[TSynEditMarkupHighlightAllCaret].TempDisable end; end; procedure TForm1.LabeledEditSearchExit(Sender: TObject); begin if not CheckBoxMatchCase.MouseEntered then RefreshTab; end; procedure TForm1.LabeledEditSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if (ssCtrl in Shift) and (key = vk_f) then begin; LabeledEditSearch.SelectAll; end else if key = VK_ESCAPE then begin CloseFindPanel; key := 0; end; end; procedure TForm1.LabeledEditSearchKeyPress(Sender: TObject; var Key: char); begin if key = #13 then begin; SearchString:= LabeledEditSearch.Text; DoSearch(true, true); key := #0; // LabeledEditSearch.SelStart:= Length(LabeledEditSearch.Text); end; end; procedure TForm1.MenuEditClick(Sender: TObject); begin SetEditActions; end; procedure TForm1.MenuItemAboutClick(Sender: TObject); begin AboutForm.ShowModal; end; procedure TForm1.MenuItemCloseTabsClick(Sender: TObject); begin Self.CloseTabs; end; procedure TForm1.MenuItemDebugImageClick(Sender: TObject); begin MenuItemDebugImage.Checked := not DebugImgForm.Visible; if MenuItemDebugImage.Checked then DebugImgForm.Show else DebugImgForm.Hide; end; procedure TForm1.MenuItemExportHTMLClick(Sender: TObject); var SynExporterHTML : TSynExporterHTML; begin; SynExporterHTML := TSynExporterHTML.Create(nil); SynExporterHTML.Highlighter := CurrHighlighter; SynExporterHTML.ExportAsText:= True; with TSaveDialog.Create(nil) do try Filter:= 'HTML Files (*.html;*.htm)|*.html;*.htm|All files(*.*)|*.*'; Options:= [ofOverwritePrompt,ofEnableSizing]; DefaultExt:= 'html'; if Execute then begin if CurrScript.ScriptName <> '' then SynExporterHTML.Title:= 'Simba - ' + CurrScript.ScriptName else SynExporterHTML.Title:= 'Cogat - Untitled'; SynExporterHTML.ExportAll(CurrScript.SynEdit.Lines); SynExporterHTML.SaveToFile(FileName); end; finally free; SynExporterHTML.Free; end; end; procedure formWritelnEx(S: String); begin Form1.Memo1.Lines.Add(s); end; function GetMethodName( Decl : string; PlusNextChar : boolean) : string; var I : integer; ii : integer; begin; I := pos(' ',Decl) + 1; for ii := i to Length(decl) do begin; if (Decl[ii] = '(') or (Decl[ii] = ';') then begin; if PlusNextChar then result := result + decl[ii]; exit; end; if (Decl[ii] = ' ') or (Decl[ii] = ':') then begin; if PlusNextChar then result := result + ' '; exit; end; result := result + decl[ii]; end; //We made it out of the loop.. This is a method without ';' we might wanne add that! if PlusNextChar then result := result + ';'; end; procedure TForm1.MenuitemFillFunctionListClick(Sender: TObject); var Methods : TExpMethodArr; LastSection : string; Sections : TStringList; Nodes : array of TTreeNode; i : integer; Index : integer; TempNode : TTreeNode; Temp2Node : TTreeNode; Tree : TTreeView; begin SetLength(nodes,0); if frmFunctionList.FunctionList.Items.Count = 0 then begin; Methods := TMThread.GetExportedMethods; Tree := frmFunctionList.FunctionList; Tree.Items.Clear; Sections := TStringList.Create; LastSection := ''; frmFunctionList.ScriptNode := Tree.Items.Add(nil,'Script'); frmFunctionList.IncludesNode := Tree.Items.Add(nil,'Includes'); for i := 0 to high(Methods) do begin; if Methods[i].Section <> LastSection then begin; LastSection := Methods[i].Section; Index := Sections.IndexOf(LastSection); if Index <> -1 then TempNode := Nodes[index] else begin TempNode := Tree.Items.Add(nil,LastSection); Sections.Add(LastSection); setlength(nodes,length(nodes)+1); nodes[high(nodes)] := tempNode; end; end; Temp2Node := Tree.Items.AddChild(Tempnode,GetMethodName(Methods[i].FuncDecl,false)); Temp2Node.Data := GetMem(SizeOf(TMethodInfo)); FillChar(PMethodInfo(Temp2Node.Data)^,SizeOf(TMethodInfo),0); with PMethodInfo(Temp2Node.Data)^ do begin MethodStr:= strnew(PChar(Methods[i].FuncDecl)); BeginPos:= -1; end; end; Sections.free; end; if CurrScript <> nil then frmFunctionList.LoadScriptTree(CurrScript.SynEdit.Text); end; procedure TForm1.MenuItemHideClick(Sender: TObject); begin if Self.Visible = false then MenuItemShowClick(sender) else Self.hide; end; procedure TForm1.MenuItemReportBugClick(Sender: TObject); begin OpenURL('http://mufasa.villavu.com/mantis/bug_report_page.php'); end; procedure TForm1.MenuItemSettingsButtonClick(Sender: TObject); begin SettingsForm.ShowModal; end; procedure TForm1.MenuItemShowClick(Sender: TObject); begin Self.Show; Self.WindowState := wsNormal; end; procedure TForm1.MenuItemTabCloseClick(Sender: TObject); begin DeleteTab(PopupTab,false); end; procedure TForm1.MenuItemTabCloseOthersClick(Sender: TObject); begin CloseTabs(PopupTab); end; procedure TForm1.MenuItemFunctionListClick(Sender: TObject); begin FunctionListShown(not MenuItemFunctionList.Checked); end; function TForm1.GetSimbaNews: String; var t: TDownloadThread; begin t := TDownloadThread.Create(true); t.InputURL:=LoadSettingDef('Settings/News/URL', 'http://simba.villavu.com/bin/news'); t.Resume; while not t.done do begin Application.ProcessMessages; Sleep(50); end; Exit(t.ResultStr); end; procedure TForm1.SetExtPath(const AValue: string); begin SetSetting('Settings/Extensions/Path',AValue,true); end; procedure TForm1.NewsTimerTimer(Sender: TObject); var s: String; News : TStringList; {Need it for correct EOL stuff} begin NewsTimer.Enabled:=False; s := GetSimbaNews; News := TStringList.Create; News.Text:= s; Memo1.Lines.AddStrings(News); Memo1.Lines.add(''); News.free; end; procedure TForm1.OnLinePSScript(Sender: TObject); begin {$IFDEF ProcessMessages} Application.ProcessMessages; //Don't think that this is neccesary though {$ENDIF} end; procedure TForm1.ButtonPickClick(Sender: TObject); var c, x, y: Integer; cobj: TColourPickerObject; begin Picker.Pick(c, x, y); cobj := TColourPickerObject.Create(c, Classes.Point(x,y), ''); if lowercase(LoadSettingDef('Settings/ColourPicker/ShowHistoryOnPick', 'True')) = 'true' then begin ColourHistoryForm.AddColObj(cobj, true); ColourHistoryForm.Show; end; FormWritelnEx('Picked colour: ' + inttostr(c) + ' at (' + inttostr(x) + ', ' + inttostr(y) + ')'); end; procedure TForm1.ButtonSelectorDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Manager.SetTarget(Selector.Drag); FormWritelnEx('New window: ' + IntToStr(Selector.LastPick)); end; procedure TForm1.NoTray(Sender: TObject); begin if Not Form1.IsVisible then Self.MenuItemShowClick(Sender) else Form1.Hide; end; procedure TForm1.PageControl1Change(Sender: TObject); begin RefreshTab(); end; procedure TForm1.ButtonTrayClick(Sender: TObject); begin self.hide; end; procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean ); begin LastTab:= PageControl1.TabIndex; end; procedure TForm1.PageControl1ContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); begin PopupTab := PageControl1.TabIndexAtClientPos(MousePos); if PopupTab = -1 then begin mDebugLn('We couldn''t find which tab you clicked on, closing the popup'); Handled := true; end; end; procedure TForm1.PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer); var NewPos : integer; OldPos : integer; begin if sender <> PageControl1 then exit; NewPos := PageControl1.TabIndexAtClientPos(Classes.Point(x,y)); OldPos := PageControl1.TabIndex; if (NewPos <> OldPos) and (NewPos <> -1) then begin; Tabs.Move(OldPos,NewPos); PageControl1.Pages[OldPos].TabIndex:= NewPos; end; end; procedure TForm1.PageControl1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var Pos: Integer; begin Pos := PageControl1.TabIndexAtClientPos(Classes.Point(x,y)); Accept := (Pos <> PageControl1.TabIndex) and (Pos <> -1); end; procedure TForm1.PageControl1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if(Button = mbLeft)then begin {$ifdef linux} PageControl1.TabIndex := PageControl1.TabIndexAtClientPos(Point(x,y)); {$endif} PageControl1.BeginDrag(false, 10); end; end; procedure TForm1.PageControl1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if(Button = mbMiddle) and (not(PageControl1.Dragging))then if(PageControl1.TabIndexAtClientPos(Classes.Point(x,y)) <> -1)then DeleteTab(PageControl1.TabIndexAtClientPos(Classes.Point(x,y)), False); end; procedure TForm1.PickerPick(Sender: TObject; const Colour, colourx, coloury: integer); var Args : TVariantArray; begin SetLength(args,3); Args[0] := Colour; Args[1] := Colourx; Args[2] := Coloury; ExtManager.HandleHook(EventHooks[SExt_OnColourPick].HookName,Args); end; procedure TForm1.PopupItemFindClick(Sender: TObject); begin SearchString := CurrScript.SynEdit.SelText; ActionFindNextExecute(ScriptPopup); end; function TForm1.GetScriptState: TScriptState; begin result := CurrScript.FScriptState; end; function TForm1.GetShowHintAuto: boolean; begin Result := LowerCase(LoadSettingDef('Settings/CodeHints/ShowAutomatically','True')) = 'true'; end; procedure TForm1.SetFontPath(const AValue: String); begin SetSetting('Settings/Fonts/Path',AValue,true); end; function TForm1.GetFontPath: String; begin Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Fonts/Path', ExpandFileName(MainDir+DS+'Fonts' + DS))); end; function TForm1.GetExtPath: string; begin result :=IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Extensions/Path', ExpandFileName(MainDir+DS+'Extensions' + DS))); end; function TForm1.GetHighlighter: TSynCustomHighlighter; begin if lowercase(LoadSettingDef('Settings/SourceEditor/LazColors','True')) = 'true' then result := LazHighlighter else result := SCARHighlighter; end; function TForm1.GetIncludePath: String; begin Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Includes/Path', ExpandFileName(MainDir+DS+'Includes' + DS))); end; function TForm1.GetPluginPath: string; begin Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Plugins/Path', ExpandFileName(MainDir+DS+'Plugins' + DS))); end; procedure TForm1.SetIncludePath(const AValue: String); begin SetSetting('Settings/Includes/Path',AValue,true); end; procedure TForm1.SetPluginPath(const AValue: string); begin SetSetting('Settings/Plugins/Path',AValue,true); end; procedure TForm1.SetScriptState(const State: TScriptState); begin CurrScript.FScriptState:= State; with Self.StatusBar.panels[Panel_State] do case state of ss_Running : begin Text := 'Running'; TB_Run.Enabled:= False; {$ifdef MSWindows}TB_Pause.Enabled:= True; {$endif} TB_Stop.ImageIndex := Image_Stop; TB_Stop.Enabled:= True; TrayPlay.Checked := True; TrayPlay.Enabled := False; {$ifdef MSWindows}TrayPause.Checked := false; TrayPause.Enabled := True;{$endif} TrayStop.Enabled:= True; TrayStop.Checked:= False; end; ss_Paused : begin Text := 'Paused'; TB_Run.Enabled:= True; {$ifdef MSWindows}TB_Pause.Enabled:= True; {$endif} TB_Stop.ImageIndex := Image_Stop; TB_Stop.Enabled:= True; TrayPlay.Checked := false; TrayPlay.Enabled := True; {$ifdef MSWindows}TrayPause.Checked := True; TrayPause.Enabled := True;{$endif} TrayStop.Enabled:= True; TrayStop.Checked:= False; end; ss_Stopping: begin Text := 'Stopping';TB_Run.Enabled:= False; TB_Pause.Enabled:= False; TB_Stop.Enabled:= True; TB_Stop.ImageIndex := Image_Terminate; TrayPlay.Checked := False; TrayPlay.Enabled := False; {$ifdef MSWindows}TrayPause.Checked := false; TrayPause.Enabled := False;{$endif} TrayStop.Enabled:= True; TrayStop.Checked:= True; end; ss_None : begin Text := 'Done'; TB_Run.Enabled:= True; TB_Pause.Enabled:= False; TB_Stop.Enabled:= False; TB_Stop.ImageIndex := Image_Stop; TrayPlay.Checked := false; TrayPlay.Enabled := True; {$ifdef MSWindows}TrayPause.Checked := false; TrayPause.Enabled := False;{$endif} TrayStop.Enabled:= false; TrayStop.Checked:= False; end; end; end; function TForm1.LoadSettingDef(const Key,Def: string): string; begin result := SettingsForm.Settings.GetKeyValueDefLoad(Key,def,SimbaSettingsFile); end; function TForm1.CreateSetting(const Key,Value: string): string; begin result := SettingsForm.Settings.GetKeyValueDef(Key,value); end; procedure TForm1.SetSetting(const key,Value: string; save : boolean); begin //Creates the setting if needed SettingsForm.Settings.SetKeyValue(key,value); if save then SettingsForm.Settings.SaveToXML(SimbaSettingsFile); end; function TForm1.SettingExtists(const key: string): boolean; begin result :=SettingsForm.Settings.KeyExists(key); end; procedure TForm1.FontUpdate; var CurrVersion : integer; LatestVersion : integer; FontDownload : TDownloadThread; Stream : TStringStream; Decompressed : TMemoryStream; begin if UpdatingFonts then exit; UpdatingFonts := True; CurrVersion := StrToIntDef(LoadSettingDef('Settings/Fonts/Version','-1'),-1); LatestVersion := SimbaUpdateForm.GetLatestFontVersion; if LatestVersion > CurrVersion then begin; formWriteln(format('New fonts available. Current version: %d. Latest version: %d',[CurrVersion,LatestVersion])); FontDownload := TDownloadThread.Create(True); FontDownload.InputURL:= LoadSettingDef('Settings/Fonts/UpdateLink',FontURL + 'Fonts.tar.bz2'); FontDownload.resume; while FontDownload.Done = false do begin Application.ProcessMessages; Sleep(25); end; Stream := TStringStream.Create(FontDownload.ResultStr); try Decompressed := DecompressBZip2(stream); if UnTar(decompressed, FontPath,true) then begin; FormWriteln('Succesfully installed the new fonts!'); SetSetting('Settings/Fonts/Version',IntToStr(LatestVersion),true); if Assigned(self.OCR_Fonts) then self.OCR_Fonts.Free; Self.OCR_Fonts := TMOCR.Create(nil); OCR_Fonts.InitTOCR(fontPath); end; Decompressed.free; finally Stream.Free; FontDownload.Free; end; end; UpdatingFonts := False; end; procedure TForm1.ScriptStartEvent(Sender: TObject; var Script: string; var Continue: boolean); begin ScriptStartData.Sender:=Sender; ScriptStartData.Script:= @Script; ScriptStartData.Continue:= @Continue; TThread.Synchronize(nil,@HandleScriptStartData); end; procedure TForm1.SetShowHintAuto(const AValue: boolean); begin SetSetting('Settings/CodeHints/ShowAutomatically',Booltostr(AValue,true)); end; {$ifdef mswindows} function GetConsoleWindow: HWND; stdcall; external kernel32 name 'GetConsoleWindow'; procedure TForm1.ShowConsole(ShowIt: boolean); var ProcessId : DWOrd; begin if ShowIt = ConsoleVisible then Exit; //Check if the console is ours (if it's not, do not hide it!! GetWindowThreadProcessId(GetConsoleWindow,ProcessId); if ProcessId = GetCurrentProcessId then begin if showit then ShowWindow(GetConsoleWindow,SW_SHOWNA) else ShowWindow(GetConsoleWindow,sw_hide); ConsoleVisible:= ShowIt; end else Writeln('You cannot hide the window, since its not created by Simba'); end; {$endif} procedure TForm1.FunctionListShown(ShowIt: boolean); begin with MenuItemFunctionList, frmFunctionList do begin Checked := ShowIt; if(Checked)then begin if FunctionList.Items.Count = 0 then MenuitemFillFunctionListClick(nil); FrameEndDock(frmFunctionList,frmFunctionList.Parent,0,0);//Set the label correctly if(frmFunctionList.Parent is TPanel)then begin SplitterFunctionList.Show; frmFunctionList.Show; end else frmFunctionList.Parent.Show; if Self.Visible then if editSearchList.CanFocus then editSearchList.SetFocus; //Lets load up this Script tree! if CurrScript <> nil then frmFunctionList.LoadScriptTree(CurrScript.SynEdit.text); end else begin if(frmFunctionList.Parent is TPanel)then frmFunctionList.Hide else frmFunctionList.Parent.Hide; SplitterFunctionList.Hide; end; end; end; procedure TForm1.SafeCallThread; var thread: TMThread; LocalCopy : TSyncInfo; begin LocalCopy := CurrentSyncInfo; mDebugLn('Executing : ' + LocalCopy.MethodName); thread:= TMThread(LocalCopy.OldThread); mmlpsthread.CurrThread:= thread; try if thread is TPSThread then begin with TPSThread(thread).PSScript do begin OnLine:=@OnLinePSScript; LocalCopy.Res^:= Exec.RunProcPVar(LocalCopy.V^,Exec.GetProc(LocalCopy.MethodName)); Online := nil; end; end else begin raise Exception.Create('ThreadSafeCall not implemented on this client'); end; finally mmlpsthread.CurrThread:= nil; end; end; function TForm1.OpenScript: boolean; var OpenInNewTab : boolean; begin Result := False; OpenInNewTab:= (LowerCase(LoadSettingDef('Settings/Tabs/OpenScriptInNewTab','True')) = 'true'); if not OpenInNewTab then if CanExitOrOpen = false then Exit; with TOpenDialog.Create(nil) do try Filter:= 'Simba Files|*.simba;*.simb;*.cogat;*.mufa;*.txt;*.' +LoadSettingDef('Settings/Extensions/FileExtension','sex')+ '|Any files|*.*'; if Execute then if FileExists(filename) then result := LoadScriptFile(filename); finally Free; end; end; function TForm1.LoadScriptFile(filename: string; AlwaysOpenInNewTab: boolean; CheckOtherTabs : boolean ): boolean; var OpenInNewTab : boolean; CheckTabsFirst : boolean; Tab : integer; begin if AlwaysOpenInNewTab then OpenInNewTab := true else OpenInNewTab:= (LowerCase(LoadSettingDef('Settings/Tabs/OpenScriptInNewTab','True')) = 'true'); if CheckOtherTabs then CheckTabsFirst := True else CheckTabsFirst := (Lowercase(LoadSettingDef('Settings/Tabs/CheckTabsBeforeOpen','True')) = 'true'); if FileExists(FileName) then begin; if CheckTabsFirst then begin; Tab := FindTab(filename); if tab <> -1 then begin TMufasaTab(Tabs[tab]).ScriptFrame.MakeActiveScriptFrame; exit(true); end; end; if OpenInNewTab and (CurrScript.SynEdit.Text <> CurrScript.ScriptDefault) then //Add la tab! self.addtab; with CurrScript do begin filename := SetDirSeparators(filename); SynEdit.Lines.LoadFromFile(FileName); StartText := SynEdit.Lines.text; ScriptName:= ExtractFileNameOnly(filename); mDebugLn('Script name will be: ' + ScriptName); ScriptFile:= FileName; ScriptChanged := false; AddRecentFile(filename); RefreshTab(); Result := True; end; end; end; function TForm1.SaveCurrentScript: boolean; begin with CurrScript do begin Result := (ScriptFile <> ''); if Result then begin try SynEdit.Lines.SaveToFile(ScriptFile); except mDebugLn('Cannot save the file. Try specifying a different location.'); result := SaveCurrentScriptAs; exit; end; OnSaveScript(scriptfile); end else result := SaveCurrentScriptAs; end; end; function TForm1.SaveCurrentScriptAs: boolean; var ScriptFile : string; begin Result := false; with TSaveDialog.Create(nil) do try filter := 'Simba Files|*.simba;*.simb;*.cogat;*.mufa;*.txt;*.' + LoadSettingDef('Settings/Extensions/FileExtension','sex')+ '|Any files|*.*'; if Execute then begin; if ExtractFileExt(FileName) = '' then begin; ScriptFile := FileName + '.simba'; end else ScriptFile := FileName; CurrScript.SynEdit.Lines.SaveToFile(ScriptFile); OnSaveScript(scriptfile); end; finally free; end; end; function TForm1.CanExitOrOpen: boolean; begin; Self.Enabled := False;//We HAVE to answer the popup Result := True; if ScriptState <> ss_None then begin if ScriptState <> ss_Stopping then begin result := False; case MessageDlg('Script is still running', 'Do you want to stop the script?', mtConfirmation, mbYesNoCancel, 0) of mrYes: StopScript; end; end else case MessageDlg('Script is stopping.', 'Do you want to terminate the script?', mtConfirmation, mbYesNoCancel, 0) of mrNo, mrCancel: Result := false; mrYes: StopScript; end; end; if Result and (CurrScript.StartText <> CurrScript.SynEdit.Lines.text) then begin case MessageDlg('Script has been modified.', 'Do you want to save the script?', mtConfirmation, mbYesNoCancel, 0) of mrCancel : Result := False; mrYes : Result := SaveCurrentScript; end; end; Self.Enabled := True; if Self.CanFocus then Self.SetFocus; end; function TForm1.ClearScript: boolean; begin result := false; if CanExitOrOpen then begin; result := true; CurrTab.Clear; RefreshTab(); end; end; { TMufasaTab } procedure TMufasaTab.Clear; begin ScriptFrame.Free; ScriptFrame := TScriptFrame.Create(Tabsheet); ScriptFrame.Parent := Tabsheet; ScriptFrame.Align:= alClient; end; constructor TMufasaTab.Create(Page: TPageControl); begin inherited Create; PageCtrl := Page; Tabsheet := TTabSheet.Create(Page); Tabsheet.PageControl := Page; ScriptFrame := TScriptFrame.Create(Tabsheet); ScriptFrame.Parent := Tabsheet; ScriptFrame.Align := alClient; end; destructor TMufasaTab.Destroy; begin ScriptFrame.Free; TabSheet.Free; inherited Destroy; end; initialization {$R *.lfm} end.