commit e879e1e65903b6fe96fc16398d1470ffa20bcbdc
parent 9a6a9e13aba798872e10399d04b516516fee0413
Author: Yuval Langer <yuval.langer@gmail.com>
Date: Sat, 6 Jan 2024 03:06:33 +0200
Return multiple values instead of a cons for the fifo file r+w, replace define with lets inside of procedures, and bump version number.
Diffstat:
| M | clipboard-speaker.scm | | | 216 | ++++++++++++++++++++++++++++++++++++++----------------------------------------- |
1 file changed, 104 insertions(+), 112 deletions(-)
diff --git a/clipboard-speaker.scm b/clipboard-speaker.scm
@@ -41,6 +41,8 @@
string-trim-both
waitpid
)
+
+ (srfi srfi-11)
(srfi srfi-26)
(prefix (srfi srfi-180) json:)
@@ -72,36 +74,32 @@
(format #f "~s~%" x))))
(define (get-pid-of-file-locking-process options)
- (define lslocks-output-pipe (pipe))
- (define lslocks-pid
- (spawn "lslocks"
- (list "lslocks"
- "--json"
- "--notruncate"
- "--output=pid,path")
- #:output (cdr lslocks-output-pipe)))
-
- (close-port (cdr lslocks-output-pipe))
-
- (define lslocks-output (json:json-read (car lslocks-output-pipe)))
-
- (waitpid lslocks-pid)
- (close-port (car lslocks-output-pipe))
-
- (define result
- (match (filter (lambda (x)
- (equal? (cdadr x)
- (config:option-ref options 'lock-file-path)))
- ((compose
- vector->list
- cdar)
- lslocks-output))
- (((('pid . pid) ('path . path)))
- pid)
- (()
- #f)))
-
- result)
+ (let* ((lslocks-output-pipe (pipe))
+ (lslocks-pid
+ (spawn "lslocks"
+ (list "lslocks"
+ "--json"
+ "--notruncate"
+ "--output=pid,path")
+ #:output (cdr lslocks-output-pipe))))
+
+ (close-port (cdr lslocks-output-pipe))
+
+ (let ((lslocks-output (json:json-read (car lslocks-output-pipe))))
+ (waitpid lslocks-pid)
+ (close-port (car lslocks-output-pipe))
+
+ (match (filter (lambda (x)
+ (equal? (cdadr x)
+ (config:option-ref options 'lock-file-path)))
+ ((compose
+ vector->list
+ cdar)
+ lslocks-output))
+ (`(((pid . ,pid) (path . ,path)))
+ pid)
+ (()
+ #f)))))
(define (open-file-locked filename)
(let ([file-port (open-file filename "w")])
@@ -138,7 +136,7 @@
(author "Yuval Langer")
(copyright '(2023))
(license config:licenses:agpl3+)
- (version "0.1")
+ (version "1.0")
(parser config:parser:sexp:sexp-parser)
(keywords
(list
@@ -212,50 +210,43 @@
(equal? clipboard-type "b"))
(error "Bad clipboard type:" clipboard-type))
- (define xsel-stdout-pipe (pipe))
- (define xsel-pid
- (spawn "xsel"
- (list "xsel"
- (string-append "-" clipboard-type))
- #:output (cdr xsel-stdout-pipe)))
-
- (close-port (cdr xsel-stdout-pipe))
-
- ;; Read lines from xsel port and for each line replace
- ;; the newlines in it with spaces.
- (define xsel-output ((compose (cut string-join <> " ")
- (cut map string-trim-both <>)
- (cut string-split <> #\newline)
- get-string-all)
- (car xsel-stdout-pipe)))
-
- (close-port (car xsel-stdout-pipe))
-
- (waitpid xsel-pid)
-
- xsel-output)
+ (let* ((xsel-stdout-pipe (pipe))
+ (xsel-pid
+ (spawn "xsel"
+ (list "xsel"
+ (string-append "-" clipboard-type))
+ #:output (cdr xsel-stdout-pipe))))
+ (close-port (cdr xsel-stdout-pipe))
+
+ ;; Read lines from xsel port and for each line replace
+ ;; the newlines in it with spaces.
+ (let ((xsel-output ((compose (cut string-join <> " ")
+ (cut map string-trim-both <>)
+ (cut string-split <> #\newline)
+ get-string-all)
+ (car xsel-stdout-pipe))))
+ (close-port (car xsel-stdout-pipe))
+ (waitpid xsel-pid)
+ xsel-output)))
(define (make-fifo-ports fifo-file-path)
(when (not (file-exists? fifo-file-path))
(mkfifo fifo-file-path
#o600))
- (define fifo-port-write
- (open-file fifo-file-path
- "wl+"))
-
- (define fifo-port-read
- (open-file fifo-file-path
- "rl+"))
-
- (let ([flags (fcntl fifo-port-read
- F_GETFL)])
+ (let* ((fifo-port-write
+ (open-file fifo-file-path
+ "wl+"))
+ (fifo-port-read
+ (open-file fifo-file-path
+ "rl+"))
+ (flags (fcntl fifo-port-read
+ F_GETFL)))
(fcntl fifo-port-read
F_SETFL
(logior O_NONBLOCK
- flags)))
-
- (cons fifo-port-read fifo-port-write))
+ flags))
+ (values fifo-port-read fifo-port-write)))
(define (espeak-loop fifo-read-port words-per-minute)
(define espeak-ng-input-pipe (pipe))
@@ -311,54 +302,55 @@
(define (main args)
- (define options (config:getopt-config-auto args config))
-
- (when (config:option-ref options
- 'kill)
- (kill-server options))
-
- ;; Make / open read and write fifo files.
- (define fifo-r+w (make-fifo-ports (config:option-ref options
- 'fifo-file-path)))
-
- (define clipboard-output
- (read-clipboard (config:option-ref options
- 'clipboard-type)))
-
- (format #t "Client sends: ~A~%" clipboard-output)
-
- ;; Write clipboard contents into the FIFO file for the TTS server to
- ;; read.
- (put-string (cdr fifo-r+w)
- clipboard-output)
- ;; XXX: These ports are line buffered. Always write to ports with
- ;; a newline at their end if you want the other side to read them
- ;; now.
- (put-char (cdr fifo-r+w) #\newline)
-
- ;; XXX: We don't need to write to FIFO anymore. This will make sure
- ;; the message passes through. Please someone explain this to me.
- (close-port (cdr fifo-r+w))
-
- ;; Try to lock the lock file.
- (define lock-file-port (open-file-locked (config:option-ref options
- 'lock-file-path)))
-
- (when lock-file-port
- ;; If we have the lock, we're the speaker server.
-
- ;; If we receive a divine SIGTERM, kill our offsprings and commit
- ;; suicide. Truly, an Abrahamic horror story.
- (sigaction SIGTERM
- (lambda (received-signal)
+ (let ((options (config:getopt-config-auto args config)))
+
+ (when (config:option-ref options
+ 'kill)
+ (kill-server options))
+
+ ;; Make / open read and write fifo files.
+ (let-values (((fifo-r fifo-w)
+ (make-fifo-ports (config:option-ref options
+ 'fifo-file-path)))
+ ((clipboard-output)
+ (read-clipboard (config:option-ref options
+ 'clipboard-type))))
+
+ (format #t "Client sends: ~A~%" clipboard-output)
+
+ ;; Write clipboard contents into the FIFO file for the TTS server to
+ ;; read.
+ (put-string fifo-w
+ clipboard-output)
+ ;; XXX: These ports are line buffered. Always write to ports with
+ ;; a newline at their end if you want the other side to read them
+ ;; now.
+ (put-char fifo-w #\newline)
+
+ ;; XXX: We don't need to write to FIFO anymore. This will make sure
+ ;; the message passes through. Please someone explain this to me.
+ (close-port fifo-w)
+
+ ;; Try to lock the lock file.
+ (let ((lock-file-port
+ (open-file-locked (config:option-ref options
+ 'lock-file-path))))
+
+ (when lock-file-port
+ ;; If we have the lock, we're the speaker server.
+
+ ;; If we receive a divine SIGTERM, kill our offsprings and commit
+ ;; suicide. Truly, an Abrahamic horror story.
+ (sigaction SIGTERM
+ (lambda (received-signal)
;;; XXX: BUG: In Gnome, (kill 0 received-signal), which kills all
;;; processes in our group, results in killing the keybinding reading
;;; process that runs clipboard-speaker, hence *espeak-ng-pid*.
- (when (number? *espeak-ng-pid*)
- (kill *espeak-ng-pid* received-signal))
- (exit EXIT_SUCCESS)))
+ (when (number? *espeak-ng-pid*)
+ (kill *espeak-ng-pid* received-signal))
+ (exit EXIT_SUCCESS)))
- (espeak-loop (car fifo-r+w)
- (config:option-ref options 'words-per-minute)))
+ (espeak-loop fifo-r
+ (config:option-ref options 'words-per-minute)))
- (exit EXIT_SUCCESS))))
+ (exit EXIT_SUCCESS)))))))
