[SeS] A way of simulating Dynamic File Links behavior in a text widget.

A typical use-case would be to provide easy loading of files referenced inside a Source Code editor, in such cases, a code developer will likely insert references to file(s) with (semi)paths in the source page. In that case, when clicked on these references the bindings will first highlight the reference with a blue forecolor and underlined font. The second time user presses on the visual link, it will grab the link for further processing inside procedure 'executeDLNK'. When cursor is moved away by mouse-click, the highlight will disappear.

[tG²] v1.06.01.41 has this feature included for the ctext widget of it's Source Code Editor.

======
# setDLNKbindings.tcl
#
# Copyright (C) 2012 Sedat Serper
# A similar script and functionality is implemented in tG² as of v1.06.01.41 
#
# The author  hereby grant permission to use,  copy, modify, distribute,
# and  license this  software  and its  documentation  for any  purpose,
# provided that  existing copyright notices  are retained in  all copies
# and that  this notice  is included verbatim  in any  distributions. No
# written agreement, license, or royalty  fee is required for any of the
# authorized uses.  Modifications to this software may be copyrighted by
# their authors and need not  follow the licensing terms described here,
# provided that the new terms are clearly indicated on the first page of
# each file where they apply.
# 
# IN NO  EVENT SHALL THE AUTHOR  OR DISTRIBUTORS BE LIABLE  TO ANY PARTY
# FOR  DIRECT, INDIRECT, SPECIAL,  INCIDENTAL, OR  CONSEQUENTIAL DAMAGES
# ARISING OUT  OF THE  USE OF THIS  SOFTWARE, ITS DOCUMENTATION,  OR ANY
# DERIVATIVES  THEREOF, EVEN  IF THE  AUTHOR  HAVE BEEN  ADVISED OF  THE
# POSSIBILITY OF SUCH DAMAGE.
# 
# THE  AUTHOR  AND DISTRIBUTORS  SPECIFICALLY  DISCLAIM ANY  WARRANTIES,
# INCLUDING,   BUT   NOT  LIMITED   TO,   THE   IMPLIED  WARRANTIES   OF
# MERCHANTABILITY,    FITNESS   FOR    A    PARTICULAR   PURPOSE,    AND
# NON-INFRINGEMENT.  THIS  SOFTWARE IS PROVIDED  ON AN "AS  IS" BASIS,
# AND  THE  AUTHOR  AND  DISTRIBUTORS  HAVE  NO  OBLIGATION  TO  PROVIDE
# MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
# 
# Update July 5th, 2013 by SeS: removed overquoting in proc setDLNKbindings 
#
# ------------------------------------------------------------------------------
proc setDLNKbindings {w triggerString} {
  # propagate local variable to global
  set ::triggerString $triggerString

  #bindings for dynamic DLNK/file links
  bind $w <ButtonRelease-1> {+; check4DLNK %W %x %y $::triggerString}
  
  $w tag bind DLNK <Enter> {
    check4DLNK %W %x %y $::triggerString
    if {([string first $::triggerString [%W get DLNK.first DLNK.last]]>=0) && \
        ([string first \n [%W get DLNK.first DLNK.last]]<0)} {
      %W config -cursor hand2
      catch {%W tag configure DLNK -font "artail 9 underline" -foreground blue}
    }
  }
  
  $w tag bind DLNK <Leave> {%W config -cursor xterm} 
  
  $w tag bind DLNK <ButtonRelease-1> {executeDLNK [%W get DLNK.first DLNK.last]}
}

# ------------------------------------------------------------------------------
proc executeDLNK {link} {
  puts $link
}

# ------------------------------------------------------------------------
proc check4DLNK {W x y triggerString} {
  set cur [::tk::TextClosestGap $W $x $y]
  if {[catch {$W index anchor}]} {$W mark set anchor $cur}
  set anchor [$W index anchor]
  set last  [::tk::TextNextPos $W "$cur - 1c" tcl_wordBreakAfter]
  set first [::tk::TextPrevPos $W anchor tcl_wordBreakBefore]
  $W tag remove DLNK 0.0 end
  $W mark set insert $cur
  $W tag add DLNK $first $last
  $W tag remove DLNK $last end
  if {([catch {set tmp [$W get DLNK.first DLNK.last]}]) || \
      ([string first "$triggerString" $tmp]<0) || \
      ([string first "\n" $tmp]>=0)} {
    $W tag remove DLNK 0.0 end
  } {
    set i 1
    while {([string first "\[" [$W get DLNK.first DLNK.last]]==0) || \
           ([string first "\"" [$W get DLNK.first DLNK.last]]==0) || \
           ([string first "\\" [$W get DLNK.first DLNK.last]]==0) || \
           ([string first "\{" [$W get DLNK.first DLNK.last]]==0) || \
           ([string first "\(" [$W get DLNK.first DLNK.last]]==0) || ($i>256)} {
      $W tag remove DLNK 0.0 end
      $W tag add DLNK "$first+${i}c" $last
      $W tag remove DLNK $last end
      incr i
    }
    if {$i<=256} {
      incr i -1
      set j 1
      while {([string first "\]" [$W get DLNK.first DLNK.last] 13]>0) || \
             ([string first "\"" [$W get DLNK.first DLNK.last] 13]>0) || \
             ([string first ";"  [$W get DLNK.first DLNK.last] 13]>0) || \
             ([string first "\\" [$W get DLNK.first DLNK.last] 13]>0) || \
             ([string first "\}" [$W get DLNK.first DLNK.last] 13]>0) || \
             ([string first "\)" [$W get DLNK.first DLNK.last] 13]>0) || ($j>256)} {
        $W tag remove DLNK 0.0 end
        $W tag add DLNK "$first+${i}c" "$last-${j}c"
        $W tag remove DLNK $last end
        incr j
      }
    }
  }
  update idletasks
}
======

'''THE DEMO'''

======
# ----------------------- demo -------------------------------------------
# Open a new wish console and copy/paste the following complete script.
# Clicking on parts of where the trigger string is located, will highlight 
# the complete string first, the second time user clicks will execute 
# procedure executeDLNK.

console show
wm geo . 500x200+500+500

set trigger_string "/"
pack [text .t] 
.t insert end "testing script\n\n"
.t insert end "the string or character that will trigger the dynamic link visualisation is $trigger_string.\n"
.t insert end "a string like \"\${dev_folder}/procedures/test.tcl\" can be clicked and processed\n"
.t insert end "a string like {./test2.anything} can be clicked and processed\n\n"
.t insert end "a string like {test2.anything} and test2.anything will be ignored,\nbecause it does not have the trigger string.\n\n"

setDLNKbindings .t $trigger_string
======

<<categories>> Example | Widget