# jtext.tcl - constrained interface to Text widget
#
######################################################################
# Copyright 1992-1999 by Jay Sekora.  This file may be freely        #
# distributed, modified or unmodified, for any purpose, provided     #
# that this copyright notice is retained verbatim in all copies and  #
# no attempt is made to obscure the authorship of this file.  If you #
# distribute any modified versions, I ask, but do not require, that  #
# you clearly mark any changes you make as such and that you provide #
# your users with instructions for getting the original sources.     #
######################################################################

# TO DO:
#   logging
#   integrate more tightly with jtexttags (so can log tags as well)

# THIS IS A BIG PROBLEM until this whole file gets wrapped in its own
# namespace:

catch {
  package require jldb
  # following likely to fail, because done by other libraries too
  namespace import ::jldb::shortcuts::*
}

catch {
  package require aq
  namespace eval ::aq { }			;# so namespace is defined
}

######################################################################
# global variables:
#
global J_PREFS env
if {! [info exists J_PREFS(typeover)]} {set J_PREFS(typeover) 1}
#
######################################################################

######################################################################
# j:text:insert w text -
#   insert text into w at insert point
#   * detects if tags are being used and uses ::aq::tag::insert_string 
#   * handles deletion of selection if needed
######################################################################
### PROBLEM - checking J_PREFS(typeover) shouldn't really be here; it's
###   only appropriate if a user event is generating the text to insert

proc j:text:insert { w text } {
  global j_text
  global j_tag
  global J_PREFS
  
  # in typeover mode, all insertions replace selection:
  if {$J_PREFS(typeover)} {
    if {[j:text:insert_touches_selection $w]} {	;# else might be off-screen!
      j:text:delete $w sel.first sel.last
    }
  }
  
  # if we're using tagged-insertion...
  if {[info exists j_tag(tags,$w)]} {		;# using tagged text
    ::aq::tag::insert_string $w $text
  } else {
    set start [$w index insert]			;# ????? USED ?????
    $w insert insert $text
    $w see insert
  }
  set j_text(dirty,$w) 1
}

proc j:text:insert_string { w text } [info body j:text:insert]

######################################################################
# j:text:move w index -
#   move insert mark in w to index
######################################################################

proc j:text:move { w index } {
  global j_text
  global j_tag
  global J_PREFS
  
  # if we're using tagged-insertion...
  if {[info exists j_tag(tags,$w)]} {		;# using tagged text
    ::aq::tag::move $w $index
  } else {
    $w mark set insert $index
    $w yview -pickplace insert
  }
}

######################################################################
# j:text:delete w from to -
#   delete from index from to index to in w
######################################################################

proc j:text:delete { w from to } {
  j:text:move $w $from
  $w delete $from $to
  set j_text(dirty,$w) 1
}

######################################################################
# j:text:replace w from to string -
#   replace range with string, preserving tags at from
######################################################################

proc j:text:replace { w from to string } {
  set start [$w index $from]
  set tags [$w tag names $from]
  
  $w mark set insert $from
  $w delete insert $to
  $w insert insert $string
  
  foreach tag [$w tag names $start] {
    $w tag remove $tag $start insert
  }
  foreach tag $tags {
    $w tag add $tag $start insert
  }
  set j_text(dirty,$w) 1
  
  $w see insert
}

######################################################################
# j:text:mark_dirty w - mark widget w as dirty (modified)
######################################################################

proc j:text:mark_dirty { w } {
  global j_text
  set j_text(dirty,$w) 1
}

######################################################################
# j:text:mark_clean w - mark widget w as clean (unmodified)
######################################################################

proc j:text:mark_clean { w } {
  global j_text
  set j_text(dirty,$w) 0
}

######################################################################
# j:text:is_dirty w -
#   return 1 if w is dirty (modified) else 0
#   (returns 1 if w hasn't been set dirty or clean)
######################################################################

proc j:text:is_dirty { w } {
  global j_text
  if {[info exists j_text(dirty,$w)]} {
    return $j_text(dirty,$w)
  } else {
    return 1
  }
}

######################################################################
# j:text:has_selection t -
#   return true if selection made in t, else false
######################################################################

proc j:text:has_selection { t } {
  set selrange [$t tag nextrange sel 1.0]
  
  if {"x$selrange" == "x"} {                    ;# returns {} if none
    return 0
  } else {
    return 1
  }
}

######################################################################
# j:text:insert_touches_selection t -
#   return true if selection exists in t and insert is inside or next
#   to it (as will be the case if you just made the selection with
#   the mouse)
######################################################################

proc j:text:insert_touches_selection { t } {
  if {! [j:text:has_selection $t]} {		;# no selection
    return 0
  }
  if {[$t compare insert < sel.first]} {	;# insert before selection
    return 0
  }
  if {[$t compare insert > sel.last]} {		;# insert after selection
    return 0
  }
  return 1
}

######################################################################
######################################################################
######################################################################

######################################################################
# j:text:get_text_with_tags t index1 index2
#   return a list, suitable for use with $t insert, of tagged text
#   from $index1 to $index2
######################################################################

proc j:text:get_text_with_tags { t index1 index2 } {
  catch {unset tags}
  set tags(0) 1
  unset tags(0)
  
  foreach tag [$t tag names $index1] {
    set tags($tag) 1
  }
  
  set rvalue {}
  
  foreach {key value index} [$t dump -text -tag $index1 $index2] {
    switch -exact $key {
      tagon {
        set tags($value) 1
      }
      tagoff {
        catch {unset tags($value)}
      }
      text {
        lappend rvalue $value
        lappend rvalue [array names tags]
      }
    }
  }
  
  return $rvalue
}

######################################################################
# j:text:tagged_insert $t text [tag text2 tag2...]
#   insert tagged text into $t, like text widget insert command
######################################################################

proc j:text:tagged_insert { t tagged_text } {
  global j_text
  global j_tag
  global J_PREFS
  
  # in typeover mode, all insertions replace selection:
  if {$J_PREFS(typeover)} {
    if {[j:text:insert_touches_selection $t]} {	;# else might be off-screen!
      j:text:delete $t sel.first sel.last
    }
  }
  
  eval [list $t] insert insert $tagged_text
  $t see insert
  set j_text(dirty,$t) 1
}

######################################################################
# j:text:find
######################################################################

proc j:text:find { t args } {
  ::aq::parse_args {
    {pattern {}}
    {tag sel}
    {backwards 0}
    {regexp 0}
    {case 1}
    {wrap 1}
  }
  
  if {[string match "" $pattern]} {
    return 0
  }
  
  set command [list $t search -count chars]
  if {!$case} {lappend command -nocase}
  if {$backwards} {lappend command -backwards}
  if {$regexp} {lappend command -regexp}
  lappend command -- $pattern insert
  if {!$wrap} {
    if {$backwards} {
      lappend command 1.0
    } else {
      lappend command end
    }
  }
  
  set index [eval $command]
    
  if {[string match "" $index]} {
    return 0
  }
  
  if {$backwards} {
    j:text:move $t $index
  } else {
    j:text:move $t $index+${chars}c
  }
  if {[string match sel $tag]} {
    $t tag remove sel 1.0 end
  }
  $t tag add $tag $index $index+${chars}c
  return 1
}
