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

if [catch {

global title
global opnum
global height
global rfile

if $tk_version>=4.0 {
    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 "xd stdin"
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]
}
set f stdin
if [string length [lindex $argv 0]] {
    set f [open [lindex $argv 0] r]
    if [regexp {^xd stdin} $title] {
        regsub {^.*/} [lindex $argv 0] "" title
        set title "xd $title"
    }
}

set opnum 0

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 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 s {args} {
    if [string length $args] {eval selection $args} {selection get}
}

frame .panel
button .panel.quit   -text quit -command "destroy ."
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"
frame .ops
frame .ops.nop
pack .ops.nop -side top
foreach b {quit tcl tclop mark search} {pack .panel.$b -side left}

scrollbar .scroll -command ".text yview"
text .text -yscroll ".scroll set" -wrap word -font 6x13 -height $height
.text insert 1.0 [read $f]
.text configure -state disabled
.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
}