Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

DRAFT: Callback API #66

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open

DRAFT: Callback API #66

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
b262cdd
Pass lambda instead of body in with-g-async-ready-callback and export.
Ambrevar May 20, 2022
179d723
Use with-g-async-ready-callback in webkit-web-view-evaluate-javascript.
Ambrevar May 20, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
26 changes: 23 additions & 3 deletions webkit2/callback.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,13 +17,33 @@
`(cffi:defcallback ,name :void ((source-object :pointer)
(result g-async-result)
(user-data :pointer))
,@body))
,@body))

(defmacro with-g-async-ready-callback ((var &body callback-body) &body body)
(export 'with-g-async-ready-callback)
(defmacro with-g-async-ready-callback ((var callback) &body body)
"Example:

\(let ((result-channel (make-instance 'calispel:channel)))
(bt:make-thread
(gtk:within-gtk-thread
(let* ((context (webkit:webkit-web-view-web-context view))
(cookie-manager (webkit:webkit-web-context-get-cookie-manager context)))
(webkit:with-g-async-ready-callback (callback (lambda (source result user-data)
(declare (ignore source user-data))
(calispel:! result-channel
(webkit:webkit-cookie-manager-get-accept-policy-finish
cookie-manager
result))))
(webkit:webkit-cookie-manager-get-accept-policy
cookie-manager
(cffi:null-pointer)
callback
(cffi:null-pointer))))))
(calispel:? result-channel))"
(let ((g (gensym "CALLBACK")))
`(progn
(define-g-async-ready-callback ,g
,@callback-body)
(funcall ,callback source-object result user-data))
(let ((,var (callback ,g)))
,@body)
(fmakunbound ',g))))
70 changes: 30 additions & 40 deletions webkit2/webkit2.web-view.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -233,30 +233,6 @@
(function nil :type (or function null))
(error-function nil :type (or function null)))

(cffi:defcallback javascript-evaluation-complete
:void ((source-object :pointer) (result :pointer) (user-data :pointer))
(declare (ignore source-object))
(let ((callback (find (cffi:pointer-address user-data) callbacks :key (function callback-id))))
(handler-case
(let* ((js-result (webkit-web-view-run-javascript-finish (callback-web-view callback) result))
(value (webkit-javascript-result-get-js-value js-result))
(exception (jsc-context-get-exception (jsc-value-get-context value))))
(when exception
(signal 'jsc-exception-condition :exception exception))
(setf callbacks (delete callback callbacks))
(when (callback-function callback)
(funcall (callback-function callback) (jsc-value-to-lisp value) value))
(webkit-javascript-result-unref js-result))
(condition (c)
(when callback
(when (callback-error-function callback)
;; We don't ignore errors when running the callback: this way the
;; caller can run code that can (possibly intentionally) raise a
;; condition. It's up to the caller to make the error callback
;; condition-less or not.
(funcall (callback-error-function callback) c))
(setf callbacks (delete callback callbacks)))))))

(declaim (ftype (function (webkit-web-view string &optional
(or null (function (t t)))
(or null (function (condition))) string))
Expand All @@ -268,22 +244,36 @@ CALL-BACK is called over two arguments:
- The Lisp transformation of the result.
- The untransformed result (a JSCValue).
ERROR-CALL-BACK is called with the signaled condition."
(incf callback-counter)
(push (make-callback :id callback-counter :web-view web-view
:function call-back
:error-function error-call-back)
callbacks)
(if world
(webkit-web-view-run-javascript-in-world
web-view javascript world
(cffi:null-pointer)
(cffi:callback javascript-evaluation-complete)
(cffi:make-pointer callback-counter))
(webkit-web-view-run-javascript
web-view javascript
(cffi:null-pointer)
(cffi:callback javascript-evaluation-complete)
(cffi:make-pointer callback-counter))))
(with-g-async-ready-callback
(callback-wrapper
(lambda (source-object result user-data)
(declare (ignore source-object user-data))
(handler-case
(let* ((js-result (webkit-web-view-run-javascript-finish web-view result))
(value (webkit-javascript-result-get-js-value js-result))
(exception (jsc-context-get-exception (jsc-value-get-context value))))
(when exception
(signal 'jsc-exception-condition :exception exception))
(when call-back
(funcall call-back (jsc-value-to-lisp value) value))
(webkit-javascript-result-unref js-result))
(condition (c)
(when call-back
(when error-call-back
;; We don't ignore errors when running the callback: this way the
;; caller can run code that can (possibly intentionally) raise a
;; condition. It's up to the caller to make the error callback
;; condition-less or not.
(funcall error-call-back c)))))))
(if world
(webkit-web-view-run-javascript-in-world web-view javascript world
(cffi:null-pointer)
callback-wrapper
(cffi:null-pointer))
(webkit-web-view-run-javascript web-view javascript
(cffi:null-pointer)
callback-wrapper
(cffi:null-pointer)))))
(export 'webkit-web-view-evaluate-javascript)

(defcfun ("webkit_web_view_run_javascript_finish" %webkit-web-view-run-javascript-finish) webkit-javascript-result
Expand Down