# 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 "arial 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
}

# ----------------------- 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