Show all occurrences of a word in the IDE

Working on new editor enhancements?
BarryG
Addict
Addict
Posts: 3292
Joined: Thu Apr 18, 2019 8:17 am

Re: Show all occurrences of a word in the IDE

Post by BarryG »

AZJIO wrote: Sat Feb 11, 2023 6:48 pm Everything has already been done in the previous post
I only ever look at the first post, which is what should get edited with every update. Otherwise it makes people scroll through pages of posts to find the lastest, which is a hassle.
Allen
User
User
Posts: 92
Joined: Wed Nov 10, 2021 2:05 am

Re: Show all occurrences of a word in the IDE

Post by Allen »

Post by AZJIO » Sat Feb 11, 2023 6:48 pm

Everything has already been done in the previous post
I overlooked that you have already updated the code. Thanks.

Allen
Allen
User
User
Posts: 92
Joined: Wed Nov 10, 2021 2:05 am

Re: Show all occurrences of a word in the IDE

Post by Allen »

Hi,

As GetEnvironmentVariable("PB_TOOL_Word") will ignore # or * when getting words under cursor. I try to use CRT-C key sequence to store the highlighted text in clipboard. So it worked similar to IDE. The whole highlighted word will be used for searching. The disadvantage is it may have timing problem (Key yet not released) when the tool is activited by hot key.

I do not know any other method to capture highlighted text to clipboard, any suggestion?

Below is the modified code.

Code: Select all

;   Description: Find all references of a variable
;            OS: Windows
; English-Forum: 
;  French-Forum: 
;  German-Forum: http://www.purebasic.fr/german/viewtopic.php?f=8&t=28292
;-----------------------------------------------------------------------------

; MIT License
; 
; Copyright (c) 2015 Kiffi
; 
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
; 
; The above copyright notice and this permission notice shall be included in all
; copies or substantial portions of the Software.
; 
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
; SOFTWARE.

; FindAllReferences



CompilerIf #PB_Compiler_OS<>#PB_OS_Windows
	CompilerError "Windows Only!"
CompilerEndIf

EnableExplicit

Enumeration ; Windows
	#frmMain
EndEnumeration
Enumeration ; Gadgets
	#frmMain_References
EndEnumeration
Enumeration ; Menu-/Toolbaritems
	#frmMain_Shortcut_Escape_Event
EndEnumeration

Global PbIdeHandle = Val(GetEnvironmentVariable("PB_TOOL_MainWindow"))
If PbIdeHandle = 0 : End : EndIf

Global ScintillaHandle = Val(GetEnvironmentVariable("PB_TOOL_Scintilla"))
If ScintillaHandle = 0 : End : EndIf

Procedure Ctrl_C()
  #Delay=20
  #WaitForHotKeyRelease=300
  
  Delay(#WaitForHotKeyRelease)
  
  Protected.INPUT InputKey
  ; Control key Down
  InputKey\Type = #INPUT_KEYBOARD
  InputKey\ki\wVk = #VK_CONTROL
  InputKey\ki\dwFlags = 0
  SendInput_(1, @InputKey, SizeOf(INPUT))
  Delay(#Delay)

  ;c press
  InputKey\Type = #INPUT_KEYBOARD
  InputKey\ki\wVk = 67
  InputKey\ki\dwFlags = 0
  SendInput_(1, @InputKey, SizeOf(INPUT))
  Delay(#Delay)
  
  ;c release
  InputKey\Type = #INPUT_KEYBOARD
  InputKey\ki\wVk = 67
  InputKey\ki\dwFlags = #KEYEVENTF_KEYUP
  SendInput_(1, @InputKey, SizeOf(INPUT))
  Delay(#Delay)

  ;Control key up
  InputKey\Type = #INPUT_KEYBOARD
  InputKey\ki\wVk = #VK_CONTROL
  InputKey\ki\dwFlags = #KEYEVENTF_KEYUP
  SendInput_(1, @InputKey, SizeOf(INPUT))
  Delay(#Delay)
EndProcedure

Procedure.s RemoveLeadingWhitespaceFromString(InString.s)
	
	While Left(InString, 1) = Chr(32) Or Left(InString, 1) = Chr(9)
		InString = LTrim(InString, Chr(32))
		InString = LTrim(InString, Chr(9))
	Wend
	
	ProcedureReturn InString
	
EndProcedure

Procedure.s GetScintillaText()
	
	Protected ReturnValue.s
	
	Protected length
	Protected buffer
	Protected processId
	Protected hProcess
	Protected result
	
	length = SendMessage_(ScintillaHandle, #SCI_GETLENGTH, 0, 0)
	If length
		length + 2
		buffer = AllocateMemory(length)
		If buffer   
			SendMessageTimeout_(ScintillaHandle, #SCI_GETCHARACTERPOINTER, 0, 0, #SMTO_ABORTIFHUNG, 2000, @result)
			If result
				GetWindowThreadProcessId_(ScintillaHandle, @processId)
				hProcess = OpenProcess_(#PROCESS_ALL_ACCESS, #False, processId)
				If hProcess
					ReadProcessMemory_(hProcess, result, buffer, length, 0)   
					ReturnValue = PeekS(buffer, -1, #PB_UTF8)
				EndIf
			EndIf
		EndIf
		FreeMemory(buffer)
	EndIf
	
	ProcedureReturn ReturnValue
	
EndProcedure

Procedure frmMain_SizeWindow_Event()
	ResizeGadget(#frmMain_References, #PB_Ignore, #PB_Ignore, WindowWidth(#frmMain) - 20, WindowHeight(#frmMain) - 20)
EndProcedure

Procedure frmMain_References_Event()
	
	Protected SelectedLine
	
	SelectedLine = Val(GetGadgetItemText(#frmMain_References, GetGadgetState(#frmMain_References), 0))
	
	If SelectedLine > 0
		SendMessage_(ScintillaHandle, #SCI_GOTOLINE, SelectedLine - 1, 0)
		SendMessage_(ScintillaHandle, #SCI_ENSUREVISIBLE, SelectedLine - 1, 0)
		SetForegroundWindow_(PbIdeHandle)
		SetActiveWindow_(PbIdeHandle)
	EndIf
	
EndProcedure

;-Main
;Define SelectedWord.s = GetEnvironmentVariable("PB_TOOL_Word")
Define.s SelectedWord, ClipBoardContent

ClipBoardContent=GetClipboardText()
Ctrl_C() ; 
SelectedWord=GetClipboardText()
SetClipboardText(ClipBoardContent)
If SelectedWord = "" : End : EndIf

Define ScintillaText.s = GetScintillaText()
If ScintillaText = "" : End : EndIf

Define Line.s
Define CountLines, LineCounter
Define CountTokens, TokenCounter
Define WWE
Define RegexLines, PbRegexTokens

Structure sFoundReference
	LineNo.i
	Reference.s
	
EndStructure

NewList FoundReference.sFoundReference()

Dim Tokens.s(0)


;http://www.purebasic.fr/english/viewtopic.php?f=12&t=37823
RegexLines = CreateRegularExpression(#PB_Any , ".*\r\n")
PbRegexTokens = CreateRegularExpression(#PB_Any, #DOUBLEQUOTE$ + "[^" + #DOUBLEQUOTE$ + "]*" + #DOUBLEQUOTE$ + "|[\*]?[a-zA-Z_]+[\w]*[\x24]?|#[a-zA-Z_]+[\w]*[\x24]?|[\[\]\(\)\{\}]|[-+]?[0-9]*\.?[0-9]+|;.*|\.|\+|-|[&@!\\\/\*,\|]|::|:|\|<>|>>|<<|=>{1}|>={1}|<={1}|=<{1}|={1}|<{1}|>{1}|\x24+[0-9a-fA-F]+|\%[0-1]*|%|'")

CountLines = CountString(ScintillaText, #CRLF$)

Dim Lines.s(0)

CountLines = ExtractRegularExpression(RegexLines, ScintillaText, Lines())

SelectedWord = LCase(SelectedWord)

For LineCounter = 0 To CountLines - 1
	
	Line = Lines(LineCounter)   
	
	CountTokens = ExtractRegularExpression(PbRegexTokens, Line, Tokens())
	
	For TokenCounter = 0 To CountTokens - 1   
		If SelectedWord = LCase(Tokens(TokenCounter))
			AddElement(FoundReference())
			FoundReference()\LineNo = LineCounter + 1
			Line = Trim(Line)
			Line = Mid(Line, 1, Len(Line)-2)
			FoundReference()\Reference = Line
			Break
		EndIf
	Next
Next

	If ListSize(FoundReference()) = 0 : End : EndIf

OpenWindow(#frmMain,
           #PB_Ignore,
           #PB_Ignore,
           600,
           300,
           "Display all: '" + SelectedWord + "'",
           #PB_Window_SystemMenu |
           #PB_Window_SizeGadget |
           #PB_Window_ScreenCentered)

StickyWindow(#frmMain, #True)

ListIconGadget(#frmMain_References,
               10,
               10,
               WindowWidth(#frmMain) - 20,
               WindowHeight(#frmMain) - 20,
               "Line",
               50,
               #PB_ListIcon_FullRowSelect |   
               #PB_ListIcon_GridLines |
               #PB_ListIcon_AlwaysShowSelection)

AddGadgetColumn(#frmMain_References, 1, "Ref", 400)


ForEach FoundReference()
	AddGadgetItem(#frmMain_References, -1, Str(FoundReference()\LineNo) + #LF$ + FoundReference()\Reference)   
Next

Define i

SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 0, #LVSCW_AUTOSIZE_USEHEADER)
SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 1, #LVSCW_AUTOSIZE)
SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 2, #LVSCW_AUTOSIZE)

AddKeyboardShortcut(#frmMain, #PB_Shortcut_Escape, #frmMain_Shortcut_Escape_Event)
BindEvent(#PB_Event_SizeWindow, @frmMain_SizeWindow_Event(), #frmMain)
BindGadgetEvent(#frmMain_References, @frmMain_References_Event())
SetActiveGadget(#frmMain_References)


Repeat
	
	WWE = WaitWindowEvent()
	
	If (WWE = #PB_Event_Menu And EventMenu() = #frmMain_Shortcut_Escape_Event) Or (WWE = #PB_Event_CloseWindow)
		Break
	EndIf
	
ForEver
Allen
AZJIO
Addict
Addict
Posts: 1316
Joined: Sun May 14, 2017 1:48 am

Re: Show all occurrences of a word in the IDE

Post by AZJIO »

Allen
SendKey
Axolotl
Enthusiast
Enthusiast
Posts: 435
Joined: Wed Dec 31, 2008 3:36 pm

Re: Show all occurrences of a word in the IDE

Post by Axolotl »

hey folks,
thank you very much for bringing this to my attention.
I have taken the liberty to change something a bit here and included my interpretation of the comments.
I think there is still something to do, but I like it so quite well and will try it.
P.S. For those who are interested in the details, i have commented out the original code parts and not deleted them.
Happy coding and stay healthy.

Code: Select all

; ----------------------------------------------------------------------------
; File : FindAllReferences[Win].pb 
; ----------------------------------------------------------------------------
;
;   Description: Find all references of a variable
;            OS: Windows
; English-Forum: 
;  French-Forum: 
;  German-Forum: http://www.purebasic.fr/german/viewtopic.php?f=8&t=28292
; ----------------------------------------------------------------------------

; MIT License 
; 
; Copyright (c) 2015 Kiffi
; 
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
; 
; The above copyright notice and this permission notice shall be included in all
; copies or substantial portions of the Software.
; 
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
; SOFTWARE.
;
; ----------------------------------------------------------------------------
; Change Log : 
;   2023-02-12 : New Additions from Mesa, AZJIO, Axolotl 
;
; English-Forum: https://www.purebasic.fr/english/viewtopic.php?t=80739 
;
; Change Details by Axolotl 
;   - Integrated ColorListIconGadget.pb from AZJIO and modified 
;   - Add a #PB_Compiler_Debugger mode (for development) 
;   - New Structure of the entire application 
;   - harmonize the different coding styles (still something to do) 
;   - Changing the coloring of the selected words 
;   - counting all appearances of the SelectedWord (quick and dirty) 
;
; ----------------------------------------------------------------------------

; FindAllReferences

CompilerIf #PB_Compiler_OS <> #PB_OS_Windows 
	CompilerError "Windows Only!" 
CompilerEndIf

EnableExplicit

; ---== Structure Definition ==----------------------------------------------------------------------------------------

Structure sFoundReference
	LineNo.i
	Reference.s

EndStructure

; ---== Enumeration ==-------------------------------------------------------------------------------------------------

Enumeration ; Windows
	#frmMain
EndEnumeration

Enumeration ; Gadgets
	#frmMain_References
EndEnumeration

Enumeration ; Menu-/Toolbaritems
	#frmMain_Shortcut_Escape_Event
EndEnumeration

; ---== Constants ==---------------------------------------------------------------------------------------------------

CompilerIf #PB_Compiler_Debugger 
#SelectedWordMarker$ = "|" 
CompilerElse 
#SelectedWordMarker$ = Chr(1)  ; not used in source codes
CompilerEndIf 
; "	 Line = Trim(Line)" 
; "	 |Line| = Trim(|Line|)" 
; --> ReplaceString(text$, SelectedWord, #SelectedWordMarker$ + SelectedWord + #SelectedWordMarker$) 

;/-----------------------------------------------------------------------------
;| RGB() as HEX() -->     BB GG RR   .. i.e. RGB (1, 2, 3)    -->    03 02 01 
;| RGB() as HEX() -->  AA BB GG RR   .. i.e. RGBA(1, 2, 3, 4) --> 04 03 02 01 
;\
#MediumBlue            = $CD0000 ;  RGB(0, 0, 205) 
#CornflowerBlue        = $ED9564
#DodgerBlue            = $FF901E
#Navy                  = $800000

#coloredChars_Delimeter = "{***\"

; ---== Global Variables ==--------------------------------------------------------------------------------------------

Global PbIdeHandle, ScintillaHandle 

Global SelectedWord.s, ScintillaText.s
Global CountSelectedWords    ; new, because we want to know all references (not only the lines) 
Global NewList FoundReference.sFoundReference()

; ; ; Global PbIdeHandle = Val(GetEnvironmentVariable("PB_TOOL_MainWindow"))
; ; ; If PbIdeHandle = 0 : End : EndIf
; ; ; 
; ; ; Global ScintillaHandle = Val(GetEnvironmentVariable("PB_TOOL_Scintilla"))
; ; ; If ScintillaHandle = 0 : End : EndIf

; ---== Procedures ==--------------------------------------------------------------------------------------------------

Procedure.s RemoveLeadingWhitespaceFromString(InString.s)
	While Left(InString, 1) = Chr(32) Or Left(InString, 1) = Chr(9)
		InString = LTrim(InString, Chr(32))
		InString = LTrim(InString, Chr(9))
	Wend
	ProcedureReturn InString
EndProcedure

; ---------------------------------------------------------------------------------------------------------------------

Procedure.s GetScintillaText()
	Protected ReturnValue.s
	Protected length
	Protected buffer
	Protected processId
	Protected hProcess
	Protected result

	length = SendMessage_(ScintillaHandle, #SCI_GETLENGTH, 0, 0)
	If length
		length + 2
		buffer = AllocateMemory(length)
		If buffer
			SendMessageTimeout_(ScintillaHandle, #SCI_GETCHARACTERPOINTER, 0, 0, #SMTO_ABORTIFHUNG, 2000, @result)
			If result
				GetWindowThreadProcessId_(ScintillaHandle, @processId)
				hProcess = OpenProcess_(#PROCESS_ALL_ACCESS, #False, processId)
				If hProcess
					ReadProcessMemory_(hProcess, result, buffer, length, 0)
					ReturnValue = PeekS(buffer, -1, #PB_UTF8) 
					CloseHandle_(hProcess)  ; <-- Axolotl, added acc. to MSDN 
				EndIf
			EndIf
		EndIf
		FreeMemory(buffer)
	EndIf
	ProcedureReturn ReturnValue
EndProcedure

; ---------------------------------------------------------------------------------------------------------------------

Procedure Initialization() 

  PbIdeHandle = Val(GetEnvironmentVariable("PB_TOOL_MainWindow")) 
  CompilerIf Not #PB_Compiler_Debugger 
    If PbIdeHandle = 0 : End : EndIf
  CompilerEndIf 

  ScintillaHandle = Val(GetEnvironmentVariable("PB_TOOL_Scintilla"))
  CompilerIf Not #PB_Compiler_Debugger 
    If ScintillaHandle = 0 : End : EndIf
  CompilerEndIf 


  SelectedWord.s = GetEnvironmentVariable("PB_TOOL_Word") 
  CompilerIf Not #PB_Compiler_Debugger 
    If SelectedWord = "" : End : EndIf
  CompilerEndIf 

  ScintillaText.s = GetScintillaText()
  CompilerIf Not #PB_Compiler_Debugger 
    If ScintillaText = "" : End : EndIf
  CompilerEndIf 

  ; >> These are test pattern for development 
  CompilerIf #PB_Compiler_Debugger 

    If SelectedWord = "" 
;     SelectedWord = "Line"    ; try one of these 
;     SelectedWord = "#Line"   ; -"-  #Line could be in a comment also 
      SelectedWord = "*Line"   ; -"- 
    EndIf

    If ScintillaText = ""  
      ScintillaText = "" + #CRLF$ + 
                      "#Line = #LF ;  #Line could be in a comment also " + #CRLF$ + 
                      "Procedure Test(*Line)  ; pointer *Line " + #CRLF$ + 
                      "" + #CRLF$ + 
                      "If SelectedWord = LCase(Tokens(TokenCounter))" + #CRLF$ + 
                      "	 AddElement(FoundReference())" + #CRLF$ + 
                      "	 FoundReference()\LineNo = LineCounter + 1" + #CRLF$ + 
                      "	 Line = Trim(Line)" + #CRLF$ + 
                      "	 Line = Mid(Line, 1, Len(Line)-2)" + #CRLF$ + 
                      "	 FoundReference()\Reference = Line" + #CRLF$ + 
                      "EndIf" + #CRLF$ + 
                      "" ; End of Text 
    EndIf
  CompilerEndIf 
  ProcedureReturn 0  ; default (ZERO is returned by default, even if there is no ProcedureReturn) 
EndProcedure 

; ---------------------------------------------------------------------------------------------------------------------

Procedure LookForWordUnderCursor() 
  ; LINK : http://www.purebasic.fr/english/viewtopic.php?f=12&t=37823 
  Protected RegexLines, PbRegexTokens 
  Protected CountLines, LineCounter, CountTokens, TokenCounter 
  Protected Line.s, selWord.s, stx.s 
  Protected Dim Lines.s(0), Dim Tokens.s(0)

  RegexLines = CreateRegularExpression(#PB_Any , ".*\r\n")
  PbRegexTokens = CreateRegularExpression(#PB_Any, #DOUBLEQUOTE$ + "[^" + #DOUBLEQUOTE$ + "]*" + #DOUBLEQUOTE$ + "|[\*]?[a-zA-Z_]+[\w]*[\x24]?|#[a-zA-Z_]+[\w]*[\x24]?|[\[\]\(\)\{\}]|[-+]?[0-9]*\.?[0-9]+|;.*|\.|\+|-|[&@!\\\/\*,\|]|::|:|\|<>|>>|<<|=>{1}|>={1}|<={1}|=<{1}|={1}|<{1}|>{1}|\x24+[0-9a-fA-F]+|\%[0-1]*|%|'")

  CountLines = CountString(ScintillaText, #CRLF$) 

  CountLines = ExtractRegularExpression(RegexLines, ScintillaText, Lines())  

  selWord = LCase(SelectedWord)  ; keep the original writing 
  CountSelectedWords = 0         ; init for new search 

  For LineCounter = 0 To CountLines - 1
    Line = Lines(LineCounter) 

;Debug "tokenize Line '" + Line + "'" 

    CountTokens = ExtractRegularExpression(PbRegexTokens, Line, Tokens()) ; tokenize the line 

    For TokenCounter = 0 To CountTokens - 1 
;Debug "  check Token '" + Tokens(TokenCounter) + "'" 

      If selWord = LCase(Tokens(TokenCounter))
        AddElement(FoundReference())
        FoundReference()\LineNo = LineCounter + 1  

        Line = Trim(Line)
        Line = Mid(Line, 1, Len(Line)-2)  ; remove the #CRLF$ 
        
        CountSelectedWords + CountString(LCase(Line), selWord)   ; <-- count SelectedWord in the codeline 

        FoundReference()\Reference = Line 
        Break  ; only one line (evenn if there are more than one SelectedWord ) 
      EndIf 
    Next TokenCounter 
  Next LineCounter 

  ; because of #Constant or *Pointer
  If ListSize(FoundReference()) = 0
    For LineCounter = 0 To CountLines - 1 
      Line = Lines(LineCounter) 
      CountTokens = ExtractRegularExpression(PbRegexTokens, Line, Tokens()) 
      For TokenCounter = 0 To CountTokens - 1 
        stx = LCase(Tokens(TokenCounter))
        If stx = "#"+selWord Or stx = "*"+selWord 
          AddElement(FoundReference()) 
          FoundReference()\LineNo = LineCounter + 1 

          Line = Trim(Line)
          Line = Mid(Line, 1, Len(Line)-2)

          CountSelectedWords + CountString(LCase(Line), stx)  ; <-- count SelectedWord in the codeline 

          FoundReference()\Reference = Line 
          Break 
        EndIf
      Next
    Next

    CompilerIf Not #PB_Compiler_Debugger 
      If ListSize(FoundReference()) = 0 : End : EndIf 
    CompilerEndIf 
  EndIf
EndProcedure 



; ---------------------------------------------------------------------------------------------------------------------
; XIncludeFile "ColorListIconGadget.pbi"  ; I prefer .pbi (instead of .pb) 
; ---------------------------------------------------------------------------------------------------------------------

;... Create brushes for painting item background
Structure MYBRUSHES
	brushDefault.l
	brushSelected.l
EndStructure

Global brush.MYBRUSHES
Global Dim Colors(1) 

; brush\brushSelected = CreateSolidBrush_(GetSysColor_(#COLOR_HIGHLIGHT))
brush\brushSelected = CreateSolidBrush_(GetSysColor_(#COLOR_INFOBK))
brush\brushDefault = GetStockObject_(#WHITE_BRUSH)


; ---== Color for Default Text and Selected Word ==--------------------------------------------------------------------

; Colors(0) = #Red                                ; the SelectedWord 
Colors(0) = #DodgerBlue                           ; the SelectedWord 
; Colors(1) = GetSysColor_(#COLOR_HIGHLIGHTTEXT)  ; the default text 
Colors(1) = GetSysColor_(#COLOR_WINDOWTEXT)       ; the default text 

; ---------------------------------------------------------------------------------------------------------------------

Procedure GetCharWidth(gad, c$)
	ProcedureReturn SendMessage_(gad, #LVM_GETSTRINGWIDTH, 0, @c$)
EndProcedure

; ---------------------------------------------------------------------------------------------------------------------

;Here we add some text to the underlying cell text to store the color info.
Procedure SetColor(gad, row, column, startp, endp, color)
	Protected text$
	If column
		text$ = GetGadgetItemText(gad, row, column)
		;Now add the new text.
		text$+#coloredChars_Delimeter+Str(startp)+"\"+Str(endp)+"\"+Str(color)
		SetGadgetItemText(gad,row,text$,column)
	EndIf
EndProcedure


; ---== MainWindow Procedures ==---------------------------------------------------------------------------------------

Procedure frmMain_SizeWindow_Event()
	ResizeGadget(#frmMain_References, #PB_Ignore, #PB_Ignore, WindowWidth(#frmMain) - 16, WindowHeight(#frmMain) - 16)
  SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 1, #LVSCW_AUTOSIZE_USEHEADER)  ; last column -> fill the remaining rest 
EndProcedure 

Procedure frmMain_References_Event()
	Protected SelectedLine

	SelectedLine = Val(GetGadgetItemText(#frmMain_References, GetGadgetState(#frmMain_References), 0))
	If SelectedLine > 0
		SendMessage_(ScintillaHandle, #SCI_GOTOLINE, SelectedLine - 1, 0)
		SendMessage_(ScintillaHandle, #SCI_ENSUREVISIBLE, SelectedLine - 1, 0)
		SetForegroundWindow_(PbIdeHandle)
		SetActiveWindow_(PbIdeHandle)
	EndIf
EndProcedure

; ---------------------------------------------------------------------------------------------------------------------

Procedure myWindowCallback(hwnd, msg, wParam, lParam)
	Protected Result, *nmhdr.NMHDR, *lvCD.NMLVCUSTOMDRAW, subItemRect.RECT
	Protected thisRow, thisCol, idx 
  Protected t$, text$ 
; ; ; ; ; ; ; 	Protected subItemText$, pos, color, c$, nextColor, thisColor

	Result = #PB_ProcessPureBasicEvents
;;Dim LVColor(0)

	Select msg 
		Case #WM_NOTIFY
			*nmhdr.NMHDR = lParam
			*lvCD.NMLVCUSTOMDRAW = lParam
			If *lvCD\nmcd\hdr\hwndFrom = GadgetID(#frmMain_References) And *lvCD\nmcd\hdr\code = #NM_CUSTOMDRAW
				Select *lvCD\nmcd\dwDrawStage
					Case #CDDS_PREPAINT
						Result = #CDRF_NOTIFYITEMDRAW
					Case #CDDS_ITEMPREPAINT
						Result = #CDRF_NOTIFYSUBITEMDRAW;
					Case #CDDS_ITEMPREPAINT | #CDDS_SUBITEM
						thisRow = *lvCD\nmcd\dwItemSpec
						thisCol = *lvCD\iSubItem
						If thisCol
							;... Define rect for text
							subItemRect.RECT\left = #LVIR_LABEL
							subItemRect.RECT\top = *lvCD\iSubItem
							;... Get the subitem rect
							SendMessage_(GadgetID(#frmMain_References), #LVM_GETSUBITEMRECT, thisRow, @subItemRect)

							text$ = GetGadgetItemText(#frmMain_References, thisRow, thisCol)

							If GetGadgetState(#frmMain_References) = thisRow
								;... If item is selected
								FillRect_(*lvCD\nmcd\hdc, subItemRect, brush\brushSelected)
;               Colors(1) = GetSysColor_(#COLOR_HIGHLIGHTTEXT)  ; the default text 
							Else
								;... If item is not selected
								FillRect_(*lvCD\nmcd\hdc, subItemRect, brush\brushDefault)
;               Colors(1) = GetSysColor_(#COLOR_WINDOWTEXT)  ; the default text 
							EndIf
							InflateRect_(subItemRect, -2, 0) 

              For idx = 1 To CountString(text$, #SelectedWordMarker$) + 1 
                t$ = StringField(text$, idx, #SelectedWordMarker$) 
                If t$ 
                  SetTextColor_(*lvCD\nmcd\hdc, colors(idx & 1)) 
                  DrawText_(*lvCD\nmcd\hdc, t$, -1, subItemRect, #DT_END_ELLIPSIS|#DT_VCENTER|#DT_SINGLELINE) 
                  subItemRect\left + GetCharWidth(*nmhdr\hwndFrom, t$)
                EndIf 
              Next idx 
                
; --- old code 
; ; ; ; ; ; ; 	pos = FindString(text$, #coloredChars_Delimeter,1)
; ; ; ; ; ; ; 	If pos
; ; ; ; ; ; ; 		subItemText$ = Left(text$, pos-1)
; ; ; ; ; ; ; 		text$ = Right(text$, Len(text$)-pos+1)
; ; ; ; ; ; ; 	Else
; ; ; ; ; ; ; 		subItemText$ = text$
; ; ; ; ; ; ; 		text$=""
; ; ; ; ; ; ; 	EndIf
; ; ; ; ; ; ; 	Dim LVColor(Len(subItemText$))
; ; ; ; ; ; ; 	pos=2
; ; ; ; ; ; ; 	For i = 1 To CountString(text$, #coloredChars_Delimeter)
; ; ; ; ; ; ; 		color = Val(StringField(StringField(text$,pos+2,"\"),1,"{"))
; ; ; ; ; ; ; 		For j = Val(StringField(text$,pos,"\")) To Val(StringField(text$,pos+1,"\"))
; ; ; ; ; ; ; 			LVColor(j) = color
; ; ; ; ; ; ; 		Next
; ; ; ; ; ; ; 		pos+3
; ; ; ; ; ; ; 	Next
; ; ; ; ; ; ; 
; ; ; ; ; ; ; 	If GetGadgetState(#frmMain_References) = thisRow
; ; ; ; ; ; ; 		;... If item is selected
; ; ; ; ; ; ; 		FillRect_(*lvCD\nmcd\hdc, subItemRect, brush\brushSelected)
; ; ; ; ; ; ; 	Else
; ; ; ; ; ; ; 		;... If item is not selected
; ; ; ; ; ; ; 		FillRect_(*lvCD\nmcd\hdc, subItemRect, brush\brushDefault)
; ; ; ; ; ; ; 	EndIf
; ; ; ; ; ; ; 	InflateRect_(subItemRect,-2,0)
; ; ; ; ; ; ; 
; ; ; ; ; ; ; 	;... Here we will paste together the colored characters
; ; ; ; ; ; ; 	;... to form a string. This should speed up the drawing
; ; ; ; ; ; ; 	For c = 1 To Len(subItemText$)
; ; ; ; ; ; ; 		c$ = Mid(subItemText$, c, 1)
; ; ; ; ; ; ; 		If thisRow <> GetGadgetState(#frmMain_References)
; ; ; ; ; ; ; 			For i = c + 1 To Len(subItemText$)
; ; ; ; ; ; ; 				thisColor = LVColor(c)
; ; ; ; ; ; ; 				nextColor = LVColor(i)
; ; ; ; ; ; ; 				If thisColor = nextColor
; ; ; ; ; ; ; 					c$ + Mid(subItemText$, i, 1)
; ; ; ; ; ; ; 					c + 1
; ; ; ; ; ; ; 				Else
; ; ; ; ; ; ; 					Break
; ; ; ; ; ; ; 				EndIf
; ; ; ; ; ; ; 			Next i
; ; ; ; ; ; ; 			SetTextColor_(*lvCD\nmcd\hdc, thisColor)
; ; ; ; ; ; ; 		Else
; ; ; ; ; ; ; 			SetTextColor_(*lvCD\nmcd\hdc, GetSysColor_(#COLOR_HIGHLIGHTTEXT))
; ; ; ; ; ; ; 		EndIf
; ; ; ; ; ; ; 		DrawText_(*lvCD\nmcd\hdc, c$, Len(c$), subItemRect, #DT_END_ELLIPSIS|#DT_VCENTER|#DT_SINGLELINE)
; ; ; ; ; ; ; 		subItemRect\left + GetCharWidth(*nmhdr\hwndFrom, c$)
; ; ; ; ; ; ; 	Next c

							Result = #CDRF_SKIPDEFAULT
						Else
							Result = #CDRF_DODEFAULT
						EndIf
				EndSelect
			EndIf
	EndSelect
	ProcedureReturn Result
EndProcedure

; ---------------------------------------------------------------------------------------------------------------------

Procedure.s LTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
	Protected *memChar, *c.Character, *jc.Character
	
	If Not Asc(String$)
		ProcedureReturn ""
	EndIf
	
	*c.Character = @String$
	*memChar = @TrimChar$
	
	While *c\c
		*jc.Character = *memChar
		
		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 SetGadgetBorderless(Gadget) 
  Protected hGad = GadgetID(Gadget) 
  SetWindowLongPtr_(hGad, #GWL_EXSTYLE, GetWindowLongPtr_(hGad, #GWL_EXSTYLE) & (~#WS_EX_CLIENTEDGE))  
  ProcedureReturn SetWindowPos_(hGad, 0, 0, 0, 0, 0, #SWP_SHOWWINDOW | #SWP_NOZORDER | #SWP_NOSIZE | #SWP_NOMOVE | #SWP_FRAMECHANGED)  
EndProcedure 


; ; ; Global hGUI
; ; ; 
; ; ; Procedure Redraw()
; ; ; 	Protected rc.RECT
; ; ; 		With rc
; ; ; 			rc\left = 10
; ; ; 			rc\right = 50
; ; ; 			rc\top = 10
; ; ; 			rc\bottom = 300 - 10
; ; ; 		EndWith
; ; ; 		RedrawWindow_(hGUI, rc, 0, #RDW_ERASE|#RDW_INVALIDATE|#RDW_ERASENOW)
; ; ; EndProcedure

; ---------------------------------------------------------------------------------------------------------------------

Procedure main() 
  Protected WWE ;, idx, pos, le 

  Initialization()  ; 
  LookForWordUnderCursor() 

  If OpenWindow(#frmMain, #PB_Ignore, #PB_Ignore, 600, 300,
               ;"Display all: '" + SelectedWord + "', " + Str(ListSize(FoundReference())), 
                "Display all: '" + SelectedWord + "', Found " + CountSelectedWords + " in " + Str(ListSize(FoundReference())) + " Lines", 
                #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
    StickyWindow(#frmMain, #True)
    SetWindowCallback(@myWindowCallback()) 

    ListIconGadget(#frmMain_References, 8, 8, WindowWidth(#frmMain) - 16, WindowHeight(#frmMain) - 16, "Line ", 96, #PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines|#PB_ListIcon_AlwaysShowSelection)
    AddGadgetColumn(#frmMain_References, 1, "Reference ", 400)

    SetGadgetBorderless(#frmMain_References)  ; by me 

    ForEach FoundReference()
    	FoundReference()\Reference = LTrimChar(FoundReference()\Reference, " " + #TAB$)

      ; >> first attempt to mark the selected word in the string 
      FoundReference()\Reference = ReplaceString(FoundReference()\Reference, SelectedWord, #SelectedWordMarker$ + SelectedWord + #SelectedWordMarker$, #PB_String_NoCase) 

    	AddGadgetItem(#frmMain_References, -1, Str(FoundReference()\LineNo) + #LF$ + FoundReference()\Reference)
    Next

    ; SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 0, #LVSCW_AUTOSIZE_USEHEADER)
    ; SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 1, #LVSCW_AUTOSIZE)
    ; SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 2, #LVSCW_AUTOSIZE)
    SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 0, #LVSCW_AUTOSIZE_USEHEADER) 
    SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 1, #LVSCW_AUTOSIZE_USEHEADER)  ; last column -> fill the remaining rest 


    AddKeyboardShortcut(#frmMain, #PB_Shortcut_Escape, #frmMain_Shortcut_Escape_Event)
    BindEvent(#PB_Event_SizeWindow, @frmMain_SizeWindow_Event(), #frmMain)
    BindGadgetEvent(#frmMain_References, @frmMain_References_Event())
    SetActiveGadget(#frmMain_References)

;     le = Len(SelectedWord)
;     idx = 0 
; 
;     ForEach FoundReference()
; 	
; ; ReplaceString(text$, SelectedWord, #SelectedWordMarker$ + SelectedWord + #SelectedWordMarker$) 
;     	FoundReference()\Reference = ReplaceString(FoundReference()\Reference, SelectedWord, #SelectedWordMarker$ + SelectedWord + #SelectedWordMarker$, #PB_String_NoCase) 
; Debug " ==> " + FoundReference()\Reference 
; 	
;     	pos = FindString(FoundReference()\Reference, SelectedWord, 1, #PB_String_NoCase)
;     	SetColor(#frmMain_References, idx, 1, pos, pos + le - 1, #CornflowerBlue) ; !=    ; #Red)
;       idx + 1 
;     Next 

   ;Redraw()

    Repeat 
      WWE = WaitWindowEvent()
      If (WWE = #PB_Event_Menu And EventMenu() = #frmMain_Shortcut_Escape_Event) Or (WWE = #PB_Event_CloseWindow)
        Break ; bye 
      EndIf  
    ForEver 

    DeleteObject_(brush\brushSelected)  ; objects created by CreateSolidBrush_() needs this! 
  EndIf 
  ProcedureReturn 0  ; not necessary, but looks good/better 
EndProcedure 

End main() 

;----== Bottom of File ==----------------------------------------------------------------------------------------------
Mostly running PureBasic <latest stable version and current alpha/beta> (x64) on Windows 11 Home
User avatar
Caronte3D
Addict
Addict
Posts: 1027
Joined: Fri Jan 22, 2016 5:33 pm
Location: Some Universe

Re: Show all occurrences of a word in the IDE

Post by Caronte3D »

Very useful, thanks! :wink:
Allen
User
User
Posts: 92
Joined: Wed Nov 10, 2021 2:05 am

Re: Show all occurrences of a word in the IDE

Post by Allen »

Axolotl,

Thanks for the update. I like the colored output.

Allen
AZJIO
Addict
Addict
Posts: 1316
Joined: Sun May 14, 2017 1:48 am

Re: Show all occurrences of a word in the IDE

Post by AZJIO »

The fact that the function for highlighting words has been reduced is great.

Previously, there were problems, if you select the variable "i", then it was highlighted 2 characters at the end of the string "i)", also the problem was not highlighted at the end of the string, for example "z.i". Also I tried to use regex to capture only whole words "\b" + SelectedWord + "\b" but it caused problem with "$" and "*" characters even if I escaped them with "\$" and "\ *" or "\b\Q" + SelectedWord + "\E\b". Then "i" would not be highlighted in the lines "Find", "pid", etc.

There was also an idea to remove the heading, since the purpose of the columns is clear even without it, but add a field for the regular expression on top. Since we have all the lines in the array, we can do a re-search not according to the %WORD% rule, which limits us, but without any rules at all. That is, we enter any string that we want to find and get the result. For example to get all WinAPI functions:

Code: Select all

(?mi)[a-z][\da-z]*_(?=\h*\()
And even it could be a combobox with ready-made regular expressions and with comments what it is intended for, for example

Code: Select all

(?# Link )https?://[\w.:]+/?(?:[\w/?&=.~;\+!*_#%-]+)
here (?# Link ) shows the purpose of the regular expression. In a sense, this will act as a procedure panel, but only with its own rules.
AZJIO
Addict
Addict
Posts: 1316
Joined: Sun May 14, 2017 1:48 am

Re: Show all occurrences of a word in the IDE

Post by AZJIO »

Axolotl
Maybe you can do it, because I'm already confused and will try later.

I have added the GoRegExp() function. The ExtractRegularExpression function does not return positions, so I enumerate the elements using NextRegularExpressionMatch. When I got the element, I check how many line breaks there are before this position and this will mean the line number. Next, I cut off the viewed part of the text so as not to repeat the search on it and look for the regular expression again, but now the number of lines is added to the previous result, because I cut it off. In this case, my search spends less megaflops. But maybe I'm getting confused with the positions, because I'm looking in the original text, and I'm searching for the line number using the cut text.


Not working code

Code: Select all

; deleted
Last edited by AZJIO on Wed Feb 15, 2023 8:08 am, edited 1 time in total.
Allen
User
User
Posts: 92
Joined: Wed Nov 10, 2021 2:05 am

Re: Show all occurrences of a word in the IDE

Post by Allen »

Hi,

After some search, I found another way to get the word under cursor. The advantage of this method is it will take into account of the preference setting of the IDE, it will handle "the extra characters included in word selection".

Add below procedure and
Replace this line "SelectedWord.s = GetEnvironmentVariable("PB_TOOL_Word")"
with "SelectedWord.s=GetWordUnderCursor()"

The extra scanning with the addition of "*" or "#" is not required.
However, eventhough the "%" char is included in word selection, the scanning process seems consider it an invalid selection and no match will be shown.

Code: Select all

Procedure.s GetWordUnderCursor()
  Protected.s WordUnderCursor, ClipBoardContent
  Protected.i Cursor,Start,Stop
  SendMessage_(ScintillaHandle,#SCI_BEGINUNDOACTION,#Null,#Null)
  If SendMessage_(ScintillaHandle,#SCI_GETSELECTIONEMPTY,#Null,#Null)
    Cursor.i = SendMessage_(ScintillaHandle,#SCI_GETCURRENTPOS,#Null,#Null)
    Start.i = SendMessage_(ScintillaHandle,#SCI_WORDSTARTPOSITION, Cursor, #True)
    Stop.i = SendMessage_(ScintillaHandle,#SCI_WORDENDPOSITION, Cursor, #True)
    SendMessage_(ScintillaHandle,#SCI_SETSEL, Start, Stop)
  EndIf
  ClipBoardContent= GetClipboardText() ; store clipboard content
  SendMessage_(ScintillaHandle,#SCI_COPY,#Null,#Null) ; copy selection to clipbiard
  WordUnderCursor=GetClipboardText()
  SetClipboardText(ClipBoardContent) ; restore clipboard content 
  SendMessage_(ScintillaHandle,#SCI_ENDUNDOACTION,#Null,#Null)
  ProcedureReturn WordUnderCursor
EndProcedure
Allen
AZJIO
Addict
Addict
Posts: 1316
Joined: Sun May 14, 2017 1:48 am

Re: Show all occurrences of a word in the IDE

Post by AZJIO »

Added regular expressions (function GoRegExp()). The code is modernized by the author Axolotl
Updated post. Added many regular expressions (16 pieces). When selected, the item is automatically applied.
Updated post. Added CopyClipboardReference() by ChrisR

Code: Select all

; ----------------------------------------------------------------------------
; File : FindAllReferences[Win].pb
; ----------------------------------------------------------------------------
;
;   Description: Find all references of a variable
;            OS: Windows
; English-Forum:
;  French-Forum:
;  German-Forum: http://www.purebasic.fr/german/viewtopic.php?f=8&t=28292
; ----------------------------------------------------------------------------

; MIT License
;
; Copyright (c) 2015 Kiffi
;
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
;
; The above copyright notice and this permission notice shall be included in all
; copies or substantial portions of the Software.
;
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
; SOFTWARE.
;
; ----------------------------------------------------------------------------
; Change Log :
;   2023-02-12 : New Additions from Mesa, AZJIO, Axolotl
;
; English-Forum: https://www.purebasic.fr/english/viewtopic.php?t=80739
;
; Change Details by Axolotl
;   - Integrated ColorListIconGadget.pb from AZJIO and modified
;   - Add a #PB_Compiler_Debugger mode (for development)
;   - New Structure of the entire application
;   - harmonize the different coding styles (still something to do)
;   - Changing the coloring of the selected words
;   - counting all appearances of the SelectedWord (quick and dirty)
;
; ----------------------------------------------------------------------------

; FindAllReferences

CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
	CompilerError "Windows Only!"
CompilerEndIf

EnableExplicit

; ---== Structure Definition ==----------------------------------------------------------------------------------------

Structure sFoundReference
	LineNo.i
	Reference.s
	Selregexp.s

EndStructure

; ---== Enumeration ==-------------------------------------------------------------------------------------------------

Enumeration ; Windows
	#frmMain
EndEnumeration

Enumeration ; Gadgets
	#cmbRex
	#btnRex
	; 	#btnClose
	#frmMain_References
EndEnumeration

Enumeration ; Menu-/Toolbaritems
	#frmMain_Shortcut_Escape_Event
	#Shortcut_Ctrl_C
EndEnumeration

; ---== Constants ==---------------------------------------------------------------------------------------------------

CompilerIf #PB_Compiler_Debugger
	#SelectedWordMarker$ = "|"
CompilerElse
	#SelectedWordMarker$ = Chr(1)  ; not used in source codes
CompilerEndIf
; "	 Line = Trim(Line)"
; "	 |Line| = Trim(|Line|)"
; --> ReplaceString(text$, SelectedWord, #SelectedWordMarker$ + SelectedWord + #SelectedWordMarker$)

;/-----------------------------------------------------------------------------
;| RGB() as HEX() -->     BB GG RR   .. i.e. RGB (1, 2, 3)    -->    03 02 01
;| RGB() as HEX() -->  AA BB GG RR   .. i.e. RGBA(1, 2, 3, 4) --> 04 03 02 01
;\

#coloredChars_Delimeter = "{***\"

; ---== Global Variables ==--------------------------------------------------------------------------------------------

Global PbIdeHandle, ScintillaHandle

Global SelectedWord.s, ScintillaText.s
Global CountSelectedWords    ; new, because we want to know all references (not only the lines)
Global NewList FoundReference.sFoundReference()
Global Dim Lines.s(0)

; ; ; Global PbIdeHandle = Val(GetEnvironmentVariable("PB_TOOL_MainWindow"))
; ; ; If PbIdeHandle = 0 : End : EndIf
; ; ;
; ; ; Global ScintillaHandle = Val(GetEnvironmentVariable("PB_TOOL_Scintilla"))
; ; ; If ScintillaHandle = 0 : End : EndIf

; ---== Procedures ==--------------------------------------------------------------------------------------------------

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

	If Not Asc(String$)
		ProcedureReturn ""
	EndIf

	*c.Character = @String$
	*memChar = @TrimChar$

	While *c\c
		*jc.Character = *memChar

		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 RemoveLeadingWhitespaceFromString(InString.s)
	While Left(InString, 1) = Chr(32) Or Left(InString, 1) = Chr(9)
		InString = LTrim(InString, Chr(32))
		InString = LTrim(InString, Chr(9))
	Wend
	ProcedureReturn InString
EndProcedure

; ---------------------------------------------------------------------------------------------------------------------

Procedure.s GetScintillaText()
	Protected ReturnValue.s
	Protected length
	Protected buffer
	Protected processId
	Protected hProcess
	Protected result

	length = SendMessage_(ScintillaHandle, #SCI_GETLENGTH, 0, 0)
	If length
		length + 2
		buffer = AllocateMemory(length)
		If buffer
			SendMessageTimeout_(ScintillaHandle, #SCI_GETCHARACTERPOINTER, 0, 0, #SMTO_ABORTIFHUNG, 2000, @result)
			If result
				GetWindowThreadProcessId_(ScintillaHandle, @processId)
				hProcess = OpenProcess_(#PROCESS_ALL_ACCESS, #False, processId)
				If hProcess
					ReadProcessMemory_(hProcess, result, buffer, length, 0)
					ReturnValue = PeekS(buffer, -1, #PB_UTF8)
					CloseHandle_(hProcess)  ; <-- Axolotl, added acc. to MSDN
				EndIf
			EndIf
		EndIf
		FreeMemory(buffer)
	EndIf
	ProcedureReturn ReturnValue
EndProcedure

; ---------------------------------------------------------------------------------------------------------------------

Procedure Initialization()

	PbIdeHandle = Val(GetEnvironmentVariable("PB_TOOL_MainWindow"))
	CompilerIf Not #PB_Compiler_Debugger
		If PbIdeHandle = 0 : End : EndIf
	CompilerEndIf

	ScintillaHandle = Val(GetEnvironmentVariable("PB_TOOL_Scintilla"))
	CompilerIf Not #PB_Compiler_Debugger
		If ScintillaHandle = 0 : End : EndIf
	CompilerEndIf


	SelectedWord.s = GetEnvironmentVariable("PB_TOOL_Word")
	CompilerIf Not #PB_Compiler_Debugger
		If SelectedWord = "" : End : EndIf
	CompilerEndIf

	ScintillaText.s = GetScintillaText()
	CompilerIf Not #PB_Compiler_Debugger
		If ScintillaText = "" : End : EndIf
	CompilerEndIf

	; >> These are test pattern for development
	CompilerIf #PB_Compiler_Debugger

		If SelectedWord = ""
			;     SelectedWord = "Line"    ; try one of these
			;     SelectedWord = "#Line"   ; -"-  #Line could be in a comment also
			SelectedWord = "ScintillaText"   ; -"-
		EndIf

		If ScintillaText = ""
			#File = 0
			If ReadFile(#File, #PB_Compiler_File)
				ScintillaText = ReadString(#File, #PB_UTF8 | #PB_File_IgnoreEOL)
				CloseFile(#File)
			EndIf
; 			RunProgram("explorer.exe", "/Select," + #PB_Compiler_File, "")

; 			ScintillaText = "" + #CRLF$ +
; 			                "#Line = #LF ;  #Line could be in a comment also " + #CRLF$ +
; 			                "Procedure Test(*Line)  ; pointer *Line " + #CRLF$ +
; 			                "" + #CRLF$ +
; 			                "If SelectedWord = LCase(Tokens(TokenCounter))" + #CRLF$ +
; 			                "	 AddElement(FoundReference())" + #CRLF$ +
; 			                "	 FoundReference()\LineNo = LineCounter + 1" + #CRLF$ +
; 			                "	 Line = Trim(Line)" + #CRLF$ +
; 			                "	 Line = Mid(Line, 1, Len(Line)-2)" + #CRLF$ +
; 			                "	 FoundReference()\Reference = Line" + #CRLF$ +
; 			                "EndIf" + #CRLF$ +
; 			                "" ; End of Text
		EndIf
	CompilerEndIf
	ProcedureReturn 0  ; default (ZERO is returned by default, even if there is no ProcedureReturn)
EndProcedure

; ---------------------------------------------------------------------------------------------------------------------

; ChrisR
Procedure CopyClipboardReference()
	Protected text$
	PushListPosition(FoundReference()) 
	ForEach FoundReference()
		If text$ : text$ + #CRLF$ : EndIf
		If Right(FoundReference()\Reference, 2) = #CRLF$
			text$ + Left(FoundReference()\Reference, Len(FoundReference()\Reference) - 2)
		Else
			text$ + FoundReference()\Reference
		EndIf
	Next
	PopListPosition(FoundReference())
	If text$
		text$ = ReplaceString(text$, #SelectedWordMarker$, "")
		SetClipboardText(text$)
		Protected Title$ = GetWindowTitle(#frmMain)
		SetWindowTitle(#frmMain, Title$ + " (Reference copied To the clipboard)")
		Delay(500)
		SetWindowTitle(#frmMain, Title$)
	EndIf
EndProcedure

; AZJIO
Procedure GoRegExp()
	; LINK : https://www.purebasic.fr/english/viewtopic.php?p=595832#p595832
	Protected rex, LSize, Pos = 0, i, tmp$
	Protected Dim Tokens.s(0)
	
	ClearGadgetItems(#frmMain_References)
	ClearList(FoundReference())
	
	tmp$ = GetGadgetText(#cmbRex)
	If Not Asc(tmp$)
		ProcedureReturn
	EndIf
	rex = CreateRegularExpression(#PB_Any, tmp$)
	; 	CountTokens = ExtractRegularExpression(rex, ScintillaText, Tokens()) ; tokenize the line
	
	; 	Debug ArraySize(Lines())
	
	If rex
		If ExamineRegularExpression(rex, ScintillaText)
			While NextRegularExpressionMatch(rex)
				If Not FindString(RegularExpressionMatchString(rex), #LF$)
					AddElement(FoundReference())
					FoundReference()\Selregexp = RegularExpressionMatchString(rex)
					FoundReference()\LineNo = RegularExpressionMatchPosition(rex)
; 					Debug  FoundReference()\LineNo
				EndIf
			Wend
		EndIf
	Else
		MessageRequester("Regular expression error", RegularExpressionError())
		ProcedureReturn
	EndIf
	
	LSize = ListSize(FoundReference())
	If LSize > 0
; 		If LSize > 5000 And MessageRequester("Continue?", "Found" + Str(LSize) + " rows, Continue?", #PB_MessageRequester_YesNo) = #PB_MessageRequester_No
; 			ProcedureReturn
; 		EndIf
		
		Pos = 0
		i = 0
		SendMessage_(GadgetID(#frmMain_References), #WM_SETREDRAW, 0, 0)
		ForEach FoundReference()
			While Pos < FoundReference()\LineNo
				Pos = FindString(ScintillaText, #LF$, Pos + 1)
				If Pos
					i + 1
				Else
					Break
				EndIf
; 				Debug Str(FoundReference()\LineNo) + " "  + Str(Pos)
			Wend
			If i < 1 Or i > ArraySize(Lines())
				Continue
			EndIf
			FoundReference()\LineNo = i
			FoundReference()\Reference = Lines(i - 1)
			
			
			FoundReference()\Reference = LTrimChar(FoundReference()\Reference, " " + #TAB$)
			
			; >> first attempt to mark the selected word in the string
			FoundReference()\Reference = ReplaceString(FoundReference()\Reference, FoundReference()\Selregexp, #SelectedWordMarker$ + FoundReference()\Selregexp + #SelectedWordMarker$, #PB_String_NoCase)
			
			AddGadgetItem(#frmMain_References, -1, Str(FoundReference()\LineNo) + #LF$ + FoundReference()\Reference)
		Next
; 		SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 0, #LVSCW_AUTOSIZE_USEHEADER)
; 		SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 1, #LVSCW_AUTOSIZE_USEHEADER)  ; last column -> fill the remaining rest
		SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 0, #LVSCW_AUTOSIZE)
		SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 1, #LVSCW_AUTOSIZE)
		SendMessage_(GadgetID(#frmMain_References), #WM_SETREDRAW, 1, 0)
		
		SelectedWord = "regexp"
		SetWindowTitle(#frmMain, "Display all: '" + SelectedWord + "', Found " + " in " + Str(ListSize(FoundReference())) + " Lines")
	EndIf
EndProcedure


Procedure LookForWordUnderCursor()
	; LINK : http://www.purebasic.fr/english/viewtopic.php?f=12&t=37823
	Protected RegexLines, PbRegexTokens
	Protected CountLines, LineCounter, CountTokens, TokenCounter
	Protected Line.s, selWord.s, stx.s
	Protected Dim Tokens.s(0)

	RegexLines = CreateRegularExpression(#PB_Any , ".*\r\n")
	PbRegexTokens = CreateRegularExpression(#PB_Any, #DOUBLEQUOTE$ + "[^" + #DOUBLEQUOTE$ + "]*" + #DOUBLEQUOTE$ + "|[\*]?[a-zA-Z_]+[\w]*[\x24]?|#[a-zA-Z_]+[\w]*[\x24]?|[\[\]\(\)\{\}]|[-+]?[0-9]*\.?[0-9]+|;.*|\.|\+|-|[&@!\\\/\*,\|]|::|:|\|<>|>>|<<|=>{1}|>={1}|<={1}|=<{1}|={1}|<{1}|>{1}|\x24+[0-9a-fA-F]+|\%[0-1]*|%|'")

	CountLines = CountString(ScintillaText, #CRLF$)

	CountLines = ExtractRegularExpression(RegexLines, ScintillaText, Lines())

	selWord = LCase(SelectedWord)  ; keep the original writing
	CountSelectedWords = 0		   ; init for new search

	For LineCounter = 0 To CountLines - 1
		Line = Lines(LineCounter)

		;Debug "tokenize Line '" + Line + "'"

		CountTokens = ExtractRegularExpression(PbRegexTokens, Line, Tokens()) ; tokenize the line

		For TokenCounter = 0 To CountTokens - 1
			;Debug "  check Token '" + Tokens(TokenCounter) + "'"

			If selWord = LCase(Tokens(TokenCounter))
				AddElement(FoundReference())
				FoundReference()\LineNo = LineCounter + 1

				Line = Trim(Line)
				Line = Mid(Line, 1, Len(Line)-2)  ; remove the #CRLF$

				CountSelectedWords + CountString(LCase(Line), selWord)   ; <-- count SelectedWord in the codeline

				FoundReference()\Reference = Line
				Break  ; only one line (evenn if there are more than one SelectedWord )
			EndIf
		Next TokenCounter
	Next LineCounter

	; because of #Constant or *Pointer
	If ListSize(FoundReference()) = 0
		For LineCounter = 0 To CountLines - 1
			Line = Lines(LineCounter)
			CountTokens = ExtractRegularExpression(PbRegexTokens, Line, Tokens())
			For TokenCounter = 0 To CountTokens - 1
				stx = LCase(Tokens(TokenCounter))
				If stx = "#"+selWord Or stx = "*"+selWord
					AddElement(FoundReference())
					FoundReference()\LineNo = LineCounter + 1

					Line = Trim(Line)
					Line = Mid(Line, 1, Len(Line)-2)

					CountSelectedWords + CountString(LCase(Line), stx)  ; <-- count SelectedWord in the codeline

					FoundReference()\Reference = Line
					Break
				EndIf
			Next
		Next

		CompilerIf Not #PB_Compiler_Debugger
			If ListSize(FoundReference()) = 0 : End : EndIf
		CompilerEndIf
	EndIf
EndProcedure



; ---------------------------------------------------------------------------------------------------------------------
; XIncludeFile "ColorListIconGadget.pbi"  ; I prefer .pbi (instead of .pb)
; ---------------------------------------------------------------------------------------------------------------------

;... Create brushes for painting item background
Structure MYBRUSHES
	brushDefault.l
	brushSelected.l
EndStructure

Global brush.MYBRUSHES
Global Dim Colors(1)

; brush\brushSelected = CreateSolidBrush_(GetSysColor_(#COLOR_HIGHLIGHT))
brush\brushSelected = CreateSolidBrush_(GetSysColor_(#COLOR_INFOBK))
brush\brushDefault = GetStockObject_(#WHITE_BRUSH)


; ---== Color for Default Text and Selected Word ==--------------------------------------------------------------------


; Colors(0) = #Red                                ; the SelectedWord
Colors(0) = #Red                           ; the SelectedWord
										   ; Colors(1) = GetSysColor_(#COLOR_HIGHLIGHTTEXT)  ; the default text
Colors(1) = GetSysColor_(#COLOR_WINDOWTEXT); the default text

; ---------------------------------------------------------------------------------------------------------------------

Procedure GetCharWidth(gad, c$)
	ProcedureReturn SendMessage_(gad, #LVM_GETSTRINGWIDTH, 0, @c$)
EndProcedure

; ---------------------------------------------------------------------------------------------------------------------

;Here we add some text to the underlying cell text to store the color info.
Procedure SetColor(gad, row, column, startp, endp, color)
	Protected text$
	If column
		text$ = GetGadgetItemText(gad, row, column)
		;Now add the new text.
		text$+#coloredChars_Delimeter+Str(startp)+"\"+Str(endp)+"\"+Str(color)
		SetGadgetItemText(gad,row,text$,column)
	EndIf
EndProcedure


; ---== MainWindow Procedures ==---------------------------------------------------------------------------------------

Procedure frmMain_SizeWindow_Event()
	ResizeGadget(#cmbRex, #PB_Ignore, #PB_Ignore, WindowWidth(#frmMain) - 60, 24)
	ResizeGadget(#btnRex, WindowWidth(#frmMain) - 54, #PB_Ignore, #PB_Ignore, #PB_Ignore)
	ResizeGadget(#frmMain_References, #PB_Ignore, #PB_Ignore, WindowWidth(#frmMain) - 6, WindowHeight(#frmMain) - 33)
	SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 1, #LVSCW_AUTOSIZE_USEHEADER)  ; last column -> fill the remaining rest
EndProcedure

Procedure frmMain_References_Event()
	Protected SelectedLine

	SelectedLine = Val(GetGadgetItemText(#frmMain_References, GetGadgetState(#frmMain_References), 0))
	If SelectedLine > 0
		SendMessage_(ScintillaHandle, #SCI_GOTOLINE, SelectedLine - 1, 0)
		SendMessage_(ScintillaHandle, #SCI_ENSUREVISIBLE, SelectedLine - 1, 0)
		SetForegroundWindow_(PbIdeHandle)
		SetActiveWindow_(PbIdeHandle)
	EndIf
EndProcedure

; ---------------------------------------------------------------------------------------------------------------------

Procedure myWindowCallback(hwnd, msg, wParam, lParam)
	Protected Result, *nmhdr.NMHDR, *lvCD.NMLVCUSTOMDRAW, subItemRect.RECT
	Protected thisRow, thisCol, idx
	Protected t$, text$
	; ; ; ; ; ; ; 	Protected subItemText$, pos, color, c$, nextColor, thisColor

	Result = #PB_ProcessPureBasicEvents
	;;Dim LVColor(0)

	Select msg
		Case #WM_NOTIFY
			*nmhdr.NMHDR = lParam
			*lvCD.NMLVCUSTOMDRAW = lParam
			If *lvCD\nmcd\hdr\hwndFrom = GadgetID(#frmMain_References) And *lvCD\nmcd\hdr\code = #NM_CUSTOMDRAW
				Select *lvCD\nmcd\dwDrawStage
					Case #CDDS_PREPAINT
						Result = #CDRF_NOTIFYITEMDRAW
					Case #CDDS_ITEMPREPAINT
						Result = #CDRF_NOTIFYSUBITEMDRAW;
					Case #CDDS_ITEMPREPAINT | #CDDS_SUBITEM
						thisRow = *lvCD\nmcd\dwItemSpec
						thisCol = *lvCD\iSubItem
						If thisCol
							;... Define rect for text
							subItemRect.RECT\left = #LVIR_LABEL
							subItemRect.RECT\top = *lvCD\iSubItem
							;... Get the subitem rect
							SendMessage_(GadgetID(#frmMain_References), #LVM_GETSUBITEMRECT, thisRow, @subItemRect)

							text$ = GetGadgetItemText(#frmMain_References, thisRow, thisCol)

							If GetGadgetState(#frmMain_References) = thisRow
								;... If item is selected
								FillRect_(*lvCD\nmcd\hdc, subItemRect, brush\brushSelected)
								;               Colors(1) = GetSysColor_(#COLOR_HIGHLIGHTTEXT)  ; the default text
							Else
								;... If item is not selected
								FillRect_(*lvCD\nmcd\hdc, subItemRect, brush\brushDefault)
								;               Colors(1) = GetSysColor_(#COLOR_WINDOWTEXT)  ; the default text
							EndIf
							InflateRect_(subItemRect, -2, 0)

							For idx = 1 To CountString(text$, #SelectedWordMarker$) + 1
								t$ = StringField(text$, idx, #SelectedWordMarker$)
								If t$
									SetTextColor_(*lvCD\nmcd\hdc, colors(idx & 1))
									DrawText_(*lvCD\nmcd\hdc, t$, -1, subItemRect, #DT_END_ELLIPSIS|#DT_VCENTER|#DT_SINGLELINE)
									subItemRect\left + GetCharWidth(*nmhdr\hwndFrom, t$)
								EndIf
							Next idx
							Result = #CDRF_SKIPDEFAULT
						Else
							Result = #CDRF_DODEFAULT
						EndIf
				EndSelect
			EndIf
	EndSelect
	ProcedureReturn Result
EndProcedure

; ---------------------------------------------------------------------------------------------------------------------

Procedure SetGadgetBorderless(Gadget)
	Protected hGad = GadgetID(Gadget)
	SetWindowLongPtr_(hGad, #GWL_EXSTYLE, GetWindowLongPtr_(hGad, #GWL_EXSTYLE) & (~#WS_EX_CLIENTEDGE))
	ProcedureReturn SetWindowPos_(hGad, 0, 0, 0, 0, 0, #SWP_SHOWWINDOW | #SWP_NOZORDER | #SWP_NOSIZE | #SWP_NOMOVE | #SWP_FRAMECHANGED)
EndProcedure

; ---------------------------------------------------------------------------------------------------------------------
Procedure main()
	Protected WWE ;, idx, pos, le

	Initialization()  ;
	LookForWordUnderCursor()

	;- GUI
	If OpenWindow(#frmMain, #PB_Ignore, #PB_Ignore, 600, 300,
				"Display all: '" + SelectedWord + "', Found " + CountSelectedWords + " in " + Str(ListSize(FoundReference())) + " Lines",
				#PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
		StickyWindow(#frmMain, #True)
		SetWindowCallback(@myWindowCallback())

		ComboBoxGadget(#cmbRex, 3, 3, WindowWidth(#frmMain) - 60, 24, #PB_ComboBox_Editable)
		AddGadgetItem(#cmbRex, -1, "(?# Debug, All )\bDebug\b")
		AddGadgetItem(#cmbRex, -1, "(?# Debug, real )(?m)^\h*Debug\b")
		AddGadgetItem(#cmbRex, -1, "(?# WinAPI )(?mi)[a-z][\da-z]*_(?=\h*\()")
		AddGadgetItem(#cmbRex, -1, "(?# Link )https?://[\w.:]+/?(?:[\w/?&=.~;\+!*_#%-]+)")
		AddGadgetItem(#cmbRex, -1, "(?# Procedure )(?mi)^\h*(?:Procedure[CDL$]{0,5}?(?:\h*\.[abcdfilqsuw])?\h+\K)[A-Za-z_]\w*\h*(?=\()")
		AddGadgetItem(#cmbRex, -1, "(?# Macro )(?mi)^\h*Macro\h+\K[A-Za-z_]\w*\h*(?=\()")
		AddGadgetItem(#cmbRex, -1, "(?# Var$ )(?<![#@\w])\w+\$")
		AddGadgetItem(#cmbRex, -1, "(?# Hex num )(?i)\$[\da-f]+")
		AddGadgetItem(#cmbRex, -1, "(?# Comments )(?m)^\h*;.*?(?=\r?$)")
		#q$ = Chr(34)
		AddGadgetItem(#cmbRex, -1, "(?# Comments, All )(?m)^(?:[^" + #q$ + ";]*" + #q$ + "[^" + #q$ + "]*?" + #q$ + ")*[^" + #q$ + ";]*(;.*?)(?=\r?$)")
		AddGadgetItem(#cmbRex, -1, "(?# Structures, Declare )(?i)(?<![=\w" + #q$ + "\\./-])[a-z]\w*\.[a-z]\w+(?![\w" + #q$ + "\\./-])")
		AddGadgetItem(#cmbRex, -1, "(?# Structures, item )(?<![\w.:" + #q$ + "\\])\*?\w+(?:(?:\(\))?\\[\d_a-zA-Z]+)+(?![\w" + #q$ + "\\])")
		AddGadgetItem(#cmbRex, -1, "(?# Structures, Content )(?m)^\h*Structure\h*\K\w+")
; 		AddGadgetItem(#cmbRex, -1, ~"(?# Comments )(?m)^(?:[^\";]*\"[^\"]*?\")*[^\";]*(;.*?)(?=\r?$)")
; 		AddGadgetItem(#cmbRex, -1, ~"(?# Structures, Declare )(?i)(?<![=\\w\"\\./-])[a-z]\\w*\\.[a-z]\\w+(?![\\w\"\\\\./-])")
; 		AddGadgetItem(#cmbRex, -1, ~"(?# Structures, item )(?<![\\w.:\"\\\\])\\*?\\w+(?:(?:\\(\\))?\\\\[\\d_a-zA-Z]+)+(?![\\w\"\\\\])")
		AddGadgetItem(#cmbRex, -1, "(?# Types )\b\w+\.[sfdqbliwcapu]\b")
		AddGadgetItem(#cmbRex, -1, "(?# Constants, Declare )(?m)^\h*\K#\w+(?=\h*(?:=|\r?$))")
		AddGadgetItem(#cmbRex, -1, "(?# Constants, All )#\w+\b")

		ButtonGadget(#btnRex, WindowWidth(#frmMain) - 54, 3, 24, 24, ">") ; Chr($25BA)
		; ButtonGadget(#btnClose, WindowWidth(#frmMain) - 27, 3, 24, 24, "x") ; to make a black theme

		ListIconGadget(#frmMain_References, 3, 30, WindowWidth(#frmMain) - 6, WindowHeight(#frmMain) - 33, "Line ", 96, #PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines|#PB_ListIcon_AlwaysShowSelection)
		SetWindowLongPtr_(GadgetID(#frmMain_References),#GWL_STYLE,GetWindowLongPtr_(GadgetID(#frmMain_References),#GWL_STYLE) | #LVS_NOCOLUMNHEADER)
		AddGadgetColumn(#frmMain_References, 1, "Reference ", 400)

		SetGadgetBorderless(#frmMain_References)  ; by me

		ForEach FoundReference()
			FoundReference()\Reference = LTrimChar(FoundReference()\Reference, " " + #TAB$)

			; >> first attempt to mark the selected word in the string
			FoundReference()\Reference = ReplaceString(FoundReference()\Reference, SelectedWord, #SelectedWordMarker$ + SelectedWord + #SelectedWordMarker$, #PB_String_NoCase)

			AddGadgetItem(#frmMain_References, -1, Str(FoundReference()\LineNo) + #LF$ + FoundReference()\Reference)
		Next

; 		SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 0, #LVSCW_AUTOSIZE_USEHEADER)
; 		SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 1, #LVSCW_AUTOSIZE_USEHEADER)  ; last column -> fill the remaining rest
		SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 0, #LVSCW_AUTOSIZE)
		SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 1, #LVSCW_AUTOSIZE)


		AddKeyboardShortcut(#frmMain, #PB_Shortcut_Escape, #frmMain_Shortcut_Escape_Event)
		BindEvent(#PB_Event_SizeWindow, @frmMain_SizeWindow_Event(), #frmMain)
		BindGadgetEvent(#frmMain_References, @frmMain_References_Event())
		SetActiveGadget(#frmMain_References)

		AddKeyboardShortcut(#frmMain, #PB_Shortcut_Control | #PB_Shortcut_C, #Shortcut_Ctrl_C)


		Repeat
			Select WaitWindowEvent()
				Case #PB_Event_CloseWindow
					Break
				Case #PB_Event_Menu
					Select EventMenu()
						Case #Shortcut_Ctrl_C
							CopyClipboardReference()
						Case #frmMain_Shortcut_Escape_Event
							Break
					EndSelect
				Case #PB_Event_Gadget
					Select EventGadget()
						Case #btnRex, #cmbRex
							GoRegExp()
					EndSelect
			EndSelect
		ForEver

		DeleteObject_(brush\brushSelected)  ; objects created by CreateSolidBrush_() needs this!
	EndIf
	ProcedureReturn 0  ; not necessary, but looks good/better
EndProcedure

End main()

;----== Bottom of File ==----------------------------------------------------------------------------------------------
Last edited by AZJIO on Wed Feb 15, 2023 4:16 pm, edited 9 times in total.
Mesa
Enthusiast
Enthusiast
Posts: 345
Joined: Fri Feb 24, 2012 10:19 am

Re: Show all occurrences of a word in the IDE

Post by Mesa »

@AZJIO: Wonderfull !
I add two regex for Debug uncommented and All Debug but they don't work very well :?

Code: Select all

AddGadgetItem(#cmbRex, -1, "[^; ]Debug[^Debugger].+")
AddGadgetItem(#cmbRex, -1, "Debug[^Debugger].+")
Could you help me ?

M.
Marc56us
Addict
Addict
Posts: 1477
Joined: Sat Feb 08, 2014 3:26 pm

Re: Show all occurrences of a word in the IDE

Post by Marc56us »

Code: Select all

Debug[^Debugger]
Mean "Debug" followed by Not any char like "D", "e", "b" ... etc (whatever order and count)
Do you mean the word "Debug" Not followed by the word "Debugger" ?
If so, try:

Code: Select all

Debug\h?(?!Debugger).+
And take car of line search or full text

\h? mean at least one horizontal space or tab
(? ) non capture group
!text: negative lookahead

:wink:
AZJIO
Addict
Addict
Posts: 1316
Joined: Sun May 14, 2017 1:48 am

Re: Show all occurrences of a word in the IDE

Post by AZJIO »

Corrected again. I have a crash with \w+. I concluded and found out that the cycle goes on endlessly. I added an exit from the loop and a check that the array index is within the array size

added

Code: Select all

AddGadgetItem(#cmbRex, -1, "(?# Debug, All )\bDebug\b")
AddGadgetItem(#cmbRex, -1, "(?# Debug, real )(?m)^\h*Debug\b")
Now we have to get rid of repeating lines again, so that all elements are highlighted in one line.
User avatar
ChrisR
Addict
Addict
Posts: 1127
Joined: Sun Jan 08, 2017 10:27 pm
Location: France

Re: Show all occurrences of a word in the IDE

Post by ChrisR »

I'm just discovering it, it can be really useful and it would be great as a native tool. Thanks for sharing :)

It could be nice to be able to copy all references in the Clipboard.
To use for example with (?# Procedure ) and copy them to write the Declare procedure

Code: Select all

Procedure CopyClipboardReference()
  Protected text$
  PushListPosition(FoundReference()) 
  ForEach FoundReference()
    If text$ : text$ + #CRLF$ : EndIf
    If Right(FoundReference()\Reference, 2) = #CRLF$
      text$ + Left(FoundReference()\Reference, Len(FoundReference()\Reference) - 2)
    Else
      text$ + FoundReference()\Reference
    EndIf
  Next
  PopListPosition(FoundReference())
  If text$
    text$ = ReplaceString(text$, #SelectedWordMarker$, "")
    SetClipboardText(text$)
    Protected Title$ = GetWindowTitle(#frmMain)
    SetWindowTitle(#frmMain, Title$ + " (Reference copied To the clipboard)")
    Delay(500)
    SetWindowTitle(#frmMain, Title$)
  EndIf
EndProcedure
.....
AddKeyboardShortcut(#frmMain, #PB_Shortcut_Control | #PB_Shortcut_C, #Shortcut_Ctrl_C)
.....
If WWE = #PB_Event_Menu And EventMenu() = #Shortcut_Ctrl_C
  CopyClipboardReference()
EndIf
Post Reply