guile-clipboard-speaker

commit a87f916ab31c586b4daf9a27391892c2af93a819
parent 1bf4d18cf18f38678caef4fab9c9207c75ffe5a4
Author: Yuval Langer <yuval.langer@gmail.com>
Date:   Thu, 22 Jun 2023 15:55:29 +0300

The pid file is now a lock file. I now need to change the naming, I guess.

Diffstat:
M
clipboard-speaker.scm
 | 
94
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--------------------

1 file changed, 71 insertions(+), 23 deletions(-)
diff --git a/clipboard-speaker.scm b/clipboard-speaker.scm
@@ -4,14 +4,67 @@
 (define-module (clipboard-speaker)
   #:export (main))
 
-(use-modules (ice-9 popen)
+(use-modules (srfi srfi-26)
+             ((srfi srfi-180) #:prefix json:)
+
+             (ice-9 match)
+             (ice-9 popen)
              (ice-9 textual-ports)
-             (srfi srfi-26)
 
              ((config) #:prefix config:)
              ((config api) #:prefix config:api:)
              ((config licenses) #:prefix config:licenses:)
-             ((config parser sexp) #:prefix config:parser:sexp:))
+             ((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)
+  (waitpid (spawn "notify-send" (list "notify-send"
+                                      "--expire-time=1000"
+                                      (format #f "~a~%" 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 result
+    (match (filter (lambda (x)
+                     (equal? (cdadr x)
+                             (config:option-ref options 'pid-file-path)))
+                   ((compose
+                     vector->list
+                     cdar
+                     json:json-read)
+                    (car lslocks-output-pipe)))
+      (((('pid . pid) ('path . path)))
+       pid)
+      (()
+       #f)))
+
+  (waitpid lslocks-pid)
+
+  (close-port (car lslocks-output-pipe))
+
+  result)
 
 (define (open-file-locked filename)
   (let ([file-port (open-file filename "w+")])
@@ -62,7 +115,7 @@
               (or (string-ci=? x "b")
                   (string-ci=? x "s")
                   (string-ci=? x "p"))))
-      ;(handler identity)
+      ;;(handler identity)
       )
      (config:api:switch
       (name 'words-per-minute)
@@ -120,14 +173,14 @@
   (unless (or (equal? clipboard-type "p")
               (equal? clipboard-type "s")
               (equal? clipboard-type "b"))
-      (error "Bad clipboard type:" clipboard-type))
+    (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)))
+    (spawn "xsel"
+           (list "xsel"
+                 (string-append "-" clipboard-type))
+           #:output (cdr xsel-stdout-pipe)))
 
   (close-port (cdr xsel-stdout-pipe))
 
@@ -183,7 +236,7 @@
     (string-append (get-line fifo-read-port)
                    "\n"))
 
-  (display text-to-speak)
+  (dp text-to-speak)
 
   (define espeak-ng-pid (espeak-ng-speak text-to-speak
                                          words-per-minute))
@@ -205,7 +258,8 @@
 
 (define (main args)
   (define options (config:getopt-config-auto args config))
-  (display (config:full-command options)) (newline)
+  (dp (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
@@ -218,17 +272,11 @@
     (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)))))
+      (let ([pid (get-pid-of-file-locking-process options)])
+        (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))))
@@ -241,7 +289,7 @@
     (read-clipboard (config:option-ref options
                                        'clipboard-type)))
 
-  (display clipboard-output)
+  (format #t "Clipboard: ~a~%" clipboard-output)
 
   ;; Write lines into fifo write port and flush.
   (put-string (cdr fifo-r+w)