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$)