[IDE tool] Generate procedure local variables

Everything else that doesn't fall into one of the other PB categories.
AZJIO
Addict
Addict
Posts: 2154
Joined: Sun May 14, 2017 1:48 am

[IDE tool] Generate procedure local variables

Post by AZJIO »

First try.
1. Select the procedure in the source code and press Ctrl+C
2. The tool will find all variables in the procedure body and exclude from them those declared in the procedure parameters.
3. The finished string will be pasted into the clipboard. Now you can press Ctrl+V on the second empty line of the procedure.

That is, you do not have to manually copy all the variable names. You won't get an undeclared variable error every time you run it using EnableExplicit.

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

Global NewMap Var.s()
Global Buffer$, Buffer2$, Length, NotSuccess, *Buffer, Pos, Pos2, flgAdd


Declare.s LTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
Declare.s RTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")

Procedure Callback(*Position, Length, Color)
	Protected token$
	; 	Debug 2
	Select Color
		Case #SYNTAX_Text, #SYNTAX_Pointer
			token$ = PeekS(*Position, Length, #PB_Ascii)
			token$ = LTrimChar(token$, #TAB$ + " ")
			token$ = RTrimChar(token$, #CRLF$ + #TAB$ + " ")
			; 			AddMapElement(LCase(token$))
			If flgAdd
				Var(LCase(token$)) = ""
			Else
				Var(LCase(token$)) = token$
 		   EndIf
; 			Debug "|" + token$ + "|"; + Str(*Position)
	EndSelect
EndProcedure

If OpenLibrary(#Dll, #PB_Compiler_Home + "SDK\Syntax Highlighting\SyntaxHighlighting.dll")
; 	MessageRequester("", #PB_Compiler_Home + "SDK\Syntax Highlighting\SyntaxHighlighting.dll")
	
	Buffer$ = GetClipboardText()
	Pos = FindString(Buffer$, "Procedure", 1, #PB_String_NoCase)
	If Pos
		Pos2 = FindString(Buffer$, #LF$, Pos + 9)
		If Pos
			Buffer2$ = Mid(Buffer$, Pos, Pos2 - Pos)
; 			Debug Buffer2$
	    EndIf
    EndIf
	*Buffer = UTF8(Buffer$)
	Length = MemorySize(*Buffer)
	CallFunction(#Dll, "SyntaxHighlight", *Buffer, Length, @Callback(), 0)
	FreeMemory(*Buffer)
	If Asc(Buffer2$)
		flgAdd = 1
		*Buffer = UTF8(Buffer2$)
		Length = MemorySize(*Buffer)
		CallFunction(#Dll, "SyntaxHighlight", *Buffer, Length, @Callback(), 0)
		FreeMemory(*Buffer)
    EndIf
	CloseLibrary(#Dll)
	Buffer$ = "Protected "
	ForEach Var()
		If Asc(Var())
			Buffer$ + Var() + ", "
	    EndIf
	Next
	Buffer$ = Left(Buffer$, Len(Buffer$) - 2)
	Debug Buffer$
	SetClipboardText(Buffer$)
EndIf



Procedure.s LTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
    Protected *jc0, *c.Character, *jc.Character

    If Not Asc(String$)
        ProcedureReturn ""
    EndIf

    *c = @String$
    *jc0 = @TrimChar$

    While *c\c
        *jc = *jc0

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

        If *c\c
            String$ = PeekS(*c)
            Break
        EndIf
        *c + SizeOf(Character)
    Wend

    ProcedureReturn String$
EndProcedure

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
AZJIO
Addict
Addict
Posts: 2154
Joined: Sun May 14, 2017 1:48 am

Re: [IDE tool] Generate procedure local variables

Post by AZJIO »

Now you don't need to press Ctrl+C, the text is copied using the GetScintillaRangeText() function.
DLL path is now retrieved from PB_TOOL_IDE.

get_local.pb

Code: Select all

EnableExplicit

XIncludeFile "forlocal.pb"

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

Global NewMap Var.s()
Global Buffer$, Buffer2$, Length, NotSuccess, *Buffer, Pos, Pos2, flgAdd

Global PbIdeHandle, ScintillaHandle, Selected$, PathDLL$
Define d, scope$


; For test only
CompilerIf #PB_Compiler_Debugger
Global classText.s = Space(256)
; Finding a PureBasic Window
Procedure.l enumChildren0(hwnd.l)
	If hwnd
		GetClassName_(hwnd, @classText, 256)
		If classText = "WindowClass_2"
			GetWindowText_(hwnd, @classText, 256)
			If Left(classText, 9) = "PureBasic"
				PbIdeHandle = hwnd
				ProcedureReturn 0
			EndIf
		EndIf
		ProcedureReturn 1
	EndIf
	ProcedureReturn 0
EndProcedure

; Finding the Scintilla
Procedure.l enumChildren1(hwnd.l)
	If hwnd
		GetClassName_(hwnd, @classText, 256)
		If classText = "Scintilla"
			ScintillaHandle = hwnd
			ProcedureReturn 0
		EndIf
		ProcedureReturn 1
	EndIf
	ProcedureReturn 0
EndProcedure
CompilerEndIf
; End: For test only

Procedure Initialization()
	Protected LenSelText, Cursor, Anchor, tmp

	; For test only
	CompilerIf #PB_Compiler_Debugger
		EnumChildWindows_(0, @enumChildren0(), 0)
		EnumChildWindows_(PbIdeHandle, @enumChildren1(), 0)
		PathDLL$ = #PB_Compiler_Home + "SDK\Syntax Highlighting\SyntaxHighlighting.dll"
	CompilerElse
		ScintillaHandle = Val(GetEnvironmentVariable("PB_TOOL_Scintilla"))
		If ScintillaHandle = 0 : End : EndIf

		PathDLL$ = GetPathPart(GetEnvironmentVariable("PB_TOOL_IDE")) + "SDK\Syntax Highlighting\SyntaxHighlighting.dll"
		If FileSize(PathDLL$) < 1 : End : EndIf
	CompilerEndIf
	; End: For test only
	Debug PathDLL$

	Anchor = SendMessage_(ScintillaHandle, #SCI_GETANCHOR, 0, 0)
	Cursor = SendMessage_(ScintillaHandle, #SCI_GETCURRENTPOS, 0, 0)
	If Anchor < Cursor
		Cursor = Anchor
	EndIf
	LenSelText = SendMessage_(ScintillaHandle, #SCI_GETSELTEXT, 0, 0)

	Selected$ = GetScintillaRangeText(ScintillaHandle, Cursor, LenSelText)
	Debug LenSelText
	Debug Anchor - Cursor
	; Debug Selected$
EndProcedure

Procedure Callback(*Position, Length, Color)
	Protected token$
	; Debug 2
	Select Color
		Case #SYNTAX_Text, #SYNTAX_Pointer
			token$ = PeekS(*Position, Length, #PB_Ascii)
			token$ = LTrimChar(token$, #TAB$ + " ")
			token$ = RTrimChar(token$, #CRLF$ + #TAB$ + " ")
; 			If Asc(token$) = '@'
; ; 				token$ = LTrim(token$, "@")
; 				token$ = ""
; 			EndIf
			If Asc(token$) <> '@'
				; переменные не учитывают регистр поэтому LCase
				; AddMapElement(LCase(token$))
				If flgAdd ; флаг что найдены переданные в процедуру переменные и их надо обнулить, не добавляя в локальные для Protected
					Var(LCase(token$)) = ""
				Else
					Var(LCase(token$)) = token$
				EndIf
				; Debug "|" + token$ + "|"; + Str(*Position)
			EndIf
			
	EndSelect
EndProcedure

Initialization()

If Not OpenLibrary(#Dll, PathDLL$)
	MessageRequester("", "SyntaxHighlighting.dll not found")
	End
EndIf

; 	MessageRequester("", PathDLL$)


; 	Selected$ = GetClipboardText()
; 	MessageRequester("", Selected$)
Pos = FindString(Selected$, "Procedure", 1, #PB_String_NoCase)
If Pos
	Pos2 = FindString(Selected$, #LF$, Pos + 9)
	If Pos
		Buffer2$ = Mid(Selected$, Pos, Pos2 - Pos)
		; Debug Buffer2$
	EndIf
EndIf
*Buffer = UTF8(Selected$)
Length = MemorySize(*Buffer)
CallFunction(#Dll, "SyntaxHighlight", *Buffer, Length, @Callback(), 0)
FreeMemory(*Buffer)
If Asc(Buffer2$)
	flgAdd = 1
	*Buffer = UTF8(Buffer2$)
	Length = MemorySize(*Buffer)
	CallFunction(#Dll, "SyntaxHighlight", *Buffer, Length, @Callback(), 0)
	FreeMemory(*Buffer)
EndIf
CloseLibrary(#Dll)

If flgAdd
	scope$ = #TAB$ + "Protected "
Else
	scope$ = "Define "
EndIf

Selected$ = #CRLF$ + scope$
ForEach Var()
	If Asc(Var())
		d + 1
		If d > 10; And Len(Selected$) > 100 ; если 8 переменных то делаем новую строку
			d = 0
			Selected$ = Left(Selected$, Len(Selected$) - 2) + #CRLF$ + scope$
		EndIf
		Selected$ + Var() + ", "
	EndIf
Next
Selected$ = Left(Selected$, Len(Selected$) - 2)
Debug Selected$
SetClipboardText(Selected$)
forlocal.pb

Code: Select all

Procedure.s GetScintillaRangeText(ScintillaHandle, cursor, length)
	Protected String$
; 	Protected length
	Protected *mem
	Protected PID
	Protected hProcess
	Protected *pointer

	If length
		*mem = AllocateMemory(length + 2)
		If *mem
; 			высылаем сообщение ScintillaHandle, чтобы получить указатель (в *pointer) на позицию где находится "курсор"
			SendMessageTimeout_(ScintillaHandle, #SCI_GETRANGEPOINTER, cursor, 0, #SMTO_ABORTIFHUNG, 2000, @*pointer)
			If *pointer ; если указатель получен, то
				GetWindowThreadProcessId_(ScintillaHandle, @PID) ; получаем идентификатор процесса ScintillaHandle
				hProcess = OpenProcess_(#PROCESS_VM_READ | #SYNCHRONIZE, #False, PID) ; запрашиваем доступ к процессу и получаем декскриптор
				If hProcess ; если дескриптор получен, то
					; читаем память процесса по указателю *pointer в выделенную память *mem с заказанной длинной
					ReadProcessMemory_(hProcess, *pointer, *mem, length, 0)
					String$ = PeekS(*mem, -1, #PB_UTF8) ; а может тут стоит указать длину для чтения? Выделено на 2 байта больше чтобы -1
					CloseHandle_(hProcess)
				EndIf
			EndIf
			FreeMemory(*mem)
		EndIf
	EndIf
	ProcedureReturn String$
EndProcedure



Procedure.s LTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
	Protected *jc0, *c.Character, *jc.Character

	If Not Asc(String$)
		ProcedureReturn ""
	EndIf

	*c = @String$
	*jc0 = @TrimChar$

	While *c\c
		*jc = *jc0

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

		If *c\c
			String$ = PeekS(*c)
			Break
		EndIf
		*c + SizeOf(Character)
	Wend

	ProcedureReturn String$
EndProcedure

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
AZJIO
Addict
Addict
Posts: 2154
Joined: Sun May 14, 2017 1:48 am

Re: [IDE tool] Generate procedure local variables

Post by AZJIO »

For Linux (without SyntaxHighlighting.dll)
download

tool parameters:
%SELECTION "%TEMPFILE"

Code: Select all

EnableExplicit

#Empty = 1

Global Dim Proc$(0)
Global Dim Var$(0)
Global Dim StrVar$(0)
Global Dim DeclareVar$(0)
Global Dim VarPoint$(0)
Global NbProc, NbStrVar, NbDeclareVar, NbVar, NbVarPoint
Global NativeFunc$, KeyWord$
Global NewMap FuncExceptionMap.s()
Global NewMap KeyWordExceptionMap.s()
Global NewMap ResultMap.s()
; Global NewList ResultList.s()

Procedure.s ReadFileToVar(Path$)
	Protected id_file, Format, Text$

	id_file = ReadFile(#PB_Any, Path$)
	If id_file
		Format = ReadStringFormat(id_file)
		Text$ = ReadString(id_file, Format | #PB_File_IgnoreEOL)
		; Text$ = ReadString(id_file, #PB_UTF8 | #PB_File_IgnoreEOL)
		CloseFile(id_file)
	EndIf

	ProcedureReturn Text$
EndProcedure


Procedure.s StringProcessing(Text$)
	Protected tilda
	Protected *c.Character

	*c = @Text$
	While *c\c
		Select *c\c

			Case '!' ; если ASM код, то тупо пропускаем эту строку (строки в кавычках в ASM в виде псевдокода)
				*c\c = 0
				Break

			Case '\' ; элемент структуры
				*c\c = #Empty
				*c + SizeOf(Character)
				Repeat
					Select *c\c
						Case 'A' To 'Z', 'a' To 'z', '0' To '9', '_'
							*c\c = #Empty
							*c + SizeOf(Character)
						Default
							Break
					EndSelect
				Until *c\c = 0

			Case 39 ; ' апостроф
				*c\c = #Empty
				*c + SizeOf(Character)
				If *c\c = 0
					Break
				EndIf
				If *c\c = 39
					*c\c = #Empty
					*c + SizeOf(Character)
					Continue
				EndIf
				Repeat
					*c\c = #Empty
					*c + SizeOf(Character)
				Until *c\c = 0 Or *c\c = 39 ; идём до конца строки или до заканчивающегося апострофа
				If *c\c = 0
					Break
				EndIf	; выпрыг, если конец строки или апостроф в ненадлежащем месте.

			Case '"'
				Repeat
					*c\c = #Empty
					*c + SizeOf(Character)
				Until *c\c = 0 Or *c\c = '"' ; идём до конца строки или до заканчивающегося апострофа
				If *c\c = '"'
					*c\c = #Empty
				ElseIf *c\c = 0
					Break
				EndIf	; выпрыг, если конец строки или апостроф в ненадлежащем месте.

			Case ';'
				; Debug комент
				*c\c = 0
				Break ; если нет открытой кавычки, значит пошли комментарии до конца строки, поэтому выпрыгиваем и запрашиваем новую строку

			Case '~'
				tilda = 1 ; включаем флаг запуска/открытия тильды
				*c\c = #Empty
				*c + SizeOf(Character)
				While *c\c
					Select *c\c
						Case '"'
							Select tilda
								Case 1, 3
									tilda = 2
									*c\c = #Empty
									*c + SizeOf(Character)
									Continue
								Case 2
									; пришли к завершающей кавычке и срабатывает ниже условие flgOpnQt, так как нет Continue по тексту
									; tilda = 0
									*c\c = #Empty
									Break ; выпрыгиваем, чтобы не делать лишний сдвиг, мы прошли до закрывющей кавычки, сброс тильды не обязателен
							EndSelect
						Case '\'
							; этот механизм чисто для проверки экранированных кавычек после тильды
							; двойная проверка флагов изменяет поведение при дублировании кавычки
							Select tilda
								Case 2
									tilda = 3
								Case 3
									tilda = 2
							EndSelect
					EndSelect
					*c\c = #Empty
					*c + SizeOf(Character)
				Wend
			Case '+', '-', '/', '=', ',', ')'
				*c\c = #Empty
		EndSelect
		*c + SizeOf(Character)
	Wend
	ProcedureReturn Text$
EndProcedure


; Функция GetSelText() вызывается один раз, поэтому компиляция регулярных выражений не требуется глобальной
Procedure.s GetSelText()
	Protected Line2, Line1, Line, Format, String$, PathFile$, Text$, i, d
	Protected API, Constant, StrVar, Struct, Imports, Type, HNum, Proc, ProcClear, ModulesClear
	Protected DeclareVar, DeclareVarClear, Var, Num, VarPoint, ProcAll, CountScope, Macros, Modules
	Protected CountProc, Scope$

	If CountProgramParameters() < 2
		End
	EndIf
	; Selected$ = ProgramParameter(0)
	PathFile$ = ProgramParameter(1)
	; 11x22x33x44
	Line1 = Int(Val(StringField(ProgramParameter(0), 1, "x")))
	Line2 = Int(Val(StringField(ProgramParameter(0), 3, "x")))
	
; 	Принудительный тест и надо закомментировать CountProgramParameters()
; 	PathFile$ = "C:\D\PureBasic\Source\!My_projects\Tools\get_local\get_local_Linux.pb"
; 	Line1 = 10
; 	Line2 = 352

	; Добавляём процедуры текущего исходника в список исключений
	#File = 0
	If ReadFile(#File, PathFile$)
		Format = ReadStringFormat(#File)
		Text$ = ReadString(#File, Format | #PB_File_IgnoreEOL)
		CloseFile(#File)
		
		ProcAll = CreateRegularExpression(#PB_Any, "^\h*(?:Procedure[CDL$]{0,5}?(?:\h*\.[abcdfilqsuw])?\h+\K)[A-Za-z_]\w*(?=\h*\()", #PB_RegularExpression_MultiLine | #PB_RegularExpression_NoCase)
		If ProcAll
			If ExamineRegularExpression(ProcAll, Text$)
				While NextRegularExpressionMatch(ProcAll)
					If Not FindMapElement(FuncExceptionMap(), RegularExpressionMatchString(ProcAll))
						AddMapElement(FuncExceptionMap(), RegularExpressionMatchString(ProcAll))
					EndIf
				Wend
			EndIf
		EndIf
	EndIf
	; Конец захват процедур
	
	; Добавляём модуль::функции текущего исходника в список исключений
	Modules = CreateRegularExpression(#PB_Any, "::[A-Za-z_]\w*(?=\h*\()", #PB_RegularExpression_MultiLine | #PB_RegularExpression_NoCase)
	If Modules
		If ExamineRegularExpression(Modules, Text$)
			While NextRegularExpressionMatch(Modules)
				If Not FindMapElement(FuncExceptionMap(), RegularExpressionMatchString(Modules))
					AddMapElement(FuncExceptionMap(), RegularExpressionMatchString(Modules))
				EndIf
			Wend
		EndIf
	EndIf
	; Конец захват модуль::функции
	
	; Добавляём макросы текущего исходника в список исключений
	Macros = CreateRegularExpression(#PB_Any, "^\h*Macro\h+\K[A-Za-z_]\w*(?=\h*\()", #PB_RegularExpression_MultiLine | #PB_RegularExpression_NoCase)
	If Macros
		If ExamineRegularExpression(Macros, Text$)
			While NextRegularExpressionMatch(Macros)
				If Not FindMapElement(FuncExceptionMap(), RegularExpressionMatchString(Macros))
					AddMapElement(FuncExceptionMap(), RegularExpressionMatchString(Macros))
				EndIf
			Wend
		EndIf
	EndIf
	Text$ = ""
	; Конец захват макросов



	; Захват строк выделенного текста
	#File = 0
	If ReadFile(#File, PathFile$)
		Format = ReadStringFormat(#File)
		While Not Eof(0)
			String$ = ReadString(#File, Format)
			Line + 1
			If Line >= Line1 And Line <= Line2
				Text$ + StringProcessing(String$) + #CRLF$ ; первичная чистка от строк, комментариев, операторов, апострофов, ASM-кода
			EndIf
		Wend
		CloseFile(#File)
	EndIf
	; Конец захват выделенного текста

	; MessageRequester("", Text$)
	; Проверяем, сколько функций в выделенном тексте, чтобы правильно подставить область видимости Protected или Define или Global
	If ProcAll
		If ExamineRegularExpression(ProcAll, Text$)
			While NextRegularExpressionMatch(ProcAll)
				CountProc + 1
			Wend
		EndIf
	EndIf

	; Здесь бы ещё сделать списки областей видимости Protected, Define, Global,
	; чтобы для Protected исключить Global, а для Global исключить Protected

	; Удаление API-функций, #констант, ключевых слов, встроенных функций

	Constant = CreateRegularExpression(#PB_Any, "[#@]\w+\$?") ; для удаления #констант и взятие указателей
	API = CreateRegularExpression(#PB_Any, "\w+_\(")		  ; для удаления API-функций
	Struct = CreateRegularExpression(#PB_Any, "Structure\h.+?EndStructure", #PB_RegularExpression_DotAll | #PB_RegularExpression_NoCase) ; для удаления структур
	Imports = CreateRegularExpression(#PB_Any, "ImportC?\h.+?EndImport", #PB_RegularExpression_DotAll | #PB_RegularExpression_NoCase) ; для удаления структур
	Num = CreateRegularExpression(#PB_Any, "\b\d+\b")	 ; для очистки чисел
	HNum = CreateRegularExpression(#PB_Any, "(?<!\w)\$[\da-fA-F]+\b")			
; 	Type = CreateRegularExpression(#PB_Any, "(?<=\w)\.[abcdfilqsuw]\h*(?=\()") ; для очистки типов у переменных со скобками
	Type = CreateRegularExpression(#PB_Any, "(?<=\w)\.\w+") ; для очистки типов у переменных со скобками, включая объявления структур
	ModulesClear = CreateRegularExpression(#PB_Any, "\w+::[A-Za-z_]\w*\h*\(")

	Text$ = ReplaceRegularExpression(Constant, Text$, "")
	Text$ = ReplaceRegularExpression(API, Text$, "")
	Text$ = ReplaceRegularExpression(Struct, Text$, "")
	Text$ = ReplaceRegularExpression(Imports, Text$, "")
	Text$ = ReplaceRegularExpression(Num, Text$, "")
	Text$ = ReplaceRegularExpression(HNum, Text$, "")
	Text$ = ReplaceRegularExpression(Type, Text$, "")
	Text$ = ReplaceRegularExpression(ModulesClear, Text$, "")

	Proc = CreateRegularExpression(#PB_Any, "\w+(?=\h*\()") ; для захвата процедур
	ProcClear = CreateRegularExpression(#PB_Any, "\w+\h*\("); для очистки процедур

	NbProc = ExtractRegularExpression(Proc, Text$, Proc$())
	If NbProc
		For i = 0 To NbProc - 1
			If FindMapElement(FuncExceptionMap(), Proc$(i)) Or FindMapElement(KeyWordExceptionMap(), Proc$(i))
				Proc$(i) = ""
			EndIf
		Next
	EndIf
	Text$ = ReplaceRegularExpression(ProcClear, Text$, "")


	VarPoint = CreateRegularExpression(#PB_Any, "\*[a-zA-Z]\w*") ; для захвата и очистки указателей
	NbVarPoint = ExtractRegularExpression(VarPoint, Text$, VarPoint$())
	Text$ = ReplaceRegularExpression(VarPoint, Text$, "")

	StrVar = CreateRegularExpression(#PB_Any, "\w+\$") ; для захвата и очистки строковых переменных

	NbStrVar = ExtractRegularExpression(StrVar, Text$, StrVar$())
	Text$ = ReplaceRegularExpression(StrVar, Text$, "")

	DeclareVar = CreateRegularExpression(#PB_Any, "\w+(?=\.[abcdfilqsuw])") ; для захвата декларируемых типом переменных
	DeclareVarClear = CreateRegularExpression(#PB_Any, "\w+\.[abcdfilqsuw]"); для очистки декларируемых типом переменных

	NbDeclareVar = ExtractRegularExpression(DeclareVar, Text$, DeclareVar$())
	Text$ = ReplaceRegularExpression(DeclareVarClear, Text$, "")


	Var = CreateRegularExpression(#PB_Any, "\w++") ; для захвата и очистки строковых переменных

	NbVar = ExtractRegularExpression(Var, Text$, Var$())
	If NbVar
		For i = 0 To NbVar - 1
			If FindMapElement(KeyWordExceptionMap(), Var$(i))
				Var$(i) = ""
			EndIf
		Next
	EndIf
	Text$ = ReplaceRegularExpression(Var, Text$, "")

	Select CountProc
		Case 0
			Scope$ = "Define "
		Case 1
			Scope$ = #TAB$ + "Protected "
		Default
			Scope$ = "Global "
	EndSelect

	Text$ = ""
	If NbProc
		d = 0
		Text$ + #CRLF$ + Scope$
		For i = 0 To NbProc - 1
			If Asc(Proc$(i)) And Not FindMapElement(ResultMap(), Proc$(i))
				AddMapElement(ResultMap(), Proc$(i))
				d + 1
				If d > 10; And Len(Text$) > 100 ; если 8 переменных то делаем новую строку
					d = 0 ; обычных переменных всегда много, поэтому делаем следующую строку
					Text$ = Left(Text$, Len(Text$) - 2) + #CRLF$ + Scope$
				EndIf
				Text$ + Proc$(i) + "(), "
				CountScope + 1
			EndIf
		Next
		If CountScope
			Text$ = Left(Text$, Len(Text$) - 2)
		Else
			Text$ = ""
		EndIf
	EndIf

	If NbVarPoint
		d = 0
		Text$ + #CRLF$ + Scope$
		For i = 0 To NbVarPoint - 1
			If Asc(VarPoint$(i)) And Not FindMapElement(ResultMap(), VarPoint$(i))
				AddMapElement(ResultMap(), VarPoint$(i))
				d + 1
				If d > 10; And Len(Text$) > 100 ; если 8 переменных то делаем новую строку
					d = 0 ; обычных переменных всегда много, поэтому делаем следующую строку
					Text$ = Left(Text$, Len(Text$) - 2) + #CRLF$ + Scope$
				EndIf
				Text$ + VarPoint$(i) + ", "
			EndIf
		Next
		Text$ = Left(Text$, Len(Text$) - 2)
	EndIf

	If NbStrVar
		d = 0
		Text$ + #CRLF$ + Scope$
		For i = 0 To NbStrVar - 1
			If Asc(StrVar$(i)) And Not FindMapElement(ResultMap(), StrVar$(i))
				AddMapElement(ResultMap(), StrVar$(i))
				d + 1
				If d > 10; And Len(Text$) > 100 ; если 8 переменных то делаем новую строку
					d = 0 ; обычных переменных всегда много, поэтому делаем следующую строку
					Text$ = Left(Text$, Len(Text$) - 2) + #CRLF$ + Scope$
				EndIf
				Text$ + StrVar$(i) + ", "
			EndIf
		Next
		Text$ = Left(Text$, Len(Text$) - 2)
	EndIf

	If NbVar
		CountScope = 0
		d = 0
		Text$ + #CRLF$ + Scope$
		For i = 0 To NbVar - 1
			If Asc(Var$(i)) And Not FindMapElement(ResultMap(), Var$(i))
				AddMapElement(ResultMap(), Var$(i))
				d + 1
				If d > 10; And Len(Text$) > 100 ; если 8 переменных то делаем новую строку
					d = 0 ; обычных переменных всегда много, поэтому делаем следующую строку
					Text$ = Left(Text$, Len(Text$) - 2) + #CRLF$ + Scope$
				EndIf
				Text$ + Var$(i) + ", "
				CountScope + 1
			EndIf
		Next
		If CountScope
			Text$ = Left(Text$, Len(Text$) - 2)
		Else
			Text$ = Left(Text$, Len(Text$) - Len(Scope$) - 2)
		EndIf
	EndIf
	
	FreeRegularExpression(#PB_All) ; это может стать причиной проблем при создании глобальных регвыр с использованием после этой функции
	ProcedureReturn Text$
EndProcedure


Procedure SplitM(String.s, Map StringMap.s(), Separator.s = " ", CaseSensitive = 1)
	Protected S.String, *S.Integer = @S
	Protected.i p, slen

	slen = Len(Separator)
	ClearMap(StringMap())
	*S\i = @String
	Repeat
		p = FindString(S\s, Separator)
		If CaseSensitive
			AddMapElement(StringMap(), PeekS(*S\i, p - 1))
		Else
			AddMapElement(StringMap(), LCase(PeekS(*S\i, p - 1)))
			StringMap() = PeekS(*S\i, p - 1)
		EndIf

		*S\i + (p + slen - 1) << #PB_Compiler_Unicode
	Until p = 0
	*S\i = 0
EndProcedure


Define Text$, ProgDir$

ProgDir$ = GetPathPart(ProgramFilename())

NativeFunc$ = ReadFileToVar(ProgDir$ + "Procedure.txt")
If Not Asc(NativeFunc$)
	MessageRequester("", "Не удалось прочитать файл" + #CRLF$ + ProgDir$ + "Procedure.txt")
	End
EndIf

KeyWord$ = ReadFileToVar(ProgDir$ + "KeyWord.txt")
If Not Asc(KeyWord$)
	MessageRequester("", "Не удалось прочитать файл" + #CRLF$ + ProgDir$ + "KeyWord.txt")
	End
EndIf
; создаём список исключений из нативных функций до обработки исходника
SplitM(NativeFunc$, FuncExceptionMap(), #CRLF$)
SplitM(KeyWord$, KeyWordExceptionMap(), #CRLF$)

Text$ = GetSelText()
SetClipboardText(Text$)
MessageRequester("", Text$)
Sergey
User
User
Posts: 54
Joined: Wed Jan 12, 2022 2:41 pm

Re: [IDE tool] Generate procedure local variables

Post by Sergey »

I tested code from 18 Mar 2023 and got next variable's line:
Protected q, s, file_name, file_size

quad and string types become variables :D

Procedure code:

Code: Select all

Procedure files_list()
	Shared files()

	If FileSize(#directory_name) = -2
		If ExamineDirectory(#directory, #directory_name, "*.*")

			While NextDirectoryEntry(#directory)
				file_name.s = DirectoryEntryName(#directory)

				If DirectoryEntryType(#directory) = #PB_DirectoryEntry_File
					file_size.q = DirectoryEntrySize(#directory)

					Debug "Найден файл: " + file_name + " (" + Str(file_size) + " байт)"

					AddElement(files())
					files()\file_name = file_name
					files()\file_size = file_size

				EndIf
			Wend

			FinishDirectory(#directory)
		EndIf
	EndIf
EndProcedure
Post Reply