├── .gitignore ├── LICENSE ├── README.md ├── lainzcs.lpi ├── lainzcs.lpr ├── lcs_package ├── lcs_application.pas ├── lcs_crypto.pas ├── lcs_debug.pas ├── lcs_debugform.lfm ├── lcs_debugform.pas ├── lcs_dialog.pas ├── lcs_dialog_input.lfm ├── lcs_dialog_input.pas ├── lcs_file.pas ├── lcs_folder.pas ├── lcs_ftpwi.pas ├── lcs_http.pas ├── lcs_inifile.pas ├── lcs_package.lpk ├── lcs_package.pas ├── lcs_registerall.pas ├── lcs_registry.pas ├── lcs_string.pas ├── lcs_table.pas ├── lcs_textfile.pas ├── lcs_zip.pas ├── lua53.pas └── synhighlighterlua.pas ├── scripts ├── 7zip.lua └── exitscript.lua ├── uhighdpi.pas ├── umain.lfm ├── umain.pas ├── ustack.lfm ├── ustack.pas ├── uwatches.lfm └── uwatches.pas /.gitignore: -------------------------------------------------------------------------------- 1 | *.bak 2 | *.dbg 3 | *.exe 4 | *.lps 5 | *.res 6 | backup/* 7 | lib 8 | /lua53.dll 9 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | 9 | This version of the GNU Lesser General Public License incorporates 10 | the terms and conditions of version 3 of the GNU General Public 11 | License, supplemented by the additional permissions listed below. 12 | 13 | 0. Additional Definitions. 14 | 15 | As used herein, "this License" refers to version 3 of the GNU Lesser 16 | General Public License, and the "GNU GPL" refers to version 3 of the GNU 17 | General Public License. 18 | 19 | "The Library" refers to a covered work governed by this License, 20 | other than an Application or a Combined Work as defined below. 21 | 22 | An "Application" is any work that makes use of an interface provided 23 | by the Library, but which is not otherwise based on the Library. 24 | Defining a subclass of a class defined by the Library is deemed a mode 25 | of using an interface provided by the Library. 26 | 27 | A "Combined Work" is a work produced by combining or linking an 28 | Application with the Library. The particular version of the Library 29 | with which the Combined Work was made is also called the "Linked 30 | Version". 31 | 32 | The "Minimal Corresponding Source" for a Combined Work means the 33 | Corresponding Source for the Combined Work, excluding any source code 34 | for portions of the Combined Work that, considered in isolation, are 35 | based on the Application, and not on the Linked Version. 36 | 37 | The "Corresponding Application Code" for a Combined Work means the 38 | object code and/or source code for the Application, including any data 39 | and utility programs needed for reproducing the Combined Work from the 40 | Application, but excluding the System Libraries of the Combined Work. 41 | 42 | 1. Exception to Section 3 of the GNU GPL. 43 | 44 | You may convey a covered work under sections 3 and 4 of this License 45 | without being bound by section 3 of the GNU GPL. 46 | 47 | 2. Conveying Modified Versions. 48 | 49 | If you modify a copy of the Library, and, in your modifications, a 50 | facility refers to a function or data to be supplied by an Application 51 | that uses the facility (other than as an argument passed when the 52 | facility is invoked), then you may convey a copy of the modified 53 | version: 54 | 55 | a) under this License, provided that you make a good faith effort to 56 | ensure that, in the event an Application does not supply the 57 | function or data, the facility still operates, and performs 58 | whatever part of its purpose remains meaningful, or 59 | 60 | b) under the GNU GPL, with none of the additional permissions of 61 | this License applicable to that copy. 62 | 63 | 3. Object Code Incorporating Material from Library Header Files. 64 | 65 | The object code form of an Application may incorporate material from 66 | a header file that is part of the Library. You may convey such object 67 | code under terms of your choice, provided that, if the incorporated 68 | material is not limited to numerical parameters, data structure 69 | layouts and accessors, or small macros, inline functions and templates 70 | (ten or fewer lines in length), you do both of the following: 71 | 72 | a) Give prominent notice with each copy of the object code that the 73 | Library is used in it and that the Library and its use are 74 | covered by this License. 75 | 76 | b) Accompany the object code with a copy of the GNU GPL and this license 77 | document. 78 | 79 | 4. Combined Works. 80 | 81 | You may convey a Combined Work under terms of your choice that, 82 | taken together, effectively do not restrict modification of the 83 | portions of the Library contained in the Combined Work and reverse 84 | engineering for debugging such modifications, if you also do each of 85 | the following: 86 | 87 | a) Give prominent notice with each copy of the Combined Work that 88 | the Library is used in it and that the Library and its use are 89 | covered by this License. 90 | 91 | b) Accompany the Combined Work with a copy of the GNU GPL and this license 92 | document. 93 | 94 | c) For a Combined Work that displays copyright notices during 95 | execution, include the copyright notice for the Library among 96 | these notices, as well as a reference directing the user to the 97 | copies of the GNU GPL and this license document. 98 | 99 | d) Do one of the following: 100 | 101 | 0) Convey the Minimal Corresponding Source under the terms of this 102 | License, and the Corresponding Application Code in a form 103 | suitable for, and under terms that permit, the user to 104 | recombine or relink the Application with a modified version of 105 | the Linked Version to produce a modified Combined Work, in the 106 | manner specified by section 6 of the GNU GPL for conveying 107 | Corresponding Source. 108 | 109 | 1) Use a suitable shared library mechanism for linking with the 110 | Library. A suitable mechanism is one that (a) uses at run time 111 | a copy of the Library already present on the user's computer 112 | system, and (b) will operate properly with a modified version 113 | of the Library that is interface-compatible with the Linked 114 | Version. 115 | 116 | e) Provide Installation Information, but only if you would otherwise 117 | be required to provide such information under section 6 of the 118 | GNU GPL, and only to the extent that such information is 119 | necessary to install and execute a modified version of the 120 | Combined Work produced by recombining or relinking the 121 | Application with a modified version of the Linked Version. (If 122 | you use option 4d0, the Installation Information must accompany 123 | the Minimal Corresponding Source and Corresponding Application 124 | Code. If you use option 4d1, you must provide the Installation 125 | Information in the manner specified by section 6 of the GNU GPL 126 | for conveying Corresponding Source.) 127 | 128 | 5. Combined Libraries. 129 | 130 | You may place library facilities that are a work based on the 131 | Library side by side in a single library together with other library 132 | facilities that are not Applications and are not covered by this 133 | License, and convey such a combined library under terms of your 134 | choice, if you do both of the following: 135 | 136 | a) Accompany the combined library with a copy of the same work based 137 | on the Library, uncombined with any other library facilities, 138 | conveyed under the terms of this License. 139 | 140 | b) Give prominent notice with the combined library that part of it 141 | is a work based on the Library, and explaining where to find the 142 | accompanying uncombined form of the same work. 143 | 144 | 6. Revised Versions of the GNU Lesser General Public License. 145 | 146 | The Free Software Foundation may publish revised and/or new versions 147 | of the GNU Lesser General Public License from time to time. Such new 148 | versions will be similar in spirit to the present version, but may 149 | differ in detail to address new problems or concerns. 150 | 151 | Each version is given a distinguishing version number. If the 152 | Library as you received it specifies that a certain numbered version 153 | of the GNU Lesser General Public License "or any later version" 154 | applies to it, you have the option of following the terms and 155 | conditions either of that published version or of any later version 156 | published by the Free Software Foundation. If the Library as you 157 | received it does not specify a version number of the GNU Lesser 158 | General Public License, you may choose any version of the GNU Lesser 159 | General Public License ever published by the Free Software Foundation. 160 | 161 | If the Library as you received it specifies that a proxy can decide 162 | whether future versions of the GNU Lesser General Public License shall 163 | apply, that proxy's public statement of acceptance of any version is 164 | permanent authorization for you to choose that version for the 165 | Library. 166 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Lainz Code Studio 2 | Beginners programming tool 3 | 4 | # Welcome 5 | This tool is intended as learning the basics of programming with LUA that's the first language I ever used. 6 | 7 | # Download 8 | https://github.com/lainz/lainzcodestudio/releases 9 | 10 | # Where to find help 11 | [Documentation](https://github.com/lainz/lainzcodestudio/wiki). 12 | 13 | # Compiling 14 | This is intended for advanced users that want to learn more: A big step is learning a new language, Free Pascal is the second language I've used and still using. 15 | 16 | * You need Lazarus to compile LCS from https://www.lazarus-ide.org/ 17 | * Download and install Synapse from http://www.ararat.cz/synapse/doku.php/download 18 | * Download and install LCS package 19 | * Once everything is installed, open the .lpr file with Lazarus 20 | * Copy the LUA .dll file into the same folder where the compiled .exe file is located 21 | 22 | # License 23 | Modified LGPL (also referred to as FPC modified LGPL) is the Library GNU General Public License with the following modification: 24 | As a special exception, the copyright holders of this library give you permission to link this library with independent modules to produce an executable, regardless of the license terms of these independent modules, and to copy and distribute the resulting executable under terms of your choice, provided that you also meet, for each linked independent module, the terms and conditions of the license of that module. An independent module is a module which is not derived from or based on this library. If you modify this library, you may extend this exception to your version of the library, but you are not obligated to do so. If you do not wish to do so, delete this exception statement from your version. 25 | -------------------------------------------------------------------------------- /lainzcs.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | <ResourceType Value="res"/> 11 | <UseXPManifest Value="True"/> 12 | <XPManifest> 13 | <DpiAware Value="True"/> 14 | </XPManifest> 15 | </General> 16 | <i18n> 17 | <EnableI18N LFM="False"/> 18 | </i18n> 19 | <BuildModes Count="2"> 20 | <Item1 Name="Debug x86" Default="True"/> 21 | <Item2 Name="Release x86"> 22 | <CompilerOptions> 23 | <Version Value="11"/> 24 | <PathDelim Value="\"/> 25 | <Target> 26 | <Filename Value="lainzcs"/> 27 | </Target> 28 | <SearchPaths> 29 | <IncludeFiles Value="$(ProjOutDir)"/> 30 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 31 | </SearchPaths> 32 | <CodeGeneration> 33 | <SmartLinkUnit Value="True"/> 34 | <TargetCPU Value="i386"/> 35 | <Optimizations> 36 | <OptimizationLevel Value="3"/> 37 | </Optimizations> 38 | </CodeGeneration> 39 | <Linking> 40 | <Debugging> 41 | <GenerateDebugInfo Value="False"/> 42 | </Debugging> 43 | <LinkSmart Value="True"/> 44 | <Options> 45 | <Win32> 46 | <GraphicApplication Value="True"/> 47 | </Win32> 48 | </Options> 49 | </Linking> 50 | </CompilerOptions> 51 | </Item2> 52 | </BuildModes> 53 | <PublishOptions> 54 | <Version Value="2"/> 55 | </PublishOptions> 56 | <RunParams> 57 | <FormatVersion Value="2"/> 58 | <Modes Count="1"> 59 | <Mode0 Name="default"/> 60 | </Modes> 61 | </RunParams> 62 | <RequiredPackages Count="3"> 63 | <Item1> 64 | <PackageName Value="lcs_package"/> 65 | </Item1> 66 | <Item2> 67 | <PackageName Value="SynEdit"/> 68 | </Item2> 69 | <Item3> 70 | <PackageName Value="LCL"/> 71 | </Item3> 72 | </RequiredPackages> 73 | <Units Count="5"> 74 | <Unit0> 75 | <Filename Value="lainzcs.lpr"/> 76 | <IsPartOfProject Value="True"/> 77 | </Unit0> 78 | <Unit1> 79 | <Filename Value="umain.pas"/> 80 | <IsPartOfProject Value="True"/> 81 | <ComponentName Value="frmMain"/> 82 | <HasResources Value="True"/> 83 | <ResourceBaseClass Value="Form"/> 84 | </Unit1> 85 | <Unit2> 86 | <Filename Value="uhighdpi.pas"/> 87 | <IsPartOfProject Value="True"/> 88 | </Unit2> 89 | <Unit3> 90 | <Filename Value="ustack.pas"/> 91 | <IsPartOfProject Value="True"/> 92 | <ComponentName Value="frmStack"/> 93 | <ResourceBaseClass Value="Form"/> 94 | </Unit3> 95 | <Unit4> 96 | <Filename Value="uwatches.pas"/> 97 | <IsPartOfProject Value="True"/> 98 | <ComponentName Value="frmWatches"/> 99 | <ResourceBaseClass Value="Form"/> 100 | </Unit4> 101 | </Units> 102 | </ProjectOptions> 103 | <CompilerOptions> 104 | <Version Value="11"/> 105 | <PathDelim Value="\"/> 106 | <Target> 107 | <Filename Value="lainzcs"/> 108 | </Target> 109 | <SearchPaths> 110 | <IncludeFiles Value="$(ProjOutDir)"/> 111 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 112 | </SearchPaths> 113 | <Parsing> 114 | <SyntaxOptions> 115 | <IncludeAssertionCode Value="True"/> 116 | </SyntaxOptions> 117 | </Parsing> 118 | <CodeGeneration> 119 | <Checks> 120 | <IOChecks Value="True"/> 121 | <RangeChecks Value="True"/> 122 | <OverflowChecks Value="True"/> 123 | <StackChecks Value="True"/> 124 | </Checks> 125 | <TargetCPU Value="i386"/> 126 | </CodeGeneration> 127 | <Linking> 128 | <Debugging> 129 | <DebugInfoType Value="dsDwarf2Set"/> 130 | <UseHeaptrc Value="True"/> 131 | <UseExternalDbgSyms Value="True"/> 132 | </Debugging> 133 | </Linking> 134 | </CompilerOptions> 135 | <Debugging> 136 | <Exceptions Count="3"> 137 | <Item1> 138 | <Name Value="EAbort"/> 139 | </Item1> 140 | <Item2> 141 | <Name Value="ECodetoolError"/> 142 | </Item2> 143 | <Item3> 144 | <Name Value="EFOpenError"/> 145 | </Item3> 146 | </Exceptions> 147 | </Debugging> 148 | </CONFIG> 149 | -------------------------------------------------------------------------------- /lainzcs.lpr: -------------------------------------------------------------------------------- 1 | program lainzcs; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | {$IFDEF UNIX}{$IFDEF UseCThreads} 7 | cthreads, 8 | {$ENDIF}{$ENDIF} 9 | Interfaces, // this includes the LCL widgetset 10 | Forms, umain, uhighdpi, lcs_debugform, lcs_dialog_input, ustack, uwatches; 11 | 12 | {$R *.res} 13 | 14 | begin 15 | Application.Title:='Lainz Code Studio 0.2'; 16 | RequireDerivedFormResource:=True; 17 | Application.Initialize; 18 | Application.CreateForm(TfrmMain, frmMain); 19 | Application.CreateForm(TfrmDebug, frmDebug); 20 | Application.CreateForm(Tfrm_lcs_dialog_input, frm_lcs_dialog_input); 21 | HighDPI(96); 22 | Application.CreateForm(TfrmStack, frmStack); 23 | Application.CreateForm(TfrmWatches, frmWatches); 24 | Application.Run; 25 | end. 26 | 27 | -------------------------------------------------------------------------------- /lcs_package/lcs_application.pas: -------------------------------------------------------------------------------- 1 | unit lcs_application; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Forms, Classes, SysUtils, Lua53; 9 | 10 | procedure RegisterApplication(L: Plua_State); 11 | 12 | function ApplicationExit(L: Plua_State): integer; cdecl; 13 | function ApplicationMinimize(L: Plua_State): integer; cdecl; 14 | function ApplicationRestore(L: Plua_State): integer; cdecl; 15 | function ApplicationSleep(L: Plua_State): integer; cdecl; 16 | 17 | implementation 18 | 19 | procedure RegisterApplication(L: Plua_State); 20 | 21 | procedure RegisterFunction(n: string; f: lua_CFunction); 22 | var 23 | reg: luaL_Reg; 24 | begin 25 | reg.Name := PChar(n); 26 | reg.func := f; 27 | luaL_setfuncs(L, reg, 0); 28 | end; 29 | 30 | begin 31 | lua_newtable(L); 32 | RegisterFunction('Exit', @ApplicationExit); 33 | RegisterFunction('Minimize', @ApplicationMinimize); 34 | RegisterFunction('Restore', @ApplicationRestore); 35 | RegisterFunction('Sleep', @ApplicationSleep); 36 | lua_setglobal(L, 'Application'); 37 | end; 38 | 39 | function ApplicationExit(L: Plua_State): integer; cdecl; 40 | begin 41 | Application.Terminate; 42 | Result := 0; 43 | end; 44 | 45 | function ApplicationMinimize(L: Plua_State): integer; cdecl; 46 | begin 47 | Application.Minimize; 48 | Result := 0; 49 | end; 50 | 51 | function ApplicationRestore(L: Plua_State): integer; cdecl; 52 | begin 53 | Application.Restore; 54 | Result := 0; 55 | end; 56 | 57 | function ApplicationSleep(L: Plua_State): integer; cdecl; 58 | begin 59 | Sleep(lua_tointeger(L, -1)); 60 | Result := 0; 61 | end; 62 | 63 | end. 64 | 65 | -------------------------------------------------------------------------------- /lcs_package/lcs_crypto.pas: -------------------------------------------------------------------------------- 1 | unit lcs_crypto; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, Blowfish, Lua53; 9 | 10 | procedure RegisterCrypto(L: Plua_State); 11 | 12 | function CryptoBlowfishDecrypt(L: Plua_State): integer; cdecl; 13 | function CryptoBlowfishDecryptString(L: Plua_State): integer; cdecl; 14 | function CryptoBlowfishEncrypt(L: Plua_State): integer; cdecl; 15 | function CryptoBlowfishEncryptString(L: Plua_State): integer; cdecl; 16 | 17 | implementation 18 | 19 | procedure RegisterCrypto(L: Plua_State); 20 | 21 | procedure RegisterFunction(n: string; f: lua_CFunction); 22 | var 23 | reg: luaL_Reg; 24 | begin 25 | reg.Name := PChar(n); 26 | reg.func := f; 27 | luaL_setfuncs(L, reg, 0); 28 | end; 29 | 30 | begin 31 | lua_newtable(L); 32 | RegisterFunction('BlowfishDecrypt', @CryptoBlowfishDecrypt); 33 | RegisterFunction('BlowfishDecryptString', @CryptoBlowfishDecryptString); 34 | RegisterFunction('BlowfishEncrypt', @CryptoBlowfishEncrypt); 35 | RegisterFunction('BlowfishEncryptString', @CryptoBlowfishEncryptString); 36 | lua_setglobal(L, 'Crypto'); 37 | end; 38 | 39 | function CryptoBlowfishDecrypt(L: Plua_State): integer; cdecl; 40 | var 41 | Source, destination, key: string; 42 | s1, s2: TMemoryStream; 43 | dc: TBlowfishDecryptStream; 44 | begin 45 | Source := lua_tostring(L, -3); 46 | destination := lua_tostring(L, -2); 47 | key := lua_tostring(L, -1); 48 | 49 | s1 := TMemoryStream.Create; 50 | s1.LoadFromFile(Source); 51 | s2 := TMemoryStream.Create; 52 | 53 | dc := TBlowfishDecryptStream.Create(key, s1); 54 | s2.CopyFrom(dc, s1.Size); 55 | dc.Free; 56 | 57 | s2.SaveToFile(destination); 58 | s2.Free; 59 | s1.Free; 60 | 61 | Result := 0; 62 | end; 63 | 64 | function CryptoBlowfishDecryptString(L: Plua_State): integer; cdecl; 65 | var 66 | Text, key: string; 67 | s1, s2: TStringStream; 68 | dc: TBlowfishDecryptStream; 69 | begin 70 | Text := lua_tostring(L, -2); 71 | key := lua_tostring(L, -1); 72 | 73 | s1 := TStringStream.Create(Text); 74 | s2 := TStringStream.Create(''); 75 | 76 | dc := TBlowfishDecryptStream.Create(key, s1); 77 | s2.CopyFrom(dc, s1.Size); 78 | dc.Free; 79 | 80 | lua_pushstring(L, s2.DataString); 81 | s2.Free; 82 | s1.Free; 83 | 84 | Result := 1; 85 | end; 86 | 87 | function CryptoBlowfishEncrypt(L: Plua_State): integer; cdecl; 88 | var 89 | Source, destination, key: string; 90 | s1, s2: TMemoryStream; 91 | ec: TBlowfishEncryptStream; 92 | begin 93 | Source := lua_tostring(L, -3); 94 | destination := lua_tostring(L, -2); 95 | key := lua_tostring(L, -1); 96 | 97 | s1 := TMemoryStream.Create; 98 | s1.LoadFromFile(Source); 99 | s2 := TMemoryStream.Create; 100 | 101 | ec := TBlowfishEncryptStream.Create(key, s2); 102 | ec.CopyFrom(s1, s1.Size); 103 | ec.Free; 104 | 105 | s2.SaveToFile(destination); 106 | s2.Free; 107 | s1.Free; 108 | 109 | Result := 0; 110 | end; 111 | 112 | function CryptoBlowfishEncryptString(L: Plua_State): integer; cdecl; 113 | var 114 | Text, key: string; 115 | s1, s2: TStringStream; 116 | ec: TBlowfishEncryptStream; 117 | begin 118 | Text := lua_tostring(L, -2); 119 | key := lua_tostring(L, -1); 120 | 121 | s1 := TStringStream.Create(Text); 122 | s2 := TStringStream.Create(''); 123 | 124 | ec := TBlowfishEncryptStream.Create(key, s2); 125 | ec.CopyFrom(s1, s1.Size); 126 | ec.Free; 127 | 128 | lua_pushstring(L, s2.DataString); 129 | s2.Free; 130 | s1.Free; 131 | 132 | Result := 1; 133 | end; 134 | 135 | end. 136 | 137 | -------------------------------------------------------------------------------- /lcs_package/lcs_debug.pas: -------------------------------------------------------------------------------- 1 | unit lcs_debug; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, Lua53; 9 | 10 | procedure RegisterDebug(L: Plua_State); 11 | 12 | function DebugClear(L: Plua_State): integer; cdecl; 13 | function DebugPrint(L: Plua_State): integer; cdecl; 14 | function DebugSendToFile(L: Plua_State): integer; cdecl; 15 | function DebugShowWindow(L: Plua_State): integer; cdecl; 16 | 17 | implementation 18 | 19 | uses 20 | lcs_debugform; 21 | 22 | procedure RegisterDebug(L: Plua_State); 23 | 24 | procedure RegisterFunction(n: string; f: lua_CFunction); 25 | var 26 | reg: luaL_Reg; 27 | begin 28 | reg.Name := PChar(n); 29 | reg.func := f; 30 | luaL_setfuncs(L, reg, 0); 31 | end; 32 | 33 | begin 34 | lua_newtable(L); 35 | RegisterFunction('Clear', @DebugClear); 36 | RegisterFunction('Print', @DebugPrint); 37 | RegisterFunction('SendToFile', @DebugSendToFile); 38 | RegisterFunction('ShowWindow', @DebugShowWindow); 39 | lua_setglobal(L, 'Debug'); 40 | end; 41 | 42 | function DebugClear(L: Plua_State): integer; cdecl; 43 | begin 44 | frmDebug.memoDebug.Clear; 45 | Result := 0; 46 | end; 47 | 48 | function DebugPrint(L: Plua_State): integer; cdecl; 49 | var 50 | Text: string; 51 | begin 52 | Text := lua_tostring(L, -1); 53 | frmDebug.memoDebug.Lines.AddText(Text); 54 | Result := 0; 55 | end; 56 | 57 | function DebugSendToFile(L: Plua_State): integer; cdecl; 58 | var 59 | filename: string; 60 | overwrite: boolean; 61 | s: TStringList; 62 | begin 63 | filename := lua_tostring(L, -2); 64 | overwrite := lua_toboolean(L, -1); 65 | if overwrite then 66 | frmDebug.memoDebug.Lines.SaveToFile(filename) 67 | else 68 | begin 69 | s := TStringList.Create; 70 | s.LoadFromFile(filename); 71 | s.AddText(frmDebug.memoDebug.Lines.Text); 72 | s.SaveToFile(filename); 73 | s.Free; 74 | end; 75 | Result := 0; 76 | end; 77 | 78 | function DebugShowWindow(L: Plua_State): integer; cdecl; 79 | var 80 | Show: boolean; 81 | begin 82 | Show := lua_toboolean(L, -1); 83 | if Show then 84 | frmDebug.Show 85 | else 86 | frmDebug.Close; 87 | Result := 0; 88 | end; 89 | 90 | end. 91 | 92 | -------------------------------------------------------------------------------- /lcs_package/lcs_debugform.lfm: -------------------------------------------------------------------------------- 1 | object frmDebug: TfrmDebug 2 | Left = 0 3 | Height = 400 4 | Top = 0 5 | Width = 640 6 | Caption = 'Debug Form' 7 | ChildSizing.LeftRightSpacing = 8 8 | ChildSizing.TopBottomSpacing = 8 9 | ClientHeight = 400 10 | ClientWidth = 640 11 | OnCreate = FormCreate 12 | LCLVersion = '1.6.0.4' 13 | object memoDebug: TMemo 14 | Left = 8 15 | Height = 384 16 | Top = 8 17 | Width = 624 18 | Align = alClient 19 | TabOrder = 0 20 | end 21 | end 22 | -------------------------------------------------------------------------------- /lcs_package/lcs_debugform.pas: -------------------------------------------------------------------------------- 1 | unit lcs_debugform; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, Forms, Graphics, StdCtrls; 9 | 10 | type 11 | 12 | { TfrmDebug } 13 | 14 | TfrmDebug = class(TForm) 15 | memoDebug: TMemo; 16 | procedure FormCreate(Sender: TObject); 17 | private 18 | { private declarations } 19 | public 20 | { public declarations } 21 | end; 22 | 23 | var 24 | frmDebug: TfrmDebug; 25 | 26 | implementation 27 | 28 | {$R *.lfm} 29 | 30 | { TfrmDebug } 31 | 32 | procedure TfrmDebug.FormCreate(Sender: TObject); 33 | begin 34 | Self.ChildSizing.LeftRightSpacing := ScaleX(Self.ChildSizing.LeftRightSpacing, 96); 35 | Self.ChildSizing.TopBottomSpacing := ScaleY(Self.ChildSizing.TopBottomSpacing, 96); 36 | Self.Width := ScaleX(Self.Width, 96); 37 | Self.Height := ScaleY(Self.Height, 96); 38 | end; 39 | 40 | end. 41 | 42 | -------------------------------------------------------------------------------- /lcs_package/lcs_dialog.pas: -------------------------------------------------------------------------------- 1 | unit lcs_dialog; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Forms, Classes, SysUtils, Controls, Lua53; 9 | 10 | procedure RegisterDialog(L: Plua_State); 11 | 12 | function DialogInput(L: Plua_State): integer; cdecl; 13 | 14 | implementation 15 | 16 | uses 17 | lcs_dialog_input; 18 | 19 | procedure RegisterDialog(L: Plua_State); 20 | 21 | procedure RegisterFunction(n: string; f: lua_CFunction); 22 | var 23 | reg: luaL_Reg; 24 | begin 25 | reg.Name := PChar(n); 26 | reg.func := f; 27 | luaL_setfuncs(L, reg, 0); 28 | end; 29 | 30 | begin 31 | lua_newtable(L); 32 | RegisterFunction('Input', @DialogInput); 33 | lua_setglobal(L, 'Dialog'); 34 | end; 35 | 36 | function DialogInput(L: Plua_State): integer; cdecl; 37 | begin 38 | frm_lcs_dialog_input.Caption := lua_tostring(L, -3); 39 | frm_lcs_dialog_input.lblPrompt.Caption := lua_tostring(L, -2); 40 | frm_lcs_dialog_input.editText.Text := lua_tostring(L, -1); 41 | frm_lcs_dialog_input.ActiveDefaultControl := frm_lcs_dialog_input.editText; 42 | case frm_lcs_dialog_input.ShowModal of 43 | mrOk: lua_pushstring(L, frm_lcs_dialog_input.editText.Text); 44 | mrCancel: lua_pushstring(L, 'CANCEL'); 45 | end; 46 | Result := 1; 47 | end; 48 | 49 | end. 50 | 51 | -------------------------------------------------------------------------------- /lcs_package/lcs_dialog_input.lfm: -------------------------------------------------------------------------------- 1 | object frm_lcs_dialog_input: Tfrm_lcs_dialog_input 2 | Left = 465 3 | Height = 123 4 | Top = 182 5 | Width = 400 6 | AutoSize = True 7 | BorderStyle = bsDialog 8 | Caption = 'Input' 9 | ChildSizing.LeftRightSpacing = 8 10 | ChildSizing.TopBottomSpacing = 8 11 | ChildSizing.HorizontalSpacing = 8 12 | ChildSizing.VerticalSpacing = 8 13 | ChildSizing.EnlargeHorizontal = crsScaleChilds 14 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 15 | ChildSizing.ControlsPerLine = 1 16 | ClientHeight = 123 17 | ClientWidth = 400 18 | Constraints.MinWidth = 400 19 | OnCreate = FormCreate 20 | Position = poMainFormCenter 21 | LCLVersion = '1.6.0.4' 22 | object lblPrompt: TLabel 23 | Left = 8 24 | Height = 20 25 | Top = 8 26 | Width = 384 27 | Align = alTop 28 | Caption = 'Insert text here:' 29 | ParentColor = False 30 | end 31 | object editText: TEdit 32 | Left = 8 33 | Height = 28 34 | Top = 36 35 | Width = 384 36 | Align = alTop 37 | TabOrder = 0 38 | end 39 | object panelButtons: TPanel 40 | Left = 8 41 | Height = 43 42 | Top = 72 43 | Width = 384 44 | Align = alClient 45 | AutoSize = True 46 | BevelOuter = bvNone 47 | ChildSizing.LeftRightSpacing = 8 48 | ChildSizing.TopBottomSpacing = 8 49 | ChildSizing.HorizontalSpacing = 8 50 | ChildSizing.VerticalSpacing = 8 51 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 52 | ChildSizing.ControlsPerLine = 2 53 | ClientHeight = 43 54 | ClientWidth = 384 55 | ParentColor = False 56 | TabOrder = 1 57 | object btnOK: TButton 58 | Left = 8 59 | Height = 30 60 | Top = 8 61 | Width = 46 62 | AutoSize = True 63 | Caption = 'OK' 64 | ModalResult = 1 65 | TabOrder = 0 66 | end 67 | object btnCancel: TButton 68 | Left = 62 69 | Height = 30 70 | Top = 8 71 | Width = 70 72 | AutoSize = True 73 | Caption = 'Cancel' 74 | ModalResult = 2 75 | TabOrder = 1 76 | end 77 | end 78 | end 79 | -------------------------------------------------------------------------------- /lcs_package/lcs_dialog_input.pas: -------------------------------------------------------------------------------- 1 | unit lcs_dialog_input; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, Forms, Graphics, StdCtrls, ExtCtrls; 9 | 10 | type 11 | 12 | { Tfrm_lcs_dialog_input } 13 | 14 | Tfrm_lcs_dialog_input = class(TForm) 15 | btnOK: TButton; 16 | btnCancel: TButton; 17 | editText: TEdit; 18 | lblPrompt: TLabel; 19 | panelButtons: TPanel; 20 | procedure FormCreate(Sender: TObject); 21 | private 22 | { private declarations } 23 | public 24 | { public declarations } 25 | end; 26 | 27 | var 28 | frm_lcs_dialog_input: Tfrm_lcs_dialog_input; 29 | 30 | implementation 31 | 32 | {$R *.lfm} 33 | 34 | { Tfrm_lcs_dialog_input } 35 | 36 | procedure Tfrm_lcs_dialog_input.FormCreate(Sender: TObject); 37 | begin 38 | Self.ChildSizing.LeftRightSpacing := ScaleX(Self.ChildSizing.LeftRightSpacing, 96); 39 | Self.ChildSizing.TopBottomSpacing := ScaleY(Self.ChildSizing.TopBottomSpacing, 96); 40 | Self.ChildSizing.HorizontalSpacing := ScaleX(Self.ChildSizing.HorizontalSpacing, 96); 41 | Self.ChildSizing.VerticalSpacing := ScaleY(Self.ChildSizing.VerticalSpacing, 96); 42 | Self.panelButtons.ChildSizing.LeftRightSpacing := ScaleX(Self.panelButtons.ChildSizing.LeftRightSpacing, 96); 43 | Self.panelButtons.ChildSizing.TopBottomSpacing := ScaleY(Self.panelButtons.ChildSizing.TopBottomSpacing, 96); 44 | Self.panelButtons.ChildSizing.HorizontalSpacing := ScaleX(Self.panelButtons.ChildSizing.HorizontalSpacing, 96); 45 | Self.panelButtons.ChildSizing.VerticalSpacing := ScaleY(Self.panelButtons.ChildSizing.VerticalSpacing, 96); 46 | Self.Width := ScaleX(Self.Width, 96); 47 | Self.Height := ScaleY(Self.Height, 96); 48 | end; 49 | 50 | end. 51 | 52 | -------------------------------------------------------------------------------- /lcs_package/lcs_file.pas: -------------------------------------------------------------------------------- 1 | unit lcs_file; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, FileUtil, LazFileUtils, Process, UTF8Process, LCLIntF, Lua53; 9 | 10 | procedure RegisterFile(L: Plua_State); 11 | 12 | function FileDoesExist(L: Plua_State): integer; cdecl; 13 | function FileGetShortName(L: Plua_State): integer; cdecl; 14 | function FileOpenEmail(L: Plua_State): integer; cdecl; 15 | function FileOpenURL(L: Plua_State): integer; cdecl; 16 | function FilePrint(L: Plua_State): integer; cdecl; 17 | function FileRun(L: Plua_State): integer; cdecl; 18 | 19 | implementation 20 | 21 | {$IFDEF WINDOWS} 22 | uses Windows; 23 | 24 | {$ENDIF} 25 | 26 | procedure RegisterFile(L: Plua_State); 27 | 28 | procedure RegisterFunction(n: string; f: lua_CFunction); 29 | var 30 | reg: luaL_Reg; 31 | begin 32 | reg.Name := PChar(n); 33 | reg.func := f; 34 | luaL_setfuncs(L, reg, 0); 35 | end; 36 | 37 | begin 38 | lua_newtable(L); 39 | RegisterFunction('DoesExist', @FileDoesExist); 40 | RegisterFunction('GetShortName', @FileGetShortName); 41 | RegisterFunction('ExploreFolder', @FileOpenURL); 42 | RegisterFunction('Open', @FileOpenURL); 43 | RegisterFunction('OpenEmail', @FileOpenEmail); 44 | RegisterFunction('OpenURL', @FileOpenURL); 45 | RegisterFunction('Print', @FilePrint); 46 | RegisterFunction('Run', @FileRun); 47 | lua_setglobal(L, 'File'); 48 | end; 49 | 50 | function FileDoesExist(L: Plua_State): integer; cdecl; 51 | begin 52 | lua_pushboolean(L, FileExistsUTF8(lua_tostring(L, -1))); 53 | Result := 1; 54 | end; 55 | 56 | function FileGetShortName(L: Plua_State): integer; cdecl; 57 | begin 58 | lua_pushstring(L, ExtractShortPathNameUTF8(lua_tostring(L, -1))); 59 | Result := 1; 60 | end; 61 | 62 | function FileOpenEmail(L: Plua_State): integer; cdecl; 63 | begin 64 | OpenURL('mailto:' + lua_tostring(L, -1)); 65 | Result := 0; 66 | end; 67 | 68 | function FileOpenURL(L: Plua_State): integer; cdecl; 69 | begin 70 | OpenURL(lua_tostring(L, -1)); 71 | Result := 0; 72 | end; 73 | 74 | function FilePrint(L: Plua_State): integer; cdecl; 75 | {$IFDEF WINDOWS} 76 | var 77 | s: WideString; 78 | {$ENDIF} 79 | begin 80 | {$IFDEF WINDOWS} 81 | s := lua_tostring(L, -1); 82 | ShellExecuteW(0, PWideChar('print'), PWideChar(s), PWideChar(''), 83 | PWideChar(''), SW_SHOWNORMAL); 84 | {$ENDIF} 85 | Result := 0; 86 | end; 87 | 88 | function FileRun(L: Plua_State): integer; cdecl; 89 | var 90 | process: TProcessUTF8; 91 | begin 92 | process := TProcessUTF8.Create(nil); 93 | process.CurrentDirectory := lua_tostring(L, -3); 94 | process.Parameters.Delimiter := ' '; 95 | process.Parameters.DelimitedText := (lua_tostring(L, -4)); 96 | process.Executable := lua_tostring(L, -5); 97 | 98 | case lua_tointeger(L, -2) of 99 | 0: process.ShowWindow := swoHide; 100 | 1: process.ShowWindow := swoShowNormal; 101 | 3: process.ShowWindow := swoShowMaximized; 102 | 6: process.ShowWindow := swoShowMinimized; 103 | end; 104 | 105 | if lua_toboolean(L, -1) then 106 | process.Options := [poWaitOnExit]; 107 | process.Execute; 108 | if process.WaitOnExit then 109 | lua_pushinteger(L, process.ExitCode) 110 | else 111 | lua_pushinteger(L, 0); 112 | process.Free; 113 | Result := 1; 114 | end; 115 | 116 | end. 117 | -------------------------------------------------------------------------------- /lcs_package/lcs_folder.pas: -------------------------------------------------------------------------------- 1 | unit lcs_folder; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, FileUtil, LazFileUtils, LazUTF8, Lua53; 9 | 10 | procedure RegisterFolder(L: Plua_State); 11 | 12 | function FolderCreate(L: Plua_State): integer; cdecl; 13 | function FolderDelete(L: Plua_State): integer; cdecl; 14 | function FolderDeleteTree(L: Plua_State): integer; cdecl; 15 | function FolderDoesExist(L: Plua_State): integer; cdecl; 16 | function FolderFind(L: Plua_State): integer; cdecl; 17 | function FolderGetCurrent(L: Plua_State): integer; cdecl; 18 | function FolderRename(L: Plua_State): integer; cdecl; 19 | function FolderSetCurrent(L: Plua_State): integer; cdecl; 20 | 21 | implementation 22 | 23 | procedure RegisterFolder(L: Plua_State); 24 | 25 | procedure RegisterFunction(n: string; f: lua_CFunction); 26 | var 27 | reg: luaL_Reg; 28 | begin 29 | reg.Name := PChar(n); 30 | reg.func := f; 31 | luaL_setfuncs(L, reg, 0); 32 | end; 33 | 34 | begin 35 | lua_newtable(L); 36 | RegisterFunction('Create', @FolderCreate); 37 | RegisterFunction('Delete', @FolderDelete); 38 | RegisterFunction('DeleteTree', @FolderDeleteTree); 39 | RegisterFunction('DoesExist', @FolderDoesExist); 40 | RegisterFunction('Find', @FolderFind); 41 | RegisterFunction('GetCurrent', @FolderGetCurrent); 42 | RegisterFunction('Rename', @FolderRename); 43 | RegisterFunction('SetCurrent', @FolderSetCurrent); 44 | lua_setglobal(L, 'Folder'); 45 | end; 46 | 47 | function FolderCreate(L: Plua_State): integer; cdecl; 48 | begin 49 | CreateDirUTF8(lua_tostring(L, -1)); 50 | Result := 0; 51 | end; 52 | 53 | function FolderDelete(L: Plua_State): integer; cdecl; 54 | begin 55 | RemoveDirUTF8(lua_tostring(L, -1)); 56 | Result := 0; 57 | end; 58 | 59 | function FolderDeleteTree(L: Plua_State): integer; cdecl; 60 | begin 61 | DeleteDirectory(lua_tostring(L, -1), False); 62 | Result := 0; 63 | end; 64 | 65 | function FolderDoesExist(L: Plua_State): integer; cdecl; 66 | begin 67 | lua_pushboolean(L, DirectoryExistsUTF8(lua_tostring(L, -1))); 68 | Result := 1; 69 | end; 70 | 71 | function FolderFind(L: Plua_State): integer; cdecl; 72 | var 73 | s: TStringList; 74 | i: integer; 75 | path, mask: string; 76 | subdirs: boolean; 77 | begin 78 | path := lua_tostring(L, -3); 79 | mask := lua_tostring(L, -2); 80 | subdirs := lua_toboolean(L, -1); 81 | 82 | s := TStringList.Create; 83 | FindAllDirectories(s, path, subdirs); 84 | 85 | for i := s.Count - 1 downto 0 do 86 | if (UTF8Pos(mask, s[i]) = 0) then 87 | s.Delete(i); 88 | 89 | lua_newtable(L); 90 | for i := 0 to s.Count - 1 do 91 | begin 92 | lua_pushstring(L, s[i]); 93 | lua_rawseti(L, -2, i); 94 | end; 95 | 96 | s.Free; 97 | 98 | Result := 1; 99 | end; 100 | 101 | function FolderGetCurrent(L: Plua_State): integer; cdecl; 102 | begin 103 | lua_pushstring(L, GetCurrentDirUTF8); 104 | Result := 1; 105 | end; 106 | 107 | function FolderRename(L: Plua_State): integer; cdecl; 108 | begin 109 | RenameFileUTF8(lua_tostring(L, -2), lua_tostring(L, -1)); 110 | Result := 0; 111 | end; 112 | 113 | function FolderSetCurrent(L: Plua_State): integer; cdecl; 114 | begin 115 | SetCurrentDirUTF8(lua_tostring(L, -1)); 116 | Result := 0; 117 | end; 118 | 119 | end. 120 | 121 | -------------------------------------------------------------------------------- /lcs_package/lcs_ftpwi.pas: -------------------------------------------------------------------------------- 1 | unit lcs_ftpwi; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, ftpsend, Lua53; 9 | 10 | procedure RegisterFTPWI(L: Plua_State); 11 | 12 | function FTPWIDownload(L: Plua_State): integer; cdecl; 13 | function FTPWIGetFileSize(L: Plua_State): integer; cdecl; 14 | 15 | implementation 16 | 17 | const 18 | FTPScheme = 'ftp://'; 19 | 20 | procedure RegisterFTPWI(L: Plua_State); 21 | 22 | procedure RegisterFunction(n: string; f: lua_CFunction); 23 | var 24 | reg: luaL_Reg; 25 | begin 26 | reg.Name := PChar(n); 27 | reg.func := f; 28 | luaL_setfuncs(L, reg, 0); 29 | end; 30 | 31 | begin 32 | lua_newtable(L); 33 | RegisterFunction('Download', @FTPWIDownload); 34 | RegisterFunction('GetFileSize', @FTPWIGetFileSize); 35 | lua_setglobal(L, 'FTPWI'); 36 | end; 37 | 38 | function FTPWIDownload(L: Plua_State): integer; cdecl; 39 | var 40 | Host, Source: string; 41 | FoundPos: integer; 42 | URL, Filename, Username, Password, Port: string; 43 | begin 44 | URL := lua_tostring(L, -5); 45 | Filename := lua_tostring(L, -4); 46 | Username := lua_tostring(L, -3); 47 | Password := lua_tostring(L, -2); 48 | Port := lua_tostring(L, -1); 49 | 50 | // Strip out scheme info: 51 | if LeftStr(URL, length(FTPScheme)) = FTPScheme then 52 | URL := Copy(URL, length(FTPScheme) + 1, length(URL)); 53 | 54 | // Crude parsing: 55 | FoundPos := pos('/', URL); 56 | Host := LeftStr(URL, FoundPos - 1); 57 | Source := Copy(URL, FoundPos + 1, Length(URL)); 58 | 59 | FtpGetFile(Host, Port, Source, Filename, Username, Password); 60 | Result := 0; 61 | end; 62 | 63 | function FTPWIGetFileSize(L: Plua_State): integer; cdecl; 64 | var 65 | Host, Source: string; 66 | FoundPos: integer; 67 | URL, User, Pass, Port: string; 68 | VSize: int64 = -1; 69 | begin 70 | URL := lua_tostring(L, -4); 71 | User := lua_tostring(L, -3); 72 | Pass := lua_tostring(L, -2); 73 | Port := lua_tostring(L, -1); 74 | 75 | // Strip out scheme info: 76 | if LeftStr(URL, length(FTPScheme)) = FTPScheme then 77 | URL := Copy(URL, length(FTPScheme) + 1, length(URL)); 78 | 79 | // Crude parsing: 80 | FoundPos := pos('/', URL); 81 | Host := LeftStr(URL, FoundPos - 1); 82 | Source := Copy(URL, FoundPos + 1, Length(URL)); 83 | 84 | with TFTPSend.Create do 85 | try 86 | if User <> '' then 87 | begin 88 | Username := User; 89 | Password := Pass; 90 | end; 91 | TargetHost := Host; 92 | TargetPort := Port; 93 | if not Login then 94 | Exit; 95 | VSize := FileSize(Source); 96 | Logout; 97 | finally 98 | Free; 99 | end; 100 | lua_pushinteger(L, VSize); 101 | Result := 1; 102 | end; 103 | 104 | end. 105 | -------------------------------------------------------------------------------- /lcs_package/lcs_http.pas: -------------------------------------------------------------------------------- 1 | unit lcs_http; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, fphttpclient, Lua53; 9 | 10 | procedure RegisterHTTP(L: Plua_State); 11 | 12 | function HTTPDownload(L: Plua_State): integer; cdecl; 13 | function HTTPGetFileSize(L: Plua_State): integer; cdecl; 14 | function HTTPSubmit(L: Plua_State): integer; cdecl; 15 | 16 | type 17 | 18 | { THTTPGetFileSize } 19 | 20 | THTTPGetFileSize = class 21 | public 22 | constructor Create(L: Plua_State); 23 | procedure DoDataReceived(Sender: TObject; const ContentLength, CurrentPos: int64); 24 | end; 25 | 26 | implementation 27 | 28 | procedure RegisterHTTP(L: Plua_State); 29 | 30 | procedure RegisterFunction(n: string; f: lua_CFunction); 31 | var 32 | reg: luaL_Reg; 33 | begin 34 | reg.Name := PChar(n); 35 | reg.func := f; 36 | luaL_setfuncs(L, reg, 0); 37 | end; 38 | 39 | begin 40 | lua_newtable(L); 41 | RegisterFunction('Download', @HTTPDownload); 42 | RegisterFunction('DownloadSecure', @HTTPDownload); 43 | RegisterFunction('GetFileSize', @HTTPGetFileSize); 44 | RegisterFunction('GetFileSizeSecure', @HTTPGetFileSize); 45 | RegisterFunction('Submit', @HTTPSubmit); 46 | RegisterFunction('SubmitSecute', @HTTPSubmit); 47 | lua_setglobal(L, 'HTTP'); 48 | end; 49 | 50 | function HTTPDownload(L: Plua_State): integer; cdecl; 51 | var 52 | client: TFPHTTPClient; 53 | url, filename, username, password: string; 54 | begin 55 | client := TFPHTTPClient.Create(nil); 56 | url := lua_tostring(L, -4); 57 | filename := lua_tostring(L, -3); 58 | username := lua_tostring(L, -2); 59 | password := lua_tostring(L, -1); 60 | if username <> '' then 61 | client.UserName := username; 62 | if password <> '' then 63 | client.Password := password; 64 | client.AllowRedirect := True; 65 | try 66 | client.Get(url, filename); 67 | finally 68 | client.Free; 69 | end; 70 | Result := 0; 71 | end; 72 | 73 | function HTTPGetFileSize(L: Plua_State): integer; cdecl; 74 | var 75 | GetFileSize: THTTPGetFileSize; 76 | begin 77 | GetFileSize := THTTPGetFileSize.Create(L); 78 | GetFileSize.Free; 79 | Result := 1; 80 | end; 81 | 82 | function HTTPSubmit(L: Plua_State): integer; cdecl; 83 | var 84 | client: TFPHTTPClient; 85 | method: integer; 86 | url, username, password, res: string; 87 | s: TStringList; 88 | begin 89 | try 90 | s := TStringList.Create; 91 | client := TFPHTTPClient.Create(nil); 92 | url := lua_tostring(L, -5); 93 | method := lua_tointeger(L, -3); 94 | username := lua_tostring(L, -2); 95 | password := lua_tostring(L, -1); 96 | 97 | if username <> '' then 98 | client.UserName := username; 99 | if password <> '' then 100 | client.Password := password; 101 | client.AllowRedirect := True; 102 | client.AddHeader('User-Agent','Mozilla/5.0 (compatible; fpweb)'); 103 | 104 | lua_pushnil(L); 105 | while (lua_next(L, -5) <> 0) do 106 | begin 107 | s.Add(lua_tostring(L, -2) + '=' + lua_tostring(L, -1)); 108 | lua_pop(L, 1); 109 | end; 110 | 111 | s.QuoteChar := char(''); 112 | s.Delimiter := '&'; 113 | s.StrictDelimiter := True; 114 | res := ''; 115 | 116 | case method of 117 | 1: 118 | begin 119 | res := client.Get(url + '?' + s.DelimitedText); 120 | end; 121 | 0: 122 | begin 123 | res := client.FormPost(url, s); 124 | end; 125 | end; 126 | 127 | finally 128 | client.Free; 129 | s.Free; 130 | end; 131 | lua_pushstring(L, res); 132 | Result := 1; 133 | end; 134 | 135 | { THTTPGetFileSize } 136 | 137 | constructor THTTPGetFileSize.Create(L: Plua_State); 138 | var 139 | client: TFPHTTPClient; 140 | url, username, password: string; 141 | VSize: int64 = -1; 142 | LStringStream: TStringStream; 143 | begin 144 | LStringStream := TStringStream.Create(''); 145 | try 146 | client := TFPHTTPClient.Create(nil); 147 | url := lua_tostring(L, -3); 148 | username := lua_tostring(L, -2); 149 | password := lua_tostring(L, -1); 150 | if username <> '' then 151 | client.UserName := username; 152 | if password <> '' then 153 | client.Password := password; 154 | client.AllowRedirect := True; 155 | client.OnDataReceived := @DoDataReceived; 156 | client.ResponseHeaders.NameValueSeparator := ':'; 157 | try 158 | client.HTTPMethod('GET', url, LStringStream, []); 159 | except 160 | end; 161 | VSize := StrToIntDef(client.ResponseHeaders.Values['CONTENT-LENGTH'], -1); 162 | finally 163 | client.Free; 164 | LStringStream.Free; 165 | end; 166 | lua_pushinteger(L, VSize); 167 | end; 168 | 169 | procedure THTTPGetFileSize.DoDataReceived(Sender: TObject; 170 | const ContentLength, CurrentPos: int64); 171 | begin 172 | if ContentLength > 0 then 173 | begin 174 | Abort; 175 | end; 176 | end; 177 | 178 | end. 179 | -------------------------------------------------------------------------------- /lcs_package/lcs_inifile.pas: -------------------------------------------------------------------------------- 1 | unit lcs_inifile; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, INIFiles, Lua53; 9 | 10 | procedure RegisterINIFile(L: Plua_State); 11 | 12 | function INIFileDeleteSection(L: Plua_State): integer; cdecl; 13 | function INIFileDeleteValue(L: Plua_State): integer; cdecl; 14 | function INIFileGetSectionNames(L: Plua_State): integer; cdecl; 15 | function INIFileGetValue(L: Plua_State): integer; cdecl; 16 | function INIFileGetValueNames(L: Plua_State): integer; cdecl; 17 | function INIFileSetValue(L: Plua_State): integer; cdecl; 18 | 19 | implementation 20 | 21 | procedure RegisterINIFile(L: Plua_State); 22 | 23 | procedure RegisterFunction(n: string; f: lua_CFunction); 24 | var 25 | reg: luaL_Reg; 26 | begin 27 | reg.Name := PChar(n); 28 | reg.func := f; 29 | luaL_setfuncs(L, reg, 0); 30 | end; 31 | 32 | begin 33 | lua_newtable(L); 34 | RegisterFunction('DeleteSection', @INIFileDeleteSection); 35 | RegisterFunction('DeleteValue', @INIFileDeleteValue); 36 | RegisterFunction('GetSectionNames', @INIFileGetSectionNames); 37 | RegisterFunction('GetValue', @INIFileGetValue); 38 | RegisterFunction('GetValueNames', @INIFileGetValueNames); 39 | RegisterFunction('SetValue', @INIFileSetValue); 40 | lua_setglobal(L, 'INIFile'); 41 | end; 42 | 43 | function INIFileDeleteSection(L: Plua_State): integer; cdecl; 44 | var 45 | ini: TIniFile; 46 | begin 47 | ini := TIniFile.Create(lua_tostring(L, -2)); 48 | ini.EraseSection(lua_tostring(L, -1)); 49 | ini.Free; 50 | Result := 0; 51 | end; 52 | 53 | function INIFileDeleteValue(L: Plua_State): integer; cdecl; 54 | var 55 | ini: TIniFile; 56 | begin 57 | ini := TIniFile.Create(lua_tostring(L, -3)); 58 | ini.DeleteKey(lua_tostring(L, -2), lua_tostring(L, -1)); 59 | ini.Free; 60 | Result := 0; 61 | end; 62 | 63 | function INIFileGetSectionNames(L: Plua_State): integer; cdecl; 64 | var 65 | ini: TIniFile; 66 | s: TStringList; 67 | i: integer; 68 | begin 69 | ini := TIniFile.Create(lua_tostring(L, -1)); 70 | s := TStringList.Create; 71 | ini.ReadSections(s); 72 | ini.Free; 73 | 74 | lua_newtable(L); 75 | for i := 0 to s.Count - 1 do 76 | begin 77 | lua_pushstring(L, s[i]); 78 | lua_rawseti(L, -2, i); 79 | end; 80 | 81 | s.Free; 82 | Result := 1; 83 | end; 84 | 85 | function INIFileGetValue(L: Plua_State): integer; cdecl; 86 | var 87 | ini: TIniFile; 88 | res: string; 89 | begin 90 | ini := TIniFile.Create(lua_tostring(L, -3)); 91 | res := ini.ReadString(lua_tostring(L, -2), lua_tostring(L, -1), EmptyStr); 92 | ini.Free; 93 | lua_pushstring(L, res); 94 | Result := 1; 95 | end; 96 | 97 | function INIFileGetValueNames(L: Plua_State): integer; cdecl; 98 | var 99 | ini: TIniFile; 100 | s: TStringList; 101 | i: integer; 102 | begin 103 | ini := TIniFile.Create(lua_tostring(L, -2)); 104 | s := TStringList.Create; 105 | ini.ReadSection(lua_tostring(L, -1), s); 106 | ini.Free; 107 | 108 | lua_newtable(L); 109 | for i := 0 to s.Count - 1 do 110 | begin 111 | lua_pushstring(L, s[i]); 112 | lua_rawseti(L, -2, i); 113 | end; 114 | 115 | s.Free; 116 | Result := 1; 117 | end; 118 | 119 | function INIFileSetValue(L: Plua_State): integer; cdecl; 120 | var 121 | ini: TIniFile; 122 | begin 123 | ini := TIniFile.Create(lua_tostring(L, -4)); 124 | ini.WriteString(lua_tostring(L, -3), lua_tostring(L, -2), lua_tostring(L, -1)); 125 | ini.Free; 126 | Result := 0; 127 | end; 128 | 129 | end. 130 | 131 | -------------------------------------------------------------------------------- /lcs_package/lcs_package.lpk: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <Package Version="4"> 4 | <PathDelim Value="\"/> 5 | <Name Value="lcs_package"/> 6 | <Type Value="RunAndDesignTime"/> 7 | <CompilerOptions> 8 | <Version Value="11"/> 9 | <PathDelim Value="\"/> 10 | <SearchPaths> 11 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 12 | </SearchPaths> 13 | </CompilerOptions> 14 | <Files Count="21"> 15 | <Item1> 16 | <Filename Value="lcs_application.pas"/> 17 | <UnitName Value="lcs_application"/> 18 | </Item1> 19 | <Item2> 20 | <Filename Value="lcs_crypto.pas"/> 21 | <UnitName Value="lcs_crypto"/> 22 | </Item2> 23 | <Item3> 24 | <Filename Value="lcs_debug.pas"/> 25 | <UnitName Value="lcs_debug"/> 26 | </Item3> 27 | <Item4> 28 | <Filename Value="lcs_debugform.pas"/> 29 | <UnitName Value="lcs_debugform"/> 30 | </Item4> 31 | <Item5> 32 | <Filename Value="lcs_debugform.lfm"/> 33 | <Type Value="LFM"/> 34 | </Item5> 35 | <Item6> 36 | <Filename Value="lcs_dialog.pas"/> 37 | <UnitName Value="lcs_dialog"/> 38 | </Item6> 39 | <Item7> 40 | <Filename Value="lcs_dialog_input.pas"/> 41 | <UnitName Value="lcs_dialog_input"/> 42 | </Item7> 43 | <Item8> 44 | <Filename Value="lcs_dialog_input.lfm"/> 45 | <Type Value="LFM"/> 46 | </Item8> 47 | <Item9> 48 | <Filename Value="lcs_file.pas"/> 49 | <UnitName Value="lcs_file"/> 50 | </Item9> 51 | <Item10> 52 | <Filename Value="lcs_folder.pas"/> 53 | <UnitName Value="lcs_folder"/> 54 | </Item10> 55 | <Item11> 56 | <Filename Value="lcs_http.pas"/> 57 | <UnitName Value="lcs_http"/> 58 | </Item11> 59 | <Item12> 60 | <Filename Value="lcs_inifile.pas"/> 61 | <UnitName Value="lcs_inifile"/> 62 | </Item12> 63 | <Item13> 64 | <Filename Value="lcs_registerall.pas"/> 65 | <UnitName Value="lcs_registerall"/> 66 | </Item13> 67 | <Item14> 68 | <Filename Value="lcs_registry.pas"/> 69 | <UnitName Value="lcs_registry"/> 70 | </Item14> 71 | <Item15> 72 | <Filename Value="lcs_string.pas"/> 73 | <UnitName Value="lcs_string"/> 74 | </Item15> 75 | <Item16> 76 | <Filename Value="lcs_table.pas"/> 77 | <UnitName Value="lcs_table"/> 78 | </Item16> 79 | <Item17> 80 | <Filename Value="lcs_textfile.pas"/> 81 | <UnitName Value="lcs_textfile"/> 82 | </Item17> 83 | <Item18> 84 | <Filename Value="lcs_zip.pas"/> 85 | <UnitName Value="lcs_zip"/> 86 | </Item18> 87 | <Item19> 88 | <Filename Value="lua53.pas"/> 89 | <UnitName Value="lua53"/> 90 | </Item19> 91 | <Item20> 92 | <Filename Value="synhighlighterlua.pas"/> 93 | <HasRegisterProc Value="True"/> 94 | <UnitName Value="SynHighlighterLua"/> 95 | </Item20> 96 | <Item21> 97 | <Filename Value="lcs_ftpwi.pas"/> 98 | <UnitName Value="lcs_ftpwi"/> 99 | </Item21> 100 | </Files> 101 | <RequiredPkgs Count="4"> 102 | <Item1> 103 | <PackageName Value="laz_synapse"/> 104 | </Item1> 105 | <Item2> 106 | <PackageName Value="SynEdit"/> 107 | </Item2> 108 | <Item3> 109 | <PackageName Value="LCL"/> 110 | </Item3> 111 | <Item4> 112 | <PackageName Value="FCL"/> 113 | </Item4> 114 | </RequiredPkgs> 115 | <UsageOptions> 116 | <UnitPath Value="$(PkgOutDir)"/> 117 | </UsageOptions> 118 | <PublishOptions> 119 | <Version Value="2"/> 120 | </PublishOptions> 121 | <CustomOptions Items="ExternHelp" Version="2"> 122 | <_ExternHelp Items="Count"/> 123 | </CustomOptions> 124 | </Package> 125 | </CONFIG> 126 | -------------------------------------------------------------------------------- /lcs_package/lcs_package.pas: -------------------------------------------------------------------------------- 1 | { This file was automatically created by Lazarus. Do not edit! 2 | This source is only used to compile and install the package. 3 | } 4 | 5 | unit lcs_package; 6 | 7 | interface 8 | 9 | uses 10 | lcs_application, lcs_crypto, lcs_debug, lcs_debugform, lcs_dialog, 11 | lcs_dialog_input, lcs_file, lcs_folder, lcs_http, lcs_inifile, 12 | lcs_registerall, lcs_registry, lcs_string, lcs_table, lcs_textfile, lcs_zip, 13 | lua53, SynHighlighterLua, lcs_ftpwi, LazarusPackageIntf; 14 | 15 | implementation 16 | 17 | procedure Register; 18 | begin 19 | RegisterUnit('SynHighlighterLua', @SynHighlighterLua.Register); 20 | end; 21 | 22 | initialization 23 | RegisterPackage('lcs_package', @Register); 24 | end. 25 | -------------------------------------------------------------------------------- /lcs_package/lcs_registerall.pas: -------------------------------------------------------------------------------- 1 | unit lcs_registerall; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, Lua53; 9 | 10 | procedure RegisterAll(L: Plua_State; S: TStrings); 11 | 12 | implementation 13 | 14 | uses 15 | lcs_string, lcs_inifile, lcs_registry, lcs_textfile, lcs_zip, lcs_table, 16 | lcs_crypto, lcs_folder, lcs_file, lcs_application, lcs_debug, lcs_dialog, 17 | lcs_http, lcs_ftpwi; 18 | 19 | procedure RegisterAll(L: Plua_State; S: TStrings); 20 | begin 21 | RegisterString(L); 22 | RegisterINIFile(L); 23 | RegisterRegistry(L); 24 | RegisterTextFile(L); 25 | RegisterZip(L); 26 | RegisterTable(L, S); 27 | RegisterCrypto(L); 28 | RegisterFolder(L); 29 | RegisterFile(L); 30 | RegisterApplication(L); 31 | RegisterDebug(L); 32 | RegisterDialog(L); 33 | RegisterHTTP(L); 34 | RegisterFTPWI(L); 35 | end; 36 | 37 | end. 38 | 39 | -------------------------------------------------------------------------------- /lcs_package/lcs_registry.pas: -------------------------------------------------------------------------------- 1 | unit lcs_registry; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, Registry, LazUTF8, Lua53; 9 | 10 | procedure RegisterRegistry(L: Plua_State); 11 | 12 | function RegistryCreateKey(L: Plua_State): integer; cdecl; 13 | function RegistryDeleteKey(L: Plua_State): integer; cdecl; 14 | function RegistryDeleteValue(L: Plua_State): integer; cdecl; 15 | function RegistryDoesKeyExist(L: Plua_State): integer; cdecl; 16 | function RegistryGetAccess(L: Plua_State): integer; cdecl; 17 | function RegistryGetKeyNames(L: Plua_State): integer; cdecl; 18 | function RegistryGetValue(L: Plua_State): integer; cdecl; 19 | function RegistryGetValueNames(L: Plua_State): integer; cdecl; 20 | function RegistryGetValueType(L: Plua_State): integer; cdecl; 21 | function RegistrySetValue(L: Plua_State): integer; cdecl; 22 | 23 | implementation 24 | 25 | procedure RegisterRegistry(L: Plua_State); 26 | 27 | procedure RegisterFunction(n: string; f: lua_CFunction); 28 | var 29 | reg: luaL_Reg; 30 | begin 31 | reg.Name := PChar(n); 32 | reg.func := f; 33 | luaL_setfuncs(L, reg, 0); 34 | end; 35 | 36 | begin 37 | lua_newtable(L); 38 | RegisterFunction('CreateKey', @RegistryCreateKey); 39 | RegisterFunction('DeleteKey', @RegistryDeleteKey); 40 | RegisterFunction('DeleteValue', @RegistryDeleteValue); 41 | RegisterFunction('DoesKeyExist', @RegistryDoesKeyExist); 42 | RegisterFunction('GetAccess', @RegistryGetAccess); 43 | RegisterFunction('GetKeyNames', @RegistryGetKeyNames); 44 | RegisterFunction('GetValue', @RegistryGetValue); 45 | RegisterFunction('GetValueNames', @RegistryGetValueNames); 46 | RegisterFunction('GetValueType', @RegistryGetValueType); 47 | RegisterFunction('SetValue', @RegistrySetValue); 48 | lua_setglobal(L, 'Registry'); 49 | end; 50 | 51 | function GetRootKey(i: integer): HKEY; 52 | begin 53 | case i of 54 | 0: Result := HKEY_CLASSES_ROOT; 55 | 1: Result := HKEY_CURRENT_CONFIG; 56 | 2: Result := HKEY_CURRENT_USER; 57 | 3: Result := HKEY_LOCAL_MACHINE; 58 | 4: Result := HKEY_USERS; 59 | else 60 | Result := HKEY_CLASSES_ROOT; 61 | end; 62 | end; 63 | 64 | function RegistryCreateKey(L: Plua_State): integer; cdecl; 65 | var 66 | reg: TRegistry; 67 | begin 68 | reg := TRegistry.Create; 69 | reg.RootKey := GetRootKey(lua_tointeger(L, -2)); 70 | reg.CreateKey(lua_tostring(L, -1)); 71 | reg.Free; 72 | Result := 0; 73 | end; 74 | 75 | function RegistryDeleteKey(L: Plua_State): integer; cdecl; 76 | var 77 | reg: TRegistry; 78 | begin 79 | reg := TRegistry.Create; 80 | reg.RootKey := GetRootKey(lua_tointeger(L, -2)); 81 | reg.DeleteKey(lua_tostring(L, -1)); 82 | reg.Free; 83 | Result := 0; 84 | end; 85 | 86 | function RegistryDeleteValue(L: Plua_State): integer; cdecl; 87 | var 88 | reg: TRegistry; 89 | begin 90 | reg := TRegistry.Create; 91 | reg.RootKey := GetRootKey(lua_tointeger(L, -3)); 92 | reg.OpenKey(lua_tostring(L, -2), True); 93 | reg.DeleteValue(lua_tostring(L, -1)); 94 | reg.Free; 95 | Result := 0; 96 | end; 97 | 98 | function RegistryDoesKeyExist(L: Plua_State): integer; cdecl; 99 | var 100 | reg: TRegistry; 101 | begin 102 | reg := TRegistry.Create; 103 | reg.RootKey := GetRootKey(lua_tointeger(L, -2)); 104 | lua_pushboolean(L, reg.OpenKeyReadOnly(lua_tostring(L, -1))); 105 | reg.Free; 106 | Result := 1; 107 | end; 108 | 109 | function RegistryGetAccess(L: Plua_State): integer; cdecl; 110 | var 111 | reg: TRegistry; 112 | begin 113 | reg := TRegistry.Create; 114 | reg.RootKey := GetRootKey(lua_tointeger(L, -3)); 115 | reg.Access := lua_tointeger(L, -1); 116 | lua_pushboolean(L, reg.OpenKey(lua_tostring(L, -2), True)); 117 | reg.Free; 118 | Result := 1; 119 | end; 120 | 121 | function RegistryGetKeyNames(L: Plua_State): integer; cdecl; 122 | var 123 | reg: TRegistry; 124 | s: TStringList; 125 | i: integer; 126 | begin 127 | reg := TRegistry.Create; 128 | reg.RootKey := GetRootKey(lua_tointeger(L, -2)); 129 | reg.OpenKeyReadOnly(lua_tostring(L, -1)); 130 | s := TStringList.Create; 131 | reg.GetKeyNames(s); 132 | reg.Free; 133 | 134 | lua_newtable(L); 135 | for i := 0 to s.Count - 1 do 136 | begin 137 | lua_pushstring(L, s[i]); 138 | lua_rawseti(L, -2, i); 139 | end; 140 | 141 | s.Free; 142 | Result := 1; 143 | end; 144 | 145 | function RegistryGetValue(L: Plua_State): integer; cdecl; 146 | 147 | function StringToHex(S: string): string; 148 | var 149 | I: integer; 150 | begin 151 | Result := ''; 152 | for I := 1 to length(S) do 153 | Result := Result + IntToHex(Ord(S[i]), 2) + ' '; 154 | Result := UTF8Copy(Result, 1, UTF8Length(Result) - 1); 155 | end; 156 | 157 | var 158 | reg: TRegistry; 159 | Data: string; 160 | Info: TRegDataInfo; 161 | begin 162 | reg := TRegistry.Create; 163 | reg.RootKey := GetRootKey(lua_tointeger(L, -3)); 164 | reg.OpenKeyReadOnly(lua_tostring(L, -2)); 165 | case reg.GetDataType(lua_tostring(L, -1)) of 166 | rdUnknown: 167 | begin 168 | lua_pushstring(L, ''); 169 | end; 170 | rdString: 171 | begin 172 | lua_pushstring(L, reg.ReadString(lua_tostring(L, -1))); 173 | end; 174 | rdExpandString: 175 | begin 176 | lua_pushstring(L, reg.ReadString(lua_tostring(L, -1))); 177 | end; 178 | rdBinary: 179 | begin 180 | reg.GetDataInfo(lua_tostring(L, -1), Info); 181 | SetLength(Data, Info.DataSize); 182 | reg.ReadBinaryData(lua_tostring(L, -1), Data[1], Length(Data)); 183 | Data := StringToHex(Data); 184 | lua_pushstring(L, Data); 185 | end; 186 | rdInteger: 187 | begin 188 | lua_pushstring(L, IntToStr(reg.ReadInteger(lua_tostring(L, -1)))); 189 | end; 190 | end; 191 | reg.Free; 192 | Result := 1; 193 | end; 194 | 195 | function RegistryGetValueNames(L: Plua_State): integer; cdecl; 196 | var 197 | reg: TRegistry; 198 | s: TStringList; 199 | i: integer; 200 | begin 201 | reg := TRegistry.Create; 202 | reg.RootKey := GetRootKey(lua_tointeger(L, -2)); 203 | reg.OpenKeyReadOnly(lua_tostring(L, -1)); 204 | s := TStringList.Create; 205 | reg.GetValueNames(s); 206 | reg.Free; 207 | 208 | lua_newtable(L); 209 | for i := 0 to s.Count - 1 do 210 | begin 211 | lua_pushstring(L, s[i]); 212 | lua_rawseti(L, -2, i); 213 | end; 214 | 215 | s.Free; 216 | Result := 1; 217 | end; 218 | 219 | function RegistryGetValueType(L: Plua_State): integer; cdecl; 220 | var 221 | reg: TRegistry; 222 | begin 223 | reg := TRegistry.Create; 224 | reg.RootKey := GetRootKey(lua_tointeger(L, -3)); 225 | reg.OpenKeyReadOnly(lua_tostring(L, -2)); 226 | lua_pushinteger(L, integer(reg.GetDataType(lua_tostring(L, -1)))); 227 | reg.Free; 228 | Result := 1; 229 | end; 230 | 231 | function RegistrySetValue(L: Plua_State): integer; cdecl; 232 | 233 | function HexToStr(s: string): string; 234 | var 235 | i: integer; 236 | begin 237 | Result := ''; 238 | i := 1; 239 | while i < Length(s) do 240 | begin 241 | Result := Result + Chr(StrToIntDef('$' + Copy(s, i, 2), 0)); 242 | Inc(i, 2); 243 | end; 244 | end; 245 | 246 | var 247 | reg: TRegistry; 248 | Data: string; 249 | begin 250 | reg := TRegistry.Create; 251 | reg.RootKey := GetRootKey(lua_tointeger(L, -5)); 252 | reg.OpenKey(lua_tostring(L, -4), True); 253 | case lua_tointeger(L, -1) of 254 | 1: reg.WriteString(lua_tostring(L, -3), lua_tostring(L, -2)); 255 | 2: reg.WriteExpandString(lua_tostring(L, -3), lua_tostring(L, -2)); 256 | 3: 257 | begin 258 | Data := lua_tostring(L, -2); 259 | Data := StringReplace(Data, ' ', '', [rfReplaceAll]); 260 | Data := HexToStr(Data); 261 | reg.WriteBinaryData(lua_tostring(L, -3), Data[1], (Length(Data)) * 262 | SizeOf(byte)); 263 | end; 264 | 4: reg.WriteInteger(lua_tostring(L, -3), lua_tointeger(L, -2)); 265 | 7: ; 266 | end; 267 | reg.Free; 268 | Result := 0; 269 | end; 270 | 271 | end. 272 | -------------------------------------------------------------------------------- /lcs_package/lcs_string.pas: -------------------------------------------------------------------------------- 1 | unit lcs_string; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, LazUTF8, Lua53; 9 | 10 | procedure RegisterString(L: Plua_State); 11 | 12 | //function AbbreviateFilePath(L: Plua_State): integer; cdecl; 13 | function StringAsc(L: Plua_State): integer; cdecl; 14 | function StringChar(L: Plua_State): integer; cdecl; 15 | function StringCompare(L: Plua_State): integer; cdecl; 16 | function StringCompareFileVersions(L: Plua_state): integer; cdecl; 17 | function StringCompareNoCase(L: Plua_State): integer; cdecl; 18 | function StringConcat(L: Plua_State): integer; cdecl; 19 | function StringFind(L: Plua_State): integer; cdecl; 20 | function StringGetFormattedSize(L: Plua_State): integer; cdecl; 21 | function StringLeft(L: Plua_State): integer; cdecl; 22 | function StringLength(L: Plua_State): integer; cdecl; 23 | function StringLower(L: Plua_State): integer; cdecl; 24 | //function StringMakePath(L: Plua_State): integer; cdecl; 25 | function StringMid(L: Plua_State): integer; cdecl; 26 | function StringRepeat(L: Plua_State): integer; cdecl; 27 | function StringReplaceLua(L: Plua_State): integer; cdecl; 28 | function StringReverseFind(L: Plua_State): integer; cdecl; 29 | function StringRight(L: Plua_State): integer; cdecl; 30 | //function StringSplitPath(L: Plua_State): integer; cdecl; 31 | function StringToNumber(L: Plua_State): integer; cdecl; 32 | //function StringTrimLeft(L: Plua_State): integer; cdecl; 33 | //function StringTrimRight(L: Plua_State): integer; cdecl; 34 | function StringUpper(L: Plua_State): integer; cdecl; 35 | 36 | implementation 37 | 38 | procedure RegisterString(L: Plua_State); 39 | 40 | procedure RegisterFunction(n: string; f: lua_CFunction); 41 | var 42 | reg: luaL_Reg; 43 | begin 44 | reg.Name := PChar(n); 45 | reg.func := f; 46 | luaL_setfuncs(L, reg, 0); 47 | end; 48 | 49 | begin 50 | lua_newtable(L); 51 | RegisterFunction('Asc', @StringAsc); 52 | RegisterFunction('Char', @StringChar); 53 | RegisterFunction('Compare', @StringCompare); 54 | RegisterFunction('CompareFileVersions', @StringCompareFileVersions); 55 | RegisterFunction('CompareNoCase', @StringCompareNoCase); 56 | RegisterFunction('Concat', @StringConcat); 57 | RegisterFunction('Find', @StringFind); 58 | RegisterFunction('GetFormattedSize', @StringGetFormattedSize); 59 | RegisterFunction('Left', @StringLeft); 60 | RegisterFunction('Length', @StringLength); 61 | RegisterFunction('Lower', @StringLower); 62 | RegisterFunction('Mid', @StringMid); 63 | RegisterFunction('Repeat', @StringRepeat); 64 | RegisterFunction('Replace', @StringReplaceLua); 65 | RegisterFunction('ReverseFind', @StringReverseFind); 66 | RegisterFunction('Right', @StringRight); 67 | RegisterFunction('ToNumber', @StringToNumber); 68 | RegisterFunction('Upper', @StringUpper); 69 | lua_setglobal(L, 'String'); 70 | end; 71 | 72 | function StringAsc(L: Plua_State): integer; cdecl; 73 | var 74 | i: integer; 75 | begin 76 | lua_pushinteger(L, UTF8CharacterToUnicode(lua_tostring(L, -1), i)); 77 | Result := 1; 78 | end; 79 | 80 | function StringChar(L: Plua_State): integer; cdecl; 81 | begin 82 | lua_pushstring(L, UnicodeToUTF8(lua_tointeger(L, -1))); 83 | Result := 1; 84 | end; 85 | 86 | function StringCompare(L: Plua_State): integer; cdecl; 87 | var 88 | s1, s2: string; 89 | r: integer; 90 | begin 91 | s1 := lua_tostring(L, -2); 92 | s2 := lua_tostring(L, -1); 93 | 94 | if (s1 = s2) then 95 | r := 0 96 | else if (s1 < s2) then 97 | r := -1 98 | else 99 | r := 1; 100 | 101 | lua_pushinteger(L, r); 102 | Result := 1; 103 | end; 104 | 105 | function StringCompareFileVersions(L: Plua_state): integer; cdecl; 106 | 107 | function Compare(s1, s2: TStringList; index: integer): integer; 108 | begin 109 | if (s1[index] = s2[index]) then 110 | Result := 0 111 | else if (s1[index] < s2[index]) then 112 | Result := -1 113 | else 114 | Result := 1; 115 | end; 116 | 117 | var 118 | i, j, res: integer; 119 | s1, s2: TStringList; 120 | begin 121 | s1 := TStringList.Create; 122 | s2 := TStringList.Create; 123 | s1.Delimiter := '.'; 124 | s2.Delimiter := '.'; 125 | s1.DelimitedText := lua_tostring(L, -2); 126 | s2.DelimitedText := lua_tostring(L, -1); 127 | 128 | if (s1.Count = s2.Count) then 129 | j := s1.Count 130 | else if (s1.Count < s2.Count) then 131 | j := s1.Count 132 | else 133 | j := s2.Count; 134 | 135 | for i := 0 to j - 1 do 136 | begin 137 | res := Compare(s1, s2, i); 138 | if res <> 0 then 139 | break; 140 | end; 141 | 142 | s1.Free; 143 | s2.Free; 144 | 145 | lua_pushinteger(L, res); 146 | Result := 1; 147 | end; 148 | 149 | function StringCompareNoCase(L: Plua_State): integer; cdecl; 150 | var 151 | s1, s2: string; 152 | r: integer; 153 | begin 154 | s1 := UTF8LowerCase(lua_tostring(L, -2)); 155 | s2 := UTF8LowerCase(lua_tostring(L, -1)); 156 | 157 | if (s1 = s2) then 158 | r := 0 159 | else if (s1 < s2) then 160 | r := -1 161 | else 162 | r := 1; 163 | 164 | lua_pushinteger(L, r); 165 | Result := 1; 166 | end; 167 | 168 | function StringConcat(L: Plua_State): integer; cdecl; 169 | begin 170 | lua_pushstring(L, string(lua_tostring(L, -2)) + string(lua_tostring(L, -1))); 171 | Result := 1; 172 | end; 173 | 174 | function StringFind(L: Plua_State): integer; cdecl; 175 | var 176 | s1, s2: string; 177 | index, res: integer; 178 | begin 179 | s1 := lua_tostring(L, -4); 180 | s2 := lua_tostring(L, -3); 181 | index := integer(lua_tointeger(L, -2)); 182 | if lua_toboolean(L, -1) then 183 | res := UTF8Pos(s2, s1, index) 184 | else 185 | res := UTF8Pos(UTF8LowerCase(s2), UTF8LowerCase(s1), index); 186 | lua_pushinteger(L, res); 187 | Result := 1; 188 | end; 189 | 190 | function StringGetFormattedSize(L: Plua_State): integer; cdecl; 191 | var 192 | sres: string; 193 | res: lua_number; 194 | bytes: int64; 195 | format: integer; 196 | begin 197 | bytes := lua_tointeger(L, -2); 198 | format := lua_tointeger(L, -1); 199 | 200 | if format = 1 then 201 | case bytes of 202 | 0..999: format := 2; // Byte 203 | 1000..999999: format := 3; // Kilobyte 204 | 1000000..999999999: format := 4; // Megabyte 205 | 1000000000..999999999999: format := 5; // Gigabyte 206 | 1000000000000..999999999999999: format := 6; // Terabyte 207 | end; 208 | 209 | case format of 210 | 2: res := bytes; // Byte 211 | 3: res := bytes / 1000; // Kilobyte 212 | 4: res := bytes / 1000000; // Megabyte 213 | 5: res := bytes / 1000000000; // Gigabyte 214 | 6: res := bytes / 1000000000000; // Terabyte 215 | end; 216 | 217 | sres := FloatToStr(res, DefaultFormatSettings); 218 | 219 | case format of 220 | 2: sres += ' Byte'; 221 | 3: sres += ' KB'; 222 | 4: sres += ' MB'; 223 | 5: sres += ' GB'; 224 | 6: sres += ' TB'; 225 | end; 226 | 227 | lua_pushstring(L, sres); 228 | Result := 1; 229 | end; 230 | 231 | function StringLeft(L: Plua_State): integer; cdecl; 232 | begin 233 | lua_pushstring(L, UTF8LeftStr(lua_tostring(L, -2), lua_tointeger(L, -1))); 234 | Result := 1; 235 | end; 236 | 237 | function StringLength(L: Plua_State): integer; cdecl; 238 | begin 239 | lua_pushinteger(L, UTF8Length(lua_tostring(L, -1))); 240 | Result := 1; 241 | end; 242 | 243 | function StringLower(L: Plua_State): integer; cdecl; 244 | begin 245 | lua_pushstring(L, UTF8LowerCase(lua_tostring(L, -1))); 246 | Result := 1; 247 | end; 248 | 249 | function StringMid(L: Plua_State): integer; cdecl; 250 | begin 251 | lua_pushstring(L, UTF8Copy(lua_tostring(L, -3), lua_tointeger(L, -2), 252 | lua_tointeger(L, -1))); 253 | Result := 1; 254 | end; 255 | 256 | function StringRepeat(L: Plua_State): integer; cdecl; 257 | var 258 | i, j: int64; 259 | s, ls: string; 260 | begin 261 | ls := lua_tostring(L, -2); 262 | j := integer(lua_tointeger(L, -1)); 263 | s := ''; 264 | i := 0; 265 | while (i < j) do 266 | begin 267 | s += ls; 268 | Inc(i); 269 | end; 270 | lua_pushstring(L, s); 271 | Result := 1; 272 | end; 273 | 274 | function StringReplaceLua(L: Plua_State): integer; cdecl; 275 | begin 276 | if lua_toboolean(L, -1) then 277 | lua_pushstring(L, StringReplace(lua_tostring(L, -4), lua_tostring(L, -3), 278 | lua_tostring(L, -2), [rfReplaceAll])) 279 | else 280 | lua_pushstring(L, StringReplace(lua_tostring(L, -4), lua_tostring(L, -3), 281 | lua_tostring(L, -2), [rfReplaceAll, rfIgnoreCase])); 282 | Result := 1; 283 | end; 284 | 285 | function StringReverseFind(L: Plua_State): integer; cdecl; 286 | 287 | function UTF8ReverseString(const AText: string): string; 288 | var 289 | i: integer; 290 | begin 291 | Result := ''; 292 | for i := UTF8Length(AText) - 1 downto 0 do 293 | Result := Result + UTF8Copy(AText, i + 1, 1); 294 | end; 295 | 296 | var 297 | s1, s2: string; 298 | res: integer; 299 | begin 300 | s1 := UTF8ReverseString(lua_tostring(L, -3)); 301 | s2 := UTF8ReverseString(lua_tostring(L, -2)); 302 | if lua_toboolean(L, -1) then 303 | res := UTF8Pos(s2, s1) 304 | else 305 | res := UTF8Pos(UTF8LowerCase(s2), UTF8LowerCase(s1)); 306 | if res <> 0 then 307 | res := UTF8Length(s1) - UTF8Length(s2) - res + 2; 308 | lua_pushinteger(L, res); 309 | Result := 1; 310 | end; 311 | 312 | function StringRight(L: Plua_State): integer; cdecl; 313 | begin 314 | lua_pushstring(L, UTF8RightStr(lua_tostring(L, -2), lua_tointeger(L, -1))); 315 | Result := 1; 316 | end; 317 | 318 | function StringToNumber(L: Plua_State): integer; cdecl; 319 | begin 320 | lua_pushnumber(L, lua_tonumber(L, -1)); 321 | Result := 1; 322 | end; 323 | 324 | function StringUpper(L: Plua_State): integer; cdecl; 325 | begin 326 | lua_pushstring(L, UTF8UpperCase(lua_tostring(L, -1))); 327 | Result := 1; 328 | end; 329 | 330 | end. 331 | -------------------------------------------------------------------------------- /lcs_package/lcs_table.pas: -------------------------------------------------------------------------------- 1 | unit lcs_table; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, Lua53; 9 | 10 | procedure RegisterTable(L: Plua_State; S: TStrings); 11 | 12 | function TableCount(L: Plua_State): integer; cdecl; 13 | 14 | implementation 15 | 16 | procedure RegisterTable(L: Plua_State; S: TStrings); 17 | 18 | procedure RegisterFunction(n: string; f: lua_CFunction); 19 | var 20 | reg: luaL_Reg; 21 | begin 22 | reg.Name := PChar(n); 23 | reg.func := f; 24 | luaL_setfuncs(L, reg, 0); 25 | end; 26 | 27 | var 28 | s1: TStringList; 29 | begin 30 | lua_newtable(L); 31 | RegisterFunction('Count', @TableCount); 32 | lua_setglobal(L, 'Table'); 33 | 34 | s1 := TStringList.Create; 35 | s1.Add('Table.Concat = table.concat;'); 36 | s1.Add('Table.Insert = table.insert;'); 37 | s1.Add('Table.Remove = table.remove;'); 38 | s1.Add('Table.Sort = table.sort;'); 39 | s.Insert(0, s1.Text); 40 | s1.Free; 41 | end; 42 | 43 | function TableCount(L: Plua_State): integer; cdecl; 44 | var 45 | i: integer; 46 | begin 47 | i := 0; 48 | lua_pushnil(L); 49 | while (lua_next(L, -2) <> 0) do 50 | begin 51 | Inc(i); 52 | lua_pop(L, 1); 53 | end; 54 | lua_pushinteger(L, i); 55 | Result := 1; 56 | end; 57 | 58 | end. 59 | 60 | -------------------------------------------------------------------------------- /lcs_package/lcs_textfile.pas: -------------------------------------------------------------------------------- 1 | unit lcs_textfile; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, Lua53; 9 | 10 | procedure RegisterTextFile(L: Plua_State); 11 | 12 | function TextFileReadToString(L: Plua_State): integer; cdecl; 13 | function TextFileReadToTable(L: Plua_State): integer; cdecl; 14 | function TextFileWriteFromString(L: Plua_State): integer; cdecl; 15 | function TextFileWriteFromTable(L: Plua_State): integer; cdecl; 16 | 17 | implementation 18 | 19 | procedure RegisterTextFile(L: Plua_State); 20 | 21 | procedure RegisterFunction(n: string; f: lua_CFunction); 22 | var 23 | reg: luaL_Reg; 24 | begin 25 | reg.Name := PChar(n); 26 | reg.func := f; 27 | luaL_setfuncs(L, reg, 0); 28 | end; 29 | 30 | begin 31 | lua_newtable(L); 32 | RegisterFunction('ReadToString', @TextFileReadToString); 33 | RegisterFunction('ReadToTable', @TextFileReadToTable); 34 | RegisterFunction('WriteFromString', @TextFileWriteFromString); 35 | RegisterFunction('WriteFromTable', @TextFileWriteFromTable); 36 | lua_setglobal(L, 'TextFile'); 37 | end; 38 | 39 | function TextFileReadToString(L: Plua_State): integer; cdecl; 40 | var 41 | s: TStringList; 42 | begin 43 | s := TStringList.Create; 44 | s.LoadFromFile(lua_tostring(L, -1)); 45 | lua_pushstring(L, s.Text); 46 | s.Free; 47 | Result := 1; 48 | end; 49 | 50 | function TextFileReadToTable(L: Plua_State): integer; cdecl; 51 | var 52 | s: TStringList; 53 | i: integer; 54 | begin 55 | s := TStringList.Create; 56 | s.LoadFromFile(lua_tostring(L, -1)); 57 | 58 | lua_newtable(L); 59 | for i := 0 to s.Count - 1 do 60 | begin 61 | lua_pushstring(L, s[i]); 62 | lua_rawseti(L, -2, i); 63 | end; 64 | 65 | s.Free; 66 | Result := 1; 67 | end; 68 | 69 | function TextFileWriteFromString(L: Plua_State): integer; cdecl; 70 | var 71 | s: TStringList; 72 | filename, Text: string; 73 | append: boolean; 74 | begin 75 | filename := lua_tostring(L, -3); 76 | Text := lua_tostring(L, -2); 77 | append := lua_toboolean(L, -1); 78 | 79 | s := TStringList.Create; 80 | 81 | if append then 82 | begin 83 | s.LoadFromFile(filename); 84 | s.Add(Text); 85 | end 86 | else 87 | begin 88 | s.Text := Text; 89 | end; 90 | 91 | s.SaveToFile(filename); 92 | s.Free; 93 | 94 | Result := 0; 95 | end; 96 | 97 | function TextFileWriteFromTable(L: Plua_State): integer; cdecl; 98 | var 99 | s: TStringList; 100 | filename: string; 101 | append: boolean; 102 | begin 103 | filename := lua_tostring(L, -3); 104 | append := lua_toboolean(L, -1); 105 | s := TStringList.Create; 106 | 107 | if append then 108 | s.LoadFromFile(filename); 109 | 110 | lua_settop(L, -2); 111 | 112 | lua_pushnil(L); 113 | while (lua_next(L, -2) <> 0) do 114 | begin 115 | s.Add(lua_tostring(L, -1)); 116 | lua_pop(L, 1); 117 | end; 118 | 119 | s.SaveToFile(filename); 120 | s.Free; 121 | Result := 0; 122 | end; 123 | 124 | end. 125 | 126 | -------------------------------------------------------------------------------- /lcs_package/lcs_zip.pas: -------------------------------------------------------------------------------- 1 | unit lcs_zip; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, Zipper, LazUTF8, Lua53; 9 | 10 | procedure RegisterZip(L: Plua_State); 11 | 12 | function ZipAdd(L: Plua_State): integer; cdecl; 13 | function ZipExtract(L: Plua_State): integer; cdecl; 14 | function ZipGetContents(L: Plua_State): integer; cdecl; 15 | 16 | implementation 17 | 18 | procedure RegisterZip(L: Plua_State); 19 | 20 | procedure RegisterFunction(n: string; f: lua_CFunction); 21 | var 22 | reg: luaL_Reg; 23 | begin 24 | reg.Name := PChar(n); 25 | reg.func := f; 26 | luaL_setfuncs(L, reg, 0); 27 | end; 28 | 29 | begin 30 | lua_newtable(L); 31 | RegisterFunction('Add', @ZipAdd); 32 | RegisterFunction('Extract', @ZipExtract); 33 | RegisterFunction('GetContents', @ZipGetContents); 34 | lua_setglobal(L, 'Zip'); 35 | end; 36 | 37 | function ZipAdd(L: Plua_State): integer; cdecl; 38 | var 39 | zip: TZipper; 40 | filename: string; 41 | files: TStringList; 42 | i: integer; 43 | begin 44 | filename := lua_tostring(L, -2); 45 | zip := TZipper.Create; 46 | 47 | files := TStringList.Create; 48 | 49 | lua_pushnil(L); 50 | while (lua_next(L, -2) <> 0) do 51 | begin 52 | files.Add(lua_tostring(L, -1)); 53 | lua_pop(L, 1); 54 | end; 55 | 56 | for i := 0 to files.Count - 1 do 57 | zip.Entries.AddFileEntry(files[i], ExtractFileName(files[i])); 58 | 59 | zip.FileName := filename; 60 | zip.ZipAllFiles; 61 | zip.Free; 62 | files.Free; 63 | Result := 0; 64 | end; 65 | 66 | function ZipExtract(L: Plua_State): integer; cdecl; 67 | var 68 | zip: TUnZipper; 69 | filename: string; 70 | destination: string; 71 | files: TStringList; 72 | i: integer; 73 | begin 74 | filename := lua_tostring(L, -3); 75 | destination := lua_tostring(L, -1); 76 | zip := TUnZipper.Create; 77 | zip.FileName := filename; 78 | zip.OutputPath := destination; 79 | 80 | files := TStringList.Create; 81 | 82 | lua_settop(L, -2); 83 | 84 | lua_pushnil(L); 85 | while (lua_next(L, -2) <> 0) do 86 | begin 87 | files.Add(lua_tostring(L, -1)); 88 | lua_pop(L, 1); 89 | end; 90 | 91 | zip.UnZipFiles(files); 92 | zip.Free; 93 | Result := 0; 94 | end; 95 | 96 | function ZipGetContents(L: Plua_State): integer; cdecl; 97 | var 98 | zip: TUnZipper; 99 | i, j: integer; 100 | Name: string; 101 | includefoldernames: boolean; 102 | begin 103 | zip := TUnZipper.Create; 104 | zip.FileName := lua_tostring(L, -2); 105 | zip.Examine; 106 | 107 | includefoldernames := lua_toboolean(L, -1); 108 | 109 | lua_newtable(L); 110 | j := 0; 111 | for i := 0 to zip.Entries.Count - 1 do 112 | begin 113 | Name := zip.Entries[i].ArchiveFileName; 114 | if includefoldernames then 115 | begin 116 | lua_pushstring(L, zip.Entries[i].ArchiveFileName); 117 | lua_rawseti(L, -2, i); 118 | end 119 | else 120 | if UTF8Copy(Name, UTF8Length(Name), 1) <> '/' then 121 | begin 122 | lua_pushstring(L, zip.Entries[i].ArchiveFileName); 123 | lua_rawseti(L, -2, j); 124 | Inc(j); 125 | end; 126 | end; 127 | 128 | zip.Free; 129 | Result := 1; 130 | end; 131 | 132 | end. 133 | 134 | -------------------------------------------------------------------------------- /lcs_package/lua53.pas: -------------------------------------------------------------------------------- 1 | (****************************************************************************** 2 | * * 3 | * File: lua53.pas * 4 | * * 5 | * Authors: TeCGraf (C headers + actual Lua libraries) * 6 | * Lavergne Thomas (original translation to Pascal) * 7 | * Bram Kuijvenhoven (update to Lua 5.1.1 for FreePascal) * 8 | * Egor Skriptunoff (update to Lua 5.2.1 for FreePascal) * 9 | * Vladimir Klimov (Delphi compatibility) * 10 | * Malcome@Japan (update to Lua 5.3.0 for FreePascal) * 11 | * * 12 | * Description: Basic Lua library * 13 | * Lua auxiliary library * 14 | * Standard Lua libraries * 15 | * This is 3-in-1 replacement for FPC modules lua.pas,lauxlib.pas,lualib.pas * 16 | * * 17 | ******************************************************************************) 18 | 19 | (* 20 | ** $Id: lua.h,v 1.325 2014/12/26 17:24:27 roberto Exp $ 21 | ** $Id: lauxlib.h,v 1.128 2014/10/29 16:11:17 roberto Exp $ 22 | ** $Id: lualib.h,v 1.44 2014/02/06 17:32:33 roberto Exp $ 23 | ** Lua - A Scripting Language 24 | ** Lua.org, PUC-Rio, Brazil (http://www.lua.org) 25 | ** See Copyright Notice at the end of this file 26 | *) 27 | (* 28 | ** Translated to pascal by Lavergne Thomas 29 | ** Notes : 30 | ** - Pointers type was prefixed with 'P' 31 | ** - lua_upvalueindex constant was transformed to function 32 | ** - Some compatibility function was isolated because with it you must have 33 | ** lualib. 34 | ** - LUA_VERSION was suffixed by '_' for avoiding name collision. 35 | ** Bug reports : 36 | ** - thomas.lavergne@laposte.net 37 | ** In french or in english 38 | *) 39 | (* 40 | ** Updated to Lua 5.1.1 by Bram Kuijvenhoven (bram at kuijvenhoven dot net), 41 | ** Hexis BV (http://www.hexis.nl), the Netherlands 42 | ** Notes: 43 | ** - Only tested with FPC (FreePascal Compiler) 44 | ** - Using LuaBinaries styled DLL/SO names, which include version names 45 | ** - LUA_YIELD was suffixed by '_' for avoiding name collision 46 | *) 47 | (* 48 | ** Updated to Lua 5.2.1 by Egor Skriptunoff 49 | ** Notes: 50 | ** - Only tested with FPC (FreePascal Compiler) 51 | ** - Functions dealing with luaL_Reg were overloaded to accept pointer 52 | ** or open array parameter. In any case, do not forget to terminate 53 | ** your array with "sentinel". 54 | ** - All floating-point exceptions were forcibly disabled in Windows 55 | ** to overcome well-known bug 56 | ** Bug reports: 57 | ** - egor.skriptunoff at gmail.com 58 | ** In russian or in english 59 | *) 60 | (* 61 | ** Delphi compatibility by Vladimir Klimov 62 | ** Notes: 63 | ** - fixed luaL_error syntax 64 | ** - PChar replaced with PAnsiChar, String with AnsiString due to since 65 | ** D2009 both PChar and String are unicode 66 | ** Bug reports: 67 | ** - wintarif@narod.ru 68 | ** russian or english 69 | *) 70 | (* 71 | ** Updated to Lua 5.3.0 by Malcome@Japan 72 | ** Notes: 73 | ** - Only tested with FPC (FreePascal Compiler) 74 | ** - Needs Delphi with Int64 supported. 75 | *) 76 | 77 | 78 | //-------------------------- 79 | // What was not translated: 80 | //-------------------------- 81 | // macro 82 | // #define luaL_opt(L,f,n,d) (lua_isnoneornil(L,(n)) ? (d) : f(L,(n))) 83 | 84 | // Generic Buffer manipulation functions and macros were not translated. 85 | // They are not required in Pascal programs due to powerful String type. 86 | // luaL_addchar, luaL_addsize, luaL_buffinit, luaL_prepbuffsize, 87 | // luaL_addlstring, luaL_addstring, luaL_addvalue, luaL_pushresult, 88 | // luaL_pushresultsize, luaL_buffinitsize, luaL_prepbuffer 89 | 90 | // Functions defined with LUA_COMPAT_MODULE are deprecated. 91 | // They were translated but commented intentionally. 92 | // Uncomment them if you really need. 93 | // luaL_pushmodule, luaL_openlib, luaL_register 94 | 95 | 96 | {$IFDEF FPC}{$MODE OBJFPC}{$H+}{$ENDIF} 97 | 98 | unit lua53; 99 | 100 | interface 101 | 102 | const 103 | {$IFDEF MSWINDOWS} 104 | LUA_LIB_NAME = 'lua53.dll'; 105 | {$ELSE} 106 | LUA_LIB_NAME = 'liblua53.so'; 107 | {$ENDIF} 108 | 109 | const 110 | LUA_VERSION_MAJOR = '5'; 111 | LUA_VERSION_MINOR = '3'; 112 | LUA_VERSION_NUM = 503; 113 | LUA_VERSION_RELEASE = '0'; 114 | LUA_VERSION_ = 'Lua 5.3'; // LUA_VERSION was suffixed by '_' for avoiding name collision 115 | LUA_RELEASE = 'Lua 5.3.0'; 116 | LUA_COPYRIGHT = 'Lua 5.3.0 Copyright (C) 1994-2015 Lua.org, PUC-Rio'; 117 | LUA_AUTHORS = 'R. Ierusalimschy, L. H. de Figueiredo, W. Celes'; 118 | LUA_SIGNATURE = #27'Lua'; // mark for precompiled code '<esc>Lua' 119 | LUA_MULTRET = -1; // option for multiple returns in 'lua_pcall' and 'lua_call' 120 | 121 | // pseudo-indices 122 | LUA_REGISTRYINDEX = -1001000; 123 | 124 | function lua_upvalueindex(I: Integer): Integer; inline; 125 | 126 | // thread status 127 | const 128 | LUA_OK = 0; 129 | LUA_YIELD_ = 1; // LUA_YIELD was suffixed by '_' for avoiding name collision 130 | LUA_ERRRUN = 2; 131 | LUA_ERRSYNTAX = 3; 132 | LUA_ERRMEM = 4; 133 | LUA_ERRGCMM = 5; 134 | LUA_ERRERR = 6; 135 | LUA_ERRFILE = LUA_ERRERR + 1; // extra error code for `luaL_load' 136 | 137 | type 138 | // Type of Numbers in Lua 139 | {$IFDEF FPC} 140 | lua_Integer = Int64; 141 | lua_Unsigned = UInt64; 142 | {$ELSE} // Delphi 143 | {$IF CompilerVersion < 18} 144 | lua_Integer = Int64; 145 | lua_Unsigned = Int64; 146 | {$ELSE} 147 | lua_Integer = Int64; 148 | lua_Unsigned = UInt64; 149 | {$IFEND} 150 | {$ENDIF} 151 | 152 | Plua_Integer = ^lua_Integer; 153 | Plua_Unsigned = ^lua_Unsigned; 154 | 155 | lua_Number = Double; 156 | Plua_Number = ^lua_Number; 157 | 158 | size_t = Cardinal; 159 | Psize_t = ^size_t; 160 | 161 | Plua_State = Pointer; 162 | 163 | // type for continuation-function contexts 164 | lua_KContext = Pointer; 165 | 166 | lua_CFunction = function(L: Plua_State): Integer; cdecl; 167 | 168 | // Type for continuation functions 169 | lua_KFunction = function(L: Plua_State; status: Integer; ctx: lua_KContext): Integer; cdecl; 170 | 171 | // functions that read/write blocks when loading/dumping Lua chunks 172 | lua_Reader = function(L: Plua_State; ud: Pointer; sz: Psize_t): PAnsiChar; cdecl; 173 | lua_Writer = function(L: Plua_State; const p: Pointer; sz: size_t; ud: Pointer): Integer; cdecl; 174 | 175 | // prototype for memory-allocation functions 176 | lua_Alloc = function(ud, ptr: Pointer; osize, nsize: size_t): Pointer; cdecl; 177 | 178 | const 179 | // basic types 180 | LUA_TNONE = -1; 181 | LUA_TNIL = 0; 182 | LUA_TBOOLEAN = 1; 183 | LUA_TLIGHTUSERDATA = 2; 184 | LUA_TNUMBER = 3; 185 | LUA_TSTRING = 4; 186 | LUA_TTABLE = 5; 187 | LUA_TFUNCTION = 6; 188 | LUA_TUSERDATA = 7; 189 | LUA_TTHREAD = 8; 190 | LUA_NUMTAGS = 9; 191 | 192 | // minimum Lua stack available to a C function 193 | LUA_MINSTACK = 20; 194 | 195 | // predefined values in the registry */ 196 | LUA_RIDX_MAINTHREAD = 1; 197 | LUA_RIDX_GLOBALS = 2; 198 | LUA_RIDX_LAST = LUA_RIDX_GLOBALS; 199 | 200 | // state manipulation 201 | function lua_newstate(f: lua_Alloc; ud: Pointer): Plua_state; cdecl; 202 | procedure lua_close(L: Plua_State); cdecl; 203 | function lua_newthread(L: Plua_State): Plua_State; cdecl; 204 | function lua_atpanic(L: Plua_State; panicf: lua_CFunction): lua_CFunction; cdecl; 205 | function lua_version(L: Plua_State): Plua_Number; cdecl; 206 | 207 | // basic stack manipulation 208 | function lua_absindex(L: Plua_State; idx: Integer): Integer; cdecl; 209 | function lua_gettop(L: Plua_State): Integer; cdecl; 210 | procedure lua_settop(L: Plua_State; idx: Integer); cdecl; 211 | procedure lua_pushvalue(L: Plua_State; Idx: Integer); cdecl; 212 | procedure lua_rotate(L: Plua_State; idx, n: Integer); cdecl; 213 | procedure lua_remove(L: Plua_State; idx: Integer); inline; 214 | procedure lua_insert(L: Plua_State; idx: Integer); inline; 215 | procedure lua_replace(L: Plua_State; idx: Integer); inline; 216 | procedure lua_copy(L: Plua_State; fromidx, toidx: Integer); cdecl; 217 | function lua_checkstack(L: Plua_State; n: Integer): LongBool; cdecl; 218 | 219 | procedure lua_xmove(from, to_: Plua_State; n: Integer); cdecl; 220 | 221 | // access functions (stack -> C) 222 | function lua_isnumber(L: Plua_State; idx: Integer): LongBool; cdecl; 223 | function lua_isstring(L: Plua_State; idx: Integer): LongBool; cdecl; 224 | function lua_iscfunction(L: Plua_State; idx: Integer): LongBool; cdecl; 225 | function lua_isinteger(L: Plua_State; idx: Integer): LongBool; cdecl; 226 | function lua_isuserdata(L: Plua_State; idx: Integer): LongBool; cdecl; 227 | function lua_type(L: Plua_State; idx: Integer): Integer; cdecl; 228 | function lua_typename(L: Plua_State; tp: Integer): PAnsiChar; cdecl; 229 | function lua_tonumberx(L: Plua_State; idx: Integer; isnum: PLongBool): lua_Number; cdecl; 230 | function lua_tointegerx(L: Plua_State; idx: Integer; isnum: PLongBool): lua_Integer; cdecl; 231 | function lua_toboolean(L: Plua_State; idx: Integer): LongBool; cdecl; 232 | function lua_tolstring(L: Plua_State; idx: Integer; len: Psize_t): PAnsiChar; cdecl; 233 | function lua_rawlen(L: Plua_State; idx: Integer): size_t; cdecl; 234 | function lua_tocfunction(L: Plua_State; idx: Integer): lua_CFunction; cdecl; 235 | function lua_touserdata(L: Plua_State; idx: Integer): Pointer; cdecl; 236 | function lua_tothread(L: Plua_State; idx: Integer): Plua_State; cdecl; 237 | function lua_topointer(L: Plua_State; idx: Integer): Pointer; cdecl; 238 | 239 | // Arithmetic functions 240 | const 241 | LUA_OPADD = 0; (* ORDER TM, ORDER OP *) 242 | LUA_OPSUB = 1; 243 | LUA_OPMUL = 2; 244 | LUA_OPMOD = 3; 245 | LUA_OPPOW = 4; 246 | LUA_OPDIV = 5; 247 | LUA_OPIDIV = 6; 248 | LUA_OPBAND = 7; 249 | LUA_OPBOR = 8; 250 | LUA_OPBXOR = 9; 251 | LUA_OPSHL = 10; 252 | LUA_OPSHR = 11; 253 | LUA_OPUNM = 12; 254 | LUA_OPBNOT = 13; 255 | 256 | procedure lua_arith(L: Plua_State; op: Integer); cdecl; 257 | 258 | // Comparison functions 259 | const 260 | LUA_OPEQ = 0; 261 | LUA_OPLT = 1; 262 | LUA_OPLE = 2; 263 | 264 | function lua_rawequal(L: Plua_State; idx1, idx2: Integer): LongBool; cdecl; 265 | function lua_compare(L: Plua_State; idx1, idx2, op: Integer): LongBool; cdecl; 266 | 267 | // push functions (C -> stack) 268 | procedure lua_pushnil(L: Plua_State); cdecl; 269 | procedure lua_pushnumber(L: Plua_State; n: lua_Number); cdecl; 270 | procedure lua_pushinteger(L: Plua_State; n: lua_Integer); cdecl; 271 | procedure lua_pushlstring(L: Plua_State; const s: PAnsiChar; len: size_t); cdecl; 272 | procedure lua_pushstring(L: Plua_State; const s: PAnsiChar); cdecl; overload; 273 | procedure lua_pushstring(L: Plua_State; const s: AnsiString); inline; overload; // added for Pascal 274 | function lua_pushvfstring(L: Plua_State; const fmt: PAnsiChar; argp: Pointer): PAnsiChar; cdecl; 275 | function lua_pushfstring(L: Plua_State; const fmt: PAnsiChar): PAnsiChar; cdecl; varargs; 276 | procedure lua_pushcclosure(L: Plua_State; fn: lua_CFunction; n: Integer); cdecl; 277 | procedure lua_pushboolean(L: Plua_State; b: LongBool); cdecl; 278 | procedure lua_pushlightuserdata(L: Plua_State; p: Pointer); cdecl; 279 | procedure lua_pushthread(L: Plua_State); cdecl; 280 | 281 | // get functions (Lua -> stack) 282 | function lua_getglobal(L: Plua_State; const name: PAnsiChar): Integer; cdecl; 283 | function lua_gettable(L: Plua_State; idx: Integer): Integer; cdecl; 284 | function lua_getfield(L: Plua_state; idx: Integer; k: PAnsiChar): Integer; cdecl; 285 | function lua_geti(L: Plua_State; idx: Integer; n: lua_Integer): Integer cdecl; 286 | function lua_rawget(L: Plua_State; idx: Integer): Integer; cdecl; 287 | function lua_rawgeti(L: Plua_State; idx, n: Integer): Integer; cdecl; 288 | function lua_rawgetp(L: Plua_State; idx: Integer; p: Pointer): Integer; cdecl; 289 | 290 | procedure lua_createtable(L: Plua_State; narr, nrec: Integer); cdecl; 291 | function lua_newuserdata(L: Plua_State; sz: size_t): Pointer; cdecl; 292 | function lua_getmetatable(L: Plua_State; objindex: Integer): Integer; cdecl; 293 | function lua_getuservalue(L: Plua_State; idx: Integer): Integer; cdecl; 294 | 295 | // set functions (stack -> Lua) 296 | procedure lua_setglobal(L: Plua_State; const name: PAnsiChar); cdecl; 297 | procedure lua_settable(L: Plua_State; idx: Integer); cdecl; 298 | procedure lua_setfield(L: Plua_State; idx: Integer; k: PAnsiChar); cdecl; 299 | procedure lua_seti(L: Plua_State; idx: Integer; n: lua_Integer); cdecl; 300 | procedure lua_rawset(L: Plua_State; idx: Integer); cdecl; 301 | procedure lua_rawseti(L: Plua_State; idx: Integer; n: lua_Integer); cdecl; 302 | procedure lua_rawsetp(L: Plua_State; idx: Integer; p: Pointer); cdecl; 303 | function lua_setmetatable(L: Plua_State; objindex: Integer): Integer; cdecl; 304 | procedure lua_setuservalue(L: Plua_State; idx: Integer); cdecl; 305 | 306 | // 'load' and 'call' functions (load and run Lua code) 307 | procedure lua_callk(L: Plua_State; nargs, nresults: Integer; ctx: lua_KContext; k: lua_KFunction); cdecl; 308 | procedure lua_call(L: Plua_State; nargs, nresults: Integer); inline; 309 | function lua_pcallk(L: Plua_State; nargs, nresults, errfunc: Integer; ctx: lua_KContext; k: lua_KFunction): Integer; cdecl; 310 | function lua_pcall(L: Plua_State; nargs, nresults, errf: Integer): Integer; inline; 311 | function lua_load(L: Plua_State; reader: lua_Reader; dt: Pointer; const chunkname, mode: PAnsiChar): Integer; cdecl; 312 | function lua_dump(L: Plua_State; writer: lua_Writer; data: Pointer; strip: Integer): Integer; cdecl; 313 | 314 | // coroutine functions 315 | function lua_yieldk(L: Plua_State; nresults: Integer; ctx: lua_KContext; k: lua_KFunction): Integer; cdecl; 316 | function lua_yield(L: Plua_State; nresults: Integer): Integer; inline; 317 | function lua_resume(L, from: Plua_State; narg: Integer): Integer; cdecl; 318 | function lua_status(L: Plua_State): Integer; cdecl; 319 | function lua_isyieldable(L: Plua_State): LongBool; cdecl; 320 | 321 | // garbage-collection function and options 322 | const 323 | LUA_GCSTOP = 0; 324 | LUA_GCRESTART = 1; 325 | LUA_GCCOLLECT = 2; 326 | LUA_GCCOUNT = 3; 327 | LUA_GCCOUNTB = 4; 328 | LUA_GCSTEP = 5; 329 | LUA_GCSETPAUSE = 6; 330 | LUA_GCSETSTEPMUL = 7; 331 | LUA_GCISRUNNING = 9; 332 | 333 | function lua_gc(L: Plua_State; what, data: Integer): Integer; cdecl; 334 | 335 | // miscellaneous functions 336 | function lua_error(L: Plua_State): Integer; cdecl; 337 | 338 | function lua_next(L: Plua_State; idx: Integer): Integer; cdecl; 339 | 340 | procedure lua_concat(L: Plua_State; n: Integer); cdecl; 341 | procedure lua_len(L: Plua_State; idx: Integer); cdecl; 342 | 343 | function lua_stringtonumber(L: Plua_State; const s: PAnsiChar): size_t; cdecl; 344 | 345 | function lua_getallocf(L: Plua_State; ud: PPointer): lua_Alloc; cdecl; 346 | procedure lua_setallocf(L: Plua_State; f: lua_Alloc; ud: Pointer); cdecl; 347 | 348 | // some useful macros 349 | function lua_getextraspace(L: Plua_State): Pointer; inline; 350 | function lua_tonumber(L: Plua_State; idx: Integer): lua_Number; inline; 351 | function lua_tointeger(L: Plua_State; idx: Integer): lua_Integer; inline; 352 | procedure lua_pop(L: Plua_State; n: Integer); inline; 353 | procedure lua_newtable(L: Plua_state); inline; 354 | procedure lua_register(L: Plua_State; const n: PAnsiChar; f: lua_CFunction); inline; 355 | procedure lua_pushcfunction(L: Plua_State; f: lua_CFunction); inline; 356 | function lua_isfunction(L: Plua_State; n: Integer): Boolean; inline; 357 | function lua_istable(L: Plua_State; n: Integer): Boolean; inline; 358 | function lua_islightuserdata(L: Plua_State; n: Integer): Boolean; inline; 359 | function lua_isnil(L: Plua_State; n: Integer): Boolean; inline; 360 | function lua_isboolean(L: Plua_State; n: Integer): Boolean; inline; 361 | function lua_isthread(L: Plua_State; n: Integer): Boolean; inline; 362 | function lua_isnone(L: Plua_State; n: Integer): Boolean; inline; 363 | function lua_isnoneornil(L: Plua_State; n: Integer): Boolean; inline; 364 | procedure lua_pushliteral(L: Plua_State; s: PAnsiChar); inline; 365 | procedure lua_pushglobaltable(L: Plua_State); inline; 366 | function lua_tostring(L: Plua_State; i: Integer): PAnsiChar; inline; 367 | 368 | // Debug API 369 | const 370 | // Event codes 371 | LUA_HOOKCALL = 0; 372 | LUA_HOOKRET = 1; 373 | LUA_HOOKLINE = 2; 374 | LUA_HOOKCOUNT = 3; 375 | LUA_HOOKTAILCALL = 4; 376 | 377 | // Event masks 378 | LUA_MASKCALL = 1 shl Ord(LUA_HOOKCALL); 379 | LUA_MASKRET = 1 shl Ord(LUA_HOOKRET); 380 | LUA_MASKLINE = 1 shl Ord(LUA_HOOKLINE); 381 | LUA_MASKCOUNT = 1 shl Ord(LUA_HOOKCOUNT); 382 | 383 | LUA_IDSIZE = 60; 384 | 385 | type 386 | lua_Debug = packed record (* activation record *) 387 | event: Integer; 388 | name: PAnsiChar; (* (n) *) 389 | namewhat: PAnsiChar; (* (n) `global', `local', `field', `method' *) 390 | what: PAnsiChar; (* (S) `Lua', `C', `main', `tail'*) 391 | source: PAnsiChar; (* (S) *) 392 | currentline: Integer; (* (l) *) 393 | linedefined: Integer; (* (S) *) 394 | lastlinedefined: Integer; (* (S) *) 395 | nups: Byte; (* (u) number of upvalues *) 396 | nparams: Byte; (* (u) number of parameters *) 397 | isvararg: ByteBool; (* (u) *) 398 | istailcall: ByteBool; (* (t) *) 399 | short_src: packed array[0..LUA_IDSIZE - 1] of AnsiChar; (* (S) *) 400 | (* private part *) 401 | i_ci: Pointer; (* active function *) // ptr to struct CallInfo 402 | end; 403 | Plua_Debug = ^lua_Debug; 404 | 405 | // Functions to be called by the debugger in specific events 406 | lua_Hook = procedure(L: Plua_State; ar: Plua_Debug); cdecl; 407 | 408 | function lua_getstack(L: Plua_State; level: Integer; ar: Plua_Debug): Integer; cdecl; 409 | function lua_getinfo(L: Plua_State; const what: PAnsiChar; ar: Plua_Debug): Integer; cdecl; 410 | function lua_getlocal(L: Plua_State; const ar: Plua_Debug; n: Integer): PAnsiChar; cdecl; 411 | function lua_setlocal(L: Plua_State; const ar: Plua_Debug; n: Integer): PAnsiChar; cdecl; 412 | function lua_getupvalue(L: Plua_State; funcindex, n: Integer): PAnsiChar; cdecl; 413 | function lua_setupvalue(L: Plua_State; funcindex, n: Integer): PAnsiChar; cdecl; 414 | function lua_upvalueid(L: Plua_State; funcindex, n: Integer): Pointer; cdecl; 415 | procedure lua_upvaluejoin(L: Plua_State; funcindex1, n1, funcindex2, n2: Integer); cdecl; 416 | procedure lua_sethook(L: Plua_State; func: lua_Hook; mask: Integer; count: Integer); cdecl; 417 | function lua_gethook(L: Plua_State): lua_Hook; cdecl; 418 | function lua_gethookmask(L: Plua_State): Integer; cdecl; 419 | function lua_gethookcount(L: Plua_State): Integer; cdecl; 420 | 421 | // pre-defined references 422 | const 423 | LUA_NOREF = -2; 424 | LUA_REFNIL = -1; 425 | 426 | LUAL_NUMSIZES = sizeof(lua_Integer)*16 + sizeof(lua_Number); 427 | 428 | type 429 | luaL_Reg = packed record 430 | name: PAnsiChar; 431 | func: lua_CFunction; 432 | end; 433 | PluaL_Reg = ^luaL_Reg; 434 | 435 | procedure luaL_checkversion_(L: Plua_State; ver: lua_Number; sz: size_t); cdecl; 436 | procedure luaL_checkversion(L: Plua_State); inline; 437 | function luaL_getmetafield(L: Plua_State; obj: Integer; const e: PAnsiChar): Integer; cdecl; 438 | function luaL_callmeta(L: Plua_State; obj: Integer; const e: PAnsiChar): Integer; cdecl; 439 | function luaL_tolstring(L: Plua_State; idx: Integer; len: Psize_t): PAnsiChar; cdecl; 440 | function luaL_argerror(L: Plua_State; arg: Integer; const extramsg: PAnsiChar): Integer; cdecl; 441 | function luaL_checklstring(L: Plua_State; arg: Integer; l_: Psize_t): PAnsiChar; cdecl; 442 | function luaL_optlstring(L: Plua_State; arg: Integer; const def: PAnsiChar; l_: Psize_t): PAnsiChar; cdecl; 443 | function luaL_checknumber(L: Plua_State; arg: Integer): lua_Number; cdecl; 444 | function luaL_optnumber(L: Plua_State; arg: Integer; def: lua_Number): lua_Number; cdecl; 445 | function luaL_checkinteger(L: Plua_State; arg: Integer): lua_Integer; cdecl; 446 | function luaL_optinteger(L: Plua_State; arg: Integer; def: lua_Integer): lua_Integer; cdecl; 447 | procedure luaL_checkstack(L: Plua_State; sz: Integer; const msg: PAnsiChar); cdecl; 448 | procedure luaL_checktype(L: Plua_State; arg, t: Integer); cdecl; 449 | procedure luaL_checkany(L: Plua_State; arg: Integer); cdecl; 450 | function luaL_newmetatable(L: Plua_State; const tname: PAnsiChar): Integer; cdecl; 451 | procedure luaL_setmetatable(L: Plua_State; const tname: PAnsiChar); cdecl; 452 | function luaL_testudata(L: Plua_State; ud: Integer; const tname: PAnsiChar): Pointer; cdecl; 453 | function luaL_checkudata(L: Plua_State; ud: Integer; const tname: PAnsiChar): Pointer; cdecl; 454 | procedure luaL_where(L: Plua_State; lvl: Integer); cdecl; 455 | function luaL_error(L: Plua_State; const fmt: PAnsiChar): Integer; cdecl; varargs; 456 | function luaL_checkoption(L: Plua_State; arg: Integer; def: PAnsiChar; lst: PPAnsiChar): Integer; cdecl; 457 | function luaL_fileresult(L: Plua_State; stat: Integer; const fname: PAnsiChar): Integer; cdecl; 458 | function luaL_execresult(L: Plua_State; stat: Integer): Integer; cdecl; 459 | function luaL_ref(L: Plua_State; t: Integer): Integer; cdecl; 460 | procedure luaL_unref(L: Plua_State; t, ref: Integer); cdecl; 461 | function luaL_loadfilex(L: Plua_State; const filename, mode: PAnsiChar): Integer; cdecl; 462 | function luaL_loadfile(L: Plua_State; const filename: PAnsiChar): Integer; inline; 463 | function luaL_loadbufferx(L: Plua_State; const buff: PAnsiChar; sz: size_t; const name, mode: PAnsiChar): Integer; cdecl; 464 | function luaL_loadstring(L: Plua_State; const s: PAnsiChar): Integer; cdecl; 465 | function luaL_newstate: Plua_State; cdecl; 466 | function luaL_len(L: Plua_State; idx: Integer): lua_Integer; cdecl; 467 | function luaL_gsub(L: Plua_State; const s, p, r: PAnsiChar): PAnsiChar; cdecl; 468 | procedure luaL_setfuncs(L: Plua_State; lr: array of luaL_Reg; nup: Integer); inline; overload; 469 | procedure luaL_setfuncs(L: Plua_State; lr: PluaL_Reg; nup: Integer); cdecl; overload; 470 | function luaL_getsubtable(L: Plua_State; idx: Integer; const fname: PAnsiChar): Integer; cdecl; 471 | procedure luaL_traceback(L, L1: Plua_State; msg: PAnsiChar; level: Integer); cdecl; 472 | procedure luaL_requiref(L: Plua_State; const modname: PAnsiChar; openf: lua_CFunction; glb: LongBool); cdecl; 473 | 474 | // some useful macros 475 | procedure luaL_newlibtable(L: Plua_State; lr: array of luaL_Reg); inline; overload; 476 | procedure luaL_newlibtable(L: Plua_State; lr: PluaL_Reg); inline; overload; 477 | procedure luaL_newlib(L: Plua_State; lr: array of luaL_Reg); inline; overload; 478 | procedure luaL_newlib(L: Plua_State; lr: PluaL_Reg); inline; overload; 479 | procedure luaL_argcheck(L: Plua_State; cond: Boolean; arg: Integer; extramsg: PAnsiChar); inline; 480 | function luaL_checkstring(L: Plua_State; n: Integer): PAnsiChar; inline; 481 | function luaL_optstring(L: Plua_State; n: Integer; d: PAnsiChar): PAnsiChar; inline; 482 | function luaL_typename(L: Plua_State; i: Integer): PAnsiChar; inline; 483 | function luaL_dofile(L: Plua_State; const filename: PAnsiChar): Integer; inline; 484 | function luaL_dostring(L: Plua_State; const str: PAnsiChar): Integer; inline; 485 | procedure luaL_getmetatable(L: Plua_State; tname: PAnsiChar); inline; 486 | function luaL_loadbuffer(L: Plua_State; const buff: PAnsiChar; size: size_t; const name: PAnsiChar): Integer; inline; 487 | 488 | const 489 | LUA_COLIBNAME = 'coroutine'; 490 | LUA_TABLIBNAME = 'table'; 491 | LUA_IOLIBNAME = 'io'; 492 | LUA_OSLIBNAME = 'os'; 493 | LUA_STRLIBNAME = 'string'; 494 | LUA_UTF8LIBNAME = 'utf8'; 495 | LUA_BITLIBNAME = 'bit32'; 496 | LUA_MATHLIBNAME = 'math'; 497 | LUA_DBLIBNAME = 'debug'; 498 | LUA_LOADLIBNAME = 'package'; 499 | 500 | function luaopen_base(L: Plua_State): Integer; cdecl; 501 | function luaopen_coroutine(L: Plua_State): Integer; cdecl; 502 | function luaopen_table(L: Plua_State): Integer; cdecl; 503 | function luaopen_io(L: Plua_State): Integer; cdecl; 504 | function luaopen_os(L: Plua_State): Integer; cdecl; 505 | function luaopen_string(L: Plua_State): Integer; cdecl; 506 | function luaopen_utf8(L: Plua_State): Integer; cdecl; 507 | function luaopen_bit32(L: Plua_State): Integer; cdecl; 508 | function luaopen_math(L: Plua_State): Integer; cdecl; 509 | function luaopen_debug(L: Plua_State): Integer; cdecl; 510 | function luaopen_package(L: Plua_State): Integer; cdecl; 511 | 512 | // open all previous libraries 513 | procedure luaL_openlibs(L: Plua_State); cdecl; 514 | 515 | implementation 516 | 517 | function lua_upvalueindex(I: Integer): Integer; 518 | begin 519 | Result := LUA_REGISTRYINDEX - i; 520 | end; 521 | 522 | function lua_newstate(f: lua_Alloc; ud: Pointer): Plua_State; cdecl; external LUA_LIB_NAME; 523 | procedure lua_close(L: Plua_State); cdecl; external LUA_LIB_NAME; 524 | function lua_newthread(L: Plua_State): Plua_State; cdecl; external LUA_LIB_NAME; 525 | function lua_atpanic(L: Plua_State; panicf: lua_CFunction): lua_CFunction; cdecl; external LUA_LIB_NAME; 526 | function lua_version(L: Plua_State): Plua_Number; cdecl; external LUA_LIB_NAME; 527 | function lua_absindex(L: Plua_State; idx: Integer): Integer; cdecl; external LUA_LIB_NAME; 528 | function lua_gettop(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; 529 | procedure lua_settop(L: Plua_State; idx: Integer); cdecl; external LUA_LIB_NAME; 530 | procedure lua_pushvalue(L: Plua_State; Idx: Integer); cdecl; external LUA_LIB_NAME; 531 | procedure lua_rotate(L: Plua_State; idx, n: Integer); cdecl; external LUA_LIB_NAME; 532 | 533 | procedure lua_remove(L: Plua_State; idx: Integer); 534 | begin 535 | lua_rotate(L, idx, -1); 536 | lua_pop(L, 1); 537 | end; 538 | 539 | procedure lua_insert(L: Plua_State; idx: Integer); 540 | begin 541 | lua_rotate(L, idx, 1); 542 | end; 543 | 544 | procedure lua_replace(L: Plua_State; idx: Integer); 545 | begin 546 | lua_copy(L, -1, idx); 547 | lua_pop(L, 1); 548 | end; 549 | 550 | procedure lua_copy(L: Plua_State; fromidx, toidx: Integer); cdecl; external LUA_LIB_NAME; 551 | function lua_checkstack(L: Plua_State; n: Integer): LongBool; cdecl; external LUA_LIB_NAME; 552 | procedure lua_xmove(from, to_: Plua_State; n: Integer); cdecl; external LUA_LIB_NAME; 553 | function lua_isnumber(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_LIB_NAME; 554 | function lua_isstring(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_LIB_NAME; 555 | function lua_iscfunction(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_LIB_NAME; 556 | function lua_isinteger(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_LIB_NAME; 557 | function lua_isuserdata(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_LIB_NAME; 558 | function lua_type(L: Plua_State; idx: Integer): Integer; cdecl; external LUA_LIB_NAME; 559 | function lua_typename(L: Plua_State; tp: Integer): PAnsiChar; cdecl; external LUA_LIB_NAME; 560 | function lua_tonumberx(L: Plua_State; idx: Integer; isnum: PLongBool): lua_Number; cdecl; external LUA_LIB_NAME; 561 | function lua_tointegerx(L: Plua_State; idx: Integer; isnum: PLongBool): lua_Integer; cdecl; external LUA_LIB_NAME; 562 | procedure lua_arith(L: Plua_State; op: Integer); cdecl; external LUA_LIB_NAME; 563 | function lua_rawequal(L: Plua_State; idx1, idx2: Integer): LongBool; cdecl; external LUA_LIB_NAME; 564 | function lua_compare(L: Plua_State; idx1, idx2, op: Integer): LongBool; cdecl; external LUA_LIB_NAME; 565 | function lua_toboolean(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_LIB_NAME; 566 | function lua_tolstring(L: Plua_State; idx: Integer; len: Psize_t): PAnsiChar; cdecl; external LUA_LIB_NAME; 567 | function lua_rawlen(L: Plua_State; idx: Integer): size_t; cdecl; external LUA_LIB_NAME; 568 | function lua_tocfunction(L: Plua_State; idx: Integer): lua_CFunction; cdecl; external LUA_LIB_NAME; 569 | function lua_touserdata(L: Plua_State; idx: Integer): Pointer; cdecl; external LUA_LIB_NAME; 570 | function lua_tothread(L: Plua_State; idx: Integer): Plua_State; cdecl; external LUA_LIB_NAME; 571 | function lua_topointer(L: Plua_State; idx: Integer): Pointer; cdecl; external LUA_LIB_NAME; 572 | procedure lua_pushnil(L: Plua_State); cdecl; external LUA_LIB_NAME; 573 | procedure lua_pushnumber(L: Plua_State; n: lua_Number); cdecl; external LUA_LIB_NAME; 574 | procedure lua_pushinteger(L: Plua_State; n: lua_Integer); cdecl; external LUA_LIB_NAME; 575 | procedure lua_pushlstring(L: Plua_State; const s: PAnsiChar; len: size_t); cdecl; external LUA_LIB_NAME; 576 | procedure lua_pushstring(L: Plua_State; const s: PAnsiChar); cdecl; external LUA_LIB_NAME; 577 | 578 | procedure lua_pushstring(L: Plua_State; const s: AnsiString); 579 | begin 580 | lua_pushlstring(L, PAnsiChar(s), Length(s)); 581 | end; 582 | 583 | function lua_pushvfstring(L: Plua_State; const fmt: PAnsiChar; argp: Pointer): PAnsiChar; cdecl; external LUA_LIB_NAME; 584 | function lua_pushfstring(L: Plua_State; const fmt: PAnsiChar): PAnsiChar; cdecl; varargs; external LUA_LIB_NAME; 585 | procedure lua_pushcclosure(L: Plua_State; fn: lua_CFunction; n: Integer); cdecl; external LUA_LIB_NAME; 586 | procedure lua_pushboolean(L: Plua_State; b: LongBool); cdecl; external LUA_LIB_NAME; 587 | procedure lua_pushlightuserdata(L: Plua_State; p: Pointer); cdecl; external LUA_LIB_NAME; 588 | procedure lua_pushthread(L: Plua_State); cdecl; external LUA_LIB_NAME; 589 | function lua_getglobal(L: Plua_State; const name: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; 590 | function lua_gettable(L: Plua_State; idx: Integer): Integer; cdecl; external LUA_LIB_NAME; 591 | function lua_getfield(L: Plua_state; idx: Integer; k: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; 592 | function lua_geti(L: Plua_State; idx: Integer; n: lua_Integer): Integer cdecl; external LUA_LIB_NAME; 593 | function lua_rawget(L: Plua_State; idx: Integer): Integer; cdecl; external LUA_LIB_NAME; 594 | function lua_rawgeti(L: Plua_State; idx, n: Integer): Integer; cdecl; external LUA_LIB_NAME; 595 | function lua_rawgetp(L: Plua_State; idx: Integer; p: Pointer): Integer; cdecl; external LUA_LIB_NAME; 596 | procedure lua_createtable(L: Plua_State; narr, nrec: Integer); cdecl; external LUA_LIB_NAME; 597 | function lua_newuserdata(L: Plua_State; sz: size_t): Pointer; cdecl; external LUA_LIB_NAME; 598 | function lua_getmetatable(L: Plua_State; objindex: Integer): Integer; cdecl; external LUA_LIB_NAME; 599 | function lua_getuservalue(L: Plua_State; idx: Integer): Integer; cdecl; external LUA_LIB_NAME; 600 | procedure lua_setglobal(L: Plua_State; const name: PAnsiChar); cdecl; external LUA_LIB_NAME; 601 | procedure lua_settable(L: Plua_State; idx: Integer); cdecl; external LUA_LIB_NAME; 602 | procedure lua_setfield(L: Plua_State; idx: Integer; k: PAnsiChar); cdecl; external LUA_LIB_NAME; 603 | procedure lua_seti(L: Plua_State; idx: Integer; n: lua_Integer); cdecl; external LUA_LIB_NAME; 604 | procedure lua_rawset(L: Plua_State; idx: Integer); cdecl; external LUA_LIB_NAME; 605 | procedure lua_rawseti(L: Plua_State; idx: Integer; n: lua_Integer); cdecl; external LUA_LIB_NAME; 606 | procedure lua_rawsetp(L: Plua_State; idx: Integer; p: Pointer); cdecl; external LUA_LIB_NAME; 607 | function lua_setmetatable(L: Plua_State; objindex: Integer): Integer; cdecl; external LUA_LIB_NAME; 608 | procedure lua_setuservalue(L: Plua_State; idx: Integer); cdecl; external LUA_LIB_NAME; 609 | procedure lua_callk(L: Plua_State; nargs, nresults: Integer; ctx: lua_KContext; k: lua_KFunction); cdecl; external LUA_LIB_NAME; 610 | function lua_pcallk(L: Plua_State; nargs, nresults, errfunc: Integer; ctx: lua_KContext; k: lua_KFunction): Integer; cdecl; external LUA_LIB_NAME; 611 | function lua_load(L: Plua_State; reader: lua_Reader; dt: Pointer; const chunkname, mode: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; 612 | function lua_dump(L: Plua_State; writer: lua_Writer; data: Pointer; strip: Integer): Integer; cdecl; external LUA_LIB_NAME; 613 | function lua_yieldk(L: Plua_State; nresults: Integer; ctx: lua_KContext; k: lua_KFunction): Integer; cdecl; external LUA_LIB_NAME; 614 | 615 | procedure lua_call(L: Plua_State; nargs, nresults: Integer); 616 | begin 617 | lua_callk(L, nargs, nresults, nil, nil); 618 | end; 619 | 620 | function lua_pcall(L: Plua_State; nargs, nresults, errf: Integer): Integer; 621 | begin 622 | Result := lua_pcallk(L, nargs, nresults, errf, nil, nil); 623 | end; 624 | 625 | function lua_yield(L: Plua_State; nresults: Integer): Integer; 626 | begin 627 | Result := lua_yieldk(L, nresults, nil, nil); 628 | end; 629 | 630 | function lua_resume(L, from: Plua_State; narg: Integer): Integer; cdecl; external LUA_LIB_NAME; 631 | function lua_status(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; 632 | function lua_isyieldable(L: Plua_State): LongBool; cdecl; external LUA_LIB_NAME; 633 | function lua_gc(L: Plua_State; what, data: Integer): Integer; cdecl; external LUA_LIB_NAME; 634 | function lua_error(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; 635 | function lua_next(L: Plua_State; idx: Integer): Integer; cdecl; external LUA_LIB_NAME; 636 | procedure lua_concat(L: Plua_State; n: Integer); cdecl; external LUA_LIB_NAME; 637 | procedure lua_len(L: Plua_State; idx: Integer); cdecl; external LUA_LIB_NAME; 638 | function lua_stringtonumber(L: Plua_State; const s: PAnsiChar): size_t; cdecl; external LUA_LIB_NAME; 639 | function lua_getallocf(L: Plua_State; ud: PPointer): lua_Alloc; cdecl; external LUA_LIB_NAME; 640 | procedure lua_setallocf(L: Plua_State; f: lua_Alloc; ud: Pointer); cdecl; external LUA_LIB_NAME; 641 | 642 | function lua_getextraspace(L: Plua_State): Pointer; 643 | const 644 | LUA_EXTRASPACE = sizeof(Pointer); 645 | begin 646 | Result := L - LUA_EXTRASPACE; 647 | end; 648 | 649 | function lua_tonumber(L: Plua_State; idx: Integer): lua_Number; 650 | begin 651 | Result := lua_tonumberx(L, idx, nil); 652 | end; 653 | 654 | function lua_tointeger(L: Plua_State; idx: Integer): lua_Integer; 655 | begin 656 | Result := lua_tointegerx(L, idx, nil); 657 | end; 658 | 659 | procedure lua_pop(L: Plua_State; n: Integer); 660 | begin 661 | lua_settop(L, - n - 1); 662 | end; 663 | 664 | procedure lua_newtable(L: Plua_State); 665 | begin 666 | lua_createtable(L, 0, 0); 667 | end; 668 | 669 | procedure lua_register(L: Plua_State; const n: PAnsiChar; f: lua_CFunction); 670 | begin 671 | lua_pushcfunction(L, f); 672 | lua_setglobal(L, n); 673 | end; 674 | 675 | procedure lua_pushcfunction(L: Plua_State; f: lua_CFunction); 676 | begin 677 | lua_pushcclosure(L, f, 0); 678 | end; 679 | 680 | function lua_isfunction(L: Plua_State; n: Integer): Boolean; 681 | begin 682 | Result := lua_type(L, n) = LUA_TFUNCTION; 683 | end; 684 | 685 | function lua_istable(L: Plua_State; n: Integer): Boolean; 686 | begin 687 | Result := lua_type(L, n) = LUA_TTABLE; 688 | end; 689 | 690 | function lua_islightuserdata(L: Plua_State; n: Integer): Boolean; 691 | begin 692 | Result := lua_type(L, n) = LUA_TLIGHTUSERDATA; 693 | end; 694 | 695 | function lua_isnil(L: Plua_State; n: Integer): Boolean; 696 | begin 697 | Result := lua_type(L, n) = LUA_TNIL; 698 | end; 699 | 700 | function lua_isboolean(L: Plua_State; n: Integer): Boolean; 701 | begin 702 | Result := lua_type(L, n) = LUA_TBOOLEAN; 703 | end; 704 | 705 | function lua_isthread(L: Plua_State; n: Integer): Boolean; 706 | begin 707 | Result := lua_type(L, n) = LUA_TTHREAD; 708 | end; 709 | 710 | function lua_isnone(L: Plua_State; n: Integer): Boolean; 711 | begin 712 | Result := lua_type(L, n) = LUA_TNONE; 713 | end; 714 | 715 | function lua_isnoneornil(L: Plua_State; n: Integer): Boolean; 716 | begin 717 | Result := lua_type(L, n) <= 0; 718 | end; 719 | 720 | procedure lua_pushliteral(L: Plua_State; s: PAnsiChar); 721 | begin 722 | lua_pushlstring(L, s, Length(s)); 723 | end; 724 | 725 | procedure lua_pushglobaltable(L: Plua_State); 726 | begin 727 | lua_rawgeti(L, LUA_REGISTRYINDEX, LUA_RIDX_GLOBALS); 728 | end; 729 | 730 | function lua_tostring(L: Plua_State; i: Integer): PAnsiChar; 731 | begin 732 | Result := lua_tolstring(L, i, nil); 733 | end; 734 | 735 | function lua_getstack(L: Plua_State; level: Integer; ar: Plua_Debug): Integer; cdecl; external LUA_LIB_NAME; 736 | function lua_getinfo(L: Plua_State; const what: PAnsiChar; ar: Plua_Debug): Integer; cdecl; external LUA_LIB_NAME; 737 | function lua_getlocal(L: Plua_State; const ar: Plua_Debug; n: Integer): PAnsiChar; cdecl; external LUA_LIB_NAME; 738 | function lua_setlocal(L: Plua_State; const ar: Plua_Debug; n: Integer): PAnsiChar; cdecl; external LUA_LIB_NAME; 739 | function lua_getupvalue(L: Plua_State; funcindex, n: Integer): PAnsiChar; cdecl; external LUA_LIB_NAME; 740 | function lua_setupvalue(L: Plua_State; funcindex, n: Integer): PAnsiChar; cdecl; external LUA_LIB_NAME; 741 | function lua_upvalueid(L: Plua_State; funcindex, n: Integer): Pointer; cdecl; external LUA_LIB_NAME; 742 | procedure lua_upvaluejoin(L: Plua_State; funcindex1, n1, funcindex2, n2: Integer); cdecl; external LUA_LIB_NAME; 743 | procedure lua_sethook(L: Plua_State; func: lua_Hook; mask: Integer; count: Integer); cdecl; external LUA_LIB_NAME; 744 | function lua_gethook(L: Plua_State): lua_Hook; cdecl; external LUA_LIB_NAME; 745 | function lua_gethookmask(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; 746 | function lua_gethookcount(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; 747 | 748 | procedure luaL_checkversion_(L: Plua_State; ver: lua_Number; sz: size_t); cdecl; external LUA_LIB_NAME; 749 | 750 | procedure luaL_checkversion(L: Plua_State); 751 | begin 752 | luaL_checkversion_(L, LUA_VERSION_NUM, LUAL_NUMSIZES); 753 | end; 754 | 755 | procedure luaL_traceback(L, L1: Plua_State; msg: PAnsiChar; level: Integer); cdecl; external LUA_LIB_NAME; 756 | function luaL_argerror(L: Plua_State; arg: Integer; const extramsg: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; 757 | procedure luaL_where(L: Plua_State; lvl: Integer); cdecl; external LUA_LIB_NAME; 758 | function luaL_newmetatable(L: Plua_State; const tname: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; 759 | procedure luaL_setmetatable(L: Plua_State; const tname: PAnsiChar); cdecl; external LUA_LIB_NAME; 760 | function luaL_testudata(L: Plua_State; ud: Integer; const tname: PAnsiChar): Pointer; cdecl; external LUA_LIB_NAME; 761 | function luaL_checkudata(L: Plua_State; ud: Integer; const tname: PAnsiChar): Pointer; cdecl; external LUA_LIB_NAME; 762 | function luaL_error(L: Plua_State; const fmt: PAnsiChar): Integer; cdecl; varargs; external LUA_LIB_NAME; 763 | function luaL_checkoption(L: Plua_State; arg: Integer; def: PAnsiChar; lst: PPAnsiChar): Integer; cdecl; external LUA_LIB_NAME; 764 | procedure luaL_checkstack(L: Plua_State; sz: Integer; const msg: PAnsiChar); cdecl; external LUA_LIB_NAME; 765 | procedure luaL_checktype(L: Plua_State; arg, t: Integer); cdecl; external LUA_LIB_NAME; 766 | procedure luaL_checkany(L: Plua_State; arg: Integer); cdecl; external LUA_LIB_NAME; 767 | function luaL_checklstring(L: Plua_State; arg: Integer; l_: Psize_t): PAnsiChar; cdecl; external LUA_LIB_NAME; 768 | function luaL_optlstring(L: Plua_State; arg: Integer; const def: PAnsiChar; l_: Psize_t): PAnsiChar; cdecl; external LUA_LIB_NAME; 769 | function luaL_checknumber(L: Plua_State; arg: Integer): lua_Number; cdecl; external LUA_LIB_NAME; 770 | function luaL_optnumber(L: Plua_State; arg: Integer; def: lua_Number): lua_Number; cdecl; external LUA_LIB_NAME; 771 | function luaL_checkinteger(L: Plua_State; arg: Integer): lua_Integer; cdecl; external LUA_LIB_NAME; 772 | function luaL_optinteger(L: Plua_State; arg: Integer; def: lua_Integer): lua_Integer; cdecl; external LUA_LIB_NAME; 773 | 774 | procedure luaL_argcheck(L: Plua_State; cond: Boolean; arg: Integer; extramsg: PAnsiChar); 775 | begin 776 | if not cond then 777 | luaL_argerror(L, arg, extramsg); 778 | end; 779 | 780 | function luaL_checkstring(L: Plua_State; n: Integer): PAnsiChar; 781 | begin 782 | Result := luaL_checklstring(L, n, nil); 783 | end; 784 | 785 | function luaL_optstring(L: Plua_State; n: Integer; d: PAnsiChar): PAnsiChar; 786 | begin 787 | Result := luaL_optlstring(L, n, d, nil); 788 | end; 789 | 790 | function luaL_typename(L: Plua_State; i: Integer): PAnsiChar; 791 | begin 792 | Result := lua_typename(L, lua_type(L, i)); 793 | end; 794 | 795 | function luaL_dofile(L: Plua_State; const filename: PAnsiChar): Integer; 796 | begin 797 | Result := luaL_loadfile(L, filename); 798 | if Result = 0 then 799 | Result := lua_pcall(L, 0, LUA_MULTRET, 0); 800 | end; 801 | 802 | function luaL_dostring(L: Plua_State; const str: PAnsiChar): Integer; 803 | begin 804 | Result := luaL_loadstring(L, str); 805 | if Result = 0 then 806 | Result := lua_pcall(L, 0, LUA_MULTRET, 0); 807 | end; 808 | 809 | procedure luaL_getmetatable(L: Plua_State; tname: PAnsiChar); 810 | begin 811 | lua_getfield(L, LUA_REGISTRYINDEX, tname); 812 | end; 813 | 814 | function luaL_fileresult(L: Plua_State; stat: Integer; const fname: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; 815 | function luaL_execresult(L: Plua_State; stat: Integer): Integer; cdecl; external LUA_LIB_NAME; 816 | function luaL_ref(L: Plua_State; t: Integer): Integer; cdecl; external LUA_LIB_NAME; 817 | procedure luaL_unref(L: Plua_State; t, ref: Integer); cdecl; external LUA_LIB_NAME; 818 | function luaL_loadfilex(L: Plua_State; const filename, mode: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; 819 | function luaL_loadbufferx(L: Plua_State; const buff: PAnsiChar; sz: size_t; const name, mode: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; 820 | 821 | function luaL_loadfile(L: Plua_State; const filename: PAnsiChar): Integer; 822 | begin 823 | Result := luaL_loadfilex(L, filename, nil); 824 | end; 825 | 826 | function luaL_loadbuffer(L: Plua_State; const buff: PAnsiChar; size: size_t; const name: PAnsiChar): Integer; 827 | begin 828 | Result := luaL_loadbufferx(L, buff, size, name, nil); 829 | end; 830 | 831 | function luaL_loadstring(L: Plua_State; const s: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; 832 | function luaL_getmetafield(L: Plua_State; obj: Integer; const e: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; 833 | function luaL_callmeta(L: Plua_State; obj: Integer; const e: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; 834 | function luaL_tolstring(L: Plua_State; idx: Integer; len: Psize_t): PAnsiChar; cdecl; external LUA_LIB_NAME; 835 | procedure luaL_requiref(L: Plua_State; const modname: PAnsiChar; openf: lua_CFunction; glb: LongBool); cdecl; external LUA_LIB_NAME; 836 | procedure luaL_setfuncs(L: Plua_State; lr: PluaL_Reg; nup: Integer); cdecl; external LUA_LIB_NAME; 837 | 838 | procedure luaL_setfuncs(L: Plua_State; lr: array of luaL_Reg; nup: Integer); 839 | begin 840 | luaL_setfuncs(L, @lr, nup); 841 | end; 842 | 843 | procedure luaL_newlibtable(L: Plua_State; lr: array of luaL_Reg); 844 | begin 845 | lua_createtable(L, 0, High(lr)); 846 | end; 847 | 848 | procedure luaL_newlibtable(L: Plua_State; lr: PluaL_Reg); 849 | var 850 | n: Integer; 851 | begin 852 | n := 0; 853 | while lr^.name <> nil do begin 854 | inc(n); 855 | inc(lr); 856 | end; 857 | lua_createtable(L, 0, n); 858 | end; 859 | 860 | procedure luaL_newlib(L: Plua_State; lr: array of luaL_Reg); 861 | begin 862 | luaL_checkversion(L); 863 | luaL_newlibtable(L, lr); 864 | luaL_setfuncs(L, @lr, 0); 865 | end; 866 | 867 | procedure luaL_newlib(L: Plua_State; lr: PluaL_Reg); 868 | begin 869 | luaL_checkversion(L); 870 | luaL_newlibtable(L, lr); 871 | luaL_setfuncs(L, lr, 0); 872 | end; 873 | 874 | function luaL_gsub(L: Plua_State; const s, p, r: PAnsiChar): PAnsiChar; cdecl; external LUA_LIB_NAME; 875 | function luaL_getsubtable(L: Plua_State; idx: Integer; const fname: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; 876 | function luaL_newstate: Plua_State; cdecl; external LUA_LIB_NAME; 877 | function luaL_len(L: Plua_State; idx: Integer): lua_Integer; cdecl; external LUA_LIB_NAME; 878 | 879 | function luaopen_base(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; 880 | function luaopen_coroutine(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; 881 | function luaopen_table(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; 882 | function luaopen_io(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; 883 | function luaopen_os(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; 884 | function luaopen_string(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; 885 | function luaopen_utf8(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; 886 | function luaopen_bit32(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; 887 | function luaopen_math(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; 888 | function luaopen_debug(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; 889 | function luaopen_package(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; 890 | procedure luaL_openlibs(L: Plua_State); cdecl; external LUA_LIB_NAME; 891 | 892 | initialization 893 | {$IFDEF MSWINDOWS} 894 | Set8087CW($133F); // disable all floating-point exceptions 895 | {$ENDIF} 896 | 897 | (****************************************************************************** 898 | * Copyright (C) 1994-2015 Lua.org, PUC-Rio. 899 | * 900 | * Permission is hereby granted, free of charge, to any person obtaining 901 | * a copy of this software and associated documentation files (the 902 | * "Software"), to deal in the Software without restriction, including 903 | * without limitation the rights to use, copy, modify, merge, publish, 904 | * distribute, sublicense, and/or sell copies of the Software, and to 905 | * permit persons to whom the Software is furnished to do so, subject to 906 | * the following conditions: 907 | * 908 | * The above copyright notice and this permission notice shall be 909 | * included in all copies or substantial portions of the Software. 910 | * 911 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 912 | * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 913 | * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 914 | * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 915 | * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 916 | * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 917 | * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 918 | ******************************************************************************) 919 | 920 | end. 921 | -------------------------------------------------------------------------------- /lcs_package/synhighlighterlua.pas: -------------------------------------------------------------------------------- 1 | {------------------------------------------------------------------------------- 2 | The contents of this file are subject to the Mozilla Public License 3 | Version 1.1 (the "License"); you may not use this file except in compliance 4 | with the License. You may obtain a copy of the License at 5 | http://www.mozilla.org/MPL/ 6 | 7 | Software distributed under the License is distributed on an "AS IS" basis, 8 | WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 9 | the specific language governing rights and limitations under the License. 10 | 11 | The Original Code is: SynHighlighterGeneral.pas, released 2000-04-07. 12 | The Original Code is based on the mwGeneralSyn.pas file from the 13 | mwEdit component suite by Martin Waldenburg and other developers, the Initial 14 | Author of this file is Martin Waldenburg. 15 | Portions written by Martin Waldenburg are copyright 1999 Martin Waldenburg. 16 | All Rights Reserved. 17 | 18 | Contributors to the SynEdit and mwEdit projects are listed in the 19 | Contributors.txt file. 20 | 21 | Alternatively, the contents of this file may be used under the terms of the 22 | GNU General Public License Version 2 or later (the "GPL"), in which case 23 | the provisions of the GPL are applicable instead of those above. 24 | If you wish to allow use of your version of this file only under the terms 25 | of the GPL and not to allow others to use your version of this file 26 | under the MPL, indicate your decision by deleting the provisions above and 27 | replace them with the notice and other provisions required by the GPL. 28 | If you do not delete the provisions above, a recipient may use your version 29 | of this file under either the MPL or the GPL. 30 | 31 | $Id: SynHighlighterGeneral.pas,v 1.3 2000/11/08 22:09:59 mghie Exp $ 32 | 33 | You may retrieve the latest version of this file at the SynEdit home page, 34 | located at http://SynEdit.SourceForge.net 35 | 36 | Known Issues: 37 | ------------------------------------------------------------------------------- 38 | 39 | @abstract(Provides a customizable highlighter for SynEdit) 40 | @author(Martin Waldenburg, converted to SynEdit by Michael Hieke) 41 | @created(1999) 42 | @lastmod(2000-06-23) 43 | The SynHighlighterGeneral unit provides a customizable highlighter for SynEdit. 44 | 45 | Notes: March 21, 2006 46 | 47 | -SynHighlighterAny.pas converted for use with Lazarus by Lars (L505) 48 | 49 | Notes: July 17, 2016 50 | 51 | -SynHighlighterLua.pas added Lua comments, keywords, 52 | strings and colors by Lainz. 53 | } 54 | 55 | 56 | 57 | unit SynHighlighterLua; 58 | 59 | //{$I SynEdit.inc} 60 | 61 | interface 62 | 63 | uses 64 | SysUtils, Classes, LazUTF8, LazFileUtils, Controls, Graphics, Registry, 65 | SynEditTypes, SynEditHighlighter; 66 | 67 | type 68 | TtkTokenKind = (tkComment, tkIdentifier, tkKey, tkNull, tkNumber, 69 | tkPreprocessor, tkSpace, tkString, tkSymbol, tkUnknown, tkConstant, 70 | tkObject, tkEntity, tkDollarVariable, tkDot); 71 | 72 | TCommentStyle = (csAnsiStyle, csPasStyle, csCStyle, csAsmStyle, csBasStyle, csVBStyle); 73 | CommentStyles = set of TCommentStyle; 74 | 75 | TRangeState = (rsANil, rsAnsi, rsPasStyle, rsCStyle, rsLuaComment, 76 | rsLuaMComment, rsLuaMString, rsUnKnown); 77 | 78 | TStringDelim = (sdSingleQuote, sdDoubleQuote); 79 | 80 | TProcTableProc = procedure of object; 81 | 82 | type 83 | TIniList = class(TStringList) 84 | private 85 | function GetKeyIndex(asection, akey: string): integer; 86 | function GetKeyValue(asection, akey: string): string; 87 | public 88 | function ReadString(asection, akey, adefault: string): string; 89 | function ReadInteger(asection, akey: string; adefault: integer): integer; 90 | function ReadBool(asection, akey: string; adefault: boolean): boolean; 91 | procedure ReadSectionNames(asection: string; alist: TStrings); 92 | end; 93 | 94 | { TSynLuaSyn } 95 | 96 | TSynLuaSyn = class(TSynCustomHighlighter) 97 | private 98 | fUserData: TIniList; 99 | fMarkupOn: boolean; 100 | fRange: TRangeState; 101 | fLine: PChar; 102 | fProcTable: array[#0..#255] of TProcTableProc; 103 | Run: longint; 104 | fTokenPos: integer; 105 | fTokenID: TtkTokenKind; 106 | fLineNumber: integer; 107 | fCommentAttri: TSynHighlighterAttributes; 108 | fIdentifierAttri: TSynHighlighterAttributes; 109 | fKeyAttri: TSynHighlighterAttributes; 110 | fConstantAttri: TSynHighlighterAttributes; 111 | fObjectAttri: TSynHighlighterAttributes; 112 | fNumberAttri: TSynHighlighterAttributes; 113 | fPreprocessorAttri: TSynHighlighterAttributes; 114 | fSpaceAttri: TSynHighlighterAttributes; 115 | fStringAttri: TSynHighlighterAttributes; 116 | fSymbolAttri: TSynHighlighterAttributes; 117 | fKeyWords: TStrings; 118 | fConstants: TStrings; 119 | fObjects: TStrings; 120 | fComments: CommentStyles; 121 | fStringDelimCh: char; 122 | fIdentChars: TSynIdentChars; 123 | fDetectPreprocessor: boolean; 124 | FMarkup: boolean; 125 | FEntity: boolean; 126 | fEntityAttri: TSynHighlighterAttributes; 127 | FDollarVariables: boolean; 128 | fVariableAttri: TSynHighlighterAttributes; 129 | FActiveDot: boolean; 130 | FDotAttri: TSynHighlighterAttributes; 131 | procedure ApostropheProc; 132 | procedure AmpersandProc; 133 | procedure AsciiCharProc; 134 | procedure BraceOpenProc; 135 | procedure BraceCloseProc; 136 | procedure PointCommaProc; 137 | procedure CRProc; 138 | procedure DotProc; 139 | procedure IdentProc; 140 | procedure IntegerProc; 141 | procedure DollarProc; 142 | procedure LFProc; 143 | procedure NullProc; 144 | procedure NumberProc; 145 | procedure RoundOpenProc; 146 | procedure RoundCloseProc; 147 | procedure SlashProc; 148 | procedure LuaCommentOpenProc; 149 | procedure LuaCommentProc; 150 | procedure LuaMCommentOpenProc; 151 | procedure LuaMCommentProc; 152 | procedure LuaMStringOpenProc; 153 | procedure LuaMStringProc; 154 | procedure SpaceProc; 155 | procedure StringProc; 156 | procedure String2Proc; 157 | procedure UnknownProc; 158 | procedure GreaterThan; 159 | procedure SmallerThan; 160 | procedure MakeMethodTables; 161 | procedure AnsiProc; 162 | procedure PasStyleProc; 163 | procedure CStyleProc; 164 | procedure SetKeyWords(const Value: TStrings); 165 | procedure SetComments(Value: CommentStyles); 166 | function GetStringDelim: TStringDelim; 167 | procedure SetStringDelim(const Value: TStringDelim); 168 | function GetIdentifierChars: string; 169 | procedure SetIdentifierChars(const Value: string); 170 | procedure SetDetectPreprocessor(Value: boolean); 171 | procedure SetConstants(const Value: TStrings); 172 | procedure SetObjects(const Value: TStrings); 173 | function IsObject(const AObject: string): boolean; 174 | procedure SetMarkup(const Value: boolean); 175 | procedure SetEntity(const Value: boolean); 176 | procedure SetDollarVariables(const Value: boolean); 177 | procedure SetActiveDot(const Value: boolean); 178 | procedure SetDotAttri(const Value: TSynHighlighterAttributes); 179 | protected 180 | function GetIdentChars: TSynIdentChars; override; 181 | public 182 | class function GetLanguageName: string; override; 183 | public 184 | constructor Create(AOwner: TComponent); override; 185 | destructor Destroy; override; 186 | function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; 187 | override; 188 | function GetEol: boolean; override; 189 | function GetRange: Pointer; override; 190 | function GetTokenID: TtkTokenKind; 191 | function GetToken: string; override; 192 | procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); override; 193 | function GetTokenAttribute: TSynHighlighterAttributes; override; 194 | function GetTokenKind: integer; override; 195 | function GetTokenPos: integer; override; 196 | function IsKeyword(const AKeyword: string): boolean; 197 | override; //mh 2000-11-08 198 | function IsConstant(const AConstant: string): boolean; 199 | procedure Next; override; 200 | procedure ResetRange; override; 201 | procedure SetRange(Value: Pointer); override; 202 | procedure SetLine(const NewValue: string; LineNumber: integer); override; 203 | function SaveToRegistry(RootKey: HKEY; Key: string): boolean; override; 204 | function LoadFromRegistry(RootKey: HKEY; Key: string): boolean; override; 205 | procedure LoadHighLighter(aFile: string); 206 | published 207 | property CommentAttri: TSynHighlighterAttributes 208 | read fCommentAttri write fCommentAttri; 209 | property Comments: CommentStyles read fComments write SetComments; 210 | property DetectPreprocessor: boolean read fDetectPreprocessor 211 | write SetDetectPreprocessor; 212 | property IdentifierAttri: TSynHighlighterAttributes 213 | read fIdentifierAttri write fIdentifierAttri; 214 | property IdentifierChars: string read GetIdentifierChars write SetIdentifierChars; 215 | property KeyAttri: TSynHighlighterAttributes read fKeyAttri write fKeyAttri; 216 | property ConstantAttri: TSynHighlighterAttributes 217 | read fConstantAttri write fConstantAttri; 218 | property ObjectAttri: TSynHighlighterAttributes read fObjectAttri write fObjectAttri; 219 | property EntityAttri: TSynHighlighterAttributes read fEntityAttri write fEntityAttri; 220 | property VariableAttri: TSynHighlighterAttributes 221 | read fVariableAttri write fVariableAttri; 222 | property DotAttri: TSynHighlighterAttributes read FDotAttri write SetDotAttri; 223 | property KeyWords: TStrings read fKeyWords write SetKeyWords; 224 | property Constants: TStrings read fConstants write SetConstants; 225 | property Objects: TStrings read fObjects write SetObjects; 226 | property NumberAttri: TSynHighlighterAttributes 227 | read fNumberAttri write fNumberAttri; 228 | property PreprocessorAttri: TSynHighlighterAttributes 229 | read fPreprocessorAttri write fPreprocessorAttri; 230 | property SpaceAttri: TSynHighlighterAttributes read fSpaceAttri write fSpaceAttri; 231 | property StringAttri: TSynHighlighterAttributes 232 | read fStringAttri write fStringAttri; 233 | property SymbolAttri: TSynHighlighterAttributes 234 | read fSymbolAttri write fSymbolAttri; 235 | property StringDelim: TStringDelim read GetStringDelim 236 | write SetStringDelim default sdSingleQuote; 237 | property Markup: boolean read FMarkup write SetMarkup; 238 | property Entity: boolean read FEntity write SetEntity; 239 | property DollarVariables: boolean read FDollarVariables write SetDollarVariables; 240 | property ActiveDot: boolean read FActiveDot write SetActiveDot; 241 | end; 242 | 243 | procedure Register; 244 | 245 | implementation 246 | 247 | uses 248 | SynEditStrConst; 249 | 250 | var 251 | Identifiers: array[#0..#255] of bytebool; 252 | 253 | procedure Register; 254 | begin 255 | RegisterComponents('SynEdit', [TSynLuaSyn]); 256 | end; 257 | 258 | procedure MakeIdentTable; 259 | var 260 | I: char; 261 | idents: string; 262 | begin 263 | idents := '_0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-?!'; 264 | for I := #0 to #255 do 265 | begin 266 | if pos(i, idents) > 0 then 267 | identifiers[i] := True 268 | else 269 | identifiers[i] := False; 270 | // case I in ['_', '0'..'9', 'a'..'z', 'A'..'Z','-','?','!'] of true: Identifiers[I] := True; 271 | // else Identifiers[I] := False; 272 | // end; 273 | end; 274 | end; 275 | 276 | function TSynLuaSyn.IsKeyword(const AKeyword: string): boolean; 277 | //mh 2000-11-08 278 | var 279 | First, Last, I, Compare: integer; 280 | Token: string; 281 | begin 282 | First := 0; 283 | Last := fKeywords.Count - 1; 284 | Result := False; 285 | Token := UpperCase(AKeyword); 286 | while First <= Last do 287 | begin 288 | I := (First + Last) shr 1; 289 | Compare := AnsiCompareStr(fKeywords[i], Token); 290 | if Compare = 0 then 291 | begin 292 | Result := True; 293 | break; 294 | end 295 | else 296 | if Compare < 0 then 297 | First := I + 1 298 | else 299 | Last := I - 1; 300 | end; 301 | end; { IsKeyWord } 302 | 303 | 304 | function TSynLuaSyn.IsConstant(const AConstant: string): boolean; 305 | //mh 2000-11-08 306 | var 307 | First, Last, I, Compare: integer; 308 | Token: string; 309 | begin 310 | First := 0; 311 | Last := fConstants.Count - 1; 312 | Result := False; 313 | Token := UpperCase(AConstant); 314 | while First <= Last do 315 | begin 316 | I := (First + Last) shr 1; 317 | Compare := AnsiCompareStr(fConstants[i], Token); 318 | if Compare = 0 then 319 | begin 320 | Result := True; 321 | break; 322 | end 323 | else 324 | if Compare < 0 then 325 | First := I + 1 326 | else 327 | Last := I - 1; 328 | end; 329 | end; { IsConstant } 330 | 331 | function TSynLuaSyn.IsObject(const AObject: string): boolean; //mh 2000-11-08 332 | var 333 | First, Last, I, Compare: integer; 334 | Token: string; 335 | begin 336 | First := 0; 337 | Last := fObjects.Count - 1; 338 | Result := False; 339 | Token := UpperCase(AObject); 340 | while First <= Last do 341 | begin 342 | I := (First + Last) shr 1; 343 | Compare := AnsiCompareStr(fObjects[i], Token); 344 | if Compare = 0 then 345 | begin 346 | Result := True; 347 | break; 348 | end 349 | else 350 | if Compare < 0 then 351 | First := I + 1 352 | else 353 | Last := I - 1; 354 | end; 355 | end; { IsObject } 356 | 357 | 358 | procedure TSynLuaSyn.MakeMethodTables; 359 | var 360 | I: char; 361 | begin 362 | for I := #0 to #255 do 363 | case I of 364 | #39: 365 | begin 366 | if csVBStyle in comments then 367 | begin 368 | fProcTable[I] := @ApostropheProc; 369 | fStringDelimch := #34; 370 | end 371 | else 372 | fProcTable[I] := @UnknownProc; 373 | end; 374 | '<': 375 | begin 376 | if markup then 377 | fProcTable[i] := @SmallerThan 378 | else 379 | fProcTable[I] := @UnknownProc; 380 | end; 381 | '>': 382 | begin 383 | if markup then 384 | fProcTable[i] := @GreaterThan 385 | else 386 | fProcTable[I] := @UnknownProc; 387 | end; 388 | '&': 389 | begin 390 | if Entity then 391 | fProcTable[i] := @AmpersandProc 392 | else 393 | fProcTable[I] := @UnknownProc; 394 | end; 395 | '#': fProcTable[I] := @AsciiCharProc; 396 | '{': fProcTable[I] := @BraceOpenProc; 397 | '}': fProcTable[I] := @BraceCloseProc; 398 | ';': fProcTable[I] := @PointCommaProc; 399 | #13: fProcTable[I] := @CRProc; 400 | 'A'..'Z', 'a'..'z', '_': fProcTable[I] := @IdentProc; 401 | '$': 402 | begin 403 | if dollarvariables then 404 | fProcTable[I] := @DollarProc 405 | else 406 | fProcTable[I] := @IntegerProc; 407 | end; 408 | '.': fProcTable[i] := @DotProc; 409 | #10: fProcTable[I] := @LFProc; 410 | #0: fProcTable[I] := @NullProc; 411 | '0'..'9': fProcTable[I] := @NumberProc; 412 | '(': fProcTable[I] := @RoundOpenProc; 413 | ')': fProcTable[I] := @RoundCloseProc; 414 | //'/': fProcTable[I] := @SlashProc; 415 | '-': fProcTable[I] := @LuaCommentOpenProc; 416 | '[': fProcTable[I] := @LuaMStringOpenProc; 417 | #1..#9, #11, #12, #14..#32: fProcTable[I] := @SpaceProc; 418 | else 419 | fProcTable[I] := @UnknownProc; 420 | end; 421 | fProcTable[''''] := @StringProc; 422 | fProcTable['"'] := @String2Proc; 423 | end; 424 | 425 | constructor TSynLuaSyn.Create(AOwner: TComponent); 426 | begin 427 | inherited Create(AOwner); 428 | fUserData := TIniList.Create; 429 | fKeyWords := TStringList.Create; 430 | TStringList(fKeyWords).Sorted := True; 431 | TStringList(fKeyWords).Duplicates := dupIgnore; 432 | fConstants := TStringList.Create; 433 | TStringList(fConstants).Sorted := True; 434 | TStringList(fConstants).Duplicates := dupIgnore; 435 | fObjects := TStringList.Create; 436 | TStringList(fObjects).Sorted := True; 437 | TStringList(fObjects).Duplicates := dupIgnore; 438 | fCommentAttri := TSynHighlighterAttributes.Create(@SYNS_AttrComment, 439 | SYNS_XML_AttrComment); 440 | fCommentAttri.Style := [fsItalic]; 441 | AddAttribute(fCommentAttri); 442 | fIdentifierAttri := TSynHighlighterAttributes.Create(@SYNS_AttrIdentifier, 443 | SYNS_XML_AttrIdentifier); 444 | AddAttribute(fIdentifierAttri); 445 | fKeyAttri := TSynHighlighterAttributes.Create(@SYNS_AttrReservedWord, 446 | SYNS_XML_AttrReservedWord); 447 | fKeyAttri.Style := [fsBold]; 448 | AddAttribute(fKeyAttri); 449 | fConstantAttri := TSynHighlighterAttributes.Create('jan_constant'); 450 | fConstantAttri.Style := [fsBold]; 451 | fConstantAttri.Foreground := clfuchsia; 452 | AddAttribute(fConstantAttri); 453 | fObjectAttri := TSynHighlighterAttributes.Create('jan_object'); 454 | fObjectAttri.Style := [fsBold]; 455 | fObjectAttri.Foreground := clmaroon; 456 | AddAttribute(fObjectAttri); 457 | fEntityAttri := TSynHighlighterAttributes.Create('jan_entity'); 458 | fEntityAttri.Style := [fsBold]; 459 | fEntityAttri.Foreground := cllime; 460 | AddAttribute(fEntityAttri); 461 | fDotAttri := TSynHighlighterAttributes.Create('jan_dot'); 462 | fDotAttri.Style := [fsBold]; 463 | fDotAttri.Foreground := clgreen; 464 | AddAttribute(fDotAttri); 465 | fNumberAttri := TSynHighlighterAttributes.Create(@SYNS_AttrNumber, 466 | SYNS_XML_AttrNumber); 467 | AddAttribute(fNumberAttri); 468 | fSpaceAttri := TSynHighlighterAttributes.Create(@SYNS_AttrSpace, SYNS_XML_AttrSpace); 469 | AddAttribute(fSpaceAttri); 470 | fStringAttri := TSynHighlighterAttributes.Create(@SYNS_AttrString, 471 | SYNS_XML_AttrString); 472 | AddAttribute(fStringAttri); 473 | fSymbolAttri := TSynHighlighterAttributes.Create(@SYNS_AttrSymbol, 474 | SYNS_XML_AttrSymbol); 475 | AddAttribute(fSymbolAttri); 476 | fVariableAttri := TSynHighlighterAttributes.Create('jan_Variable'); 477 | fVariableAttri.Style := [fsBold]; 478 | fVariableAttri.Foreground := clpurple; 479 | AddAttribute(fVariableAttri); 480 | fPreprocessorAttri := TSynHighlighterAttributes.Create(@SYNS_AttrPreprocessor, 481 | SYNS_XML_AttrPreprocessor); 482 | AddAttribute(fPreprocessorAttri); 483 | SetAttributesOnChange(@DefHighlightChange); 484 | 485 | fStringDelimCh := ''''; 486 | fIdentChars := inherited GetIdentChars; 487 | MakeMethodTables; 488 | fRange := rsUnknown; 489 | 490 | ActiveDot := True; 491 | CommentAttri.Foreground := clGreen; 492 | StringAttri.Foreground := clBlue; 493 | StringDelim := sdSingleQuote; 494 | SymbolAttri.Foreground := clRed; 495 | KeyWords.Add('AND'); 496 | KeyWords.Add('BREAK'); 497 | KeyWords.Add('DO'); 498 | KeyWords.Add('ELSE'); 499 | KeyWords.Add('ELSEIF'); 500 | KeyWords.Add('END'); 501 | KeyWords.Add('FALSE'); 502 | KeyWords.Add('FOR'); 503 | KeyWords.Add('FUNCTION'); 504 | KeyWords.Add('GOTO'); 505 | KeyWords.Add('IF'); 506 | KeyWords.Add('IN'); 507 | KeyWords.Add('LOCAL'); 508 | KeyWords.Add('NIL'); 509 | KeyWords.Add('NOT'); 510 | KeyWords.Add('OR'); 511 | KeyWords.Add('REPEAT'); 512 | KeyWords.Add('RETURN'); 513 | KeyWords.Add('THEN'); 514 | KeyWords.Add('TRUE'); 515 | KeyWords.Add('UNTIL'); 516 | KeyWords.Add('WHILE'); 517 | end; { Create } 518 | 519 | destructor TSynLuaSyn.Destroy; 520 | begin 521 | fUserData.Free; 522 | fKeyWords.Free; 523 | FConstants.Free; 524 | FObjects.Free; 525 | inherited Destroy; 526 | end; { Destroy } 527 | 528 | procedure TSynLuaSyn.SetLine(const NewValue: string; LineNumber: integer); 529 | begin 530 | inherited; 531 | fLine := PChar(NewValue); 532 | Run := 0; 533 | fLineNumber := LineNumber; 534 | Next; 535 | end; { SetLine } 536 | 537 | procedure TSynLuaSyn.AnsiProc; 538 | begin 539 | case fLine[Run] of 540 | #0: NullProc; 541 | #10: LFProc; 542 | #13: CRProc; 543 | else 544 | fTokenID := tkComment; 545 | repeat 546 | if (fLine[Run] = '*') and (fLine[Run + 1] = ')') then 547 | begin 548 | fRange := rsUnKnown; 549 | Inc(Run, 2); 550 | break; 551 | end; 552 | Inc(Run); 553 | until fLine[Run] in [#0, #10, #13]; 554 | end; 555 | end; 556 | 557 | procedure TSynLuaSyn.PasStyleProc; 558 | begin 559 | case fLine[Run] of 560 | #0: NullProc; 561 | #10: LFProc; 562 | #13: CRProc; 563 | else 564 | fTokenID := tkComment; 565 | repeat 566 | if fLine[Run] = '}' then 567 | begin 568 | fRange := rsUnKnown; 569 | Inc(Run); 570 | break; 571 | end; 572 | Inc(Run); 573 | until fLine[Run] in [#0, #10, #13]; 574 | end; 575 | end; 576 | 577 | procedure TSynLuaSyn.CStyleProc; 578 | begin 579 | case fLine[Run] of 580 | #0: NullProc; 581 | #10: LFProc; 582 | #13: CRProc; 583 | else 584 | fTokenID := tkComment; 585 | repeat 586 | if (fLine[Run] = '*') and (fLine[Run + 1] = '/') then 587 | begin 588 | fRange := rsUnKnown; 589 | Inc(Run, 2); 590 | break; 591 | end; 592 | Inc(Run); 593 | until fLine[Run] in [#0, #10, #13]; 594 | end; 595 | end; 596 | 597 | procedure TSynLuaSyn.AsciiCharProc; 598 | begin 599 | if fDetectPreprocessor then 600 | begin 601 | fTokenID := tkPreprocessor; 602 | repeat 603 | Inc(Run); 604 | until fLine[Run] in [#0, #10, #13]; 605 | end 606 | else 607 | begin 608 | fTokenID := tkString; 609 | repeat 610 | Inc(Run); 611 | until not (fLine[Run] in ['0'..'9']); 612 | end; 613 | end; 614 | 615 | procedure TSynLuaSyn.BraceOpenProc; 616 | begin 617 | if csPasStyle in fComments then 618 | begin 619 | fTokenID := tkComment; 620 | fRange := rsPasStyle; 621 | Inc(Run); 622 | while FLine[Run] <> #0 do 623 | case FLine[Run] of 624 | '}': 625 | begin 626 | fRange := rsUnKnown; 627 | Inc(Run); 628 | break; 629 | end; 630 | #10: break; 631 | 632 | #13: break; 633 | else 634 | Inc(Run); 635 | end; 636 | end 637 | else 638 | begin 639 | Inc(Run); 640 | fTokenID := tkSymbol; 641 | end; 642 | end; 643 | 644 | procedure TSynLuaSyn.BraceCloseProc; 645 | begin 646 | Inc(Run); 647 | FTokenID := tkSymbol; 648 | end; 649 | 650 | procedure TSynLuaSyn.PointCommaProc; 651 | begin 652 | if (csASmStyle in fComments) or (csBasStyle in fComments) then 653 | begin 654 | fTokenID := tkComment; 655 | fRange := rsUnknown; 656 | Inc(Run); 657 | while FLine[Run] <> #0 do 658 | begin 659 | fTokenID := tkComment; 660 | Inc(Run); 661 | end; 662 | end 663 | else 664 | begin 665 | Inc(Run); 666 | fTokenID := tkSymbol; 667 | end; 668 | end; 669 | 670 | procedure TSynLuaSyn.CRProc; 671 | begin 672 | fTokenID := tkSpace; 673 | Inc(Run); 674 | if fLine[Run] = #10 then 675 | Inc(Run); 676 | end; 677 | 678 | procedure TSynLuaSyn.IdentProc; 679 | var 680 | aToken: string; 681 | begin 682 | while Identifiers[fLine[Run]] do 683 | Inc(Run); 684 | aToken := GetToken; 685 | if IsKeyWord(aToken) then 686 | begin 687 | if not Markup then 688 | fTokenId := tkKey 689 | else 690 | begin 691 | if fMarkupOn then 692 | fTokenId := tkKey 693 | else 694 | fTokenId := tkIdentifier; 695 | end; 696 | end 697 | else if IsConstant(aToken) then 698 | fTokenId := tkConstant 699 | else if IsObject(aToken) then 700 | fTokenId := tkObject 701 | else 702 | fTokenId := tkIdentifier; 703 | end; 704 | 705 | procedure TSynLuaSyn.IntegerProc; 706 | begin 707 | Inc(Run); 708 | fTokenID := tkNumber; 709 | while FLine[Run] in ['0'..'9', 'A'..'F', 'a'..'f'] do 710 | Inc(Run); 711 | end; 712 | 713 | procedure TSynLuaSyn.LFProc; 714 | begin 715 | fTokenID := tkSpace; 716 | Inc(Run); 717 | end; 718 | 719 | procedure TSynLuaSyn.NullProc; 720 | begin 721 | fTokenID := tkNull; 722 | end; 723 | 724 | procedure TSynLuaSyn.NumberProc; 725 | begin 726 | Inc(Run); 727 | fTokenID := tkNumber; 728 | while FLine[Run] in ['0'..'9', '.', 'e', 'E', 'x'] do 729 | begin 730 | case FLine[Run] of 731 | 'x': 732 | begin // handle C style hex numbers 733 | IntegerProc; 734 | break; 735 | end; 736 | '.': 737 | if FLine[Run + 1] = '.' then 738 | break; 739 | end; 740 | Inc(Run); 741 | end; 742 | end; 743 | 744 | procedure TSynLuaSyn.RoundOpenProc; 745 | begin 746 | Inc(Run); 747 | if csAnsiStyle in fComments then 748 | begin 749 | case fLine[Run] of 750 | '*': 751 | begin 752 | fTokenID := tkComment; 753 | fRange := rsAnsi; 754 | Inc(Run); 755 | while fLine[Run] <> #0 do 756 | case fLine[Run] of 757 | '*': 758 | if fLine[Run + 1] = ')' then 759 | begin 760 | fRange := rsUnKnown; 761 | Inc(Run, 2); 762 | break; 763 | end 764 | else 765 | Inc(Run); 766 | #10: break; 767 | #13: break; 768 | else 769 | Inc(Run); 770 | end; 771 | end; 772 | '.': 773 | begin 774 | Inc(Run); 775 | fTokenID := tkSymbol; 776 | end; 777 | else 778 | begin 779 | FTokenID := tkSymbol; 780 | end; 781 | end; 782 | end 783 | else 784 | fTokenId := tkSymbol; 785 | end; 786 | 787 | procedure TSynLuaSyn.RoundCloseProc; 788 | begin 789 | Inc(Run); 790 | FTokenID := tkSymbol; 791 | end; 792 | 793 | procedure TSynLuaSyn.SlashProc; 794 | begin 795 | case FLine[Run + 1] of 796 | '/': 797 | begin 798 | Inc(Run, 2); 799 | fTokenID := tkComment; 800 | while FLine[Run] <> #0 do 801 | begin 802 | case FLine[Run] of 803 | #10, #13: break; 804 | end; 805 | Inc(Run); 806 | end; 807 | end; 808 | '*': 809 | begin 810 | if csCStyle in fComments then 811 | begin 812 | fTokenID := tkComment; 813 | fRange := rsCStyle; 814 | Inc(Run); 815 | while fLine[Run] <> #0 do 816 | case fLine[Run] of 817 | '*': 818 | if fLine[Run + 1] = '/' then 819 | begin 820 | fRange := rsUnKnown; 821 | Inc(Run, 2); 822 | break; 823 | end 824 | else 825 | Inc(Run); 826 | #10: break; 827 | #13: break; 828 | else 829 | Inc(Run); 830 | end; 831 | end 832 | else 833 | begin 834 | Inc(Run); 835 | fTokenId := tkSymbol; 836 | end; 837 | end; 838 | else 839 | begin 840 | Inc(Run); 841 | if markup and fmarkupon then 842 | fTokenID := tkKey 843 | else 844 | fTokenID := tkSymbol; 845 | end; 846 | end; 847 | end; 848 | 849 | procedure TSynLuaSyn.LuaCommentOpenProc; 850 | begin 851 | Inc(Run); 852 | if (fLine[Run] = '-') and (fLine[Run + 1] = '[') and (fLine[Run + 2] = '[') then 853 | 854 | begin 855 | LuaMCommentOpenProc; 856 | end 857 | else if (fLine[Run] = '-') then 858 | begin 859 | fRange := rsLuaComment; 860 | LuaCommentProc; 861 | fTokenID := tkComment; 862 | end 863 | else 864 | fTokenID := tkSymbol; 865 | end; 866 | 867 | procedure TSynLuaSyn.LuaCommentProc; 868 | begin 869 | fTokenID := tkComment; 870 | repeat 871 | if (fLine[Run] = '@') and (fLine[Run + 1] = '£') and 872 | (fLine[Run + 2] = '¤') and (fLine[Run + 3] = '£') and 873 | (fLine[Run + 4] = '@') and (fLine[Run + 5] = '¢') and 874 | (fLine[Run + 6] = '£') and (fLine[Run + 7] = '@') then 875 | begin 876 | Inc(Run, 8); 877 | fRange := rsUnKnown; 878 | Break; 879 | end; 880 | if not (fLine[Run] in [#0, #10, #13]) then 881 | Inc(Run); 882 | until fLine[Run] in [#0, #10, #13]; 883 | end; 884 | 885 | procedure TSynLuaSyn.LuaMCommentOpenProc; 886 | begin 887 | fRange := rsLuaMComment; 888 | LuaMCommentProc; 889 | fTokenID := tkComment; 890 | end; 891 | 892 | procedure TSynLuaSyn.LuaMCommentProc; 893 | begin 894 | case fLine[Run] of 895 | #0: NullProc; 896 | #10: LFProc; 897 | #13: CRProc; 898 | else 899 | begin 900 | fTokenID := tkComment; 901 | repeat 902 | if (fLine[Run] = ']') and (fLine[Run + 1] = ']') then 903 | begin 904 | Inc(Run, 2); 905 | fRange := rsUnKnown; 906 | Break; 907 | end; 908 | if not (fLine[Run] in [#0, #10, #13]) then 909 | Inc(Run); 910 | until fLine[Run] in [#0, #10, #13]; 911 | end; 912 | end; 913 | end; 914 | 915 | procedure TSynLuaSyn.LuaMStringOpenProc; 916 | begin 917 | Inc(Run); 918 | if (fLine[Run] = '[') then 919 | begin 920 | fRange := rsLuaMString; 921 | LuaMStringProc; 922 | fTokenID := tkComment; 923 | end 924 | else 925 | fTokenID := tkSymbol; 926 | end; 927 | 928 | procedure TSynLuaSyn.LuaMStringProc; 929 | begin 930 | case fLine[Run] of 931 | #0: NullProc; 932 | #10: LFProc; 933 | #13: CRProc; 934 | else 935 | begin 936 | fTokenID := tkComment; 937 | repeat 938 | if (fLine[Run] = ']') and (fLine[Run + 1] = ']') then 939 | begin 940 | Inc(Run, 2); 941 | fRange := rsUnKnown; 942 | Break; 943 | end; 944 | if not (fLine[Run] in [#0, #10, #13]) then 945 | Inc(Run); 946 | until fLine[Run] in [#0, #10, #13]; 947 | end; 948 | end; 949 | end; 950 | 951 | procedure TSynLuaSyn.SpaceProc; 952 | begin 953 | Inc(Run); 954 | fTokenID := tkSpace; 955 | while FLine[Run] in [#1..#9, #11, #12, #14..#32] do 956 | Inc(Run); 957 | end; 958 | 959 | procedure TSynLuaSyn.StringProc; 960 | begin 961 | fTokenID := tkString; 962 | if (fLine[Run + 1] = fStringDelimCh) and (fLine[Run + 2] = fStringDelimCh) then 963 | Inc(Run, 2); 964 | repeat 965 | case FLine[Run] of 966 | #0, #10, #13: break; 967 | end; 968 | Inc(Run); 969 | until FLine[Run] = fStringDelimCh; 970 | if FLine[Run] <> #0 then 971 | Inc(Run); 972 | end; 973 | 974 | procedure TSynLuaSyn.String2Proc; 975 | begin 976 | fTokenID := tkString; 977 | if (fLine[Run + 1] = '"') and (fLine[Run + 2] = '"') then 978 | Inc(Run, 2); 979 | repeat 980 | case FLine[Run] of 981 | #0, #10, #13: break; 982 | end; 983 | Inc(Run); 984 | until FLine[Run] = '"'; 985 | if FLine[Run] <> #0 then 986 | Inc(Run); 987 | end; 988 | 989 | procedure TSynLuaSyn.UnknownProc; 990 | begin 991 | Inc(Run); 992 | while (fLine[Run] in [#128..#191]) or // continued utf8 subcode 993 | ((fLine[Run] <> #0) and (fProcTable[fLine[Run]] = @UnknownProc)) do 994 | Inc(Run); 995 | fTokenID := tkUnKnown; 996 | end; 997 | 998 | procedure TSynLuaSyn.Next; 999 | begin 1000 | fTokenPos := Run; 1001 | case fRange of 1002 | rsAnsi: AnsiProc; 1003 | rsPasStyle: PasStyleProc; 1004 | rsCStyle: CStyleProc; 1005 | rsLuaMComment: LuaMCommentProc; 1006 | rsLuaMString: LuaMStringProc; 1007 | else 1008 | fProcTable[fLine[Run]]; 1009 | end; 1010 | end; 1011 | 1012 | function TSynLuaSyn.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; 1013 | begin 1014 | case Index of 1015 | SYN_ATTR_COMMENT: Result := fCommentAttri; 1016 | SYN_ATTR_IDENTIFIER: Result := fIdentifierAttri; 1017 | SYN_ATTR_KEYWORD: Result := fKeyAttri; 1018 | SYN_ATTR_STRING: Result := fStringAttri; 1019 | SYN_ATTR_WHITESPACE: Result := fSpaceAttri; 1020 | SYN_ATTR_SYMBOL: Result := fSymbolAttri; 1021 | SYN_ATTR_NUMBER: Result := fNumberAttri; 1022 | SYN_ATTR_DIRECTIVE: Result := fPreprocessorAttri; 1023 | else 1024 | Result := nil; 1025 | end; 1026 | end; 1027 | 1028 | function TSynLuaSyn.GetEol: boolean; 1029 | begin 1030 | Result := fTokenId = tkNull; 1031 | end; 1032 | 1033 | function TSynLuaSyn.GetRange: Pointer; 1034 | begin 1035 | Result := Pointer(PtrUInt(fRange)); 1036 | end; 1037 | 1038 | function TSynLuaSyn.GetToken: string; 1039 | var 1040 | Len: longint; 1041 | begin 1042 | Len := Run - fTokenPos; 1043 | Result := ''; 1044 | SetString(Result, (FLine + fTokenPos), Len); 1045 | end; 1046 | 1047 | procedure TSynLuaSyn.GetTokenEx(out TokenStart: PChar; out TokenLength: integer); 1048 | begin 1049 | TokenLength := Run - fTokenPos; 1050 | TokenStart := FLine + fTokenPos; 1051 | end; 1052 | 1053 | function TSynLuaSyn.GetTokenID: TtkTokenKind; 1054 | begin 1055 | Result := fTokenId; 1056 | end; 1057 | 1058 | function TSynLuaSyn.GetTokenAttribute: TSynHighlighterAttributes; 1059 | begin 1060 | case fTokenID of 1061 | tkComment: Result := fCommentAttri; 1062 | tkIdentifier: Result := fIdentifierAttri; 1063 | tkEntity: Result := fEntityAttri; 1064 | tkKey: Result := fKeyAttri; 1065 | tkConstant: Result := fConstantAttri; 1066 | tkObject: Result := fObjectAttri; 1067 | tkNumber: Result := fNumberAttri; 1068 | tkPreprocessor: Result := fPreprocessorAttri; 1069 | tkSpace: Result := fSpaceAttri; 1070 | tkString: Result := fStringAttri; 1071 | tkSymbol: Result := fSymbolAttri; 1072 | tkDollarVariable: Result := fVariableAttri; 1073 | tkDot: Result := fDotAttri; 1074 | tkUnknown: Result := fSymbolAttri; 1075 | else 1076 | Result := nil; 1077 | end; 1078 | end; 1079 | 1080 | function TSynLuaSyn.GetTokenKind: integer; 1081 | begin 1082 | Result := Ord(fTokenId); 1083 | end; 1084 | 1085 | function TSynLuaSyn.GetTokenPos: integer; 1086 | begin 1087 | Result := fTokenPos; 1088 | end; 1089 | 1090 | procedure TSynLuaSyn.ResetRange; 1091 | begin 1092 | fRange := rsUnknown; 1093 | end; 1094 | 1095 | procedure TSynLuaSyn.SetRange(Value: Pointer); 1096 | begin 1097 | fRange := TRangeState(PtrUInt(Value)); 1098 | end; 1099 | 1100 | procedure TSynLuaSyn.SetKeyWords(const Value: TStrings); 1101 | var 1102 | i: integer; 1103 | begin 1104 | if Value <> nil then 1105 | begin 1106 | Value.BeginUpdate; 1107 | for i := 0 to Value.Count - 1 do 1108 | Value[i] := UpperCase(Value[i]); 1109 | Value.EndUpdate; 1110 | end; 1111 | fKeyWords.Assign(Value); 1112 | DefHighLightChange(nil); 1113 | end; 1114 | 1115 | procedure TSynLuaSyn.SetComments(Value: CommentStyles); 1116 | begin 1117 | if fComments = Value then 1118 | exit; 1119 | fComments := Value; 1120 | MakeMethodTables; 1121 | DefHighLightChange(nil); 1122 | end; 1123 | 1124 | class function TSynLuaSyn.GetLanguageName: string; 1125 | begin 1126 | Result := SYNS_LangGeneral; 1127 | end; 1128 | 1129 | function TSynLuaSyn.LoadFromRegistry(RootKey: HKEY; Key: string): boolean; 1130 | var 1131 | r: TRegistry; 1132 | begin 1133 | r := TRegistry.Create; 1134 | try 1135 | r.RootKey := RootKey; 1136 | if r.OpenKeyReadOnly(Key) then 1137 | begin 1138 | if r.ValueExists('KeyWords') then 1139 | KeyWords.Text := r.ReadString('KeyWords'); 1140 | Result := inherited LoadFromRegistry(RootKey, Key); 1141 | end 1142 | else 1143 | Result := False; 1144 | finally 1145 | r.Free; 1146 | end; 1147 | end; 1148 | 1149 | function TSynLuaSyn.SaveToRegistry(RootKey: HKEY; Key: string): boolean; 1150 | var 1151 | r: TRegistry; 1152 | begin 1153 | r := TRegistry.Create; 1154 | try 1155 | r.RootKey := RootKey; 1156 | if r.OpenKey(Key, True) then 1157 | begin 1158 | Result := True; 1159 | r.WriteString('KeyWords', KeyWords.Text); 1160 | Result := inherited SaveToRegistry(RootKey, Key); 1161 | end 1162 | else 1163 | Result := False; 1164 | finally 1165 | r.Free; 1166 | end; 1167 | end; 1168 | 1169 | function TSynLuaSyn.GetStringDelim: TStringDelim; 1170 | begin 1171 | if fStringDelimCh = '''' then 1172 | Result := sdSingleQuote 1173 | else 1174 | Result := sdDoubleQuote; 1175 | end; 1176 | 1177 | procedure TSynLuaSyn.SetStringDelim(const Value: TStringDelim); 1178 | var 1179 | newCh: char; 1180 | begin 1181 | case Value of 1182 | sdSingleQuote: newCh := ''''; 1183 | else 1184 | newCh := '"'; 1185 | end; //case 1186 | if newCh <> fStringDelimCh then 1187 | begin 1188 | fStringDelimCh := newCh; 1189 | MakeMethodTables; 1190 | end; 1191 | end; 1192 | 1193 | function TSynLuaSyn.GetIdentifierChars: string; 1194 | var 1195 | ch: char; 1196 | s: shortstring; 1197 | begin 1198 | s := ''; 1199 | for ch := #0 to #255 do 1200 | if ch in fIdentChars then 1201 | s := s + ch; 1202 | Result := s; 1203 | end; 1204 | 1205 | procedure TSynLuaSyn.SetIdentifierChars(const Value: string); 1206 | var 1207 | i: integer; 1208 | begin 1209 | fIdentChars := []; 1210 | for i := 1 to Length(Value) do 1211 | begin 1212 | fIdentChars := fIdentChars + [Value[i]]; 1213 | end; //for 1214 | end; 1215 | 1216 | function TSynLuaSyn.GetIdentChars: TSynIdentChars; 1217 | begin 1218 | Result := fIdentChars; 1219 | end; 1220 | 1221 | procedure TSynLuaSyn.SetDetectPreprocessor(Value: boolean); 1222 | begin 1223 | if Value <> fDetectPreprocessor then 1224 | begin 1225 | fDetectPreprocessor := Value; 1226 | DefHighlightChange(Self); 1227 | end; 1228 | end; 1229 | 1230 | 1231 | procedure TSynLuaSyn.ApostropheProc; 1232 | begin 1233 | fTokenID := tkComment; 1234 | repeat 1235 | Inc(Run); 1236 | until fLine[Run] in [#0, #10, #13]; 1237 | end; 1238 | 1239 | procedure TSynLuaSyn.SetConstants(const Value: TStrings); 1240 | var 1241 | i: integer; 1242 | begin 1243 | if Value <> nil then 1244 | begin 1245 | Value.BeginUpdate; 1246 | for i := 0 to Value.Count - 1 do 1247 | Value[i] := UpperCase(Value[i]); 1248 | Value.EndUpdate; 1249 | end; 1250 | fConstants.Assign(Value); 1251 | DefHighLightChange(nil); 1252 | end; 1253 | 1254 | procedure TSynLuaSyn.SetObjects(const Value: TStrings); 1255 | var 1256 | i: integer; 1257 | begin 1258 | if Value <> nil then 1259 | begin 1260 | Value.BeginUpdate; 1261 | for i := 0 to Value.Count - 1 do 1262 | Value[i] := UpperCase(Value[i]); 1263 | Value.EndUpdate; 1264 | end; 1265 | fObjects.Assign(Value); 1266 | DefHighLightChange(nil); 1267 | end; 1268 | 1269 | procedure TSynLuaSyn.SetMarkup(const Value: boolean); 1270 | begin 1271 | if Value <> FMarkup then 1272 | begin 1273 | FMarkup := Value; 1274 | DefHighLightChange(nil); 1275 | end; 1276 | end; 1277 | 1278 | procedure TSynLuaSyn.GreaterThan; 1279 | begin 1280 | Inc(Run); 1281 | if markup then 1282 | begin 1283 | fMarkupOn := False; 1284 | fTokenId := tkKey; 1285 | end 1286 | else 1287 | fTokenID := tkUnKnown; 1288 | end; 1289 | 1290 | procedure TSynLuaSyn.SmallerThan; 1291 | begin 1292 | Inc(Run); 1293 | if markup then 1294 | begin 1295 | fMarkupOn := True; 1296 | fTokenId := tkKey; 1297 | end 1298 | else 1299 | fTokenID := tkUnKnown; 1300 | end; 1301 | 1302 | 1303 | procedure TSynLuaSyn.LoadHighLighter(aFile: string); 1304 | var 1305 | hini: TIniList; 1306 | s: string; 1307 | b: boolean; 1308 | HL: TSynLuaSyn; 1309 | i: integer; 1310 | genlist: TStringList; 1311 | 1312 | function StyleToStr(aStyle: TFontStyles): string; 1313 | begin 1314 | Result := ''; 1315 | if (fsbold in aStyle) then 1316 | Result := Result + 'bold,'; 1317 | if (fsitalic in aStyle) then 1318 | Result := Result + 'italic,'; 1319 | if (fsunderline in aStyle) then 1320 | Result := Result + 'underline'; 1321 | end; 1322 | 1323 | procedure ReadAttribute(attr: TSynHighlighterAttributes; attrname: string); 1324 | begin 1325 | s := ''; 1326 | if (fsbold in attr.Style) then 1327 | s := 'bold,'; 1328 | if (fsitalic in attr.Style) then 1329 | s := s + 'italic,'; 1330 | if (fsunderline in attr.Style) then 1331 | s := s + 'underline'; 1332 | s := hini.ReadString(AttrName, 'Style', s); 1333 | if (s = 'normal') or (s = '') then 1334 | attr.style := [] 1335 | else 1336 | begin 1337 | if pos('bold', s) > 0 then 1338 | attr.style := attr.style + [fsbold] 1339 | else 1340 | attr.style := attr.style - [fsbold]; 1341 | if pos('italic', s) > 0 then 1342 | attr.style := attr.style + [fsitalic] 1343 | else 1344 | attr.style := attr.style - [fsitalic]; 1345 | if pos('underline', s) > 0 then 1346 | attr.style := attr.style + [fsunderline] 1347 | else 1348 | attr.style := attr.style - [fsunderline]; 1349 | end; 1350 | s := colortostring(Attr.Background); 1351 | s := hini.ReadString(AttrName, 'Background', s); 1352 | Attr.Background := stringtocolor(s); 1353 | s := colortostring(Attr.Foreground); 1354 | s := hini.ReadString(AttrName, 'Foreground', s); 1355 | Attr.Foreground := stringtocolor(s); 1356 | end; 1357 | 1358 | begin 1359 | if FileExistsUTF8(aFile) then 1360 | begin 1361 | HL := self; 1362 | fUserData.LoadFromFile(UTF8ToSys(aFile)); 1363 | hini := fUserData; 1364 | // attributes 1365 | ReadAttribute(HL.Commentattri, 'Comment'); 1366 | ReadAttribute(HL.Identifierattri, 'Identifier'); 1367 | ReadAttribute(HL.Keyattri, 'Key'); 1368 | ReadAttribute(HL.Constantattri, 'Constant'); 1369 | ReadAttribute(HL.Objectattri, 'Object'); 1370 | ReadAttribute(HL.Numberattri, 'Number'); 1371 | ReadAttribute(HL.Spaceattri, 'Space'); 1372 | ReadAttribute(HL.Stringattri, 'String'); 1373 | ReadAttribute(HL.Symbolattri, 'Symbol'); 1374 | ReadAttribute(HL.Entityattri, 'Entity'); 1375 | ReadAttribute(HL.Variableattri, 'Variables'); 1376 | ReadAttribute(HL.DotAttri, 'Dot'); 1377 | // comment style 1378 | HL.Comments := []; 1379 | if hini.ReadBool('CommentStyle', 'ansi', False) then 1380 | HL.comments := HL.Comments + [csAnsiStyle]; 1381 | if hini.ReadBool('CommentStyle', 'pas', False) then 1382 | HL.comments := HL.Comments + [csPasStyle]; 1383 | if hini.ReadBool('CommentStyle', 'c', False) then 1384 | HL.comments := HL.Comments + [csCStyle]; 1385 | if hini.ReadBool('CommentStyle', 'asm', False) then 1386 | HL.comments := HL.Comments + [csAsmStyle]; 1387 | if hini.ReadBool('CommentStyle', 'bas', False) then 1388 | HL.comments := HL.Comments + [csBasStyle]; 1389 | if hini.ReadBool('CommentStyle', 'vb', False) then 1390 | HL.comments := HL.Comments + [csVBStyle]; 1391 | // markup switch for html, xml, xsl etc. 1392 | HL.markup := hini.ReadBool('Switches', 'markup', False); 1393 | // entity switch for html, xml, xsl etc. 1394 | HL.entity := hini.ReadBool('Switches', 'entity', False); 1395 | // $variable switch for languages like perl and php 1396 | HL.dollarvariables := hini.ReadBool('Switches', 'dollarvariables', False); 1397 | // .dot switch for object methods and properties 1398 | HL.ActiveDot := hini.ReadBool('Switches', 'activedot', False); 1399 | // string delimiter 1400 | b := hini.ReadBool('String Delimiter', 'Double Quotes', False); 1401 | if b then 1402 | HL.StringDelim := sdDoubleQuote 1403 | else 1404 | HL.StringDelim := sdSingleQuote; 1405 | genlist := TStringList.Create; 1406 | // read keywords 1407 | hini.ReadSectionNames('Keywords', genlist); 1408 | if genlist.Count > 0 then 1409 | for i := 0 to genlist.Count - 1 do 1410 | genlist[i] := uppercase(genlist[i]); 1411 | HL.KeyWords.Assign(genlist); 1412 | hini.ReadSectionNames('Constants', genlist); 1413 | if genlist.Count > 0 then 1414 | for i := 0 to genlist.Count - 1 do 1415 | genlist[i] := uppercase(genlist[i]); 1416 | HL.Constants.Assign(genlist); 1417 | hini.ReadSectionNames('Objects', genlist); 1418 | if genlist.Count > 0 then 1419 | for i := 0 to genlist.Count - 1 do 1420 | genlist[i] := uppercase(genlist[i]); 1421 | HL.Objects.Assign(genlist); 1422 | genlist.Free; 1423 | makemethodtables; 1424 | end; 1425 | end; 1426 | 1427 | 1428 | 1429 | { TIniList } 1430 | 1431 | function TIniList.GetKeyIndex(asection, akey: string): integer; 1432 | var 1433 | i, c: integer; 1434 | begin 1435 | Result := -1; 1436 | i := self.IndexOf('[' + asection + ']'); 1437 | if i = -1 then 1438 | exit; 1439 | c := self.Count; 1440 | Inc(i); 1441 | while (i < c) and (pos('=', strings[i]) <> 0) do 1442 | begin 1443 | if comparetext(names[i], akey) = 0 then 1444 | begin 1445 | Result := i; 1446 | exit; 1447 | end; 1448 | Inc(i); 1449 | end; 1450 | end; 1451 | 1452 | function TIniList.GetKeyValue(asection, akey: string): string; 1453 | var 1454 | i, p: integer; 1455 | begin 1456 | Result := ''; 1457 | i := getkeyindex(asection, akey); 1458 | if i = -1 then 1459 | exit; 1460 | p := pos('=', strings[i]); 1461 | Result := copy(strings[i], p + 1, maxint); 1462 | end; 1463 | 1464 | function TIniList.ReadBool(asection, akey: string; adefault: boolean): boolean; 1465 | var 1466 | keyvalue: string; 1467 | begin 1468 | Result := adefault; 1469 | keyvalue := GetKeyValue(asection, akey); 1470 | Result := comparetext('true', keyvalue) = 0; 1471 | end; 1472 | 1473 | function TIniList.ReadInteger(asection, akey: string; adefault: integer): integer; 1474 | var 1475 | keyvalue: string; 1476 | begin 1477 | Result := adefault; 1478 | keyvalue := GetKeyValue(asection, akey); 1479 | try 1480 | Result := StrToInt(keyvalue); 1481 | except 1482 | end; 1483 | end; 1484 | 1485 | procedure TIniList.ReadSectionNames(asection: string; alist: TStrings); 1486 | var 1487 | i, c, p: integer; 1488 | s: string; 1489 | begin 1490 | alist.Clear; 1491 | i := self.IndexOf('[' + asection + ']'); 1492 | if i = -1 then 1493 | exit; 1494 | Inc(i); 1495 | c := Count; 1496 | while (i < c) and (pos('[', strings[i]) = 0) and (strings[i] <> '') do 1497 | begin 1498 | s := strings[i]; 1499 | p := pos('=', s); 1500 | if p = 0 then 1501 | alist.Append(s) 1502 | else 1503 | alist.append(copy(s, 1, p - 1)); 1504 | Inc(i); 1505 | end; 1506 | end; 1507 | 1508 | function TIniList.ReadString(asection, akey, adefault: string): string; 1509 | var 1510 | keyvalue: string; 1511 | begin 1512 | Result := adefault; 1513 | keyvalue := GetKeyValue(asection, akey); 1514 | if keyvalue <> '' then 1515 | Result := keyvalue; 1516 | end; 1517 | 1518 | procedure TSynLuaSyn.SetEntity(const Value: boolean); 1519 | begin 1520 | if Value <> FEntity then 1521 | begin 1522 | FEntity := Value; 1523 | DefHighLightChange(nil); 1524 | end; 1525 | end; 1526 | 1527 | procedure TSynLuaSyn.AmpersandProc; 1528 | 1529 | function testentity: boolean; 1530 | var 1531 | i: integer; 1532 | begin 1533 | Result := False; 1534 | i := run; 1535 | Inc(i); 1536 | while FLine[i] <> #0 do 1537 | case FLine[i] of 1538 | ';': 1539 | begin 1540 | fRange := rsUnKnown; 1541 | Inc(i); 1542 | Result := True; 1543 | break; 1544 | end; 1545 | #10: break; 1546 | ' ': break; 1547 | #13: break; 1548 | else 1549 | Inc(i); 1550 | end; 1551 | if Result then 1552 | run := i; 1553 | end; 1554 | 1555 | begin 1556 | if Entity then 1557 | begin 1558 | if testentity then 1559 | fTokenID := tkEntity 1560 | else 1561 | begin 1562 | Inc(Run); 1563 | fTokenID := tkSymbol; 1564 | end; 1565 | end 1566 | else 1567 | begin 1568 | Inc(Run); 1569 | fTokenID := tkSymbol; 1570 | end; 1571 | end; 1572 | 1573 | procedure TSynLuaSyn.SetDollarVariables(const Value: boolean); 1574 | begin 1575 | if Value <> FDollarVariables then 1576 | begin 1577 | FDollarVariables := Value; 1578 | MakeMethodTables; 1579 | DefHighLightChange(nil); 1580 | end; 1581 | end; 1582 | 1583 | procedure TSynLuaSyn.DollarProc; 1584 | begin 1585 | Inc(Run); 1586 | fTokenID := tkDollarVariable; 1587 | while FLine[Run] in ['0'..'9', 'A'..'Z', 'a'..'z', '_'] do 1588 | Inc(Run); 1589 | end; 1590 | 1591 | procedure TSynLuaSyn.DotProc; 1592 | 1593 | function testdot: boolean; 1594 | var 1595 | i: integer; 1596 | begin 1597 | Result := False; 1598 | i := run; 1599 | Inc(i); 1600 | while (FLine[i] in ['a'..'z', 'A'..'Z']) do 1601 | Inc(i); 1602 | if i > (run + 1) then 1603 | Result := True; 1604 | if Result then 1605 | run := i; 1606 | end; 1607 | 1608 | begin 1609 | if not FActiveDot then 1610 | begin 1611 | Inc(Run); 1612 | fTokenID := tkSymbol; 1613 | end 1614 | else if testDot then 1615 | fTokenID := tkDot 1616 | else 1617 | begin 1618 | Inc(Run); 1619 | fTokenID := tkSymbol; 1620 | end; 1621 | end; 1622 | 1623 | procedure TSynLuaSyn.SetActiveDot(const Value: boolean); 1624 | begin 1625 | FActiveDot := Value; 1626 | end; 1627 | 1628 | procedure TSynLuaSyn.SetDotAttri(const Value: TSynHighlighterAttributes); 1629 | begin 1630 | FDotAttri := Value; 1631 | end; 1632 | 1633 | initialization 1634 | MakeIdentTable; 1635 | end. 1636 | -------------------------------------------------------------------------------- /scripts/7zip.lua: -------------------------------------------------------------------------------- 1 | -- the path of 7z.exe or 7zG.exe 2 | _7z = '"C:\\Program Files\\7-Zip\\7z.exe"'; 3 | 4 | function Compress7z(_output, _filenames, _password, _close) 5 | _filenames = Table.Concat(_filenames, " ", 1, Table.Count(_filenames)) 6 | if String.Compare(_password, "") ~= 0 then 7 | _password = "-p" .. _password .. " " 8 | else 9 | _password = "" 10 | end 11 | if _close then 12 | return File.Run(_7z, 'a '.. _output .. ' ' .. _password .. _filenames, "", 1, true) 13 | else 14 | return File.Run("cmd.exe", '/K ' .. _7z .. ' a '.. _output .. ' ' .. _password .. _filenames, "", 1, true) 15 | end 16 | end 17 | 18 | -- the output 7z file to create, double quoted 19 | output = '"C:\\Temp\\Wallpapers.7z"' 20 | -- a table with all filenames, double quoted 21 | filenames = {'"C:\\Windows\\Web\\Wallpaper\\*"'} 22 | -- the password to protect the file without spaces, to don't use password use an empty string ("") 23 | password = "password" 24 | -- if close or not the command window 25 | closewindow = true 26 | 27 | -- compress the file with 7zip 28 | Compress7z(output, filenames, password, closewindow) 29 | 30 | -- open the folder where is the output and selects the new file created 31 | File.Run("explorer.exe", "/select," .. output, "", 1, false) 32 | -------------------------------------------------------------------------------- /scripts/exitscript.lua: -------------------------------------------------------------------------------- 1 | print("Hello") 2 | 3 | -- like Application.ExitScript() 4 | do return end 5 | 6 | print("World") 7 | -------------------------------------------------------------------------------- /uhighdpi.pas: -------------------------------------------------------------------------------- 1 | unit uhighdpi; 2 | 3 | { Unidad para escalar los controles y formularios } 4 | 5 | {$mode objfpc}{$H+} 6 | 7 | interface 8 | 9 | uses 10 | Forms, Graphics, Controls; 11 | 12 | procedure HighDPI(FromDPI: integer); 13 | procedure ScaleDPI(Control: TControl; FromDPI: integer); 14 | 15 | implementation 16 | 17 | procedure HighDPI(FromDPI: integer); 18 | var 19 | i: integer; 20 | begin 21 | if Screen.PixelsPerInch = FromDPI then 22 | exit; 23 | 24 | for i := 0 to Screen.FormCount - 1 do 25 | begin 26 | Screen.Forms[i].DoubleBuffered := True; 27 | ScaleDPI(Screen.Forms[i], FromDPI); 28 | end; 29 | end; 30 | 31 | procedure ScaleDPI(Control: TControl; FromDPI: integer); 32 | var 33 | i: integer; 34 | WinControl: TWinControl; 35 | begin 36 | if Screen.PixelsPerInch = FromDPI then 37 | exit; 38 | 39 | with Control do 40 | begin 41 | Left := ScaleX(Left, FromDPI); 42 | Top := ScaleY(Top, FromDPI); 43 | Width := ScaleX(Width, FromDPI); 44 | Height := ScaleY(Height, FromDPI); 45 | end; 46 | 47 | if Control is TWinControl then 48 | begin 49 | WinControl := TWinControl(Control); 50 | WinControl.DoubleBuffered := True; 51 | if WinControl.ControlCount = 0 then 52 | exit; 53 | for i := 0 to WinControl.ControlCount - 1 do 54 | ScaleDPI(WinControl.Controls[i], FromDPI); 55 | end; 56 | end; 57 | 58 | end. 59 | 60 | -------------------------------------------------------------------------------- /umain.pas: -------------------------------------------------------------------------------- 1 | unit umain; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, Forms, StdCtrls, Menus, Dialogs, Lua53, SynHighlighterLua, SynEdit, 9 | LCLIntF, Controls, SynGutterBase, SynEditMarks, SynEditMarkupSpecialLine, 10 | Graphics, ActnList, Buttons, uwatches, ustack; 11 | 12 | type 13 | TScriptState = (ssRunning, ssPaused, ssStepInto, ssStepOver, ssFreeRun); 14 | TScriptStates = set of TScriptState; 15 | TScriptDbgStates = set of ssStepInto..ssFreeRun; 16 | 17 | { TfrmMain } 18 | 19 | TfrmMain = class(TForm) 20 | actFreeRun: TAction; 21 | actRefreshWatches: TAction; 22 | actShowStack: TAction; 23 | actShowWatches: TAction; 24 | actToggleBkpt: TAction; 25 | actWatch: TAction; 26 | actStop: TAction; 27 | actPause: TAction; 28 | actStepInto: TAction; 29 | actStepOver: TAction; 30 | actRun: TAction; 31 | ActionList1: TActionList; 32 | ImageList2: TImageList; 33 | lblScriptState: TLabel; 34 | ListBox1: TListBox; 35 | MainMenu1: TMainMenu; 36 | MenuItem1: TMenuItem; 37 | MenuItem10: TMenuItem; 38 | MenuItem11: TMenuItem; 39 | MenuItem12: TMenuItem; 40 | MenuItem13: TMenuItem; 41 | MenuItem14: TMenuItem; 42 | MenuItem15: TMenuItem; 43 | MenuItem16: TMenuItem; 44 | MenuItem17: TMenuItem; 45 | MenuItem18: TMenuItem; 46 | MenuItem19: TMenuItem; 47 | MenuItem2: TMenuItem; 48 | MenuItem20: TMenuItem; 49 | MenuItem21: TMenuItem; 50 | MenuItem22: TMenuItem; 51 | MenuItem23: TMenuItem; 52 | MenuItem24: TMenuItem; 53 | MenuItem25: TMenuItem; 54 | MenuItem26: TMenuItem; 55 | MenuItem27: TMenuItem; 56 | MenuItem28: TMenuItem; 57 | MenuItem29: TMenuItem; 58 | MenuItem3: TMenuItem; 59 | MenuItem30: TMenuItem; 60 | MenuItem31: TMenuItem; 61 | MenuItem32: TMenuItem; 62 | MenuItem33: TMenuItem; 63 | MenuItem34: TMenuItem; 64 | MenuItem35: TMenuItem; 65 | MenuItem36: TMenuItem; 66 | MenuItem37: TMenuItem; 67 | MenuItem38: TMenuItem; 68 | MenuItem39: TMenuItem; 69 | MenuItem4: TMenuItem; 70 | MenuItem40: TMenuItem; 71 | MenuItem41: TMenuItem; 72 | MenuItem42: TMenuItem; 73 | MenuItem5: TMenuItem; 74 | MenuItem6: TMenuItem; 75 | MenuItem7: TMenuItem; 76 | MenuItem8: TMenuItem; 77 | MenuItem9: TMenuItem; 78 | OpenDialog1: TOpenDialog; 79 | PopupMenu1: TPopupMenu; 80 | SaveDialog1: TSaveDialog; 81 | Editor: TSynEdit; 82 | SpeedButton1: TSpeedButton; 83 | SpeedButton2: TSpeedButton; 84 | SpeedButton3: TSpeedButton; 85 | SpeedButton4: TSpeedButton; 86 | SpeedButton5: TSpeedButton; 87 | SpeedButton6: TSpeedButton; 88 | SynLuaSyn1: TSynLuaSyn; 89 | procedure actFreeRunExecute(Sender: TObject); 90 | procedure actPauseExecute(Sender: TObject); 91 | procedure actRefreshWatchesExecute(Sender: TObject); 92 | procedure actRunExecute(Sender: TObject); 93 | procedure actRunUpdate(Sender: TObject); 94 | procedure actShowStackExecute(Sender: TObject); 95 | procedure actShowWatchesExecute(Sender: TObject); 96 | procedure actStepIntoExecute(Sender: TObject); 97 | procedure actStepOverExecute(Sender: TObject); 98 | procedure actStopExecute(Sender: TObject); 99 | procedure actToggleBkptExecute(Sender: TObject); 100 | procedure actWatchExecute(Sender: TObject); 101 | procedure EditorSpecialLineColors(Sender: TObject; Line: integer; 102 | var Special: boolean; var FG, BG: TColor); 103 | procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); 104 | procedure FormCreate(Sender: TObject); 105 | procedure FormDestroy(Sender: TObject); 106 | procedure MenuItem12Click(Sender: TObject); 107 | procedure MenuItem18Click(Sender: TObject); 108 | procedure MenuItem19Click(Sender: TObject); 109 | procedure MenuItem20Click(Sender: TObject); 110 | procedure MenuItem21Click(Sender: TObject); 111 | procedure MenuItem22Click(Sender: TObject); 112 | procedure MenuItem23Click(Sender: TObject); 113 | procedure MenuItem24Click(Sender: TObject); 114 | procedure MenuItem25Click(Sender: TObject); 115 | procedure MenuItem26Click(Sender: TObject); 116 | procedure MenuItem27Click(Sender: TObject); 117 | procedure MenuItem28Click(Sender: TObject); 118 | procedure EditorGutterClick(Sender: TObject; X, Y, Line: integer; 119 | mark: TSynEditMark); 120 | procedure SynEditCutToClipboard(Sender: TObject); 121 | procedure SynEditSelectAll(Sender: TObject); 122 | procedure MenuItem2Click(Sender: TObject); 123 | procedure MenuItem3Click(Sender: TObject); 124 | procedure MenuItem5Click(Sender: TObject); 125 | procedure MenuItem7Click(Sender: TObject); 126 | procedure SynEditCopyToClipboard(Sender: TObject); 127 | procedure SynEditPasteFromClipboard(Sender: TObject); 128 | procedure PopupMenu1Popup(Sender: TObject); 129 | private 130 | { private declarations } 131 | FileName: string; 132 | 133 | procedure ToggleBreakpoint(Line: LongInt); 134 | procedure ScriptFinalize(AThrStat: Integer); 135 | procedure CaretPos(ALine, ACol: LongInt; ACenter: Boolean = True); 136 | procedure ShowScriptState; 137 | 138 | function BkptAtLine(ALine: LongInt): TSynEditMark; 139 | function HasBkptAtLine(ALine: LongInt): Boolean; 140 | 141 | function DoCompile: Boolean; 142 | procedure DoRun(AStep: TScriptDbgStates); 143 | procedure DoResume(AStep: TScriptDbgStates); 144 | procedure DoStop(AReset: Boolean); 145 | procedure ShowError(AErrorMsg: String); 146 | function GetVarContents(AId: String): String; 147 | function LuaVarToString(L: Plua_State): String; 148 | function GetStackContents(L: Plua_State; AVarArgs, ATemps: Boolean): String; 149 | procedure RefreshWatches; 150 | procedure RefreshStack; 151 | public 152 | { public declarations } 153 | end; 154 | 155 | var 156 | frmMain: TfrmMain; 157 | 158 | implementation 159 | 160 | uses 161 | lcs_registerall, Contnrs, SysUtils, Math, StrUtils; 162 | 163 | {$R *.lfm} 164 | 165 | const 166 | // Identifier characters 167 | ID_FIRST = ['A'..'Z', 'a'..'z', '_']; 168 | ID_SYMBOL = ID_FIRST + ['0'..'9']; 169 | ID_DELIMITERS = [#9..#127] - ID_SYMBOL; 170 | 171 | // Special line colors 172 | FG_ACTIVE = clWhite; 173 | BG_ACTIVE = clBlue; 174 | FG_BKPT = clWhite; 175 | BG_BKPT = clRed; 176 | FG_ACTIVE_ON_BKPT = clWhite; 177 | BG_ACTIVE_ON_BKPT = clMaroon; 178 | 179 | PRINT_SEP = ' '; // (or ''?) print() separator 180 | MAX_TABLE_N = 32; // Max table elements to show 181 | 182 | var 183 | // Just for the scope 184 | Script: record 185 | State: TScriptStates; 186 | StopRq, ResetRq: Boolean; 187 | L, Lt: Plua_State; 188 | LOfs, SrcLine, CallDepth, ReqDepth: LongInt; 189 | S: TStringList; 190 | end; 191 | 192 | { TfrmMain } 193 | 194 | function Alloc({%H-}ud, ptr: Pointer; {%H-}osize, nsize: size_t): Pointer; cdecl; 195 | begin 196 | try 197 | Result := ptr; 198 | ReallocMem(Result, nSize); 199 | except 200 | Result := nil; 201 | end; 202 | end; 203 | 204 | procedure DbgHook(L: Plua_State; ar: Plua_Debug); cdecl; 205 | var 206 | MustYield, AtBkpt: Boolean; 207 | begin 208 | Application.ProcessMessages; 209 | MustYield := False; 210 | case ar^.event of 211 | LUA_HOOKCALL: 212 | Inc(Script.CallDepth); 213 | LUA_HOOKRET: 214 | Dec(Script.CallDepth); 215 | LUA_HOOKLINE: 216 | begin 217 | Script.SrcLine := ar^.currentline - Script.LOfs; 218 | MustYield := Script.StopRq or Script.ResetRq; 219 | if 220 | not MustYield and 221 | not (ssFreeRun in Script.State) and 222 | (Script.SrcLine > 0) 223 | then 224 | begin 225 | AtBkpt := frmMain.HasBkptAtLine(Script.SrcLine); 226 | if (ssStepOver in Script.State) then 227 | MustYield := (Script.CallDepth <= Script.ReqDepth) or AtBkpt 228 | else 229 | MustYield := (ssStepInto in Script.State) or AtBkpt; 230 | end; 231 | end; 232 | end; 233 | if MustYield and lua_isyieldable(L) then 234 | lua_yield(L, 0); 235 | end; 236 | 237 | function StackToStr(L: Plua_State; ASep: String): String; 238 | var 239 | I, N, T: Integer; 240 | S, Si: String; 241 | begin 242 | S := ''; 243 | N := lua_gettop(L); 244 | for I := 1 to N do 245 | begin 246 | T := lua_type(L, I); 247 | case T of 248 | LUA_TSTRING, LUA_TNUMBER: 249 | Si := lua_tostring(L, I); 250 | LUA_TNIL: 251 | Si := 'nil'; 252 | LUA_TBOOLEAN: 253 | if lua_toboolean(L, I) then 254 | Si := 'true' else 255 | Si := 'false'; 256 | otherwise 257 | Si := '(' + lua_typename(L, T) + ')'; 258 | end; 259 | if S = '' then 260 | S := Si else 261 | S := S + ASep + Si; 262 | end; 263 | Result := S; 264 | end; 265 | 266 | function print(L: Plua_State): Integer; cdecl; 267 | begin 268 | frmMain.ListBox1.Items.AddText(StackToStr(L, PRINT_SEP)); 269 | Result := 0; 270 | end; 271 | 272 | procedure TfrmMain.FormCreate(Sender: TObject); 273 | begin 274 | Editor.Font.Height := Canvas.GetTextHeight('Fpc'); 275 | ListBox1.Font.Height := Canvas.GetTextHeight('Fpc'); 276 | SynLuaSyn1.ActiveDot := True; 277 | Caption := Application.Title; 278 | ShowScriptState; 279 | end; 280 | 281 | procedure TfrmMain.FormDestroy(Sender: TObject); 282 | begin 283 | end; 284 | 285 | procedure TfrmMain.MenuItem12Click(Sender: TObject); 286 | begin 287 | MenuItem13.Enabled := Editor.SelAvail; 288 | MenuItem14.Enabled := Editor.SelAvail; 289 | end; 290 | 291 | procedure TfrmMain.MenuItem18Click(Sender: TObject); 292 | begin 293 | Editor.InsertTextAtCaret('if () then' + LineEnding + LineEnding + 294 | 'else' + LineEnding + LineEnding + 'end'); 295 | end; 296 | 297 | procedure TfrmMain.MenuItem19Click(Sender: TObject); 298 | begin 299 | Editor.InsertTextAtCaret('while () do' + LineEnding + LineEnding + 'end'); 300 | end; 301 | 302 | procedure TfrmMain.MenuItem20Click(Sender: TObject); 303 | begin 304 | Editor.InsertTextAtCaret('repeat' + LineEnding + LineEnding + 'until'); 305 | end; 306 | 307 | procedure TfrmMain.MenuItem21Click(Sender: TObject); 308 | begin 309 | Editor.InsertTextAtCaret('for i=0,10,1 do' + LineEnding + LineEnding + 'end'); 310 | end; 311 | 312 | procedure TfrmMain.MenuItem22Click(Sender: TObject); 313 | begin 314 | Editor.InsertTextAtCaret('for i,v in ipairs() do' + LineEnding + LineEnding + 'end'); 315 | end; 316 | 317 | procedure TfrmMain.MenuItem23Click(Sender: TObject); 318 | begin 319 | Editor.InsertTextAtCaret('for k in pairs() do' + LineEnding + LineEnding + 'end'); 320 | end; 321 | 322 | procedure TfrmMain.MenuItem24Click(Sender: TObject); 323 | begin 324 | Editor.InsertTextAtCaret('function f()' + LineEnding + ' return' + 325 | LineEnding + 'end'); 326 | end; 327 | 328 | procedure TfrmMain.MenuItem25Click(Sender: TObject); 329 | begin 330 | Editor.InsertTextAtCaret('--'); 331 | end; 332 | 333 | procedure TfrmMain.MenuItem26Click(Sender: TObject); 334 | begin 335 | Editor.InsertTextAtCaret('--[[' + LineEnding + ']]'); 336 | end; 337 | 338 | procedure TfrmMain.MenuItem27Click(Sender: TObject); 339 | begin 340 | Editor.InsertTextAtCaret('if () then' + LineEnding + LineEnding + 'end'); 341 | end; 342 | 343 | procedure TfrmMain.MenuItem28Click(Sender: TObject); 344 | begin 345 | if FileName <> '' then 346 | begin 347 | Editor.Lines.SaveToFile(FileName); 348 | end 349 | else 350 | begin 351 | if SaveDialog1.Execute then 352 | begin 353 | FileName := SaveDialog1.FileName; 354 | Editor.Lines.SaveToFile(SaveDialog1.FileName); 355 | end; 356 | end; 357 | end; 358 | 359 | procedure TfrmMain.EditorGutterClick(Sender: TObject; X, Y, Line: integer; 360 | mark: TSynEditMark); 361 | begin 362 | ToggleBreakpoint(Line); 363 | end; 364 | 365 | procedure TfrmMain.SynEditCutToClipboard(Sender: TObject); 366 | begin 367 | Editor.CutToClipboard; 368 | end; 369 | 370 | procedure TfrmMain.SynEditSelectAll(Sender: TObject); 371 | begin 372 | Editor.SelectAll; 373 | end; 374 | 375 | procedure TfrmMain.MenuItem2Click(Sender: TObject); 376 | begin 377 | if OpenDialog1.Execute then 378 | begin 379 | FileName := OpenDialog1.FileName; 380 | Editor.Lines.LoadFromFile(OpenDialog1.FileName); 381 | end; 382 | end; 383 | 384 | procedure TfrmMain.MenuItem3Click(Sender: TObject); 385 | begin 386 | if SaveDialog1.Execute then 387 | begin 388 | FileName := SaveDialog1.FileName; 389 | Editor.Lines.SaveToFile(SaveDialog1.FileName); 390 | end; 391 | end; 392 | 393 | procedure TfrmMain.MenuItem5Click(Sender: TObject); 394 | begin 395 | Self.Close; 396 | end; 397 | 398 | procedure TfrmMain.MenuItem7Click(Sender: TObject); 399 | begin 400 | OpenURL('https://github.com/lainz/lainzcodestudio/wiki'); 401 | end; 402 | 403 | procedure TfrmMain.SynEditCopyToClipboard(Sender: TObject); 404 | begin 405 | Editor.CopyToClipboard; 406 | end; 407 | 408 | procedure TfrmMain.SynEditPasteFromClipboard(Sender: TObject); 409 | begin 410 | Editor.PasteFromClipboard; 411 | end; 412 | 413 | procedure TfrmMain.PopupMenu1Popup(Sender: TObject); 414 | begin 415 | MenuItem8.Enabled := Editor.SelAvail; 416 | MenuItem10.Enabled := Editor.SelAvail; 417 | end; 418 | 419 | procedure TfrmMain.ToggleBreakpoint(Line: LongInt); 420 | var 421 | Mark: TSynEditMark; 422 | begin 423 | Mark := BkptAtLine(Line); 424 | if Mark <> Nil then 425 | repeat 426 | Editor.Marks.Remove(Mark); 427 | Mark.Free; 428 | Mark := BkptAtLine(Line); 429 | until Mark = Nil 430 | else 431 | begin 432 | Mark := TSynEditMark.Create(Editor); 433 | Mark.Line := Line; 434 | Mark.BookmarkNumber := -99; // brkpt 435 | Mark.ImageList := ImageList2; 436 | Mark.ImageIndex := 10; 437 | Mark.Visible := True; 438 | Editor.Marks.Add(Mark); 439 | end; 440 | Editor.Refresh; 441 | end; 442 | 443 | procedure TfrmMain.ScriptFinalize(AThrStat: Integer); 444 | begin 445 | Script.State := []; 446 | Script.StopRq := False; 447 | Script.ResetRq := False; 448 | if LUA_YIELD_ < AThrStat then 449 | ShowError(lua_tostring(Script.Lt, -1)); 450 | Script.SrcLine := -1; 451 | lua_close(Script.L); 452 | Script.S.Free; 453 | ShowScriptState; 454 | Editor.Refresh; 455 | end; 456 | 457 | procedure TfrmMain.CaretPos(ALine, ACol: LongInt; ACenter: Boolean); 458 | begin 459 | if ACenter then 460 | if (ALine < Editor.TopLine + 2) or 461 | (ALine > Editor.TopLine + Editor.LinesInWindow - 2) 462 | then 463 | Editor.TopLine := ALine - (Editor.LinesInWindow div 2); 464 | Editor.CaretY := ALine; 465 | Editor.CaretX := ACol; 466 | end; 467 | 468 | procedure TfrmMain.ShowScriptState; 469 | var 470 | Running, Paused, FreeRun: Boolean; 471 | begin 472 | Running := (ssRunning in Script.State); 473 | Paused := (ssPaused in Script.State); 474 | FreeRun := (ssFreeRun in Script.State); 475 | 476 | actRun.Enabled := not Running or Paused; 477 | actFreeRun.Enabled := not Running or Paused; 478 | actPause.Enabled := Running and not Paused; 479 | actStop.Enabled := Running; 480 | 481 | actStepInto.Enabled := not FreeRun; 482 | actStepOver.Enabled := not FreeRun; 483 | 484 | if Paused then 485 | lblScriptState.Caption := Format('Paused at line %d', [script.SrcLine]) 486 | else if FreeRun then 487 | lblScriptState.Caption := 'Running (no brkpt)...' 488 | else if Running then 489 | lblScriptState.Caption := 'Running...' 490 | else 491 | lblScriptState.Caption := 'Not running'; 492 | end; 493 | 494 | function TfrmMain.BkptAtLine(ALine: LongInt): TSynEditMark; 495 | var 496 | Marks: TSynEditMarkLine; 497 | Mark: TSynEditMark; 498 | I: Integer; 499 | begin 500 | Result := Nil; 501 | Marks := Editor.Marks.Line[ALine]; 502 | if Assigned(Marks) then 503 | for I := 0 to Pred(Marks.Count) do 504 | begin 505 | Mark := Marks[I]; 506 | if Mark.BookmarkNumber < 0 then 507 | begin 508 | Result := Mark; 509 | Break; 510 | end; 511 | end; 512 | end; 513 | 514 | function TfrmMain.HasBkptAtLine(ALine: LongInt): Boolean; 515 | begin 516 | Result := BkptAtLine(ALine) <> Nil; 517 | end; 518 | 519 | function TfrmMain.DoCompile: Boolean; 520 | begin 521 | ListBox1.Clear; 522 | Script.L := lua_newstate(@alloc, nil); 523 | luaL_openlibs(Script.L); 524 | lua_register(Script.L, 'print', @print); 525 | Script.S := TStringList.Create; 526 | RegisterAll(Script.L, Script.S); 527 | Script.S.Text := Script.S.Text; // split lines 528 | Script.LOfs := Script.S.Count; // offset of 1-st line 529 | Script.S.Add(Editor.Text); 530 | Script.Lt := lua_newthread(Script.L); // for yield/resume 531 | lua_sethook(Script.Lt, @DbgHook, LUA_MASKLINE + LUA_MASKCALL + LUA_MASKRET, 0); 532 | Result := (luaL_loadbuffer(Script.Lt, PChar(Script.S.Text), 533 | Length(Script.S.Text), 'Lainz Code Studio') = 0); 534 | Script.CallDepth := 0; 535 | if not Result then 536 | ShowError(lua_tostring(Script.Lt, -1)); // invalid source line 537 | end; 538 | 539 | procedure TfrmMain.DoRun(AStep: TScriptDbgStates); 540 | begin 541 | if ssPaused in Script.State then 542 | DoResume(AStep) 543 | 544 | else if not(ssRunning in Script.State) then 545 | begin 546 | if DoCompile then 547 | DoResume(AStep); 548 | end; 549 | end; 550 | 551 | procedure TfrmMain.DoResume(AStep: TScriptDbgStates); 552 | var 553 | stat: Integer; 554 | begin 555 | Script.StopRq := False; 556 | Script.ResetRq := False; 557 | if ssStepOver in AStep then 558 | Script.ReqDepth := Max(1, Script.CallDepth); 559 | Script.State := AStep + [ssRunning]; 560 | ShowScriptState; 561 | stat := lua_resume(Script.Lt, Script.Lt, 0); 562 | if stat = LUA_YIELD_ then 563 | begin 564 | Exclude(Script.State, ssFreeRun); 565 | Include(Script.State, ssPaused); 566 | CaretPos(Script.SrcLine, 1); 567 | ShowScriptState; 568 | if Script.StopRq or Script.ResetRq then 569 | begin 570 | Script.StopRq := False; 571 | if Script.ResetRq then 572 | ScriptFinalize(stat); 573 | end 574 | end 575 | else 576 | ScriptFinalize(stat); 577 | Editor.Refresh; 578 | RefreshWatches; 579 | RefreshStack; 580 | end; 581 | 582 | procedure TfrmMain.DoStop(AReset: Boolean); 583 | begin 584 | Script.StopRq := True; 585 | Script.ResetRq := AReset; 586 | end; 587 | 588 | procedure TfrmMain.ShowError(AErrorMsg: String); 589 | begin 590 | ListBox1.Items.Add(Format('Line %d: ', [Script.SrcLine]) + AErrorMsg); 591 | end; 592 | 593 | function TfrmMain.GetVarContents(AId: String): String; 594 | 595 | function EvaLua(L: Plua_State; AExp: String): Integer; 596 | begin 597 | luaL_loadstring(L, PChar('return ' + AExp)); 598 | lua_pcall(L, 0, 1, 0); 599 | Result := lua_type(L, -1); 600 | end; 601 | 602 | begin 603 | Result := ''; 604 | if not (ssRunning in Script.State) then 605 | Exit; 606 | EvaLua(Script.L, AId); 607 | try 608 | Result := LuaVarToString(Script.L); 609 | finally 610 | lua_pop(Script.L, 1); 611 | end; 612 | end; 613 | 614 | function TfrmMain.LuaVarToString(L: Plua_State): String; 615 | var 616 | T: Integer; 617 | S: String; 618 | 619 | function AddQuoted(S: String): String; 620 | var 621 | C: Char; 622 | begin 623 | Result := '"'; 624 | for C in S do 625 | if C in [#0, #7, #8, #9, #10, #11, #12, #13, '"', '''', '\'] then 626 | case C of 627 | #0: Result := Result + '\0'; 628 | #7: Result := Result + '\a'; 629 | #8: Result := Result + '\b'; 630 | #9: Result := Result + '\t'; 631 | #10: Result := Result + '\n'; 632 | #11: Result := Result + '\v'; 633 | #12: Result := Result + '\f'; 634 | #13: Result := Result + '\r'; 635 | otherwise 636 | Result := Result + '\' + C; 637 | end 638 | else if C < ' ' then 639 | Result := Result + '\' + RightStr('000' + IntToStr(Ord(C)), 3) 640 | else 641 | Result := Result + C; 642 | Result := Result + '"'; 643 | end; 644 | 645 | function TblToString(L: Plua_State; V: Integer): String; 646 | var 647 | N: Integer; 648 | begin 649 | Result := '{'; 650 | N := 0; 651 | lua_pushnil(L); 652 | while lua_next(L, -2) <> 0 do 653 | try 654 | if N < 1 then 655 | else if N < MAX_TABLE_N then 656 | Result := Result + ', ' 657 | else 658 | begin // do not print after n-th element 659 | Result := Result + ', ...'; 660 | lua_pop(L, 1); 661 | Break; 662 | end; 663 | Inc(N); 664 | 665 | lua_pushvalue(L, -2); 666 | try 667 | Result := Result + lua_tostring(L, -1) + ' => '; 668 | finally 669 | lua_pop(L, 1); 670 | end; 671 | if lua_istable(L, -1) then 672 | Result := Result + TblToString(L, V + 1) 673 | else if lua_isstring(L, -1) then 674 | Result := Result + AddQuoted(lua_tostring(L, -1)) 675 | else 676 | Result := Result + lua_tostring(L, -1); 677 | 678 | finally 679 | lua_pop(L, 1); 680 | end; 681 | Result := Result + '}'; 682 | end; 683 | 684 | begin 685 | Result := ''; 686 | T := lua_type(L, -1); 687 | case T of 688 | LUA_TSTRING: 689 | S := AddQuoted(lua_tostring(L, -1)); 690 | LUA_TNUMBER: 691 | S := lua_tostring(L, -1); 692 | LUA_TNIL: 693 | S := 'nil'; 694 | LUA_TBOOLEAN: 695 | if lua_toboolean(L, -1) then 696 | S := 'true' else 697 | S := 'false'; 698 | LUA_TTABLE: 699 | S := TblToString(L, 1); 700 | otherwise 701 | S := '(' + lua_typename(L, T) + ')'; 702 | end; 703 | Result := S; 704 | end; 705 | 706 | function TfrmMain.GetStackContents(L: Plua_State; AVarArgs, ATemps: Boolean 707 | ): String; 708 | var 709 | ar: lua_Debug; 710 | I: Integer; 711 | LName: String; 712 | PLName: PChar; 713 | 714 | procedure L1(AInc: Integer; Temps: Boolean); 715 | begin 716 | I := AInc; 717 | while True do 718 | begin 719 | PLName := lua_getlocal(L, @ar, I); 720 | if PLName = Nil then 721 | Break 722 | else 723 | try 724 | LName := StrPas(PLName); 725 | if not Temps and (LName[1] = '(') then 726 | Continue; 727 | Result := Result + 728 | LName + ' = ' + LuaVarToString(L) + LineEnding; 729 | finally 730 | I := I + AInc; 731 | lua_pop(Script.Lt, 1); 732 | end; 733 | end; 734 | end; 735 | 736 | begin 737 | Result := ''; 738 | if not (ssRunning in Script.State) then 739 | Exit; 740 | if lua_getstack(L, 0, @ar) <> 1 then 741 | Exit; 742 | if AVarArgs then 743 | L1(-1, True); 744 | L1(1, ATemps); 745 | end; 746 | 747 | procedure TfrmMain.RefreshWatches; 748 | var 749 | SID, Cont: String; 750 | I: Integer; 751 | begin 752 | with frmWatches do 753 | for I := 0 to Pred(moWatches.Lines.Count) do 754 | begin 755 | SID := Trim(ExtractWord(1, moWatches.Lines[I], ['=']{ID_DELIMITERS})); 756 | if (SID = '') or not (SID[1] in ID_FIRST) then 757 | Continue; 758 | if (ssRunning in Script.State) then 759 | Cont := GetVarContents(SID) else 760 | Cont := '(not running)'; 761 | moWatches.Lines[I] := SID + ' = ' + Cont; 762 | end; 763 | end; 764 | 765 | procedure TfrmMain.RefreshStack; 766 | begin 767 | with frmStack do 768 | moStack.Text := GetStackContents(Script.Lt, True, False); 769 | end; 770 | 771 | procedure TfrmMain.actRunExecute(Sender: TObject); 772 | begin 773 | DoRun([]); 774 | end; 775 | 776 | procedure TfrmMain.actRunUpdate(Sender: TObject); 777 | begin 778 | 779 | end; 780 | 781 | procedure TfrmMain.actShowStackExecute(Sender: TObject); 782 | begin 783 | if frmStack.Visible then 784 | frmStack.Hide else frmStack.Show; 785 | actShowStack.Checked := frmStack.Visible; 786 | end; 787 | 788 | procedure TfrmMain.actShowWatchesExecute(Sender: TObject); 789 | begin 790 | if frmWatches.Visible then 791 | frmWatches.Hide else frmWatches.Show; 792 | actShowWatches.Checked := frmWatches.Visible; 793 | end; 794 | 795 | procedure TfrmMain.actFreeRunExecute(Sender: TObject); 796 | begin 797 | DoRun([ssFreeRun]); 798 | end; 799 | 800 | procedure TfrmMain.actPauseExecute(Sender: TObject); 801 | begin 802 | Script.StopRq := True; 803 | end; 804 | 805 | procedure TfrmMain.actRefreshWatchesExecute(Sender: TObject); 806 | begin 807 | RefreshWatches; 808 | end; 809 | 810 | procedure TfrmMain.actStepIntoExecute(Sender: TObject); 811 | begin 812 | DoRun([ssStepInto]); 813 | end; 814 | 815 | procedure TfrmMain.actStepOverExecute(Sender: TObject); 816 | begin 817 | DoRun([ssStepOver]); 818 | end; 819 | 820 | procedure TfrmMain.actStopExecute(Sender: TObject); 821 | begin 822 | if ssPaused in Script.State then 823 | ScriptFinalize(0) else 824 | Script.ResetRq := True; 825 | end; 826 | 827 | procedure TfrmMain.actToggleBkptExecute(Sender: TObject); 828 | begin 829 | ToggleBreakpoint(Editor.CaretY); 830 | end; 831 | 832 | procedure TfrmMain.actWatchExecute(Sender: TObject); 833 | var 834 | S, SID, Cont: String; 835 | I: Integer = 0; 836 | begin 837 | S := Trim(Editor.SelText); 838 | if S = '' then 839 | begin 840 | S := Trim(InputBox('Watch', 'Variable', '')); 841 | end; 842 | if S = '' then 843 | Exit; 844 | for I := 1 to 10 do 845 | begin 846 | SID := ExtractWord(I, S, ID_DELIMITERS); 847 | if SID = '' then 848 | Break; 849 | if not (SID[1] in ID_FIRST) then 850 | Continue; 851 | Cont := GetVarContents(SID); 852 | if not frmWatches.Visible then 853 | actShowWatches.Execute; 854 | frmWatches.moWatches.Lines.Add(SID + ' = ' + Cont); 855 | end; 856 | end; 857 | 858 | procedure TfrmMain.EditorSpecialLineColors(Sender: TObject; Line: integer; 859 | var Special: boolean; var FG, BG: TColor); 860 | begin 861 | if HasBkptAtLine(Line) then 862 | begin 863 | Special := True; 864 | if Line = Script.SrcLine then 865 | begin 866 | FG := FG_ACTIVE_ON_BKPT; 867 | BG := BG_ACTIVE_ON_BKPT; 868 | end else 869 | begin 870 | FG := FG_BKPT; 871 | BG := BG_BKPT; 872 | end; 873 | end 874 | else if Line = Script.SrcLine then 875 | begin 876 | Special := True; 877 | FG := FG_ACTIVE; // clWhite; 878 | BG := BG_ACTIVE; // clBlue; 879 | end 880 | else 881 | Special := False; 882 | end; 883 | 884 | procedure TfrmMain.FormClose(Sender: TObject; var CloseAction: TCloseAction); 885 | begin 886 | if ssRunning in Script.State then 887 | ScriptFinalize(0); 888 | end; 889 | 890 | end. 891 | -------------------------------------------------------------------------------- /ustack.lfm: -------------------------------------------------------------------------------- 1 | object frmStack: TfrmStack 2 | Left = 413 3 | Height = 240 4 | Top = 133 5 | Width = 320 6 | BorderStyle = bsToolWindow 7 | Caption = 'Stack' 8 | ClientHeight = 240 9 | ClientWidth = 320 10 | FormStyle = fsStayOnTop 11 | Position = poDefault 12 | LCLVersion = '1.9.0.0' 13 | object moStack: TMemo 14 | Left = 0 15 | Height = 240 16 | Top = 0 17 | Width = 320 18 | Align = alClient 19 | Color = clCream 20 | ParentFont = False 21 | ReadOnly = True 22 | ScrollBars = ssAutoBoth 23 | TabOrder = 0 24 | WordWrap = False 25 | end 26 | end 27 | -------------------------------------------------------------------------------- /ustack.pas: -------------------------------------------------------------------------------- 1 | unit ustack; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls; 9 | 10 | type 11 | 12 | { TfrmStack } 13 | 14 | TfrmStack = class(TForm) 15 | moStack: TMemo; 16 | private 17 | 18 | public 19 | 20 | end; 21 | 22 | var 23 | frmStack: TfrmStack; 24 | 25 | implementation 26 | 27 | {$R *.lfm} 28 | 29 | end. 30 | 31 | -------------------------------------------------------------------------------- /uwatches.lfm: -------------------------------------------------------------------------------- 1 | object frmWatches: TfrmWatches 2 | Left = 457 3 | Height = 240 4 | Top = 173 5 | Width = 320 6 | BorderStyle = bsToolWindow 7 | Caption = 'Watch' 8 | ClientHeight = 240 9 | ClientWidth = 320 10 | FormStyle = fsStayOnTop 11 | Position = poDefault 12 | LCLVersion = '1.9.0.0' 13 | object moWatches: TMemo 14 | Left = 0 15 | Height = 240 16 | Top = 0 17 | Width = 320 18 | Align = alClient 19 | Color = clMoneyGreen 20 | ParentFont = False 21 | ScrollBars = ssAutoBoth 22 | TabOrder = 0 23 | WordWrap = False 24 | end 25 | end 26 | -------------------------------------------------------------------------------- /uwatches.pas: -------------------------------------------------------------------------------- 1 | unit uwatches; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls; 9 | 10 | type 11 | 12 | { TfrmWatches } 13 | 14 | TfrmWatches = class(TForm) 15 | moWatches: TMemo; 16 | private 17 | 18 | public 19 | 20 | end; 21 | 22 | var 23 | frmWatches: TfrmWatches; 24 | 25 | implementation 26 | 27 | {$R *.lfm} 28 | 29 | end. 30 | 31 | --------------------------------------------------------------------------------