#!/usr/bin/tclsh
#
# rehelper
#
# Monitors the primary selection for occurrences of filename:lineno .
# When found, sends to the corresponding recenteditor instance the lineno.
#
# Dependencies:
#  socat
#
# Documentation:
#  https://wiki.tcl-lang.org/page/Primary+Transfer+vs.+the+Clipboard
#  https://wiki.tcl-lang.org/page/Unix+Domain+Sockets
#
# Author: Dario Rodriguez antartica@whereismybit.com
# (c) 2024 Dario Rodriguez
# This program is in the public domain

package require Tk

wm title . rehelper
wm geometry . 128x42

option add *font "-*-*-*-*-*-*-20-*-*-*-*-*-*-*"

button .b -text Exit -command exit
pack .b -side top -fill both -expand true

set curselection ""

set lastseconds 0
set nstolen 0

proc selectionlost {} {
        global curselection
        global lastseconds nstolen
        # check if there is another instance fighting for the selection
        set newseconds [clock seconds]
        if { $newseconds == $lastseconds } {
                incr nstolen
                if { $nstolen>10 } {
                        puts "There seems to be another instance running, exiting"
                        exit 0
                }
        } else {
                set lastseconds $newseconds
                set nstolen 0
        }
        # process the selection
        set curselection [selection get -selection PRIMARY]
        puts $curselection
        checkselection $curselection
        selection own -selection PRIMARY -command selectionlost "."
}

proc selectionrequest { offset maxchars } {
        global curselection
        return $curselection
}

proc checkselection { curselection } {
        global env
        set socketsdir /tmp/.re_$env(USER)
	set filenames [list]
	catch {
	        set filenames [glob -tails -directory $socketsdir ) *]
	}
        foreach f $filenames {
                set index -1
                set flen [string length $f]
                while { [set index [string first $f $curselection [expr $index + 1]]]!=-1 } {
                        if { [string compare [string index $curselection [expr $index+$flen]] ":"]==0
                             && ( $index==0 || [string is alnum [string index $curselection [expr $index-1]]]==0 )
                             && [string compare [string index $curselection [expr $index+$flen+1]] ""]!=0
                             && [string is digit [string index $curselection [expr $index+$flen+1]]]==1} {
                                set index [expr $index+$flen+1]
                                set startindex $index
                                while { [string compare [string index $curselection $index] ""]!=0
                                        && ( [string is digit [string index $curselection $index]]==1
                                        || [string compare [string index $curselection $index] ":"]==0 ) } {
                                        incr index
                                }
                                set newpos [string range $curselection $startindex $index-1]
                                remotecontrol $socketsdir $f "goto $newpos"
                        }
                }
        }
}

proc remotecontrol { socketsdir filename command } {
        puts "filename:$socketsdir/$filename command:\"$command\""
        catch {
                set f [open "|socat - UNIX-CONNECT:$socketsdir/$filename" r+]
                puts -nonewline $f "$command\n"
                close $f
        }
}

selection handle -selection PRIMARY "." selectionrequest
selection own -selection PRIMARY -command selectionlost "."