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