[ulis], 2003-09-05: A minimal package to simulate the URL behaviour in a text widget.

----

The package:

  namespace eval ::textURL \
  {
    # exports
    namespace export textURL
    
    # packages
    package require Tk
    package provide TextURL 0.1
    package provide textURL 0.1

    # global vars 
    set () {}
    
    # ---------------
    # create text widget
    # ---------------

    proc textURL {w args} \
    {
      variable {}
      set cmd [list text $w]
      # init URL current ID
      set ($w:urlID) 0
      # default values
      set newcolor navy
      set oldcolor gray
      set ($w:command) {tk_messageBox -message}
      # get args
      foreach {key value} $args \
      {
        switch -glob -- $key \
        {
          +*    \
          {
            switch -glob $key \
            {
              +cmd    -
              +com*   { set ($w:command) $value }
              +old*   { set oldcolor $value }
              +new*   { set newcolor $value }
              default { error "unknown option \"$key\": should be +newcolor, +oldcolor, +command or +cmd" }
            }
          }
          default { lappend cmd $key $value }
        }
      }
      # create & configure text
      eval $cmd
      # redefine ref
      rename $w ::textURL::_$w
      interp alias {} $w {} ::textURL::dispatch $w
      # tags config
      $w tag config newURL -underline 1 -foreground $newcolor
      $w tag config oldURL -underline 1 -foreground $oldcolor
      # bindings
      $w tag bind oldURL <Enter> [namespace code [list _$w config -cursor hand2]]
      $w tag bind oldURL <Leave> [namespace code [list _$w config -cursor ""]]
      $w tag bind newURL <Enter> [namespace code [list _$w config -cursor hand2]]
      $w tag bind newURL <Leave> [namespace code [list _$w config -cursor ""]]
      bind $w <1> [namespace code [list checkURL $w]]
      # return ref
      return $w
    }

    # ---------------
    # dispatch operation
    # ---------------

    proc dispatch {w operation args} \
    {
      switch -glob -- $operation \
      {
        bbo* - cge* - com* - con* - deg* - del* - dli* - dum* -
        edi* - get - ima* - ind* - ins* - mar* - sca* - sea* - 
        see - tag - win* - xvi* - yvi* \
        { return [uplevel 1 [linsert $args 0 ::textURL::_$w $operation]] }
        che*  { set op ::textURL::checkURL }
        to    { set op ::textURL::toIndex }
        tex*  { set op ::textURL::textInsert }
        url   { set op ::textURL::urlInsert }
        inv*  { set op ::textURL::invokeURL }
        default { error "unknown operation \"$operation\"" }
      }
      puts "uplevel 1 [linsert $args 0 $op $w]"
      uplevel 1 [linsert $args 0 $op $w]
    }
    
    # ---------------
    # check if URL
    # ---------------

    proc checkURL {w} \
    {
      variable {}
      set current [$w index current]
      foreach {start end} [$w tag prevrange newURL $current] break
      if {[info exists start] && $current <= $end} \
      {
        # new URL
        set url [$w get $start $end]
        foreach {tag value} $($w:urls:$url) break
        foreach {start end} [$w tag ranges $tag] \
        {
          $w tag add oldURL $start $end
          $w tag remove newURL $start $end
        }
        invokeURL $w $url
        return
      }
      foreach {start end} [$w tag prevrange oldURL $current] break
      if {[info exists start] && $current <= $end} \
      {
        # old URL
        invokeURL $w [$w get $start $end]
      }
    }

    # ---------------
    # invoke URL
    # ---------------

    proc invokeURL {w url args} \
    { 
      variable {}
      set cmd $($w:command)
      if {$cmd != ""} \
      { 
        set value [lindex $($w:urls:$url) 1]
        uplevel 1 $cmd $value $args
      }
    }

    # ---------------
    # set text index
    # ---------------

    proc toIndex {w index} \
    { 
      variable {}
      set ($w:index) $index 
    }
    
    # ---------------
    # insert text
    # ---------------

    proc textInsert {w text} \
    { 
      variable {}
      $w insert $($w:index) $text 
    }
    
    # ---------------
    # insert url
    # ---------------

    proc urlInsert {w url {value ""}} \
    {
      variable {}
      if {[info exists ($w:urls:$url)]} \
      {
        foreach {tag value} $($w:urls:$url) break
      } \
      else \
      { 
        set tag URL[incr ($w:urlID)]
        lappend ($w:urls:$url) $tag $value 
      }
      $w insert $($w:index) $url [list $tag newURL]
    }
  }

----

A little demo:

  # ==============
  # demo
  # ==============
  
  package require TextURL
  namespace import ::textURL::textURL
  pack [textURL .t +new red -bd 1]
  .t to 1.end
  .t text "a line with an "
  .t url URL1 value1
  .t text " inside\n"
  .t to 2.end
  .t text "a line with an "
  .t url URL2 value2
  .t text " inside\n"
  .t to 3.end
  .t text "a line with an "
  .t url URL1 value1
  .t text " inside\n"

----
[Category Example]