Code Indenter

Category: Source Code Analysis

Date: 03-28-2012

Return to Index


 
'This snippet provides indentation of source code. It starts by left
'justifying all text (spaces trimmed), then indents as appropriate.
'Multiple levels-within-levels of code constructs are supported.
 
'This code does not break long lines.
'This code does recognize _ at the end of a line.
'TABs are replaced with spaces
 
'Primary Code:
'The Indent function is very long, so it is displayed only in the
'compilable example below. When called, the Indent function accepts
'an argument which is the # of spaces for each indentationl level.
 
 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Debug Error On     'catch array/pointer errors - OFF in production
#Debug Display On   'display untrapped errors   - OFF in production
#Include "Win32API.inc"
Global hDlg As DWord
 
Function PBMain() As Long
   Local style&
   style& = %WS_TabStop Or %WS_Border Or  %ES_Left Or %ES_AutoHScroll Or %ES_MultiLine Or %ES_NoHideSel Or %ES_WantReturn Or %WS_VScroll Or %ES_AutoVScroll
   Dialog New Pixels, 0, "Test Code",300,200,300,500, %WS_OverlappedWindow To hDlg
   Control Add TextBox, hDlg, 100, SampleText, 10,10,280,440, Style&
   Control Add Button, hDlg, 200,"Indent", 80,460,100,20
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case CB.Msg
      Case %WM_InitDialog
         Control Post hDlg, 100, %EM_SetSel, -1, 0
      Case %WM_Command
         If CB.Ctl = 200 AND CB.Ctlmsg = %BN_Clicked Then Control Set Text CB.Hndl, 100, xIndent(4,1,2)
   End Select
End Function
 
Function xIndent(N As Long, B As Long, P As LongAs String   'N is indentation, B is max blank lines
   Local temp$, D() As String, i, j, Flag, iCount, iMax, cFlag As Long   'cFlag = continuation flag
   Local iSelectLevel&, iDoLevel&, iForLevel&, iIfLevel&, iWhileLevel&
   Local iLevel&, iInterfaceLevel&, iMethodLevel&, iPropertyLevel&, iTryLevel&
 
   Dim SelectLevel(100) As Long
   Dim DoLevel(100) As Long
   Dim ForLevel(100) As Long
   Dim IfLevel(100) As Long
   Dim WhileLevel(100) As Long
   Dim TryLevel(100) As Long
   Dim InterfaceLevel(100) As Long
   Dim MethodLevel(100) As Long
   Dim PropertyLevel(100) As Long
 
   Control Get Text hDlg, 100 To temp$
   Replace $Tab With Space$(N) In temp$
   i = ParseCount(temp$, $CrLf)
   ReDim D(i-1)
   Parse temp$, D(), $CrLf
 
   'Trim excess white space, but leave white space on right (left-justifies all text)
   For i = 0 To UBound(D)
      D(i) = Trim$(D(i)) + " "
   Next i
 
   'blank line management  B = max number of allowed blank lines between any 2 lines of code
   If B > -1 Then
      For i = UBound(D) To 0 Step -1
         If Len(Trim$(D(i))) = 0 Then
            Incr iCount
            If iCount > B Then
               Array Delete D(i)
               ReDim Preserve D(UBound(D)-1)
               Decr iCount
            End If
         Else
            iCount = 0
         End If
      Next i
   End If
 
   'pre-construct blank line addition   P = exact number of blank lines required before construct
   If P > -1 Then
      iCount = 0 : iMax = UBound(D)
      For i = iMax To 1 Step -1
         If LCase$(Left$(D(i),5)) = "type Or _
               LCase$(Left$(D(i),6)) = "union Or _
               LCase$(Left$(D(i),4)) = "sub Or _
               LCase$(Left$(D(i),16)) = "thread function Or _
               LCase$(Left$(D(i),9)) = "callback Or _
               (LCase$(Left$(D(i),9)) = "function And LCase$(Left$(D(i),10)) <> "function =") Or _
               (LCase$(Left$(D(i),6)) = "class And LCase$(Left$(D(i),10)) <> "function =") Then
            iCount = 0 : Flag = 1
 
         ElseIf Len(Trim$(D(i))) = 0 Then
            If Flag Then Incr iCount
 
         Else
            If Flag Then
               Select Case iCount
                  Case P            'no action
                  Case Is < P       'add P-iCount lines
                     ReDim Preserve D(UBound(D) + P - iCount)
                     For j = 1 To (P-iCount) : Array Insert D(i+1) : Next j
                  Case Is > P        'delete iCount - P line
                     For j = 1 To (iCount-P) : Array Delete D(i+1) : Next j
                     ReDim Preserve D(UBound(D) - (iCount - P))
               End Select
            End If
            Flag = 0 : iCount = 0
         End If
      Next i
   End If
 
   For i = 0 To UBound(D)
      temp$ = LCase$(RTrim$(TrimComments(D(i))))'used in test merged multi-line code
      If cFlag Then    'previous line ended in _ so use this line as is, with indentation to iLevel + 1
         D(i) = Space$((iLevel+1)*N) + D(i) 'keep current indentation
 
      ElseIf LCase$(Left$(D(i),5)) = "type Then
         iLevel=1 : iIFLevel&=1 : iForLevel&=1 : iSelectLevel&=1 : iDoLEvel&=1 : iWhileLevel&=1
      ElseIf LCase$(Left$(D(i),8)) = "end typeThen
         iLevel=1 : iIFLevel&=1 : iForLevel&=1 : iSelectLevel&=1 : iDoLEvel&=1 : iWhileLevel&=1
      ElseIf LCase$(Left$(D(i),6)) = "union Then
         iLevel=1 : iIFLevel&=1 : iForLevel&=1 : iSelectLevel&=1 : iDoLEvel&=1 : iWhileLevel&=1
      ElseIf LCase$(Left$(D(i),9)) = "end unionThen
         iLevel=1 : iIFLevel&=1 : iForLevel&=1 : iSelectLevel&=1 : iDoLEvel&=1 : iWhileLevel&=1
      ElseIf LCase$(Left$(D(i),4)) = "sub Then
         iLevel=1 : iIFLevel&=1 : iForLevel&=1 : iSelectLevel&=1 : iDoLEvel&=1 : iWhileLevel&=1
      ElseIf LCase$(Left$(D(i),7)) = "end subThen
         iLevel=1 : iIFLevel&=1 : iForLevel&=1 : iSelectLevel&=1 : iDoLEvel&=1 : iWhileLevel&=1
      ElseIf LCase$(Left$(D(i),16)) = "thread function Then
         iLevel=1 : iIFLevel&=1 : iForLevel&=1 : iSelectLevel&=1 : iDoLEvel&=1 : iWhileLevel&=1
      ElseIf LCase$(Left$(D(i),9)) = "callback Then
         iLevel=1 : iIFLevel&=1 : iForLevel&=1 : iSelectLevel&=1 : iDoLEvel&=1 : iWhileLevel&=1
      ElseIf LCase$(Left$(D(i),9)) = "function And LCase$(Left$(D(i),10)) <> "function =Then
         iLevel=1 : iIFLevel&=1 : iForLevel&=1 : iSelectLevel&=1 : iDoLEvel&=1 : iWhileLevel&=1
      ElseIf LCase$(Left$(D(i),12)) = "end functionThen
         iLevel=1 : iIFLevel&=1 : iForLevel&=1 : iSelectLevel&=1 : iDoLEvel&=1 : iWhileLevel&=1
      ElseIf LCase$(Left$(D(i),6)) = "class And LCase$(Left$(D(i),10)) <> "function =Then
         iLevel=1 : iIFLevel&=1 : iForLevel&=1 : iSelectLevel&=1 : iDoLEvel&=1 : iWhileLevel&=1
      ElseIf LCase$(Left$(D(i),9)) = "end classThen
         iLevel=1 : iIFLevel&=1 : iForLevel&=1 : iSelectLevel&=1 : iDoLEvel&=1 : iWhileLevel&=1
 
         '****** This section tests for multi-line structures merged on a single line ***************************
         'such structures have no children, so the iLevel is not changed and the line is used as is *************
 
      ElseIf Left$(temp$,3) = "if And InStr(-1,temp$,"then ") And Len(Mid$(temp$,InStr(-1,temp$,"then ")+5)) > 0 Then
         'Tests for:  If x then y=2
         D(i) = Space$(iLevel*N) + D(i)
 
      ElseIf Left$(temp$,3) = "if And InStr(-1,temp$,"else ") And Len(Mid$(temp$,InStr(-1,temp$,"else ")+5)) > 0 Then
         D(i) = Space$(iLevel*N) + D(i)
         'Tests for:  If x then y=2 else z=4
         D(i) = Space$(iLevel*N) + D(i)
 
      ElseIf Left$(temp$,4) = "for And InStr(-1,temp$,"next ") And Len(Mid$(temp$,InStr(-1,temp$,"next ")+5)) > 0 Then
         'Tests for:  For x=2 To 5 : next i
         D(i) = Space$(iLevel*N) + D(i)
 
      ElseIf Left$(temp$,6) = "macro And Right$(temp$,9) = "end macroThen
         'Tests for:  macro : ... : ... : end macro
         D(i) = Space$(iLevel*N) + D(i)
 
      ElseIf Left$(temp$,4) = "try And Right$(temp$,7) = "end tryThen
         'Tests for:  try : ... : ... : end try
         D(i) = Space$(iLevel*N) + D(i)
 
      ElseIf Left$(temp$,3) = "do And Right$(temp$,4) = "loopThen
         'Tests for:  do loop/while : ... : ... : loop
         D(i) = Space$(iLevel*N) + D(i)
 
      ElseIf Left$(temp$,3) = "do And InStr(-1,temp$,"loop while ") And Len(Mid$(temp$,InStr(-1,temp$,"loop while ")+11)) > 0 Then
         'Tests for:  Do .. : .. : Loop While x=2
         D(i) = Space$(iLevel*N) + D(i)
 
      ElseIf Left$(temp$,3) = "do And InStr(-1,temp$,"loop until ") And Len(Mid$(temp$,InStr(-1,temp$,"loop until ")+11)) > 0 Then
         'Tests for:  Do .. : .. : Loop While x=2
         D(i) = Space$(iLevel*N) + D(i)
 
      ElseIf Left$(temp$,6) = "while And Right$(temp$,4) = "wendThen
         'Tests for:  While x=2 : y=3 : Wend
         D(i) = Space$(iLevel*N) + D(i)
 
      ElseIf Left$(temp$,11) = "select caseAnd Right$(temp$,10) = "end selectThen
         'Tests for: Select Case x : ... : End Select
         D(i) = Space$(iLevel*N) + D(i)
 
      ElseIf Left$(temp$,10) = "interface And Right$(temp$,9) = "interfaceThen
         'Tests for:  Interface ... End Interface
         D(i) = Space$(iLevel*N) + D(i)
 
      ElseIf Left$(temp$,7) = "methodAnd Right$(temp$,10) = "end methodThen
         'Tests for:  Method ... End Method
         D(i) = Space$(iLevel*N) + D(i)
 
      ElseIf Left$(temp$,10) = "property And Right$(temp$,12) = "end propertyThen
         'Tests for:  Property ... End Property
         D(i) = Space$(iLevel*N) + D(i)
 
         '********* This section handles each line of multi-line constructs *********************
 
         'merge/end merge
      ElseIf LCase$(Left$(D(i),6)) = "macro Then
         iLevel=1 : iIFLevel&=1 : iForLevel&=1 : iSelectLevel&=1 : iDoLEvel&=1 : iWhileLevel&=1
      ElseIf LCase$(Left$(D(i),9)) = "end macroThen
         iLevel=1 : iIFLevel&=1 : iForLevel&=1 : iSelectLevel&=1 : iDoLEvel&=1 : iWhileLevel&=1
 
         'do/loop
      ElseIf LCase$(Left$(D(i),3)) = "do Then
         Incr iDoLevel& : DoLevel(iDoLevel&) = iLevel
         D(i) = Space$(iLevel*N) + D(i)
         Incr iLevel
      ElseIf LCase$(Left$(D(i),5)) = "loop Then
         iLevel = DoLevel(iDoLevel&)
         D(i) = Space$(iLevel*N) + D(i)
         Decr iDoLevel&
 
         'for/next
      ElseIf LCase$(Left$(D(i),4)) = "for Then
         Incr iForLevel& : ForLevel(iForLevel&) = iLevel
         D(i) = Space$(iLevel*N) + D(i)
         Incr iLevel
      ElseIf LCase$(Left$(D(i),5)) = "next Then
         iLevel = ForLevel(iForLevel&)
         D(i) = Space$(iLevel*N) + D(i)
         Decr iForLevel&
 
         'if/elseif/else/end if
      ElseIf LCase$(Left$(D(i),3)) = "if Then
         Incr iIFLevel& : IFLevel(iIFLevel&) = iLevel
         D(i) = Space$(iLevel*N) + D(i)
         Incr iLevel
      ElseIf LCase$(Left$(D(i),7)) = "elseif Then
         iLevel = IFLevel(iIFLevel&)
         D(i) = Space$(iLevel*N) + D(i)
         Incr iLevel
      ElseIf LCase$(Left$(D(i),4)) = "elseThen
         iLevel = IFLevel(iIFLevel&)
         D(i) = Space$(iLevel*N) + D(i)
         Incr iLevel
      ElseIf LCase$(Left$(D(i),6)) = "end ifThen
         iLevel = IFLevel(iIFLevel&)
         D(i) = Space$(iLevel*N) + D(i)
         Decr iIFLevel&
 
         'try/catch/finally/end try
      ElseIf LCase$(Left$(D(i),4)) = "try Then
         Incr iTryLevel& : TryLevel(iTryLevel&) = iLevel
         D(i) = Space$(iLevel*N) + D(i)
         Incr iLevel
      ElseIf LCase$(Left$(D(i),5)) = "catchThen
         iLevel = TryLevel(iTryLevel&)
         D(i) = Space$(iLevel*N) + D(i)
         Incr iLevel
      ElseIf LCase$(Left$(D(i),7)) = "finallyThen
         iLevel = TryLevel(iTryLevel&)
         D(i) = Space$(iLevel*N) + D(i)
         Incr iLevel
      ElseIf LCase$(Left$(D(i),7)) = "end tryThen
         iLevel = TryLevel(iTryLevel&)
         D(i) = Space$(iLevel*N) + D(i)
         Decr iTryLevel&
 
         'select case/end select
      ElseIf LCase$(Left$(D(i),7)) = "select Then
         Incr iSelectLevel& : SelectLevel(iSelectLevel&) = iLevel
         D(i) = Space$(iLevel*N) + D(i)
         Incr iLevel
      ElseIf LCase$(Left$(D(i),5)) = "case Then
         iLevel = SelectLevel(iSelectLevel&)+1
         D(i) = Space$(iLevel*N) + D(i)
         Incr iLevel
      ElseIf LCase$(Left$(D(i),10)) = "end selectThen
         iLevel = SelectLevel(iSelectLevel&)
         D(i) = Space$(iLevel*N) + D(i)
         Decr iSelectLevel&
 
         'while/wend
      ElseIf LCase$(Left$(D(i),6)) = "while Then
         Incr iWhileLevel& : WhileLevel(iWhileLevel&) = iLevel
         D(i) = Space$(iLevel*N) + D(i)
         Incr iLevel
      ElseIf LCase$(Left$(D(i),4)) = "wendThen
         iLevel = WhileLevel(iWhileLevel&)
         D(i) = Space$(iLevel*N) + D(i)
         Decr iWhileLevel&
 
         'interface/endinterface
      ElseIf LCase$(Left$(D(i),10)) = "interface Then
         Incr iInterfaceLevel& : InterfaceLevel(iInterfaceLevel&) = iLevel
         D(i) = Space$(iLevel*N) + D(i)
         Incr iLevel
      ElseIf LCase$(Left$(D(i),13)) = "end interfaceThen
         iLevel = InterfaceLevel(iInterfaceLevel&)
         D(i) = Space$(iLevel*N) + D(i)
         Decr iInterfaceLevel&
 
         'property/endproperty
      ElseIf LCase$(Left$(D(i),9)) = "property Then
         Incr iPropertyLevel& : PropertyLevel(iPropertyLevel&) = iLevel
         D(i) = Space$(iLevel*N) + D(i)
         Incr iLevel
      ElseIf LCase$(Left$(D(i),12)) = "end propertyThen
         iLevel = PropertyLevel(iPropertyLevel&)
         D(i) = Space$(iLevel*N) + D(i)
         Decr iPropertyLevel&
 
         'method/endmethod
      ElseIf LCase$(Left$(D(i),7)) = "method Then
         Incr iMethodLevel& : MethodLevel(iMethodLevel&) = iLevel
         D(i) = Space$(iLevel*N) + D(i)
         Incr iLevel
      ElseIf LCase$(Left$(D(i),10)) = "end methodThen
         iLevel = MethodLevel(iMethodLevel&)
         D(i) = Space$(iLevel*N) + D(i)
         Decr iMethodLevel&
 
         'labels
      ElseIf Instr(D(i),":") And Verify(Left$(D(i),Instr(D(i),":")-1), Chr$(65 to 90, 97 to 122, 48 to 57, 95)) = 0 Then
         'no indentation
 
      Else
         D(i) = Space$(iLevel*N) + D(i)
      End If
      D(i) = RTrim$(D(i))
 
      If Right$(temp$,1) = "_Then cFlag = 1 Else cFlag = 0
 
   Next i
   Function = Join$(D(), $CrLf)
End Function
 
Function TrimComments(txt As StringAs String
   Local i, qFlag As Long, c As String
   For i = 1 To Len(txt)
      c = Mid$(txt,i,1)
      If c = $Dq AND qFlag = 1 Then
         qFlag = 0
      ElseIf c = $Dq Then
         qFlag = 1
      ElseIf c = "'AND qFlag = 0 Then
         Function = RTrim$(Left$(txt,i-1))   'found single-quote character not embedded in double-quotes
         Exit Function
      End If
   Next i
   Function = txt
End Function
 
Function SampleText() As String
   Local temp$
   temp$ = temp$ + "Macro " + $CrLf
   temp$ = temp$ + "nothing " + $CrLf
   temp$ = temp$ + "End Macro " + $CrLf
   temp$ = temp$ + "Type " + $CrLf
   temp$ = temp$ + "nothing " + $CrLf
   temp$ = temp$ + "End Type " + $CrLf
   temp$ = temp$ + "Function MyF()" + $CrLf
   temp$ = temp$ + "nothing " + $CrLf
   temp$ = temp$ + "End Function" + $CrLf
   temp$ = temp$ + "Sub " + $CrLf
   temp$ = temp$ + "nothing " + $CrLf
   temp$ = temp$ + "End Sub " + $CrLf
   temp$ = temp$ + "Class " + $CrLf
   temp$ = temp$ + "nothing " + $CrLf
   temp$ = temp$ + "End Class " + $CrLf
   temp$ = temp$ + "Function MyF()" + $CrLf
   temp$ = temp$ + "x=2" + $CrLf
   temp$ = temp$ + "If x=2 Then" + $CrLf
   temp$ = temp$ + "'no action" + $CrLf
   temp$ = temp$ + "ElseIf x = 3" + $CrLf
   temp$ = temp$ + "y = x" + $CrLf
   temp$ = temp$ + "Else" + $CrLf
   temp$ = temp$ + "'no action" + $CrLf
   temp$ = temp$ + "End If" + $CrLf
   temp$ = temp$ + "If x=2 Then y=6" + $CrLf
   temp$ = temp$ + "Select Case x" + $CrLf
   temp$ = temp$ + "case 1" + $CrLf
   temp$ = temp$ + "Select Case y" + $CrLf
   temp$ = temp$ + "case 1" + $CrLf
   temp$ = temp$ + "case 2" + $CrLf
   temp$ = temp$ + "case 3" + $CrLf
   temp$ = temp$ + "End Select" + $CrLf
 
   temp$ = temp$ + "macro : ... : end macro" + $CrLf
   temp$ = temp$ + "do loop : ... : loop" + $CrLf
   temp$ = temp$ + "try : ... :: end try" + $CrLf
   temp$ = temp$ + "try" + $CrLf
   temp$ = temp$ + "trystuff" + $CrLf
   temp$ = temp$ + "catch" + $CrLf
   temp$ = temp$ + "cstuff" + $CrLf
   temp$ = temp$ + "finally" + $CrLf
   temp$ = temp$ + "fstuff" + $CrLf
   temp$ = temp$ + "end try" + $CrLf
 
   temp$ = temp$ + "If x = 2 Then _" + $CrLf
   temp$ = temp$ + "y = 6" + $CrLf
 
   temp$ = temp$ + "case 2" + $CrLf
   temp$ = temp$ + "End Select" + $CrLf
   temp$ = temp$ + "Function = 2" + $CrLf
   temp$ = temp$ + "End Function" + $CrLf
   temp$ = temp$ + "Sub MyS" + $CrLf
   temp$ = temp$ + "While iResult" + $CrLf
   temp$ = temp$ + "Beep" + $CrLf
   temp$ = temp$ + "Wend" + $CrLf
   temp$ = temp$ + "Do While x=2" + $CrLf
   temp$ = temp$ + "x = time$" + $CrLf
   temp$ = temp$ + "Loop" + $CrLf
   temp$ = temp$ + "End Sub" + $CrLf
   Function = temp$
End Function
 
'gbs_00689
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm