From 02db72515f0066218ccb6584f5fcf4df9fb5fc9a Mon Sep 17 00:00:00 2001 From: Brahn Partridge Date: Thu, 27 Nov 2014 13:41:21 +0100 Subject: [PATCH] removed less common extensions and better examples --- lib/linguist/languages.yml | 3 - samples/Clarion/CStringClass.clw | 172 +++++++++++++++++++++++++++++ samples/Clarion/CStringClass.inc | 36 ++++++ samples/Clarion/ConsoleSupport.clw | 68 ++++++++++++ samples/Clarion/ConsoleSupport.inc | 48 ++++++++ samples/Clarion/Defaults.equ | 29 ----- samples/Clarion/School.txa | 8 -- samples/Clarion/Utility.tpw | 16 --- 8 files changed, 324 insertions(+), 56 deletions(-) create mode 100644 samples/Clarion/CStringClass.clw create mode 100644 samples/Clarion/CStringClass.inc create mode 100644 samples/Clarion/ConsoleSupport.clw create mode 100644 samples/Clarion/ConsoleSupport.inc delete mode 100644 samples/Clarion/Defaults.equ delete mode 100644 samples/Clarion/School.txa delete mode 100644 samples/Clarion/Utility.tpw diff --git a/lib/linguist/languages.yml b/lib/linguist/languages.yml index e7bce8f8..f3a74665 100644 --- a/lib/linguist/languages.yml +++ b/lib/linguist/languages.yml @@ -432,10 +432,7 @@ Clarion: color: #f29200 extensions: - .clw - - .equ - .inc - - .tpw - - .txa tm_scope: source.clarion Clean: 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/CStringClass.inc b/samples/Clarion/CStringClass.inc new file mode 100644 index 00000000..aec351f7 --- /dev/null +++ b/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 ,VIRTUAL + END +!_EndOfInclude_ 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/ConsoleSupport.inc b/samples/Clarion/ConsoleSupport.inc new file mode 100644 index 00000000..cd08c463 --- /dev/null +++ b/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_ diff --git a/samples/Clarion/Defaults.equ b/samples/Clarion/Defaults.equ deleted file mode 100644 index 4ec2992e..00000000 --- a/samples/Clarion/Defaults.equ +++ /dev/null @@ -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 \ No newline at end of file diff --git a/samples/Clarion/School.txa b/samples/Clarion/School.txa deleted file mode 100644 index 0aba0bcc..00000000 --- a/samples/Clarion/School.txa +++ /dev/null @@ -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) diff --git a/samples/Clarion/Utility.tpw b/samples/Clarion/Utility.tpw deleted file mode 100644 index d6d70df2..00000000 --- a/samples/Clarion/Utility.tpw +++ /dev/null @@ -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