Having updated [doubleclick] I made an extension of text widget which is intended to be small and '''stable'''. For features see comment section. Have fun. ====== #!/usr/bin/wish # file: texteditor-0.1.tm # # This package extends Tk's text widget by usual bindings. # This is done by extend the bindtags of given widget by new tag TextEditor. # # Technically: # New namespace TextEditorBindings # New widgets .textEditorContextMenu .textEditorSelContextMenu # Relies on UNDOCUMENTED array variable ::tk::Priv(selectMode) # but this is the ONLY undocumented property to use # # Usage: # textEditor win - creates extended text widget $win # with options on creation: wrap -word, -undo yes # textToEditor win - extends given text widget $win # editorToText win - removes extensions from text widget $win # textEditorQuotes - sets internationaL quotes AND dash bindings # arguments: de en en-AM fr ch C # # Extensions: # # Double-click on opening brace { selects to closing brace }, incl. nesting; # same on [ to ], ( to ), " to ", opening to closing , # additionaly selects any international quote, but non-nesting. # # Quotes are set according to textEditorQuotes. # When quotes are set to any of de, fr, en, en-AM, ch, # then key sequence Escape-Quote produces computer quotes (#34, #39). # # Context menu on to set some HTML tags and remove outermost paired tags # with NO ACTION if selected tags are NOT PAIRED. # package require Tcl 8.6 package require Tk 8.6 package provide texteditor 0.1 namespace eval TextEditorBindings { namespace export\ textEditor\ textToEditor\ editorToText\ textEditorQuotes } proc ::TextEditorBindings::selectToClosingChar {w x y} { set i0 [$w index @$x,$y] set transList [list \u007b \u007d\ \" \" ' ' „ “ ‚ ‘ “ ” ‘ ’\ \u00bb \u00ab \u00ab \u00bb \u203a \u2039 \u2039 \u203a\ \u005b \u005d < > \u0028 \u0029] set c0 [$w get $i0] set selectTo {{w i0 i1} { if {[$w tag ranges sel] eq ""} then { $w tag add sel $i0 $i1 $w mark set insert $i0 } else { $w tag add sel sel.first $i1 $w mark set insert $i1 } }} if {![dict exists $transList $c0]} then { return false } set c1 [dict get $transList $c0] if {$c0 ni [list \[ \( \{ \" <]} then { # Quotes - non-nestable set i1 [$w search $c1 $i0+1chars end] if {$i1 eq ""} then { return false } # $w tag add sel $i0 $i1+1chars # $w mark set insert $i0 apply $selectTo $w $i0 $i1+1chars return true } elseif {$c0 eq "<"} then { # HTML tags? set i1 [$w search > $i0+1chars end] if {$i1 eq ""} then { # no closing char > - not an HTML tag return false } set src [$w get $i0 $i1+1chars] if {[regexp {<\s*/} $src] || [regexp {/\s*>} $src] || [regexp {<\s*[?!]} $src]} then { # closing or empty tag - non-nestable apply $selectTo $w $i0 $i1+1chars return true } else { # opening tag - nestable set txt [string trim [$w get $i0+1chars $i1]] set name [lindex [split $txt] 0] set open <\\s*$name\[^>\]*> set close <\\s*/\\s*$name\\s*> set i1 $i0 while true { set i1 [$w search -regexp $close $i1 end] if {$i1 eq ""} then { return false } set i1 [$w index [$w search > $i1 end]+1chars] set txt [$w get $i0 $i1] set txt [string map [list \{ " " \} " " \" " "] $txt] regsub -all $open $txt \{ txt regsub -all $close $txt \} txt if {[info complete $txt]} then { apply $selectTo $w $i0 $i1 return true } } } return false } else { # braces, brackets - nestable if {$c0 in [list \{ \"]} then { set map {} } else { set map [list \{ " " \} " " \" " " $c0 \{ $c1 \}] } set i1 $i0 while true { set i1 [$w search $c1 $i1+1chars end] if {$i1 eq ""} then { return false } if {[info complete [string map $map [$w get $i0 $i1+1chars]]]} then { apply $selectTo $w $i0 $i1+1chars return true } } } } proc ::TextEditorBindings::textEditorQuotes {{lang de}} { switch -exact -- $lang { de { set quotes {„ “ ‚ ‘} } en - en-AM { set quotes {“ ” ‘ ’} } fr { set quotes {» « › ‹} } ch { set quotes {« » ‹ ›} } default { bind TextEditor "" bind TextEditor "" bind TextEditor "" bind TextEditor "" bind TextEditor "" return } } lassign $quotes doubleOpen doubleClose singleOpen singleClose set insideTag { {window index} { set idx0 [$window search -backwards < $index 1.0] if {$idx0 eq ""} then { return false } set idx1 [$window search -backwards > $index 1.0] if {$idx1 eq ""} then { return true } if {[$window compare $idx0 < $idx1]} then { return false } else { return true } } } set wordStart { {text index} { # index am Anfang oder vor Leerzeichen? if {[$text compare $index == 1.0] || [regexp {[\s-]} [$text get $index-1chars]]} then { return true } else { return false } } } bind TextEditor [subst -nocommand { if {[apply {$insideTag} %W insert]} then continue if {[apply {$wordStart} %W insert]} then { %W insert insert $doubleOpen } else { %W insert insert $doubleClose } break }] bind TextEditor [subst -nocommand { if {[apply {$insideTag} %W insert]} then continue if {[apply {$wordStart} %W insert]} then { %W insert insert $singleOpen } else { %W insert insert $singleClose } break }] bind TextEditor { %W insert insert \" break } bind TextEditor { %W insert insert ' break } switch -exact -- $lang { en-AM { bind TextEditor { if {[regexp {\s} [%W get insert-2c]]} then { %W delete insert-2c insert %W insert insert \u200b—\u200b break } } } default { bind TextEditor { if {[regexp {\s} [%W get insert-2c]]} then { %W delete insert-1c %W insert insert – } } } } } namespace eval TextEditorBindings { bind TextEditor { set tk::Priv(selectMode) word if {[TextEditorBindings::selectToClosingChar %W %x %y]} then break } bind TextEditor { if {$tk::Priv(selectMode) ne "word"} then continue if {[TextEditorBindings::selectToClosingChar %W %x %y]} then break } bind TextEditor { if {$tk::Priv(selectMode) ne "word"} then continue if {[TextEditorBindings::selectToClosingChar %W %x %y]} then break } } proc ::TextEditorBindings::textToEditor win { set idx [lsearch [bindtags $win] TextEditor] if {$idx < 0} then { bindtags $win [lreplace [bindtags $win] 1 0 TextEditor] } $win configure -undo yes } proc ::TextEditorBindings::editorToText win { set idx [lsearch [bindtags $win] TextEditor] bindtags $win [lreplace [bindtags $win] $idx $idx] $win configure -undo yes } proc ::TextEditorBindings::textEditor {win args} { text $win -wrap word {*}$args textToEditor $win set win } proc ::TextEditorBindings::widgetTagIndex {text from to} { set startIdx [$text search < $from $to] if {$startIdx eq ""} then return set endIdx [$text search > $startIdx $to] if {$endIdx eq ""} then return list [$text get $startIdx $endIdx+1chars] $startIdx } proc ::TextEditorBindings::formOfTag tag { if {[regexp {<\s*/} $tag]} then { return close } elseif {[regexp {/\s*>} $tag] || [regexp {<\s*[[:punct:]]} $tag]} then { return empty } else { return open } } proc ::TextEditorBindings::nameOfTag tag { lindex [split [string trim $tag ]] 0 } proc ::TextEditorBindings::openingTagPattern openingTag { append pattern < {\s*} [nameOfTag $openingTag] .*? > } proc ::TextEditorBindings::closingTagPattern openingTag { append pattern < {\s*} / [nameOfTag $openingTag] {\s*} > } proc ::TextEditorBindings::widgetTokenList {text idx to {result {}}} { while true { lassign [widgetTagIndex $text $idx $to] tag idx if {$idx eq ""} then break lappend result $tag $idx set idx [$text index $idx+[string length $tag]chars] } set result } proc ::TextEditorBindings::widgetRangeTagsBalanced {text from to} { set level {} foreach {tag idx} [widgetTokenList $text $from $to] { set name [nameOfTag $tag] switch [formOfTag $tag] open { dict incr level $name } close { dict incr level $name -1 if {[dict get $level $name] < 0} then { return false } } } foreach key [dict keys $level] { if {[dict get $level $key] != 0} then { return false } } return true } namespace import\ ::TextEditorBindings::textEditor\ ::TextEditorBindings::textToEditor\ ::TextEditorBindings::editorToText\ ::TextEditorBindings::textEditorQuotes proc ::TextEditorBindings::addTag {window tag start end} { if {[widgetRangeTagsBalanced $window $start $end]} then { while {[regexp {\s} [$window get $start]]} { $window tag remove sel $start if {[$window tag ranges sel] eq ""} then return } while {[regexp {\s} [$window get $end-1chars]]} { $window tag remove sel $end-1chars if {[$window tag ranges sel] eq ""} then return } $window edit separator $window insert $end sel $window insert $start <$tag> sel $window edit separator if {[$window compare insert < sel.first]} then { $window mark set insert sel.first } elseif {[$window compare insert > sel.last]} then { $window mark set insert sel.last } } } proc ::TextEditorBindings::delTag {window start end} { while {[regexp {\s} [$window get $start]]} { $window tag remove sel $start if {[$window tag ranges sel] eq ""} then return } while {[regexp {\s} [$window get $end-1chars]]} { $window tag remove sel $end-1chars if {[$window tag ranges sel] eq ""} then return } set tokenList [widgetTokenList $window $start $end] if {$tokenList eq ""} then return lassign $tokenList tag0 idx0 if {[$window compare $idx0 != $start]} then return lassign [lrange $tokenList end-1 end] tag1 idx1 if {[$window compare $idx1+[string length $tag1]chars != $end]} then return if {[widgetRangeTagsBalanced $window $idx0+[string length $tag0]chars $idx1]} then { $window edit separator $window del $idx1 $idx1+[string length $tag1]chars $window del $idx0 $idx0+[string length $tag0]chars $window edit separator if {[$window compare insert < sel.first]} then { $window mark set insert sel.first } elseif {[$window compare insert > sel.last]} then { $window mark set insert sel.last } } } bind TextEditor { if {[%W tag ranges sel] eq ""} then { tk_popup .textEditorContextMenu %X %Y } else { tk_popup .textEditorSelContextMenu %X %Y } } destroy .textEditorContextMenu .textEditorSelContextMenu menu .textEditorContextMenu -tearoff no .textEditorContextMenu add command -label Paste -command { event generate [focus] <> } .textEditorContextMenu add command -label "select all" -command { [focus] tag add sel 1.0 end-1c } .textEditorContextMenu add separator .textEditorContextMenu add cascade\ -label Quotes\ -menu [menu .textEditorContextMenu.quotes] apply { args { foreach {label sign} $args { .textEditorContextMenu.quotes add command\ -label $label\ -command " ::TextEditorBindings::textEditorQuotes $sign " } } } German de English en American en-AM French fr Swiss ch None C menu .textEditorSelContextMenu -tearoff no .textEditorSelContextMenu add command -label cut -command { event generate [focus] <> } .textEditorSelContextMenu add command -label copy -command { event generate [focus] <> } .textEditorSelContextMenu add command -label "select all" -command { [focus] tag add sel 1.0 end-1c } .textEditorSelContextMenu add separator .textEditorSelContextMenu add cascade\ -label Inline\ -menu [menu .textEditorSelContextMenu.inlinetag -tearoff no] apply { args { foreach tag $args { .textEditorSelContextMenu.inlinetag add command\ -label $tag\ -command [subst -nocommand { ::TextEditorBindings::addTag [focus] $tag sel.first sel.last }] } } } a q abbr em strong b i span .textEditorSelContextMenu add cascade\ -label Block\ -menu [menu .textEditorSelContextMenu.blocktag -tearoff no] apply { args { foreach tag $args { .textEditorSelContextMenu.blocktag add command\ -label $tag\ -command [subst -nocommand { ::TextEditorBindings::addTag [focus] $tag sel.first sel.last }] } } } p h1 h2 h3 h4 h5 h6 blockquote div .textEditorSelContextMenu add cascade\ -label List\ -menu [menu .textEditorSelContextMenu.listtag -tearoff no] apply { args { foreach tag $args { .textEditorSelContextMenu.listtag add command\ -label $tag\ -command [subst -nocommand { ::TextEditorBindings::addTag [focus] $tag sel.first sel.last }] } } } ul ol dl li dt dd .textEditorSelContextMenu add cascade\ -label Document\ -menu [menu .textEditorSelContextMenu.doctag -tearoff no] apply { args { foreach tag $args { .textEditorSelContextMenu.doctag add command\ -label $tag\ -command [subst -nocommand { ::TextEditorBindings::addTag [focus] $tag sel.first sel.last }] } } } html head title body .textEditorSelContextMenu add command\ -label "Remove outermost tags"\ -command { ::TextEditorBindings::delTag [focus] sel.first sel.last } .textEditorSelContextMenu add separator .textEditorSelContextMenu add cascade\ -label Quotes\ -menu [.textEditorContextMenu entrycget Quotes -menu] ====== <>Enter Category Here