Browse code
rehelper initial version, monitors primary selection for filename:line ocurrences and sends the corresponding recenteditor the command to change current line
Dario Rodriguez authored on 02/01/2024 16:38:04
Showing 1 changed files
| 1 | 1 |
new file mode 100755 |
| ... | ... |
@@ -0,0 +1,81 @@ |
| 1 |
+#!/usr/bin/tclsh |
|
| 2 |
+# |
|
| 3 |
+# rehelper |
|
| 4 |
+# |
|
| 5 |
+# Monitors the primary selection for occurrences of filename:lineno . |
|
| 6 |
+# When found, sends to the corresponding recenteditor instance the lineno. |
|
| 7 |
+# |
|
| 8 |
+# Dependencies: |
|
| 9 |
+# socat |
|
| 10 |
+# |
|
| 11 |
+# Documentation: |
|
| 12 |
+# https://wiki.tcl-lang.org/page/Primary+Transfer+vs.+the+Clipboard |
|
| 13 |
+# https://wiki.tcl-lang.org/page/Unix+Domain+Sockets |
|
| 14 |
+# |
|
| 15 |
+# Author: Dario Rodriguez antartica@whereismybit.com |
|
| 16 |
+# (c) 2024 Dario Rodriguez |
|
| 17 |
+# This program is in the public domain |
|
| 18 |
+ |
|
| 19 |
+package require Tk |
|
| 20 |
+ |
|
| 21 |
+wm title . rehelper |
|
| 22 |
+wm geometry . 128x42 |
|
| 23 |
+ |
|
| 24 |
+option add *font "-*-*-*-*-*-*-20-*-*-*-*-*-*-*" |
|
| 25 |
+ |
|
| 26 |
+button .b -text Exit -command exit |
|
| 27 |
+pack .b -side top -fill both -expand true |
|
| 28 |
+ |
|
| 29 |
+set curselection "" |
|
| 30 |
+ |
|
| 31 |
+proc selectionlost {} {
|
|
| 32 |
+ global curselection |
|
| 33 |
+ set curselection [selection get -selection PRIMARY] |
|
| 34 |
+ puts $curselection |
|
| 35 |
+ checkselection $curselection |
|
| 36 |
+ selection own -selection PRIMARY -command selectionlost "." |
|
| 37 |
+} |
|
| 38 |
+ |
|
| 39 |
+proc selectionrequest { offset maxchars } {
|
|
| 40 |
+ global curselection |
|
| 41 |
+ return $curselection |
|
| 42 |
+} |
|
| 43 |
+ |
|
| 44 |
+proc checkselection { curselection } {
|
|
| 45 |
+ global env |
|
| 46 |
+ set socketsdir /tmp/.re_$env(USER) |
|
| 47 |
+ set filenames [glob -tails -directory $socketsdir ) *] |
|
| 48 |
+ foreach f $filenames {
|
|
| 49 |
+ set index -1 |
|
| 50 |
+ set flen [string length $f] |
|
| 51 |
+ while { [set index [string first $f $curselection [expr $index + 1]]]!=-1 } {
|
|
| 52 |
+ if { [string compare [string index $curselection [expr $index+$flen]] ":"]==0
|
|
| 53 |
+ && ( $index==0 || [string is alnum [string index $curselection [expr $index-1]]]==0 ) |
|
| 54 |
+ && [string compare [string index $curselection [expr $index+$flen+1]] ""]!=0 |
|
| 55 |
+ && [string is digit [string index $curselection [expr $index+$flen+1]]]==1} {
|
|
| 56 |
+ set index [expr $index+$flen+1] |
|
| 57 |
+ set startindex $index |
|
| 58 |
+ while { [string compare [string index $curselection $index] ""]!=0
|
|
| 59 |
+ && ( [string is digit [string index $curselection $index]]==1 |
|
| 60 |
+ || [string compare [string index $curselection $index] ":"]==0 ) } {
|
|
| 61 |
+ incr index |
|
| 62 |
+ } |
|
| 63 |
+ set newpos [string range $curselection $startindex $index-1] |
|
| 64 |
+ remotecontrol $socketsdir $f "goto $newpos" |
|
| 65 |
+ } |
|
| 66 |
+ } |
|
| 67 |
+ } |
|
| 68 |
+} |
|
| 69 |
+ |
|
| 70 |
+proc remotecontrol { socketsdir filename command } {
|
|
| 71 |
+ puts "filename:$socketsdir/$filename command:\"$command\"" |
|
| 72 |
+ catch {
|
|
| 73 |
+ set f [open "|socat - UNIX-CONNECT:$socketsdir/$filename" r+] |
|
| 74 |
+ puts -nonewline $f "$command\n" |
|
| 75 |
+ close $f |
|
| 76 |
+ } |
|
| 77 |
+} |
|
| 78 |
+ |
|
| 79 |
+selection handle -selection PRIMARY "." selectionrequest |
|
| 80 |
+selection own -selection PRIMARY -command selectionlost "." |
|
| 81 |
+ |