diff --git a/.gitmodules b/.gitmodules index a43b324c..aea5068f 100644 --- a/.gitmodules +++ b/.gitmodules @@ -612,6 +612,9 @@ [submodule "vendor/grammars/mediawiki.tmbundle"] path = vendor/grammars/mediawiki.tmbundle url = https://github.com/textmate/mediawiki.tmbundle +[submodule "vendor/grammars/SublimeClarion"] + path = vendor/grammars/SublimeClarion + url = https://github.com/fushnisoft/SublimeClarion [submodule "vendor/grammars/oracle.tmbundle"] path = vendor/grammars/oracle.tmbundle url = https://github.com/mulander/oracle.tmbundle.git diff --git a/grammars.yml b/grammars.yml index e67b0710..46f2fd5d 100644 --- a/grammars.yml +++ b/grammars.yml @@ -123,6 +123,8 @@ vendor/grammars/Sublime-VimL: - source.viml vendor/grammars/SublimeBrainfuck: - source.bf +vendor/grammars/SublimeClarion/: +- source.clarion vendor/grammars/SublimePapyrus/: - source.compiled-papyrus - source.papyrus diff --git a/lib/linguist/languages.yml b/lib/linguist/languages.yml index fb046819..12a48e9f 100644 --- a/lib/linguist/languages.yml +++ b/lib/linguist/languages.yml @@ -502,6 +502,14 @@ Cirru: extensions: - .cirru +Clarion: + type: programming + color: "#db901e" + ace_mode: text + extensions: + - .clw + tm_scope: source.clarion + Clean: type: programming color: "#3F85AF" diff --git a/samples/Clarion/CStringClass.clw b/samples/Clarion/CStringClass.clw new file mode 100644 index 00000000..7fa3ba98 --- /dev/null +++ b/samples/Clarion/CStringClass.clw @@ -0,0 +1,172 @@ + Member() + omit('***$***',_VER_C55) +_ABCDllMode_ EQUATE(0) +_ABCLinkMode_ EQUATE(1) + ***$*** + Include('Equates.CLW'),ONCE + Include('Keycodes.CLW'),ONCE + Include('Errors.CLW'),ONCE + Map + End ! map + Include('CStringClass.inc'),ONCE +CStringClass.Construct PROCEDURE ! Declare Procedure + CODE + SELF.bufferSize = DEFAULT_CS_BUFFER_SIZE + SELF.CS &= New(CSTRING(SELF.bufferSize)) +CStringClass.Destruct PROCEDURE ! Declare Procedure + CODE + Dispose(SELF.cs) +CStringClass.Cat PROCEDURE (STRING pStr) !,*CSTRING,PROC ! Declare Procedure +newLen LONG,AUTO +oldCS &CSTRING + CODE + newLen = Len(pStr) + IF (newLen+SELF.strLength+2) > SELF.newStrSize + ! Only grow the internal string if the result of the cat will be larger than the string currently is. + ! The reason for the "+2" is because this is used in the string slicing outside this IF. Without this matching +2 there is potential for an out of bounds slice which would be bad! + + ! Save a temporary copy of the old string so we can us it in the concatination after we have grown it! + oldCS &= New(CSTRING(SELF.strLength+1)) + oldCS = SELF.CS + Dispose(SELF.CS) + + SELF.newStrSize = newLen + SELF.strLength + 1 + SELF.bufferSize + SELF.CS &= New(CSTRING(SELF.newStrSize)) + SELF.CS = oldCS + Dispose(oldCS) + END + + ! Append the new string directly to the end of the old one. + SELF.CS[SELF.strLength+1 : SELF.strLength+newLen] = pStr + ! And terminate the CSTRING manually + SELF.CS[SELF.strLength+newLen+1] = '<0>' + + ! This is the same as doing "SELF.strLength = Len(SELF.CS)" but the Len() is _really_ slow on large strings. This is much faster! + SELF.strLength += newLen + + ! This is what it used to be: + ! SELF.Str(SELF.Str() & s) + ! It is a nice and neat solution but performance, especially on large strings was terrible! + + RETURN SELF.Str() +CStringClass.Str PROCEDURE (STRING pStr) !,*CSTRING, PROC ! Declare Procedure + CODE + IF Len(pStr) > SELF.newStrSize + ! Only Dispose/New the internal string if the new one requires it. + ! This might be slightly innefficient in terms of memory usage when the string gets smaller + ! But it is _vasty_ better for performance when the string gets added to a lot. + Dispose(SELF.CS) + SELF.newStrSize = Len(pStr) + 1 + SELF.bufferSize + SELF.CS &= New(CSTRING(SELF.newStrSize)) + END + + SELF.CS = pStr + SELF.strLength = Len(SELF.CS) + + RETURN SELF.CS +CStringClass.Len PROCEDURE !,LONG ! Declare Procedure + CODE + RETURN SELF.strLength +CStringClass.Replace PROCEDURE (STRING pFind, STRING pReplace) !,*CSTRING,PROC ! Declare Procedure +! FindString , ReplaceWith +locate LONG,AUTO +lastLocate LONG + CODE + LOOP + locate = InString(Upper(pFind), Upper(SELF.Str()), 1, lastLocate+1) + IF ~locate + BREAK + END + + ! So we dont end up having recursive replacement. + lastLocate = locate + Len(pReplace)-1 + + SELF.Str(Sub(SELF.Str(), 1, locate-1) & | + pReplace & | + Sub(SELF.Str(), locate+Len(pFind), SELF.Len()) | + ) + END + + RETURN SELF.Str() +CStringClass.Str PROCEDURE () !,*CSTRING ! Declare Procedure 3 + CODE + RETURN SELF.CS +!------------------------------------------------------------------------------ +CStringClass.Contains PROCEDURE (STRING pFind, BYTE pCaseSensitive=TRUE) !,BYTE ! Declare Procedure +! Returns a value (TRUE) indicating whether the specified String occurs within this string. +! Second parameter defaults to a case sensitive search. + CODE + IF pCaseSensitive = TRUE + IF InString(pFind, SELF.Str(), 1 , 1) > 0 + RETURN TRUE + END + ELSE + IF InString(Lower(pFind), SELF.Lower(), 1 , 1) > 0 + RETURN TRUE + END + END + + RETURN FALSE +CStringClass.Lower PROCEDURE () !,STRING ! Declare Procedure +! Returns a "Lowered" version of the self.cs doesnt change the self.cs + CODE + RETURN Lower(SELF.CS) +CStringClass.SubString PROCEDURE (LONG pPosition, LONG pLength) !,STRING,PROC ! Declare Procedure + CODE + RETURN Sub(SELF.Str(), pPosition, pLength) +CStringClass.ToLower PROCEDURE () !,*CSTRING,PROC ! Declare Procedure +! Converts this string to lowercase and returns the converted string + + CODE + RETURN SELF.Str(SELF.Lower()) +CStringClass.ToUpper PROCEDURE () !,*CSTRING,PROC ! Declare Procedure +! Converts this string to uppercase and returns the converted string + + CODE + RETURN SELF.Str(SELF.Upper()) +CStringClass.Trim PROCEDURE () !,*CSTRING,PROC ! Declare Procedure + CODE + SELF.Str(Left(SELF.Str())) + SELF.Str(Clip(SELF.Str())) + RETURN SELF.Str() +CStringClass.Upper PROCEDURE () !,STRING ! Declare Procedure + CODE + RETURN Upper(SELF.Str()) +CStringClass.IndexOf PROCEDURE (STRING pLookIn, BYTE pCaseSensitive=TRUE) !,LONG ! Declare Procedure +! Returns the index of the first parameter (pLookIn) is found within the SELF.CS +! zero if it is not found + CODE + IF pCaseSensitive = TRUE + RETURN InString(SELF.Str(), pLookIn, 1 , 1) + ELSE + RETURN InString(SELF.Lower(), Lower(pLookIn), 1 , 1) + END +CStringClass.FoundIn PROCEDURE (STRING pLookIn, BYTE pCaseSensitive=TRUE) !,BYTE ! Declare Procedure +! Returns TRUE if the first parameter (pLookIn) is found within the SELF.CS +! FALSE if it is no + CODE + IF SELF.IndexOf(pLookIn, pCaseSensitive) > 0 + RETURN TRUE + ELSE + RETURN FALSE + END +CStringClass.SetBuffer PROCEDURE (LONG pNewBuffer) ! Declare Procedure + CODE + SELF.bufferSize = pNewBuffer +CStringClass.EscapeXml PROCEDURE () !,STRING ! Declare Procedure +CS CStringClass + CODE + IF Omitted(pStr)=FALSE + CS.Str(pStr) + ELSE + ! Make a copy so we don't alter the original + CS.Str(SELF.Str()) + END + CS.Replace('&', '&') + CS.Replace('<', '<') + CS.Replace('>', '>') + CS.Replace('"', '"') + CS.Replace('''', ''') + + RETURN CS.Str() + diff --git a/samples/Clarion/ConsoleSupport.clw b/samples/Clarion/ConsoleSupport.clw new file mode 100644 index 00000000..c7eac1e1 --- /dev/null +++ b/samples/Clarion/ConsoleSupport.clw @@ -0,0 +1,68 @@ + Member() + Include('ConsoleSupport.inc'),ONCE + Map + MODULE('32-bit Windows API') + ! General functions + GetLastError(),DWORD,PASCAL + + ! Console functions + GetStdHandle(DWORD),HANDLE,PASCAL,PROC,RAW + WriteConsole(Handle,Long,Dword,long,long),bool,Raw,Pascal,name('WriteConsoleA') + ReadConsole(Handle,Long,Dword,long,long),bool,Raw,Pascal,name('ReadConsoleA') + SetConsoleTitle(Long),Bool,Raw,Pascal,name('SetConsoleTitleA') + GetConsoleTitle(Long,dword),Bool,Raw,Pascal,name('GetConsoleTitleA') + SetConsoleMode(Handle,dWord),BOOL,RAW,PASCAL + GetConsoleMode(Handle,Long),BOOL,RAW,PASCAL + End + End + +ConsoleSupport.Construct PROCEDURE + + CODE + +ConsoleSupport.Destruct PROCEDURE + + CODE + +ConsoleSupport.Init PROCEDURE () !,BYTE,VIRTUAL + CODE + + SELF.OutputHandle = GetStdHandle(STD_OUTPUT_HANDLE) + If SELF.OutputHandle = INVALID_HANDLE_VALUE + Halt(1,'Unable to get output handle (' & GetLastError() & ')') + RETURN INVALID_HANDLE_VALUE + End + + SELF.InputHandle = GetStdHandle(STD_INPUT_HANDLE) + if SELF.InputHandle = INVALID_HANDLE_VALUE + Halt(2,'Unable to get console input handle (' & GetLastError() & ')') + RETURN INVALID_HANDLE_VALUE + End + + If ~SetConsoleMode(SELF.InputHandle,ENABLE_PROCESSED_INPUT ) + Halt(3,'Unable to set console mode (' & GetLastError() & ')') + RETURN INVALID_OTHER + End + + RETURN FALSE + +ConsoleSupport.WriteLine PROCEDURE (STRING pText) !,BYTE,PROC,VIRTUAL + CODE + SELF.TextBuffer = SELF.Prefix & pText & '<13,10>' + If WriteConsole(SELF.OutputHandle, ADDRESS(SELF.TextBuffer), LEN(SELF.TextBuffer),ADDRESS(SELF.BytesWritten), NULL) = 0 + Halt(4,'WriteConsoleError (' & GetLastError() & ')') + RETURN -1 + End + RETURN FALSE + +Consolesupport.ReadKey PROCEDURE () !,STRING,PROC,VIRTUAL + CODE + SELF.WriteLine('Press any key to continue...') + Clear(SELF.InBuffer) + Loop + IF ReadConsole(SELF.InputHandle,Address(SELF.InBuffer),100,Address(SELF.BytesRead),NULL) = 0 THEN + Halt(5,'Error on read console (' & GetLastError() & ')') + Break + End + Until SELF.BytesRead > 0 + RETURN SELF.InBuffer \ No newline at end of file diff --git a/samples/Clarion/HelloWorld.clw b/samples/Clarion/HelloWorld.clw new file mode 100644 index 00000000..8cad46dc --- /dev/null +++ b/samples/Clarion/HelloWorld.clw @@ -0,0 +1,10 @@ + PROGRAM + + MAP + END + + CODE + + MESSAGE('Hello World!') + + RETURN \ No newline at end of file diff --git a/samples/Clarion/hello.clw b/samples/Clarion/hello.clw new file mode 100644 index 00000000..14328c84 --- /dev/null +++ b/samples/Clarion/hello.clw @@ -0,0 +1,12 @@ + MEMBER() + INCLUDE('HelloClass.inc'),ONCE + MAP + END + +HelloClass.Construct PROCEDURE + CODE +HelloClass.Destruct PROCEDURE() !,VIRTUAL + CODE +HelloClass.SayHello PROCEDURE + CODE + MESSAGE('Hello World!') diff --git a/vendor/grammars/SublimeClarion b/vendor/grammars/SublimeClarion new file mode 160000 index 00000000..f070aadd --- /dev/null +++ b/vendor/grammars/SublimeClarion @@ -0,0 +1 @@ +Subproject commit f070aadd26c5376be522bd0c9a135ff85bb76f13