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
118
'ОПИСАНИЕ
'Запись точек после команд синтаксиса SPSS.

'Откройте синтаксис в окне редактора синтаксиса и запустите этот скрипт, чтобы вставить
'символы конца команд (точки) в соответствии с правилами "производственного" режима SPSS (Production mode)

'Может поддерживать текст синтаксиса в форматах Unix или Mac
'(соответственно, новые строки начинаются либо со спецсивола LF, либо с CR)
'Удаляет концевые пробелы и конвертирует текст в формат DOS, если он представлен в другом формате

'Автор: John Hendrickx <J.Hendrickx@maw.kun.nl>
'Дата: 22.09.1998

'КОНЕЦ ОПИСАНИЯ

Sub Main
	'Ищем окно синтаксиса
	Dim objDocuments As ISpssDocuments
	Dim objSyntaxDoc As ISpssSyntaxDoc
	Set objDocuments = objSpssApp.Documents
	Dim inCount As Integer
	intCount = objDocuments.SyntaxDocCount

	'Привязываемся и отображаем текущее окно синтаксиса:
	If intCount <> 0 Then
		Set objSyntaxDoc = objSpssApp.GetDesignatedSyntaxDoc
		objSyntaxDoc.Visible = True
	Else
		'Если не нашли открытых окон синтаксиса
		MsgBox( "Открытого окна синтаксиса не найдено." )
		Exit Sub
	End If
	
	'Считываем синтаксис
	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)

	'проверяем, составлен ли синтаксис в формате Unix
	If CurrLineEnd=0 Then
		NextLineEnd=InStr(SyntaxCode,vbLf)
		If NextLineEnd<>0 Then
			LineEnd=vbLf
			LineEndLength=1
			CurrLineEnd=NextLineEnd
		End If
	End If

	'проверяем, составлен ли синтаксис в формате Macintosh
	If CurrLineEnd=0 Then
		NextLineEnd=InStr(SyntaxCode,vbCr)
		If NextLineEnd<>0 Then
			LineEnd=vbCr
			LineEndLength=1
			CurrLineEnd=NextLineEnd
		End If
	End If

	'если не найдено символов перевода строки, синтаксис, повидимому, одностроковый
	If CurrLineEnd=0 Then
		CurrLineEnd=Len(SyntaxCode)+1
	End If
	
	'добавим пустую строку для цикла While
	SyntaxCode=RTrim(SyntaxCode) & LineEnd & LineEnd

	CurrLine=RTrim(Left(SyntaxCode,CurrLineEnd-1))
	'Пробегаем по синтаксиса строка за строкой и добавляем в конце строки точку,
	'если следующая строка начинается в первом столбце, либо является пустой,
	'учитывая возможные комментарии
	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
				'Проверяем наличия комментария
				PosComment=InStr(CurrLine,"/*")
				If PosComment<=1 Then 
					Point=Len(CurrLine)
				Else 
					Point=Len(RTrim(Left(CurrLine,PosComment-1)))
				End If

				'Завершаем строку точкой, если этого ещё не сделано
				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
	
	'Заменяем старый синтаксис новым
	objSyntaxDoc.Text=NewCode
	'Hasta la vista, Baby!
 End Sub