Doppelklick

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

Einsatzmöglichkeiten:

  1. DoubleClick::bindDoubleClick Text ändert sämtliche Text-Widgets;
  2. DoubleClick::bindDoubleClick .t ändert nur das Widget .t;
  3. 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.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 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.

(Ursprung – 22.05.2019)

<< Home | Sitemap | A-Z | Impressum | Suche >>