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.1.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
#
package require Tcl 8.6.1
package provide DoubleClick 0.1
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::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}} {
lassign {no no no} commentAhead cDataAhead questAhead
# <b> ... </b>
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 {![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 {[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::sentenceEndIndex {win {index insert}} {
set tagPat {(<[^>]+>|<!--.*?-->|<!\[CDATA\[.*?\]\]>)}
append pat\
{[.:?!]([›‹ ‘’][[:punct:]]*)?[»«“”]?} (?=$tagPat?\\s+$tagPat*)
set target [$win search -elide -regexp -nolinestop -count c\
$pat $index end]
if {$target eq ""} then {
lassign {end-1char 0} target c
}
set result [$win index "$target + $c chars"]
if {[string is space [$win get $result-1chars]]} then {
set result [$win index $result-1chars]
}
set result
}
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> {
set ::DoubleClick::click triple
DoubleClick::selectSentence %W @%x,%y
break
}
bind+ $tag <Shift-Button-1> {
if {$DoubleClick::click eq "triple"} then {
::DoubleClick::extendSentenceRange %W @%x,%y
break
}
}
bind+ $tag <B1-Motion> {
if {$DoubleClick::click eq "triple"} then {
::DoubleClick::extendSentenceRange %W @%x,%y
break
}
}
}
}
namespace eval DoubleClick namespace export bindDoubleClick
namespace import DoubleClick::*