clipboard-speaker.scm (11541B)
1 #!/usr/bin/guile \ 2 --r7rs -e (clipboard-speaker) -s 3 !# 4 5 (define-library (clipboard-speaker) 6 (import 7 (scheme base) 8 (scheme cxr) 9 (scheme process-context) 10 (scheme write) 11 12 (only (guile) 13 EXIT_FAILURE 14 EXIT_SUCCESS 15 F_GETFL 16 F_SETFL 17 LOCK_EX 18 LOCK_NB 19 O_NONBLOCK 20 SIGTERM 21 compose 22 fcntl 23 file-exists? 24 flock 25 force-output 26 format 27 getpw 28 getuid 29 kill 30 logior 31 mknod 32 open-file 33 passwd:dir 34 pipe 35 setvbuf 36 sigaction 37 spawn 38 string-ci=? 39 string-join 40 string-split 41 string-trim-both 42 waitpid 43 ) 44 45 (srfi srfi-1) 46 (srfi srfi-11) 47 (srfi srfi-26) 48 (prefix (srfi srfi-180) json:) 49 50 (ice-9 match) 51 (ice-9 popen) 52 (ice-9 textual-ports) 53 54 (prefix (config) config:) 55 (prefix (config api) config:api:) 56 (prefix (config licenses) config:licenses:) 57 (prefix (config parser sexp) config:parser:sexp:)) 58 (export main) 59 60 (begin 61 (define *espeak-ng-pid* #f) 62 63 (define (dp x) 64 ;; Debug print, but it's just like the identity procedure. 65 (display x) (newline) 66 x) 67 68 (define (debug-notify-send x) 69 (spawn "notify-send" (list "notify-send" 70 "--expire-time=1000" 71 (format #f "~s~%" x)))) 72 73 (define (get-pid-of-file-locking-process options) 74 (let* ((lslocks-output-pipe (pipe)) 75 (lslocks-pid 76 (spawn "lslocks" 77 (list "lslocks" 78 "--json" 79 "--notruncate" 80 "--output=pid,path") 81 #:output (cdr lslocks-output-pipe)))) 82 83 (close-port (cdr lslocks-output-pipe)) 84 85 (let ((lslocks-output (json:json-read (car lslocks-output-pipe)))) 86 (waitpid lslocks-pid) 87 (close-port (car lslocks-output-pipe)) 88 89 (match (filter (lambda (x) 90 (equal? (cdadr x) 91 (config:option-ref options 'lock-file-path))) 92 ((compose 93 vector->list 94 cdar) 95 lslocks-output)) 96 (`(((pid . ,pid) (path . ,path))) 97 pid) 98 (() 99 #f))))) 100 101 (define (open-file-locked filename) 102 (let ([file-port (open-file filename "w")]) 103 (with-exception-handler 104 (lambda (an-exception) 105 (close-port file-port) 106 #f) 107 (lambda () 108 (flock file-port 109 (logior LOCK_EX 110 LOCK_NB)) 111 file-port) 112 #:unwind? #t))) 113 114 (define (get-home-directory) 115 (passwd:dir (getpw (getuid)))) 116 117 (define DEFAULT-WORDS-PER-MINUTE 200) 118 119 (define DEFAULT-CLIPBOARD-SPEAKER-HOME-PATH ".config/clipboard-speaker/") 120 121 (define DEFAULT-LOCK-FILE-PATH 122 (string-append DEFAULT-CLIPBOARD-SPEAKER-HOME-PATH 123 "lock")) 124 125 (define DEFAULT-FIFO-FILE-PATH 126 (string-append DEFAULT-CLIPBOARD-SPEAKER-HOME-PATH 127 "fifo")) 128 129 (define config 130 (config:api:configuration 131 (name 'clipboard-speaker) 132 (synopsis "Speak clipboard contents.") 133 (author "Yuval Langer") 134 (copyright '(2023)) 135 (license config:licenses:agpl3+) 136 (version "1.0.1") 137 (parser config:parser:sexp:sexp-parser) 138 (keywords 139 (list 140 (config:api:switch 141 (name 'clipboard-type) 142 (synopsis "Type of clipboard (b, s, or p)") 143 (character #f) 144 (example "b/s/p (choose b or s or p)") 145 (default "b") 146 (test (lambda (x) 147 (or (string=? x "b") 148 (string=? x "s") 149 (string=? x "p")))) 150 ;;(handler identity) 151 ) 152 (config:api:switch 153 (name 'words-per-minute) 154 (synopsis "Words per minute spoken.") 155 (character #f) 156 (example "170") 157 (default 200) 158 (test integer?) 159 (handler string->number)) 160 (config:api:switch 161 (name 'kill) 162 (synopsis "Kill the espeak-ng loop process.") 163 (default #f) 164 (test boolean?) 165 (character #f)) 166 (config:api:switch 167 (name 'clipboard-speaker-path) 168 (synopsis "Path to the clipboard-speaker settings directory.") 169 (default DEFAULT-CLIPBOARD-SPEAKER-HOME-PATH) 170 (character #f) 171 ) 172 (config:api:setting 173 (name 'words-per-minute) 174 (synopsis "Words per minute spoken.") 175 (default 200) 176 (handler string->number) 177 (test number?) 178 (example "230")) 179 (config:api:setting 180 (name 'fifo-file-path) 181 (synopsis "Path to FIFO file.") 182 (default (string-append (get-home-directory) 183 "/" 184 DEFAULT-FIFO-FILE-PATH))) 185 (config:api:setting 186 (name 'lock-file-path) 187 (synopsis "Path to lock file.") 188 (default (string-append (get-home-directory) 189 "/" 190 DEFAULT-LOCK-FILE-PATH))))) 191 (directory 192 (config:api:in-home DEFAULT-CLIPBOARD-SPEAKER-HOME-PATH)))) 193 194 (define (make-config-if-does-not-exist path value) 195 (if (file-exists? path) 196 #f 197 (let ([file-port (open-file path "w")]) 198 (put-string file-port value)))) 199 200 (define (mkfifo path mode) 201 (mknod path 'fifo mode 0)) 202 203 (define (read-clipboard clipboard-type) 204 ;; Popen `xsel -p` or `xsel -b` as an output port. 205 (unless (or (equal? clipboard-type "p") 206 (equal? clipboard-type "s") 207 (equal? clipboard-type "b")) 208 (error "Bad clipboard type:" clipboard-type)) 209 210 (let* ((xsel-stdout-pipe (pipe)) 211 (xsel-pid 212 (spawn "xsel" 213 (list "xsel" 214 (string-append "-" clipboard-type)) 215 #:output (cdr xsel-stdout-pipe)))) 216 (close-port (cdr xsel-stdout-pipe)) 217 218 ;; Read lines from xsel port and for each line replace 219 ;; the newlines in it with spaces. 220 (let ((xsel-output ((compose (cut string-join <> " ") 221 (cut map string-trim-both <>) 222 (cut string-split <> #\newline) 223 get-string-all) 224 (car xsel-stdout-pipe)))) 225 (close-port (car xsel-stdout-pipe)) 226 (waitpid xsel-pid) 227 xsel-output))) 228 229 (define (make-fifo-ports fifo-file-path) 230 (when (not (file-exists? fifo-file-path)) 231 (mkfifo fifo-file-path 232 #o600)) 233 234 (let* ((fifo-port-write 235 (open-file fifo-file-path 236 "wl+")) 237 (fifo-port-read 238 (open-file fifo-file-path 239 "rl+")) 240 (flags (fcntl fifo-port-read 241 F_GETFL))) 242 (fcntl fifo-port-read 243 F_SETFL 244 (logior O_NONBLOCK 245 flags)) 246 (values fifo-port-read fifo-port-write))) 247 248 (define (espeak-loop fifo-read-port words-per-minute) 249 (let ((espeak-ng-input-pipe (pipe))) 250 (set! *espeak-ng-pid* 251 (spawn "espeak-ng" 252 (list "espeak-ng" 253 "-s" 254 (number->string words-per-minute)) 255 #:input (car espeak-ng-input-pipe))) 256 257 (let loop ((text-to-speak (get-line fifo-read-port))) 258 (format #t "Server received: ~A\n" text-to-speak) 259 260 (put-string (cdr espeak-ng-input-pipe) 261 text-to-speak) 262 ;; XXX: These ports are line buffered(?). Always write to ports 263 ;; with a newline at their end if you want the other side to read 264 ;; them now. 265 (put-char (cdr espeak-ng-input-pipe) 266 #\newline) 267 268 ;; XXX: You also have you flush the port, otherwise the TTS keeps 269 ;; silent. Please someone explain this to me. 270 (force-output (cdr espeak-ng-input-pipe)) 271 272 (loop (get-line fifo-read-port))))) 273 274 (define (make-pipes buffering-type) 275 (let ((pipes (pipe))) 276 (setvbuf (car pipes) buffering-type) 277 (setvbuf (cdr pipes) buffering-type) 278 279 pipes)) 280 281 (define (kill-server options) 282 (cond 283 ((file-exists? (config:option-ref options 284 'lock-file-path)) 285 (let ([pid (get-pid-of-file-locking-process options)]) 286 (cond 287 ((number? pid) 288 (kill pid SIGTERM) 289 (format #t "Killed ~S.~%" pid) 290 (exit EXIT_SUCCESS)) 291 (else 292 (format #t "clipboard-speaker is not running.~%") 293 (exit EXIT_FAILURE))))) 294 (else 295 (format #t "No pid file: ~S~%" (config:option-ref options 'lock-file-path)) 296 (exit EXIT_FAILURE)))) 297 298 299 (define (main args) 300 (let ((options (config:getopt-config-auto args config))) 301 (when (config:option-ref options 302 'kill) 303 (kill-server options)) 304 305 ;; Make / open read and write fifo files. 306 (let-values (((fifo-r fifo-w) 307 (make-fifo-ports (config:option-ref options 308 'fifo-file-path)))) 309 (let ((clipboard-output 310 (read-clipboard (config:option-ref options 311 'clipboard-type)))) 312 313 (format #t "Client sends: ~A~%" clipboard-output) 314 315 ;; Write clipboard contents into the FIFO file for the TTS server to 316 ;; read. 317 (put-string fifo-w 318 clipboard-output)) 319 ;; XXX: These ports are line buffered. Always write to ports with 320 ;; a newline at their end if you want the other side to read them 321 ;; now. 322 (put-char fifo-w #\newline) 323 324 ;; XXX: We don't need to write to FIFO anymore. This will make sure 325 ;; the message passes through. Please someone explain this to me. 326 (close-port fifo-w) 327 328 ;; Try to lock the lock file. 329 (let ((lock-file-port 330 (open-file-locked (config:option-ref options 331 'lock-file-path)))) 332 333 (when lock-file-port 334 ;; If we have the lock, we're the speaker server. 335 336 ;; If we receive a divine SIGTERM, kill our offsprings and commit 337 ;; suicide. Truly, an Abrahamic horror story. 338 (sigaction SIGTERM 339 (lambda (received-signal) 340 ;;; XXX: BUG: In Gnome, (kill 0 received-signal), which kills all 341 ;;; processes in our group, results in killing the keybinding reading 342 ;;; process that runs clipboard-speaker, hence *espeak-ng-pid*. 343 (when (number? *espeak-ng-pid*) 344 (kill *espeak-ng-pid* received-signal)) 345 (exit EXIT_SUCCESS))) 346 347 (espeak-loop fifo-r 348 (config:option-ref options 'words-per-minute))) 349 350 (exit EXIT_SUCCESS)))))))