#!/usr/bin/tclsh if { [llength $argv]==0 || [string compare [lindex $argv 0] "--help"]==0 } { puts "Syntax: regdb executable" exit 0 } set lastfile "" proc checkselection { curselection } { global env lastfile set socketsdir /tmp/.re_$env(USER) set filenames [glob -tails -directory $socketsdir ) *] # search for occurrences of :[:] 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 <...>, set last used file to that line (useful for gdb) set firstword [lindex [split $curselection " \t\r\t"] 0] if { [string length $lastfile]>0 && [string length $firstword]>0 && [string is ascii $firstword] && [string is digit $firstword] } { 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 } } set fifo [exec mktemp -u /tmp/regdbtmpXXX] exec mkfifo $fifo exec script -q -f -a -c "gdb [lindex $argv 0]" $fifo & set f [open $fifo "r"] set c "" set l "" while { [string length [set c [read $f 1]]]>0 } { if { [string compare $c "\r"]==0 || [string compare $c "\n"]==0 } { if { [string length $l]==0 } { # ignore empty lines continue } checkselection [set l] set l "" continue } set l "$l$c" } close $f file delete $fifo