mirror of
https://gitlab.com/eql/EQL5.git
synced 2025-12-24 19:01:14 -08:00
120 lines
4.7 KiB
Common Lisp
120 lines
4.7 KiB
Common Lisp
;;; WebKit & WebEngine as plugin widgets in WebKit
|
|
;;;
|
|
;;; "Just For Fun"
|
|
|
|
(qrequire :webkit)
|
|
(qrequire :webengine)
|
|
|
|
(in-package :eql-user)
|
|
|
|
(defvar *web-view* (qnew "QWebView")) ; browser 1
|
|
(defvar *web-engine-view* (qnew "QWebEngineView")) ; browser 2
|
|
(defvar *main-view* (qnew "QWebView")) ; container
|
|
(defvar *webkit-bridge* (qload-c++ "lib/webkit_bridge"))
|
|
|
|
(defparameter *parallel-browsing* t)
|
|
(defparameter *parallel-scrolling* t)
|
|
(defparameter *scroll-position-1* 0)
|
|
(defparameter *scroll-position-2* 0)
|
|
(defparameter *scroll-max-1* nil)
|
|
(defparameter *scroll-max-2* nil)
|
|
(defparameter *scrollbar-to-sync* nil)
|
|
|
|
(defun frame ()
|
|
(|mainFrame| (|page| *main-view*)))
|
|
|
|
(defun js-webkit (expression view)
|
|
(qvariant-value (|evaluateJavaScript| (|mainFrame| (|page| view)) expression)))
|
|
|
|
(defun js-webengine (expression view &optional function)
|
|
(if function
|
|
(|runJavaScript| (|page| view) expression function)
|
|
(|runJavaScript| (|page| view) expression)))
|
|
|
|
(defun set-params (arg-names arg-values)
|
|
"Qt: void setParams(QStringList, QStringList)" ; for JS
|
|
(mapc (lambda (name value)
|
|
(cond ((string= "parallel-browsing" name)
|
|
(setf *parallel-browsing* (string= "true" value)))
|
|
((string= "parallel-scrolling" name)
|
|
(setf *parallel-scrolling* (string= "true" value)))))
|
|
arg-names arg-values))
|
|
|
|
(defun set-url (name)
|
|
"Qt: void setUrl(QString)" ; for JS
|
|
(setf *scroll-position-1* 0
|
|
*scroll-position-2* 0
|
|
*scroll-max-1* nil
|
|
*scroll-max-2* nil)
|
|
(js-webkit (format nil "document.getElementById('url').value = ~S" name)
|
|
*main-view*)
|
|
(qlet ((url (qnew "QUrl(QString)" name)))
|
|
(dolist (view (list *web-view* *web-engine-view*))
|
|
(unless (string= name (|toString| (|url| view)))
|
|
(|setUrl| view url)))))
|
|
|
|
(defun get-scroll-max (view)
|
|
(let ((exp "document.body.scrollHeight - window.innerHeight"))
|
|
(cond ((qeql *web-view* view)
|
|
(setf *scroll-max-1* (js-webkit exp *web-view*)))
|
|
((qeql *web-engine-view* view)
|
|
(js-webengine exp *web-engine-view*
|
|
(lambda (max) (setf *scroll-max-2* max)))))))
|
|
|
|
(defun sync-scrollbar (other)
|
|
(when *parallel-scrolling*
|
|
(qsingle-shot 500 (lambda () (setf *scrollbar-to-sync* nil))) ; prevent recursion loops
|
|
(unless *scrollbar-to-sync*
|
|
(setf *scrollbar-to-sync* other))
|
|
(when (eql other *scrollbar-to-sync*) ; see above
|
|
(get-scroll-max *web-view*)
|
|
(get-scroll-max *web-engine-view*) ; async
|
|
(let ((f (if (and *scroll-max-1* *scroll-max-2* (plusp *scroll-max-2*))
|
|
(/ *scroll-max-1* *scroll-max-2*)
|
|
1)))
|
|
(case other
|
|
(1 (js-webkit
|
|
(format nil "window.scrollTo(0, ~D)" (truncate (* *scroll-position-2* f)))
|
|
*web-view*))
|
|
(2 (js-webengine
|
|
(format nil "window.scrollTo(0, ~D)" (truncate (/ *scroll-position-1* f)))
|
|
*web-engine-view*)))))))
|
|
|
|
(defun ini-container ()
|
|
(let ((web-plugin (qnew "QWebPluginFactory(QObject*)" *main-view*))
|
|
(settings (|settings| *main-view*)))
|
|
(|setAttribute| settings |QWebSettings.PluginsEnabled| t)
|
|
(qoverride web-plugin "create(QString,QUrl,QStringList,QStringList)"
|
|
(lambda (mime-type url arg-names arg-values)
|
|
(cond ((string= "application/x-web-kit" mime-type)
|
|
(set-params arg-names arg-values)
|
|
*web-view*)
|
|
((string= "application/x-web-engine" mime-type)
|
|
(set-params arg-names arg-values)
|
|
*web-engine-view*))))
|
|
(|setPluginFactory| (|page| *main-view*) web-plugin))
|
|
(qconnect (frame) "javaScriptWindowObjectCleared()"
|
|
(lambda ()
|
|
(|addToJavaScriptWindowObject| (frame) "Lisp" *webkit-bridge*)))
|
|
(|setUrl| *main-view* (|fromUserInput.QUrl| (namestring (probe-file "web-kit-engine.htm"))))
|
|
(|showMaximized| *main-view*))
|
|
|
|
(defun ini-browsers ()
|
|
(dolist (view (list *web-view* *web-engine-view*))
|
|
(qconnect view "urlChanged(QUrl)"
|
|
(lambda (url)
|
|
(when *parallel-browsing*
|
|
(set-url (|toString| url))))))
|
|
(qconnect (|page| *web-view*) "scrollRequested(int,int,QRect)"
|
|
(lambda (x y rect)
|
|
(decf *scroll-position-1* y)
|
|
(sync-scrollbar 2)))
|
|
(qconnect (|page| *web-engine-view*) "scrollPositionChanged(QPointF)"
|
|
(lambda (pos)
|
|
(setf *scroll-position-2* (truncate (second pos)))
|
|
(sync-scrollbar 1))))
|
|
|
|
(progn
|
|
(ini-container)
|
|
(ini-browsers)
|
|
(set-url "http://planet.lisp.org/"))
|