Working on.

Signed-off-by: Hans Dijkema <hans@dijkewijk.nl>

private/web-racket.rkt

@@ -193,19 +193,15 @@
       (super-new)
 
       (begin
-        (displayln (format "win-id: ~a, id: ~a" (send this get-win-id) (send this get-id)))
         (inp-set! val (ww-get-value (send this get-win-id)
                                     (send this get-id)))
-        (displayln (format "got value '~a'" val))
         (send this connect 'input (λ (data)
                                     (ww-debug data)
                                     (let ((js-evt (hash-ref data 'js-evt #f)))
                                       (unless (eq? js-evt #f)
                                         (when (hash-has-key? js-evt 'value)
                                           (inp-set! val (hash-ref js-evt 'value)))))))
-        (displayln "connected")
         (send (send this win) bind 'input (format "#~a" (send this get-id)))
-        (displayln "bind of input?")
         )
       ))
 
@@ -392,7 +388,6 @@
         (ww-debug (format "call to bind ~a ~a ~a" event selector forced-cl))
         (let ((infos (ww-bind win-id event selector)))
           (for-each (λ (info)
-                      (displayln (format "info = ~a" info))
                       (let* ((id (car info))
                              (tag (cadr info))
                              (type (caddr info)))
@@ -548,18 +543,11 @@
 
       (define/public (choose-dir caption base-dir)
         (let ((r (ww-choose-dir win-id caption base-dir)))
-          (if (eq? (car r) #f)
+          (ww-debug (format "choose-dir: ~a" r))
+          (if (eq? r 'cmd-nok)
               #f
-              (let ((m (regexp-match re-choose-dir (cdr r))))
+              r)))
-                (if (eq? m #f)
+            
-                    #f
-                    (let ((dir (caddr m)))
-                      (ww-from-string dir))
-                    )
-                )
-              )
-          )
-        )
 
       ; Supers first
       (super-new)

private/web-wire.rkt

@@ -9,7 +9,7 @@
            "../utils/utils.rkt"
            "css.rkt"
            "menu.rkt"
-           ;"webui-wire-ffi.rkt"
+           "webui-wire-ffi.rkt"
            "webui-wire-ipc.rkt"
            "webui-wire-download.rkt"
            )
@@ -21,6 +21,8 @@
            ww-debug
            ww-error
            ww-display-log
+           ww-tail-log
+           ww-set-log-lines!
 
            ww-cmd
            ww-cmd-nok?
@@ -113,21 +115,21 @@
   ;; web-wire handling (interaction with the library)
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-  (define _ww-debug #f)
+  (define _ww-debug #t)
   
   (define (ww-set-debug yn) (set! _ww-debug yn))
 
   (define (do-debug str . var)
     (when _ww-debug
       (if (null? var)
-          (displayln (format "Debug: ~a" str))
+          (process-log 'WW-DEBUG (format "~a" str))
-          (displayln (format "Debug: ~a: ~a" (car var) str))
+          (process-log 'WW-DEBUG (format "~a: ~a" (car var) str))
           )))
 
   (define (err str . var)
     (if (null? var)
-        (displayln (format "Error: ~a" str))
+        (process-log 'WW-ERROR (format "~a" str))
-        (displayln (format "Error: ~a: ~a" var str))
+        (process-log 'WW-ERROR (format "~a: ~a" var str))
         ))
 
   (define-syntax debug
@@ -155,7 +157,6 @@
       ))
   
   (define re-kind #px"([A-Z]+)[(]([0-9]+)[)][:]")
-  ;(define re-event #px"([^:]+)[:]([0-9]+)([:](.*))?")
   (define re-js-event #px"^([^:]+)([:](.*))?")
   (define re-js-result #px"([0-9]+)[:]([^:]+)[:](.*)")
   (define re-js-handle #px"([^:]+)[:]([0-9]+)[:]([0-9]+)([:](.*))?")
@@ -171,6 +172,7 @@
      [event-thread #:mutable]
      [stop-thread #:mutable]
      [reader-thread #:mutable]
+     [type #:mutable]
      )
     )
 
@@ -179,18 +181,27 @@
   (define evt-sem  (make-semaphore))
   (define evt-fifo (make-queue))
   (define log-fifo (make-queue))
-  (define log-fifo-max 100)
+  (define log-fifo-max 2500)
+
+  (define (ww-set-log-lines! n)
+    (set! log-fifo-max (if (< n 10) 10
+                          (if (> n 10000) 10000 n)))
+    (ensure-fifo)
+    )
 
   (define re-event #px"^([^:]+)([:]([^:]+))?")
 
-
+  (define (event-queuer-ipc evt)
-  (define (event-queuer evt)
     (enqueue! evt-fifo evt)
     (semaphore-post evt-sem))
   
-  (define (process-event h evt*)
+  (define (event-queuer-ffi  evt)
-    (let* ((evt evt*) ;(bytes->string/utf-8 evt*))
+    (let ((evt* (bytes->string/utf-8 evt)))
-           (m (regexp-match re-event evt)))
+      (enqueue! evt-fifo evt*)
+      (semaphore-post evt-sem)))
+
+  (define (process-event h evt)
+    (let* ((m (regexp-match re-event evt)))
       (ww-debug evt)
       (let* ((e (string->symbol (string-downcase (list-ref m 1))))
              (win-id (if (eq? (list-ref m 3) #f) #f (string->number (list-ref m 3))))
@@ -203,7 +214,6 @@
         (if (eq? evt-handler #f)
             (ww-error (format "no event handler to handle event ~a" evt))
             (queue-callback (lambda () (evt-handler e payload))))
-;            (evt-handler e payload))
         )
       )
     )
@@ -220,48 +230,136 @@
            (f))))))
   
 
-  (define (process-log kind* msg*)
   (define (ensure-fifo)
     (if (> (queue-length log-fifo) log-fifo-max)
         (begin
           (dequeue! log-fifo)
           (ensure-fifo))
         (queue-length log-fifo)))
-    (let ((kind kind*) ;(bytes->string/utf-8 kind*))
+
-          (msg msg*)) ;(bytes->string/utf-8 msg*)))
+  (define tail-handler #f)
+
+  (define (put-in-fifo kind msg)
     (enqueue! log-fifo (cons kind msg))
+    (when tail-handler
+      (tail-handler kind msg))
+    )
+
+  (define (process-log-ipc kind msg)
+    (put-in-fifo kind msg)
+    (ensure-fifo))
+
+  (define process-log process-log-ipc)
+  
+  (define (process-log-ffi kind* msg*)
+    (let ((kind (bytes->string/utf-8 kind*))
+          (msg (bytes->string/utf-8 msg*)))
+      (put-in-fifo kind msg)
       (ensure-fifo)))
 
-  (define (ww-display-log)
+  (define (ww-do-display item filter)
+    (let ((displ #f))
+      (when (eq? filter #f)
+        (set! displ #t))
+      (when (symbol? filter)
+        (set! displ (eq? (car item) filter)))
+      (when (regexp? filter)
+        (when (or (regexp-match filter (cdr item))
+                  (regexp-match filter (symbol->string (car item))))
+          (set! displ #t)))
+      (when displ
+        (displayln (format "~a - ~a" (car item) (cdr item)))))
+    )
+
+  (define (ww-display-log . filter*)
+    (let ((filter (if (null? filter*) #f (car filter*))))
+      (when (string? filter)
+        (set! filter (pregexp (string-append "(?i:" filter ")"))))
+      (when (list? filter)
+        (set! filter (pregexp (string-append "(?i:(" (string-join filter "|") "))"))))
       (for-each (λ (item)
-                   (displayln (format "~a - ~a" (car item) (cdr item))))
+                  (ww-do-display item filter))
                 (queue->list log-fifo)))
+    )
 
+  (define (ww-tail-log . args)
+    (let ((last-n 3)
+          (filter #f)
+          (stop-tail #f)
+          )
+      (let ((f (λ ()
+                 (let ((arg (if (null? args) #f (car args))))
+                   (unless (null? args)
+                     (when (boolean? arg)
+                       (when (eq? arg #f)
+                         (set! stop-tail #t)))
+                     (when (number? arg)
+                       (set! last-n (if (< arg 0) 0 arg)))
+                     (when (or (symbol? arg) (regexp? arg) (string? arg) (list? arg))
+                       (set! filter arg)))
+                   (set! args (if (null? args) '() (cdr args)))))))
+        (f)(f))
+      (ww-debug (format "tail log: ~a ~a ~a" last-n filter stop-tail))
+      (if stop-tail
+          (set! tail-handler #f)
+          (let* ((l (queue->list log-fifo))
+                 (len (length l)))
+            (let ((nl (take-right l (if (<= last-n len) last-n len))))
+              (when (string? filter)
+                (set! filter (pregexp (string-append "(?i:" filter ")"))))
+              (when (list? filter)
+                (set! filter (pregexp (string-append "(?i:(" (string-join filter "|") "))"))))
+              (for-each (λ (item)
+                          (ww-do-display item filter))
+                        nl))
+            (set! tail-handler (λ (kind msg)
+                                 (ww-do-display (cons kind msg) filter))))
+          )
+      )
+    )
 
-  (define (ww-start . args)
+  (define (ww-start* type args)
     (when (eq? ww-current-handle #f)
-      (let* ((h (make-web-rkt (webui-ipc event-queuer process-log)
+      (let ((h (make-web-rkt (if (eq? type 'ipc)
+                                 (webui-ipc event-queuer-ipc process-log-ipc)
+                                 (let ((existing-h (webwire-current)))
+                                   (if (eq? existing-h #f)
+                                       (webwire-new)
+                                       existing-h)))
                              #f
                              #f
-                              #f))
+                             #f
-             (thrd (event-handler h)))
+                             type)))
+        (when (eq? type 'ffi)
+          (unless (eq? (webwire-status (web-rkt-handle h)) 'valid)
+            (error (format "Invalid handle, cannot start webui-wire ffi, reason: ~a"
+                           (webwire-status->string (webwire-status (web-rkt-handle h)))))))
+        (let ((thrd (event-handler h)))
+          (when (eq? type 'ffi)
+            (webwire-handlers! (web-rkt-handle h) event-queuer-ffi process-log-ffi))
           (set-web-rkt-event-thread! h thrd)
-        (set! ww-current-handle h)))
+          (set! ww-current-handle h))
+        ))
     (unless (null? args)
       (ww-log-level (car args)))
     ww-current-handle)
 
+  (define (ww-start . args)
+    (ww-start* 'ipc args))
+
   (define (ww-stop)
     (unless (eq? ww-current-handle #f)
-      (let ((thr (web-rkt-event-thread ww-current-handle)))
-        (kill-thread thr))
       ;; inform event handlers of destroying of windows.
       (let ((keys (hash-keys windows-evt-handlers)))
         (for-each (λ (win-id)
                     (let ((handler (hash-ref windows-evt-handlers win-id)))
                       (handler 'destroyed #f)))
                   keys))
-      ((web-rkt-handle ww-current-handle) "exit")
+      (ww-cmd "exit")
+      (let ((thr (web-rkt-event-thread ww-current-handle)))
+        (kill-thread thr))
+      (when (eq? (web-rkt-type ww-current-handle) 'ffi)
+        (webwire-destroy (web-rkt-handle ww-current-handle)))
       (set! ww-current-handle #f)))
 
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -328,7 +426,11 @@
         (begin
           (ww-stop)
           #t)
-        (let ((result ((web-rkt-handle ww-current-handle) cmd)))
+        (let* ((type (web-rkt-type ww-current-handle))
+               (result (if (eq? type 'ipc)
+                           ((web-rkt-handle ww-current-handle) cmd)
+                           (webwire-command (web-rkt-handle ww-current-handle) cmd)))
+               )
           (let ((r (convert-result result)))
             (check-nok cmd r)
             r))))
@@ -877,26 +979,49 @@
     -> symbol)
     
   ;; Files and directories
-  (define (ww-file-open win-id title dir file-filters)
+  ;(define (ww-file-open win-id title dir file-filters)
-    (let ((cmd (format "file-open ~a ~a ~a ~a" win-id
+  ;  (let ((cmd (format "file-open ~a ~a ~a ~a" win-id
-                       (as-string title)
+  ;                     (as-string title)
-                       (as-string dir)
+  ;                     (as-string dir)
-                       (as-string file-filters))))
+  ;                     (as-string file-filters))))
-      (ww-cmd cmd)))
+  ;    (ww-cmd cmd)))
 
-  (define (ww-file-save win-id title dir file-filters overwrite)
+  (def-cmd ww-file-open
-    (let ((cmd (format "file-save ~a ~a ~a ~a ~a" win-id
+    file-open ((win-id ww-win?)
-                       (as-string title)
+               (caption string?)
-                       (as-string dir)
+               (dir string?)
-                       (as-string file-filters)
+               (file-filters string?)) ()
-                       (if overwrite 1 0))))
+    -> string)
-      (ww-cmd cmd)))
 
-  (define (ww-choose-dir win-id title dir)
+  (def-cmd ww-file-save
-    (let ((cmd (format "choose-dir ~a ~a ~a" win-id
+    file-save ((win-id ww-win?)
-                       (as-string title)
+               (caption string?)
-                       (as-string dir))))
+               (dir string?)
-      (ww-cmd cmd)))
+               (file-filters string?)
+               (overwrite boolean?)
+               ) ()
+    -> string)
+    
+  ;(define (ww-file-save win-id title dir file-filters overwrite)
+  ;  (let ((cmd (format "file-save ~a ~a ~a ~a ~a" win-id
+  ;                     (as-string title)
+  ;                     (as-string dir)
+  ;                     (as-string file-filters)
+  ;                     (if overwrite 1 0))))
+  ;    (ww-cmd cmd)))
+
+  (def-cmd ww-choose-dir
+    choose-dir ((win-id ww-win?)
+                (caption string?)
+                (dir string?)
+                ) ()
+    -> string)
+
+  ;(define (ww-choose-dir win-id title dir)
+  ;  (let ((cmd (format "choose-dir ~a ~a ~a" win-id
+  ;                     (as-string title)
+  ;                     (as-string dir))))
+  ;    (ww-cmd cmd)))
   
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;; Finalizing stuff

private/webui-wire-download.rkt

@@ -14,9 +14,11 @@
            ww-webui-wire
            )
 
+  ;(define (current-release os)
 
   (define (ww-webui-wire)
-    "/home/hans/src/racket/webui-wire/build/Debug/webui-wire"
+    (list "/home/hans/src/racket/webui-wire/build/Release/webui-wire")
+    ;(list "/usr/bin/flatpak" "run" "nl.dijkewijk.webui-wire")
     )
 
   (define ww-current-win-release "https://github.com/hdijkema/web-wire/releases/download/0.1/web-wire-0.1-win64.zip")

private/webui-wire-ffi.rkt

@@ -73,21 +73,26 @@
                (will-register webwire-will
                             handle (λ (handle)
                                      (webwire-destroy handle))))
+             (start-gui-processing)
              handle))
   #:c-id webwire_new)
 
+
 (define-libwebui-wire webwire-current
   (_fun -> (handle : _webui-handle/null)
         -> (begin
              (unless (eq? handle #f)
                (will-register webwire-will
                             handle (λ (handle)
-                                     (webwire-destroy handle))))
+                                     (webwire-destroy handle)))
+               (start-gui-processing)
+               )
              handle))
   #:c-id webwire_current)
 
 (define-libwebui-wire webwire-destroy
-  (_fun _webui-handle/null -> _void)
+  (_fun _webui-handle/null -> _void
+        -> (stop-gui-processing))
   #:c-id webwire_destroy)
 
 (define-libwebui-wire webwire-command
@@ -149,7 +154,7 @@
   #:c-id webwire_status_string)
 
 (define-libwebui-wire webwire-process-gui
-  (_fun _webui-handle/null -> _void)
+  (_fun _webui-handle/null -> _bool)
   #:c-id webwire_process_gui)
 
 
@@ -263,13 +268,32 @@
 
 
 ; Make sure GUI Events are processed (e.g. for linux - gtk main loop)
-(void (thread (λ ()
+
-                (let loop ()
+(define gui-processing-thread #f)
+(define gui-processing-go-on #f)
+  
+(define (start-gui-processing)
+  (when (eq? gui-processing-thread #f)
+    (set! gui-processing-go-on #t)
+    (set! gui-processing-thread (thread (λ ()
                                           (begin
+                                            (displayln "gui processing starts")
+                                            (letrec ((loop (λ ()
                                                              (sleep 0.05)
-                    (webwire-process-gui #f)
+                                                             (let ((processed (webwire-process-gui #f)))
-                    ;(displayln 'process-gui-ok)
+                                                               (when (or gui-processing-go-on processed)
-                    (loop)))
+                                                                 (loop))))))
-                )
+                                              (loop))
+                                            (displayln "gui processing stops")
+                                            (set! gui-processing-thread #f)))))
     )
   )
+
+(define (stop-gui-processing)
+  (void (thread (λ ()
+                  (display "waiting 5 seconds")
+                  (sleep 5)
+                  (displayln "stopping gui processing")
+                  (set! gui-processing-go-on #f)))))
+
+  

private/webui-wire-ipc.rkt

@@ -1,11 +1,19 @@
 (module webui-wire-ipc racket/base
 
-  (require "webui-wire-download.rkt")
+  (require "webui-wire-download.rkt"
+           racket/string
+           )
   
   (provide webui-ipc)
 
   (define re-kind #px"^([^:]+)[:]")
 
+  (define (is-int? str)
+    (let ((re-num #px"^[0-9]+$"))
+      (if (regexp-match re-num str)
+          #t
+          #f)))
+
   (define (read-eol port)
     (read-string 1 port))
   
@@ -19,10 +27,8 @@
                                          (log-processor 'stderr-reader "webui-wire executable exited")
                                          'process-ended)
                                        (begin
-                                         (unless (and
+                                         (if (and (string? colon) (string=? colon ":") (is-int? str-length))
-                                                  (string? colon)
+                                             ; process line
-                                                  (string=? colon ":"))
-                                           (error "Unexpected input from webui-wire standard error"))
                                              (let* ((length (string->number str-length))
                                                     (input (read-string length process-stderr))
                                                     (m (regexp-match re-kind input))
@@ -38,6 +44,11 @@
                                                          (event-queuer line)
                                                          (log-processor kind line))))
                                                )
+                                             ; otherwise skip line
+                                             (let* ((line (read-line process-stderr))
+                                                    (msg (string-trim (string-append str-length colon line))))
+                                               (log-processor 'stderr-reader msg))
+                                             )
                                          (reader)
                                          )
                                        ))
@@ -48,12 +59,12 @@
     )
 
   (define (webui-ipc event-queuer log-processor)
-    (let ((webui-wire-exe (ww-webui-wire)))
+    (let* ((webui-wire-exe (ww-webui-wire))
-      (displayln webui-wire-exe)
+           (proc-args (append (list #f #f #f) webui-wire-exe))
+           )
       (call-with-values
-       (λ () (subprocess #f #f #f webui-wire-exe))
+       (λ () (apply subprocess proc-args))
        (λ (pid process-stdout process-stdin process-stderr)
-         ;(displayln (format "~a ~a ~a ~a" pid process-stdout process-stdin process-stderr))
          (let ((reader-thrd (process-stderr-reader process-stderr event-queuer log-processor)))
            (λ (cmd)
              (displayln cmd process-stdin)