# general procedures for Athena text widget
# Gustaf Neumann, Dov Grobgeld

proc XawTextRead {w from to} {
  set content ""
  set toread [expr $to-$from]
  while {$toread>0} {
    XawTextSourceRead $w $from text $toread
    append content [string range $text(ptr) 0 [expr $text(length)-1]]
    incr from $text(length)
    incr toread -$text(length)
  }
  return $content
}

proc XawTextBackSpace {w} {
  XawTextGetSelectionPos $w from to
  if $from!=$to {
    callActionProc $w {} kill-selection
    XawTextSetSelection $w $from $from
  } else {
    callActionProc $w {} delete-previous-character
  }
}

proc XawTextDelLine {w} {
  callActionProc $w {} insert-string a
  callActionProc $w {} beginning-of-line
  callActionProc $w {} kill-to-end-of-line
  callActionProc $w {} delete-next-character
}

proc XawTextGetChar {w} {
  XawTextSourceRead $w [XawTextGetInsertionPoint $w] txt 1
  return [string range $txt(ptr) 0 0]
}

proc XawTextGetCurrentLine {w} {
  set ip [XawTextGetInsertionPoint $w]
  set bl [XawTextSourceScan $w $ip EOL left 1 false]
  set el [XawTextSourceScan $w $ip EOL right 1 false]
  return [XawTextRead $w $bl $el]
}

proc XawTextGetColumn {w} {
  set ip [XawTextGetInsertionPoint $w]
  return [incr ip -[XawTextSourceScan $w $ip EOL left 1 false]]
}

proc XawTextGotoColumn {w column} {
  set ip [XawTextGetInsertionPoint $w]
  set bl [XawTextSourceScan $w $ip EOL left 1 false]
  set el [XawTextSourceScan $w $ip EOL right 1 false]
  if {$ip+$column<$el} {
    incr column $bl
    XawTextSetInsertionPoint $w $column
  } else {
    XawTextSetInsertionPoint $w $el
  }
}

proc XawTextSetCurrentLine {w s} {
  set ip [XawTextGetInsertionPoint $w]
  set bl [XawTextSourceScan $w $ip EOL left 1 false]
  set el [XawTextSourceScan $w $ip EOL right 1 false]
  set txt(ptr) $s
  set txt(firstPos) 0
  set txt(length) [string length $s]
  XawTextReplace $w $bl $el txt
}

proc XawTextCopyCurrentLineToNext {w} {
  set cl [XawTextGetCurrentLine $w]
  set ip [XawTextGetInsertionPoint $w]
  XawTextDisplayCaret $w false
  callActionProc $w {} end-of-line
  callActionProc $w {} insert-string \n$cl
  XawTextSetInsertionPoint $w $ip
  XawTextDisplayCaret $w true
}

proc XawTextNewlineAndIndent {w} {
  XawTextDisplayCaret $w false
  set cl [XawTextGetCurrentLine $w]
  set column [XawTextGetColumn $w]
  incr column -1
  callActionProc $w {} newline-and-indent
  callActionProc $w {} insert-string a
  callActionProc $w {} delete-previous-word
  if ![string compare \{ [string range $cl $column $column]] {
    callActionProc $w {} insert-string  "    "
  }
  XawTextDisplayCaret $w true
}


proc XawTextSmartCloseBrace {w} {
  XawTextDisplayCaret $w false
  set ip [XawTextGetInsertionPoint $w]
  set l [XawTextGetCurrentLine $w]
  set column [XawTextGetColumn $w]
  set ll [string range $l 0 [expr $column-1]]
  set lr [string range $l $column end]
  
  if { [regsub "    \$" $ll {} ll] != 0 } {
    incr ip -3
  } else { 
    incr ip
  }
  XawTextSetCurrentLine $w $ll\}$lr
  XawTextSetInsertionPoint $w $ip
  XawTextDisplayCaret $w true
}

proc XawTextSmartBackSpace {w} {
  set ip [XawTextGetInsertionPoint $w]
  set l [XawTextGetCurrentLine $w]
  set column [XawTextGetColumn $w]
  set ll [string range $l 0 [expr $column-1]]
  set lr [string range $l $column end]
  if { [regsub "    \$" $ll {} ll] != 0 } {
    incr ip -4
    XawSetCurrentLine $w $ll$lr
    XawTextSetInsertionPoint $w $ip
  } else { 
    callActionProc $w {} delete-previous-character
  }
}


#Text t topLevel \
#    width 800 height 300 scrollVertical always \
#    type file \
#    string /u/neumann/wafe/src/tcllib/XawText.tcl \
#    translations {#override
#      <Key>x: exec(tohere t)
#      <Key>c: exec(puts stderr [XawTextGetColumn t])
#      <Key>l: exec(puts stderr <[XawTextGetCurrentLine t]>)
#    }
#
#proc tohere {w} {
#  set ip [XawTextGetInsertionPoint $w]
#  puts stderr "\n\n----\n"
#  set read "<[textRead $w 0 $ip]>"
#  puts stderr <$read>
#}
#
#realize
