commit ff8b38e7594b1eefa541300c6de5eccda7037d9b
parent 572c303a5d4848aba791ddf2690d874cfe07f943
Author: Yuval Langer <yuval.langer@gmail.com>
Date: Sun, 18 Jun 2023 13:57:14 +0300
Add guile-config to the mess.
Diffstat:
| M | clipboard-speaker.scm | | | 219 | +++++++++++++++++++++++++++++++++++++++++++++++-------------------------------- |
1 file changed, 131 insertions(+), 88 deletions(-)
diff --git a/clipboard-speaker.scm b/clipboard-speaker.scm
@@ -1,64 +1,121 @@
+#!/usr/bin/env -S guile -e main -s
+!#
+
(use-modules (ice-9 match)
(ice-9 popen)
(ice-9 pretty-print)
(ice-9 textual-ports)
(ice-9 optargs)
+ (srfi srfi-1)
+ (srfi srfi-9)
+ (srfi srfi-9 gnu)
(srfi srfi-26)
(srfi srfi-42)
- (srfi srfi-64))
-
+ (srfi srfi-64)
+
+ ((config) #:prefix config:)
+ ((config api) #:prefix config:api:)
+ ((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
+ (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-syntax pathifier
- (syntax-rules ()
- ((_) "/")
- ((_ 'HOME) (get-home-directory))
- ((_ 'HOME path path* ...)
- (string-append (pathifier 'HOME)
- path
- (pathifier )))))
-
-(define (path-append . xs)
- (let f ([xs xs])
- (cond
- ((null? (cdr xs))
- (cond
- ((equal? (car xs) file-name-separator-string) "")
- (else (car xs))))
- (else (string-append (car xs)
- file-name-separator-string
- (f (cdr xs)))))))
+(display (get-home-directory)) (newline)
(define DEFAULT-WORDS-PER-MINUTE 200)
-(define DEFAULT-CLIPBOARD-SPEAKER-PATH
- (path-append (get-home-directory)
- ".clipboard-speaker"))
-(define DEFAULT-PID-FILE-PATH
- (path-append DEFAULT-CLIPBOARD-SPEAKER-PATH
- "pid"))
-(define DEFAULT-FIFO-FILE-PATH
- (path-append DEFAULT-CLIPBOARD-SPEAKER-PATH
- "fifo"))
-
-(define DEFAULT-WORDS-PER-MINUTE-PATH
- (path-append DEFAULT-CLIPBOARD-SPEAKER-PATH
- "words-per-minute"))
-
+(define DEFAULT-CLIPBOARD-SPEAKER-HOME-PATH ".config/clipboard-speaker/")
-(define (load-config cli-arguments)
- (list '(clipboard-type . "-b")
- '(fifo-file-path . "fifo-file")
- (cons 'words-per-minute DEFAULT-WORDS-PER-MINUTE)))
-
-
-(define (get-cli-arguments args)
- '())
+(define DEFAULT-PID-FILE-PATH
+ (string-append DEFAULT-CLIPBOARD-SPEAKER-HOME-PATH
+ "pid"))
+(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 '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 'pid-file-path)
+ (synopsis "Path to PID file.")
+ (default (string-append (get-home-directory)
+ "/"
+ DEFAULT-PID-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)
+ (display path) (newline)
(mknod path 'fifo mode 0))
@@ -68,7 +125,7 @@
(open-pipe* OPEN_READ
"xsel"
clipboard-type))
-
+
;; Read lines from xsel port and for each line replace the newlines in it
;; with spaces.
(define xsel-output
@@ -126,12 +183,12 @@
;; (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))
@@ -140,39 +197,42 @@
(define text-to-speak
(string-append (get-line fifo-read-port)
"\n"))
-
+
(display text-to-speak)
-
+
(espeak-ng-speak text-to-speak
words-per-minute)
-
+
(espeak-loop fifo-read-port
words-per-minute))
(define (make-pipes buffering-type)
(define pipes (pipe))
-
+
(setvbuf (car pipes) buffering-type)
(setvbuf (cdr pipes) buffering-type)
-
- pipes)
+ pipes)
-(define (main . args)
- ;; Commandline arguments.
- (define cli-arguments (get-cli-arguments args))
- ;; Make / load config.
- (define configuration (load-config cli-arguments))
+(define (main args)
+ (define options (config:getopt-config-auto args config))
+ (display (config:full-command options)) (newline)
+ ;; 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"))
;; Make / open read and write fifo files.
- (define fifo-r+w (make-fifo-ports (assq-ref configuration
- 'fifo-file-path)))
+ (define fifo-r+w (make-fifo-ports (config:option-ref options
+ 'fifo-file-path)))
(define clipboard-output
- (read-clipboard (assq-ref configuration
- 'clipboard-type)))
+ (read-clipboard (config:option-ref options
+ 'clipboard-type)))
(display clipboard-output)
@@ -180,31 +240,14 @@
(put-string (cdr fifo-r+w)
clipboard-output)
+ (define pid-file-port (open-file-locked (config:option-ref options
+ 'pid-file-path)))
+ (put-string pid-file-port (number->string (getpid)))
+ (force-output pid-file-port)
- (when (not (file-exists? "pid-file"))
- (call-with-output-file "pid-file"
- (lambda (port)
- (put-string port
- (number->string (getpid)))))
-
+ ;; We're the speaker server.
+ (when pid-file-port
(espeak-loop (car fifo-r+w)
- (assq-ref configuration 'words-per-minute)))
-
-
- (exit 0))
-
-
-(define (tests . args)
- (test-begin "path-append")
- (test-equal
- (string-append "a" file-name-separator-string "b" file-name-separator-string "c")
- (path-append "a" "b" "c"))
- (test-equal
- (string-append "a"
- file-name-separator-string
- "b"
- file-name-separator-string
- "c"
- file-name-separator-string)
- (path-append "a" "b" "c" "/"))
- (test-end "path-append"))
+ (config:option-ref options 'words-per-minute)))
+
+ (exit EXIT_SUCCESS))
