# specSrc.tcl -- Source specials for DVI files with TkDVI
# Copyright © 2001 Anselm Lingnau <anselm@strathspey.org>
# See file COPYING for conditions on use and distribution.
# $Id: specSrc.tcl,v 1.1 2001/08/03 12:48:47 anselm Exp $

namespace eval ::tkdvi::browser::special {}

proc ::tkdvi::browser::special::src {name key x y cookie s} {
    variable ::tkdvi::browser::Configure
    variable ::tkdvi::browser::State
    variable ::tkdvi::browser::srcspec::Src

    if {!$::tkdvi::browser::Configure($name-sourcespecials) \
	    || ![regexp {src:(\d+) *(.*)} $s junk lineNo fileName]} {
	return
    }
    if {![::info exists ::tkdvi::browser::srcspec::Src($name,$cookie)]} {
	# puts stderr "Source special: $x $y $fileName $lineNo"
	$::tkdvi::browser::State($name-canvas) create rectangle \
	    [expr {$x-1}] [expr {$y-1}] [expr {$x+1}] [expr {$y+1}] \
	    -outline red -tags src -state hidden
	lappend ::tkdvi::browser::srcspec::Src($name-Y,$y) $x
	set ::tkdvi::browser::srcspec::Src($name,$cookie) 1
	set ::tkdvi::browser::srcspec::Src($name,$x,$y) [list $fileName $lineNo]
    }
}

# Source specials

namespace eval ::tkdvi::browser::srcspec {}

proc ::tkdvi::browser::srcspec::precmd {name} {
    variable Src
    set Src($name-Ys) {}
}

proc ::tkdvi::browser::srcspec::postcmd {name} {
    variable ::tkdvi::browser::State
    variable Src
    $::tkdvi::browser::State($name-canvas) delete src
    foreach s [array names Src $name-Y,*] { unset Src($s) }
    foreach s [array names Src $name,*] { unset Src($s) }
    unset Src($name-Ys)
}

::tkdvi::browser::addHook predisplay ::tkdvi::browser::srcspec::precmd
::tkdvi::browser::addHook postdisplay ::tkdvi::browser::srcspec::postcmd
    
namespace eval ::tkdvi::browser::srcspec {
    ::tkdvi::browser::addBinding canvas <z> [namespace code [list dump %T]]
    ::tkdvi::browser::addBinding canvas <v> [list %C itemconfigure src -state normal]
}

proc ::tkdvi::browser::srcspec::dump {name} {
    variable Src
    puts stderr "Source specials:"
    set ys [array names Src $name-Y,*]
    foreach y [lsort $ys] {
	puts stderr "$y => $Src($y)"
    }
}
proc ::tkdvi::browser::srcspec::go {name x y} {
    variable ::tkdvi::browser::Configure
    variable ::tkdvi::browser::State
    variable Src

    if {!$::tkdvi::browser::Configure($name-sourcespecials)} {
	return
    }

    # Translate current mouse position to canvas position

    set c $::tkdvi::browser::State($name-canvas)
    set x [$c canvasx $x]
    set y [$c canvasy $y]

    # Construct a list of source specials on this page in y-coordinate
    # order and put it in State($name-srcYs)

    if {[llength $Src($name-Ys)] == 0} {
	set ll {}
	set ys [array names Src $name-Y,*]
	if {[llength $ys] == 0} {
	    return
	}
	foreach yy $ys {
	    lappend ll [string range $yy [expr {[string last , $yy]+1}] end]
	}
	set Src($name-Ys) [lsort -integer $ll]
	lappend Src($name-Ys) 99999999
    }

    # Look for the current line (coordinate yyy where mouse y coordinate
    # is less than yyy but greater than y coordinate of previous line).
    # Check for source special on that line but to the left of mouse x
    # coordinate; if there isn't one, check previous line with very large
    # hypothetical mouse x coordinate. BUG: Doesn't seem to work well for
    # multi-column documents.

    # puts stderr "Mouse Y: $y"
    set srcYs $Src($name-Ys)
    set last [expr {[llength $srcYs]-1}]
    for {set i 0} {$i < $last} {incr i} {
	if {[lindex $srcYs $i] > $y} break
    }
    while {$i > 0} {
	set yyy [lindex $srcYs $i]
	if {$yyy < 99999999} {
	    # puts stderr "Likely Y: $yyy"
	    set ys [concat -1 $Src($name-Y,$yyy) 99999999]
	    for {set j 0} {$j < [llength $ys]} {incr j} {
		if {[lindex $ys $j] > $x} break
	    }
	    if {[lindex $ys [expr {$j-1}]] >= 0} {
		set xxx [lindex $ys [expr {$j-1}]]
		break
	    }
	}
	set x 99999998
	incr i -1
    }
    # puts stderr "Likely X: $xxx"

    # Find appropriate file name and line number and emit command to
    # go there.

    if {[info exists Src($name,$xxx,$yyy)]} {
	edit $name $Src($name,$xxx,$yyy)
    }
}

proc ::tkdvi::browser::srcspec::edit {name t} {
    variable ::tkdvi::browser::Configure

    foreach {file line} $t break
    set cmd $::tkdvi::browser::Configure($name-editor)
    regsub {%l} $cmd $line cmd
    regsub {%f} $cmd $file cmd
    # puts stderr "cmd: $cmd"
    if {[catch {eval exec $cmd} msg]} {
	puts stderr $msg
    }
}
	
package provide tkdvi::browser::special::src 1.0
