#!/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 .b0 -text copysel -command {
	selection handle -selection CLIPBOARD . selectionrequest
	selection own -selection CLIPBOARD . } -font "-*-*-*-*-*-*-12-*-*-*-*-*-*-*"
pack .b0 -side left -fill both -expand false
button .b -text Exit -command exit
pack .b -side left -fill both -expand true

set curselection ""

set lastseconds 0
set nstolen 0
set lastfile ""

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
        catch {
                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 lastfile
        set socketsdir /tmp/.re_$env(USER)
        set filenames [glob -tails -directory $socketsdir ) *]
        # search for occurrences of <filename>:<line>[:<col>]
        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"
                                set lastfile $f
                        }
                }
        }
        # if it is just <line>, set last used file to that line (useful for gdb)
        if { [string length $lastfile]>0 && [string is ascii $curselection] && [string is digit $curselection] } {
                remotecontrol $socketsdir $lastfile "goto $curselection"
        }
}

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 "."