#!/bin/sh
#
# edit file argument on a text window
# \
exec wish -file $0 ${1+"$@"}
# \
exit

if [catch {
 
global title
global fn
global opnum
global commit
global height
global rfile

# compensate for tk3.6/4.0 text widget autoinsertion of trailing newline
proc end {} {return end}
if $tk_version>=4.0 {
    proc end {} {return end-1char}
    option add *Menubutton*padX 1
    option add *Menubutton*padY 1
    option add *Button*padX 1
    option add *Button*padY 1
}

set rfile ""
set eexpr ""
set height 40
set title xe
while {[regexp {^-[tlre]$} [lindex $argv 0]]} {
    if [regexp {^-t$} [lindex $argv 0]] { set title [lindex $argv 1] }
    if [regexp {^-l$} [lindex $argv 0]] { set height [lindex $argv 1] }
    if [regexp {^-r$} [lindex $argv 0]] { set rfile [lindex $argv 1] }
    if [regexp {^-e$} [lindex $argv 0]] { set eexpr [lindex $argv 1] }
    set argv [lrange $argv 2 end]
}

if [string length [lindex $argv 0]] {
    set fn [lindex $argv 0]
} {
    set fn [exec sh -c {echo $HOME/tmp/`date +%y%m%d%H%M%S`}]
    if ![file isfile $fn] {exec touch $fn}
}
if [regexp {^xe$} $title] {
    regsub {^.*/} $fn "" title
    set title "xe $title"
}

set opnum 0

proc set-file {newfn} {
    global fn title
    set fn $newfn
    regsub {^.*/} $fn "" title
    set title "xe $title"
    wm iconname . $title
    wm title . $title
    .text delete 1.0 end
    .text insert 1.0 [exec -keepnewline cat $fn]
}

proc set-fn {newfn} {set-filename $newfn}
proc set-filename {newfn} {
    global fn title
    set fn $newfn
    regsub {^.*/} $fn "" title
    set title "xe $title"
    wm iconname . $title
    wm title . $title
}

proc write-buffer {} {
    global fn
    set f [open $fn w]
    puts $f [.text get 1.0 [end]] nonewline
    close $f
}

proc commit-text {} {
    global commit
    set commit [.text get 1.0 [end]]
}

proc revert-text {} {
    global commit
    set x [.text get 1.0 [end]]
    .text delete 1.0 end
    .text insert 1.0 $commit
    set commit $x
}

proc newtcl {} {
    global opnum
    set opnum [expr $opnum+1]
    frame .ops.$opnum
    button .ops.$opnum.delete -text del -command "destroy .ops.$opnum"
    button .ops.$opnum.do -text tcl -command "dotcl $opnum"
    text   .ops.$opnum.text -font 6x13 -height 1 -width 60
    foreach b {delete do} {pack .ops.$opnum.$b -side left}
    pack .ops.$opnum.text -side left -fill x
    pack .ops.$opnum -side top -fill x
}
proc newmark {} {
    global opnum
    set position [.text index @1,1]
    newtcl
    .ops.$opnum.text insert 1.0 ".text yview $position"
}
proc dotcl {n} {
    eval [.ops.$n.text get 1.0 end]
}

proc newsearch {} {
    global opnum
    set opnum [expr $opnum+1]
    frame .ops.$opnum
    button .ops.$opnum.delete -text del -command "destroy .ops.$opnum"
    button .ops.$opnum.next -text next -command "nextsearch $opnum"
    button .ops.$opnum.prev -text prev -command "prevsearch $opnum"
    text   .ops.$opnum.text -font 6x13 -height 1 -width 60
    foreach b {delete next prev} {pack .ops.$opnum.$b -side left}
    pack .ops.$opnum.text -side left -fill x
    pack .ops.$opnum -side top -fill x
}
proc nextsearch {n} {search next [.ops.$n.text get 1.0 [end]]}
proc prevsearch {n} {search prev [.ops.$n.text get 1.0 [end]]}
proc search {which re} {
    if {$which=="next"} {
        set incr {incr i}
        set test {$i<=$iend}
        set istart [expr int([.text index "insert linestart + 1 lines"])]
        set iend   [.text index "end linestart"]
    } else {
        set incr {incr i -1}
        set test {$i>=$iend}
        set istart [expr int([.text index "insert linestart - 1 lines"])]
        set iend   1.0
    }
    if [regexp {^-i (.*)} $re re re] {set opt -nocase} {set opt --}
    for {set i $istart} $test $incr {
        if [regexp $opt $re [.text get "$i.0 linestart" "$i.0 lineend"]] {
            .text yview $i.0
            .text mark set insert $i.0
            return
        }
    }
}

proc newfilter {} {
    global opnum
    set opnum [expr $opnum+1]
    frame .ops.$opnum
    button .ops.$opnum.delete -text del -command "destroy .ops.$opnum"
    button .ops.$opnum.do -text do -command "dofilter $opnum"
    text   .ops.$opnum.text -font 6x13 -height 1 -width 60
    foreach b {delete do} {pack .ops.$opnum.$b -side left}
    pack .ops.$opnum.text -side left -fill x
    pack .ops.$opnum -side top -fill x
}
proc dofilter {n} {
    set text ""
    if [catch {selection get} text] {set text ""}
    .text insert insert \
                 [exec -keepnewline sh -c [.ops.$n.text get 1.0 end] \
                                    << $text]
}
proc newop {optype optext} {
    global opnum
    "new$optype"
    .ops.$opnum.text insert 1.0 $optext
}
proc xd {args} {exec xd << [eval $args] &}
proc t {args} {
    if [string length $args] {eval .text get $args} {.text get 1.0 [end]}
}
proc i {args} {eval .text insert $args}
proc s {args} {
    if [string length $args] {eval selection $args} {selection get}
}

frame .panel
button .panel.quit -text quit -command "destroy ."
button .panel.write -text write -command write-buffer
button .panel.commit -text commit -command commit-text
button .panel.revert -text revert -command revert-text
button .panel.tcl    -text tcl    -command {eval [selection get]}
button .panel.tclop  -text tclop  -command "newtcl"
button .panel.mark   -text mark   -command "newmark"
button .panel.search -text search -command "newsearch"
button .panel.filter -text filter -command "newfilter"
frame .ops
frame .ops.nop
pack .ops.nop -side top
foreach b {quit write commit revert tcl tclop mark search filter} {
       pack .panel.$b -side left
}

scrollbar .scroll -command ".text yview"
set f [open $fn r]
set commit [read $f]
text .text -yscroll ".scroll set" -wrap word -font 6x13 -height $height
.text insert 1.0 $commit
.text mark set insert 1.0
close $f
pack .panel -side top -fill x
pack .ops -side top -fill x
pack .scroll -side left -fill y
pack .text -side left -fill both -expand yes

bind Text <Left>  {%W mark set insert "insert - 1 chars"}
bind Text <Right> {%W mark set insert "insert + 1 chars"}
bind Text <Up>    {%W mark set insert "insert - 1 lines"}
bind Text <Down>  {%W mark set insert "insert + 1 lines"}
bind Text <ButtonRelease-3> {
    %W mark set insert @%x,%y
    %W insert insert [selection get]
}

wm iconname . $title
wm title . $title
wm minsize . 100 100

if [string length $rfile] {source $rfile}
if [string length $eexpr] {eval $eexpr}
catch {source $env(HOME)/.xerc}

} err] {
    tkerror $err
    exit 2
}