1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
'Begin Description
'Terminates commands of an SPSS syntax file with a period

'Open a syntax window and run this script to terminate commands
'according to SPSS production mode syntax rules

'Should be able to handle Unix or Mac format syntax files
'(Newlines separated by a LF or CR respectively)
'Trims trailing blanks and converts to DOS format if not already the case

'John Hendrickx <J.Hendrickx@maw.kun.nl>
'22-9-98
'End Description

Sub Main
	'Find the syntax window
	Dim objDocuments As ISpssDocuments
	Dim objSyntaxDoc As ISpssSyntaxDoc
	Set objDocuments = objSpssApp.Documents
	Dim inCount As Integer
	intCount = objDocuments.SyntaxDocCount

	'Get and display the designated syntax document:
	If intCount <> 0 Then
		Set objSyntaxDoc = objSpssApp.GetDesignatedSyntaxDoc
		objSyntaxDoc.Visible = True
	Else
		'No syntax documents open
		MsgBox( "No syntax document found." )
		Exit Sub
	End If
	
	'Get the syntax
	Dim SyntaxCode As String
	SyntaxCode=RTrim(objSyntaxDoc.Text)
	
	Dim LineEnd As String
	Dim LineEndLength As Integer
	Dim CurrLine As String
	Dim NextLine As String
	Dim CurrLineEnd As Long
	Dim NextLineEnd As Long
	Dim Pending As Boolean
	Dim PosComment As Integer
	Dim Point As Integer
	Dim NewCode As String
				
	Pending=False
	LineEnd=vbCrLf
	LineEndLength=2
	CurrLineEnd=InStr(SyntaxCode,LineEnd)

	'check if syntax is Unix format
	If CurrLineEnd=0 Then
		NextLineEnd=InStr(SyntaxCode,vbLf)
		If NextLineEnd<>0 Then
			LineEnd=vbLf
			LineEndLength=1
			CurrLineEnd=NextLineEnd
		End If
	End If

	'check if syntax is Macintosh format
	If CurrLineEnd=0 Then
		NextLineEnd=InStr(SyntaxCode,vbCr)
		If NextLineEnd<>0 Then
			LineEnd=vbCr
			LineEndLength=1
			CurrLineEnd=NextLineEnd
		End If
	End If

	'if there are no newline characters, the syntax must be a one-liner
	If CurrLineEnd=0 Then
		CurrLineEnd=Len(SyntaxCode)+1
	End If
	
	'add an empty line for the while loop
	SyntaxCode=RTrim(SyntaxCode) & LineEnd & LineEnd

	CurrLine=RTrim(Left(SyntaxCode,CurrLineEnd-1))
	'Run through the syntax line by line and add a period
	'if the next line starts in column 1 or is empty,
	'taking inline comments into account
	While NextLineEnd<=Len(SyntaxCode)-LineEndLength
		NextLineEnd=InStr(CurrLineEnd+LineEndLength,SyntaxCode,LineEnd)
		NextLine=RTrim(Mid(SyntaxCode,CurrLineEnd+LineEndLength,NextLineEnd-CurrLineEnd-LineEndLength))

		If (Left(CurrLine,1)<>" " Or Pending) And Len(Currline)>0 Then
			If Left(NextLine,1)<>" " Or Len(NextLine)=0 Then
				'Check for inline comments 
				PosComment=InStr(CurrLine,"/*")
				If PosComment<=1 Then 
					Point=Len(CurrLine)
				Else 
					Point=Len(RTrim(Left(CurrLine,PosComment-1)))
				End If

				'Terminate line if not already so
				If Mid(CurrLine,Point,1)<>"."  Then
					CurrLine=Left(CurrLine,Point) & "." & Mid(CurrLine,Point+1)
				End If
				Pending=False
			Else
				Pending=True
			End If
		End If

		NewCode=NewCode & CurrLine & vbCrLf
		CurrLineEnd=NextLineEnd
		CurrLine=NextLine
	Wend
	
	'Replace the old syntax with the new
	objSyntaxDoc.Text=NewCode
	'Hasta la vista, Baby!
 End Sub