mirror of
https://github.com/KevinMidboe/linguist.git
synced 2025-10-29 09:40:21 +00:00
removed less common extensions and better examples
This commit is contained in:
Brahn Partridge
@@ -432,10 +432,7 @@ Clarion:
|
||||
color: #f29200
|
||||
extensions:
|
||||
- .clw
|
||||
- .equ
|
||||
- .inc
|
||||
- .tpw
|
||||
- .txa
|
||||
tm_scope: source.clarion
|
||||
|
||||
Clean:
|
||||
|
||||
172
samples/Clarion/CStringClass.clw
Normal file
172
samples/Clarion/CStringClass.clw
Normal file
@@ -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('&', '&')
|
||||
CS.Replace('<', '<')
|
||||
CS.Replace('>', '>')
|
||||
CS.Replace('"', '"')
|
||||
CS.Replace('''', ''')
|
||||
|
||||
RETURN CS.Str()
|
||||
|
||||
36
samples/Clarion/CStringClass.inc
Normal file
36
samples/Clarion/CStringClass.inc
Normal file
@@ -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_
|
||||
68
samples/Clarion/ConsoleSupport.clw
Normal file
68
samples/Clarion/ConsoleSupport.clw
Normal file
@@ -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
|
||||
48
samples/Clarion/ConsoleSupport.inc
Normal file
48
samples/Clarion/ConsoleSupport.inc
Normal file
@@ -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_
|
||||
@@ -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
|
||||
@@ -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)
|
||||
@@ -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
|
||||
Reference in New Issue
Block a user