#
# Module for painting Text widgets
#


# Add a set of expressions to check for a widget
proc th_Misc_paint_add {w tag regexp subexp args} {
  global TH
  if {[catch "set TH(Paint,$w)"]} {set TH(Paint,$w) ""}
  lappend TH(Paint,$w) [list $tag $regexp $subexp]
  if {[lsearch [$w tag names] $tag] < 0} {eval $w tag configure $tag $args}
  return ""
} 

proc th_Text_paint_region {w start end} {
  global TH
  if {[catch "set TH(Paint,$w)"]} {set TH(Paint,$w) ""}
  foreach group $TH(Paint,$w) {$w tag remove [lindex $group 0] $start $end}
  foreach group $TH(Paint,$w) {
    eval th_Text_paint_region_tag $w $start $end $group
  }
  if {[catch "set TH(Paint,Hook,$w)"]} {set TH(Paint,Hook,$w) ""} else {
    eval $TH(Paint,Hook,$w)}
}

proc th_Text_paint_region_tag {w start end tag pattern subpattern} {
  set index $start
  while {[$w compare $index < $end]} {
    set index [$w search -regexp -count c -- $pattern $index $end]
    if {$index == ""} {break}
    set regend "$index +$c c"
    if {$subpattern == ""} {
      set tagstart $index ; set tagend $regend
    } else {if {[set tagstart [$w search -regexp -count c2 -- $subpattern $index "$index + $c c"]] == ""} {set index "$tagstart +1c" ; continue}
      set tagend "$tagstart + $c2 c"
    }
    $w tag add $tag $tagstart $tagend
    if {([$w get "$tagstart - 1c"] == "\n") &&
	([lsearch [$w tag names "$tagstart -2c"] $tag] >= 0)} {
      $w tag add $tag "$tagstart - 1c"
    }
    set index "$regend +1c"
}}

proc th_Text_paint_region {w start end} {
  global TH
  if {[catch "set TH(Paint,$w)"]} {set TH(Paint,$w) ""}
  foreach group $TH(Paint,$w) {$w tag remove [lindex $group 0] $start $end}
  if {[catch "set TH(Paren,Length)"]} {set TH(Paren,Length) end}
  foreach group $TH(Paint,$w) {
    th_flash_label $w -text "Painting [string range $group 0 $TH(Paren,Length)]"
    update
    eval th_Text_paint_region_tag $w $start $end $group
  }
  if {[catch "set TH(Paint,Hook,$w)"]} {set TH(Paint,Hook,$w) ""} else {
    th_flash_label $w -text "Doing [string range $TH(Paint,Hook,$w) 0 $TH(Paren,Length)]"
    update
    eval $TH(Paint,Hook,$w)}
  th_flash_label $w -text ""
}

proc th_Text_paint_region_tag {w start end tag pattern subpattern} {
  set index $start
  while {[$w compare $index < $end]} {
    set index [$w search -regexp -count c -- $pattern $index $end]
    if {$index == ""} {break}
    set regend "$index +$c c"
    if {$subpattern == ""} {
      set tagstart $index ; set tagend $regend
    } else {if {[set tagstart [$w search -regexp -count c2 -- $subpattern $index "$index + $c c"]] == ""} {set index "$index +1c" ; continue}
      set tagend "$tagstart + $c2 c"
    }
    $w tag add $tag $tagstart $tagend
    if {([$w get "$tagstart - 1c"] == "\n") &&
	([lsearch $tag [$w tag names "$tagstart -2c"]] >= 0)} {
      $w tag add $tag "$tagstart - 1c"
    }
    if {$regend == ""} {break}
    set index "$regend + 1c"
}}


# Procedures for interactively adding new paints

proc th_Text_test_clear {} {[focus] tag remove TEST 1.0 end ; return ""}

proc th_Text_test_paint {{pattern ""} {subpattern ""}} {
  set w [focus]
  if {$pattern == ""} {
    if {[catch {$w get sel.first sel.last} subpattern]} {bell ; return}
    set pattern ""
    append pattern {(^|[^A-Za-z0-9_])} $subpattern {([^A-Za-z0-9_]|$)}
  }
  th_Text_test_clear
  th_Text_paint_region_tag [focus] 1.0 end TEST $pattern $subpattern
  global TH
  eval $w tag configure TEST $TH(Paint,Test,Tag)
  $w tag lower TEST sel
  
  set TH(Paint,Test,Pattern,$w) $pattern
  set TH(Paint,Test,Subpattern,$w) $subpattern
  return ""
}

proc th_Text_test_use {tag args} {
  global TH
  th_Text_test_clear
  set w [focus]
  eval th_Misc_paint_add $w $tag [list $TH(Paint,Test,Pattern,$w)] \
	[list $TH(Paint,Test,Subpattern,$w)] $args
  return ""
}

proc th_Text_test_use_page {tag args} {
  eval th_Text_test_use $tag $args
  th_Text_paint_region [focus] @0,0 @0,[winfo height [focus]]
  return ""
}

proc th_Text_test_use_all {tag args} {
  eval th_Text_test_use $tag $args
  th_Text_paint_region [focus] 1.0 end
  return ""
}


proc th_Text_unpaint_this {{index insert}} {
  global TH
  set w [focus]
  set i [llength $TH(Paint,$w)] ; incr i -1
  set tags [$w tag names $index]
  set found 0
  for {} {$i >= 0} {incr i -1} {
    set tag [lindex [lindex $TH(Paint,$w) $i] 0]
    if {[lsearch $tags $tag] >= 0} {
      set found 1
      set TH(Paint,$w) [lreplace $TH(Paint,$w) $i $i]
      catch "$w tag delete $tag" result
  }}
  if {!$found} {bell}
  return ""
}

proc th_Text_unpaint_all {} {
  global TH
  set w [focus]
  foreach paint $TH(Paint,$w) {catch "$w tag delete [lindex $paint 0]"}
  set TH(Paint,$w) ""
  return ""
}

