commit 1bf4d18cf18f38678caef4fab9c9207c75ffe5a4
parent 12fac8055d121f4e266423d7e01fa2261401d188
Author: Yuval Langer <yuval.langer@gmail.com>
Date: Wed, 21 Jun 2023 15:53:20 +0300
Add guard to the xsel running procedure, better logic for killing the looping process, and some hall stuff.
Diffstat:
3 files changed, 54 insertions(+), 61 deletions(-)
diff --git a/clipboard-speaker.scm b/clipboard-speaker.scm
@@ -1,4 +1,4 @@
-#!/usr/bin/env -S guile -e '(@ (clipboard-speaker) main)' -s
+#!/usr/bin/env -S guile -e '(clipboard-speaker)' -s
!#
(define-module (clipboard-speaker)
@@ -13,7 +13,6 @@
((config licenses) #:prefix config:licenses:)
((config parser sexp) #:prefix config:parser:sexp:))
-
(define (open-file-locked filename)
(let ([file-port (open-file filename "w+")])
(with-exception-handler
@@ -118,33 +117,34 @@
(define (read-clipboard clipboard-type)
;; Popen `xsel -p` or `xsel -b` as an output port.
- (define xsel-port
- (open-pipe* OPEN_READ
- "xsel"
- (string-append "-" clipboard-type)))
-
- ;; Read lines from xsel port and for each line replace the newlines in it
- ;; with spaces.
- (define xsel-output
- ((compose (cut string-append <> "\n")
- (cut string-join <> " ")
- (cut map string-trim-both <>)
- (cut string-split <> #\newline)
- get-string-all)
- xsel-port))
-
- (close-port xsel-port)
+ (unless (or (equal? clipboard-type "p")
+ (equal? clipboard-type "s")
+ (equal? clipboard-type "b"))
+ (error "Bad clipboard type:" clipboard-type))
- xsel-output)
+ (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-append <> "\n")
+ (cut string-join <> " ")
+ (cut map string-trim-both <>)
+ (cut string-split <> #\newline)
+ get-string-all)
+ (car xsel-stdout-pipe)))
-;; (define* (start-espeak-ng input-port #:key (words-per-minute DEFAULT-WORDS-PER-MINUTE))
-;; (spawn "espeak-ng"
-;; (list "espeak-ng"
-;; "--stdin"
-;; "-s"
-;; (number->string words-per-minute))
-;; #:input input-port))
+ (close-port (car xsel-stdout-pipe))
+
+ (waitpid xsel-pid)
+
+ xsel-output)
(define* (espeak-ng-speak text-to-speak words-per-minute)
(define espeak-ng-process-pid
@@ -178,20 +178,6 @@
(cons fifo-port-read fifo-port-write))
-
-;; (define (espeak-loop fifo-read-port pipe-write-port)
-;; (define text-to-speak
-;; (string-append (get-line fifo-read-port)
-;; "\n"))
-
-;; (display text-to-speak)
-
-;; (put-string pipe-write-port
-;; text-to-speak)
-
-;; (espeak-loop fifo-read-port
-;; pipe-write-port))
-
(define (espeak-loop fifo-read-port words-per-minute)
(define text-to-speak
(string-append (get-line fifo-read-port)
@@ -229,16 +215,23 @@
(when (config:option-ref options
'kill)
- (with-input-from-file (config:option-ref options
- 'pid-file-path)
- (lambda ()
- (let ([pid ((compose string->number
- string-trim
- get-string-all)
- (current-input-port))])
- (format #t "Kill ~a\n" pid)
- (kill pid SIGHUP)
- (exit EXIT_SUCCESS)))))
+ (cond
+ ((file-exists? (config:option-ref options
+ 'pid-file-path))
+ (with-input-from-file (config:option-ref options
+ 'pid-file-path)
+ (lambda ()
+ (let ([pid ((compose string->number
+ string-trim
+ get-string-all)
+ (current-input-port))])
+ (delete-file (config:option-ref options 'pid-file-path))
+ (format #t "Kill ~a\n" pid)
+ (kill pid SIGHUP)
+ (exit EXIT_SUCCESS)))))
+ (else
+ (format #t "No pid file: ~a~%" (config:option-ref options 'pid-file-path))
+ (exit EXIT_FAILURE))))
;; Make / open read and write fifo files.
(define fifo-r+w (make-fifo-ports (config:option-ref options
diff --git a/guix.scm b/guix.scm
@@ -26,5 +26,5 @@
(synopsis "")
(description "")
(home-page "")
- (license license:gpl3+))
+ (license license:agpl3+))
diff --git a/hall.scm b/hall.scm
@@ -11,19 +11,19 @@
(dependencies `())
(skip ())
(files (libraries
- ((scheme-file "clipboard-speaker")
- (directory "clipboard-speaker" ())))
+ ((directory "clipboard-speaker" ())
+ (scheme-file "clipboard-speaker")))
(tests ((directory "tests" ())))
(programs ((directory "scripts" ())))
(documentation
- ((org-file "README")
- (symlink "README" "README.org")
- (text-file "HACKING")
- (text-file "COPYING")
- (directory
+ ((directory
"doc"
- ((texi-file "clipboard-speaker")))))
+ ((texi-file "clipboard-speaker")))
+ (symlink "COPYING" "LICENSE")
+ (symlink "HACKING" "HACKING.org")
+ (symlink "README" "README.org")
+ (org-file "README")))
(infrastructure
- ((scheme-file "guix")
+ ((scheme-file "hall")
(text-file ".gitignore")
- (scheme-file "hall")))))
+ (scheme-file "guix")))))
