Merge pull request #2325 from github/clarion

Adding support for Clarion

.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

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

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"

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 pStr>) !,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('&', '&amp;')
+  CS.Replace('<', '&lt;')
+  CS.Replace('>', '&gt;')
+  CS.Replace('"', '&quot;')
+  CS.Replace('''', '&apos;')
+
+  RETURN CS.Str()
+

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

samples/Clarion/HelloWorld.clw

@@ -0,0 +1,10 @@
+  PROGRAM
+
+  MAP
+  END
+
+  CODE
+
+  MESSAGE('Hello World!')
+
+  RETURN

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!')