Date: 02-16-2022
Return to Index
created by gbSnippets
'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: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#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 Long) As 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 type" Then
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 union" Then
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 sub" Then
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 function" Then
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 class" Then
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 macro" Then
'Tests for: macro : ... : ... : end macro
D(i) = Space$(iLevel*N) + D(i)
ElseIf Left$(temp$,4) = "try " And Right$(temp$,7) = "end try" Then
'Tests for: try : ... : ... : end try
D(i) = Space$(iLevel*N) + D(i)
ElseIf Left$(temp$,3) = "do " And Right$(temp$,4) = "loop" Then
'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) = "wend" Then
'Tests for: While x=2 : y=3 : Wend
D(i) = Space$(iLevel*N) + D(i)
ElseIf Left$(temp$,11) = "select case" And Right$(temp$,10) = "end select" Then
'Tests for: Select Case x : ... : End Select
D(i) = Space$(iLevel*N) + D(i)
ElseIf Left$(temp$,10) = "interface " And Right$(temp$,9) = "interface" Then
'Tests for: Interface ... End Interface
D(i) = Space$(iLevel*N) + D(i)
ElseIf Left$(temp$,7) = "method" And Right$(temp$,10) = "end method" Then
'Tests for: Method ... End Method
D(i) = Space$(iLevel*N) + D(i)
ElseIf Left$(temp$,10) = "property " And Right$(temp$,12) = "end property" Then
'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 macro" Then
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)) = "else" Then
iLevel = IFLevel(iIFLevel&)
D(i) = Space$(iLevel*N) + D(i)
Incr iLevel
ElseIf LCase$(Left$(D(i),6)) = "end if" Then
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)) = "catch" Then
iLevel = TryLevel(iTryLevel&)
D(i) = Space$(iLevel*N) + D(i)
Incr iLevel
ElseIf LCase$(Left$(D(i),7)) = "finally" Then
iLevel = TryLevel(iTryLevel&)
D(i) = Space$(iLevel*N) + D(i)
Incr iLevel
ElseIf LCase$(Left$(D(i),7)) = "end try" Then
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 select" Then
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)) = "wend" Then
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 interface" Then
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 property" Then
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 method" Then
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 String) As 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
http://www.garybeene.com/sw/gbsnippets.htm