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.s RFind(String$, TrimChar$ = #CRLF$)

Global flgOpn, InputFile$, OutputFile$, *Buffer, Length, NotSuccess

Procedure Callback(*Position, Length, Color)
	Protected tmp$, tmp2$, *c.Ascii
	
	If Color = #SYNTAX_Comment
		*c = *Position - SizeOf(Ascii)
; if there is no line break before the comment, then insert a line break
; i.e. comments that do not start at the beginning of the line
		If *c\a <> 10 And *c\a <> 13
			WriteStringN(#Output, "")
		EndIf
	Else
		WriteData(#Output, *Position, Length)
	EndIf
EndProcedure

If OpenLibrary(#Dll, #PB_Compiler_Home + "SDK\Syntax Highlighting\SyntaxHighlighting.dll")
	
; 	Adding command line options to use as a tool
	If CountProgramParameters()
		InputFile$ = ProgramParameter(0)
		If Not (Asc(InputFile$) And FileSize(InputFile$) > 3 And Left(GetExtensionPart(InputFile$), 2) = "pb")
			InputFile$ = ""
		EndIf
	EndIf
	
	If Not Asc(InputFile$)
		InputFile$ = OpenFileRequester("Select PB File", "", "*.pb*|*.pb*|All Files|*.*", 0)
	EndIf
	
	If Asc(InputFile$)
		OutputFile$ = GetPathPart(InputFile$) + GetFilePart(InputFile$, #PB_FileSystem_NoExtension) + "_no_comment." + GetExtensionPart(InputFile$)
		If MessageRequester("Overwrite?", "Overwrite current file? (otherwise to a file with _no_comment suffix)",
		                    #PB_MessageRequester_YesNo) = #PB_MessageRequester_No
			flgOpn = 1
		EndIf

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

			If *Buffer
				ReadData(#Input, *Buffer, Length)

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

			CloseFile(#Input)
			CloseFile(#Output)
		EndIf

	EndIf

	CloseLibrary(#Dll)
	
	If flgOpn
		RunProgram(OutputFile$)
	Else
		If DeleteFile(InputFile$)
			If Not RenameFile(OutputFile$, InputFile$)
				NotSuccess = 1
			EndIf
		EndIf
		If NotSuccess
			MessageRequester("", "Failed to update file")
		EndIf
	EndIf
Else
	MessageRequester("", "Failed to open SyntaxHighlighting.dll")
	End
EndIf

Code: Select all

; AZJIO
; https://www.purebasic.fr/english/viewtopic.php?p=574791#p574791
; https://www.purebasic.fr/english/viewtopic.php?t=80000

EnableExplicit

; AZJIO (вариант из AutoIt3, а по ссылке есть упрощённые варианты)
; https://www.purebasic.fr/english/viewtopic.php?t=80994
Procedure.s TmpFile(DirName$ = "", Prefix$ = "~", Ext$ = ".tmp", RandomLength = 7)
    Protected TmpName$

    If RandomLength < 4 Or RandomLength > 130
        RandomLength = 7
    EndIf
    If Not Asc(DirName$) Or FileSize(DirName$) = -1
        DirName$ = GetTemporaryDirectory()
    EndIf

    If Not CheckFilename(Prefix$)
        Prefix$ = "~"
    EndIf
    If Not CheckFilename(Ext$)
        Ext$ = ".tmp"
    EndIf

    If Right(DirName$, 1) <> #PS$
        DirName$ + #PS$
    EndIf
    If Asc(Ext$) And Left(Ext$, 1) <> "."
        Ext$ = "." + Ext$
    EndIf

    Repeat
        TmpName$ = ""
        While Len(TmpName$) < RandomLength
            TmpName$ + Chr(Random(122, 97))
        Wend
        TmpName$ = DirName$ + Prefix$ + TmpName$ + Ext$
    Until FileSize(TmpName$) = -1

    ProcedureReturn TmpName$
EndProcedure


; https://www.purebasic.fr/english/viewtopic.php?t=79183
Procedure.s RTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
    Protected Len2, Blen, i
    Protected *jc0, *c.Character, *jc.Character

    Len2 = Len(String$)
    Blen = StringByteLength(String$)

    If Not Asc(String$)
        ProcedureReturn ""
    EndIf

    *c = @String$ + Blen - SizeOf(Character)
    *jc0 = @TrimChar$

    For i = Len2 To 1 Step - 1
        *jc = *jc0

        While *jc\c
            If *c\c = *jc\c
                *c\c = 0
                Break
            EndIf
            *jc + SizeOf(Character)
        Wend

        If *c\c
            Break
        EndIf
        *c - SizeOf(Character)
    Next

    ProcedureReturn String$
EndProcedure



Procedure GetString(InputFile$, OutputFile$)
	Protected flgOpnQt, c, tilda, NotSkipLine
	Protected id_file, id_file2, Format, Text$, *c.Character, *c0
	; 	MessageRequester("", InputFile$)
	
	id_file = ReadFile(#PB_Any, InputFile$)
	If Not IsFile(id_file)
		MessageRequester("Error", "Error opening source file" + #CRLF$ + #CRLF$ + InputFile$)
		ProcedureReturn 
	EndIf
	
	id_file2 = CreateFile(#PB_Any, OutputFile$)
	If Not IsFile(id_file2)
		CloseFile(id_file)
		MessageRequester("Error", "Error creating file" + #CRLF$ + #CRLF$ + OutputFile$)
		ProcedureReturn 
	EndIf
	
	If id_file And id_file2
		Format = ReadStringFormat(id_file)
		WriteStringFormat(id_file2, #PB_UTF8)
		While Not Eof(id_file)
			Text$ = ReadString(id_file, Format) ; читаем построчно, так легче анализировать
			NotSkipLine = 1
; 			Debug Text$
			*c = @Text$
			*c0 = *c
			flgOpnQt = 0 ; сбросили флаг
; 			flgSemicolon = 0 ; сбросили флаг
			While *c\c
				Select *c\c
					Case '!' ; если ASM код, то тупо пропускаем эту строку
						If flgOpnQt = 0 ; если кавычка не открыта, то
							Break
						EndIf
						
					Case 39 ; ' ' апостроф
						If flgOpnQt = 0 ; если кавычка не открыта, то
							*c + SizeOf(Character)
							If *c\c = 0 : Break : EndIf
							If *c\c = 39
								*c + SizeOf(Character)
								Continue
							EndIf
							Repeat
								*c + SizeOf(Character)
							Until *c\c = 0 Or *c\c = 39 ; идём до конца строки или до заканчивающегося апострофа
							If *c\c = 0 : Break : EndIf ; выпрыг, если конец строки или апостроф в ненадлежащем месте.
						EndIf
						
					Case '"'
						If tilda
							Select tilda
								Case 1, 3
									tilda = 2
									*c + SizeOf(Character)
									Continue
								Case 2
									; пришли к завершающей кавычке и срабатывает ниже условие flgOpnQt, так как нет Continue по тексту
									tilda = 0
							EndSelect
						EndIf
						
; 						Debug flgOpnQt

						If flgOpnQt
; 							Попалась последняя кавычка, закрывающая
							flgOpnQt = 0
						Else
; 							Попалась первая кавычка, открывающая
							flgOpnQt = 1
						EndIf
					Case '\'
						; 						этот механизм чисто для проверки экранированных кавычек после тильды
; 						двойная проверка флагов изменяет поведение при дублировании кавычки
						Select tilda
							Case 2
								tilda = 3
							Case 3
								tilda = 2
						EndSelect
					Case ';'
						; 					Debug "комент, если нет открытой кавычки"
						If flgOpnQt = 0 ; если нет открытой кавычки, значит пошли комментарии до конца строки
							Text$ = Left(Text$, (*c - *c0) / 2)
							Text$ = RTrimChar(Text$, #TAB$ + " ") ; убираем табы и пробелы в конце строки
							If Not Asc(Text$)
								NotSkipLine = 0 ; флаг позволяющий при удалении комментариев удалять и строку, если она стала пуста
							EndIf
							Break
						EndIf
					Case '~'
						If flgOpnQt = 0 ; если комментарий не открыт, то начинаем считать что открылись тильда-данные
							flgOpnQt = 1 ; режим открытия кавычки, начинаем ждать закрывающую (кроме начальной и экранированных)
							tilda = 1 ; включаем флаг запуска тильды
						EndIf
				EndSelect
				*c + SizeOf(Character)
			Wend
			If NotSkipLine
				WriteStringN(id_file2, Text$) 
			EndIf
		Wend
		CloseFile(id_file)
		CloseFile(id_file2)
	EndIf
	
; 	If IsFile(id_file)
; 		CloseFile(id_file)
; 	EndIf
; 	If IsFile(id_file2)
; 		CloseFile(id_file2)
; 	EndIf
	
EndProcedure

Global Start, InputFile$, OutputFile$, Rewrite, NotSuccess


; 	Добавляем параметоры ком строки чтобы использовать как инструмент
If CountProgramParameters()
	InputFile$ = ProgramParameter(0)
	If Not (Asc(InputFile$) And FileSize(InputFile$) > 3 And Left(GetExtensionPart(InputFile$), 2) = "pb")
		InputFile$ = ""
	EndIf
EndIf

If Not Asc(InputFile$)
	InputFile$ = OpenFileRequester("Select PB File", "", "*.pb*|*.pb*|All Files|*.*", 0)
EndIf

If Asc(InputFile$)
	If MessageRequester("Overwrite?", "Overwrite current file? (otherwise to a file with _no_comment suffix)",
	                    #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
		OutputFile$ = TmpFile()
		Rewrite = 1
	Else
		Start = 1
		OutputFile$ = GetPathPart(InputFile$) + GetFilePart(InputFile$, #PB_FileSystem_NoExtension) + "_no_comment." + GetExtensionPart(InputFile$)
	EndIf

	GetString(InputFile$, OutputFile$)
	
	If Start
		RunProgram(OutputFile$)
	Else
		If DeleteFile(InputFile$)
			If Not RenameFile(OutputFile$, InputFile$)
				NotSuccess = 1
			EndIf
		EndIf
		If NotSuccess
			MessageRequester("", "Failed to update file")
		EndIf
	EndIf
	
; 	If Rewrite
; 		CopyFile(OutputFile$, InputFile$)
; 	EndIf
; 	If Start
; 		RunProgram(OutputFile$)
; 	EndIf
	
EndIf