diff --git a/source/foreign-interface.lisp b/source/foreign-interface.lisp index e902cb97c25..ff8cf43b6a4 100644 --- a/source/foreign-interface.lisp +++ b/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. diff --git a/source/renderer-script.lisp b/source/renderer-script.lisp index 15efc57cd8c..81cafaca867 100644 --- a/source/renderer-script.lisp +++ b/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." diff --git a/source/renderer/gtk.lisp b/source/renderer/gtk.lisp index 2dedc6f8dba..9e596f85e05 100644 --- a/source/renderer/gtk.lisp +++ b/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. diff --git a/source/status.lisp b/source/status.lisp index 43b2ef2fea0..327e0f37fdb 100644 --- a/source/status.lisp +++ b/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" diff --git a/source/window.lisp b/source/window.lisp index bfb2e7b417b..bc4ed0c0b01 100644 --- a/source/window.lisp +++ b/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.")