Convenient(?) Code Concatenator

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Convenient(?) Code Concatenator

Post by badidea »

When a program gets larger, it is often convenient to break it up in several files. Posting the code on the forum is less convenient is this case. Several options I can think of:
* Multiple code blocks (for each file)
* A zipped file link
* A code repository link
I made an alternative option, a code concatenation tool.
The original code below consisted of 4 files. "fbc -showincludes" output:

Code: Select all

code_concatenator.bas
 |  /usr/local/include/freebasic/file.bi
 |  inc/extStr.bi
 |  inc/fileFunc.bi
 |  inc/listType.bi
The included files are 'pasted' into the main file.
The concatenated code is this:

Code: Select all

'Convenient Code Concatenator / badidea / 2018-05-22

const as string sourceFile = "code_concatenator.bas" '<-- INPUT 
const as string concatFile = "concat1.bas" '<-- OUTPUT

#include "file.bi"

#define CC_TAB 9 '&h09
#define CC_LF 10 '&h0A
#define CC_CR 13 '&h0D

const as string QDM = chr(34) 'double quote mark character (")
const as integer INC_LEN = len("#include")


'============================ inc/extStr.bi (begin) ============================

type extStr_type
	dim as string text = ""
	dim as string lineBreak = ""
	dim as integer length = 0
	dim as integer position = 0
	declare sub fileToString(fileName as string)
	declare sub stringToFile(fileName as string)
	declare function getNextLine(byref row as string) as integer
	declare function getLineBreak() as string
	declare sub show()
end type

sub extStr_type.fileToString(fileName as string)
	dim as integer hFile = freefile
	if open(fileName for binary access read as hFile) = 0 then
		length = lof(hFile)
		text = space(length)
		get #hFile,,text
		close #hFile
	else
		print "fileToString: Unable to open '" & fileName & "'"
	end if
	lineBreak = getLineBreak()
end sub

sub extStr_type.stringToFile(fileName as string)
	dim as integer hfile = freefile
	if open(fileName for binary access write as hFile) = 0 then
		put #hFile,, text
		close #hFile
	else
		print "stringToFile: Unable to open '" & fileName & "'"
	end if
end sub

function extStr_type.getNextLine(byref row as string) as integer
	dim as integer last, i = position
	if i >= length then return -1 'end of file
	'find first/next LF character
	while i < length
		if (text[i] = CC_LF) then
			last = i
			exit while
		end if
		i += 1
	wend
	row = mid(text, position + 1, (last - position) + 1)
	position = last + 1 'update position for next call
	return 0
end function

function extStr_type.getLineBreak() as string
	dim as integer lfPos
	lfPos = instr(text, chr(CC_LF))
	if lfPos = 0 then return ""
	if lfPos = 1 then
		return chr(CC_LF)
	else
		if mid(text, lfPos - 1, 1) = chr(CC_CR) then
			return chr(CC_CR) & chr(CC_LF)
		else
			return chr(CC_LF)
		end if
	end if
end function

sub extStr_type.show()
	dim as integer i
	length = len(text)
	for i = 0 to length-1
		select case text[i]
		'case CC_TAB
		'	color 11 : print "..";
		case CC_LF
			color 14 : print "<LF>" 'no ;
		case CC_CR
			color 10 : print "<CR>";
		case else
			color 7 :  print chr(text[i]);
		end select
	next
	color 7
end sub

'============================== inc/extStr.bi (end) ============================


'============================ inc/fileFunc.bi (begin) ==========================

function getFilePath(fullFileName as string) as string
	dim as integer sepPos = instrrev(fullFileName, any "/\")
	return mid(fullFileName, 1, sepPos)
end function

function getFileName(fullFileName as string) as string
	dim as integer sepPos = instrrev(fullFileName, any "/\")
	return mid(fullFileName, sepPos + 1)
end function

function getFileExt(fullFileName as string) as string
	dim as integer sepPos = instrrev(fullFileName, any ".")
	return mid(fullFileName, sepPos + 1)
end function

function changeFileExt(fullFileName as string, newExt as string) as string
	dim as integer sepPos = instrrev(fullFileName, any ".")
	return mid(fullFileName, 1, sepPos) & newExt
end function

'============================ inc/fileFunc.bi (end) ============================


#define list_data_type string
#define LIST_DATA_MAX 100


'============================ inc/listType.bi (begin) ==========================

type list_type
	dim as list_data_type value(LIST_DATA_MAX-1)
	dim as integer occupied(LIST_DATA_MAX-1)
	declare function add(value as list_data_type) as integer
	declare function del(index as integer) as integer
	declare function find(value as list_data_type) as integer
	declare sub clr()
	declare sub show()
end type

function list_type.add(value as list_data_type) as integer
	dim as integer i
	for i = 0 to LIST_DATA_MAX-1
		if occupied(i) = 0 then
			occupied(i) = 1
			this.value(i) = value
			return i
		end if
	next
	return -1 'failed
end function

function list_type.del(index as integer) as integer
	if index < 0 then return -1 
	if index >= LIST_DATA_MAX then return -1 
	if occupied(index) = 0 then
		return -1
	else
		occupied(index) = 0
		return 0 'ok
	end if
end function

function list_type.find(value as list_data_type) as integer
	dim as integer i
	for i = 0 to LIST_DATA_MAX-1
		if occupied(i) = 1 and value = this.value(i) then
			return i
		end if
	next
	return -1 'failed / not found
end function

sub list_type.clr()
	dim as integer i
	for i = 0 to LIST_DATA_MAX-1
		occupied(i) = 0
	next
end sub

sub list_type.show()
	dim as integer i
	for i = 0 to LIST_DATA_MAX-1
		print i, occupied(i), this.value(i)
	next
end sub

'============================ inc/listType.bi (end) ============================


dim shared as list_type fileList 'quick and dirty

'===============================================================================

function checkInclude(row as string) as string
	dim as string trm, incFile = ""
	dim as integer dqpos1, dqpos2
	'trim white space characters
	trm = trim(row, any " " + chr(CC_TAB))
	'check if trimmed line starts with #include
	if mid(trm, 1, INC_LEN) = "#include" then
		'get first double quotion mark position
		dqpos1 = instr(trm, QDM)
		'get second double quotion mark relative position
		dqpos2 = instr(mid(trm, dqpos1 + 1), QDM)
		'file should be between then double quotion mark
		incFile = mid(trm, dqpos1 + 1, dqpos2 - 1)
		'trim any white space again
		incFile = trim(incFile, any " " + chr(CC_TAB))
	end if
	return incFile
end function

function commentLine(byval comment as string) as string
	dim as string commentText
	dim as integer commentPos, commentLen
	commentText = "'"
	if comment = "" then
		commentText &= string(79, "=")
	else
		comment = " " & comment & " "
		commentLen = len(comment)
		commentPos = (80 - commentLen) / 2
		commentText &= string(commentPos, "=")
		commentText &= comment
		commentText &= string(80 - len(commentText), "=")
	end if
	return commentText
end function

'recusive function
sub convert(srcFile as string, byref concatText as string)
	dim as extStr_type code
	dim as string incFile, row, path
	if fileList.find(srcFile) = -1 then
		fileList.add(srcFile)
		path = getFilePath(srcFile)
		print "Load: " & srcFile
		'load source file
		code.fileToString(srcFile)
		'Loop lines in file contents
		while code.getNextLine(row) <> -1
			incFile = checkInclude(row)
			'if include file in code and file existing at path 
			if incFile <> "" and fileExists(path & incFile) then
				concatText &= code.lineBreak
				concatText &= (commentLine(incFile & " (begin)") & code.lineBreak)
				concatText &= code.lineBreak
				convert(path & incFile, concatText) '<--
				concatText &= code.lineBreak
				concatText &= (commentLine(incFile & " (end)") & code.lineBreak)
				concatText &= code.lineBreak
			else
				'add code to list
				concatText &= row
			end if
		wend
	end if
end sub

'===============================================================================

dim as extStr_type concatCode

convert(sourceFile, concatCode.text) 'recursive function

concatCode.show()
concatCode.stringToFile(concatFile)
Not yet tested with Windows. And it might not be useful with compiled libraries. And it may only work with my way of organizing code in files.
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Convenient(?) Code Concatenator

Post by badidea »

Some changes and FBeauty included.
The self-concatenated & self-beautified code:

Code: Select all

'Convenient Code Concatenator / badidea / 2018-09-15

'INPUT FILE
Const As String sourceFile = "code_concatenator.bas"

#Include "file.bi"
Function getFilePath(fullFileName As String) As String
	Dim As Integer sepPos = InStrRev(fullFileName, Any "/\")
	Return Mid(fullFileName, 1, sepPos)
End Function

Function getFileName(fullFileName As String) As String
	Dim As Integer sepPos = InStrRev(fullFileName, Any "/\")
	Return Mid(fullFileName, sepPos + 1)
End Function

Function getFileExt(fullFileName As String) As String
	Dim As Integer sepPos = InStrRev(fullFileName, Any ".")
	Return Mid(fullFileName, sepPos + 1)
End Function

Function changeFileExt(fullFileName As String, newExt As String) As String
	Dim As Integer sepPos = InStrRev(fullFileName, Any ".")
	Return Mid(fullFileName, 1, sepPos) & newExt
End Function

'===============================================================================

#Define CC_TAB 9 '&h09
#Define CC_LF 10 '&h0A
#Define CC_CR 13 '&h0D

Const As String QDM = Chr(34) 'double quote mark character (")
Const As Integer INC_LEN = Len("#include")

Type extStr_type
	Private:
		Dim As String text = ""
		Dim As String lastText
	Public:
		Dim As String lineBreak = ""
		Dim As Integer length = 0
		Dim As Integer position = 0
		Declare Sub fileToString(fileName As String)
		Declare Sub stringToFile(fileName As String)
		Declare Function getNextLine(ByRef row As String) As Integer
		Declare Function getLineBreak() As String
		Declare Sub show()
		Declare Function getText() As String
		Declare Sub Append(newText As String)
End Type

Sub extStr_type.fileToString(fileName As String)
	Dim As Integer hFile = FreeFile
	If Open(fileName For Binary Access Read As hFile) = 0 Then
		length = Lof(hFile)
		text = Space(length)
		Get #hFile,,text
		Close #hFile
	Else
		Print "fileToString: Unable to open '" & fileName & "'"
	End If
	position = 0
	lineBreak = getLineBreak()
End Sub

Sub extStr_type.stringToFile(fileName As String)
	Dim As Integer hfile = FreeFile
	If Open(fileName For Binary Access Write As hFile) = 0 Then
		Put #hFile,, text
		Close #hFile
	Else
		Print "stringToFile: Unable to open '" & fileName & "'"
	End If
End Sub

Function extStr_type.getNextLine(ByRef row As String) As Integer
	Dim As Integer last, i = position
	If i >= length Then Return -1 'end of file
	'find first/next LF character
	While i < length
		If (text[i] = CC_LF) Then
			last = i
			Exit While
		End If
		i += 1
	Wend
	row = Mid(text, position + 1, (last - position) + 1)
	position = last + 1 'update position for next call
	Return 0
End Function

Function extStr_type.getLineBreak() As String
	Dim As Integer lfPos
	lfPos = InStr(text, Chr(CC_LF))
	If lfPos = 0 Then Return ""
	If lfPos = 1 Then
		Return Chr(CC_LF)
	Else
		If Mid(text, lfPos - 1, 1) = Chr(CC_CR) Then
			Return Chr(CC_CR) & Chr(CC_LF)
		Else
			Return Chr(CC_LF)
		End If
	End If
End Function

Sub extStr_type.show()
	Dim As Integer i
	length = Len(text)
	For i = 0 To length-1
		Select Case text[i]
		'case CC_TAB
		'	color 11 : print "..";
		Case CC_LF
			Color 14 : Print "<LF>" 'no ;
		Case CC_CR
			Color 10 : Print "<CR>";
		Case Else
			Color 7 :  Print Chr(text[i]);
		End Select
	Next
	Color 7
End Sub

Function extStr_type.getText() As String
	Return text
End Function

Sub extStr_type.append(newText As String)
	If newText = lineBreak And lastText = lineBreak Then
		'skip
	Else
		lastText = newText
		text & = newText
	End If
End Sub

'===============================================================================

#Define list_data_type String
#Define LIST_DATA_MAX 100

Type list_type
	'dim as integer numItems = 0
	Dim As list_data_type value(LIST_DATA_MAX-1)
	Dim As Integer occupied(LIST_DATA_MAX-1)
	Declare Function Add(value As list_data_type) As Integer
	Declare Function del(index As Integer) As Integer
	Declare Function find(value As list_data_type) As Integer
	Declare Sub clr()
	Declare Sub show(showEmpty As Integer)
End Type

Function list_type.add(value As list_data_type) As Integer
	Dim As Integer i
	For i = 0 To LIST_DATA_MAX-1
		If occupied(i) = 0 Then
			occupied(i) = 1
			This.value(i) = value
			'numItems += 1
			Return i
		End If
	Next
	Return -1 'failed
End Function

Function list_type.del(index As Integer) As Integer
	If index < 0 Then Return -1 
	If index >= LIST_DATA_MAX Then Return -1 
	If occupied(index) = 0 Then
		Return -1 'was not occupied
	Else
		occupied(index) = 0
		'numItems -= 1
		Return 0 'ok
	End If
End Function

Function list_type.find(value As list_data_type) As Integer
	Dim As Integer i
	For i = 0 To LIST_DATA_MAX-1
		If occupied(i) = 1 And value = This.value(i) Then
			Return i
		End If
	Next
	Return -1 'failed / not found
End Function

Sub list_type.clr()
	Dim As Integer i
	For i = 0 To LIST_DATA_MAX-1
		occupied(i) = 0
	Next
	'numItems = 0
End Sub

Sub list_type.show(showEmpty As Integer)
	Dim As Integer i
	For i = 0 To LIST_DATA_MAX-1
		If showEmpty = 1 Or occupied(i) = 1 Then
			Print i, This.value(i)
		End If
	Next
End Sub

'===============================================================================

' This is file FBeauty.bas, version 1.04
' Licence: GPLv3
' (C) 2010-2018 Thomas[ dOt }Freiherr{ at }gmx{ DoT ]net
'
' This program is free software; you can redistribute it
' and/or modify it under the terms of the GNU General Public
' License as published by the Free Software Foundation; either
' version 3 of the License, or (at your option) ANY later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
' Lesser General Public License for more details, refer to:
' http://www.gnu.org/licenses/gpl-3.0.html

'#DEFINE DIALECTS ' support for  keywords related to FB dialects
#Define THISFIX  ' support for THIS./@THIS->

Type FBeauty_type
  Private:
    Dim As Integer Modus
    Dim As UByte Char, Check(255)
    Dim As String Wort
  Public:
    Declare Constructor()
    Declare Sub setModus(command_ As String)
    Declare Sub setChecks()
    Declare Function Cases(ByRef W As String, ByVal I As ZString Ptr) As String
    Declare Function Change(ByRef T As String) As String
    Declare Sub readTo(ByRef T As String)
    Declare Function readEsc() As String
    Declare Sub convert(command_ As String, inFileName As String, outFileName As String)
End Type

Constructor FBeauty_type()
  setChecks()
End Constructor

Sub FBeauty_type.setModus(command_ As String)
  ' evaluate command line   / Kommandozeile auswerten
  Modus = IIf(InStr(command_, "-l"), 1, _ '    lower case keywords
          IIf(InStr(command_, "-c"), 2, _ '    capitalized keywords
          IIf(InStr(command_, "-i"), 3, 0))) ' individual keywords
  ' no options = upper case / keine Option = Grossbuchstaben
End Sub

Sub FBeauty_type.setChecks()
  ' define character types (1 = keyword characters)
  Check(Asc("_")) = 1
  Check(Asc("-")) = 1
  Check(Asc(">")) = 1
  Check(Asc(".")) = 1
  Check(Asc("$")) = 1
  Check(Asc("#")) = 1
  Check(Asc("2")) = 1
  Check(Asc("3")) = 1
  Check(Asc("4")) = 1
  Check(Asc("6")) = 1
  For i As Integer = Asc("A") To Asc("Z")
    Check(i) = 1
    Check(i + 32) = 1
  Next
  Check(Asc( "!")) = 2 ' escaped STRING
  Check(Asc("""")) = 3 ' standard STRING
  Check(Asc( "'")) = 4 ' comment
  Check(Asc( "/")) = 5 ' may be start of multi line comment
  Check(0) = 255
End Sub

' convert keyword depending on modus [badidea]
Function FBeauty_type.Cases(ByRef W As String, ByVal I As ZString Ptr) As String
  Select Case As Const Modus
  Case 0 : Return W 'leave as Ucase [badidea] 
  Case 1 : Return LCase(W)
  Case 2
    If W[0] < Asc("A") Then Return Left(W, 2) & LCase(Mid(W, 3)) '__Keyword [badidea]
    Return Left(W, 1) & LCase(Mid(W, 2))
  End Select
  Return (*I)
End Function

Function FBeauty_type.Change(ByRef T As String) As String
  Var w = UCase(T)
  Select Case As Const w[0]
    Case Asc("_")
      Select Case w
        Case               "__DATE__" : Return Cases(w, @"__Date__")
        Case           "__DATE_ISO__" : Return Cases(w, @"__Date_Iso__")
        Case           "__FB_64BIT__" : Return Cases(w, @"__Fb_64Bit__")
        Case            "__FB_ARGC__" : Return Cases(w, @"__Fb_ArgC__")
        Case            "__FB_ARGV__" : Return Cases(w, @"__Fb_ArgV__")
        Case         "__FB_BACKEND__" : Return Cases(w, @"__Fb_Backend__")
        Case       "__FB_BIGENDIAN__" : Return Cases(w, @"__Fb_BigEndian__")
        Case      "__FB_BUILD_DATE__" : Return Cases(w, @"__Fb_Build_Date__")
        Case          "__FB_CYGWIN__" : Return Cases(w, @"__Fb_CygWin__")
        Case          "__FB_DARWIN__" : Return Cases(w, @"__Fb_DarWin__")
        Case           "__FB_DEBUG__" : Return Cases(w, @"__Fb_Debug__")
        Case             "__FB_DOS__" : Return Cases(w, @"__Fb_Dos__")
        Case             "__FB_ERR__" : Return Cases(w, @"__Fb_Err__")
        Case          "__FB_FPMODE__" : Return Cases(w, @"__Fb_FpMode__")
        Case             "__FB_FPU__" : Return Cases(w, @"__Fb_Fpu__")
        Case         "__FB_FREEBSD__" : Return Cases(w, @"__Fb_FreeBsd__")
        Case            "__FB_LANG__" : Return Cases(w, @"__Fb_Lang__")
        Case           "__FB_LINUX__" : Return Cases(w, @"__Fb_Linux__")
        Case            "__FB_MAIN__" : Return Cases(w, @"__Fb_Main__")
        Case     "__FB_MIN_VERSION__" : Return Cases(w, @"__Fb_Min_Version__")
        Case              "__FB_MT__" : Return Cases(w, @"__Fb_Mt__")
        Case          "__FB_NETBSD__" : Return Cases(w, @"__Fb_NetBsd__")
        Case         "__FB_OPENBSD__" : Return Cases(w, @"__Fb_OpenBsd__")
        Case    "__FB_OPTION_BYVAL__" : Return Cases(w, @"__Fb_Option_ByVal__")
        Case  "__FB_OPTION_DYNAMIC__" : Return Cases(w, @"__Fb_Option_Dynamic__")
        Case   "__FB_OPTION_ESCAPE__" : Return Cases(w, @"__Fb_Option_Escape__")
        Case "__FB_OPTION_EXPLICIT__" : Return Cases(w, @"__Fb_Option_Explicit__")
        Case    "__FB_OPTION_GOSUB__" : Return Cases(w, @"__Fb_Option_Gosub__")
        Case  "__FB_OPTION_PRIVATE__" : Return Cases(w, @"__Fb_Option_Private__")
        Case         "__FB_OUT_DLL__" : Return Cases(w, @"__Fb_Out_Dll__")
        Case         "__FB_OUT_EXE__" : Return Cases(w, @"__Fb_Out_Exe__")
        Case         "__FB_OUT_LIB__" : Return Cases(w, @"__Fb_Out_Lib__")
        Case         "__FB_OUT_OBJ__" : Return Cases(w, @"__Fb_Out_Obj__")
        Case            "__FB_PCOS__" : Return Cases(w, @"__Fb_Pcos__")
        Case       "__FB_SIGNATURE__" : Return Cases(w, @"__Fb_Signature__")
        Case             "__FB_SSE__" : Return Cases(w, @"__Fb_Sse__")
        Case            "__FB_UNIX__" : Return Cases(w, @"__Fb_Unix__")
        Case       "__FB_VECTORIZE__" : Return Cases(w, @"__Fb_Vectorize__")
        Case       "__FB_VER_MAJOR__" : Return Cases(w, @"__Fb_Ver_Major__")
        Case       "__FB_VER_MINOR__" : Return Cases(w, @"__Fb_Ver_Minor__")
        Case       "__FB_VER_PATCH__" : Return Cases(w, @"__Fb_Ver_Patch__")
        Case         "__FB_VERSION__" : Return Cases(w, @"__Fb_Version__")
        Case           "__FB_WIN32__" : Return Cases(w, @"__Fb_Win32__")
        Case            "__FB_XBOX__" : Return Cases(w, @"__Fb_XBox__")
        Case               "__FILE__" : Return Cases(w, @"__File__")
        Case            "__FILE_NQ__" : Return Cases(w, @"__File_NQ__")
        Case           "__FUNCTION__" : Return Cases(w, @"__Function__")
        Case        "__FUNCTION_NQ__" : Return Cases(w, @"__Function_NQ__")
        Case               "__LINE__" : Return Cases(w, @"__Line__")
        Case               "__PATH__" : Return Cases(w, @"__Path__")
        Case               "__TIME__" : Return Cases(w, @"__Time__")
      End Select
    Case Asc("#")
      Select Case w
        Case   "#ASSERT" : Return Cases(w, @"#Assert")
        Case      "#DEF" : Return Cases(w, @"#Def")
        Case   "#DEFINE" : Return Cases(w, @"#Define")
        Case     "#ELSE" : Return Cases(w, @"#Else")
        Case   "#ELSEIF" : Return Cases(w, @"#ElseIf")
        Case    "#ENDIF" : Return Cases(w, @"#EndIf")
        Case "#ENDMACRO" : Return Cases(w, @"#EndMacro")
        Case    "#ERROR" : Return Cases(w, @"#Error")
        Case       "#IF" : Return Cases(w, @"#If")
        Case    "#IFDEF" : Return Cases(w, @"#IfDef")
        Case   "#IFNDEF" : Return Cases(w, @"#IfNDef")
        Case  "#INCLUDE" : Return Cases(w, @"#Include")
        Case   "#INCLIB" : Return Cases(w, @"#IncLib")
        Case     "#LANG" : Return Cases(w, @"#Lang")
        Case  "#LIBPATH" : Return Cases(w, @"#LibPath")
        Case     "#LINE" : Return Cases(w, @"#Line")
        Case    "#MACRO" : Return Cases(w, @"#Macro")
        Case   "#PRAGMA" : Return Cases(w, @"#Pragma")
        Case    "#PRINT" : Return Cases(w, @"#Print")
        Case    "#UNDEF" : Return Cases(w, @"#UnDef")
      End Select
#IfDef DIALECTS
    Case Asc("$")
      Select Case w
        Case "$INCLUDE" : Return Cases(w, @"$Include")
        Case "$DYNAMIC" : Return Cases(w, @"$Dynamic")
        Case    "$LANG" : Return Cases(w, @"$Lang")
        Case  "$STATIC" : Return Cases(w, @"$Static")
      End Select
#EndIf
    Case Asc("A")
      Select Case w
        Case        "ABS" : Return Cases(w, @"Abs")
        Case   "ABSTRACT" : Return Cases(w, @"Abstract")
        Case     "ACCESS" : Return Cases(w, @"Access")
        Case       "ACOS" : Return Cases(w, @"ACos")
        Case        "ADD" : Return Cases(w, @"Add")
        Case      "ALIAS" : Return Cases(w, @"Alias")
        Case   "ALLOCATE" : Return Cases(w, @"Allocate")
        Case      "ALPHA" : Return Cases(w, @"Alpha")
        Case        "AND" : Return Cases(w, @"And")
        Case    "ANDALSO" : Return Cases(w, @"AndAlso")
        Case        "ANY" : Return Cases(w, @"Any")
        Case     "APPEND" : Return Cases(w, @"Append")
        Case         "AS" : Return Cases(w, @"As")
        Case        "ASC" : Return Cases(w, @"Asc")
        Case       "ASIN" : Return Cases(w, @"ASin")
        Case        "ASM" : Return Cases(w, @"Asm")
        Case     "ASSERT" : Return Cases(w, @"Assert")
        Case "ASSERTWARN" : Return Cases(w, @"AssertWarn")
        Case      "ATAN2" : Return Cases(w, @"ATan2")
        Case        "ATN" : Return Cases(w, @"Atn")
      End Select
    Case Asc("B")
      Select Case w
        Case     "BEEP" : Return Cases(w, @"Beep")
        Case      "BIN" : Return Cases(w, @"Bin")
        Case   "BINARY" : Return Cases(w, @"Binary")
        Case      "BIT" : Return Cases(w, @"Bit")
        Case "BITRESET" : Return Cases(w, @"BitReSet")
        Case   "BITSET" : Return Cases(w, @"BitSet")
        Case    "BLOAD" : Return Cases(w, @"BLoad")
        Case    "BSAVE" : Return Cases(w, @"BSave")
        Case     "BYTE" : Return Cases(w, @"Byte")
        Case    "BYREF" : Return Cases(w, @"ByRef")
        Case    "BYVAL" : Return Cases(w, @"ByVal")
        Case     "BASE" : Return Cases(w, @"Base")
      End Select
    Case Asc("C")
      Select Case w
        Case          "CALL" : Return Cases(w, @"Call")
        Case     "CALLOCATE" : Return Cases(w, @"CAllocate")
        Case         "CALLS" : Return Cases(w, @"Calls")
        Case          "CASE" : Return Cases(w, @"Case")
        Case          "CAST" : Return Cases(w, @"Cast")
        Case         "CBYTE" : Return Cases(w, @"CByte")
        Case          "CDBL" : Return Cases(w, @"CDbl")
        Case         "CDECL" : Return Cases(w, @"CDecl")
        Case         "CHAIN" : Return Cases(w, @"Chain")
        Case         "CHDIR" : Return Cases(w, @"ChDir")
        Case           "CHR" : Return Cases(w, @"Chr")
        Case          "CINT" : Return Cases(w, @"CInt")
        Case        "CIRCLE" : Return Cases(w, @"Circle")
        Case         "CLASS" : Return Cases(w, @"Class")
        Case         "CLEAR" : Return Cases(w, @"Clear")
        Case          "CLNG" : Return Cases(w, @"CLng")
        Case       "CLNGINT" : Return Cases(w, @"CLngInt")
        Case         "CLOSE" : Return Cases(w, @"Close")
        Case           "CLS" : Return Cases(w, @"Cls")
        Case         "COLOR" : Return Cases(w, @"Color")
        Case           "COM" : Return Cases(w, @"Com")
        Case       "COMMAND" : Return Cases(w, @"Command")
        Case        "COMMON" : Return Cases(w, @"Common")
        Case "CONDBROADCAST" : Return Cases(w, @"CondBroadCast")
        Case    "CONDCREATE" : Return Cases(w, @"CondCreate")
        Case   "CONDDESTROY" : Return Cases(w, @"CondDestroy")
        Case    "CONDSIGNAL" : Return Cases(w, @"CondSignal")
        Case      "CONDWAIT" : Return Cases(w, @"CondWait")
        Case          "CONS" : Return Cases(w, @"Cons")
        Case         "CONST" : Return Cases(w, @"Const")
        Case   "CONSTRUCTOR" : Return Cases(w, @"Constructor")
        Case      "CONTINUE" : Return Cases(w, @"Continue")
        Case           "COS" : Return Cases(w, @"Cos")
        Case          "CPTR" : Return Cases(w, @"CPtr")
        Case        "CSHORT" : Return Cases(w, @"CShort")
        Case         "CSIGN" : Return Cases(w, @"CSign")
        Case          "CSNG" : Return Cases(w, @"CSng")
        Case        "CSRLIN" : Return Cases(w, @"CsrLin")
        Case        "CUBYTE" : Return Cases(w, @"CUByte")
        Case         "CUINT" : Return Cases(w, @"CUInt")
        Case         "CULNG" : Return Cases(w, @"CULng")
        Case      "CULNGINT" : Return Cases(w, @"CULngInt")
        Case         "CUNSG" : Return Cases(w, @"CUnSg")
        Case        "CURDIR" : Return Cases(w, @"CurDir")
        Case       "CUSHORT" : Return Cases(w, @"CUShort")
        Case        "CUSTOM" : Return Cases(w, @"Custom")
        Case           "CVD" : Return Cases(w, @"CvD")
        Case           "CVI" : Return Cases(w, @"CvI")
        Case           "CVL" : Return Cases(w, @"CvL")
        Case     "CVLONGINT" : Return Cases(w, @"CvLongInt")
        Case           "CVS" : Return Cases(w, @"CvS")
        Case       "CVSHORT" : Return Cases(w, @"CvShort")
      End Select
    Case Asc("D")
      Select Case w
        Case        "DATA" : Return Cases(w, @"Data")
        Case        "DATE" : Return Cases(w, @"Date")
        Case     "DATEADD" : Return Cases(w, @"DateAdd")
        Case    "DATEDIFF" : Return Cases(w, @"DateDiff")
        Case    "DATEPART" : Return Cases(w, @"DatePart")
        Case  "DATESERIAL" : Return Cases(w, @"DateSerial")
        Case   "DATEVALUE" : Return Cases(w, @"DateValue")
        Case         "DAY" : Return Cases(w, @"Day")
        Case  "DEALLOCATE" : Return Cases(w, @"DeAllocate")
        Case     "DECLARE" : Return Cases(w, @"Declare")
        Case     "DEFBYTE" : Return Cases(w, @"DefByte")
        Case      "DEFDBL" : Return Cases(w, @"DefDbl")
        Case      "DEFINE" : Return Cases(w, @"Define")
        Case     "DEFINED" : Return Cases(w, @"Defined")
        Case      "DEFINT" : Return Cases(w, @"DefInt")
        Case      "DEFLNG" : Return Cases(w, @"DefLng")
        Case  "DEFLONGINT" : Return Cases(w, @"DefLongInt")
        Case    "DEFSHORT" : Return Cases(w, @"DefShort")
        Case      "DEFSNG" : Return Cases(w, @"DefSng")
        Case      "DEFSTR" : Return Cases(w, @"DefStr")
        Case    "DEFUBYTE" : Return Cases(w, @"DefUByte")
        Case     "DEFUINT" : Return Cases(w, @"DefUInt")
        Case "DEFULONGINT" : Return Cases(w, @"DefULongInt")
        Case   "DEFUSHORT" : Return Cases(w, @"DefUShort")
        Case      "DELETE" : Return Cases(w, @"Delete")
        Case  "DESTRUCTOR" : Return Cases(w, @"Destructor")
        Case         "DIM" : Return Cases(w, @"Dim")
        Case         "DIR" : Return Cases(w, @"Dir")
        Case          "DO" : Return Cases(w, @"Do")
        Case      "DOUBLE" : Return Cases(w, @"Double")
        Case        "DRAW" : Return Cases(w, @"Draw")
        Case   "DYLIBFREE" : Return Cases(w, @"DyLibFree")
        Case   "DYLIBLOAD" : Return Cases(w, @"DyLibLoad")
        Case "DYLIBSYMBOL" : Return Cases(w, @"DyLibSymbol")
#IfDef DIALECTS
        Case "DYNAMIC" : Return Cases(w, @"Dynamic")
#EndIf
      End Select
    Case Asc("E")
      Select Case w
        Case     "ELSE" : Return Cases(w, @"Else")
        Case   "ELSEIF" : Return Cases(w, @"ElseIf")
        Case "ENCODING" : Return Cases(w, @"Encoding")
        Case      "END" : Return Cases(w, @"End")
        Case    "ENDIF" : Return Cases(w, @"EndIf")
        Case "ENDMACRO" : Return Cases(w, @"EndMacro")
        Case     "ENUM" : Return Cases(w, @"Enum")
        Case  "ENVIRON" : Return Cases(w, @"Environ")
        Case      "EOF" : Return Cases(w, @"Eof")
        Case      "EQV" : Return Cases(w, @"Eqv")
        Case    "ERASE" : Return Cases(w, @"Erase")
        Case     "ERFN" : Return Cases(w, @"ErFn")
        Case      "ERL" : Return Cases(w, @"ErL")
        Case     "ERMN" : Return Cases(w, @"ErMn")
        Case      "ERR" : Return Cases(w, @"Err")
        Case    "ERROR" : Return Cases(w, @"Error")
        Case   "ESCAPE" : Return Cases(w, @"Escape")
        Case     "EXEC" : Return Cases(w, @"Exec")
        Case  "EXEPATH" : Return Cases(w, @"ExePath")
        Case "EXPLICIT" : Return Cases(w, @"Explicit")
        Case     "EXIT" : Return Cases(w, @"Exit")
        Case      "EXP" : Return Cases(w, @"Exp")
        Case   "EXPORT" : Return Cases(w, @"Export")
        Case  "EXTENDS" : Return Cases(w, @"Extends")
        Case   "EXTERN" : Return Cases(w, @"Extern")
#IfDef DIALECTS
        Case   "ESCAPE" : Return Cases(w, @"Escape")
        Case "EXPLICIT" : Return Cases(w, @"Explicit")
#EndIf
      End Select
    Case Asc("F")
      Select Case w
        Case        "FIELD" : Return Cases(w, @"Field")
        Case     "FILEATTR" : Return Cases(w, @"FileAttr")
        Case     "FILECOPY" : Return Cases(w, @"FileCopy")
        Case "FILEDATETIME" : Return Cases(w, @"FileDateTime")
        Case   "FILEEXISTS" : Return Cases(w, @"FileExists")
        Case      "FILELEN" : Return Cases(w, @"FileLen")
        Case          "FIX" : Return Cases(w, @"Fix")
        Case         "FLIP" : Return Cases(w, @"Flip")
        Case          "FOR" : Return Cases(w, @"For")
        Case       "FORMAT" : Return Cases(w, @"Format")
        Case         "FRAC" : Return Cases(w, @"Frac")
        Case          "FRE" : Return Cases(w, @"Fre")
        Case     "FREEFILE" : Return Cases(w, @"FreeFile")
        Case     "FUNCTION" : Return Cases(w, @"Function")
      End Select
    Case Asc("G")
      Select Case w
        Case         "GET" : Return Cases(w, @"Get")
        Case "GETJOYSTICK" : Return Cases(w, @"GetJoyStick")
        Case      "GETKEY" : Return Cases(w, @"GetKey")
        Case    "GETMOUSE" : Return Cases(w, @"GetMouse")
        Case       "GOSUB" : Return Cases(w, @"GoSub")
        Case        "GOTO" : Return Cases(w, @"GoTo")
      End Select
    Case Asc("H")
      Select Case w
        Case    "HEX" : Return Cases(w, @"Hex")
        Case "HIBYTE" : Return Cases(w, @"HiByte")
        Case "HIWORD" : Return Cases(w, @"HiWord")
        Case   "HOUR" : Return Cases(w, @"Hour")
      End Select
    Case Asc("I")
      Select Case w
        Case              "IF" : Return Cases(w, @"If")
        Case             "IIF" : Return Cases(w, @"IIf")
        Case "IMAGECONVERTROW" : Return Cases(w, @"ImageConvertRow")
        Case     "IMAGECREATE" : Return Cases(w, @"ImageCreate")
        Case    "IMAGEDESTROY" : Return Cases(w, @"ImageDestroy")
        Case       "IMAGEINFO" : Return Cases(w, @"ImageInfo")
        Case             "IMP" : Return Cases(w, @"Imp")
        Case      "IMPLEMENTS" : Return Cases(w, @"Implements")
        Case          "IMPORT" : Return Cases(w, @"Import")
        Case          "INCLIB" : Return Cases(w, @"IncLib")
        Case         "INCLUDE" : Return Cases(w, @"Include")
        Case           "INKEY" : Return Cases(w, @"InKey")
        Case             "INP" : Return Cases(w, @"Inp")
        Case           "INPUT" : Return Cases(w, @"Input")
        Case           "INSTR" : Return Cases(w, @"InStr")
        Case        "INSTRREV" : Return Cases(w, @"InStrRev")
        Case             "INT" : Return Cases(w, @"Int")
        Case         "INTEGER" : Return Cases(w, @"Integer")
        Case              "IS" : Return Cases(w, @"Is")
        Case          "ISDATE" : Return Cases(w, @"IsDate")
        Case    "ISREDIRECTED" : Return Cases(w, @"IsRedirected")
      End Select
    Case Asc("K")
      Select Case w
        Case "KILL" : Return Cases(w, @"Kill")
      End Select
    Case Asc("L")
      Select Case w
        Case  "LBOUND" : Return Cases(w, @"LBound")
        Case   "LCASE" : Return Cases(w, @"LCase")
        Case    "LEFT" : Return Cases(w, @"Left")
        Case     "LEN" : Return Cases(w, @"Len")
        Case     "LET" : Return Cases(w, @"Let")
        Case     "LIB" : Return Cases(w, @"Lib")
        Case "LIBPATH" : Return Cases(w, @"LibPath")
        Case    "LINE" : Return Cases(w, @"Line")
        Case  "LOBYTE" : Return Cases(w, @"LoByte")
        Case     "LOC" : Return Cases(w, @"Loc")
        Case   "LOCAL" : Return Cases(w, @"Local")
        Case  "LOCATE" : Return Cases(w, @"Locate")
        Case    "LOCK" : Return Cases(w, @"Lock")
        Case     "LOF" : Return Cases(w, @"Lof")
        Case     "LOG" : Return Cases(w, @"Log")
        Case    "LONG" : Return Cases(w, @"Long")
        Case "LONGINT" : Return Cases(w, @"LongInt")
        Case    "LOOP" : Return Cases(w, @"Loop")
        Case  "LOWORD" : Return Cases(w, @"LoWord")
        Case    "LPOS" : Return Cases(w, @"LPos")
        Case  "LPRINT" : Return Cases(w, @"LPrint")
        Case     "LPT" : Return Cases(w, @"Lpt")
        Case    "LSET" : Return Cases(w, @"LSet")
        Case   "LTRIM" : Return Cases(w, @"LTrim")
      End Select
    Case Asc("M")
      Select Case w
        Case          "MID" : Return Cases(w, @"Mid")
        Case       "MINUTE" : Return Cases(w, @"Minute")
        Case          "MKD" : Return Cases(w, @"MkD")
        Case        "MKDIR" : Return Cases(w, @"MkDir")
        Case          "MKI" : Return Cases(w, @"MkI")
        Case          "MKL" : Return Cases(w, @"MkL")
        Case    "MKLONGINT" : Return Cases(w, @"MkLongInt")
        Case          "MKS" : Return Cases(w, @"MkS")
        Case      "MKSHORT" : Return Cases(w, @"MkShort")
        Case          "MOD" : Return Cases(w, @"Mod")
        Case        "MONTH" : Return Cases(w, @"Month")
        Case    "MONTHNAME" : Return Cases(w, @"MonthName")
        Case     "MULTIKEY" : Return Cases(w, @"MultiKey")
        Case  "MUTEXCREATE" : Return Cases(w, @"MutexCreate")
        Case "MUTEXDESTROY" : Return Cases(w, @"MutexDestroy")
        Case    "MUTEXLOCK" : Return Cases(w, @"MutexLock")
        Case  "MUTEXUNLOCK" : Return Cases(w, @"MutexUnLock")
      End Select
    Case Asc("N")
      Select Case w
        Case     "NAKED" : Return Cases(w, @"Naked")
        Case      "NAME" : Return Cases(w, @"Name")
        Case "NAMESPACE" : Return Cases(w, @"NameSpace")
        Case       "NEW" : Return Cases(w, @"New")
        Case      "NEXT" : Return Cases(w, @"Next")
        Case       "NOT" : Return Cases(w, @"Not")
        Case       "NOW" : Return Cases(w, @"Now")
#IfDef DIALECTS
        Case   "NOGOSUB" : Return Cases(w, @"NoGoSub")
        Case "NOKEYWORD" : Return Cases(w, @"NoKeyWord")
#EndIf
      End Select
    Case Asc("O")
      Select Case w
        Case   "OBJECT" : Return Cases(w, @"Object")
        Case      "OCT" : Return Cases(w, @"Oct")
        Case "OFFSETOF" : Return Cases(w, @"OffsetOf")
        Case       "ON" : Return Cases(w, @"On")
        Case     "ONCE" : Return Cases(w, @"Once")
        Case     "OPEN" : Return Cases(w, @"Open")
        Case "OPERATOR" : Return Cases(w, @"Operator")
        Case   "OPTION" : Return Cases(w, @"Option")
        Case       "OR" : Return Cases(w, @"Or")
        Case   "ORELSE" : Return Cases(w, @"OrElse")
        Case      "OUT" : Return Cases(w, @"Out")
        Case   "OUTPUT" : Return Cases(w, @"Output")
        Case "OVERLOAD" : Return Cases(w, @"Overload")
        Case "OVERRIDE" : Return Cases(w, @"Override")
#IfDef DIALECTS
        Case   "OPTION" : Return Cases(w, @"Option")
#EndIf
      End Select
    Case Asc("P")
      Select Case w
        Case     "PAINT" : Return Cases(w, @"Paint")
        Case   "PALETTE" : Return Cases(w, @"Palette")
        Case    "PASCAL" : Return Cases(w, @"Pascal")
        Case     "PCOPY" : Return Cases(w, @"PCopy")
        Case      "PEEK" : Return Cases(w, @"Peek")
        Case      "PIPE" : Return Cases(w, @"Pipe")
        Case      "PMAP" : Return Cases(w, @"PMap")
        Case     "POINT" : Return Cases(w, @"Point")
        Case   "POINTER" : Return Cases(w, @"Pointer")
        Case      "POKE" : Return Cases(w, @"Poke")
        Case       "POS" : Return Cases(w, @"Pos")
        Case       "POP" : Return Cases(w, @"Pop")
        Case  "PRESERVE" : Return Cases(w, @"Preserve")
        Case    "PRESET" : Return Cases(w, @"PreSet")
        Case     "PRINT" : Return Cases(w, @"Print")
        Case   "PRIVATE" : Return Cases(w, @"Private")
        Case   "PROCPTR" : Return Cases(w, @"ProcPtr")
        Case  "PROPERTY" : Return Cases(w, @"Property")
        Case "PROTECTED" : Return Cases(w, @"Protected")
        Case      "PSET" : Return Cases(w, @"PSet")
        Case       "PTR" : Return Cases(w, @"Ptr")
        Case    "PUBLIC" : Return Cases(w, @"Public")
        Case       "PUT" : Return Cases(w, @"Put")
        Case      "PUSH" : Return Cases(w, @"Push")
      End Select
    Case Asc("R")
      Select Case w
        Case     "RANDOM" : Return Cases(w, @"Random")
        Case  "RANDOMIZE" : Return Cases(w, @"Randomize")
        Case       "READ" : Return Cases(w, @"Read")
        Case "REALLOCATE" : Return Cases(w, @"ReAllocate")
        Case      "REDIM" : Return Cases(w, @"ReDim")
        Case        "REM" : Return Cases(w, @"Rem")
        Case      "RESET" : Return Cases(w, @"ReSet")
        Case    "RESTORE" : Return Cases(w, @"ReStore")
        Case     "RESUME" : Return Cases(w, @"ReSume")
        Case     "RETURN" : Return Cases(w, @"Return")
        Case        "RGB" : Return Cases(w, @"RGB")
        Case       "RGBA" : Return Cases(w, @"RGBA")
        Case      "RIGHT" : Return Cases(w, @"Right")
        Case      "RMDIR" : Return Cases(w, @"RmDir")
        Case        "RND" : Return Cases(w, @"Rnd")
        Case       "RSET" : Return Cases(w, @"RSet")
        Case      "RTRIM" : Return Cases(w, @"RTrim")
        Case        "RUN" : Return Cases(w, @"Run")
      End Select
    Case Asc("S")
      Select Case w
        Case          "SADD" : Return Cases(w, @"SAdd")
        Case         "SCOPE" : Return Cases(w, @"Scope")
        Case        "SCREEN" : Return Cases(w, @"Screen")
        Case "SCREENCONTROL" : Return Cases(w, @"ScreenControl")
        Case    "SCREENCOPY" : Return Cases(w, @"ScreenCopy")
        Case   "SCREENEVENT" : Return Cases(w, @"ScreenEvent")
        Case  "SCREENGLPROC" : Return Cases(w, @"ScreenGlProc")
        Case    "SCREENINFO" : Return Cases(w, @"ScreenInfo")
        Case    "SCREENLIST" : Return Cases(w, @"ScreenList")
        Case    "SCREENLOCK" : Return Cases(w, @"ScreenLock")
        Case     "SCREENPTR" : Return Cases(w, @"ScreenPtr")
        Case     "SCREENRES" : Return Cases(w, @"ScreenRes")
        Case     "SCREENSET" : Return Cases(w, @"ScreenSet")
        Case    "SCREENSYNC" : Return Cases(w, @"ScreenSync")
        Case  "SCREENUNLOCK" : Return Cases(w, @"ScreenUnLock")
        Case          "SCRN" : Return Cases(w, @"Scrn")
        Case        "SECOND" : Return Cases(w, @"Second")
        Case          "SEEK" : Return Cases(w, @"Seek")
        Case        "SELECT" : Return Cases(w, @"Select")
        Case       "SETDATE" : Return Cases(w, @"SetDate")
        Case    "SETENVIRON" : Return Cases(w, @"SetEnviron")
        Case      "SETMOUSE" : Return Cases(w, @"SetMouse")
        Case       "SETTIME" : Return Cases(w, @"SetTime")
        Case           "SGN" : Return Cases(w, @"Sgn")
        Case        "SHARED" : Return Cases(w, @"Shared")
        Case         "SHELL" : Return Cases(w, @"Shell")
        Case           "SHL" : Return Cases(w, @"ShL")
        Case         "SHORT" : Return Cases(w, @"Short")
        Case           "SHR" : Return Cases(w, @"ShR")
        Case           "SIN" : Return Cases(w, @"Sin")
        Case        "SINGLE" : Return Cases(w, @"Single")
        Case        "SIZEOF" : Return Cases(w, @"SizeOf")
        Case         "SLEEP" : Return Cases(w, @"Sleep")
        Case         "SPACE" : Return Cases(w, @"Space")
        Case           "SPC" : Return Cases(w, @"Spc")
        Case           "SQR" : Return Cases(w, @"Sqr")
        Case        "STATIC" : Return Cases(w, @"Static")
        Case       "STDCALL" : Return Cases(w, @"StdCall")
        Case          "STEP" : Return Cases(w, @"Step")
        Case         "STICK" : Return Cases(w, @"Stick")
        Case          "STOP" : Return Cases(w, @"Stop")
        Case           "STR" : Return Cases(w, @"Str")
        Case         "STRIG" : Return Cases(w, @"Strig")
        Case        "STRING" : Return Cases(w, @"String")
        Case        "STRPTR" : Return Cases(w, @"StrPtr")
        Case           "SUB" : Return Cases(w, @"Sub")
        Case          "SWAP" : Return Cases(w, @"Swap")
        Case        "SYSTEM" : Return Cases(w, @"System")
      End Select
    Case Asc("T")
      Select Case w
        Case          "TAB" : Return Cases(w, @"Tab")
        Case          "TAN" : Return Cases(w, @"Tan")
        Case         "THEN" : Return Cases(w, @"Then")
        Case         "THIS" : Return Cases(w, @"This")
        Case   "THREADCALL" : Return Cases(w, @"Threadcall")
        Case "THREADCREATE" : Return Cases(w, @"ThreadCreate")
        Case "THREADDETACH" : Return Cases(w, @"ThreadDetach")
        Case   "THREADWAIT" : Return Cases(w, @"ThreadWait")
        Case         "TIME" : Return Cases(w, @"Time")
        Case        "TIMER" : Return Cases(w, @"Timer")
        Case   "TIMESERIAL" : Return Cases(w, @"TimeSerial")
        Case    "TIMEVALUE" : Return Cases(w, @"TimeValue")
        Case           "TO" : Return Cases(w, @"To")
        Case        "TRANS" : Return Cases(w, @"Trans")
        Case         "TRIM" : Return Cases(w, @"Trim")
        Case         "TYPE" : Return Cases(w, @"Type")
        Case       "TYPEOF" : Return Cases(w, @"TypeOf")
      End Select
#IfDef THISFIX
      If Left(w, 4) = "THIS" Then
        Select Case As Const Asc(w, 5)
        Case Asc("."), Asc("-") : Mid(T, 1, 4) = Cases(Left(w, 4), @"This")
        End Select
      End If
#EndIf
    Case Asc("U")
      Select Case w
        Case   "UBOUND" : Return Cases(w, @"UBound")
        Case    "UBYTE" : Return Cases(w, @"UByte")
        Case    "UCASE" : Return Cases(w, @"UCase")
        Case "UINTEGER" : Return Cases(w, @"UInteger")
        Case    "ULONG" : Return Cases(w, @"ULong")
        Case "ULONGINT" : Return Cases(w, @"ULongInt")
        Case    "UNDEF" : Return Cases(w, @"UnDef")
        Case    "UNION" : Return Cases(w, @"Union")
        Case   "UNLOCK" : Return Cases(w, @"UnLock")
        Case "UNSIGNED" : Return Cases(w, @"UnSigned")
        Case    "UNTIL" : Return Cases(w, @"Until")
        Case   "USHORT" : Return Cases(w, @"UShort")
        Case    "USING" : Return Cases(w, @"Using")
      End Select
    Case Asc("V")
      Select Case w
        Case   "VA_ARG" : Return Cases(w, @"VA_Arg")
        Case "VA_FIRST" : Return Cases(w, @"VA_First")
        Case  "VA_NEXT" : Return Cases(w, @"VA_Next")
        Case      "VAL" : Return Cases(w, @"Val")
        Case    "VAL64" : Return Cases(w, @"Val64")
        Case   "VALINT" : Return Cases(w, @"ValInt")
        Case   "VALLNG" : Return Cases(w, @"ValLng")
        Case  "VALUINT" : Return Cases(w, @"ValUInt")
        Case  "VALULNG" : Return Cases(w, @"ValULng")
        Case      "VAR" : Return Cases(w, @"Var")
        Case   "VARPTR" : Return Cases(w, @"VarPtr")
        Case     "VIEW" : Return Cases(w, @"View")
        Case  "VIRTUAL" : Return Cases(w, @"Virtual")
      End Select
    Case Asc("W")
      Select Case w
        Case        "WAIT" : Return Cases(w, @"Wait")
        Case        "WBIN" : Return Cases(w, @"WBin")
        Case        "WCHR" : Return Cases(w, @"WChr")
        Case     "WEEKDAY" : Return Cases(w, @"WeekDay")
        Case "WEEKDAYNAME" : Return Cases(w, @"WeekDayName")
        Case        "WEND" : Return Cases(w, @"Wend")
        Case        "WHEX" : Return Cases(w, @"WHex")
        Case       "WHILE" : Return Cases(w, @"While")
        Case       "WIDTH" : Return Cases(w, @"Width")
        Case      "WINDOW" : Return Cases(w, @"Window")
        Case "WINDOWTITLE" : Return Cases(w, @"WindowTitle")
        Case      "WINPUT" : Return Cases(w, @"WInput")
        Case        "WITH" : Return Cases(w, @"With")
        Case        "WOCT" : Return Cases(w, @"WOct")
        Case       "WRITE" : Return Cases(w, @"Write")
        Case      "WSPACE" : Return Cases(w, @"WSpace")
        Case        "WSTR" : Return Cases(w, @"WStr")
        Case     "WSTRING" : Return Cases(w, @"WString")
      End Select
    Case Asc("X")
      Select Case w
        Case     "XOR" : Return Cases(w, @"Xor")
      End Select
    Case Asc("Y")
      Select Case w
        Case    "YEAR" : Return Cases(w, @"Year")
      End Select
    Case Asc("Z")
      Select Case w
        Case "ZSTRING" : Return Cases(w, @"ZString")
      End Select
  End Select  : Return T
End Function

' skip a comment or standard STRING
Sub FBeauty_type.readTo(ByRef T As String)
  Var i = 0, lt = Len(T)
  While Not Eof(1)
    Get #1, , Char
    Print #2, Chr(Char);
    If Char <> T[i] Then i = 0 Else i += 1 : If i = lt Then Exit Sub
  Wend
End Sub

' check for an escaped STRING, skip it
Function FBeauty_type.readEsc() As String
  If Eof(1) Then Return ""
  Get #1, , Char
  If Char <> Asc("""") Then
    If Check(Char) = 1 Then Return Chr(Char)
    Print #2, Chr(Char); : Return ""
  End If : Print #2, Chr(Char);
  Var i = 0
  While Not Eof(1)
    Get #1, , Char
    Print #2, Chr(Char);
    Select Case As Const Char
    Case Asc("\") : i += 1
    Case Asc("""") : If Bit(i, 0) Then i = 0 Else Exit While
    Case Else : i = 0
    End Select
  Wend : Return ""
End Function

' convert text / file, use "" for CONS [badidea]
Sub FBeauty_type.convert(command_ As String, inFileName As String, outFileName As String)
  If inFileName = "" Then Open Cons For Input As #1 _
  Else Open inFileName For Input As #1
  If outFileName = "" Then Open Cons For Output As #2 _
  Else Open outFileName For Output As #2

  setModus(command_)
  'print Modus

  While Not Eof(1)
    Get #1, , Char
    Select Case As Const Check(Char)
    Case 1 : Wort &= Chr(Char) '                                a word character
    Case 255 : Exit While '                                         end of input
    Case Else '                     evaluate non-word letter. But first, process
      If Len(Wort) Then Print #2, Change(Wort); : Wort = "" '       pending word
      Print #2, Chr(Char); '                                output the character
      Select Case As Const Check(Char) '                                check it
      Case 2 : Wort &= readEsc() '                          check escaped STRING
      Case 3 : readTo("""") '                               skip standard STRING
      Case 4 : readTo(!"\n") '                          skip single line comment
      Case 5 '                                         may be multi line comment
        If Not Eof(1) Then Get #1, , Char Else Exit While '   get next character
        Select Case As Const Check(Char) '                              check it
        Case 1 : Wort &= Chr(Char) '                            a keyword letter
        Case 2 : Print #2, Chr(Char); : Wort &= readEsc() ' check escaped STRING
        Case 3 : Print #2, Chr(Char); : readTo("""") '      skip standard STRING
        Case 4 : Print #2, Chr(Char); : readTo("'/") '  skip single line comment
        Case Else : Print #2, Chr(Char); '          other letters, simply output
        End Select
      End Select
    End Select
  Wend
  If Len(Wort) Then Print #2, Change(Wort); '        process pending word

  Close #2
  Close #1
End Sub

'---------------------------------- main ---------------------------------------

'Var FBeauty = FBeauty_type
'FBeauty.convert(command, "", "") 'con -> con
'FBeauty.convert("-i", "test.bas", "out.bas") 'file -> file

'===============================================================================

'-------------------------------------------------------------------------------

'look for <include> statement in line
Function checkInclude(row As String) As String
	Dim As String trm, incFile = ""
	Dim As Integer dqpos1, dqpos2
	'trim white space characters
	trm = Trim(row, Any " " + Chr(CC_TAB))
	'check if trimmed line starts with #include
	If Mid(trm, 1, INC_LEN) = "#include" Then
		'get first double quotion mark position
		dqpos1 = InStr(trm, QDM)
		'get second double quotion mark relative position
		dqpos2 = InStr(Mid(trm, dqpos1 + 1), QDM)
		'file should be between then double quotion mark
		incFile = Mid(trm, dqpos1 + 1, dqpos2 - 1)
		'trim any white space again
		incFile = Trim(incFile, Any " " + Chr(CC_TAB))
	End If
	Return incFile
End Function

Function commentLine(ByVal comment As String) As String
	Dim As String commentText
	Dim As Integer commentPos, commentLen
	commentText = "'"
	If comment = "" Then
		commentText &= String(79, "=")
	Else
		comment = " " & comment & " "
		commentLen = Len(comment)
		commentPos = (80 - commentLen) / 2
		commentText &= String(commentPos, "=")
		commentText &= comment
		commentText &= String(80 - Len(commentText), "=")
	End If
	Return commentText
End Function

Sub convertFile(srcFile As String, ByRef concatCode As extStr_type, ByRef fileList As list_type)
	Static As Integer firstFile = 1
  Static As String firstFileName
	Dim As extStr_type code
	Dim As String incFile, row, path
	Static As String lb
	If fileList.find(srcFile) = -1 Then
		fileList.add(srcFile)
		path = getFilePath(srcFile)
		Print "Load: <" & srcFile & ">"
		'load source file
		code.fileToString(srcFile)
		'set line break on first file
		If firstFile = 1 Then
			concatCode.lineBreak = code.getLineBreak()
			lb = concatCode.lineBreak
			firstFileName = srcFile
			firstFile = 0
		End If
		'concatCode.append(lb)
		'concatCode.append(commentLine(srcFile & " (begin)") & lb)
		'concatCode.append(lb)
		'Loop lines in file contents
		While code.getNextLine(row) <> -1
			incFile = checkInclude(row)
			'if include file in code and file existing at path 
			If incFile <> "" Then
				If FileExists(path & incFile) Then
					convertFile(path & incFile, concatCode, fileList)
				Else
					Print "Skip: <" & incFile & ">"
					concatCode.append(row)
				End If
			Else
				concatCode.append(row)
			End If
		Wend
		'concatCode.append(lb)
		'concatCode.append(commentLine(srcFile & " (end)") & lb)
		'concatCode.append(lb)
		If srcFile <> firstFileName Then
			concatCode.append(lb)
			concatCode.append(commentLine("") & lb)
			concatCode.append(lb)
		End If
	End If
End Sub

'-------------------------------------------------------------------------------

'OUTPUT FILE
Dim As String concatFile = changeFileExt(getFilePath(sourceFile) & "concat_" & getFileName(sourceFile), "tmp")

Dim As extStr_type concatCode
Dim As list_type fileList

convertFile(sourceFile, concatCode, fileList) 'recursive function
'fileList.show(0)

concatCode.show()
concatCode.stringToFile(concatFile)

Var FBeauty = FBeauty_type
FBeauty.convert("-i", concatFile, changeFileExt(concatFile, "bas"))
Print Kill(concatFile) 'delete .tmp file
TJF
Posts: 3809
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Re: Convenient(?) Code Concatenator

Post by TJF »

When you continue that concept, you'll soon find out that the posts on that forum are limited to a certian length. That's why some people split their long code in to multiple posts.
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Convenient(?) Code Concatenator

Post by badidea »

TJF wrote:When you continue that concept, you'll soon find out that the posts on that forum are limited to a certian length. That's why some people split their long code in to multiple posts.
Yes, I have read that before. I forgot what the limit was. I have't hit this limit myself yet. Not productive enough probably.

Another issue is that the c-like 'include once' is ignored:

Code: Select all

#ifndef __SOME_BI__
#define __SOME_BI__
'code
#endif __SOME_BI__
But unclear to me why one whats to use this if freebasic has 'include once'.
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Convenient(?) Code Concatenator

Post by MrSwiss »

badidea wrote:Yes, I have read that before. I forgot what the limit was.
It's 60'000 bytes (AFAIK), but keep in mind Forum uses UTF 8, so a single character,
can be larger than 1 Byte.

Code: Select all

#ifndef __SOME_BI__
#define __SOME_BI__
'code
#endif  ' __SOME_BI__
badidea wrote:But unclear to me why one whats to use this if freebasic has 'include once'.
Above code prevents including a file twice (or more), whether 'include once' is used or not.
(the included file protects 'itself')
FB alternative:

Code: Select all

#pragma once
Has the same effect.
Post Reply