PureBasic Forums - English

Code: Select all

EnableExplicit

Enumeration
	#SYNTAX_Text
	#SYNTAX_Keyword
	#SYNTAX_Comment
	#SYNTAX_Constant
	#SYNTAX_String
	#SYNTAX_Function
	#SYNTAX_Asm
	#SYNTAX_Operator
	#SYNTAX_Structure
	#SYNTAX_Number
	#SYNTAX_Pointer
	#SYNTAX_Separator
	#SYNTAX_Label
	#SYNTAX_Module
EndEnumeration

#Dll = 0
#Input = 0
#Output = 1

Declare RegexReplace2(RgEx, *Result.string, Replace0$, Escaped = 0)

Global res$, old$
Global InputFile$, OutputFile$, *Buffer, Length, tmp$

Global RegExp, RegExp2, RegExp3
RegExp = CreateRegularExpression(#PB_Any, "\A(.*?)\h{2,}+\z",  #PB_RegularExpression_NoCase)
If Not RegExp
	Debug RegularExpressionError()
	End
EndIf
RegExp2 = CreateRegularExpression(#PB_Any, "\A\h{2,}(.*?)\z",  #PB_RegularExpression_NoCase)
If Not RegExp2
    Debug RegularExpressionError()
	End
EndIf
; RegExp3 = CreateRegularExpression(#PB_Any, "(?<=[\r\n])\h+",  #PB_RegularExpression_NoCase)
RegExp3 = CreateRegularExpression(#PB_Any, "\h+(?=[\r\n])",  #PB_RegularExpression_NoCase)
If Not RegExp3
    Debug RegularExpressionError()
	End
EndIf
; RegExp4 = CreateRegularExpression(#PB_Any, "[\r\n]",  #PB_RegularExpression_NoCase)

Procedure.s Strip(*Text.string, NotNewStr)
; 	If RegExp ; do not check regexps as they are now stable
	RegexReplace2(RegExp, *Text, "\1 ") ; remove spaces on the right
; 	EndIf
; 	If RegExp2 And NotNewStr
	If NotNewStr
		RegexReplace2(RegExp2, *Text, " \1") ; remove spaces on the left
	EndIf
EndProcedure



Procedure Callback(*Position, Length, Color)
	Protected Text.string, NotNewStr
	Text\s = PeekS(*Position, Length, #PB_UTF8 | #PB_ByteLength)
	Select Color
; 		Case #SYNTAX_Text
		Case 0 To 13
			; res$ + "<" + Text\s + ">" ; check how the code is captured
			old$ = Right(old$, 1)
			If old$ = Chr(10) Or old$ = Chr(13) ; если предыдущий был с переносом строк, то не удаляем отступы справа
				NotNewStr = 0
			Else
				NotNewStr = 1
			EndIf
			Strip(@Text, NotNewStr)
			res$ + Text\s
			old$ = Text\s
	EndSelect

EndProcedure


If OpenLibrary(#Dll, #PB_Compiler_Home + "SDK\Syntax Highlighting\SyntaxHighlighting.dll")
	; If OpenLibrary(#Dll, GetPathPart(ProgramFilename()) + "SyntaxHighlighting.dll")

	InputFile$ = OpenFileRequester("Select PB File", "", "*.pb*|*.pb*|All Files|*.*", 0)
; 	InputFile$ = "C:\Source\2022.10\test.pb"
	If InputFile$

		If ReadFile(#Input, InputFile$) ; And CreateFile(#Output, OutputFile$)
			Length = Lof(#Input)
			*Buffer = AllocateMemory(Length)

			If *Buffer
				ReadData(#Input, *Buffer, Length) ; read the source
				
; 				Remove spaces at the end of lines
				tmp$ = PeekS(*Buffer, -1, #PB_UTF8)
; 				Debug Len(tmp$)
				tmp$ = ReplaceRegularExpression(RegExp3, tmp$, "")
; 				Debug Len(tmp$)
; 				Debug Len(tmp$) - Len1
				Length = StringByteLength(tmp$, #PB_UTF8)
				PokeS(*Buffer, tmp$, Length, #PB_UTF8)

				CallFunction(#Dll, "SyntaxHighlight", *Buffer, Length, @Callback(), 0)
				
				FreeMemory(*Buffer)

			EndIf

			CloseFile(#Input)
; 			CloseFile(#Output)
		EndIf

	EndIf

	CloseLibrary(#Dll)
Else
	MessageRequester("", "Failed to open SyntaxHighlighting.dll")
	End
EndIf


tmp$ = SaveFileRequester("", "",  "*.pb*|*.pb*|All Files|*.*", 0)
If Asc(tmp$)
	If CreateFile(#Output,tmp$)
; 		WriteStringFormat(#Output, #PB_UTF8)
		WriteString(#Output, res$, #PB_UTF8)
		CloseFile(#Output)
	EndIf
EndIf

FreeRegularExpression(#PB_All)




Structure ReplaceGr
  pos.i
  ngr.i
  group.s
EndStructure

; https://www.purebasic.fr/english/viewtopic.php?p=575871
Procedure RegexReplace2(RgEx, *Result.string, Replace0$, Escaped = 0)
	Protected i, CountGr, Pos, Offset = 1
	Protected Replace$
	Protected NewList item.s()
	Protected LenT, *Point
; 	Static RE2
; 	Static RE3
	Protected RE2
	Protected NewList ReplaceGr.ReplaceGr()

	CountGr = CountRegularExpressionGroups(RgEx)
	; ограничение групп, только обратные ссылки \1 .. \9
	If CountGr > 9
		CountGr = 9
	EndIf

	If ExamineRegularExpression(RgEx, *Result\s)
		
		; Поиск Esc-символов в поле замены регвыр (с учётом регистра)
		If Escaped
			Replace0$ = ReplaceString(Replace0$, "\r", #CR$)
			Replace0$ = ReplaceString(Replace0$, "\n", #LF$)
			Replace0$ = ReplaceString(Replace0$, "\t", #TAB$)
			Replace0$ = ReplaceString(Replace0$, "\f", #FF$)
		EndIf
		
		; Поиск ссылок на группы в поле замены регвыр
		RE2 = CreateRegularExpression(#PB_Any, "\\\d")
		If RE2
			If ExamineRegularExpression(RE2, Replace0$)
				While NextRegularExpressionMatch(RE2)
					If AddElement(ReplaceGr())
						ReplaceGr()\pos = RegularExpressionMatchPosition(RE2) ; позиция
						ReplaceGr()\ngr = ValD(Right(RegularExpressionMatchString(RE2), 1)) ; номер группы
						ReplaceGr()\group = RegularExpressionMatchString(RE2) ; текст группы
					EndIf
				Wend
			EndIf
			FreeRegularExpression(RE2) ; убрать строку при Static
		EndIf
		If Not ListSize(ReplaceGr())
			*Result\s = ReplaceRegularExpression(RgEx, *Result\s, Replace0$)
			ProcedureReturn
		EndIf
; 		Сортировка по позиции, чтобы делать замены с конца и не нарушались ранее найденные позиции
		SortStructuredList(ReplaceGr(), #PB_Sort_Descending, OffsetOf(ReplaceGr\pos), TypeOf(ReplaceGr\pos))

		While NextRegularExpressionMatch(RgEx)
			Pos = RegularExpressionMatchPosition(RgEx)
			Replace$ = Replace0$

			ForEach ReplaceGr()
				If ReplaceGr()\ngr
					Replace$ = ReplaceString(Replace$, ReplaceGr()\group, RegularExpressionGroup(RgEx, ReplaceGr()\ngr), #PB_String_CaseSensitive, ReplaceGr()\pos, 1)
				Else
					Replace$ = ReplaceString(Replace$, ReplaceGr()\group, RegularExpressionMatchString(RgEx), #PB_String_CaseSensitive, ReplaceGr()\pos, 1) ; обратная ссылка \0
				EndIf
			Next
			; item() = часть строки между началом и первым совпадением или между двумя совпадениями + результат подстановки групп
			
			If AddElement(item())
				item() = Mid(*Result\s, Offset, Pos - Offset) + Replace$
			EndIf
			Offset = Pos + RegularExpressionMatchLength(RgEx)
		Wend
		If AddElement(item())
			item() = Mid(*Result\s, Offset)
		EndIf
		
		; Формирования текстового списка
		; Debug "Count = " + Str(ListSize(item()))
; 		Count = ListSize(item())
		LenT = 0
		ForEach item()
			LenT + Len(item()) ; вычисляем длину данных для  вмещения частей текста
		Next
		
		*Result\s = Space(LenT) ; создаём строку забивая её пробелами
		*Point = @*Result\s	   ; Получаем адрес строки
		ForEach item()
			CopyMemoryString(item(), @*Point) ; копируем очередной путь в указатель
		Next
		; Конец => Формирования текстового списка

		FreeList(item()) ; удаляем список, хотя в функции наверно это не требуется
	EndIf
EndProcedure

Code: Select all

Step -1
Step - 1 ; wrong
SortOrder = -SortOrder
SortOrder = - SortOrder ; wrong

Code: Select all

var = 4
var = -var
Debug var

var = 4
var = - var ; wrong
Debug var
Debug "---"

For i = 5 To 0 Step - 1
	Debug i
Next