Code: Select all
; Define Forum Marker Tool
; Jump to Marker V1 by Michael Vogel
; ----------------------------------
; Example for Tool Settings:
; --------------------------
; Command Line: %COMPILEFILE\..\..\Pure\Tools\Tool Marker.exe
; Arguments: "%FILE" 552 "JetBrains Mono" the second parameter sets the sizes of the window, line column and font
; Working Dir.: %COMPILEFILE\..\..\Pure\Tools
; Name: &Jump to Marker...
; Event Trigger: Menu Or Shortcut I would still write 'or' instead of 'Or' (typical IDE issue)
; Shortcut: Ctrl + J
; Please set 'Enable DPI aware' compiler flag
EnableExplicit
#BufferLines= 250
#DpiBits= 12+SizeOf(Integer)
#DpiScale= 1<<#DpiBits
#Background1= $E8FFF8
#Background2= $E0FAF0
Enumeration
#File
#True
#Bingo
EndEnumeration
Enumeration
#Win
#Lst
#Fnt
#KeyGo
#KeyExit
EndEnumeration
Structure LongType
Low.l
High.l
EndStructure
Structure ResultType
StructureUnion
Quad.q
Long.LongType
EndStructureUnion
EndStructure
Structure SourceType
Code.s
PLine.i
EndStructure
Structure ToolType
Lines.i
Asize.i
Oflag.i
Pline.i
Width.i
Lsize.i
DpiScale.i
FontSize.i
FontName.s
Marker.s
SourceFile.s
EndStructure
Structure IdeType
HandleIde.i
HandleScintilla.i
Cursor.i
ClassTextIde.s
TitleTextIde.s
EndStructure
Global Ide.IdeType
Global Tool.ToolType
Global Dim Source.SourceType(Tool\Asize)
Ide\ClassTextIde= "WindowClass_2"
Ide\TitleTextIde= "PureBasic"
; EndDefine
Macro ScaleUp(value)
(((value)*Tool\DpiScale)/#DpiScale)
EndMacro
Macro ScaleDown(value)
(((value)*#DpiScale)/Tool\DpiScale)
EndMacro
Procedure.i SearchIdeHandle(hwnd.i)
Protected ClassText.s=Space(256)
With Ide
If hwnd
GetClassName_(hwnd,@classText,256)
If classText=\ClassTextIde
GetWindowText_(hwnd,@classText,256)
If Not Asc(\TitleTextIde) Or FindString(classText,\TitleTextIde)
\HandleIde=hwnd
ProcedureReturn 0
EndIf
EndIf
ProcedureReturn 1
EndIf
ProcedureReturn 0
EndWith
EndProcedure
Procedure.i SearchScintilla(hwnd.i)
Protected ClassText.s=Space(256)
With Ide
If hwnd
GetClassName_(hwnd,@classText,256)
If classText="Scintilla"
\HandleScintilla=hwnd
ProcedureReturn 0
EndIf
ProcedureReturn 1
EndIf
ProcedureReturn 0
EndWith
EndProcedure
Procedure.q MyTrim(*s.Character)
Protected p,l,r,m
Repeat
p+1
Select *s\c
Case #Null
ProcedureReturn r<<32+l+1
Case ' ',#TAB
If m=#Null
l=p
EndIf
Default
r=p
If m=#Null
m=#True
EndIf
EndSelect
*s+SizeOf(Character)
ForEver
EndProcedure
Procedure Jump(marker)
Protected line
Protected Count
line=Val(GetGadgetItemText(#Lst,marker,1))
With Ide
If \HandleIde
SendMessage_(\HandleScintilla,#SCI_ENSUREVISIBLE,line - 1, 0)
SendMessage_(\HandleScintilla,#SCI_GOTOLINE,line - 1, 0)
Count=SendMessage_(\HandleScintilla,#SCI_LINESONSCREEN, 0, 0) / 2
SendMessage_(\HandleScintilla, #SCI_SCROLLCARET, line - 1, 0)
If Abs(\Cursor - line) < Count
Count=0
ElseIf \Cursor > line
Count=-Count
EndIf
SendMessage_(\HandleScintilla, #SCI_LINESCROLL, 0, Count)
EndIf
SetForegroundWindow_(\HandleIde)
SetActiveWindow_(\HandleIde)
EndWith
End
EndProcedure
Procedure ResizeWindows(h,m,w,l)
If m=#WM_SIZING
ResizeGadget(#Lst,#PB_Ignore,#PB_Ignore,WindowWidth(#Win),#PB_Ignore)
EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Procedure Main()
Protected a,i,m,n,o,p
Protected r.ResultType
Protected s.s,t.s
With Ide
EnumChildWindows_(0,@SearchIdeHandle(),0)
EnumChildWindows_(\HandleIde,@SearchScintilla(),0)
If \HandleIde
\Cursor=SendMessage_(\HandleScintilla,#SCI_GETCURRENTPOS, 0, 0)
\Cursor=SendMessage_(\HandleScintilla,#SCI_LINEFROMPOSITION, \Cursor, 0)
EndIf
EndWith
With Tool
CompilerIf #PB_Compiler_Debugger
\SourceFile="C:\Tools\Programmer\Pure\Tools\Tools\Tool Marker.pb"
CompilerElse
\SourceFile=ProgramParameter(0)
CompilerEndIf
s=ProgramParameter(1)
If s
n=Val(s)
Else
n=333
EndIf
\Width=250+(n/100)*100
\Lsize=(n%100)/10
If \Lsize
\Lsize+4
EndIf
n%10
n%10-5
\FontSize=12+n<<Bool(n>0); 7, 8, 9, 10, 11, 12, 14, 16, 18, 20
\FontName=ProgramParameter(2)
If \FontName=""
\FontName="Segoe UI"
EndIf
If ReadFile(#File,\SourceFile,#PB_File_SharedRead)
While Eof(#File)=#Null
\Lines+1
If \Lines>\Asize
\Asize+#BufferLines
ReDim Source(\Asize)
EndIf
s=ReadString(#File)
r\Quad=MyTrim(@s)
s=Mid(s,r\Long\Low,r\Long\High-r\Long\Low+1)
If Left(s,9)="Procedure" Or Left(s,6)="Macro "
\Pline=\Lines
EndIf
Source(\Lines)\Code=s
Source(\Lines)\PLine=\Pline
If PeekC(@s)=';'
If \Oflag=#True
If Left(s,9)="; Markers"
\Marker=StringField(s,2,"=")
\Oflag=#Bingo
EndIf
ElseIf Left(s,20)="; IDE Options = Pure"
\Oflag=#True
EndIf
EndIf
Wend
CloseFile(#File)
If \Oflag=#Bingo
\DpiScale=GetDeviceCaps_(GetDC_(0),#LOGPIXELSX)<<#DpiBits/96
o=ScaleDown(GetSystemMetrics_(#SM_CYFULLSCREEN))-5; Just a quick workaround to show the full window
LoadFont(#Fnt,\FontName,\FontSize)
OpenWindow(#Win,ScaleDown(GetSystemMetrics_(#SM_CXFULLSCREEN))-\Width,0,0,0,"Jump to Marker...",#PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_Invisible)
WindowBounds(0,\Width,o,\Width,o)
SetGadgetFont(#PB_Any,FontID(#Fnt))
ListIconGadget(#Lst,0,0,\Width,o,"#",25,#PB_ListIcon_FullRowSelect)
SetGadgetColor(#Lst,#PB_Gadget_BackColor,#Background1)
AddGadgetColumn(#Lst,1,"Line",\FontSize*\Lsize*2/3)
AddGadgetColumn(#Lst,2,"Procedure",125)
AddGadgetColumn(#Lst,3,"Source Code",1000)
Protected lvm.LV_COLUMN
lvm\mask=#LVCF_FMT
lvm\fmt=#LVCFMT_CENTER
SendMessage_(GadgetID(#Lst),#LVM_SETCOLUMN,0,@lvm)
lvm\fmt=#LVCFMT_RIGHT
SendMessage_(GadgetID(#Lst),#LVM_SETCOLUMN,1,@lvm)
AddKeyboardShortcut(#Win,#PB_Shortcut_Escape,#KeyExit)
AddKeyboardShortcut(#Win,#PB_Shortcut_Return,#KeyGo)
WindowBounds(0,\Width/2,o,\Width*2,o)
\Asize=CountString(\Marker,",")+1
For i=1 To \Asize
n=Val(StringField(\Marker,i,","))
If n
If Ide\Cursor>n
a=i
EndIf
p=Source(n)\PLine
If p
s=StringField(Source(p)\Code,2," ")
Else
s="-"
EndIf
o=Bool(PeekC(@s)='M')
o=$E0F8FF+o*$1EFFE1
If m<26
t=Chr('A'+m)
Else
t="-"
EndIf
AddGadgetItem(#Lst,m,t+#LF$+Str(n)+#LF$+s+#LF$+Source(n)\Code)
If m&1
SetGadgetItemColor(#Lst,m,#PB_Gadget_BackColor,#Background2)
o-$60806
EndIf
SetGadgetItemColor(#Lst,m,#PB_Gadget_BackColor,o,2)
m+1
EndIf
Next i
SetWindowCallback(@ResizeWindows(),#Win)
SetGadgetState(#Lst,a-Bool(a=m))
SetActiveGadget(#Lst)
StickyWindow(#Win,#True)
HideWindow(#Win,#Null)
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
If EventType()=#PB_EventType_LeftDoubleClick
Jump(GetGadgetState(#Lst))
EndIf
Case #PB_Event_Menu
Select EventMenu()
Case #KeyGo
n=GetGadgetState(#Lst)
If n>=0
Jump(n)
EndIf
Case #KeyExit
End
EndSelect
Case #WM_CHAR
n=(EventwParam()&$CF)-'A'
If n>=0 And n<m And n<26
Jump(n)
EndIf
Case #PB_Event_CloseWindow
End
EndSelect
ForEver
EndIf
EndIf
EndWith
EndProcedure
Main()