Merge branch 'main' of https://git.dijkewijk.nl/hans/racket-webview

info.rkt

@@ -8,7 +8,7 @@
 
 (define scribblings
   '(
-    ("scrbl/racket-webview-collection.scrbl" (multi-page) (gui-library) "racket-webview")
+
     )
   )
 

js/boilerplate.js

@@ -50,7 +50,7 @@ window.rkt_event_info = function(e, id, evt) {
 
 window.rkt_bounds = new Map();
 
-window.rkt_get_evt_handler = function(event_kind, el_id, selector, win_nr)
+window.rkt_get_evt_handler = function(event_kind, el_id, selector, win_nr, no_prevent_default = false)
 {
    let handler_key = "h-" + event_kind + "-" + el_id + "-" + selector + "-" + win_nr;
    if (window.rkt_bounds.has(handler_key)) {
@@ -60,22 +60,26 @@ window.rkt_get_evt_handler = function(event_kind, el_id, selector, win_nr)
          handleEvent: function(e) {
               let obj = {evt: event_kind, id: el_id, selector: selector, window: win_nr,
 						 js_evt: window.rkt_event_info(event_kind, el_id, e) };
+              //console.log(e);
               window.rkt_put_evt(obj);
+              if (!no_prevent_default) {
+                 //console.log("preventing default");
                  e.preventDefault();
               }
+            }
          };
       window.rkt_bounds.set(handler_key, handler);
       return handler;
    }
-}
+};
 
 window.rkt_rm_evt_handler = function(event_kind, el_id, selector, win_nr)
 {
    let handler_key = "h-" + event_kind + "-" + el_id + "-" + selector + "-" + win_nr;
    window.rkt_bounds.delete(handler_key);
-}
+};
 
-window.rkt_bind_evt_ids = function(win_nr, selector, event_kinds) {
+window.rkt_bind_evt_ids = function(win_nr, selector, event_kinds, no_prevent_default = false) {
    try {
      let nodelist = document.querySelectorAll(selector);
      if (nodelist === undefined || nodelist === null) {
@@ -92,7 +96,7 @@ window.rkt_bind_evt_ids = function(win_nr, selector, event_kinds) {
             let i;
             for(i = 0; i < event_kinds.length; i++) {
                let event_kind = event_kinds[i];
-               el.addEventListener(event_kind, window.rkt_get_evt_handler(event_kind, el_id, selector, win_nr));
+               el.addEventListener(event_kind, window.rkt_get_evt_handler(event_kind, el_id, selector, win_nr, no_prevent_default));
             }
             let info = [ el_id, el_tag, el_type ];
             ids.push(info);
@@ -152,7 +156,7 @@ window.rkt_with_selector = function(selector, func) {
      let c = results.length;
      let r = { 'applied-to-elements': c, 'with-ids': results.filter((id) => id !== null) };
      return r;
-}
+};
 
 window.addEventListener('contextmenu', function (e) { e.preventDefault(); });
 

racket-webview-qt.rkt

@@ -746,7 +746,14 @@
 
 (define (rkt-webview-close handle)
   (rkt_webview_close (rkt-wv-win handle))
-  ;(enqueue! (rkt-wv-evt-queue handle) 'quit)
+  (let ((evt-cb (hash-ref evt-cb-hash (rkt-wv-win handle) (λ args #t))))
+    (let ((evt (format
+                (string-append "{ \"event\": \"closed\", "
+                               "  \"elaped\": -1.0, "
+                               "  \"evt-id\": -98832, "
+                               "  \"timestamp\":  ~a }")
+                (current-milliseconds))))
+      (evt-cb evt)))
   (set-rkt-wv-valid! handle #f)
   (hash-remove! evt-cb-hash (rkt-wv-win handle))
   (hash-remove! rkt-wv-store (rkt-wv-win handle))

racket-webview.rkt

@@ -705,8 +705,8 @@
     (rkt-webview-close (wv-win-handle wv))
     'oke))
 
-(define/contract (webview-bind! wv selector event)
+(define/contract (webview-bind! wv selector event no-prevent-default)
-  (-> wv-win? (or/c symbol? string?) (or/c symbol? list-of-symbol?) list?)
+  (-> wv-win? (or/c symbol? string?) (or/c symbol? list-of-symbol?) boolean? list?)
   (let* ((sel (if (symbol? selector)
                   (format "#~a" selector)
                   selector))
@@ -714,9 +714,11 @@
          (evt (format "[ ~a ]" (string-join
                                 (map (λ (e) (format "'~a'" e)) event*) ", ")))
          )
-    (let ((r (webview-call-js wv
+    (let* ((j (format "return window.rkt_bind_evt_ids(~a, '~a', ~a, ~a);"
-                              (format "return window.rkt_bind_evt_ids(~a, '~a', ~a)"
+                      (wv-win-window-nr wv) sel evt (if no-prevent-default 'true 'false)))
-                                      (wv-win-window-nr wv) sel evt))))
+           (r (webview-call-js wv j))
+           )
+      ;(dbg-webview "called js: ~a" j)
       (map (λ (el)
              (list (string->symbol (car el)) (cadr el) (caddr el)))
            r))))

scrbl/wv-tray.scrbl

@@ -0,0 +1,99 @@
+#lang scribble/manual
+
+@(require (for-label racket/base
+                     racket/class
+                     racket/contract
+                     "../wv-tray.rkt"
+                     "../menu.rkt"))
+
+@title{Tray Icons}
+
+@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
+
+@defmodule[(file "../wv-tray.rkt")]
+
+The @racketmodname[(file "../wv-tray.rkt")] module provides the
+@racket[wv-tray%] class. A tray object represents a native system tray
+icon backed by the webview runtime.
+
+@defclass[wv-tray% object% ()]{
+
+Creates a native tray icon.
+
+@bold{Initialization fields}
+
+@itemlist[#:style 'compact
+ @item{@racket[icon] — mandatory}
+ @item{@racket[tooltip] — default @racket[""]}
+ @item{@racket[menu] — default @racket[#f]}]
+
+If a menu is provided, it is installed during initialization.
+
+@bold{Events}
+
+These methods can be overridden.
+
+@defmethod[(activated [reason symbol?]) any/c]{
+Called when the tray icon is activated. The @racket[reason] is derived
+from the native event.
+}
+
+@defmethod[(message-clicked) any/c]{
+Called when a tray message is clicked.
+}
+
+@defmethod[(menu-item-chosen [id symbol?]) any/c]{
+Called when a menu item is chosen without a registered callback.
+}
+
+@defmethod[(unhandled-event [evt hash?]) any/c]{
+Called for unhandled native events.
+}
+
+@bold{Commands}
+
+@defmethod[(show) (is-a?/c wv-tray%)]{
+Shows the tray icon and returns the tray object.
+}
+
+@defmethod[(hide) (is-a?/c wv-tray%)]{
+Hides the tray icon and returns the tray object.
+}
+
+@defmethod[(close) (is-a?/c wv-tray%)]{
+Closes the tray icon and returns the tray object.
+}
+
+@defmethod[(set-icon! [icon-file path-string?]) (is-a?/c wv-tray%)]{
+Changes the tray icon and returns the tray object.
+}
+
+@defmethod[(set-tooltip! [text string?]) (is-a?/c wv-tray%)]{
+Changes the tooltip and returns the tray object.
+}
+
+@defmethod[(show-message [title string?]
+                         [message string?])
+           (is-a?/c wv-tray%)]{
+Shows a native tray message and returns the tray object.
+}
+
+@defmethod[(set-menu! [menu-def any/c]) (is-a?/c wv-tray%)]{
+Installs a tray menu and returns the tray object.
+}
+
+@defmethod[(connect-menu! [id symbol?]
+                          [callback procedure?])
+           (is-a?/c wv-tray%)]{
+Registers a callback for a menu item and returns the tray object.
+}
+
+@defmethod[(disconnect-menu! [id symbol?]) (is-a?/c wv-tray%)]{
+Removes a menu callback and returns the tray object.
+}
+
+@defmethod[(handle) any/c]{
+Returns the native tray handle.
+}
+
+}

scrbl/wv-window.scrbl

@@ -55,6 +55,7 @@ API.
                  [settings (send wv-context settings
                                  (string->symbol (format "~a" html-path)))]
                  [title string? "Racket Webview Window"]
+                 [icon (or/c path-string? #f) #f]
                  [width (or/c exact-integer? #f) #f]
                  [height (or/c exact-integer? #f) #f]
                  [x (or/c exact-integer? #f) #f]
@@ -78,7 +79,9 @@ After construction, the class:
  @item{creates the underlying webview window}
  @item{installs the internal event handler}
  @item{sets the title}
- @item{initializes position and size from settings or defaults}]
+ @item{Applies the icon during construction when it is not @racket[#f]}
+ @item{initializes position and size from settings or defaults}
+          ]
 
 If a parent is supplied, the underlying lower-level parent window is passed to
 @racket[webview-create].
@@ -148,13 +151,6 @@ Updates the internal size and stores the new dimensions in
 @racket[settings] under @racket['width] and @racket['height].
 }
 
-@defmethod[(window-state-changed [st symbol?]) any/c]{
-
-Called when the underlying window state changes.
-
-The default implementation returns @racket[#t].
-}
-
 @defmethod[(page-loaded [oke any/c]) any/c]{
 
 Called when a @racket['page-loaded] event is received.
@@ -223,6 +219,8 @@ window.
 Opens the developer tools and returns this window.
 }
 
+@bold{Window manipulation and information}
+
 @defmethod[(move [x exact-integer?] [y exact-integer?]) (is-a?/c wv-window%)]{
 
 Moves the window and returns this window.
@@ -238,6 +236,45 @@ Resizes the window and returns this window.
 Closes the window and returns this window.
 }
 
+@defmethod[(show) (is-a?/c wv-window%)]{Shows the window.}
+@defmethod[(present) (is-a?/c wv-window%)]{Presents the window.}
+@defmethod[(hide) (is-a?/c wv-window%)]{Hides the window.}
+@defmethod[(maximize) (is-a?/c wv-window%)]{Maximizes the window.}
+@defmethod[(minimize) (is-a?/c wv-window%)]{Minimizes the window.}
+@defmethod[(show-normal) (is-a?/c wv-window%)]{Restores normal state.}
+
+
+@defmethod[(window-state) symbol?]{
+  Returns the current native window state.
+ }
+
+@defmethod[(window-state-changed [st symbol?]) any/c]{
+  Called when the underlying window state changes.
+
+  Window states following calls to @racket{show}, @racket{present}, @racket{hide}, etc.:
+  @itemlist[#:style 'compact
+   @item{@racket{'normal}}
+   @item{@racket{'hidden}}
+   @item{@racket{'minimized}}
+   @item{@racket{'maximized}}
+   @item{@racket{'maximized-active} and}
+   @item{@racket{'normal-active}}
+            ]
+  are forwarded to @racket{window-state-changed}.
+ }
+
+@defmethod[(quit) (is-a?/c wv-window%)]{Quits the webview runtime.}
+
+
+@bold{Menu's and binding elements to events}
+
+@defmethod[(popup-menu! [menu-def is-wv-menu?]
+                        [x exact-integer?]
+                        [y exact-integer?])
+           any/c]{
+Shows @racket[menu-def] as a popup menu at @racket[x], @racket[y].
+}
+
 @defmethod[(bind! [selector (or/c symbol? string?)]
                   [events (or/c symbol? list?)]
                   [callback procedure?])
@@ -305,6 +342,20 @@ chosen.
 Sets the window title.
 }
 
+@defmethod[(set-icon! [icon-file path-string?]) any/c]{
+  Sets the window icon.
+ }
+
+
+@bold{Javascript methods}
+
+See also **Javascript syntax module**
+
+@defmethod[(run-js [js string?]) any/c]{ Runs JavaScript in the window. }
+@defmethod[(call-js [js string?]) any/c]{ Calls JavaScript in the window and returns the decoded result. }
+
+@bold{File dialog methods}
+
 @defmethod[(file-dialog-done [flag symbol?]
                              [file any/c]
                              [dir any/c]

wv-element.rkt

@@ -88,6 +88,40 @@
     (define/public (attr/datetime attr)
       (webview-attr/datetime wv element-id attr))
 
+    (define/public (draggable! yes-no . on-drag)
+      (webview-set-attr! wv element-id "draggable" yes-no)
+      (if (eq? yes-no #f)
+          (send window unbind! element-id 'ondragstart)
+          (if (null? on-drag)
+              (error "Need an on-drag handler (λ (el) ...)")
+              (send window bind! element-id 'ondragstart
+                    (λ (el evt data) ((car on-drag) el)))
+              )
+          )
+      )
+
+    (define/public (droppable! yes-no . on-drop)
+      (if (eq? yes-no #f)
+          (send window unbind! element-id 'ondrop)
+          (if (null? on-drop)
+              (error "Need an on-drop handler (λ (el) ...)")
+              (send window bind! element-id 'ondrop
+                    (λ (el evt data) ((car on-drop) el)))
+              )
+          )
+      )
+
+    (define/public (dragover! yes-no . on-dragover)
+      (if (eq? yes-no #f)
+          (send window unbind! element-id 'ondragover)
+          (if (null? on-dragover)
+              (error "Need an on-dragover handler (λ (el) ...)")
+              (send window bind! element-id 'ondragover
+                    (λ (el evt data) ((car on-dragover) el)))
+              )
+          )
+      )
+
     (define/public (focus!)
       (let ((s (js (let* ((el (send document getElementById (eval element-id))))
                      (if (=== el null)

wv-window.rkt

@@ -60,6 +60,7 @@
                 [height #f]
                 [x #f]
                 [y #f]
+                [quit-on-close #t]
                 )
 
     (define wv #f)
@@ -169,10 +170,37 @@
     ;; Events
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+    (define last-event-time (current-milliseconds))
+    (define last-event-kind #f)
+    (define last-js-event   #f)
+    
     (define (event-handler wv evt)
-      (let ((event (hash-ref evt 'event 'unknown-event))
+      (let* ((event (hash-ref evt 'event 'unknown-event))
+             (js-evt (if (eq? event 'js-evt)
+                         (let ((e (hash-ref (hash-ref evt 'js-evt) 'evt #f)))
+                           (if e
+                               (string->symbol e)
+                               #f))
+                         #f))
+             (cms (current-milliseconds))
              )
+
+        ;(dbg-webview "< ~a ~a = ~a && eq? ~a ~a = ~a && (eq? ~a ~a || eq? ~a ~a) = ~a"
+        ;             cms last-event-time (< cms last-event-time)
+        ;             last-event-kind event (eq? last-event-kind event)
+        ;             js-evt #f last-js-event js-evt (or (eq? js-evt #f) (eq? last-js-event js-evt))
+        ;             )
+        (unless (and
+                 (< cms last-event-time)
+                 (eq? last-event-kind event)
+                 (or (eq? js-evt #f)
+                     (eq? last-js-event js-evt)))
           (dbg-webview "event-handler - evt = ~a" evt)
+          (set! last-event-kind event)
+          (set! last-js-event js-evt)
+          (set! last-event-time (+ cms 500))
+          )
+        
         (cond
         ((eq? event 'resize)
          (send this resized (hash-ref evt 'w) (hash-ref evt 'h)))
@@ -250,6 +278,8 @@
       #t)
 
     (define/public (closed)
+      (when quit-on-close
+        (send this quit))
       #t)
 
     (define/public (js-event js-event)
@@ -341,6 +371,7 @@
       this)
 
     (define/public (quit)
+      (dbg-webview "Quit called")
       (webview-quit)
       this)
 
@@ -350,9 +381,12 @@
     (define/public (call-js js)
       (webview-call-js wv js))
 
-    (define/public (bind! selector events callback)
+    (define/public (bind! selector events callback . no-prevent-default)
-      (let ((items (webview-bind! wv selector events))
+      (let* ((npd   (if (null? no-prevent-default) #f (car no-prevent-default)))
-            (events* (if (symbol? events) (list events) events)))
+             (items (webview-bind! wv selector events npd))
+             (events* (if (symbol? events) (list events) events))
+             )
+        ;(dbg-webview "No-prevent-default = ~a" npd)
         (map (λ (item)
                     (let ((id (car item))
                           (type (string->symbol (string-downcase (caddr item))))
@@ -381,6 +415,9 @@
         )
       )
 
+    (define/public (set-attr! selector key-values)
+      (webview-set-attr! wv selector key-values))
+
     (define/public (set-title! title)
       (webview-set-title! wv title))