[wdb] This package `DoubleClick` extends text widget by generalized behaviour: deals with quotes `""` as well as international quotes such as „Deutsche Gänsefüßchen“, moreover all kinds of nesting parens – `(){}[[]]<>` – where the angles `<…>` are treatened depending of XML situation: either as comments – `<!--…-->` – or – or DOM tag elements – `<p> … </p>` – or as special markup.

Triple click selects grammatical sentence.

Put bindings to a single widget, or to tag `Text`, or to a newly-defined Tag to use with [bindtags]. Iʼd say, quite nützlich. I found it neccessary for editing master files of [One Hand]; and I guess it should be usable for PHP files too (but not tested, any volunteer?). In German we call such thing “Eierlegende Wollmilchsau”. Ask one who can translate it.

======
# 
# file: DoubleClick-0.2.tm
# Usage: 
#   package require DoubleClick
#   bindDoubleClick .textwindow ?yes|no?
#
# option yes is default
# if "yes" then triple-click selects grammatical sentence
# if "no" then no specific triple-click
# 
# 
# 
# extension about previous version:
# 
# double-click selects CSS comment /* ... */
# triple-click now treats double linefeed as sentence separator
# 
# 
# 

package require Tcl 8.6.1
package provide DoubleClick 0.2

namespace eval DoubleClick {
  variable quotes { „ “ ‚ ‘ “ ” ‘ ’ » « › ‹ « » ‹ › }
  variable click none
  variable index 1.0
}

proc DoubleClick::backslashed {win {index insert}} {
  # \{ \}
  set target [$win search -elide -backwards -regexp {[^\\]} $index 1.0]
  if {$target eq ""} then {
    return false
  }
  set found [$win get $target+1chars $index]
  set length [string length $found]
  if {$length % 2 == 1} then {
    return true
  } else {
    return false
  }
}

proc DoubleClick::extendSel {win target} {
  lassign "[$win tag ranges sel] insert" start
  $win tag add sel $start $target
}

proc DoubleClick::findCSScomment {win {index insert}} {
  if {[$win get $index $index+2chars] ne "/*"} then {
    return false
  }
  set target [$win search -elide */ $index end]
  if {$target eq ""} then {
    return false
  } else {
    extendSel $win $target+2chars
    return true
  }
}

proc DoubleClick::findCloseDquote {win {index insert}} {
  # " ... "
  set start $index
  while true {
    set target [$win search -elide \u0022 $start+2chars end]
    if {$target eq ""} then {
      return false
    }
    if {[info complete [$win get $index $target+2chars]]} then {
      extendSel $win  $target+1chars
      return true
    }
    set start $target+1chars
  }
}

proc DoubleClick::findCloseSquote {win {index insert}} {
  # ' ... '
  set start $index
  while true {
    set target [$win search -elide ' $start+1chars end]
    if {$target eq ""} then {
      return false
    }
    set txt [$win get $index $target+1chars]
    set txt\
      [string map [list \u0022 " " \{ " " \} " " ' \u0022] $txt]
    if {[info complete $txt]} then {
      extendSel $win  $target+1chars
      return true
    }
    set start $target+2chars
  }
}

proc DoubleClick::findCloseBrace {win {index insert}} {
  # { ... }
  set start $index
  while true {
    set target [$win search -elide \u007d $start end]
    if {$target eq ""} then {
      return false 
    }
    if {[info complete [$win get $index $target+1chars]]} then {
      extendSel $win  $target+1chars
      return true
    }
    set start $target+1chars
  }
}

proc DoubleClick::findCloseBracket {win {index insert}} {
  # [ ... ]
  lappend map \[ \{ \] \}
  set start $index
  while true {
    set target [$win search -elide \u005d $start end]
    if {$target eq ""} then {
      return false 
    }
    set txt [$win get $index $target+1chars]
    if {[info complete [string map $map $txt]]} then {
      extendSel $win  $target+1chars
      return true
    }
    set start $target+1chars
  }
}

proc DoubleClick::findCloseParen {win {index insert}} {
  # ( ... )
  lappend map ( \{ ) \}
  set start $index
  while true {
    set target [$win search -elide ) $start end]
    if {$target eq ""} then {
      return false 
    }
    set txt [$win get $index $target+1chars]
    if {[info complete [string map $map $txt]]} then {
      extendSel $win  $target+1chars
      return true
    }
    set start $target+1chars
  }
}

proc DoubleClick::findIntlCloseQuote {win {index insert}} {
  # „international“
  variable quotes
  set open [$win get $index]
  set close [dict get $quotes $open]
  set target [$win search -elide $close $index end]
  if {$target eq ""} then {
    return false
  }
  extendSel $win $target+1chars
  return true
}

proc DoubleClick::findCloseAngleExcl {win {index insert}} {
  # <!DOCTYPE ... >
  set target [$win search -elide > $index end]
  if {$target eq ""} then {
    return false
  }
  extendSel $win $target+1chars
  return true
}

proc DoubleClick::findCloseAngleQuest {win {index insert}} {
  # <?xml version="1.0" encoding="UTF-8"?>
  set target [$win search -elide ?> $index end]
  if {$target eq ""} then {
    return false
  }
  extendSel $win $target+2chars
  return true
}

proc DoubleClick::findEndOfComment {win {index insert}} {
  # <!-- comment -->
  set target [$win search -elide -- --> $index end]
  if {$target eq ""} then {
    return false
  }
  extendSel $win  $target+3chars
  return true
}

proc DoubleClick::findEndOfCdata {win {index insert}} {
  # <![CDATA[ ... ]]>
  set target [$win search -elide {]]>} $index end]
  if {$target eq ""} then {
    return false
  }
  extendSel $win $target+3chars
  return true
}

proc DoubleClick::findNestedCloseAngle {win {index insert}} {
  # <<ContextMenu>>
  set start $index
  lappend map \u007b " " \u007d ""  \u0022 " " < \u007b > \u007d
  while true {
    set target [$win search -elide > $start end]
    if {$target eq ""} then {
      return false
    }
    set txt [$win get $index $target+1chars]
    set txt [string map $map $txt]
    if {[info complete $txt]} then {
      extendSel $win $target+1chars
      return true
    }
    set start $target+1chars
  }
}

proc DoubleClick::insideComment {win {index insert}} {
  set start [$win search -elide -backwards <!-- $index 1.0]
  if {$start eq ""} then {
    return false
  }
  set end [$win search -elide -- --> $start end]
  if {$end eq ""} then {
    return false
  }
  if {[$win compare $end+3chars > $index]} then {
    return true
  } else {
    return false
  }
}

proc DoubleClick::insideCdata {win {index insert}} {
  set start [$win search -elide -backwards {<![CDATA[} $index 1.0]
  if {$start eq ""} then {
    return false
  }
  set end [$win search -elide {]]>} $start end]
  if {$end eq ""} then {
    return false
  }
  if {[$win compare $end+3chars > $index]} then {
    return true
  } else {
    return false
  }
}

proc DoubleClick::insideQuestionMarkup {win {index insert}} {
  set start [$win search -elide -backwards <? $index 1.0]
  if {$start eq ""} then {
    return false
  }
  set end [$win search -elide ?> $start end]
  if {$end eq ""} then {
    return false
  }
  if {[$win compare $end+2chars > $index]} then {
    return true
  } else {
    return false
  }
}

proc DoubleClick::findEndOfEmptyTag {win {index insert}} {
  set pat {<[[:alnum:]:]+[^>]*/>}
  set target\
    [$win search -elide -regexp -nolinestop -count c $pat $index end]
  if {$target eq ""} then {
    return false
  } elseif {[$win compare $index == $target]} then {
    extendSel $win "$index + $c chars"
    return true
  } else {
    return false
  }
}

proc DoubleClick::tokenIndices {win {from insert} {to end}} {
  set indices [$win search -elide -regexp -all\
      -count count {</?[[:alnum:]]+[^>]*>} $from $to]
  set result {}
  foreach index $indices length $count {
    lappend result $index [$win index "$index + $length chars"]
  }
  set result
}

proc DoubleClick::findClosingTag {win {index insert}} {
  # <b> ... </b>
  set cursor [$win cget -cursor]
  $win configure -cursor watch
  update
  $win configure -cursor $cursor
  set indices [tokenIndices $win $index]
  set stack {}
  foreach {start end} $indices {
    if {[insideComment $win $start] ||
        [insideQuestionMarkup $win $start] ||
        [insideCdata $win $start]} continue
    set tag [$win get $start $end]
    regexp {[[:alnum:]]+} $tag name
    if {[string match */> $tag]} continue
    if {![regexp {^<\s*/} $tag]} then {
      # opening tag
      set stack [concat $name $stack]
    } else {
      # closing tag
      if {$stack eq ""} then {
        return false
      } else {
        set stack [lassign $stack name1]
        if {$name1 ne $name} then {
          return false
        }
      }
      if {$stack eq ""} then {
        extendSel $win $end
        return true
      }
    }
  }
  return false
}

proc DoubleClick::findCloseAngle {win {index insert}} {
  set cdata <!\u005bCDATA\u005b
  set comment <!--
  set excl <!
  set quest <?
  set angle <
  if {[$win get $index $index+9chars] eq $cdata} then {
    # <![CDATA[ ... ]]>
    findEndOfCdata $win $index
  } elseif {[$win get $index $index+4chars] eq $comment} then {
    # <!-- ... -->
    findEndOfComment $win $index
  } elseif {[$win get $index $index+2chars] eq $excl} then {
    # <! ... >
    findCloseAngleExcl $win $index
  } elseif {[$win get $index $index+2chars] eq $quest} then {
    # <? ... ?>
    findCloseAngleQuest $win $index
  } elseif {[$win get $index] eq $angle} then {
    # <...
    if {[findEndOfEmptyTag $win $index]} then {
      # <br />
      return true
    } elseif {[findClosingTag $win $index]} then {
      # <a> ... </a>
      return true
    } else {
      # <<ContextMenu>>
      findNestedCloseAngle $win $index
    }
  } else {
    return false
  }
}

proc DoubleClick::processChar {win {index insert}} {
  set char [$win get $index]
  switch -exact -- $char {
    < {
      findCloseAngle $win $index
    }
    „ - ‚ - “ - ‘ - » - › - « - ‹ {
      findIntlCloseQuote $win $index
    }
    default {
      if {[findCSScomment $win $index]} then {
        return true
      } else {
        if {[backslashed $win $index]} then {
          return false
        }
        switch -exact -- $char {
          \u0022 {
            # " ... "
            findCloseDquote $win $index
          }
          ' {
            findCloseSquote $win $index
          }
          ( {
            findCloseParen $win $index
          }
          \u007b {
            # { ... }
            findCloseBrace $win $index
          }
          \u005b {
            # [ ... ]
            findCloseBracket $win $index
          }
          default {
            return false
          }
        }
      }
    }
  }
}

# proc DoubleClick::sentenceStartIndex {win {index insert}} {
#   set tagPat {(<[^>]+>|<!--.*?-->|<!\[CDATA\[.*?\]\]>)}
#   append pat\
#     {[.:?!]([›‹ ‘’][[:punct:]]*)?[»«“”]?} $tagPat?\\s+$tagPat*
#   set target [$win search -elide -nolinestop -regexp -backwards -count c\
#     $pat $index 1.0]
#   if {$target eq ""} then {
#     set target\
#       [$win search -elide -regexp -count c {(<[^>]+>\s*)*?\m} 1.0 end]
#   }
#   set result [$win index "$target + $c chars"]
#   while {[$win compare $result < $index] &&
#          [string is space [$win get $result]]} {
#     set result $result+1chars
#   }
#   $win index $result
# }

proc DoubleClick::sentenceStartIndex {win {index insert}} {
  set startPat {(?:[.:?!](?:[›‹‘’][[:punct:]]*)?[»«“”]?)}
  set lfIdx [$win search -backwards -elide \n\n $index 1.0]
  set punctIdx\
    [$win search -backwards -elide -regexp -count len $startPat $index 1.0]
  if {$punctIdx eq ""} then {
    lassign {1.0 0} punctIdx len
  }
  if {"$lfIdx$punctIdx" eq ""} then {
    set target 1.0
  } elseif {$lfIdx eq ""} then {
    set target [$win index "$punctIdx + $len chars"]
  } elseif {[$win compare $lfIdx > $punctIdx]} then {
    set target $lfIdx
  } else {
    set target [$win index "$punctIdx + $len chars"]
  }
  set tagPat {\s*(?:(?:<!--.*?-->|<!\[CDATA\[.*?\]\]>|<[^>]+>)\s*)+}
  set nextIdx [$win search -elide -regexp -count len $tagPat $target end]
  if {$nextIdx eq $target} then {
    set target [$win index "$target + $len chars"]
  } else {
    set nextIdx [$win search -regexp -elide {\S} $target end]
    if {$nextIdx ne ""} then {
      set target $nextIdx
    } else {
      set target [$win index $index]
    }
  }
  set target
}

proc DoubleClick::sentenceEndIndex {win {index insert}} {
  set endPat {(?:[.:?!](?:[›‹‘’][[:punct:]]*)?[»«“”]?)}
  set lfIdx [$win search -elide \n\n $index end]
  set punctIdx [$win search -elide -regexp -count len $endPat $index end]
  if {$lfIdx eq ""} then {
    if {$punctIdx eq ""} then {
      set target [$win index end-1char]
    } else {
      set target $punctIdx
    }
  } else {
    if {$punctIdx eq ""} then {
      set target $lfIdx
    } elseif {[$win compare $punctIdx < $lfIdx]} then {
      set target [$win index "$punctIdx + $len chars"]
    } else {
      set target $lfIdx
    }
  }
  while {[$win compare $target > 1.0] &&
         [string is space -strict [$win get "$target - 1 char"]]} {
    set target [$win index $target-1chars]
  }
  set tagPat {\s*(<[^>]*>\s*)+}
  set prevIdx\
    [$win search -elide -regexp -backwards -nolinestop $tagPat $target $index]
  if {$prevIdx ne ""} then {
    set target $prevIdx
  }
  while {[string is punct [$win get $target]]} {
    set target [$win index $target+1char]
  }
  set target
}

proc DoubleClick::selectSentence {win {clickpoint insert}} {
  set start [sentenceStartIndex $win]
  set end [sentenceEndIndex $win]
  $win tag remove sel 1.0 end
  $win tag add sel $start $end
}

proc DoubleClick::extendSentenceRange {win {clickpoint insert}} {
  variable index
  if {[$win compare $clickpoint < $index]} then {
    set start [sentenceStartIndex $win $clickpoint]
    set end [sentenceEndIndex $win $index]
  } else {
    set start [sentenceStartIndex $win $index]
    set end [sentenceEndIndex $win $clickpoint]
  }
  $win tag remove sel 1.0 end
  $win tag add sel $start $end
}

proc DoubleClick::bind+ {win event script} {
  bind $win $event +$script
}

proc DoubleClick::strCat args {join $args ""}

proc DoubleClick::bindDoubleClick {tag {sentence yes}} {
  foreach pat {<Button-1>
               <Double-Button-1>
               <Shift-Button-1>
               <B1-Motion>
               <Triple-Button-1>} {
    bind $tag $pat ""
  }
  bind $tag <Button-1> {
    set ::DoubleClick::click single
  }
  bind $tag <Double-Button-1> {
    %W mark set insert [%W index @%x,%y]
    set ::DoubleClick::index [%W index insert]
    set ::DoubleClick::click double
    if {[::DoubleClick::processChar %W insert]} break
  }
  bind $tag <Shift-Button-1> {
    if {$DoubleClick::click eq "double" &&
      [::DoubleClick::processChar %W @%x,%y]} then {
      %W mark set insert $::DoubleClick::index
      %W tag add sel insert sel.last
      break
    }
  }
  bind $tag <B1-Motion> {
    if {$DoubleClick::click eq "double" &&
      [::DoubleClick::processChar %W @%x,%y]} then {
      %W mark set insert $::DoubleClick::index
      %W tag add sel insert sel.last
      break
    }
  }
  if {$sentence} then {
    bind $tag <Triple-Button-1> {
      if {[%W cget -wrap] eq "word"} then {
        set ::DoubleClick::click triple
        DoubleClick::selectSentence %W @%x,%y
        break
      }
    }
    bind+ $tag <Shift-Button-1> {
      if {[%W cget -wrap] eq "word"} then {
        if {$DoubleClick::click eq "triple"} then {
          ::DoubleClick::extendSentenceRange %W @%x,%y
          break
        }
      }
    }
    bind+ $tag <B1-Motion> {
      if {[%W cget -wrap] eq "word"} then {
        if {$DoubleClick::click eq "triple"} then {
          ::DoubleClick::extendSentenceRange %W @%x,%y
          break
        }
      }
    }
  }
}

namespace eval DoubleClick namespace export bindDoubleClick

namespace import DoubleClick::*
======