commit 134cc7178f64c7d197bd8d7d5fe57e1dbf7457d3
parent db935f07e10b928cb415aa1d8a9f6a762b4b1fa5
Author: Yuval Langer <yuval.langer@gmail.com>
Date: Sat, 24 Jun 2023 13:20:59 +0300
Add some spacing / style and a few more comments.
Diffstat:
1 file changed, 44 insertions(+), 25 deletions(-)
diff --git a/clipboard-speaker.scm b/clipboard-speaker.scm
@@ -17,20 +17,24 @@
((config parser sexp) #:prefix config:parser:sexp:)
)
+
(define (dp x)
;; Debug print.
(display x) (newline))
+
(define (dp-id x)
;; Debug print, but it's just like the identity procedure.
(display x) (newline)
x)
+
(define (debug-notify-send x)
(spawn "notify-send" (list "notify-send"
"--expire-time=1000"
(format #f "~s~%" x))))
+
(define (get-pid-of-file-locking-process options)
(define lslocks-output-pipe (pipe))
(define lslocks-pid
@@ -63,6 +67,7 @@
result)
+
(define (open-file-locked filename)
(let ([file-port (open-file filename "w")])
(with-exception-handler
@@ -76,21 +81,27 @@
file-port)
#:unwind? #t)))
+
(define (get-home-directory)
(passwd:dir (getpw (getuid))))
+
(define DEFAULT-WORDS-PER-MINUTE 200)
+
(define DEFAULT-CLIPBOARD-SPEAKER-HOME-PATH ".config/clipboard-speaker/")
+
(define DEFAULT-LOCK-FILE-PATH
(string-append DEFAULT-CLIPBOARD-SPEAKER-HOME-PATH
"lock"))
+
(define DEFAULT-FIFO-FILE-PATH
(string-append DEFAULT-CLIPBOARD-SPEAKER-HOME-PATH
"fifo"))
+
(define config
(config:api:configuration
(name 'clipboard-speaker)
@@ -156,15 +167,18 @@
(directory
(config:api:in-home DEFAULT-CLIPBOARD-SPEAKER-HOME-PATH))))
+
(define (make-config-if-does-not-exist path value)
(if (file-exists? path)
#f
(let ([file-port (open-file path "w")])
(put-string file-port value))))
+
(define (mkfifo path mode)
(mknod path 'fifo mode 0))
+
(define (read-clipboard clipboard-type)
;; Popen `xsel -p` or `xsel -b` as an output port.
(unless (or (equal? clipboard-type "p")
@@ -196,6 +210,7 @@
xsel-output)
+
(define* (espeak-ng-speak text-to-speak words-per-minute)
(define espeak-ng-process-pid
(spawn "espeak-ng" `("espeak-ng"
@@ -228,6 +243,7 @@
(cons fifo-port-read fifo-port-write))
+
(define (espeak-loop fifo-read-port words-per-minute)
(define text-to-speak
(string-append (get-line fifo-read-port)
@@ -251,33 +267,30 @@
pipes)
+(define (kill-server options)
+ (cond
+ ((file-exists? (config:option-ref options
+ 'lock-file-path))
+ (let ([pid (get-pid-of-file-locking-process options)])
+ (cond
+ ((number? pid)
+ (kill pid SIGTERM)
+ (format #t "Killed ~s.~%" pid)
+ (exit EXIT_SUCCESS))
+ (else
+ (format #t "clipboard-speaker is not running.~%")
+ (exit EXIT_FAILURE)))))
+ (else
+ (format #t "No pid file: ~a~%" (config:option-ref options 'lock-file-path))
+ (exit EXIT_FAILURE))))
+
+
(define (main args)
(define options (config:getopt-config-auto args config))
- ;; XXX: I don't understand how one may retrieve these values.
- (define configuration-file-path (string-append
- (config:api:path-given
- (config:api:codex-metadatum 'directory
- options))
- "clipboard-speaker"))
-
(when (config:option-ref options
'kill)
- (cond
- ((file-exists? (config:option-ref options
- 'lock-file-path))
- (let ([pid (get-pid-of-file-locking-process options)])
- (cond
- ((number? pid)
- (kill pid SIGTERM)
- (format #t "Killed ~s.~%" pid)
- (exit EXIT_SUCCESS))
- (else
- (format #t "clipboard-speaker is not running.~%")
- (exit EXIT_FAILURE)))))
- (else
- (format #t "No pid file: ~a~%" (config:option-ref options 'lock-file-path))
- (exit EXIT_FAILURE))))
+ (kill-server options))
;; Make / open read and write fifo files.
(define fifo-r+w (make-fifo-ports (config:option-ref options
@@ -293,14 +306,20 @@
(put-string (cdr fifo-r+w)
clipboard-output)
+ (flush-all-ports)
+
+ ;; Try to lock the lock file.
(define lock-file-port (open-file-locked (config:option-ref options
'lock-file-path)))
(when lock-file-port
- ;; We're the speaker server.
+ ;; 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 (x)
- (kill 0 x) ;; Kill all processes in this group.
+ (lambda (received-signal)
+ (kill 0 received-signal) ;; Kill all processes in our group.
(exit EXIT_SUCCESS)))
(espeak-loop (car fifo-r+w)
