Attachment "ctext.tcl.patch" to
ticket [1167797fff]
added by
georgeps
2005-03-22 01:53:09.
--- ctext.tcl 2004-08-17 23:45:18.000000000 -0400
+++ ctext.tcl 2005-02-10 10:16:42.000000000 -0500
@@ -19,7 +19,11 @@
return -code error "invalid number of arguments given to ctext (uneven number after window) : $args"
}
- frame $win -class Ctext
+ if {[namespace exists ttk]} {
+ ttk::frame $win -class Ctext
+ } else {
+ frame $win -class Ctext
+ }
set tmp [text .__ctextTemp]
@@ -64,7 +68,7 @@
text $win.l -font $ar(-font) -width 1 -height 1 \
-relief $ar(-relief) -fg $ar(-linemapfg) \
- -bg $ar(-linemapbg) -takefocus 0
+ -bg $ar(-linemapbg) -takefocus 0 -wrap none
set topWin [winfo toplevel $win]
bindtags $win.l [list $win.l $topWin all]
@@ -74,10 +78,13 @@
}
set args [concat $args [list -yscrollcommand [list ctext::event:yscroll $win $ar(-yscrollcommand)]]]
-
+
#escape $win, because it could have a space
eval text \$win.t -font \$ar(-font) $args
+ $win.t configure -relief flat -bd 0
+ $win.l configure -relief flat -bd 0
+
grid $win.t -row 0 -column 1 -sticky news
grid rowconfigure $win 0 -weight 100
grid columnconfigure $win 1 -weight 100
@@ -444,7 +451,7 @@
ctext::matchPair $self "\\(" "\\)" ""
}
"\"" {
- ctext::matchQuote $self
+ if 0 {ctext::matchQuote $self}
}
}
ctext::modified $self 1
@@ -490,7 +497,7 @@
$win tag configure __ctext_blink -foreground [$win cget -fg] -background [$win cget -bg]
}
- if {$count == 4} {
+ if {$count == 10} {
$win tag delete __ctext_blink 1.0 end
return
}
@@ -814,11 +821,92 @@
#This is a proc designed to be overwritten by the user.
#It can be used to update a cursor or animation while
#the text is being highlighted.
-proc ctext::update {} {
+proc ctext::update {{done 0}} {
}
+proc ctext::highlight85 {win start end} {
+ ctext::getAr $win config configAr
+
+ if {!$configAr(-highlight)} {
+ return
+ }
+
+ set twin "$win._t"
+
+ #The number of times the loop has run.
+ set numTimesLooped 0
+ set numUntilUpdate 600
+
+ ctext::getAr $win highlight highlightAr
+ ctext::getAr $win highlightSpecialChars highlightSpecialCharsAr
+ ctext::getAr $win highlightRegexp highlightRegexpAr
+ ctext::getAr $win highlightCharStart highlightCharStartAr
+
+ set res [$twin search -all -count length -regexp -- {([^\s\(\{\[\}\]\)\.\t\n\r;\"'\|,]+)} $start $end]
+ for {set x 0} {$x < [llength $res]} {incr x} {
+ set wordEnd [$twin index "[lindex $res $x] + [lindex $length $x] indices"]
+ set word [$twin get [lindex $res $x] $wordEnd]
+ set firstOfWord [string index $word 0]
+
+ if {[info exists highlightAr($word)] == 1} {
+ set wordAttributes [set highlightAr($word)]
+ foreach {tagClass color} $wordAttributes break
+
+ $twin tag add $tagClass [lindex $res $x] $wordEnd
+ $twin tag configure $tagClass -foreground $color
+
+ } elseif {[info exists highlightCharStartAr($firstOfWord)] == 1} {
+ set wordAttributes [set highlightCharStartAr($firstOfWord)]
+ foreach {tagClass color} $wordAttributes break
+
+ $twin tag add $tagClass [lindex $res $x] $wordEnd
+ $twin tag configure $tagClass -foreground $color
+ }
+ }
+
+ incr numTimesLooped
+ if {$numTimesLooped >= $numUntilUpdate} {
+ ctext::update
+ set numTimesLooped 0
+ }
+
+ foreach {ichar tagInfo} [array get highlightSpecialCharsAr] {
+ foreach {tagClass color} $tagInfo break
+ set res [$twin search -all -- $ichar $start $end]
+ foreach idx $res {
+ set wordEnd [$twin index "$idx + 1 indices"]
+ $twin tag add $tagClass $idx $wordEnd
+ $twin tag configure $tagClass -foreground $color
+ }
+
+ incr numTimesLooped
+ if {$numTimesLooped >= $numUntilUpdate} {
+ ctext::update
+ set numTimesLooped 0
+ }
+ }
+
+ foreach {tagClass tagInfo} [array get highlightRegexpAr] {
+ foreach {re color} $tagInfo break
+ set res [$twin search -all -count length -regexp -- $re $start $end]
+ for {set x 0} {$x < [llength $res]} {incr x} {
+ set wordEnd [$twin index "[lindex $res $x] + [lindex $length $x] indices"]
+ $twin tag add $tagClass [lindex $res $x] $wordEnd
+ $twin tag configure $tagClass -foreground $color
+ }
+
+ incr numTimesLooped
+ if {$numTimesLooped >= $numUntilUpdate} {
+ ctext::update
+ set numTimesLooped 0
+ }
+ }
+ ctext::update 1
+}
+
proc ctext::highlight {win start end} {
+ if {[string first 8.5 [info patchlevel]] != -1} {highlight85 $win $start $end; return}
ctext::getAr $win config configAr
if {!$configAr(-highlight)} {
@@ -914,6 +1002,7 @@
}
}
}
+ ctext::update 1
}
proc ctext::linemapToggleMark {win y} {
@@ -923,9 +1012,9 @@
return
}
- set markChar [$win.l index @0,$y]
+ set markChar [$win.l index @0,$y]
set lineSelected [lindex [split $markChar .] 0]
- set line [$win.l get $lineSelected.0 $lineSelected.end]
+ set line [string trim [$win.l get $lineSelected.0 $lineSelected.end]]
if {$line == ""} {
return
@@ -936,14 +1025,14 @@
if {[info exists linemapAr($line)] == 1} {
#It's already marked, so unmark it.
array unset linemapAr $line
- ctext::linemapUpdate $win
+ $win.l tag remove lmark $line.0 $line.end
set type unmarked
} else {
#This means that the line isn't toggled, so toggle it.
array set linemapAr [list $line {}]
- $win.l tag add lmark $markChar [$win.l index "$markChar lineend"]
+ $win.l tag add lmark $line.0 $line.end
$win.l tag configure lmark -foreground $configAr(-linemap_select_fg) \
--background $configAr(-linemap_select_bg)
+ -background $configAr(-linemap_select_bg)
set type marked
}
@@ -954,44 +1043,28 @@
#args is here because -yscrollcommand may call it
proc ctext::linemapUpdate {win args} {
- if {[winfo exists $win.l] != 1} {
- return
- }
-
- set pixel 0
- set lastLine {}
- set lineList [list]
- set fontMetrics [font metrics [$win._t cget -font]]
- set incrBy [expr {1 + ([lindex $fontMetrics 5] / 2)}]
+ if {[winfo exists $win.l] != 1} {return}
- while {$pixel < [winfo height $win.l]} {
- set idx [$win._t index @0,$pixel]
-
- if {$idx != $lastLine} {
- set line [lindex [split $idx .] 0]
- set lastLine $idx
- $win.l config -width [string length $line]
- lappend lineList $line
- }
- incr pixel $incrBy
- }
-
- ctext::getAr $win linemap linemapAr
-
- $win.l delete 1.0 end
- set lastLine {}
- foreach line $lineList {
- if {$line == $lastLine} {
- $win.l insert end "\n"
- } else {
- if {[info exists linemapAr($line)]} {
- $win.l insert end "$line\n" lmark
+ set lastLine [lindex [split [$win.t index "end -1 chars"] .] 0]
+ if {$lastLine != [$win.l get "end -2 chars linestart" "end -2 chars lineend"]} {
+ ctext::getAr $win linemap linemapAr
+
+ $win.l configure -width [string length $lastLine]
+ set frmt "%[string length $lastLine]d\n"
+
+ $win.l delete 1.0 end
+ for {set x 1} {$x <= $lastLine} {incr x} {
+ if {[info exists linemapAr($x)]} {
+ $win.l insert $x.0 "[format $frmt $x]" lmark
} else {
- $win.l insert end "$line\n"
+ $win.l insert $x.0 "[format $frmt $x]"
}
}
- set lastLine $line
+ $win.l delete "end -1 chars" end
}
+
+ $win.l yview moveto [lindex [$win.t yview] 0]
+
}
proc ctext::modified {win value} {
@@ -1000,3 +1073,4 @@
event generate $win <<Modified>>
return $value
}
+
