[Solved] FriendlyName links in EditorGadget

[HeX0R]

I'm trying to add friendlyname links to the editor gadget, which is half-way working already.
I followed the description from here:
https://stackoverflow.com/questions/425 ... -trichedit

I'm somewhat stuck now, maybe some API guru can enlighten me.

Working:
Only the friendly name is shown and is clickable

Not working:
-It only works, when EM_AUTOURLDETECT is disabled (but then the other links, like http://bla.blubb are no longer recognized).
-when clicking on the link, I get the friendly name instead of the underlying link

The strange thing is, when I have EM_AUTOURLDETECT enabled (or not, doesn't make any difference) and paste a friendlyname link (from e.g. libreoffice writer) into the editor, it is clickable and the underlying link is send to the callback.
So, somehow it should be possible and I made something wrong.

Here is the code:

Code: Select all

#CFM_LINKPROTECTED = $800000
#CFE_LINKPROTECTED = $800000
#CFM_HIDDEN        = $100
#CFE_HIDDEN			   = #CFM_HIDDEN
EnableExplicit

Procedure WCallback(hWnd, uMsg, wParam, lParam)
	Protected b$, Result = #PB_ProcessPureBasicEvents
	Protected *el.ENLINK, txt.TEXTRANGE
	
	Select uMsg
		Case #WM_NOTIFY
			*el = lParam
			Select *el\nmhdr\hwndFrom
				Case GadgetID(0)
					If *el\nmhdr\code = #EN_LINK
						If *el\msg = #WM_LBUTTONDOWN
							b$             = Space(2048)
							txt\chrg\cpMin = *el\chrg\cpMin
							txt\chrg\cpMax = *el\chrg\cpMax
							txt\lpstrText  = @b$
							SendMessage_(*el\nmhdr\hwndFrom, #EM_GETTEXTRANGE, 0, @txt)
							Debug b$
						EndIf
					EndIf

			EndSelect
	EndSelect
	ProcedureReturn Result
EndProcedure

;source from:
;https://stackoverflow.com/questions/42532760/adding-true-hyperlink-support-to-trichedit

Procedure SwitchFriendlyLinks(Gadget)
	Protected content$, i, j, Size, PosMainStart, PosLinkStart, PosNameStart, Count, Link$, Name$, format.CHARFORMAT2
	
	content$ = GetGadgetText(Gadget)
	Size     = Len(content$)
	Count    = CountString(content$, ~"HYPERLINK \"")
	For i = 1 To Count
		PosMainStart = FindString(content$,  ~"HYPERLINK \"", PosMainStart + 1)
		PosLinkStart = PosMainStart + 11
		PosNameStart = FindString(content$, #DQUOTE$, PosMainStart + 13)
		Link$        = Mid(content$, PosLinkStart, PosNameStart - PosLinkStart)
		PosNameStart + 1
		Name$ = ""
		For j = PosNameStart To Size
			Select Mid(content$, j, 1)
				Case #LF$, #CR$, " "
					Break
				Default
					Name$ + Mid(content$, j, 1)
			EndSelect
		Next j
		
		format\cbSize = SizeOf(CHARFORMAT2)
		format\dwMask = #CFM_LINK; | #CFM_LINKPROTECTED
  	
		SendMessage_(GadgetID(Gadget), #EM_SETSEL, PosMainStart - 1, PosNameStart + Len(Name$) - 1)
  	format\dwEffects = #CFE_LINK; | #CFE_LINKPROTECTED
  	SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
  	
  	SendMessage_(GadgetID(Gadget), #EM_SETSEL, PosMainStart - 1, PosNameStart - 1)

		format\dwMask    = #CFM_HIDDEN
  	format\dwEffects = #CFE_HIDDEN
  	SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
  	
  	SendMessage_(GadgetID(Gadget), #EM_SETSEL, 0, 0)
		PosMainStart = PosNameStart + Len(Name$)
	Next i
	
EndProcedure


OpenWindow(0, 0, 0, 600, 400, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
EditorGadget(0, 5, 5, 590, 490)
SendMessage_(GadgetID(0), #EM_SETTEXTMODE, #TM_RICHTEXT, 0)
SendMessage_(GadgetID(0), #EM_SETEVENTMASK, 0, SendMessage_(GadgetID(0), #EM_GETEVENTMASK, 0, 0) | #ENM_LINK)
;SendMessage_(GadgetID(0), #EM_AUTOURLDETECT, #True, 0)

SetGadgetText(0, ~"this is a HYPERLINK \"https://purebasic.com\"FriendlyName test" + #CRLF$ + "and a 'normal' one http://www.google.com ")
SwitchFriendlyLinks(0)
SetWindowCallback(@WCallback())

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow

[Axolotl]

I tried some different rtf format for the hyper link.
Maybe this line is of any help.

Code: Select all

SetGadgetText(0, ~"{\\rtf1{\\field{\\*\\fldinst {HYPERLINK \"https://purebasic.com\" }}{\\fldrslt {FriendlyName}}}\\par Some other text\\par " + #CRLF$ + "and a 'normal' one http://www.google.com }")

Ohh, and you don't need the follwing procedure any longer.

Code: Select all

;SwitchFriendlyLinks(0)

And maybe you would like to add the following to your code. (show the original link as tooltip)

Code: Select all

#SES_HYPERLINKTOOLTIPS   =  8
#SES_NOFOCUSLINKNOTIFY   = 32

SendMessage_(GadgetID(0), #EM_SETEDITSTYLE, #SES_HYPERLINKTOOLTIPS|#SES_NOFOCUSLINKNOTIFY, #SES_HYPERLINKTOOLTIPS|#SES_NOFOCUSLINKNOTIFY) 

[HeX0R]

Thanks, but I should have probably mentioned, that the rtf usage is not the aimed solution for me here.
I'm aware of that possibility, but for different reasons, this is not what I wanted to achieve.

[HeX0R]

Got it!
Both problems solved:

Code: Select all

#CFM_LINKPROTECTED = $800000
#CFE_LINKPROTECTED = $800000
#CFM_HIDDEN        = $100
#CFE_HIDDEN			   = #CFM_HIDDEN
#PREFIX_LINK       = ~"HYPERLINK \""
EnableExplicit

Procedure.s ExtractURL(Text$)
	Protected p1, p2, Result$
	
  p1 = FindString(Text$, #PREFIX_LINK) + 11
  p2 = FindString(Text$, #DQUOTE$, p1)
  If p1 > 11 And p2 > p1
    Result$ = Mid(Text$, p1, p2 - p1)
  EndIf
  ProcedureReturn Result$
EndProcedure


Procedure WCallback(hWnd, uMsg, wParam, lParam)
	Protected Link$, Result = #PB_ProcessPureBasicEvents
	Protected *el.ENLINK, txt.GETTEXTEX, cr.CHARRANGE, FullText$
	
	Select uMsg
		Case #WM_NOTIFY
			*el = lParam
			Select *el\nmhdr\hwndFrom
				Case GadgetID(0)
					If *el\nmhdr\code = #EN_LINK
						If *el\msg = #WM_LBUTTONDOWN
							FullText$         = Space(2048)
							txt\cb            = 2048 * SizeOf(Character)
  						txt\flags         = #GT_SELECTION
 							txt\codepage      = 1200
  						cr\cpMin          = *el\chrg\cpMin - 1
  						cr\cpMax          = *el\chrg\cpMax
  						SendMessage_(*el\nmhdr\hwndFrom, #EM_EXSETSEL, 0, @cr)
  						SendMessage_(*el\nmhdr\hwndFrom, #EM_GETTEXTEX, @txt, @FullText$)
  						Link$ = ExtractURL(FullText$)
  						If Link$ = ""
  							Link$ = Mid(FullText$, 2)
  						EndIf
  						Debug "link: " + Link$
						EndIf
					EndIf

			EndSelect
	EndSelect
	ProcedureReturn Result
EndProcedure

;source from:
;https://stackoverflow.com/questions/42532760/adding-true-hyperlink-support-to-trichedit

Procedure SwitchFriendlyLinks(Gadget)
	Protected content$, i, j, Size, PosMainStart, PosLinkStart, PosNameStart
	Protected Count, FindNext, Link$, Name$, format.CHARFORMAT2
	
	content$   = GetGadgetText(Gadget)
	content$   = ReplaceString(content$, #CRLF$, #LF$) ;Richedit uses internally only one character for line feed, not sure why GetGadgetText returns #CRLF$ then...
	Size       = Len(content$)
	Count      = CountString(content$, #PREFIX_LINK)
	For i = 1 To Count
		PosMainStart = FindString(content$, #PREFIX_LINK, PosMainStart + 1)
		PosLinkStart = PosMainStart + 11
		PosNameStart = FindString(content$, #DQUOTE$, PosMainStart + 13)
		Link$        = Mid(content$, PosLinkStart, PosNameStart - PosLinkStart)
		FindNext     = FindString(content$, #PREFIX_LINK, PosMainStart + 12)
		PosNameStart + 1
		If FindNext = 0
			FindNext = -1
		EndIf
		
		Name$ = ""
		For j = PosNameStart To Size
			If j = FindNext
				;it is allowed to put links directly behind each other
				Break
			EndIf
			Select Mid(content$, j, 1)
				Case #LF$, #CR$, " "
					Break
				Default
					Name$ + Mid(content$, j, 1)
			EndSelect
		Next j
		
		format\cbSize = SizeOf(CHARFORMAT2)
		format\dwMask = #CFM_LINK; | #CFM_LINKPROTECTED
  	
		SendMessage_(GadgetID(Gadget), #EM_SETSEL, PosMainStart - 1, PosNameStart + Len(Name$) - 1)
  	format\dwEffects = #CFE_LINK; | #CFE_LINKPROTECTED
  	SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
  	
  	SendMessage_(GadgetID(Gadget), #EM_SETSEL, PosMainStart - 1, PosNameStart - 1)

		format\dwMask    = #CFM_HIDDEN
  	format\dwEffects = #CFE_HIDDEN
  	SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
  	
  	SendMessage_(GadgetID(Gadget), #EM_SETSEL, 0, 0)
  	PosMainStart = PosNameStart + Len(Name$) - 1
  	
	Next i
	
EndProcedure


OpenWindow(0, 0, 0, 600, 400, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
EditorGadget(0, 5, 5, 590, 490)
SendMessage_(GadgetID(0), #EM_SETTEXTMODE, #TM_RICHTEXT, 0)
SendMessage_(GadgetID(0), #EM_SETEVENTMASK, 0, SendMessage_(GadgetID(0), #EM_GETEVENTMASK, 0, 0) | #ENM_LINK)
SendMessage_(GadgetID(0), #EM_AUTOURLDETECT, #True, 0)
SetGadgetText(0, ~"this is a HYPERLINK \"https://purebasic.com\"FriendlyName test" + #CRLF$ + "and a 'normal' one http://www.google.com " + #CRLF$ + 
                 #CRLF$ + ~"HYPERLINK \"https://www.purebasic.fr/english/viewtopic.php?p=641709#p641709\"Second" + 
                 ~"HYPERLINK \"https://www.purebasic.fr/english/viewtopic.php?t=87028\"Third")
SendMessage_(GadgetID(0), #EM_AUTOURLDETECT, 0, 0)
SwitchFriendlyLinks(0)
SetWindowCallback(@WCallback())

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow