Merge remote-tracking branch 'gh/refactor-ffi-print-status'

source/foreign-interface.lisp

@@ -254,11 +254,19 @@ When done, call `call-next-method' to finalize the startup."
 (define-ffi-generic ffi-inspector-show (buffer)
   "Show the renderer built-in inspector.")
 
-(define-ffi-generic ffi-print-status (window text)
-  "Display TEXT in the WINDOW status buffer.")
-
+(define-ffi-generic ffi-print-status (window html-body)
+  "Display status buffer in WINDOW according to HTML-BODY.
+The `style' of the status buffer is honored."
+  (with-slots (status-buffer) window
+    (html-write (spinneret:with-html-string
+                  (:head (:nstyle (style status-buffer)))
+                  (:body (:raw html-body)))
+                status-buffer)))
+
+;; The strategy taken in `ffi-print-status' can't be replicated since the
+;; message buffer isn't a buffer.
 (define-ffi-generic ffi-print-message (window message)
-  "Print MESSAGE (an HTML string) in the WINDOW message buffer.")
+  "Print MESSAGE in the WINDOW's message buffer.")
 
 (define-ffi-generic ffi-display-url (browser url)
   "Return URL as a human-readable string.

source/renderer-script.lisp

@@ -171,10 +171,14 @@ If `setf'-d to a list of two values -- set Y to `first' and X to `second' elemen
          (setf (ps:chain style-element inner-text) (ps:lisp style)))
        (:catch (error))))))
 
-(defun html-write (content &optional (buffer (current-buffer)))
-  "Write CONTENT into BUFFER page."
-  (ps-eval :async t :buffer buffer
-    (ps:chain document (write (ps:lisp content)))))
+(defun html-write (html-document &optional (buffer (current-buffer)))
+  "Set BUFFER's document to HTML-DOCUMENT.
+Overwrites the whole HTML document (head and body elements included)."
+  ;; Don't use document.write().
+  ;; See https://developer.mozilla.org/en-US/docs/Web/API/Document/write.
+  (ps-eval :buffer buffer
+    (setf (ps:chain document (get-elements-by-tag-name "html") 0 |innerHTML|)
+          (ps:lisp html-document))))
 
 (defun html-set (content &optional (buffer (current-buffer)))
   "Set BUFFER contents to CONTENT."

source/renderer/gtk.lisp

@@ -2071,28 +2071,13 @@ custom (the specified proxy) and none."
   (webkit:webkit-web-inspector-show
    (webkit:webkit-web-view-get-inspector (gtk-object buffer))))
 
-(define-ffi-method ffi-print-status ((window gtk-window) text)
-  (let ((text (spinneret:with-html-string
-               (:head
-                (:nstyle (style (status-buffer window))))
-               (:body
-                (:raw text)))))
-    (with-slots (status-buffer) window
-      (webkit2:webkit-web-view-evaluate-javascript
-       (gtk-object (status-buffer window))
-       (ps:ps (setf (ps:@ document body |innerHTML|)
-                    (ps:lisp text)))))))
-
-(define-ffi-method ffi-print-message ((window gtk-window) text)
-  (let ((text (spinneret:with-html-string
-               (:head
-                (:nstyle (message-buffer-style window)))
-               (:body
-                (:raw (spinneret::escape-string text))))))
-    (webkit2:webkit-web-view-evaluate-javascript
-     (message-view window)
-     (ps:ps (setf (ps:@ document body |innerHTML|)
-                  (ps:lisp text))))))
+(define-ffi-method ffi-print-message ((window gtk-window) message)
+  (webkit2:webkit-web-view-evaluate-javascript
+   (message-view window)
+   (ps:ps (setf (ps:chain document (get-elements-by-tag-name "html") 0 |innerHTML|)
+                (ps:lisp (spinneret:with-html-string
+                           (:head (:nstyle (message-buffer-style window)))
+                           (:body (:raw message))))))))
 
 ;; This method does not need a renderer, so no need to use `define-ffi-method'
 ;; which is prone to race conditions.

source/status.lisp

@@ -191,11 +191,11 @@ Augment this with `style' of STATUS, if necessary."
 
 (export-always 'format-status)
 (define-generic format-status ((status status-buffer))
-  "Render all of the STATUS.
+  "Return a string corresponding to the body of the HTML document of STATUS.
 
-This is the best point to override the structure of the STATUS, because all the
-other functions (like `format-status-url', `format-status-modes') are used here
-and can all be overriden with one method redefinition."
+To override all that is displayed on STATUS, redefine this method.  To partially
+override it, redefine methods such as `format-status-url' or
+`format-status-modes'."
   (let* ((buffer (current-buffer (window status))))
     (spinneret:with-html-string
       (:div :id "container"

source/window.lisp

@@ -161,10 +161,9 @@ The handlers take the window as argument."))
   (setf (slot-value window 'active-buffer) buffer))
 
 (defun print-status (&optional (window (current-window)))
-  (when (and window (status-buffer window))
-    (ffi-print-status
-     window
-     (format-status (status-buffer window)))))
+  (with-slots (status-buffer) window
+    (when (and window status-buffer)
+      (ffi-print-status window (format-status status-buffer)))))
 
 (hooks:define-hook-type window (function (window))
   "Hook acting on `window's.")