Doppelklick

Das Paket DoubleClick erweitert beim Textwidget die Bindung für das Ereignis „Doppelklick“ so:

• Doppelklick auf öffnendes europäisches Gänsefüßchen selektiert den Bereich bis zum passend schließenden Gänsefüßchen.
• Doppelklick auf runde, eckige, geschweifte Klammer selektiert den Bereich bis zum schließenden Gegenstück. Einschachtelung wird rekursiv behandelt.
• Doppelklick auf öffnende spitze Klammer selektiert – je nachdem – bei öffnendem XML-Tag bis zu schließenden Gegenstück, bei XML-Kommentaren <!-- … --> und Bereichen <![CDATA[ … ]]> bis zum schließenden Gegenstück, bei Markup <! … > und <? … ?> dito, ansonsten bis zur passend schließenden spitzen Klammer wie bei den anderen.
• In Vesion funktioniert der Doppelklick auch in rückwärtiger Richtugn – Doppelklick auf schließendes Gänsefüßchen selektiert zum öffnenden Gegenpart, desgleichen bei schließenden Klammern und schließenden XML-Tags.
• Je nach Aufruf wird das Ereignis „Dreifachklick“ so geändert, dass bei Zeilenumbruch word der grammatische Satz selektiert wird. – Kann im laufenden Betrieb geändert werden.

Einsatzmöglichkeiten:

1. DoubleClick::bindDoubleClick .t ändert nur das Widget .t;
2. DoubleClick::bindDoubleClick Pattern setzt die Klickoption auf ein neues Muster Pattern, das sodann mit bindtags einem Widget zugewiesen wird.

Einigermaßen universell. Ich kam drauf, weil der bisherige Doppelklick bei den Musterdokumenten von One Hand unzureichend war. – Das Teil müsste auch tauglich sein zum Bearbeiten von PHP-Dokumenten (nicht getestet, bei Bedarf Fehlermeldung zu mir, Danke!)

---

# 
# file: DoubleClick-0.3.tm
# Usage: 
#   package require DoubleClick
#   bindDoubleClick .textwindow ?yes|no?
#   bindDoubleClick ComfortableText ?yes|no?
#
# option yes is default
# if "yes" then triple-click selects grammatical sentence
# if "no" then no specific triple-click
# 
if false {
  Double-click behaves as Emacs:
  
  Double-click on quote (") selects balanced counterpart,
  opening or closing depends on environment.
  double-click on opening brace \{ selects 
  to balanced closing counterbrace \} and vice versa.
  Round parens ( and ) dito.
  
  Moreover:
  
  Double-click on international quote such as “this” selects to 
  balanced counter-quote, back or forward depends on environment.
  (Caution! Reliable only if no different national quotes mixed.)
  
  Double-click on opening CSS comment such as "/*" selects to "*/".
  Double-click on internetprotocol such as "http://wolf-dieter-busch.de"
  selects complete URI.
  
  Double-click on less-than < selects to counterpart:
  XML comment such as <!-- ... --> to closing char ">",
  "<? ..." to "?>, "<! ..." to ">", "<![CDATA[ ..." to "]]>",
  opening tag such as "<a>" to closing counterpart such as "</a>",
  on closing tag "</a>" vice versa to opening tag "<a>".
  
  Double-click on leading "&" of entity such as "&amp;" selects to ";".
  
  Tcl-specific: Double-click on leading "$" selects Tcl string.
  Double-click on widget name such as ".t.menu" selects complete name.
}
# 

package require Tcl 8.6.1
package provide DoubleClick 0.3

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::findTagComment {win {index insert}} {
  # -- comment ... --
  if {[$win get $index $index+2chars] ne "--"} then {
    return false
  } else {
    set idx [$win search -elide -- -- $index+2chars end]
    if {$idx eq ""} then {
      return false
    } else {
      $win mark set insert $index
      extendSel $win $idx+2chars
      return true
    }
  }
}

proc DoubleClick::findUrl {win {index insert}} {
  # "http://wolf-dieter-busch.de/blog/index.htm"
  set wordStart [$win index "$index wordstart"]
  set wordEnd [$win index "$index wordend"]
  set word [$win get $wordStart $wordEnd+3chars]
  if {[string match *:// $word]} then {
    set urlEnd [$win search -regexp -elide {[\s<>]} $wordStart end]
    #
    # quotes
    #
    set q [$win get $wordStart-1chars]
    if {$q in {' {"}}} then {
      set idx [$win search -elide $q $wordStart $urlEnd]
      if {$idx ne ""} then {
        set urlEnd $idx
      } else {
        return false
      }
    }
    $win mark set insert $wordStart
    if {
      ([$win get $urlEnd-1char] eq {"} && $q ne {"}) ||
      ([$win get $urlEnd-1char] eq {'} && $q ne {'})
    } then {
      set urlEnd $urlEnd-1char
    }
    extendSel $win $urlEnd
    return true
  } else {
    return false
  }
}

proc DoubleClick::findEntity {win {index insert}} {
  if {[$win get $index] eq "&"} then {
    set endIdx [$win search ";" $index end]
    if {$endIdx eq ""} then {
      return false
    } else {
      set name [$win get $index+1char $endIdx]
      if {
        [regexp {^[a-zA-Z]+$} $name] ||
        [regexp {^#[[:digit:]]+$} $name] ||
        [regexp {^#x[[:xdigit:]]+$} $name]
      } then {
        extendSel $win $endIdx+1chars
        return true
      } else {
        return false
      }
    }
  } else {
    return false
  }
}

proc DoubleClick::startOfExpression {win {index insert}} {
  set startIdx [$win search -elide -backwards \{ $index 1.0 ]
  if {$startIdx eq ""} then {
    $win index 1.0
  } elseif {[info complete [$win get 1.0 $startIdx]]} then {
    $win index $startIdx+1char
  } else {
    startOfExpression $win $startIdx
  }
}

proc DoubleClick::openOrClosedQuote? {win {index insert}} {
  set start [startOfExpression $win $index]
  set txt [string map [list \{ " " \} " " ] [$win get $start $index+1char]]
  if {[$win get $index] == "'"} then {
    set txt [string map [list \" " " ' \"] $txt]
  }
  expr {[info complete $txt] ? "closing" : "opening"}
}

proc DoubleClick::findOpenQuote {win {index insert}} {
  set char [$win get $index]
  set startIdx [startOfExpression $win $index]
  set quoteIdx [$win search -backward $char $index-1char $startIdx]
  while {$quoteIdx ne "" && [backslashed $win $quoteIdx]} {
    set quoteIdx [$win search -backward $char $quoteIdx-1char $startIdx]
  }
  $win tag add sel $quoteIdx $index+1char
  return true
}

proc DoubleClick::findCloseDquote {win {index insert}} {
  # " ... "
  if {[openOrClosedQuote? $win $index] eq "closing"} then {
    return [findOpenQuote $win $index]
  }
  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}} {
  # ' ... '
  if {[openOrClosedQuote? $win $index] eq "closing"} then {
    return [findOpenQuote $win $index]
  }
  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::findOpenBrace {win {index insert}} {
  # { ... }
  set start $index
  while true {
    set start [$win search -elide -backward \{ $start 1.0]
    if {$start eq ""} break
    set target [closeBraceIdx $win $start]
    if {[backslashed $win $start]} continue
    if {[$win compare [closeBraceIdx $win $start] >= $index]} then {
      $win tag add sel $start $index+1char
      return true
    }
  }
  return false
}

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

proc DoubleClick::findCloseBrace {win {index insert}} {
  set target [closeBraceIdx $win $index]
  if {$target eq ""} then {
    return false
  } else {
    extendSel $win $target+1char
    return true
  }
}

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::closeParenIndex {win {index insert}} {
  # at opening of ( ... )
  lappend map \" " " \{ " " \} " " ( \{ ) \}
  set start $index
  while true {
    set target [$win search -elide ) $start end]
    if {$target eq ""} break
    set txt [$win get $index $target+1chars]
    if {[info complete [string map $map $txt]]} then {
      return $target
    }
    set start $target+1chars
  }
}

proc DoubleClick::findCloseParen {win {index insert}} {
  # at opening of ( ... )
  set endIdx [closeParenIndex $win $index]
  if {$endIdx eq ""} then {
    return false
  }
  $win tag add sel $index $endIdx+1char
  return true
}

proc DoubleClick::findOpenParen {win {index insert}} {
  # ( ... ) at closing
  set map [list \{ " " \} " " \" " " ( \{ ) \}]
  set top [startOfExpression $win $index]
  set start $index
  while true {
    set start [$win search -elide -backward \( $start $top]
    if {$start eq ""} break
    if {[backslashed $win $start]} continue
    set target [closeParenIndex $win $start]
    if {[$win compare $target >= $index]} then {
      $win tag add sel $start $index+1char
      return true
    }
  }
  return false
}

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::findIntlOpenQuote {win {index insert}} {
  # „international“
  variable quotes
  set map [concat {*}[lmap {a b} $quotes {list $b $a}]]
  set closeChar [$win get $index]
  set openQuote [dict get $map $closeChar]
  set startIdx [$win search -elide -backward $openQuote $index 1.0]
  if {$startIdx eq ""} then {
    return false
  }
  $win tag add sel $startIdx $index+1char
  return true
}

proc DoubleClick::documentIntQuotes win {
  # which national quotes used in doc? E. g. "de"
  set idx [$win search -elide -regexp {[»«›‹„‚“‘]} 1.0 end]
  switch -exact -- [$win get $idx] {
    „ - ‚ {
      return de
    }
    “ - ‘ {
      return en
    }
    » - › {
      return fr
    }
    « - ‹ {
      return ch
    }
    default {
      return C
    }
  }
}

proc DoubleClick::findMatchIntlQuote {win {index insert}} {
  set char [$win get $index]
  set closingQuotes { “ ‘ ” ’ » › « ‹ }
  set lang [documentIntQuotes $win]
  if {$char in { “ ‘ }} then {
    if {$lang eq "en"} then {
      set dir forw
    } else {
      set dir back
    }
  } elseif {$char in { » › }} then {
    if {$lang eq "fr"} then {
      set dir forw
    } else {
      set dir back
    }
  } elseif {$char in { « ‹ }} then {
    if {$lang eq "ch"} then {
      set dir forw
    } else {
      set dir back
    }
  } elseif {$char in { ’ ” }} then {
    set dir back
  } else {
    set dir forw
  }
  if {$dir eq "forw"} then {
    findIntlCloseQuote $win $index
  } else {
    findIntlOpenQuote $win $index
  }
}

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::closingTagIndex {win {from insert}} {
  # find tagname
  $win search -count len -regexp -elide -- {\m[[:alnum:]]+\M} $from end 
  set tagName [$win get "$from + 1 char" "$from + $len chars + 1 char"]
  set pat [subst -nocommand -nobackslash {</?$tagName\M[^>]*>}]
  set indices [$win search -regexp -elide -all -- $pat $from end]
  set level 0
  foreach index $indices {
    if {
      [insideComment $win $index] ||
      [insideQuestionMarkup $win $index] ||
      [insideCdata $win $index]
    } continue
    if {[$win get $index+1char] eq "/"} then {
      incr level -1
    } else {
      incr level
    }
    if {$level <= 0} then {
      return $index
    }
  }
}

proc DoubleClick::findClosingTag {win {index insert}} {
  set tagIdx [closingTagIndex $win $index]
  if {$tagIdx ne ""} then {
    set endIdx [$win search -elide > $tagIdx end]
    if {$endIdx ne ""} then {
      $win tag add sel $index $endIdx+1char
      return true
    } else {
      return false
    }
  } else {
    return false
  }
}

proc DoubleClick::openingTagIndex {win {index insert}} {
  $win search -count len -regexp -- {\m[[:alnum:]]+\M} $index end
  set name [$win get "$index + 2 chars" "$index + 2 chars + $len chars"]
  set pat [subst -nocommand -nobackslashes {<$name\M[^>]*>}]
  set start $index
  while true {
    set start [$win search -regexp -elide -backwards -- $pat $start 1.0]
    if {
      [insideComment $win $start] ||
      [insideQuestionMarkup $win $start] ||
      [insideCdata $win $start]
    } continue
    if {[$win compare [closingTagIndex $win $start] >= $index]} break
  }
  set start
}

proc DoubleClick::findOpeningTag {win {index insert}} {
  set start [openingTagIndex $win $index]
  if {$start eq ""} then {
    return false
  } else {
    set end [$win search -elide > $index end]
    if {$end eq ""} then {
      return false
    } else {
      $win tag add sel $start $end+1char
      return true
    }
  }
}

proc DoubleClick::findCloseAngle {win {index insert}} {
  set cdata <!\u005bCDATA\u005b
  set comment <!--
  set excl <!
  set quest <?
  set close </
  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 $index+2chars] eq $close} then {
    # </
    findOpeningTag $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::findWidgetName {win {index insert}} {
  set prev [$win search -backwards -regexp {[^[:alnum:].]|^} $index 1.0]
  if {$prev eq ""} then {
    set prev [$win index $index]
  } elseif {[$win get $prev] ne "."} then {
    set prev [$win index $prev+1chars]
  }
  if {
    [$win get $prev] ne "." || 
    ![string is alnum [$win get $prev+1chars]]
  } then {
    return false
  }
  set end [$win search -regexp {[^[:alnum:].]|\n} $prev end]
  if {[$win compare $index > $end]} then {
    return false
  }
  $win tag add sel $prev
  extendSel $win $end
  return true
}

proc DoubleClick::findStringName {win {index insert}} {
  if {[$win get $index] ne "$"} then {
    return false
  }
  set endIdx $index+1char
  if {[$win get $endIdx $endIdx+2chars] eq "::"} then {
    set endIdx $endIdx+2chars
  }
  if {[$win get $endIdx] eq "\u7b"} then {
    set endIdx [$win search \u7d $endIdx end]
    if {$endIdx eq ""} then {
      return false
    } else {
      set endIdx $endIdx+1char
    }
  } elseif {[string is alnum [$win get $endIdx]]} then {
    set endIdx [$win search -regexp {\M} $endIdx end]
  }
  if {[$win get $endIdx] eq "("} then {
    set endIdx [$win search ")" $endIdx end]
    if {$endIdx eq ""} then {
      return false
    }
    set endIdx $endIdx+1char
  }
  extendSel $win $endIdx
  return true
}

proc DoubleClick::processChar {win {index insert}} {
  if {[$win get $index] eq "\n"} then {
    set index $index-1char
  }
  set char [$win get $index]
  switch -exact -- $char {
    < {
      findCloseAngle $win $index
    }
    „ - “ - ‚ - ‘ - “ - ” - ‘ - ’ - » - « - › - ‹ {
      findMatchIntlQuote $win $index
      # findIntlCloseQuote $win $index
    }
    default {
      if {
        [findStringName $win $index] ||
        [findWidgetName $win $index] ||
        [findUrl $win $index] ||
        [findTagComment $win $index] || 
        [findCSScomment $win $index] ||
        [findEntity $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
          }
          ) {
            findOpenParen $win $index
          }
          \u007b {
            # start of { ... }
            findCloseBrace $win $index
          }
          \u007d {
            # end of { ... } 
            findOpenBrace $win $index
          }
          \u005b {
            # [ ... ]
            findCloseBracket $win $index
          }
          default {
            return false
          }
        }
      }
    }
  }
}

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::*

---

Vergnügen.

19.10.2022

<< | Heimatseite | Verzeichnis | Stichworte | Autor | >>