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

# ------------------------------------------------------------------------------
# Purpose : to provide the ability to click on ctext highlights and process the 
#           string underneath the pointer
# Usage   : ctext::binding4Tag <ctext widget path> <list of tags>
# ------------------------------------------------------------------------------
proc ctext_binding4Tag {w tags} {
  foreach tag $tags {
    $w tag bind $tag <Enter> {%W config -cursor hand2}
    $w tag bind $tag <Leave> {%W config -cursor xterm}
    $w tag bind $tag <ButtonRelease-1> {
      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]
      if {![catch {set tmp [%W get $first $last]}]} {
        ctext_execTagCmd $tmp
      }
    }
  }
}

proc ctext_execTagCmd {str} {
  # place here your customized script to process the string
  console show
  puts $str
}

# ----------------------- demo -------------------------------------------
# Open a new wish console and copy/paste the following complete script.
# Clicking on parts that are highlighted and observe the console output...
# Adjust procedure 'ctext_execTagCmd' to customize the handling 4 your application.
package require ctext
pack [ctext .t] -fill both -expand 1
ctext::addHighlightClass .t bindings purple [list <Enter> <Leave> <ButtonRelease-1>]
ctext::addHighlightClass .t commands orange [list foreach proc if set catch]
.t fastinsert end [info body ctext_binding4Tag]
.t highlight 1.0 end
ctext_binding4Tag .t {bindings commands}