#
# Module for editing Text widgets
#


# Undos are handled thus: Each cmd that can be undone stores an entry into
# TH(Undo,Data,$w). This entry contains the code necessary to undo itself, a
# human-readable title to prompt the user with what it did, and a list of marks
# that were created to accomodate the undo code.

# Clears the undo log.
proc th_Text_kill_undos {w} {
  global TH
  if {[catch "set TH(Undo,Data,$w)"]} {set TH(Undo,Data,$w) ""}

  foreach data $TH(Undo,Data,$w) {
    foreach mark [lindex $data 2] {  $w mark unset $mark}}
}

# Undoes last command.
proc th_Text_undo {w} {
  global TH
  if {[catch "set TH(Undo,Data,$w)"]} {set TH(Undo,Data,$w) ""}
  if {([llength $TH(Undo,Data,$w)] == 0)} {bell ; return}

  set data [lindex $TH(Undo,Data,$w) 0]
  set TH(Undo,Data,$w) [lrange $TH(Undo,Data,$w) 1 end]
  set TH(Modified,$w) 1
  eval [lindex $data 0]
  foreach mark [lindex $data 2] {  $w mark unset $mark}
}

# Any procedure that changes text should call this function. Code is the code
# needed to undo the change, name gets shown to the user if user wants to know
# the last undoable command. Marks are any marks left in the text that the
# undo mechanism should automagically remove.
proc th_Text_register_undoable_cmd {w code {name ""} {marks ""}} {
  global TH ;  set TH(Modified,$w) 1
  if {[catch "set TH(Undo,Data,$w)"]} {set TH(Undo,Data,$w) ""}
  if {[catch "set TH(Undo,Max,[winfo class $w])"]} {set TH(Undo,Max,[winfo class $w]) 0}

  set new_entry [list $code $name $marks]
  set TH(Undo,Data,$w) [concat [list $new_entry] $TH(Undo,Data,$w)]
  if {($TH(Undo,Max,[winfo class $w]) >= 0) && ($TH(Undo,Max,[winfo class $w]) < [llength $TH(Undo,Data,$w)])} {
    set purge_data [lindex $TH(Undo,Data,$w) $TH(Undo,Max,[winfo class $w])]
    foreach mark [lindex $purge_data 2] {  $w mark unset $mark}
    set TH(Undo,Data,$w) [lrange $TH(Undo,Data,$w) 0 [expr "$TH(Undo,Max,[winfo class $w]) - 1"]]
}}

# Allows some text to be replaced. (The change should have occured already)
# Start and end indicate where the change occrured. chars is the old string
# and 'desc' is a good description; chars will be appended to it.
proc th_Text_undoable_replace {w start end chars {desc "Change"} {one 0}} {
  set ustart [$w index $start]
  if $one {set uend [$w index $start]} else {set uend [$w index $end]}
  th_Text_register_undoable_cmd $w [list th_Text_undo_replace $w $ustart \
	$uend $chars] "$desc $chars" ""
}

proc th_Text_undo_replace {w ustart uend chars} {$w delete $ustart $uend ; $w insert $ustart $chars}


# Simple insertion routines

# Inserts chars in text (duhhhh...)
proc th_Text_insert {w chars} {
  $w insert insert $chars
  $w see insert
  global TH ; set TH(Modified,$w) 1
}

# Like th_Text_insert, but can be undone.
proc th_Text_undoable_insert {w string} {
  set i [$w index insert]
  th_Text_insert $w $string
  th_Text_undoable_replace $w $i insert "" "Insert $string"
}

# Inserts a single character, or overwrites one. Not undoable.
proc th_Text_self_insert {w {c ""}} {
  if {(![regexp . $c])} {return}
  th_Text_insert $w $c
  global TH
  if {[catch "set TH(Overwrite,$w)"]} {set TH(Overwrite,$w) 0}
  if $TH(Overwrite,$w) {if {[$w get insert] != "\n"} {$w delete insert}}
}


# Text deletion

# Delete a range of text. If $undo is set, deletion should be undoable. If
# $marks is set, use marks to signify deletion range, otherwise just use the
# absolute indices. (Absolute indices are usually better when undoing multiple
# ranges.)
proc th_Text_delete_range {w start end {undo 1} {marks 0}} {
  if {([$w compare $start >= $end])} {bell ; return}
  set s [$w index $start]
  set e [$w index $end]

  set dead [$w get $s $e]
  $w delete $s $e
  $w see insert
  if $undo {th_Text_undoable_replace $w $s $s $dead "Delete" $marks
  } else {global TH ; set TH(Modified,$w) 1}
}

# Delete the selected text from $w.
proc th_Text_delete_selection {w} {
  if {[catch "$w index sel.last"]} {bell ; return}
  th_Text_delete_range $w sel.first sel.last
}


# Text killing

# Cut a single line. Can be concatenated with previous kill-lines.
proc th_Text_kill_line {w} {
  if {([$w get insert] == "\n")} {
    set end {insert +1 chars}
  } else {set end {insert lineend}}
  set killed [$w get insert $end]
  global TH ;  set TH(Modified,$w) 1

# Add a new binding tag to tell us the next keystrokes.
  set restart_kill 0
  if {[lsearch [set bindtags [bindtags $w]] "kill_keys"] < 0} {
    set restart_kill 1
    bindtags $w "kill_keys $bindtags"
    set TH(Kill,Active) 1
    bind kill_keys <Key> {if {[regexp . %A]} {set TH(Kill,Active) 0}}
    foreach binding {<Control-Key> <Meta-Key> <Meta-Control-Key> <Button> <Enter>} {
      bind kill_keys $binding {set TH(Kill,Active) 0}}
    foreach key $TH(Binding,Kill_Line) {
      bind kill_keys $key {# do nothing, don't clear TH(Kill,Active)}
  }}
  if {$TH(Kill,Active) != 1} {set restart_kill 1}
  set TH(Kill,Active) 1

  if $restart_kill {clipboard clear -displayof $w}
  clipboard append -displayof $w -- [$w get insert $end]
  th_Text_delete_range $w insert $end 1 1
}

# Cut a range of text.
proc th_Text_kill_range {w start end} {
  if {([$w compare $start >= $end])} {bell ; return}
  set s [$w index $start]
  set e [$w index $end]
  global TH ;  set TH(Modified,$w) 1
  clipboard clear -displayof $w
  clipboard append -displayof $w -- [$w get $s $e]
  th_Text_delete_range $w $s $e
}

# Cut the selected region, or the region between anchor and insert.
proc th_Text_kill_region {w} {
  if {![catch "$w index sel.last"] &&
    [$w compare sel.first <= insert] && [$w compare insert <= sel.last]} {
    th_Text_kill_range $w sel.first sel.last
  } elseif {![catch {$w index anchor} m]} {
    if {[$w compare $m <= insert]} {
      th_Text_kill_range $w $m insert
    } else {th_Text_kill_range $w insert $m}
  } else {bell}
}


# Filtering commands

proc th_Text_filter {w filter} {
  if {([catch {$w get sel.first}])} {
    set start insert ; set end "insert wordend"
    set selected 0
  } else {set start sel.first ; set end sel.last
    set selected 1
  }
  set word [$w get $start $end]
  set new_w [$filter $word]

  if {($word == $new_w)} {$w mark set insert "insert wordend" ; return}

  set new_wl [string length $new_w]
  $w delete $start $end
  $w insert insert $new_w
  if $selected {$w tag add sel "insert -$new_wl chars" insert}
  $w see insert
  th_Text_undoable_replace $w "insert - $new_wl chars" insert $word "Filter"
}


# Transposition commands

proc th_Text_transpose_chars {w} {
  if {([$w compare insert <= 1.0])} {bell ; return}
  set transedchars "[$w get {insert -1 chars}][$w get insert]"
  tkTextTranspose $w
  th_Text_undoable_replace $w "insert -2c" insert $transedchars "Transpose"
}

proc th_Text_transpose_words {w} {
  $w mark set insert {insert wordstart}
  if {([$w compare {insert -2 chars wordstart} <= 1.0])} {bell ; return}

# Delete last three words, insert in reverse order.
  set c1 [$w get insert {insert wordend}]
  $w delete insert {insert wordend}
  set c2 [$w get {insert -1 chars wordstart} insert]
  $w delete {insert -1 chars wordstart} insert
  set c3 [$w get {insert -1 chars wordstart} insert]
  $w delete {insert -1 chars wordstart} insert
  set begin [$w index insert]
  $w insert insert $c1
  $w insert insert $c2
  $w insert insert $c3
  $w see insert
  th_Text_undoable_replace $w $begin "$begin wordend wordend wordend" \
	"$c3$c2$c1" "Transpose"
}


# Indenting text

# Given to th_Misc_indent.
proc th_Text_indent {w {delete 0}} {
  set prefix ["[th_frame $w].indent.e" get]
  th_hide_entry $w indent

  if {([catch {$w index sel.first}])} {bell ; return}
  if {($prefix == "")} {bell ; return}
  set mark1 [$w index "sel.first linestart"]
  set mark2 [$w index "sel.last -1c lineend"]
  set chars [$w get $mark1 $mark2]
  if $delete {th_Text_delete_prefix $w $mark1 $mark2 $prefix ; set desc "Un-Indent"
  } else {th_Text_add_prefix $w $mark1 $mark2 $prefix ; set desc "Indent"}
  $w tag remove sel 1.0 end
  $w tag add sel "$mark1 linestart" "$mark2 lineend"
  th_Text_undoable_replace $w "$mark1 linestart" "$mark2 lineend" $chars $desc
}

# Ditto
proc th_Text_indent_delete {w} {th_Text_indent $w 1}

# Add prefix to every line between start and end in w.
proc th_Text_add_prefix {w start end prefix} {
  scan [$w index $start] "%d.%d" s dummy
  scan [$w index $end] "%d.%d" e dummy
  if {$dummy == 0} {incr e -1}
  for {set t $s} {$t <= $e} {incr t} {
    $w insert "$t.0" $prefix
}}

# Remove prefix from every line between start and end in w (if line has prefix)
proc th_Text_delete_prefix {w start end prefix} {
  scan [$w index $start] "%d.%d" s dummy
  scan [$w index $end] "%d.%d" e dummy
  if {$dummy == 0} {incr e -1}
  set l [string length $prefix]
  for {set t $s} {$t <= $e} {incr t} {
    if {[string first $prefix [$w get "$t.0" "$t.0 lineend"]] == 0} {
      $w delete "$t.0" "$t.0 +$l c"
}}}
