[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 – `

` – or as special markup. Triple click selects grammatical sentence. Put bindings to a single widget, 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.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 ">", ", "", "", opening tag such as "" to closing counterpart such as "", on closing tag "" vice versa to opening tag "". Double-click on leading "&" of entity such as "&" 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}} { # 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}} { # 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}} { # 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}} { # 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}} { # <> 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 $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 {} $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 $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 {]*>}] 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 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 { # return true } elseif {[findClosingTag $win $index]} then { # ... return true } else { # <> 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*(?:(?:||<[^>]+>)\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 { } { bind $tag $pat "" } bind $tag { set ::DoubleClick::click single } bind $tag { %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 { 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 { 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 { if {[%W cget -wrap] eq "word"} then { set ::DoubleClick::click triple DoubleClick::selectSentence %W @%x,%y break } } bind+ $tag { if {[%W cget -wrap] eq "word"} then { if {$DoubleClick::click eq "triple"} then { ::DoubleClick::extendSentenceRange %W @%x,%y break } } } bind+ $tag { 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::* ======