Results 1 to 8 of 8

Thread: TB_SpellChecking-Utility

  1. #1
    thinBasic MVPs
    Join Date
    Oct 2012
    Location
    Germany
    Age
    54
    Posts
    1,527
    Rep Power
    170

    TB_SpellChecking-Utility

    I made a new spellchecker to check thinBasic-Files for bugs and typos - (the old one was pretty slow)
    - but this time I avoided the use of String-methods as Len and Mid$ etc...

    MinVersion 1.9.6.0 or 1.9.7.0 - when came the drag-in to TBGL?
    It works the following:

    Run the script from thinAir,
    drag any .tBasic, .tBasicC, .tBasicU or .inc -files from windows-explorer or from desktop into the spellchecker-window. Check starts immediately and stops if some serious problem in script structure is found.

    It checks for #IF+ If + Select + Do/Loop + While/Wend + Repeat/Until + For/Next + Type + Union + Sub/Function-nesting levels, also checks for even parenthesis & quotes, and for typos and a few things more. So if some expression is used just once per script it will inform about some dubious expression that you might to check back for.
    It will inform you, if found anything - click on the information to display the codeline then for further examinations.

    Only one problem to which I have no solution yet: It complains uneven paranthesis if the script uses line-continuation without underscore.



    _____________________________________________________________________________________

    Edit: @Eros
    (who else could answer this question?)

    Is there a way to add in some user-defined function or utility as this to thinAir? So I could instantly run the spellcheck from within thinAir on the current active scripts text without cumbersome actions as save script, change to spellchecker, start it, (search folder of script to check) dragging that there - checking here and then back to thinAir for corrections

    - I imagine like some menuitem on Tools\Utilities\"User defined" which can be choosen through thinAir-options - set User-defined-utility-Path + Command$ (OS_GetCommands) there then thinAir "knows" if to pass script-filename & path or plain text-string of current script or whatever (list of all current opened scriptnames, crlf-delimited?) as command to the user-utility...... ok, I would rewrite it, so you pass some tB-script as String to the function and get some $crlf-delimited error-report back?
    Attached Files Attached Files
    Last edited by ReneMiner; 29-05-2013 at 09:15.
    I think there are missing some Forum-sections as beta-testing and support

  2. #2
    Member
    Join Date
    Nov 2012
    Location
    Missouri, USA
    Posts
    113
    Rep Power
    29
    Rene,

    Do you have a link to an unofficial 1.9.7.0?

    I wont be able to checkout your spell-checker
    until later today. Plus, I want to study your
    script to see how you did it without Len and
    MID$.

    Bill

  3. #3
    thinBasic MVPs
    Join Date
    Oct 2012
    Location
    Germany
    Age
    54
    Posts
    1,527
    Rep Power
    170
    No sorry Billbo, I don't have a link to 1.9.7. I don't even know if it exists - perhaps the latest TBGL-Package can help - but I don't know for sure...

    Anyway- I made another file for demonstration-purpose which runs without TBGL - uses Console & File only - but not very comfortable since this is supposed to run only once on some filename that you type into the code before running it. This is intended to demonstrate

    Function SpellCheck_Proceed(ByVal sScript As String) As String
    
    where sScript is String of Script-content and result-string is the Error-report - small TBMain-function explains usage

    Uses "FILE"   ' needed to load keywords...
    
    Uses "CONSOLE" ' for demonstration-purpose
    
    
    '[] top of script
    
    Begin Const
    
      %await_NONE
      
      %await_EndFunction
      %await_EndSub
      %await_EndWith
      %await_EndType
      %await_EndUnion
      
      %await_DPlusENDIF      ' = "#ENDIF"
      %await_EndIf
      %await_Case
      %await_EndSelect
      
      %await_Next
      %await_Wend
      %await_Loop
      %await_Until
      
    End Const        
    
    
    Dim sKeyword()      As String     ' array of tB-keywords
    Dim sCodeLine()     As String     ' read-in codelines (change by check in memory)
                              
    Dim sErrors         As String
    Dim sExpression()   As String     ' store expressions
    Dim lExpression()   As Long       ' line of expression
    Dim nExpressions    As Long
    
    
    ' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
    
    Function TBMain()
      ' change sFile to any you want...
      Local sFile         As String = APP_Path + "SampleScripts\General\ByRef\Byref_Array_UDT.tBasic"
      Local myErrorReport As String = SpellCheck_Proceed(FILE_Load(sFile))
      
      
      If StrPtrLen(StrPtr(myErrorReport)) Then
        Local sOut()    As String
        Local nLines, i As Long
        
        
        nLines = Parse( myErrorReport, sOut, $CRLF)
      
        PrintL "found " + Str$(nLines - 1) + " messages:"
        PrintL
        
        For i = 1 To nLines - 1
          PrintL "Line-Number " + Val("&H" + Peek$(StrPtr(sOut(i)), 8)) + " reports:" 
          PrintL Peek$(StrPtr(sOut(i)) + 8, StrPtrLen(StrPtr(sOut(i))) - 8 )
          PrintL  
        
        Next
      
        If Val("&H" + Peek$(StrPtr(sOut(nLines)), 8)) = -1 Then
          PrintL "Check aborted because of script-structure-problem"
        Else
          PrintL "Check finished"
        EndIf
    
      Else
        PrintL "No problems found"
      EndIf
      
      WaitKey 
    
    End Function
    
    
    
    ' ------------------------------------------------------------------------------
    Function SpellCheck_Proceed(ByVal sScript As String) As String
      
      ' pass some tB-Script and receive Error-String delimited by $CRLF
      
      ' if no errors found returns empty string
      
      ' every single error-textline starts with 8 Bytes Hex$ of the scriptline-number
      ' (these bytes are represented here in comment-text as "§") 
      
      ' somewhat like "§§§§§§§§ErrorTextHere" + $crlf
      
      ' at the end get 8 Bytes more appended -only if any error found at all-
      
      ' and mean
      '          -1 check has been stopped through script-structure-problem
      '           0  check ran through until end
      
      ' two errors would look now like this
      ' "§§§§§§§§ErrorText1" + $crlf + "§§§§§§§§ErrorText2" + $crlf + Hex$(a 0 or -1 here, 8)
      
      
      ' first get keywords...
        If Not FILE_Exists(APP_Path + "thinAir\Syntax\thinBasic\thinBasic_Keywords.ini") Then
          MsgBox(0, "Can not find thinBasic_Keywords.ini", %MB_OK , "Unable to run")
          Return ""
        EndIf
    
    Local lKeywords As String = Ucase$(FILE_Load(APP_Path + "thinAir\Syntax\thinBasic\thinBasic_Keywords.ini"))
        If Not Parse(lKeywords, sKeyword, $CRLF) Then 
           MsgBox(0, "thinBasic_Keywords.ini seems to be corrupted", %MB_OK , "Unable to run")
          Return ""
       Endif 
     
    ' parse the script to lines, all ucase$ 
        ReDim sCodeLine(1)
        sScript = Ucase$(sScript)
    Local nLines As Long = Parse(sScript, sCodeline, $CRLF)
        If nLines < 1 Then Return ""
      
    Local cl, lLen As Long  
        
     ' go through all lines, remove Rem etc. sort numerals out
     ' combine them to actual lines if line-continuation etc.  
      For cl = 1 To nLines
        Check_Codelines(cl)
      Next  
          
     ' next step is checking "If/Elseif" followed by "Then"
     ' every "Sub" has an "End Sub" etc. 
     ' looks quite confusing much here, but is not that wild...
     
      For cl = 1 To nLines
        lLen = StrPtrLen(StrPtr(sCodeline(cl)))
        If lLen > 1 Then
          If Peek$(StrPtr(sCodeline(cl)), 2) = "IF" Then
            Check_Then(cl, "IF")
          Else
            If lLen > 2 Then
              If Peek$(StrPtr(sCodeline(cl)), 3) = "SUB" Then
                Check_End(cl, "SUB")
              Else 
                If lLen > 3 Then
                  If Peek$(StrPtr(sCodeline(cl)), 4) = "WITH" Then
                    Check_End(cl, "WITH")
                  ElseIf Peek$(StrPtr(sCodeline(cl)), 4) = "TYPE" Then
                    Check_End(cl, "TYPE")
                  Else
                    If lLen > 4 Then
                      If Peek$(StrPtr(sCodeline(cl)), 5) = "UNION" Then
                        Check_End(cl, "UNION")
                      Else
                        If lLen > 5 Then
                          If Peek$(StrPtr(sCodeline(cl)), 6) = "ELSEIF" Then
                            Check_Then(cl, "ELSEIF")
                          ElseIf Peek$(StrPtr(sCodeline(cl)), 6) = "SELECT" Then
                            If lLen >= 11 Then
                              If Peek$(StrPtr(sCodeline(cl)), 11) <> "SELECT CASE" Then sErrors += Hex$(cl, 8) + "SELECT missing: CASE" + $CRLF
                            Else
                              sErrors += Hex$(cl, 8) + "SELECT missing: CASE" + $CRLF
                            EndIf
                          Else
                            If lLen > 7 Then
                              If Peek$(StrPtr(sCodeline(cl)), 8) = "FUNCTION" Then
                                Check_End(cl, "FUNCTION")
                              Else  
                                If lLen >= 11 Then
                                  If Peek$(StrPtr(sCodeline(cl)), 11) = "BEGIN CONST" Then
                                    If lLen = 11 Then sCodeLine(cl) += " "
                                    Check_End(cl, "CONST")
                                    sCodeLine(cl) = TrimFull$(sCodeline(cl))
                                  Else
                                    If lLen >= 15 Then
                                      If Peek$(StrPtr(sCodeline(cl)), 15) = "BEGIN CONTROLID" Then
                                        If lLen = 15 Then sCodeLine(cl) += " "
                                        Check_End(cl, "CONTROLID")
                                        sCodeLine(cl) = TrimFull$(sCodeline(cl))
                                      Else
                                        If lLen > 16 Then
                                          If Peek$(StrPtr(sCodeline(cl)), 17) = "CALLBACK FUNCTION" Then
                                            Check_End(cl, "FUNCTION")
                                          EndIf
                                        EndIf
                                      EndIf
                                    EndIf
                                  EndIf
                                EndIf
                              EndIf
                            EndIf
                          EndIf
                        EndIf    
                      EndIf
                    EndIf
                  EndIf
                EndIf   
              EndIf
            EndIf
          EndIf   
        EndIf
      
      Next
         
      ' now check nesting-levels, sort out known keywords, binary (&B) and hex (&H)
      
      For cl = 1 To nLines
        If StrPtrLen(StrPtr(sCodeline(cl))) > 1 Then        
          If Not Check_Loops(cl) Then
            ' structural problem, makes no sense further checking 
            sErrors += Hex$(-1, 8)
            Return sErrors
          EndIf
        EndIf
      Next
      
      ' now check all collected unknown expressions 
      ' if the long lExpression(x) = 0 then this 
      ' sExpression(x) has been found more than once already
      
      If nExpressions Then 
        
        For cl = 1 To nExpressions
          If lExpression(cl) <> 0 Then sErrors += Hex$(lExpression(cl),8) + "dubious expression: " + sExpression(cl) + $CRLF
        Next
      EndIf
      
      If StrPtrLen(StrPtr(sErrors)) Then sErrors += Hex$(0, 8)
            
      Return sErrors
               
      
    End Function              
    
    ' ------------------------------------------------------------------------------
    
    Sub Check_Codelines(ByVal atLine As Long) 
      
      Static i, nChars, lParenthesis, lStart         As Long
      Static bChar, bSpace                           As Byte
      Static sBuffer                                 As String
      Static inQuote, bContinueRemark, bContinueLine As Boolean
      
      
      sCodeLine(atLine) = TrimFull$(sCodeLine(atLine))
      
      If StrPtrLen(StrPtr(sCodeLine(atLine))) < 1 Then 
        bContinueLine = FALSE
        lStart        = 0
        Exit Sub
      EndIf
      
      bSpace = 1
      inQuote = FALSE
      sBuffer = String$(StrPtrLen(sCodeLine(atLine)), 32)
      nChars  = 0
      If Not lStart Then lStart = atLine
       
      For i = 1 To StrPtrLen(StrPtr(sCodeline(atLine)))
        
        bChar = Peek(StrPtr(sCodeLine(atLine)) + i - 1)
        
        If bContinueRemark Then 
         
          If bChar = 43 Then  '   */
            If i < StrPtrLen(StrPtr(sCodeline(atLine))) Then
              If Peek(StrPtr(sCodeline(atLine)) + i) = 47 Then bContinueRemark = FALSE
            EndIf
          EndIf
        Else
          If bChar = 34 Then inQuote = inQuote XOR TRUE
        
          If Not inQuote Then 
            If Not bSpace Then bContinueLine = FALSE 
            
            Select Case bChar
              Case 32
                If bSpace = 0 Then
                  Poke(StrPtr(sBuffer) + nChars, 32) 
                  nChars += 1
                  bSpace = 1
                EndIf
    
              Case 34
    
              Case 38   ' &
                If i < StrPtrLen(StrPtr(sCodeLine(atLine))) Then
                  Select Case Peek(StrPtr(sCodeline(atLine))+i) 
                    Case 66, 72 ' &B, &H
                      Poke(StrPtr(sBuffer) + nChars, 38)
                      nChars += 1 
                      bSpace = 0
                  End Select
                EndIf  
              
              Case 39   ' '  
                Exit For
                    
              Case 40 ' (
                lParenthesis += 1  
                If bSpace = 0 Then
                  Poke(StrPtr(sBuffer) + nChars, 32)
                  nChars += 1
                  bSpace = 1
                EndIf
      
              Case 41 ' )
                lParenthesis -= 1
                If bSpace = 0 Then
                  Poke(StrPtr(sBuffer) + nChars, 32)
                  nChars += 1
                  bSpace = 1
                EndIf
    
              Case 42 To 46    ' * + , - . 
                If bSpace = 0 Then
                  Poke(StrPtr(sBuffer) + nChars, 32)
                  nChars += 1
                  bSpace = 1
                EndIf
    
              Case 47 ' /*
                If i < StrPtrLen(StrPtr(sCodeline(atLine))) Then
                  If Peek(StrPtr(sCodeline(atLine)) + i) = 43 Then 
                    bContinueRemark = TRUE
                  EndIf
                EndIf
                If bSpace = 0 Then
                  Poke(StrPtr(sBuffer) + nChars, 32)
                  nChars + 1
                  bSpace = 1
                EndIf
            
              Case 48 To 57   ' 0 to 9
                If bSpace = 0 Then
                  Poke(StrPtr(sBuffer) + nChars, bChar)
                  nChars += 1
                  bSpace = 0
                EndIf               
              
              Case 58 To 60    ' : ; < 
                If bSpace = 0 Then
                  Poke(StrPtr(sBuffer) + nChars, 32)
                  nChars += 1
                  bSpace = 1
                EndIf
              
              Case 61 ' =
                If nChars >= 8 + bSpace Then
                  If Peek$(StrPtr(sBuffer) + nChars - 8 - bSpace, 8) = "FUNCTION" Then
                    ' remove "Function ="
                    If nChars = 8 + bSpace Then
                      sBuffer = "" 
                      nChars = 0    
                    Else
                      If Peek(StrPtr(sBuffer) + nChars - 9 - bSpace) = 32 Then
                        nChars -= 8 + bSpace
                        sBuffer = Peek$(StrPtr(sBuffer), nChars) 
                      EndIf
                    EndIf
                  Else
                    If bSpace = 0 Then
                      Poke(StrPtr(sBuffer) + nChars, 32)
                      nChars += 1
                      bSpace = 1
                    EndIf
                  EndIf
                Else
                  If bSpace = 0 Then
                    Poke(StrPtr(sBuffer) + nChars, 32)
                    nChars += 1
                    bSpace = 1
                  EndIf
                EndIf
              
              Case 62, 92    ' > \
                If bSpace = 0 Then
                  Poke(StrPtr(sBuffer) + nChars, 32)
                  nChars += 1
                  bSpace = 1
                EndIf
              
              Case 73 ' I  - combine "End" + "If"  to "EndIf"
                If i < StrPtrLen(StrPtr(sCodeline(atLine))) And bSpace = 1 And nChars >= 4 And TRUE Then
                  If Peek(StrPtr(sCodeline(atLine)) + i ) = 70 Then 'F 
                    If nChars = 4 Then
                      If Peek$(StrPtr(sBuffer), 4)  = "END " Then nChars -= 1
                    Else
                      If Peek$(StrPtr(sBuffer) + nChars - 5, 5) = " END " Then 
                        nChars -= 1  
                      EndIf
                    EndIf  
                  EndIf  
                EndIf
                
                Poke(StrPtr(sBuffer) + nChars, bChar)
                nChars += 1
                bSpace = 0
             
                    
              Case 82 ' R (REM) 
               if bSpace then
                If i + 2 <= StrPtrLen(StrPtr(sCodeline(atLine))) Then
                  If Peek(StrPtr(sCodeline(atLine)) + i) = 69 Then
                    If Peek(StrPtr(sCodeline(atLine))+ i + 1) = 77 Then
                      If i + 2 = StrPtrLen(StrPtr(sCodeline(atLine))) Then Exit For
                      If Peek(StrPtr(sCodeline(atLine))+ i + 2) = 32 Then Exit For
                    EndIf
                  EndIf 
                 EndIf
                Endif
                Poke(StrPtr(sBuffer) + nChars, bChar)
                nChars += 1
                bSpace = 0
              
              Case 95    ' _
                If bSpace Then
                  If i = StrPtrLen(StrPtr(sCodeline(atLine))) Then
                    bContinueLine = TRUE
                  Else
                    If Peek(StrPtr(sCodeline(atLine)) + i) = 32 Then
                      bContinueLine = TRUE
                    Else
                      Poke(StrPtr(sBuffer) + nChars, bChar)
                      nChars += 1
                      bSpace = 0
                    EndIf
                  EndIf
                Else
                  Poke(StrPtr(sBuffer) + nChars, bChar)
                  nChars += 1
                  bSpace = 0
                EndIf
              
              Case Else
                Poke(StrPtr(sBuffer) + nChars, bChar)
                nChars += 1
                bSpace = 0
                
            End Select  
          EndIf
        EndIf
      Next
      
      
      If nChars Then
        If lStart = atLine Then
          sCodeLine(lStart) = TrimFull$(Peek$(StrPtr(sBuffer), nChars))
        Else
          sCodeLine(lStart) += " " + TrimFull$(Peek$(StrPtr(sBuffer), nChars))
          sCodeline(atLine) = ""
        EndIf  
      Else
        sCodeLine(atLine) = ""
        bContinueLine = FALSE
      EndIf
      
      If Not bContinueLine Then
        If inQuote Then sErrors += Hex$(lStart, 8) + "Missing quotes" + $CRLF
       
        If lParenthesis < 0 Then
          sErrors += Hex$(lStart, 8) + "Parenthesis - missing (" + $CRLF
        ElseIf lParenthesis > 0 Then
          sErrors += Hex$(lStart, 8) + "Parenthesis - missing )" + $CRLF
        EndIf
       
        lParenthesis = 0  
        lStart = 0      
      EndIf
      
      
    End Sub  
    
    
    ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -            
    ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
    Sub Check_Then(ByVal Start As Long, ByVal Keyword As String)
     
     Local sArg()    As String
     Static i, j, nArgs As Long
     
      
      If StrPtrLen(StrPtr(sCodeline(Start))) > StrPtrLen(StrPtr(Keyword)) Then
        ' not followed by a space is not the keyword we search for
        If Peek(StrPtr(sCodeline(Start)) + StrPtrLen(StrPtr(Keyword))) <> 32 Then Exit Sub
      EndIf
    
      If StrPtrLen(StrPtr(sCodeline(Start))) < StrPtrLen(StrPtr(Keyword)) + 5 Then 
        sErrors += Hex$(Start, 8) + Keyword + " missing: THEN" + $CRLF
        Exit Sub
      EndIf 
      
      nArgs = Parse(sCodeline(Start), sArg, " ")
     
      If nArgs < 2 Then 
        sErrors += Hex$(lStart, 8) + Keyword + " missing: THEN" + $CRLF
        Exit Sub
      EndIf
      
      i = 0 : j = 0
             
      Do
     
        i = Array Scan sArg(1+i), Collate Ucase, = "THEN"
        If i Then j += 1 
       
      Loop Until i = 0 Or i = nArgs
      
      
      If Keyword = "IF" And sArg(nArgs) <> "THEN" And TRUE Then 
          'remove one-line if
        sCodeline(Start) = ""
        For i = 2 To nArgs           
          If sArg(i) <> "THEN" Then
            If sArg(i) <> "ELSE" Then
              If sArg(i) <> "ENDIF" Then
                sCodeline(Start) += sArg(i)    
                If i < nArgs Then sCodeline(Start) += " "
              EndIf
            EndIf
          EndIf
        Next i
      EndIf 
      
      If j < 1 Then
        sErrors += Hex$(Start, 8) + Keyword + " missing: THEN" + $CRLF
      ElseIf j > 1 Then
        sErrors += Hex$(Start, 8) + Keyword + " redundant: THEN" + $CRLF
      EndIf
      
       
    End Sub 
    ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
    Sub Check_End(ByVal Start As Long, ByVal Keyword As String) 
    
    Static i, lsLen, lcLen As Long
    Static sSearch As String
      
      
      If StrPtrLen(StrPtr(sCodeline(Start))) > StrPtrLen(StrPtr(Keyword)) Then
        ' not followed by a space is not the keyword we search for
        If Peek(StrPtr(sCodeline(Start)) + StrPtrLen(StrPtr(Keyword))) <> 32 Then Exit Sub
      EndIf
         
      
      If StrPtrLen(StrPtr(sCodeline(Start))) < StrPtrLen(StrPtr(Keyword)) + 2 Then 
        sErrors += Hex$(Start, 8) + Keyword + " missing: identity" + $CRLF
        Exit Sub
      EndIf 
    
      sSearch = "END " + Keyword
      lsLen = StrPtrLen(StrPtr(sSearch)) 
    
      For i = Start To UBound(sCodeline)
    
        lcLen = StrPtrLen(StrPtr(sCodeline(i)))
        If lcLen >= lsLen Then
          If Peek$(StrPtr(sCodeline(i)) + lcLen - lsLen, lsLen) = sSearch Then Exit Sub  
        EndIf 
    
        If i > Start Then 
          If lcLen > 3 Then
            If Peek$(StrPtr(sCodeline(i)), 4) = "SUB " Then Exit For
            If lcLen > 8 Then
              If Peek$(StrPtr(sCodeline(i)), 9) = "FUNCTION " Then Exit For
              If lcLen > 17 Then
                If Peek$(StrPtr(sCodeline(i)), 18) = "CALLBACK FUNCTION " Then Exit For
              EndIf
            EndIf
          EndIf
        EndIf
      Next
      
      sErrors += Hex$(Start, 8) + "missing: END " + Keyword + $CRLF
      
    End Sub
    ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
    ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
    Function Check_Loops(ByVal Start As Long) As Boolean
    
     Local sArg()                 As String
     
     Static i, j, nArgs, lAwait   As Long 
     Static lError, lFound        As Long
     Static bFound                As Boolean
     Static sAwait, sFound    As String
     
     If sAwait = "" Then sAwait = MKL$(%await_NONE) 
     
     ' returns false if structural problem - 
     ' unable to find the right loop then, has to stop checking
     
      
      nArgs = Parse(sCodeline(Start), sArg, " ")
      If nArgs < 1 Then Return TRUE
     
      lError = 0
      
      
      For i = 1 To nArgs
        
        lAwait = Peek(Long, StrPtr(sAwait) + StrPtrLen(StrPtr(sAwait)) - SizeOf(Long))
      
        Select Case sArg(i)
          Case "EXIT"
            If nArgs > i Then
              Select Case sArg(i + 1)
                Case "FOR", "DO", "WHILE", "SUB", "FUNCTION"  
                  sArg(i + 1) = ""
              End Select
            EndIf
          Case "#IF" 
            sAwait += MKL$(%await_DPlusENDIF)
          
          Case "#ELSE", "#ELSEIF"
            If lAwait <> %await_DPlusENDIF Then
              sFound = sArg(i) 
              lError = 1
              Exit For  
            EndIf
          Case "#ENDIF"
            If lAwait = %await_DPlusENDIF Then 
              sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
            Else
              sFound = sArg(i) 
              lError = 1
              Exit For
            EndIf
        
          Case "END"
            If nArgs > i Then
              Select Case sArg(i + 1)
                Case "SUB", "FUNCTION"
                  If lAwait = %await_EndSub Then
                    sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
                    sArg(i+1) = ""
                  ElseIf lAwait = %await_EndFunction Then
                    sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
                    sArg(i+1) = ""
                  Else 
                    lError = 1
                    sFound = "END " + sArg(i + 1)
                    Exit For
                  EndIf  
                  If i + 1 < nArgs Then sErrors += Hex$(Start, 8) + "expected: End of Line" + $CRLF
       
                Case "SELECT"
                  If lAwait = %await_EndSelect Then
                    sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
                    sArg(i+1) = ""
                  Else
                    lError = 1
                    sFound = "END SELECT"
                    Exit For
                  EndIf
                  If i + 1 < nArgs Then sErrors += Hex$(Start, 8) + "expected: End of Line" + $CRLF
                  
                Case "WITH"
                  If lAwait = %await_EndWith Then
                    sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
                    sArg(i+1) = ""
                  Else
                    lError = 1
                    sFound = "END WITH"
                    Exit For
                  EndIf
                  If i + 1 < nArgs Then sErrors += Hex$(Start, 8) + "expected: End of Line" + $CRLF
          
                Case "TYPE"
                  If lAwait = %await_EndType Then 
                    sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
                    sArg(i+1) = ""
                  Else
                    lError = 1
                    sFound = "END TYPE"
                    Exit For
                  EndIf
                  If i + 1 < nArgs Then sErrors += Hex$(Start, 8) + "expected: End of Line" + $CRLF
          
                Case "UNION"
                  If lAwait = %await_EndUnion Then  
                    sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
                    sArg(i+1) = ""
                  Else
                    lError = 1
                    sFound = "END UNION"
                    Exit For
                  EndIf
                  If i + 1 < nArgs Then sErrors += Hex$(Start, 8) + "expected: End of Line" + $CRLF
          
              End Select 
            Else
              sErrors += Hex$(Start, 8) + "END missing: identifier" + $CRLF
            EndIf
          
          Case "IF"
            If i < nArgs Then
              For j = i + 1 To nArgs
                If sArg(j) = "THEN" Then
                  If j = nArgs Then sAwait += MKL$(%await_EndIf)
                  Exit For
                EndIf
              Next j
            EndIf  
            
          Case "ELSE", "ELSEIF"
            If lAwait <> %await_EndIf Then
              lError = 1
              sFound = sArg(i)
              Exit For
            EndIf
        
          Case "ENDIF"
            If lAwait = %await_EndIf Then 
              sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
            Else
              lError = 1
              sFound = sArg(i)
              Exit For
            EndIf
        
          Case "SUB"
            sAwait += MKL$(%await_EndSub)
        
          Case "FUNCTION"
            sAwait += MKL$(%await_EndFunction)
        
        
          Case "CALLBACK"
            If nArgs > 1 Then
              If sArg(2) = "FUNCTION" Then
                sAwait += MKL$(%await_EndFunction)
                sArg(2) = ""
              EndIf
            EndIf
        
          Case "DO"  
            sAwait += MKL$(%await_Loop)
            If nArgs > i Then
              Select Case sArg(i+1)
                Case "WHILE", "UNTIL"
                  sArg(i+1) = ""
              End Select
            EndIf
          Case "SELECT"
            sAwait += MKL$(%await_Case)
            If nArgs > i Then
              If sArg(i+1) = "CASE" Then sArg(i+1) = ""
            EndIf
        
          Case "CASE"
            If lAwait = %await_Case Then
              sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) ) + MKL$(%await_EndSelect)
            ElseIf lAwait = %await_EndSelect Then
              If nArgs > i Then
                If sArg(i+1) = "ELSE" Then sArg(i+1) = ""
              EndIf
            Else
              lError = 1
              sFound = sArg(i)
              Exit For
            EndIf
            
          Case "LOOP"
            If lAwait = %await_Loop Then
              sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
            Else
              lError = 1
              sFound = sArg(i)
              Exit For
            EndIf 
            If nArgs > i Then
              Select Case sArg(i+1)
                Case "WHILE", "UNTIL"
                  sArg(i+1) = ""
              End Select
            EndIf
          
          Case "WHILE" 
            sAwait += MKL$(%await_Wend)
        
          Case "WEND"  
            If lAwait = %await_Wend Then
              sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
            Else
              lError = 1
              sFound = sArg(i)
              Exit For
            EndIf
        
          Case "REPEAT"
            sAwait += MKL$(%await_Until)
        
          Case "UNTIL"
            If lAwait = %await_Until Then
              sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
            Else
              lError = 1
              sFound = sArg(i)
              Exit For
            EndIf
        
          Case "FOR"   
            lError = 300
            If i >= 3 Then
              For j = 1 To i - 1
                If sArg(j) = "ARRAY" Then lError -= 210
                If sArg(j) = "SCAN"  Then lError -=  90
                If lError = 0 Then Exit For
              Next j
            EndIf
            Select Case lError
              Case 0
                ' ignore array scan           
              Case 300
                ' for-next
                sAwait += MKL$(%await_Next) 
                lError = 0
              Case Else
                sErrors += Hex$(Start, 8) + "ARRAY SCAN ?" + $CRLF
            End Select
         
          Case "NEXT"
            If lAwait = %await_Next Then
              sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
            Else
              lError = 1
              sFound = sArg(i)
              Exit For
            EndIf
       
          Case "WITH"
            sAwait += MKL$(%await_EndWith)
        
          Case "TYPE"
            sAwait += MKL$(%await_EndType)
        
          Case "UNION"
            sAwait += MKL$(%await_EndUnion)
          
          Case Else  
            ' collect unknown expressions
            If StrPtrLen(StrPtr(sArg(i))) Then
              bFound = FALSE
              If Peek(StrPtr(sArg(i))) = 38 Then 
                If Peek(StrPtr(sArg(i))+1) = 66 Then
                  '&B  
                  bFound = is_Binary(sArg(i))  
                ElseIf Peek(StrPtr(sArg(i))+1) = 72 Then
                  '&H
                  bFound = is_Hex(sArg(i))  
                EndIf
              EndIf 
              
              If Not bFound Then
                If Array Scan sKeyword, Collate Ucase, = sArg(i) Then 
                  bFound = TRUE
                Else
                  If nExpressions Then
                    lFound = Array Scan sExpression, Collate Ucase, = sArg(i)
                    If lFound Then 
                      lExpression(lFound) = 0  
                      bFound = TRUE
                    EndIf
                  EndIf    
                EndIf
              EndIf
              
              If Not bFound Then
                nExpressions += 1
                If nExpressions > UBound(lExpression) Then
                  ReDim Preserve lExpression(nExpressions * 2)
                  ReDim Preserve sExpression(nExpressions * 2)
                EndIf
                sExpression(nExpressions) = sArg(i)
                lExpression(nExpressions) = Start
              EndIf  
            EndIf  
          
        End Select
      Next 
      
      If lError = 0 Then Return TRUE
        
      Select Case lAwait
        Case %await_NONE
          sErrors += Hex$(Start, 8) + "expected none, but found " + sFound + $CRLF
        Case %await_EndFunction
          sErrors += Hex$(Start, 8) + "expected END FUNCTION, but found " + sFound + $CRLF
        Case %await_EndSub
          sErrors += Hex$(Start, 8) + "expected END SUB, but found " + sFound + $CRLF
        Case %await_EndWith 
          sErrors += Hex$(Start, 8) + "expected END WITH, but found " + sFound + $CRLF
        Case %await_EndType
          sErrors += Hex$(Start, 8) + "expected END TYPE, but found " + sFound + $CRLF
        Case %await_EndUnion
          sErrors += Hex$(Start, 8) + "expected END UNION, but found " + sFound + $CRLF
        Case %await_DPlusENDIF     
          sErrors += Hex$(Start, 8) + "expected #ENDIF, but found " + sFound + $CRLF
        Case %await_EndIf
          sErrors += Hex$(Start, 8) + "expected ENDIF, but found " + sFound + $CRLF
        Case %await_Case
          sErrors += Hex$(Start, 8) + "expected CASE, but found " + sFound + $CRLF
        Case %await_EndSelect
          sErrors += Hex$(Start, 8) + "expected END SELECT, but found " + sFound + $CRLF
        Case %await_Next
          sErrors += Hex$(Start, 8) + "expected NEXT, but found " + sFound + $CRLF
        Case %await_Wend
          sErrors += Hex$(Start, 8) + "expected WEND, but found " + sFound + $CRLF
        Case %await_Loop
          sErrors += Hex$(Start, 8) + "expected LOOP, but found " + sFound + $CRLF
        Case %await_Until    
          sErrors += Hex$(Start, 8) + "expected UNTIL, but found " + sFound + $CRLF
      End Select
    
        
    End Function
    ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  
    ' following two functions will help sort out binary and hex-expressions
    ' called from Check_Loops-function
    
    Function is_Binary(ByVal sString As String) As Boolean
      
      If StrPtrLen(StrPtr(sString)) < 3 Then Return FALSE
      
      Local i As Long
      For i = 3 To StrPtrLen(StrPtr(sString))
        Select Case Peek(StrPtr(sString) + i - 1)
          Case 48, 49
          
          Case Else
            Return FALSE
        End Select
        
      Next
    
      Function = TRUE
      
      
    End Function
    
    ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -            
    Function is_Hex(ByVal sString As String) As Boolean
      
      If StrPtrLen(StrPtr(sString)) < 3 Then Return FALSE
      
      Local i As Long
      For i = 3 To StrPtrLen(StrPtr(sString))
        Select Case Peek(StrPtr(sString) + i - 1)
          Case 48 To 57
          Case 65 To 70
          Case Else
            Return FALSE
        End Select
      Next
    
      Function = TRUE
      
      
    End Function
                                                          
    ' ------------------------------------------------------------------------------
    
    Last edited by ReneMiner; 29-05-2013 at 08:50.
    I think there are missing some Forum-sections as beta-testing and support

  4. #4
    thinBasic author ErosOlmi's Avatar
    Join Date
    Sep 2004
    Location
    Milan - Italy
    Age
    57
    Posts
    8,777
    Rep Power
    10
    Quote Originally Posted by ReneMiner View Post
    Edit: @Eros
    (who else could answer this question?)

    Is there a way to add in some user-defined function or utility as this to thinAir? So I could instantly run the spellcheck from within thinAir on the current active scripts text without cumbersome actions as save script, change to spellchecker, start it, (search folder of script to check) dragging that there - checking here and then back to thinAir for corrections

    - I imagine like some menuitem on Tools\Utilities\"User defined" which can be choosen through thinAir-options - set User-defined-utility-Path + Command$ (OS_GetCommands) there then thinAir "knows" if to pass script-filename & path or plain text-string of current script or whatever (list of all current opened scriptnames, crlf-delimited?) as command to the user-utility...... ok, I would rewrite it, so you pass some tB-script as String to the function and get some $crlf-delimited error-report back?
    Maybe, maybe very soon there will be some surprises on running scripts into thinAir as native thinAir commands.

    Rene, in the meantime have you considered using Tokenizer module?
    This module has been thought to assist programmers having to "parse" big text giving each text token a meaning defined by the programmer depending from his/her needs.
    There are some examples into \thinBasic\SampleScripts\Tokenizer\

    There is also a crazy (I mean positive) thinBasic example by Michael Hartlef using Tokenizer module to translate a thinBasic source code into Pascal Source code: http://www.thinbasic.com/community/s...hlight=thinpas



    @Bilbo
    thinBasic 1.9.7.0 is on the way, maybe next week-end
    Last edited by ErosOlmi; 28-05-2013 at 21:56.
    www.thinbasic.com | www.thinbasic.com/community/ | help.thinbasic.com
    Windows 10 Pro for Workstations 64bit - 32 GB - Intel(R) Xeon(R) W-10855M CPU @ 2.80GHz - NVIDIA Quadro RTX 3000

  5. #5
    thinBasic MVPs
    Join Date
    Oct 2012
    Location
    Germany
    Age
    54
    Posts
    1,527
    Rep Power
    170
    No, I did not test tokenizer yet - especially because "tokens" confuse me- I don't know what "token" means for sure. On the other side I fear to use up users "private" memory mostly - that's why I didn't use "sort-out-powers" of dictionary But- anyway- tomorrow I'll take a look at tokenizer.
    I think there are missing some Forum-sections as beta-testing and support

  6. #6
    thinBasic author ErosOlmi's Avatar
    Join Date
    Sep 2004
    Location
    Milan - Italy
    Age
    57
    Posts
    8,777
    Rep Power
    10
    Tokens are just piece of text like you are parsing in your script example you posted here:

    • FOR is a token
    • , (comma) is a token
    • "this is a quoted string" is a token
    • ' (single apostrophe) is a token
    • ...


    The parser in tokenizer module (Tokenizer_GetNextToken) can scan a string buffer and returns at every token found giving back the token found and tokentype.
    TokenType can change depending on what keywords you have loaded into your session (tokenizer_KeyAdd) and special chars setup (Tokenizer_Default_Set and other functions)

    See examples:

    • \thinBasic\SampleScripts\Tokenizer\Tokenizer.tBasic
    • \thinBasic\SampleScripts\Tokenizer\Tokenizer_UserKeys.tBasic



    Hope this can help.

    Ciao
    Eros
    www.thinbasic.com | www.thinbasic.com/community/ | help.thinbasic.com
    Windows 10 Pro for Workstations 64bit - 32 GB - Intel(R) Xeon(R) W-10855M CPU @ 2.80GHz - NVIDIA Quadro RTX 3000

  7. #7
    thinBasic MVPs
    Join Date
    Oct 2012
    Location
    Germany
    Age
    54
    Posts
    1,527
    Rep Power
    170
    I had to do a little "cosmetics" to both - the script and the attachement - there were some typos inside quotes - also forgot to check for space in front of REM and - because I ran it on itself - found some useless, leftover variable.


    And playing around with tokenizer: found some ...bugs? in help,

    thinBasic Modules > Tokenizer > Tokenizer_KeyGetMainType, there's some description about Tokenizer_KeyGetName but does not tell anything about Tokenizer_KeyGetMainType
    same to:

    thinBasic Modules > Tokenizer > Tokenizer_KeyFind, where it tells about use of Tokenizer_KeyGetUserString but nothing about Tokenizer_KeyFind.

    So I have to check other sources for informations about tokenizer now...
    I think there are missing some Forum-sections as beta-testing and support

  8. #8
    thinBasic author ErosOlmi's Avatar
    Join Date
    Sep 2004
    Location
    Milan - Italy
    Age
    57
    Posts
    8,777
    Rep Power
    10
    Thanks Rene for help bugs hunting.
    There was an error only in the syntax where I copied the name of the keyword from another one. The title, the topic and the page are correct.

    Will be fixed in next release.
    www.thinbasic.com | www.thinbasic.com/community/ | help.thinbasic.com
    Windows 10 Pro for Workstations 64bit - 32 GB - Intel(R) Xeon(R) W-10855M CPU @ 2.80GHz - NVIDIA Quadro RTX 3000

Similar Threads

  1. amd dual core utility
    By kryton9 in forum General
    Replies: 0
    Last Post: 28-12-2007, 04:04
  2. New Utility
    By kryton9 in forum 3rd party tools
    Replies: 17
    Last Post: 05-05-2007, 01:49
  3. NEW ThinAIR utility (TBCode to Clipboard)
    By RobertoBianchi in forum thinAir General
    Replies: 2
    Last Post: 31-05-2006, 14:19
  4. Simple MCI utility
    By Petr Schreiber in forum Win API interface
    Replies: 2
    Last Post: 24-05-2006, 21:06

Members who have read this thread: 0

There are no members to list at the moment.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •