removed less common extensions and better examples

lib/linguist/languages.yml

@@ -432,10 +432,7 @@ Clarion:
   color: #f29200
   extensions:
   - .clw
-  - .equ
   - .inc
-  - .tpw
-  - .txa
   tm_scope: source.clarion
 
 Clean:

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/CStringClass.inc

@@ -0,0 +1,36 @@
+_CStringClass_ EQUATE(1)
+
+NOT_CASE_SENSITIVE           EQUATE(FALSE)
+DEFAULT_CS_BUFFER_SIZE       EQUATE(1024)
+!--------------------------------------------------------------------------------
+!Class CStringClass
+!
+!--------------------------------------------------------------------------------
+CStringClass     Class(),Type,Module('CStringClass.Clw'),LINK('CStringClass.Clw',1)
+! Properties
+cs                           &CSTRING, PROTECTED
+bufferSize                   LONG
+newStrSize                   LONG ,PROTECTED
+strLength                    LONG ,PROTECTED
+nextPointer                  LONG
+! Methods
+Cat                    PROCEDURE (STRING pStr) ,*CSTRING,PROC ,VIRTUAL 
+Construct              PROCEDURE   
+Contains               PROCEDURE (STRING pFind, BYTE pCaseSensitive=TRUE) ,BYTE ,VIRTUAL 
+Destruct               PROCEDURE () ,VIRTUAL 
+Len                    PROCEDURE ,LONG ,VIRTUAL 
+Lower                  PROCEDURE () ,STRING ,VIRTUAL 
+Replace                PROCEDURE (STRING pFind, STRING pReplace) ,*CSTRING,PROC ,VIRTUAL 
+Str                    PROCEDURE (STRING pStr) ,*CSTRING, PROC   ,VIRTUAL 
+Str                    PROCEDURE () ,*CSTRING ,VIRTUAL 
+SubString              PROCEDURE (LONG pPosition, LONG pLength) ,STRING,PROC ,VIRTUAL 
+ToLower                PROCEDURE () ,*CSTRING,PROC ,VIRTUAL 
+ToUpper                PROCEDURE () ,*CSTRING,PROC ,VIRTUAL 
+Trim                   PROCEDURE () ,*CSTRING,PROC ,VIRTUAL 
+Upper                  PROCEDURE () ,STRING ,VIRTUAL 
+IndexOf                PROCEDURE (STRING pLookIn, BYTE pCaseSensitive=TRUE) ,LONG ,VIRTUAL 
+FoundIn                PROCEDURE (STRING pLookIn, BYTE pCaseSensitive=TRUE) ,BYTE ,VIRTUAL 
+SetBuffer              PROCEDURE (LONG pNewBuffer)  ,VIRTUAL 
+EscapeXml              PROCEDURE (<STRING pStr>) ,STRING ,VIRTUAL 
+                     END 
+!_EndOfInclude_

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/ConsoleSupport.inc

@@ -0,0 +1,48 @@
+_ConsoleSupport_ EQUATE(1)
+
+HANDLE      EQUATE(UNSIGNED)
+DWORD       EQUATE(ULONG)
+INVALID_HANDLE_VALUE        EQUATE(-1)
+INVALID_OTHER        EQUATE(-2)
+NULL        EQUATE(0)
+
+ 
+!************************************************************************************************************
+! Console-specific EQUATEs
+!************************************************************************************************************
+ENABLE_PROCESSED_INPUT      EQUATE(1) ! Input Mode flags
+ENABLE_LINE_INPUT   EQUATE(2)
+ENABLE_ECHO_INPUT   EQUATE(4)
+ENABLE_WINDOW_INPUT EQUATE(8)
+ENABLE_MOUSE_INPUT  EQUATE(16)
+ 
+ENABLE_PROCESSED_OUTPUT     EQUATE(1) ! Output Mode flags
+ENABLE_WRAP_AT_EOL_OUTPUT   EQUATE(2)
+ 
+STD_INPUT_HANDLE    EQUATE(-10) ! Standard input and output handles
+STD_OUTPUT_HANDLE   EQUATE(-11)
+STD_ERROR_HANDLE    EQUATE(-12)
+ 
+CONSOLE_TEXTMODE_BUFFER     EQUATE(1) ! The type of console screen buffer to create
+ATTACH_PARENT_PROCESS       EQUATE(-1)
+ 
+
+ConsoleSupport        Class(),Type,Module('ConsoleSupport.Clw'),LINK('ConsoleSupport.Clw',1)
+! Properties
+InputHandle Handle
+OutputHandle        Handle
+TextBuffer  CString(2048)
+OutBuffer   CString(2048)
+InBuffer    CString(2048)
+BytesWritten        Long
+BytesRead   Long
+Prefix 		CSTRING(21)
+! Methods
+Construct              PROCEDURE   
+Destruct               PROCEDURE () ,VIRTUAL 
+Init				   PROCEDURE () ,BYTE,PROC,VIRTUAL 
+WriteLine			   PROCEDURE (STRING pText) ,BYTE,PROC,VIRTUAL 
+ReadKey  			   PROCEDURE () ,STRING,PROC,VIRTUAL 
+
+                     END 
+!_EndOfInclude_

samples/Clarion/Defaults.equ

@@ -1,29 +0,0 @@
-! Severity of error
-Level:Benign        EQUATE(0)
-Level:User          EQUATE(1)
-Level:Program       EQUATE(2)
-Level:Fatal         EQUATE(3)
-Level:Cancel        EQUATE(4)
-Level:Notify        EQUATE(5)
-
-ICON:VCRtop         EQUATE ('<0FFH,02H,81H,7FH>')
-ICON:VCRrewind      EQUATE ('<0FFH,02H,82H,7FH>')
-ICON:VCRback        EQUATE ('<0FFH,02H,83H,7FH>')
-ICON:VCRplay        EQUATE ('<0FFH,02H,84H,7FH>')
-ICON:VCRfastforward EQUATE ('<0FFH,02H,85H,7FH>')
-ICON:VCRbottom      EQUATE ('<0FFH,02H,86H,7FH>')
-ICON:VCRlocate      EQUATE ('<0FFH,02H,87H,7FH>')
-
-
-ff_:queue    QUEUE,PRE(ff_),TYPE
-name           string(13)
-date           long
-time           long
-size           long
-attrib         byte
-             END
-
-UINT64   GROUP,TYPE
-lo         ULONG
-hi         ULONG
-         END

samples/Clarion/School.txa

@@ -1,8 +0,0 @@
-[PROCEDURE]
-NAME SampleProc
-[COMMON]
-FROM ABC Source
-MODIFIED '2014/11/26' '14:48:17'
-[PROMPTS]
-%GenerateOpenClose LONG  (0)
-%GenerateSaveRestore LONG  (0)

samples/Clarion/Utility.tpw

@@ -1,16 +0,0 @@
-#UTILITY(ProcCallTree, 'Output procedure call tree')
- #CREATE(%Application & '.TRE')
-Procedure Call Tree: for %Application
-#INSERT(%DisplayTree, %FirstProcedure, '', '  ')
-#CLOSE
-#!***********************************************************
-#GROUP(%DisplayTree, %ThisProc, %Level, %NextIndent)
- #FIX(%Procedure, %ThisProc)
-%Level+-%ThisProc (%ProcedureTemplate)
- #FOR(%ProcedureCalled)
-   #IF(INSTANCE(%ProcedureCalled) = ITEMS(%ProcedureCalled))
-#INSERT(%DisplayTree, %ProcedureCalled, %Level & %NextIndent, '  ')
-   #ELSE
-#INSERT(%DisplayTree, %ProcedureCalled, %Level & %NextIndent, '| ')
-   #ENDIF
-#ENDFOR