commit 9a6a9e13aba798872e10399d04b516516fee0413
parent 8b493f674c1f42c480c582d10cd50bdae0926555
Author: Yuval Langer <yuval.langer@gmail.com>
Date: Sat, 30 Dec 2023 22:54:36 +0200
Define (clipboard-speaker) as a R7RS library. Remove the main call from the end of the script.
Diffstat:
| M | clipboard-speaker.scm | | | 674 | +++++++++++++++++++++++++++++++++++++++++-------------------------------------- |
1 file changed, 347 insertions(+), 327 deletions(-)
diff --git a/clipboard-speaker.scm b/clipboard-speaker.scm
@@ -1,344 +1,364 @@
-#!/usr/bin/env guile
+#!/usr/bin/env -S guile --r7rs -e (clipboard-speaker) -s
!#
-(use-modules (srfi srfi-26)
- ((srfi srfi-180) #:prefix json:)
-
- (ice-9 match)
- (ice-9 popen)
- (ice-9 textual-ports)
-
- ((config) #:prefix config:)
- ((config api) #:prefix config:api:)
- ((config licenses) #:prefix config:licenses:)
- ((config parser sexp) #:prefix config:parser:sexp:)
- )
-
-
-(define espeak-ng-pid #f)
-
-
-(define (dp x)
- ;; Debug print.
- (display x) (newline))
-
+(define-library (clipboard-speaker)
+ (import
+ (scheme base)
+ (scheme process-context)
+ (scheme write)
+
+ (only (guile)
+ EXIT_FAILURE
+ EXIT_SUCCESS
+ F_GETFL
+ F_SETFL
+ LOCK_EX
+ LOCK_NB
+ O_NONBLOCK
+ SIGTERM
+ cdadr
+ compose
+ fcntl
+ file-exists?
+ filter
+ flock
+ force-output
+ format
+ getpw
+ getuid
+ kill
+ logior
+ mknod
+ open-file
+ passwd:dir
+ pipe
+ setvbuf
+ sigaction
+ spawn
+ string-ci=?
+ string-join
+ string-split
+ string-trim-both
+ waitpid
+ )
+ (srfi srfi-26)
+ (prefix (srfi srfi-180) json:)
+
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 textual-ports)
+
+ (prefix (config) config:)
+ (prefix (config api) config:api:)
+ (prefix (config licenses) config:licenses:)
+ (prefix (config parser sexp) config:parser:sexp:))
+ (export main)
+
+ (begin
+ (define *espeak-ng-pid* #f)
+
+ (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
+ (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)
+
+ (define (open-file-locked filename)
+ (let ([file-port (open-file filename "w")])
+ (with-exception-handler
+ (lambda (an-exception)
+ (close-port file-port)
+ #f)
+ (lambda ()
+ (flock file-port
+ (logior LOCK_EX
+ LOCK_NB))
+ 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)
+ (synopsis "Speak clipboard contents.")
+ (author "Yuval Langer")
+ (copyright '(2023))
+ (license config:licenses:agpl3+)
+ (version "0.1")
+ (parser config:parser:sexp:sexp-parser)
+ (keywords
+ (list
+ (config:api:switch
+ (name 'clipboard-type)
+ (synopsis "Type of clipboard (b, s, or p)")
+ (character #f)
+ (example "b/s/p (choose b or s or p)")
+ (default "b")
+ (test (lambda (x)
+ (or (string-ci=? x "b")
+ (string-ci=? x "s")
+ (string-ci=? x "p"))))
+ ;;(handler identity)
+ )
+ (config:api:switch
+ (name 'words-per-minute)
+ (synopsis "Words per minute spoken.")
+ (character #f)
+ (example "170")
+ (default 200)
+ (test integer?)
+ (handler string->number))
+ (config:api:switch
+ (name 'kill)
+ (synopsis "Kill the espeak-ng loop process.")
+ (default #f)
+ (test boolean?)
+ (character #f))
+ (config:api:switch
+ (name 'clipboard-speaker-path)
+ (synopsis "Path to the clipboard-speaker settings directory.")
+ (default DEFAULT-CLIPBOARD-SPEAKER-HOME-PATH)
+ (character #f)
+ )
+ (config:api:setting
+ (name 'words-per-minute)
+ (synopsis "Words per minute spoken.")
+ (default 200)
+ (handler string->number)
+ (test number?)
+ (example "230"))
+ (config:api:setting
+ (name 'fifo-file-path)
+ (synopsis "Path to FIFO file.")
+ (default (string-append (get-home-directory)
+ "/"
+ DEFAULT-FIFO-FILE-PATH)))
+ (config:api:setting
+ (name 'lock-file-path)
+ (synopsis "Path to lock file.")
+ (default (string-append (get-home-directory)
+ "/"
+ DEFAULT-LOCK-FILE-PATH)))))
+ (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")
+ (equal? clipboard-type "s")
+ (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)
+
+ (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)])
+ (fcntl fifo-port-read
+ F_SETFL
+ (logior O_NONBLOCK
+ flags)))
+
+ (cons fifo-port-read fifo-port-write))
+
+ (define (espeak-loop fifo-read-port words-per-minute)
+ (define espeak-ng-input-pipe (pipe))
+
+ (set! *espeak-ng-pid*
+ (spawn "espeak-ng"
+ (list "espeak-ng"
+ "-s"
+ (number->string words-per-minute))
+ #:input (car espeak-ng-input-pipe)))
+
+ (let loop ((text-to-speak (get-line fifo-read-port)))
+ (format #t "Server received: ~A\n" text-to-speak)
+
+ (put-string (cdr espeak-ng-input-pipe)
+ text-to-speak)
+ ;; 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 espeak-ng-input-pipe)
+ #\newline)
+
+ ;; XXX: You also have you flush the port, otherwise the TTS keeps
+ ;; silent. Please someone explain this to me.
+ (force-output (cdr espeak-ng-input-pipe))
+
+ (loop (get-line fifo-read-port))))
+
+ (define (make-pipes buffering-type)
+ (define pipes (pipe))
+
+ (setvbuf (car pipes) buffering-type)
+ (setvbuf (cdr pipes) buffering-type)
+
+ 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: ~S~%" (config:option-ref options 'lock-file-path))
+ (exit EXIT_FAILURE))))
-(define (dp-id x)
- ;; Debug print, but it's just like the identity procedure.
- (display x) (newline)
- x)
+ (define (main args)
+ (define options (config:getopt-config-auto args config))
-(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
- (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)
-
-
-(define (open-file-locked filename)
- (let ([file-port (open-file filename "w")])
- (with-exception-handler
- (lambda (an-exception)
- (close-port file-port)
- #f)
- (lambda ()
- (flock file-port
- (logior LOCK_EX
- LOCK_NB))
- 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)
- (synopsis "Speak clipboard contents.")
- (author "Yuval Langer")
- (copyright '(2023))
- (license config:licenses:agpl3+)
- (version "0.1")
- (parser config:parser:sexp:sexp-parser)
- (keywords
- (list
- (config:api:switch
- (name 'clipboard-type)
- (synopsis "Type of clipboard (b, s, or p)")
- (character #f)
- (example "b/s/p (choose b or s or p)")
- (default "b")
- (test (lambda (x)
- (or (string-ci=? x "b")
- (string-ci=? x "s")
- (string-ci=? x "p"))))
- ;;(handler identity)
- )
- (config:api:switch
- (name 'words-per-minute)
- (synopsis "Words per minute spoken.")
- (character #f)
- (example "170")
- (default 200)
- (test integer?)
- (handler string->number))
- (config:api:switch
- (name 'kill)
- (synopsis "Kill the espeak-ng loop process.")
- (default #f)
- (test boolean?)
- (character #f))
- (config:api:switch
- (name 'clipboard-speaker-path)
- (synopsis "Path to the clipboard-speaker settings directory.")
- (default DEFAULT-CLIPBOARD-SPEAKER-HOME-PATH)
- (character #f)
- )
- (config:api:setting
- (name 'words-per-minute)
- (synopsis "Words per minute spoken.")
- (default 200)
- (handler string->number)
- (test number?)
- (example "230"))
- (config:api:setting
- (name 'fifo-file-path)
- (synopsis "Path to FIFO file.")
- (default (string-append (get-home-directory)
- "/"
- DEFAULT-FIFO-FILE-PATH)))
- (config:api:setting
- (name 'lock-file-path)
- (synopsis "Path to lock file.")
- (default (string-append (get-home-directory)
- "/"
- DEFAULT-LOCK-FILE-PATH)))))
- (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")
- (equal? clipboard-type "s")
- (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)
-
-(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)])
- (fcntl fifo-port-read
- F_SETFL
- (logior O_NONBLOCK
- flags)))
-
- (cons fifo-port-read fifo-port-write))
-
-
-(define (espeak-loop fifo-read-port words-per-minute)
- (define espeak-ng-input-pipe (pipe))
-
- (set! espeak-ng-pid
- (spawn "espeak-ng"
- (list "espeak-ng"
- "-s"
- (number->string words-per-minute))
- #:input (car espeak-ng-input-pipe)))
-
- (let loop ((text-to-speak (get-line fifo-read-port)))
- (format #t "Server received: ~A\n" text-to-speak)
-
- (put-string (cdr espeak-ng-input-pipe)
- text-to-speak)
- ;; 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 espeak-ng-input-pipe)
- #\newline)
+ (when (config:option-ref options
+ 'kill)
+ (kill-server options))
- ;; XXX: You also have you flush the port, otherwise the TTS keeps
- ;; silent. Please someone explain this to me.
- (force-output (cdr espeak-ng-input-pipe))
+ ;; Make / open read and write fifo files.
+ (define fifo-r+w (make-fifo-ports (config:option-ref options
+ 'fifo-file-path)))
- (loop (get-line fifo-read-port))))
+ (define clipboard-output
+ (read-clipboard (config:option-ref options
+ 'clipboard-type)))
+ (format #t "Client sends: ~A~%" clipboard-output)
-(define (make-pipes buffering-type)
- (define pipes (pipe))
+ ;; 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)
- (setvbuf (car pipes) buffering-type)
- (setvbuf (cdr pipes) buffering-type)
+ ;; 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))
- pipes)
+ ;; 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.
-(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: ~S~%" (config:option-ref options 'lock-file-path))
- (exit EXIT_FAILURE))))
-
-
-(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)
+ ;; 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)))
-
- (espeak-loop (car fifo-r+w)
- (config:option-ref options 'words-per-minute)))
-
- (exit EXIT_SUCCESS))
+;;; process that runs clipboard-speaker, hence *espeak-ng-pid*.
+ (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)))
-(main (command-line))
+ (exit EXIT_SUCCESS))))
