Make Declares List
Posted: Thu Aug 27, 2015 1:36 pm
Parse a single PB source code file for Procedures and create a list of declares from them, saved to Clipboard. Option to append list to a file if processing more than one source.
If your project starts to grow into something bigger than first intended, you will possibly get 'Procedure does not exist' messages from the Compiler. This is where the advanced declaration of Procedures works wonders, but some developers find it tedious to include/update them. So this is for you:
[/size]
I have written this to suit the way I work, everyone is free to modify it to suit their needs - don't ask me to do it for you
Edit: Modified to remove the glitches reported by Vera
If your project starts to grow into something bigger than first intended, you will possibly get 'Procedure does not exist' messages from the Compiler. This is where the advanced declaration of Procedures works wonders, but some developers find it tedious to include/update them. So this is for you:
Code: Select all
;GetDeclares.pb PB5.30 x86 UTF8 27/08/2015
;*******************************************************************************************************
; NOTE: If there is a DataSection, it is assumed to be at the end of the file.
; If not true in your files, comment out 2 lines following "Stop Search if DataSection found".
;
; sgLastPathFile: record of last path used to make file selection faster/easier.
;
; The CheckBox background colour is defined using Windows API. If not using Windows, you could
; delete the WinCallback Procedure and the setting of the Window back colour.
;
; Declares for 1 source code file are saved to the clipboard.
; Optionally, Declares for all source code files processed are appended to a file: "Declares.pbi".
;*******************************************************************************************************
EnableExplicit
UsePNGImageDecoder()
Enumeration
#WinMain
#FileIO
#ChkBox
#TxtFileIn
#BtnSort
#BtnStart
#StrFileIn
#BtnBrowse
EndEnumeration
Global NewList sgAllProcs.s() ;List of Declares
Global sgEOF.s = "@EOF@" ;Artificial End-of-file (belt and braces)
Global sgLastPathFile.s = "C:\LastPath.txt"
Global igSortBtnOn.i = #False
Global igInProcess.i = #False
Global sgDefaultFolder.s = "C:\"
Global igBtnBrwsImg.i = CatchImage(10, ?BtnBrowse)
Global igFormat.i = 0
Global qgFileLen.q = 0
Global *gTextBuff
Global igLabelTextColour.i = RGB(000,000,000)
Global igStrTextColour.i = RGB(016,016,016)
Global igWinColour.i = RGB(096,096,096)
Global hBrush.i = CreateSolidBrush_(igWinColour)
Global igFontGui10.i = LoadFont(0, "Microsoft Sans Serif", 10, #PB_Font_Bold | #PB_Font_HighQuality + 2)
Global igFontStrs12.i = LoadFont(1, "Microsoft Sans Serif", 12, #PB_Font_HighQuality + 2)
Procedure SaveLastPath()
;#----------------------
If CreateFile(#FileIO, sgLastPathFile)
WriteStringN(#FileIO, sgDefaultFolder, #PB_UTF8)
CloseFile(#FileIO)
EndIf
EndProcedure
Procedure GetLastPath()
;#---------------------
If(FileSize(sgLastPathFile) > 0)
If ReadFile(#FileIO, sgLastPathFile)
sgDefaultFolder = ReadString(#FileIO, #PB_UTF8)
CloseFile(#FileIO)
EndIf
EndIf
EndProcedure
Procedure ToggleSortBtn()
;#-----------------------
Select igSortBtnOn
Case #False: SetGadgetText(#BtnSort, "Sort ON") : igSortBtnOn = #True
Case #True: SetGadgetText(#BtnSort, "Sort OFF") : igSortBtnOn = #False
EndSelect
EndProcedure
Procedure.s GetEol()
;#------------------
;Determine End of Line String: Windows = CRLF, Unix/Linux = LF, Classic Mac = CR, Mac OSX = LF
Protected sEOL.s, sCR.s, sLF.s, iCR.i = 0, iLF.i = 0
iCR = FindString(PeekS(*gTextBuff, qgFileLen, igFormat), #CR$, 1, #PB_String_NoCase)
iLF = FindString(PeekS(*gTextBuff, qgFileLen, igFormat), #LF$, 1, #PB_String_NoCase)
If((iCR > 0) And (iLF = 0))
sEOL = #CR$
ElseIf((iCR = 0) And (iLF > 0))
sEOL = #LF$
Else
sEOL = #CRLF$ ;Default
EndIf
ProcedureReturn(sEOL)
EndProcedure
Procedure ListAll(sFullPath.s)
;#----------------------------
Protected sLine.s, sCodeLine.s, sDeclare.s, sClip.s, sChar1.s, sEOL.s
Protected qLenBytes.q, qLineLenBytes.q
Protected qStartChars.q, qEndChars.q, iProc.i, iOk.i = 0, iCnt.i = 0
Protected sExportFilePath.s = GetPathPart(sFullPath)
Protected sExportFilename.s = GetFilePart(sFullPath, #PB_FileSystem_NoExtension)
Protected sExt.s = GetExtensionPart(sFullPath)
Protected sExportFile.s = sExportFilePath + "Declares.pbi"
Protected sTitle.s = ";" + sExportFilename + "." + sExt
Protected sEndProcedure.s = "EndProcedure" + sEOL ;Required because last file line could be 'EndProcedure', but without an EOL
Protected iEndProcLenChars.i = Len(sEndProcedure)
Protected iExportFileReqd.i = GetGadgetState(#ChkBox)
ClearList(sgAllProcs())
If(qgFileLen > 1)
sEOL = GetEol()
Repeat
;Find 'Procedure'
qStartChars = FindString(PeekS(*gTextBuff, qgFileLen, igFormat), "Procedure", qStartChars, #PB_String_NoCase)
If(qStartChars = 0) : Break : EndIf
;Find EOL
qEndChars = FindString(PeekS(*gTextBuff, qgFileLen, igFormat), sEOL, qStartChars, #PB_String_NoCase)
sLine = Mid(PeekS(*gTextBuff, qgFileLen, igFormat), qStartChars, (qEndChars - qStartChars))
qLineLenBytes = StringByteLength(sLine, igFormat)
qStartChars = qEndChars + Len(sEOL)
qLenBytes = qLenBytes + qLineLenBytes ;Progress in Bytes
iProc = FindString(sLine, "Procedure", 1, #PB_String_NoCase)
If(iProc > 0)
;Test for variants that are not 'Procedure'
iOk = FindString(sLine, "Procedures", 1, #PB_String_NoCase)
If(iOk < 1)
iOk = FindString(sLine, "_Procedure", 1, #PB_String_NoCase)
If(iOk < 1)
iOk = FindString(sLine, "EndProcedure", 1, #PB_String_NoCase)
If(iOk < 1)
iOk = FindString(sLine, "ProcedureReturn", 1, #PB_String_NoCase)
If(iOk < 1)
sCodeLine = Trim(sLine)
sChar1 = Left(sCodeLine, 1)
If Not(sChar1 = ";")
;'Procedure' Found
AddElement(sgAllProcs())
sgAllProcs() = ReplaceString(sCodeLine, "Procedure", "Declare", #PB_String_NoCase)
iCnt = iCnt + 1
SetGadgetText(#StrFileIn, "Processing: " + Str(iCnt)) : While WindowEvent() : Wend
;Since 'Procedure' has been found, jump to 'EndProcedure'
qStartChars = FindString(PeekS(*gTextBuff, qgFileLen, igFormat), "EndProcedure", qStartChars, #PB_String_NoCase)
If(qStartChars = 0) : Break : EndIf ;Something wrong with the file or this code :(
sLine = Mid(PeekS(*gTextBuff, qgFileLen, igFormat), qStartChars, iEndProcLenChars)
qStartChars = qStartChars + iEndProcLenChars ;Next 'Find' Starts at end of last 'Find'
qLineLenBytes = StringByteLength(sEndProcedure, igFormat)
qLenBytes = qLenBytes + qLineLenBytes ;Progress in Bytes
EndIf
EndIf
EndIf
EndIf
EndIf
Else
;Stop Search if "DataSection" found (comment-out if your DataSections are not at the end of the file)
iOK = FindString(sLine, "DataSection", 1, #PB_String_NoCase)
If(iOk > 0) : Break : EndIf
;Stop Search if gEOF found (EOF for the purposes of this process)
iOK = FindString(sLine, sgEOF, 1, #PB_String_NoCase)
If(iOk > 0) : Break : EndIf
EndIf ;(iProc > 0)
Until((qLenBytes = qgFileLen) Or (qLenBytes > qgFileLen))
If(igSortBtnOn = #True)
SortList(sgAllProcs(), #PB_Sort_Ascending | #PB_Sort_NoCase)
EndIf
;To Clipboard
sClip = sTitle + sEOL
ForEach sgAllProcs()
sClip = sClip + sgAllProcs() + sEOL
Next
SetClipboardText(sClip) : sClip = ""
;Append File
If(iExportFileReqd = #PB_Checkbox_Checked)
If OpenFile(#FileIO, sExportFile, #PB_File_Append)
WriteString(#FileIO, sTitle + sEOL, igFormat)
ForEach sgAllProcs()
WriteString(#FileIO, sgAllProcs() + sEOL, igFormat)
Next
WriteString(#FileIO, sEOL, igFormat)
CloseFile(#FileIO)
EndIf
EndIf
SetGadgetText(#StrFileIn, "Done! Declare Total" + ": " + Str(iCnt))
Else
MessageRequester("Make Declare List", "Problem: No file?")
EndIf
igInProcess = #False
EndProcedure
Procedure PfReadFile(sFullPath.s)
;#-------------------------------
If ReadFile(#FileIO, sFullPath)
igFormat = ReadStringFormat(#FileIO)
qgFileLen = Lof(#FileIO)
*gTextBuff = AllocateMemory(qgFileLen + 32)
ReadData(#FileIO, *gTextBuff, qgFileLen)
PokeS(*gTextBuff + qgFileLen, sgEOF)
CloseFile(#FileIO)
Else
MessageRequester("Make Declare List", "Problem: Could not open file")
EndIf
EndProcedure
Procedure.s BrowseForFile()
;#-------------------------
Protected sPat.s = "PB include file (*.pbi)|*.pbi|PB file (*.pb)|*.pb|All PB files (*.pb *.pbi *.pbf)|*.pb;*.pbi;*.pbf|All files (*.*)|*.*"
Protected sFullPath.s = OpenFileRequester("Make Declare List: " + "Browse to and Select File", sgDefaultFolder, sPat, 0)
If(FileSize(sFullPath) > 0)
SetGadgetText(#StrFileIn, sFullPath)
ClearList(sgAllProcs())
sgDefaultFolder = GetPathPart(sFullPath)
SaveLastPath()
PfReadFile(sFullPath)
EndIf
ProcedureReturn(sFullPath)
EndProcedure
Procedure WinCallback(hWnd, uMsg, wParam, lParam)
;#-----------------------------------------------
Protected iReturn.i = #PB_ProcessPureBasicEvents
Select uMsg
Case #WM_CTLCOLORSTATIC
Select lParam ;API call: allows choosing gadgets by their number
Case GadgetID(#ChkBox)
iReturn = hBrush
EndSelect
EndSelect
ProcedureReturn iReturn
EndProcedure
Procedure Win()
;#-------------
Protected iFlags.i = #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered
If OpenWindow(#WinMain, 0, 0, 560, 85, "Make Declare List [Saved to Clipboard]", iFlags)
SetWindowColor(#WinMain,igWinColour)
WindowBounds(#WinMain, 560, 85, #PB_Ignore, 85)
CheckBoxGadget(#ChkBox, 5, 6, 300, 20, "Append List to Declares.pbi")
ButtonGadget(#BtnSort, 310, 6, 120, 24, "Sort OFF")
ButtonGadget(#BtnStart, 435, 6, 120, 24, "Make List")
TextGadget(#TxtFileIn, 5, 34, 200, 16, "PB Source File")
StringGadget(#StrFileIn, 5, 54, 520, 26, "", #PB_String_BorderLess | #PB_String_ReadOnly)
ButtonImageGadget(#BtnBrowse, 530, 54, 26, 26, igBtnBrwsImg)
GadgetToolTip(#BtnBrowse, "Browse to Select PB file (*.pb *.pbi *.pbf)")
GadgetToolTip(#BtnSort, "Select to sort/not sort Declares List alphabetically")
GadgetToolTip(#BtnStart, "Select to make Declares List")
SetGadgetFont(#ChkBox, igFontGui10)
SetGadgetFont(#TxtFileIn, igFontGui10)
SetGadgetFont(#StrFileIn, igFontStrs12)
SetGadgetColor(#ChkBox, #PB_Gadget_FrontColor, igLabelTextColour)
SetGadgetColor(#TxtFileIn, #PB_Gadget_FrontColor, igLabelTextColour)
SetGadgetColor(#TxtFileIn, #PB_Gadget_BackColor, igWinColour)
igSortBtnOn = #False
SetWindowCallback(@WinCallback())
EndIf
EndProcedure
Procedure WaitForUser()
;----------------------
Protected iExit = #False
Protected sFullPath.s = ""
Repeat
Select WaitWindowEvent(1)
Case #PB_Event_CloseWindow: iExit = #True
Case #PB_Event_RestoreWindow, #PB_Event_SizeWindow
;X ;Y ;W ;H
ResizeGadget(#StrFileIn, #PB_Ignore, #PB_Ignore, WindowWidth(#WinMain) - 40, #PB_Ignore)
ResizeGadget(#BtnBrowse, WindowWidth(#WinMain) - 30, #PB_Ignore, #PB_Ignore, #PB_Ignore)
ResizeGadget(#BtnSort, WindowWidth(#WinMain) - 250, #PB_Ignore, #PB_Ignore, #PB_Ignore)
ResizeGadget(#BtnStart, WindowWidth(#WinMain) - 125, #PB_Ignore, #PB_Ignore, #PB_Ignore)
Case #PB_Event_Gadget
Select EventGadget()
Case #BtnBrowse: sFullPath = BrowseForFile()
Case #BtnSort: ToggleSortBtn()
Case #BtnStart
If(igInProcess = #False)
igInProcess = #True
ListAll(sFullPath)
EndIf
EndSelect
EndSelect
Until iExit = #True
EndProcedure
Win()
GetLastPath()
WaitForUser()
If *gTextBuff : FreeMemory(*gTextBuff) : EndIf
End
DataSection
BtnBrowse:
Data.q $0A1A0A0D474E5089,$524448490D000000,$1800000018000000,$3D77E00000000608,$59487009000000F8
Data.q $0E0000C40E000073,$00001B0E2B9501C4,$DE07454D49740700,$24B9FB01330F0201,$584574070000005F
Data.q $00726F6874754174,$0C00000048CCAEA9,$6373654474584574,$006E6F6974706972,$0A00000023210913
Data.q $79706F4374584574,$0FAC007468676972,$45740E0000003ACC,$6974616572437458,$00656D6974206E6F
Data.q $09000000090FF735,$74666F5374584574,$FF705D0065726177,$5845740B0000003A,$69616C6373694474
Data.q $8FB4C0B70072656D,$7458457408000000,$00676E696E726157,$0700000087E61BC0,$72756F5374584574
Data.q $00EB83FFF5006563,$4374584574080000,$F600746E656D6D6F,$7406000000BF96CC,$656C746954745845
Data.q $01000027D2EEA800,$ED894854414449C9,$9F871840D36F3F95,$40A085DAA34ECFB3,$A58803A95A81235B
Data.q $037C40622A03282C,$581958D826502DFA,$6C426262421502F9,$DC6A0924F9425448,$32F3FE7C4969A23F
Data.q $82C8512B1A88B6B8,$3BBF3F5EEFB267D4,$D3BD76EDDAA77D9F,$AC8885E8A28DBCE9,$ED5AB507529400B2
Data.q $FA69A76D7AD5AB53,$BF2116F012F318CE,$5DDBB751E4924BC0,$2C68AA4EEC9249D6,$68E04CFBCA5B7509
Data.q $B24924A7B3671164,$C6CA7E3B96BD27AB,$71793B5B0A52824A,$7264B9E8FC50C86C,$377FD359111135C9
Data.q $53A7865EEB19CB04,$DF655A4FA78D6082,$E3C6FD7CBE2FC9C9,$5480324BEA986220,$6CAB73BD16679F84
Data.q $4C7AEB615C572B2B,$37364D5BD58379B3,$E1E35C68DC3D8EEE,$7EE23953234603F6,$065D88331F4F10FF
Data.q $E7EF3E4E78078D46,$556DEFF7052A76CF,$91DF19F8F87C15F6,$4EE3B4028B9CA032,$558159AC5F434C15
Data.q $C3A2A602AE30B751,$2B6A729869600430,$FB8F4F093FC1EFCC,$2201E76678421D1C,$FE3397E42229E7F9
Data.q $AFFFFBC29E1415A6,$6C409901ECC055C1,$8A234E5BBD54510C,$082A179D8F1C710C,$0476E7612D700102
Data.q $1F26C5E9B7CEE380,$A032A9930D6EF7DC,$4A19EB372117AC07,$29568708110337CD,$98015E03D81A7A07
Data.q $664FB3E7B73DD14C,$4D80701F7F7DF6CF,$DE07BC07B8905FC0,$DDB042AFD70A01FC,$454900000000060C
Data.q $0000826042AE444E
EndDataSection
I have written this to suit the way I work, everyone is free to modify it to suit their needs - don't ask me to do it for you
Edit: Modified to remove the glitches reported by Vera
I helped myself and added some dis&enable gadget commands.