Convenient(?) Code Concatenator

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

Convenient(?) Code Concatenator

Postby badidea » May 23, 2018 22:35

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: 895
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Convenient(?) Code Concatenator

Postby badidea » Sep 16, 2018 11:25

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

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 2 guests