├── .envrc ├── examples ├── test-extension │ ├── content.js │ └── manifest.json ├── dejavu-sans-mono.ttf ├── package.lisp ├── example-window.lisp ├── example-adblock.lisp ├── example-download.lisp ├── example-extension.lisp ├── example-web-preferences.lisp ├── example-context-menu.lisp ├── example-protocol.lisp ├── example-asset.lisp └── example-views.lisp ├── makefile ├── source ├── package.lisp ├── adblock.lisp ├── protocol.lisp ├── server.js ├── view.lisp ├── session.lisp ├── window.lisp ├── web-contents.lisp └── core.lisp ├── README.org ├── .gitignore ├── package.json ├── LICENSE ├── cl-electron.asd └── tests └── tests.lisp /.envrc: -------------------------------------------------------------------------------- 1 | use nix 2 | layout node 3 | -------------------------------------------------------------------------------- /examples/test-extension/content.js: -------------------------------------------------------------------------------- 1 | document.body.style.backgroundColor = "red"; 2 | -------------------------------------------------------------------------------- /examples/dejavu-sans-mono.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/atlas-engineer/cl-electron/HEAD/examples/dejavu-sans-mono.ttf -------------------------------------------------------------------------------- /makefile: -------------------------------------------------------------------------------- 1 | NPM = npm 2 | DESTDIR = node_modules 3 | 4 | install: package.json 5 | $(NPM) install 6 | 7 | .PHONY: all 8 | all: install 9 | 10 | clean: 11 | rm -r $(DESTDIR) 12 | -------------------------------------------------------------------------------- /examples/package.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package :electron/examples 2 | (:nicknames :cl-electron/examples) 3 | (:import-from :nclasses :define-class) 4 | (:import-from :alexandria :assoc-value)) 5 | 6 | (setf electron:*interface* (make-instance 'electron:interface)) 7 | -------------------------------------------------------------------------------- /examples/test-extension/manifest.json: -------------------------------------------------------------------------------- 1 | { 2 | "manifest_version": 2, 3 | "name": "Red Background Extension", 4 | "version": "1.0", 5 | "description": "Changes background color of all pages to red", 6 | "permissions": ["scripting"], 7 | "content_scripts": [ 8 | { 9 | "matches": [""], 10 | "js": ["content.js"], 11 | "run_at": "document_idle" 12 | } 13 | ] 14 | } 15 | -------------------------------------------------------------------------------- /source/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | (uiop:define-package #:electron 5 | (:nicknames :cl-electron) 6 | (:use :cl) 7 | (:import-from :nclasses :define-class) 8 | (:import-from :alexandria :assoc-value)) 9 | 10 | (in-package :electron) 11 | (defmacro export-always (symbols &optional (package nil package-supplied?)) 12 | "Like `export', but also evaluated at compile time." 13 | `(eval-when (:compile-toplevel :load-toplevel :execute) 14 | (export ,symbols ,@(and package-supplied? (list package))))) 15 | -------------------------------------------------------------------------------- /examples/example-window.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | (in-package :electron/examples) 5 | 6 | (defun electron-window-example () 7 | (electron:launch) 8 | (let ((win (make-instance 'electron:window))) 9 | (electron:load-url win "https://en.wikipedia.org/wiki/Electron") 10 | ;; Allow typing any character except "e". 11 | (electron:add-listener win :before-input-event 12 | (lambda (win input) (declare (ignore win)) 13 | (print input) 14 | (if (string-equal "e" (assoc-value input :key)) t nil))) 15 | win)) 16 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+TITLE: cl-electron - Electron binding for Common Lisp 2 | 3 | * Installation 4 | =cl-electron= depends on Node.js, a Common Lisp implementation (SBCL) and 5 | some CL libraries (consult [[file:cl-electron.asd][cl-electron.asd file]]). 6 | 7 | Run =npm install= from the project's root to install all Node.js dependencies 8 | (including Electron). To update the dependencies, run =npm update=. 9 | 10 | * Examples 11 | See [[file:examples/][examples]] folder. 12 | 13 | * Copying 14 | cl-electron is distributed under the BSD license. 15 | 16 | Please note that this license only covers the binding itself. Refer to 17 | the distribution terms of the third-party dependencies for details. 18 | -------------------------------------------------------------------------------- /examples/example-adblock.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | (in-package :electron/examples) 5 | 6 | (define-class main-view (electron:view) 7 | ((url nil))) 8 | 9 | (defmethod initialize-instance :after ((main-view main-view) &key window) 10 | (electron:add-bounded-view window 11 | main-view 12 | :window-bounds-alist-var bounds 13 | :x 0 14 | :y 0 15 | :width (assoc-value bounds :width) 16 | :height (assoc-value bounds :height)) 17 | (electron:load-url main-view "https://www.google.com")) 18 | 19 | (defun electron-adblock-example () 20 | (electron:launch) 21 | (let* ((win (make-instance 'electron:window)) 22 | (adblocker (make-instance 'electron:adblocker-electron))) 23 | (make-instance 'main-view :window win) 24 | (electron:default-block adblocker))) 25 | -------------------------------------------------------------------------------- /examples/example-download.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | (in-package :electron/examples) 5 | 6 | (defun electron-download-example () 7 | (electron:launch) 8 | (let* ((win (make-instance 'electron:window)) 9 | (session (electron:session (electron:web-contents win)))) 10 | (electron:load-url win "https://github.com/atlas-engineer/nyxt/releases/") 11 | (electron:add-listener session :download-item-updated 12 | (lambda (session item) 13 | (declare (ignore session)) 14 | (unless (equal (electron:total-bytes item) 0) 15 | (format t "~,1,2f%~%" (/ (electron:received-bytes item) 16 | (electron:total-bytes item)))) 17 | (sleep 1))) 18 | ;; Call `electron:cancel' over an element of the hash table below to abort. 19 | (electron:download-items session))) 20 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.core 2 | *.fas 3 | *.fasl 4 | *.lib 5 | *.lis 6 | 7 | # Logs 8 | logs 9 | *.log 10 | npm-debug.log* 11 | yarn-debug.log* 12 | yarn-error.log* 13 | lerna-debug.log* 14 | .pnpm-debug.log* 15 | 16 | # Diagnostic reports (https://nodejs.org/api/report.html) 17 | report.[0-9]*.[0-9]*.[0-9]*.[0-9]*.json 18 | 19 | # Runtime data 20 | pids 21 | *.pid 22 | *.seed 23 | *.pid.lock 24 | 25 | # Compiled binary addons (https://nodejs.org/api/addons.html) 26 | build/Release 27 | 28 | # Dependency directories 29 | node_modules/ 30 | jspm_packages/ 31 | 32 | # Optional npm cache directory 33 | .npm 34 | 35 | # Optional eslint cache 36 | .eslintcache 37 | 38 | # Optional stylelint cache 39 | .stylelintcache 40 | 41 | # Microbundle cache 42 | .rpt2_cache/ 43 | .rts2_cache_cjs/ 44 | .rts2_cache_es/ 45 | .rts2_cache_umd/ 46 | 47 | # Optional REPL history 48 | .node_repl_history 49 | 50 | # Output of 'npm pack' 51 | *.tgz 52 | 53 | # dotenv environment variable files 54 | .env 55 | .env.development.local 56 | .env.test.local 57 | .env.production.local 58 | .env.local 59 | 60 | .direnv 61 | 62 | # Ignore build output directory of Node.js FFI. 63 | build 64 | dist -------------------------------------------------------------------------------- /examples/example-extension.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | (in-package :electron/examples) 5 | 6 | (define-class main-view (electron:view) 7 | ((url nil))) 8 | 9 | (defmethod initialize-instance :after ((main-view main-view) &key window) 10 | (electron:add-bounded-view window 11 | main-view 12 | :window-bounds-alist-var bounds 13 | :x 0 14 | :y 0 15 | :width (assoc-value bounds :width) 16 | :height (assoc-value bounds :height)) 17 | (electron:load-url main-view "https://www.google.com")) 18 | 19 | (defun electron-extension-example () 20 | (electron:launch) 21 | (let* ((win (make-instance 'electron:window)) 22 | (view (make-instance 'main-view :window win)) 23 | (session (electron:session (electron:web-contents view)))) 24 | (electron:load-extension session "/home/jmercouris/Source/Lisp/cl-electron/examples/test-extension/") 25 | (print (electron:get-all-extensions session)) 26 | session)) 27 | -------------------------------------------------------------------------------- /source/adblock.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | ;;;; Built-in Ghostery ad-blocking support. 5 | 6 | (in-package :electron) 7 | 8 | (define-class adblocker-electron (remote-object) 9 | ((reference-name 10 | "ElectronBlocker" 11 | :documentation 12 | "The name to use when importing the Library into the Global 13 | namespace.")) 14 | (:export-class-name-p t) 15 | (:export-predicate-name-p t) 16 | (:export-accessor-names-p t) 17 | (:documentation "Interface with an Electron instance.")) 18 | 19 | (defmethod initialize-instance :after ((adblocker adblocker-electron) &key) 20 | (message 21 | adblocker 22 | (format nil "const fetch = require('cross-fetch'); 23 | global.~a = require('@ghostery/adblocker-electron').ElectronBlocker;" 24 | (reference-name adblocker)))) 25 | 26 | (export-always 'default-block) 27 | (defmethod default-block ((adblocker adblocker-electron)) 28 | (message 29 | adblocker 30 | (format 31 | nil 32 | "global.~a.fromPrebuiltAdsAndTracking(fetch).then((blocker) => { 33 | blocker.enableBlockingInSession(session.defaultSession); 34 | });" (reference-name adblocker)))) 35 | -------------------------------------------------------------------------------- /examples/example-web-preferences.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | (in-package :electron/examples) 5 | 6 | (define-class example-view (electron:view) 7 | ((url nil))) 8 | 9 | (defmethod initialize-instance :after ((main-view example-view) &key window) 10 | (electron:add-bounded-view window 11 | main-view 12 | :window-bounds-alist-var bounds 13 | :x 0 14 | :y 0 15 | :width (assoc-value bounds :width) 16 | :height (- (assoc-value bounds :height) 30)) 17 | (electron:load-url main-view "https://en.wikipedia.org/wiki/Electron") 18 | (print (electron:execute-javascript-synchronous (electron:web-contents main-view) 19 | "1 + 1"))) 20 | 21 | (defun electron-web-preferences-example () 22 | (electron:launch) 23 | ;; Note: WebPreferences can only be set during object creation! 24 | (let ((win (make-instance 'electron:window))) 25 | (make-instance 'example-view :window win :options "{webPreferences: {images: false}}") 26 | win)) 27 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "cl-electron-server", 3 | "version": "0.0.1", 4 | "description": "Electron server for cl-electron.", 5 | "main": "source/server.js", 6 | "author": "Atlas Engineer", 7 | "license": "BSD", 8 | "build": { 9 | "artifactName": "${productName}.${ext}" 10 | }, 11 | "bugs": { 12 | "url": "https://github.com/atlas-engineer/cl-electron/issues" 13 | }, 14 | "homepage": "https://github.com/atlas-engineer/cl-electron/", 15 | "scripts": { 16 | "postinstall": "sed 's/^#include .nan_scriptorigin\\.h./\\/\\/ #include nan_scriptorigin.h/' ./node_modules/nan/nan.h > ./node_modules/nan/nan.h.new && mv ./node_modules/nan/nan.h.new ./node_modules/nan/nan.h && electron-builder install-app-deps", 17 | "start": "electron", 18 | "debug": "electron --inspect", 19 | "repl": "electron -i", 20 | "build": "electron-builder" 21 | }, 22 | "devDependencies": { 23 | "electron": "^36.4.0", 24 | "electron-builder": "^25.1.8" 25 | }, 26 | "dependencies": { 27 | "@ghostery/adblocker-electron": "^2.6.1", 28 | "cross-fetch": "^4.1.0", 29 | "synchronous-socket": "^0.0.1" 30 | } 31 | } 32 | -------------------------------------------------------------------------------- /examples/example-context-menu.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | (in-package :electron/examples) 5 | 6 | (define-class main-view (electron:view) 7 | ((url nil))) 8 | 9 | (defmethod initialize-instance :after ((main-view main-view) &key window) 10 | (electron:add-bounded-view window 11 | main-view 12 | :window-bounds-alist-var bounds 13 | :x 0 14 | :y 0 15 | :width (assoc-value bounds :width) 16 | :height (assoc-value bounds :height)) 17 | (electron:load-url main-view "https://www.example.com")) 18 | 19 | (defun electron-context-menu-example () 20 | (electron:launch) 21 | (let* ((win (make-instance 'electron:window)) 22 | (view (make-instance 'main-view :window win))) 23 | (electron:add-listener view :context-menu 24 | (lambda (object params) 25 | (declare (ignore object)) 26 | (print params) 27 | "[{label: 'Custom Action', 28 | click: () => { 29 | console.log('Custom action clicked');}}, 30 | {type: 'separator'},]")))) 31 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright (c) 2023-2025, Atlas Engineer LLC. 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | * Neither the name of the copyright holder nor the names of its 17 | contributors may be used to endorse or promote products derived from 18 | this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 21 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 22 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 24 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 26 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 27 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 28 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 29 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /examples/example-protocol.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | (in-package :electron/examples) 5 | 6 | (defun electron-protocol-example () 7 | (setf (electron:protocols electron:*interface*) 8 | (list (make-instance 'electron:protocol 9 | :scheme-name "test" 10 | :privileges "{}"))) 11 | (electron:launch electron:*interface*) 12 | (electron:handle (find "test" (electron:protocols electron:*interface*) 13 | :key #'electron:scheme-name :test #'string-equal) 14 | "() => {return new Response('Hello test scheme.')}") 15 | (let ((win (make-instance 'electron:window)) 16 | (view1 (make-instance 'electron:view)) 17 | (view2 (make-instance 'electron:view))) 18 | (electron:add-view win view1) 19 | (electron:add-view win view2) 20 | (electron:set-bounds view1 :x 0 :y 0 :width 400 :height 200) 21 | (electron:set-bounds view2 :x 0 :y 200 :width 400 :height 200) 22 | (electron:load-url view1 "test:dummy-var") 23 | (electron:load-url view2 "test:dummy-var"))) 24 | 25 | (defun electron-protocol-example-callback () 26 | (setf (electron:protocols electron:*interface*) 27 | (list (make-instance 'electron:protocol 28 | :scheme-name "test" 29 | :privileges "{}"))) 30 | (electron:launch electron:*interface*) 31 | (electron:handle-callback (find "test" (electron:protocols electron:*interface*) 32 | :key #'electron:scheme-name :test #'string-equal) 33 | (lambda (xyz) (print xyz) "Text with UTF-8 ✈ encoding.")) 34 | (let ((win (make-instance 'electron:window)) 35 | (view1 (make-instance 'electron:view)) 36 | (view2 (make-instance 'electron:view))) 37 | (electron:add-view win view1) 38 | (electron:add-view win view2) 39 | (electron:set-bounds view1 :x 0 :y 0 :width 400 :height 200) 40 | (electron:set-bounds view2 :x 0 :y 200 :width 400 :height 200) 41 | (electron:load-url view1 "test:dummy-var") 42 | (electron:load-url view2 "test:dummy-var"))) 43 | -------------------------------------------------------------------------------- /examples/example-asset.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | (in-package :electron/examples) 5 | 6 | (defun electron-asset-example () 7 | (setf (electron:protocols electron:*interface*) 8 | (list (make-instance 'electron:protocol 9 | :scheme-name "test" 10 | :privileges "{}") 11 | (make-instance 'electron:protocol 12 | :scheme-name "font" 13 | :privileges "{secure:true}"))) 14 | (electron:launch electron:*interface*) 15 | (let* ((protocols (electron:protocols electron:*interface*)) 16 | (font-path (asdf:system-relative-pathname :cl-electron 17 | "examples/dejavu-sans-mono.ttf")) 18 | (font (alexandria:read-file-into-byte-vector font-path))) 19 | (electron:handle (find "test" protocols 20 | :key #'electron:scheme-name :test #'string-equal) 21 | "() => {return new Response('')}") 22 | (electron:handle-callback (find "font" protocols 23 | :key #'electron:scheme-name :test #'string-equal) 24 | (lambda (_) (declare (ignore _)) font))) 25 | (let ((win (make-instance 'electron:window))) 26 | (electron:load-url win "test:dummy-var") 27 | (electron:execute-javascript-synchronous 28 | (electron:web-contents win) 29 | (ps:ps (setf (ps:chain document (get-elements-by-tag-name "html") 0 |innerHTML|) 30 | (ps:lisp (spinneret:with-html-string 31 | (:head 32 | (:style 33 | (:raw 34 | (lass:compile-and-write 35 | '(:font-face 36 | :font-family "dejavu sans mono" 37 | :src "url('font:dummy-var')") 38 | '(p 39 | :font-family "dejavu sans mono"))))) 40 | (:body (:p "Hello world"))))))) 41 | win)) 42 | -------------------------------------------------------------------------------- /source/protocol.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | ;;;; Electron module to register a custom protocol and intercept existing 5 | ;;;; protocol requests. 6 | 7 | (in-package :electron) 8 | 9 | (export-always 'handle) 10 | (defmethod handle ((protocol protocol) handler) 11 | (message 12 | protocol 13 | (format nil "protocol.handle('~a', ~a)" (scheme-name protocol) handler))) 14 | 15 | (export-always 'handle-content) 16 | (defmethod handle-content ((protocol protocol) content) 17 | (handle protocol (format nil "() => {return new Response('~a')}" content))) 18 | 19 | (defun base64-encode-utf8 (input-string) 20 | (let ((utf8-bytes (babel:string-to-octets input-string))) 21 | (cl-base64:usb8-array-to-base64-string utf8-bytes))) 22 | 23 | (export-always 'handle-callback) 24 | (defmethod handle-callback ((protocol protocol) callback) 25 | (let ((socket-thread-id 26 | (create-node-socket-thread 27 | (lambda (url) 28 | (cl-json:encode-json-to-string 29 | (multiple-value-bind (data-string data-type) (funcall callback url) 30 | (list (cons "dataString" 31 | (typecase data-string 32 | ((simple-array (unsigned-byte 8)) 33 | (cl-base64:usb8-array-to-base64-string data-string)) 34 | (string 35 | (base64-encode-utf8 data-string)) 36 | (null ""))) 37 | (cons "dataType" (or data-type "text/html;charset=utf8")))))) 38 | :interface (interface protocol)))) 39 | (handle protocol 40 | (format nil 41 | "(request) => { 42 | return new Promise((resolve, reject) => { 43 | ~a.write(`${JSON.stringify(request.url)}\\n`); 44 | new ProtocolSocket(~a, data => { 45 | const jsonObject = JSON.parse(data); 46 | const _buffer = Buffer.from(jsonObject.dataString, 'base64'); 47 | const newResponse = new Response(_buffer, { 48 | headers: { 'content-type': jsonObject.dataType } 49 | }); 50 | resolve(newResponse); 51 | }); 52 | }); 53 | }" socket-thread-id socket-thread-id)))) 54 | -------------------------------------------------------------------------------- /cl-electron.asd: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | #-(or sbcl ccl) 5 | (warn "unsupported implementation, satisfaction uncertain!") 6 | 7 | (defsystem "cl-electron" 8 | :version "0.0.0" 9 | :author "Atlas Engineer LLC" 10 | :description "Common Lisp interface to Electron." 11 | :license "BSD 3-Clause" 12 | :depends-on (alexandria 13 | uiop 14 | cl-json 15 | cl-base64 16 | iolib 17 | iolib/os 18 | cl-ppcre 19 | nclasses 20 | bordeaux-threads 21 | lparallel 22 | parse-number 23 | babel) 24 | :components ((:module "source" 25 | :components 26 | ((:file "package") 27 | (:file "core" :depends-on ("package")) 28 | (:file "window" :depends-on ("package" "core")) 29 | (:file "view" :depends-on ("package" "core")) 30 | (:file "web-contents" :depends-on ("package" "core")) 31 | (:file "session" :depends-on ("package" "core")) 32 | (:file "protocol" :depends-on ("package" "core")) 33 | (:file "adblock" :depends-on ("package" "core"))))) 34 | :in-order-to ((test-op (test-op "cl-electron/tests")))) 35 | 36 | (defsystem "cl-electron/tests" 37 | :pathname "tests" 38 | :depends-on (cl-electron lisp-unit2 spinneret parenscript) 39 | :components ((:file "tests")) 40 | :perform (test-op (op c) 41 | (eval-input 42 | "(lisp-unit2:run-tests 43 | :package :electron/tests 44 | :run-contexts #'lisp-unit2:with-summary-context)"))) 45 | 46 | (defsystem "cl-electron/examples" 47 | :pathname "examples" 48 | :depends-on (cl-electron lass spinneret) 49 | :components ((:file "package") 50 | (:file "example-window") 51 | (:file "example-download") 52 | (:file "example-views") 53 | (:file "example-web-preferences") 54 | (:file "example-protocol") 55 | (:file "example-asset") 56 | (:file "example-extension") 57 | (:file "example-adblock") 58 | (:file "example-context-menu"))) 59 | -------------------------------------------------------------------------------- /source/server.js: -------------------------------------------------------------------------------- 1 | // SPDX-FileCopyrightText: Atlas Engineer LLC 2 | // SPDX-License-Identifier: BSD-3-Clause 3 | 4 | //////////////////////////////////////////////////////////////////////// 5 | // Start a Javascript server that will eval code received. 6 | //////////////////////////////////////////////////////////////////////// 7 | 8 | const path = require('node:path') 9 | const nodejs_net = require('node:net'); 10 | const fs = require('node:fs'); 11 | const emitter = require('node:events'); 12 | const SynchronousSocket = require('synchronous-socket'); 13 | const { protocol } = require('electron') 14 | 15 | // Eval and register protocols before we start Electron. 16 | eval(process.argv.at(-1)); 17 | 18 | const { app, ipcMain, BrowserWindow, WebContentsView, webContents, 19 | net, dialog, session, Menu } = require('electron') 20 | 21 | // Handle long messages from a socket and combine them into a single message. 22 | class ProtocolSocket { 23 | constructor(socket, onDataFunction) { 24 | this.socket = socket; 25 | this.onDataFunction = onDataFunction; 26 | this.messageBuffer = ''; 27 | 28 | this.socket.on('data', data => { 29 | let dataString = data.toString(); 30 | let transmissionEndIndex = dataString.indexOf(''); 31 | if (transmissionEndIndex == -1) { 32 | this.messageBuffer += dataString; 33 | } else { 34 | this.messageBuffer += dataString.substring(0, transmissionEndIndex); 35 | this.onDataFunction(this.messageBuffer); 36 | this.messageBuffer = dataString.substring(transmissionEndIndex + 1, dataString.length); 37 | } 38 | }); 39 | } 40 | send(message) { 41 | this.socket.write(message + '\n'); 42 | } 43 | } 44 | app.on('ready', () => { 45 | const server = nodejs_net.createServer((socket) => { 46 | const protocolSocket = new ProtocolSocket(socket, (message) => { 47 | try { 48 | const result = eval(message); 49 | protocolSocket.send(String(result)); 50 | } catch (err) { 51 | protocolSocket.send(String(err)); 52 | } 53 | }); 54 | }); 55 | 56 | server_socket_path = process.argv.at(-2); 57 | server.listen(server_socket_path, () => { 58 | fs.chmodSync(server_socket_path, 0o600) 59 | }); 60 | }); 61 | 62 | // Disable error dialogs. 63 | dialog.showErrorBox = function(title, content) { 64 | console.log(`${title}\n${content}`); 65 | }; 66 | 67 | // Do not limit the amount of possible listeners. 68 | emitter.setMaxListeners(0) 69 | 70 | // Generate Unique IDs for variable names. 71 | var GLOBALS = {}; 72 | var uid = (function() { 73 | var id = 0; 74 | return function() { 75 | if (arguments[0] === 0) id = 0; 76 | return id++; 77 | } 78 | })(); 79 | 80 | 81 | -------------------------------------------------------------------------------- /examples/example-views.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | (in-package :electron/examples) 5 | 6 | (define-class main-view (electron:view) 7 | ((url nil))) 8 | 9 | (defmethod initialize-instance :after ((main-view main-view) &key window) 10 | (electron:add-bounded-view window 11 | main-view 12 | :window-bounds-alist-var bounds 13 | :x 0 14 | :y 0 15 | :width (assoc-value bounds :width) 16 | :height (- (assoc-value bounds :height) 30)) 17 | (electron:add-listener (electron:web-contents main-view) :did-finish-load 18 | (lambda (web-contents) 19 | (setf (url main-view) (electron:get-url web-contents)))) 20 | (electron:load-url main-view "https://en.wikipedia.org/wiki/Electron") 21 | (print (electron:execute-javascript-synchronous (electron:web-contents main-view) 22 | "1 + 1"))) 23 | 24 | (define-class modeline (electron:view) ()) 25 | 26 | (defmethod initialize-instance :after ((modeline modeline) &key window) 27 | (electron:add-bounded-view window 28 | modeline 29 | :window-bounds-alist-var bounds 30 | :x 0 31 | :y (- (assoc-value bounds :height) 30) 32 | :width (assoc-value bounds :width) 33 | :height 30) 34 | (electron:handle-callback (make-instance 'electron:protocol :scheme-name "lisp") 35 | (lambda (url) 36 | (declare (ignorable url)) 37 | "Caution: Made with secret alien technology")) 38 | (electron:load-url modeline "lisp:hello")) 39 | 40 | (define-class prompt (electron:view) ()) 41 | 42 | (defmethod initialize-instance :after ((prompt prompt) &key window) 43 | (electron:add-bounded-view window 44 | prompt 45 | :window-bounds-alist-var bounds 46 | :x 0 47 | :y (floor (* (- (assoc-value bounds :height) 30) 2/3)) 48 | :width (assoc-value bounds :width) 49 | :height (ceiling (/ (- (assoc-value bounds :height) 30) 3))) 50 | (electron:set-background-color prompt "lightskyblue") 51 | (electron:load-url prompt "about:blank")) 52 | 53 | (defun electron-views-example () 54 | (electron:launch) 55 | (let ((win (make-instance 'electron:window))) 56 | (make-instance 'main-view :window win) 57 | (make-instance 'modeline :window win) 58 | (make-instance 'prompt :window win) 59 | win)) 60 | -------------------------------------------------------------------------------- /source/view.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | ;;;; Electron view object definition and methods. 5 | 6 | (in-package :electron) 7 | 8 | (defmethod initialize-instance :after ((view view) &key) 9 | (message 10 | view 11 | (format nil "~a = new WebContentsView(~a)" 12 | (remote-symbol view) (options view)))) 13 | 14 | (export-always 'set-bounds) 15 | (defmethod set-bounds ((view view) &key x y width height) 16 | (message 17 | view 18 | (format nil "~a.setBounds(~a)" 19 | (remote-symbol view) 20 | (format-rectangle :x x :y y :width width :height height)))) 21 | 22 | (export-always 'get-bounds) 23 | (defmethod get-bounds ((view view)) 24 | "Return Rectangle object of WINDOW." 25 | (json:decode-json-from-string 26 | (message 27 | view 28 | (format nil "JSON.stringify(~a.getBounds())" (remote-symbol view))))) 29 | 30 | (export-always 'set-background-color) 31 | (defmethod set-background-color ((view view) color) 32 | (message 33 | view 34 | (format nil "~a.setBackgroundColor(\"~a\")" (remote-symbol view) color))) 35 | 36 | (export-always 'web-contents) 37 | (defmethod web-contents ((view view)) 38 | (or (slot-value view 'web-contents) 39 | (let ((new-id (new-id))) 40 | (message 41 | view 42 | (format nil "~a = ~a.webContents" new-id (remote-symbol view))) 43 | (setf (slot-value view 'web-contents) 44 | (make-instance 'web-contents 45 | :remote-symbol new-id 46 | :interface (interface view)))))) 47 | 48 | ;; Helpers 49 | 50 | (export-always 'load-url) 51 | (defmethod load-url ((view view) url) 52 | (load-url (web-contents view) url)) 53 | 54 | (export-always 'kill) 55 | (defmethod kill ((view view)) 56 | (mapcar #'destroy-thread* (socket-threads view)) 57 | (kill (web-contents view)) 58 | (setf (slot-value view 'web-contents) nil)) 59 | 60 | (export-always 'focus) 61 | (defmethod focus ((view view)) 62 | (focus (web-contents view))) 63 | 64 | (export-always 'get-url) 65 | (defmethod get-url ((view view)) 66 | (get-url (web-contents view))) 67 | 68 | (export-always 'get-title) 69 | (defmethod get-title ((view view)) 70 | (get-title (web-contents view))) 71 | 72 | (export-always 'open-dev-tools) 73 | (defmethod open-dev-tools ((view view) &key (options "{mode: 'undocked'}")) 74 | (open-dev-tools (web-contents view) :options options)) 75 | 76 | (export-always 'close-dev-tools) 77 | (defmethod close-dev-tools ((view view)) 78 | (close-dev-tools (web-contents view))) 79 | 80 | (export-always 'is-focused) 81 | (defmethod is-focused ((view view)) 82 | (is-focused (web-contents view))) 83 | 84 | (defmethod add-listener ((object remote-object) 85 | (event (eql :context-menu)) 86 | (callback function) 87 | &key once-p) 88 | (declare (ignore once-p)) 89 | (multiple-value-bind (thread-id socket-thread socket-path) 90 | (create-node-synchronous-socket-thread 91 | (lambda (input) 92 | (apply callback (cons object input))) 93 | :interface (interface object)) 94 | (declare (ignore socket-path)) 95 | (push socket-thread (socket-threads object)) 96 | (message 97 | object 98 | (format-listener (if (web-contents-p object) object (web-contents object)) 99 | event 100 | (format nil 101 | "(event, params) => { 102 | ~a.write(JSON.stringify([ params ]) + '\\\n'); 103 | Menu.buildFromTemplate(eval(~a.read())).popup({}); 104 | }" 105 | thread-id 106 | thread-id))))) 107 | -------------------------------------------------------------------------------- /tests/tests.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | (uiop:define-package :electron/tests 5 | (:nicknames :cl-electron/tests) 6 | (:use :cl :lisp-unit2)) 7 | 8 | (in-package :electron/tests) 9 | 10 | (setf electron:*interface* (make-instance 'electron:interface)) 11 | 12 | (defmacro with-electron-session (&body body) 13 | `(progn 14 | (electron:launch) 15 | (let ((win (make-instance 'electron:window :options "{show: false}"))) 16 | (electron:load-url win "https://en.wikipedia.org/wiki/Electron") 17 | ,@body 18 | ;; To allow body to be computed. 19 | (sleep 0.1)) 20 | (electron:terminate) 21 | ;; So that chaining electron:launch and electron:terminate is safe. 22 | (sleep 0.1))) 23 | 24 | (define-test launch-terminate-idempotent () 25 | (with-electron-session 26 | (with-slots ((original-process electron:process)) electron:*interface* 27 | (assert-warning 'simple-warning (assert-false (electron:launch))) 28 | (assert-eq original-process 29 | (electron:process electron:*interface*)))) 30 | (assert-warning 'simple-warning (assert-false (electron:terminate)))) 31 | 32 | (define-test dangling-server-socket-on-launch () 33 | (open (electron:server-socket-path electron:*interface*) :if-does-not-exist :create) 34 | (assert-warning 'simple-warning (with-electron-session t))) 35 | 36 | (define-test js-handling-quotes () 37 | (with-electron-session 38 | (let ((js (ps:ps "a'b'c\"d\"e`f`g"))) 39 | (assert-string= (electron:execute-javascript-synchronous (electron:web-contents win) js) 40 | (electron::message (electron:interface win) js))))) 41 | 42 | (define-test js-handling-multi-line () 43 | (with-electron-session 44 | (let ((js (ps:ps ((lambda (x y) (+ x y)) 2 2)))) 45 | (assert-eq (electron:execute-javascript-synchronous (electron:web-contents win) js) 46 | (parse-integer (electron::message (electron:interface win) js)))))) 47 | 48 | (define-test js-handling-doc () 49 | (with-electron-session 50 | (let ((html (spinneret:with-html-string (:head) (:body (:raw "a'b'c\"d\"e`f`g"))))) 51 | (assert-string= 52 | html 53 | (electron:execute-javascript-synchronous 54 | (electron:web-contents win) 55 | (ps:ps (setf (ps:chain document (get-elements-by-tag-name "html") 0 |innerHTML|) 56 | (ps:lisp html)))))))) 57 | 58 | (defun socket-connections-count () 59 | (parse-integer 60 | (uiop:run-program (format nil "ss -x | grep ~a | wc -l" 61 | (electron:sockets-directory electron:*interface*)) 62 | :output '(:string :stripped t) 63 | :ignore-error-status t))) 64 | 65 | (define-test sanitize-ipc-communication () 66 | (with-electron-session 67 | (assert-number-equal 68 | (socket-connections-count) 69 | (progn 70 | (dotimes (n 2000) 71 | (electron:execute-javascript-synchronous (electron:web-contents win) 72 | (ps:ps "hello world!"))) 73 | (socket-connections-count))) 74 | (assert-number-equal 75 | (socket-connections-count) 76 | (let ((view (make-instance 'electron:view))) 77 | (electron:add-bounded-view win 78 | view 79 | :window-bounds-alist-var bounds 80 | :width (alexandria:assoc-value bounds :width)) 81 | (electron:add-listener (electron:web-contents win) :did-finish-load 82 | (lambda (web-contents) (declare (ignore web-contents)) t)) 83 | (electron:add-listener win :before-input-event 84 | (lambda (win input) (declare (ignore win input)) t)) 85 | (electron:remove-view win view :kill-view-p t) 86 | (electron:kill (electron:web-contents win)) 87 | (electron:kill win) 88 | (socket-connections-count)))) 89 | 90 | ;; No dangling connections. 91 | (assert-number-equal 0 (socket-connections-count)) 92 | ;; No dangling socket files. 93 | (assert-false (uiop:directory-files (electron:sockets-directory electron:*interface*)))) 94 | -------------------------------------------------------------------------------- /source/session.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | ;; Electron session object. 5 | 6 | (in-package :electron) 7 | 8 | (export-always 'default-session) 9 | (defmethod default-session ((interface interface)) 10 | (let ((new-id (new-id))) 11 | (message 12 | interface 13 | (format nil "~a = session.defaultSession" new-id)) 14 | (make-instance 'session 15 | :remote-symbol new-id 16 | :interface interface))) 17 | 18 | (defmethod add-listener ((session session) 19 | (event (eql :download-item-updated)) 20 | (callback function) 21 | &key once-p) 22 | ;; Callback runs on the updated and done instance events of DownloadItem. 23 | (declare (ignore once-p)) 24 | (let ((socket-id (create-node-socket-thread 25 | (lambda (result) 26 | (if (equal "new" (assoc-value result :state)) 27 | (funcall callback 28 | session 29 | (setf (gethash (assoc-value result :id) 30 | (download-items session)) 31 | (make-instance 32 | 'download-item 33 | :remote-symbol (assoc-value result :id) 34 | :url (assoc-value result :url)))) 35 | (let ((download-item (gethash (assoc-value result :id) 36 | (download-items session)))) 37 | (setf (url download-item) 38 | (assoc-value result :url) 39 | 40 | (state download-item) 41 | (assoc-value result :state) 42 | 43 | (received-bytes download-item) 44 | (assoc-value result :received-bytes) 45 | 46 | (percent-complete download-item) 47 | (assoc-value result :percent-complete) 48 | 49 | (save-path download-item) 50 | (assoc-value result :save-path) 51 | 52 | (total-bytes download-item) 53 | (assoc-value result :total-bytes)) 54 | (funcall callback session download-item)))) 55 | :interface (interface session)))) 56 | (message 57 | session 58 | (format-listener session 59 | :will-download 60 | (format nil 61 | "(event, item, webContents) => { 62 | var id = uid(); 63 | GLOBALS[id] = item; 64 | ~a.write(JSON.stringify({'id': id, 65 | 'state': 'new', 66 | 'url': item.getURL(),}) + '\\\n'); 67 | item.on('updated', (event, state) => { 68 | ~a.write(JSON.stringify({'id': id, 69 | 'url': item.getURL(), 70 | 'receivedBytes': item.getReceivedBytes(), 71 | 'totalBytes': item.getTotalBytes(), 72 | 'percentComplete': item.getPercentComplete(), 73 | 'savePath': item.savePath, 74 | 'state': state}) + '\\\n'); 75 | }) 76 | item.once('done', (event, state) => { 77 | ~a.write(JSON.stringify({'id': id, 78 | 'url': item.getURL(), 79 | 'receivedBytes': item.getReceivedBytes(), 80 | 'totalBytes': item.getTotalBytes(), 81 | 'percentComplete': item.getPercentComplete(), 82 | 'savePath': item.savePath, 83 | 'state': state}) + '\\\n'); 84 | }) 85 | }" 86 | socket-id 87 | socket-id 88 | socket-id))))) 89 | 90 | (export-always 'cancel) 91 | (defmethod cancel ((download-item download-item)) 92 | (message 93 | download-item 94 | (format nil "GLOBALS['~a'].cancel();" (remote-symbol download-item)))) 95 | 96 | (export-always 'load-extension) 97 | (defmethod load-extension ((session session) path &key (options "{}")) 98 | (message 99 | session 100 | (format nil "~a.loadExtension('~a', ~a)" (remote-symbol session) path options))) 101 | 102 | (export-always 'get-all-extensions) 103 | (defmethod get-all-extensions ((session session)) 104 | (message 105 | session 106 | (format nil "~a.getAllExtensions()" (remote-symbol session)))) 107 | 108 | -------------------------------------------------------------------------------- /source/window.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | ;;;; Electron window object definition and methods. 5 | 6 | (in-package :electron) 7 | 8 | (defmethod initialize-instance :after ((window window) &key) 9 | (message 10 | window 11 | (format nil "~a = new BrowserWindow(~a);" 12 | (remote-symbol window) (options window)))) 13 | 14 | (export-always 'load-url) 15 | (defmethod load-url ((window window) url) 16 | (message 17 | window 18 | (format nil "~a.loadURL('~a')" (remote-symbol window) url))) 19 | 20 | (export-always 'kill) 21 | (defmethod kill ((window window)) 22 | (mapcar #'destroy-thread* (socket-threads window)) 23 | (message 24 | window 25 | (format nil "~a.close()" (remote-symbol window)))) 26 | 27 | (export-always 'fullscreen) 28 | (defmethod fullscreen ((window window)) 29 | (message 30 | window 31 | (format nil "~a.setFullScreen(true)" (remote-symbol window)))) 32 | 33 | (export-always 'unfullscreen) 34 | (defmethod unfullscreen ((window window)) 35 | (message 36 | window 37 | (format nil "~a.setFullScreen(false)" (remote-symbol window)))) 38 | 39 | (export-always 'maximize) 40 | (defmethod maximize ((window window)) 41 | (message 42 | window 43 | (format nil "~a.maximize()" (remote-symbol window)))) 44 | 45 | (export-always 'unmaximize) 46 | (defmethod unmaximize ((window window)) 47 | (message 48 | window 49 | (format nil "~a.unmaximize()" (remote-symbol window)))) 50 | 51 | (export-always 'get-title) 52 | (defmethod get-title ((window window)) 53 | (message 54 | window 55 | (format nil "~a.getTitle()" (remote-symbol window)))) 56 | 57 | (export-always 'set-title) 58 | (defmethod set-title ((window window) title) 59 | (message 60 | window 61 | (format nil "~a.setTitle(\"~a\")" (remote-symbol window) title))) 62 | 63 | (export-always 'is-focused) 64 | (defmethod is-focused ((window window)) 65 | (string-equal "true" 66 | (message 67 | window 68 | (format nil "~a.isFocused()" (remote-symbol window))))) 69 | 70 | (export-always 'focus) 71 | (defmethod focus ((window window)) 72 | (message 73 | window 74 | (format nil "~a.focus()" (remote-symbol window)))) 75 | 76 | (export-always 'remove-menu) 77 | (defmethod remove-menu ((window window)) 78 | (message 79 | window 80 | (format nil "~a.removeMenu()" (remote-symbol window)))) 81 | 82 | (export-always 'get-bounds) 83 | (defmethod get-bounds ((window window)) 84 | "Return Rectangle object of WINDOW." 85 | (json:decode-json-from-string 86 | (message 87 | window 88 | (format nil "JSON.stringify(~a.getBounds())" (remote-symbol window))))) 89 | 90 | (export-always 'get-content-bounds) 91 | (defmethod get-content-bounds ((window window)) 92 | "Return Rectangle object of WINDOW." 93 | (json:decode-json-from-string 94 | (message 95 | window 96 | (format nil "JSON.stringify(~a.getContentBounds())" (remote-symbol window))))) 97 | 98 | (defun format-rectangle (&key x y width height) 99 | "Encode Rectangle object." 100 | (format nil "{~{~A~^, ~}}" 101 | (remove-if #'uiop:emptyp 102 | (list (format nil "~@[x: ~A~]" x) 103 | (format nil "~@[y: ~A~]" y) 104 | (format nil "~@[width: ~A~]" width) 105 | (format nil "~@[height: ~A~]" height))))) 106 | 107 | (export-always 'set-bounds) 108 | (defmethod set-bounds ((window window) &key x y width height) 109 | (message 110 | window 111 | (format nil "~a.setBounds(~a)" 112 | (remote-symbol window) 113 | (format-rectangle :x x :y y :width width :height height)))) 114 | 115 | (export-always 'set-background-color) 116 | (defmethod set-background-color ((window window) color) 117 | (message 118 | window 119 | (format nil "~a.setBackgroundColor(\"~a\")" (remote-symbol window) color))) 120 | 121 | (export-always 'content-view) 122 | (defmethod content-view ((window window)) 123 | (message 124 | window 125 | (format nil "~a.contentView" (remote-symbol window)))) 126 | 127 | (export-always 'get-content-view) 128 | (defmethod get-content-view ((window window)) 129 | (message 130 | window 131 | (format nil "~a.getContentView()" (remote-symbol window)))) 132 | 133 | (export-always 'view-count) 134 | (defmethod view-count ((window window)) 135 | (message 136 | window 137 | (format nil "~a.getContentView().children.length" (remote-symbol window)))) 138 | 139 | (export-always 'add-view) 140 | (defmethod add-view ((window window) (view view) &key z-index) 141 | "Add VIEW to WINDOW. 142 | 143 | When Z-INDEX is omitted, its value corresponds to `view-count' (such that VIEW 144 | is shown as the topmost). 145 | 146 | When VIEW is already bound to window and Z-INDEX is omitted, the Z-INDEX of all 147 | of WINDOW's views is reset such that VIEW is shown as the topmost." 148 | (pushnew view (views window)) 149 | (message 150 | window 151 | (format nil "~a.contentView.addChildView(~a~@[,~a~])" 152 | (remote-symbol window) 153 | (remote-symbol view) 154 | z-index))) 155 | 156 | (export-always 'add-bounded-view) 157 | (defmacro add-bounded-view (window view &key z-index window-bounds-alist-var x y width height) 158 | `(progn 159 | (let ((,window-bounds-alist-var (get-content-bounds ,window))) 160 | (set-bounds ,view :x ,x :y ,y :width ,width :height ,height)) 161 | ;; As to avoid adding an existing listener. Note that `add-bounded-view' 162 | ;; can be called multiple times over the same view and window, as to show 163 | ;; the former on top. 164 | (unless (find ,view (views ,window)) 165 | ;; Even though the listener is added to window, it must be removed when 166 | ;; the view is removed from it. 167 | (push (add-listener ,window :resize 168 | (lambda (win) 169 | (let ((,window-bounds-alist-var (get-content-bounds win))) 170 | (set-bounds ,view 171 | :x ,x :y ,y :width ,width :height ,height)))) 172 | (socket-threads ,view))) 173 | ;; `add-view' is called after `set-bounds', since it pushes view into 174 | ;; `views'. 175 | (add-view ,window ,view :z-index ,z-index))) 176 | 177 | (export-always 'remove-view) 178 | (defmethod remove-view ((window window) (view view) &key (kill-view-p t)) 179 | (setf (views window) (remove view (views window))) 180 | (message 181 | window 182 | (format nil "~a.contentView.removeChildView(~a)" 183 | (remote-symbol window) 184 | (remote-symbol view))) 185 | (when kill-view-p (kill view))) 186 | 187 | (export-always 'web-contents) 188 | (defmethod web-contents ((window window)) 189 | (or (slot-value window 'web-contents) 190 | (let ((new-id (new-id))) 191 | (message 192 | window 193 | (format nil "~a = ~a.webContents" new-id (remote-symbol window))) 194 | (setf (slot-value window 'web-contents) 195 | (make-instance 'web-contents 196 | :remote-symbol new-id 197 | :interface (interface window)))))) 198 | 199 | (export-always 'get-child-windows) 200 | (defmethod get-child-windows ((window window)) 201 | (message 202 | window 203 | (format nil "~a.getChildWindows()" (remote-symbol window)))) 204 | 205 | (export-always 'get-parent-window) 206 | (defmethod get-parent-window ((window window)) 207 | (message 208 | window 209 | (format nil "~a.getParentWindow()" (remote-symbol window)))) 210 | 211 | (export-always 'id) 212 | (defmethod id ((window window)) 213 | (message 214 | window 215 | (format nil "~a.id" (remote-symbol window)))) 216 | 217 | ;; Static methods 218 | 219 | (export-always 'get-all-windows) 220 | (defun get-all-windows (interface) 221 | (message 222 | interface 223 | (format nil "BrowserWindow.getAllWindows()"))) 224 | 225 | (export-always 'test-get-focused-window) 226 | (defun test-get-focused-window (interface) 227 | (message 228 | interface 229 | (format nil "BrowserWindow.getFocusedWindow()"))) 230 | 231 | (export-always 'window-from-web-contents) 232 | (defun window-from-web-contents (interface web-contents) 233 | (message 234 | interface 235 | (format nil "BrowserWindow.fromWebContents(~a)" (remote-symbol web-contents)))) 236 | 237 | (export-always 'window-from-id) 238 | (defun window-from-id (interface id) 239 | (message 240 | interface 241 | (format nil "BrowserWindow.fromId(~a)" id))) 242 | -------------------------------------------------------------------------------- /source/web-contents.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | ;;;; Electron web-contents object definition and methods. 5 | 6 | (in-package :electron) 7 | 8 | (export-always 'download-url) 9 | (defmethod download-url ((web-contents web-contents) url) 10 | (message 11 | web-contents 12 | (format nil "~a.downloadURL(\"~a\")" (remote-symbol web-contents) url))) 13 | 14 | (export-always 'set-zoom-factor) 15 | (defmethod set-zoom-factor ((web-contents web-contents) factor) 16 | (message 17 | web-contents 18 | (format nil "~a.setZoomFactor(~a)" (remote-symbol web-contents) factor))) 19 | 20 | (export-always 'get-zoom-factor) 21 | (defmethod get-zoom-factor ((web-contents web-contents)) 22 | (parse-number:parse-number 23 | (message 24 | web-contents 25 | (format nil "~a.getZoomFactor()" (remote-symbol web-contents))))) 26 | 27 | (export-always 'set-zoom-level) 28 | (defmethod set-zoom-level ((web-contents web-contents) level) 29 | (message 30 | web-contents 31 | (format nil "~a.setZoomLevel(~a)" (remote-symbol web-contents) level))) 32 | 33 | (export-always 'get-zoom-level) 34 | (defmethod get-zoom-level ((web-contents web-contents)) 35 | (parse-number:parse-number 36 | (message 37 | web-contents 38 | (format nil "~a.getZoomLevel()" (remote-symbol web-contents))))) 39 | 40 | (export-always 'set-audio-muted) 41 | (defmethod set-audio-muted ((web-contents web-contents) muted) 42 | (message 43 | web-contents 44 | (format nil "~a.setAudioMuted(~a)" 45 | (remote-symbol web-contents) 46 | (if muted 47 | "true" 48 | "false")))) 49 | 50 | (export-always 'muted-p) 51 | (defmethod muted-p ((web-contents web-contents)) 52 | (when (string-equal "true" 53 | (message web-contents 54 | (format nil "~a.isAudioMuted()" 55 | (remote-symbol web-contents)))) 56 | t)) 57 | 58 | (export-always 'set-user-agent) 59 | (defmethod set-user-agent ((web-contents web-contents) user-agent) 60 | (message 61 | web-contents 62 | (format nil "~a.setUserAgent(\"~a\")" (remote-symbol web-contents) user-agent))) 63 | 64 | (export-always 'get-user-agent) 65 | (defmethod get-user-agent ((web-contents web-contents)) 66 | (message 67 | web-contents 68 | (format nil "~a.getUserAgent()" (remote-symbol web-contents)))) 69 | 70 | (export-always 'load-url) 71 | (defmethod load-url ((web-contents web-contents) url) 72 | (message 73 | web-contents 74 | (format nil "~a.loadURL(\"~a\")" (remote-symbol web-contents) url))) 75 | 76 | (export-always 'load-file) 77 | (defmethod load-file ((web-contents web-contents) path) 78 | (message 79 | web-contents 80 | (format nil "~a.loadFile(\"~a\")" (remote-symbol web-contents) path))) 81 | 82 | (export-always 'get-url) 83 | (defmethod get-url ((web-contents web-contents)) 84 | (message 85 | web-contents 86 | (format nil "~a.getURL()" (remote-symbol web-contents)))) 87 | 88 | (export-always 'open-dev-tools) 89 | (defmethod open-dev-tools ((web-contents web-contents) &key (options "{mode: 'undocked'}")) 90 | (message 91 | web-contents 92 | (format nil "~a.openDevTools(~a)" (remote-symbol web-contents) options))) 93 | 94 | (export-always 'close-dev-tools) 95 | (defmethod close-dev-tools ((web-contents web-contents)) 96 | (message 97 | web-contents 98 | (format nil "~a.closeDevTools()" (remote-symbol web-contents)))) 99 | 100 | (export-always 'get-title) 101 | (defmethod get-title ((web-contents web-contents)) 102 | (message 103 | web-contents 104 | (format nil "~a.getTitle()" (remote-symbol web-contents)))) 105 | 106 | (export-always 'reload) 107 | (defmethod reload ((web-contents web-contents)) 108 | (message 109 | web-contents 110 | (format nil "~a.reload()" (remote-symbol web-contents)))) 111 | 112 | (export-always 'focus) 113 | (defmethod focus ((web-contents web-contents)) 114 | (message 115 | web-contents 116 | (format nil "~a.focus()" (remote-symbol web-contents)))) 117 | 118 | (export-always 'is-focused) 119 | (defmethod is-focused ((web-contents web-contents)) 120 | (when (string-equal "true" 121 | (message 122 | web-contents 123 | (format nil "~a.isFocused()" (remote-symbol web-contents)))) 124 | t)) 125 | 126 | (export-always 'undo) 127 | (defmethod undo ((web-contents web-contents)) 128 | (message 129 | web-contents 130 | (format nil "~a.undo()" (remote-symbol web-contents)))) 131 | 132 | (export-always 'redo) 133 | (defmethod redo ((web-contents web-contents)) 134 | (message 135 | web-contents 136 | (format nil "~a.redo()" (remote-symbol web-contents)))) 137 | 138 | (export-always 'cut) 139 | (defmethod cut ((web-contents web-contents)) 140 | (message 141 | web-contents 142 | (format nil "~a.cut()" (remote-symbol web-contents)))) 143 | 144 | (export-always 'copy) 145 | (defmethod copy ((web-contents web-contents)) 146 | (message 147 | web-contents 148 | (format nil "~a.copy()" (remote-symbol web-contents)))) 149 | 150 | (export-always 'paste) 151 | (defmethod paste ((web-contents web-contents)) 152 | (message 153 | web-contents 154 | (format nil "~a.paste()" (remote-symbol web-contents)))) 155 | 156 | (export-always 'insert-text) 157 | (defmethod insert-text ((web-contents web-contents) text) 158 | (message 159 | web-contents 160 | (format nil "~a.insertText(\"~a\")" (remote-symbol web-contents) text))) 161 | 162 | (export-always 'select-all) 163 | (defmethod select-all ((web-contents web-contents)) 164 | (message 165 | web-contents 166 | (format nil "~a.selectAll()" (remote-symbol web-contents)))) 167 | 168 | (export-always 'kill) 169 | (defmethod kill ((web-contents web-contents)) 170 | (mapcar #'destroy-thread* (socket-threads web-contents)) 171 | (message 172 | web-contents 173 | (format nil "~a.close()" (remote-symbol web-contents)))) 174 | 175 | (export-always 'insert-css) 176 | (defmethod insert-css ((web-contents web-contents) css) 177 | (message 178 | web-contents 179 | (format nil "~a.insertCSS(\"~a\")" (remote-symbol web-contents) css))) 180 | 181 | (export-always 'remove-inserted-css) 182 | (defmethod remove-inserted-css ((web-contents web-contents) key) 183 | (message 184 | web-contents 185 | (format nil "~a.removeInsertedCSS(\"~a\")" (remote-symbol web-contents) key))) 186 | 187 | (export-always 'session) 188 | (defmethod session ((web-contents web-contents)) 189 | (or (slot-value web-contents 'session) 190 | (let ((new-id (new-id))) 191 | (message 192 | web-contents 193 | (format nil "~a = ~a.session" new-id (remote-symbol web-contents))) 194 | (setf (slot-value web-contents 'session) 195 | (make-instance 'session 196 | :remote-symbol new-id 197 | :interface (interface web-contents)))))) 198 | 199 | (export-always 'override-window-open-handler) 200 | (defmethod override-window-open-handler ((web-contents web-contents) callback) 201 | (message 202 | web-contents 203 | (format nil "~a.setWindowOpenHandler((details) => { 204 | ~a.write(JSON.stringify(details) + '\\\n'); 205 | return { action: 'deny' }; 206 | });" 207 | (remote-symbol web-contents) 208 | (create-node-socket-thread (lambda (response) 209 | (funcall callback response) 210 | (destroy-thread* (bt:current-thread))) 211 | :interface (interface web-contents))))) 212 | 213 | (defun format-js-for-eval (js-code) 214 | "Escape JavaScript code so it can be safely inserted into a JS eval() call using double quotes." 215 | (let* ((escaped-backslashes 216 | (ppcre:regex-replace-all "\\\\" js-code "\\\\\\\\")) ; \ → \\ 217 | (escaped-quotes 218 | (ppcre:regex-replace-all "\"" escaped-backslashes "\\\\\"")) ; " → \" 219 | (escaped-newlines 220 | (ppcre:regex-replace-all "\\n" escaped-quotes "\\\\n"))) ; newline → \n 221 | escaped-newlines)) 222 | 223 | (export-always 'execute-javascript) 224 | (defmethod execute-javascript ((web-contents web-contents) code &key (user-gesture "false")) 225 | (message 226 | web-contents 227 | (format nil "~a.executeJavaScript(\"~a\", ~a)" 228 | (remote-symbol web-contents) (format-js-for-eval code) user-gesture))) 229 | 230 | (export-always 'execute-javascript-in-isolated-world) 231 | (defmethod execute-javascript-in-isolated-world ((web-contents web-contents) world-id code 232 | &key (user-gesture "false")) 233 | (message 234 | web-contents 235 | (format nil "~a.executeJavaScript(\"~a\", {code: `~a`}, ~a)" 236 | (remote-symbol web-contents) world-id (format-js-for-eval code) user-gesture))) 237 | 238 | (export-always 'execute-javascript-with-promise-callback) 239 | (defmethod execute-javascript-with-promise-callback 240 | ((web-contents web-contents) code callback &key (user-gesture "false")) 241 | (multiple-value-bind (thread-id socket-thread socket-path) 242 | (create-node-socket-thread (lambda (response) 243 | (apply callback (cons web-contents response))) 244 | :interface (interface web-contents)) 245 | (message 246 | web-contents 247 | (format nil "~a.executeJavaScript(\"~a\", ~a).then((value) => { 248 | jsonString = JSON.stringify([ value ]); 249 | ~a.write(`${jsonString}\\n`);}).catch(error => { 250 | ~a.write('[\"ERROR\"]\\n');});" 251 | (remote-symbol web-contents) (format-js-for-eval code) user-gesture 252 | thread-id thread-id)) 253 | (values thread-id socket-thread socket-path))) 254 | 255 | (export-always 'execute-javascript-synchronous) 256 | (defmethod execute-javascript-synchronous ((web-contents web-contents) code 257 | &key (user-gesture "false")) 258 | (let ((p (lparallel:promise))) 259 | (multiple-value-bind (thread-id socket-thread socket-path) 260 | (execute-javascript-with-promise-callback 261 | web-contents 262 | code 263 | (lambda (web-contents result) 264 | (declare (ignore web-contents)) 265 | (if (equal result "ERROR") 266 | (progn (warn "Renderer view error running JavaScript: ~%~a~%" code) 267 | (lparallel:fulfill p result)) 268 | (lparallel:fulfill p result))) 269 | :user-gesture user-gesture) 270 | (declare (ignore socket-path thread-id)) 271 | (prog1 (lparallel:force p) 272 | ;; Kill server and connections spawned by 273 | ;; `execute-javascript-with-promise-callback'. 274 | (bt:destroy-thread socket-thread))))) 275 | -------------------------------------------------------------------------------- /source/core.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SPDX-FileCopyrightText: Atlas Engineer LLC 2 | ;;;; SPDX-License-Identifier: BSD-3-Clause 3 | 4 | ;;;; Functions for starting, killing, and communication with the 5 | ;;;; electron process. 6 | 7 | (in-package :electron) 8 | 9 | (alexandria:define-constant +default-wayland-opts+ '("--enable-features=UseOzonePlatform" "--ozone-platform=wayland") 10 | :test #'equal 11 | :documentation "The default options to be provided to Electron on the wayland platform") 12 | 13 | (define-class interface () 14 | ((sockets-directory 15 | #-darwin 16 | (ensure-directories-exist (uiop:xdg-runtime-dir "cl-electron/") :mode #o700) 17 | #+darwin 18 | (ensure-directories-exist (pathname "~/Library/Caches/TemporaryItems/cl-electron/") 19 | :mode #o700) 20 | :export t 21 | :reader t 22 | :writer nil 23 | :documentation "The directory where sockets are stored.") 24 | (server-socket-path 25 | #P"" 26 | :export t 27 | :reader t 28 | :writer nil 29 | :documentation "The path of the server socket.") 30 | (socket-threads 31 | '() 32 | :documentation "A list of threads connected to sockets used by the system.") 33 | (process 34 | nil 35 | :documentation "The Electron process.") 36 | (protocols 37 | nil 38 | ;; The slot can't be set at initialization since protocol objects inherit 39 | ;; from remote-object, whose `interface' slot is only set after an object of 40 | ;; class `interface' has been initialized. 41 | :initarg nil 42 | :export t 43 | :reader t 44 | :writer nil 45 | :type (or list-of-protocols null) 46 | :documentation "A list of custom schemes (protocols). 47 | The slot can only be set before invoking `launch'.") 48 | (server-path 49 | (asdf:system-relative-pathname :cl-electron "source/server.js") 50 | :export t 51 | :reader t 52 | :writer nil 53 | :type pathname 54 | :documentation "The path to a JavaScript file that specifies the IPC mechanism. 55 | 56 | All of its content is evaluated before the app signals the ready event. Not 57 | meant to be overwritten but rather appended. For instance, `protocols' are 58 | required to be registered there.") 59 | (launch-options 60 | '() 61 | :export t 62 | :accessor t 63 | :documentation "A list of options to pass to the Electron invocation")) 64 | (:export-class-name-p t) 65 | (:export-predicate-name-p t) 66 | (:export-accessor-names-p t) 67 | (:documentation "Interface with an Electron instance.")) 68 | 69 | (defmethod initialize-instance :after ((interface interface) &key) 70 | (setf (slot-value interface 'server-socket-path) 71 | (uiop:merge-pathnames* (sockets-directory interface) "electron.socket"))) 72 | 73 | (export-always 'server-running-p) 74 | (defmethod server-running-p ((interface interface)) 75 | "Whether the Electron server is listening." 76 | (iolib:with-open-socket (s :address-family :local 77 | :remote-filename (uiop:native-namestring 78 | (server-socket-path interface))) 79 | (iolib:socket-connected-p s))) 80 | 81 | (defun wayland-p () 82 | "Whether we are running on Wayland. 83 | 84 | We check if WAYLAND_DISPLAY is defined and non-empty, or XDG_SESSION_TYPE 85 | is 'wayland', which are the recommended ways to detect Wayland." 86 | (or (and (uiop:getenv "WAYLAND_DISPLAY") 87 | (not (string= (uiop:getenv "WAYLAND_DISPLAY") ""))) 88 | (string= (uiop:getenv "XDG_SESSION_TYPE") "wayland"))) 89 | 90 | (defun default-launch-options () 91 | "Return default launch options based on the environment. 92 | 93 | At the moment, we only need special options on Wayland" 94 | (if (wayland-p) 95 | +default-wayland-opts+ 96 | '())) 97 | 98 | (defmethod alive-p ((interface interface)) 99 | "Whether the INTERFACE's Electron process is running." 100 | (with-slots (process) interface 101 | (and process (uiop:process-alive-p process)))) 102 | 103 | (defmethod (setf protocols) (value (interface interface)) 104 | (if (alive-p interface) 105 | (error "Protocols need to be set before launching ~a." interface) 106 | (with-slots (protocols server-path) interface 107 | (setf protocols value)))) 108 | 109 | (defmethod interface-equal ((interface1 interface) (interface2 interface)) 110 | "Return non-nil when interfaces are equal." 111 | (let ((process1 (process interface1)) 112 | (process2 (process interface2))) 113 | (when (and process1 process2) 114 | (= (uiop:process-info-pid process1) 115 | (uiop:process-info-pid process2))))) 116 | 117 | (export-always '*interface*) 118 | (defvar *interface* nil) 119 | 120 | (export-always 'launch) 121 | (defun launch (&optional (interface *interface*)) 122 | (handler-case (server-running-p interface) 123 | (iolib/syscalls:enoent () nil) 124 | (iolib/syscalls:econnrefused () 125 | (warn "Sanitizing ~a before launch." 126 | (server-socket-path interface)) 127 | (uiop:delete-file-if-exists (server-socket-path interface))) 128 | (:no-error (_) 129 | (declare (ignore _)) 130 | (warn "Connection at ~a already established, nothing to do." 131 | (server-socket-path interface)) 132 | (return-from launch nil))) 133 | (let* ((appdir (uiop:getenv-pathname "APPDIR" :ensure-directory t)) 134 | (executable-command 135 | (if appdir 136 | (list "cl-electron-server") 137 | (list "npm" "run" "start" "--"))) 138 | (execution-directory 139 | (if appdir 140 | nil 141 | (asdf:system-source-directory :cl-electron))) 142 | (execution-launch-opts 143 | (or (launch-options interface) 144 | (default-launch-options)))) 145 | (setf (process interface) 146 | (uiop:launch-program 147 | (append executable-command 148 | execution-launch-opts 149 | (list (uiop:native-namestring (server-path interface)) 150 | (uiop:native-namestring (server-socket-path interface)) 151 | (register (protocols interface)))) 152 | :output :interactive 153 | :directory execution-directory 154 | :error-output :interactive))) 155 | ;; Block until the server is listening. 156 | (loop until (handler-case (server-running-p interface) 157 | (iolib/syscalls:enoent () (sleep 0.1))) 158 | finally (return t))) 159 | 160 | (defun create-socket-path (&key (interface *interface*) (id (new-id))) 161 | "Generate a new path suitable for a socket." 162 | (uiop:merge-pathnames* (sockets-directory interface) (format nil "~a.socket" id))) 163 | 164 | (defun create-socket (callback &key ready-semaphore (path (create-socket-path))) 165 | (unwind-protect 166 | (handler-case 167 | (iolib:with-open-socket (s :address-family :local 168 | :connect :passive 169 | :local-filename path) 170 | (isys:chmod path #o600) 171 | (when ready-semaphore (bt:signal-semaphore ready-semaphore)) 172 | (iolib:with-accept-connection (connection s) 173 | (loop for message = (ignore-errors (read-line connection nil)) 174 | for decoded-object = (cl-json:decode-json-from-string message) 175 | for callback-result = (funcall callback decoded-object) 176 | when (stringp callback-result) 177 | do (write-line (concatenate 'string callback-result "") 178 | connection) 179 | (finish-output connection)))) 180 | (iolib/syscalls:eaddrinuse () (warn "~a already in use." path))) 181 | (uiop:delete-file-if-exists path))) 182 | 183 | (defun create-socket-thread (callback &key ready-semaphore (interface *interface*)) 184 | (let* ((id (new-id)) 185 | (socket-path (uiop:native-namestring (create-socket-path :id id))) 186 | (socket-thread (bt:make-thread 187 | (lambda () 188 | (create-socket callback 189 | :path socket-path 190 | :ready-semaphore ready-semaphore)) 191 | :name (format nil "cl-electron-~a" id)))) 192 | (push socket-thread (socket-threads interface)) 193 | (values id socket-thread socket-path))) 194 | 195 | (defun create-node-socket-thread (callback &key (interface *interface*)) 196 | (let ((socket-ready-semaphore (bt:make-semaphore))) 197 | (multiple-value-bind (thread-id socket-thread socket-path) 198 | (create-socket-thread callback 199 | :ready-semaphore socket-ready-semaphore) 200 | (bt:wait-on-semaphore socket-ready-semaphore) 201 | (message 202 | interface 203 | (format nil "~a = new nodejs_net.connect('~a');" thread-id socket-path)) 204 | (values thread-id socket-thread socket-path)))) 205 | 206 | (defun create-node-synchronous-socket-thread (callback &key (interface *interface*)) 207 | "Caution: SynchronousSocket blocks Node.js and can lead to deadlocks." 208 | (let ((socket-ready-semaphore (bt:make-semaphore))) 209 | (multiple-value-bind (thread-id socket-thread socket-path) 210 | (create-socket-thread callback 211 | :ready-semaphore socket-ready-semaphore) 212 | (bt:wait-on-semaphore socket-ready-semaphore) 213 | (message 214 | interface 215 | (format nil "~a = new SynchronousSocket.SynchronousSocket('~a');" 216 | thread-id socket-path)) 217 | (message interface (format nil "~a.connect();" thread-id)) 218 | (values thread-id socket-thread socket-path)))) 219 | 220 | (defun destroy-thread* (thread) 221 | "Like `bt:destroy-thread' but does not raise an error. 222 | Particularly useful to avoid errors on already terminated threads." 223 | (ignore-errors (bt:destroy-thread thread))) 224 | 225 | (export-always 'terminate) 226 | (defun terminate (&optional (interface *interface*)) 227 | (when (or (not interface) (not (alive-p interface))) 228 | (warn "Already terminated, nothing to do.") 229 | (return-from terminate nil)) 230 | (mapcar #'destroy-thread* (socket-threads interface)) 231 | (uiop:terminate-process (process interface)) 232 | (setf (process interface) nil) 233 | t) 234 | 235 | (defun new-id () 236 | "Generate a new unique ID." 237 | (symbol-name (gensym "ID"))) 238 | 239 | (define-class remote-object () 240 | ((remote-symbol 241 | (new-id) 242 | :export t 243 | :reader t 244 | :writer nil 245 | :documentation "The internal variable name in the running `process'.") 246 | (interface 247 | *interface* 248 | :reader t 249 | :writer nil 250 | :type interface 251 | :documentation "The Electron `interface' the object will use for its whole lifetime.") 252 | (socket-threads 253 | '() 254 | :export t 255 | :documentation "A list of threads connected to sockets used by this object.")) 256 | (:export-class-name-p t) 257 | (:export-predicate-name-p t) 258 | (:export-accessor-names-p t) 259 | (:documentation "Represent objects living in Electron.")) 260 | 261 | (defmethod message ((interface interface) message-contents) 262 | (iolib:with-open-socket (s :address-family :local 263 | :remote-filename (uiop:native-namestring 264 | (server-socket-path interface))) 265 | (write-line message-contents s) 266 | (write-line "" s) 267 | (finish-output s) 268 | (read-line s))) 269 | 270 | (defmethod message ((remote-object remote-object) message-contents) 271 | (message (interface remote-object) message-contents)) 272 | 273 | (define-class view (remote-object) 274 | ((web-contents 275 | nil 276 | :export t 277 | :reader nil 278 | :writer t 279 | :type (or web-contents null) 280 | :documentation "The `web-contents' object bound to the view.") 281 | (options 282 | "" 283 | :export t 284 | :reader t 285 | :writer nil 286 | :type string 287 | :documentation "A string that specifies the views's behavior.")) 288 | (:export-class-name-p t) 289 | (:export-predicate-name-p t) 290 | (:export-accessor-names-p t) 291 | (:documentation "Embed additional web content into a `window'. 292 | It is like a child window, except that it is positioned relative to its owning 293 | window.")) 294 | 295 | (define-class window (remote-object) 296 | ((web-contents 297 | nil 298 | :export t 299 | :reader nil 300 | :writer t 301 | :type (or web-contents null) 302 | :documentation "The `web-contents' object bound to the window.") 303 | (options 304 | "{autoHideMenuBar: true}" 305 | :export t 306 | :reader t 307 | :writer nil 308 | :type string 309 | :documentation "A string that specifies the window's behavior.") 310 | (views 311 | nil 312 | :export t 313 | :type (or list-of-views null) 314 | :documentation "A list of `view's bound to window.")) 315 | (:export-class-name-p t) 316 | (:export-predicate-name-p t) 317 | (:export-accessor-names-p t) 318 | (:documentation "Create and control browser windows.")) 319 | 320 | (defun list-of-views-p (views) 321 | "Return non-nil when LIST is non-nil and elements are of type `view'." 322 | (and (consp views) (every #'viewp views))) 323 | 324 | (deftype list-of-views () 325 | '(and list (satisfies list-of-views-p))) 326 | 327 | (define-class web-contents (remote-object) 328 | ((session 329 | nil 330 | :export t 331 | :reader nil 332 | :writer t 333 | :type (or session null) 334 | :documentation "The `session' object bound to `web-contents'.")) 335 | (:export-class-name-p t) 336 | (:export-predicate-name-p t) 337 | (:export-accessor-names-p t) 338 | (:documentation "It is responsible for rendering and controlling a web page 339 | (via events).")) 340 | 341 | (define-class session (remote-object) 342 | ((download-items (make-hash-table :test 'equal))) 343 | (:export-class-name-p t) 344 | (:export-predicate-name-p t) 345 | (:export-accessor-names-p t) 346 | (:documentation "Manage browser sessions, cookies, cache, proxy settings, etc.")) 347 | 348 | (define-class extensions (remote-object) 349 | () 350 | (:export-class-name-p t) 351 | (:export-predicate-name-p t) 352 | (:export-accessor-names-p t) 353 | (:documentation "Manage browser extensions.")) 354 | 355 | (define-class extension (remote-object) 356 | () 357 | (:export-class-name-p t) 358 | (:export-predicate-name-p t) 359 | (:export-accessor-names-p t) 360 | (:documentation "Manage a single browser extension.")) 361 | 362 | (define-class download-item (remote-object) 363 | ((url "") 364 | (state "") 365 | (received-bytes 0) 366 | (total-bytes 0) 367 | (percent-complete 0) 368 | (save-path "")) 369 | (:export-class-name-p t) 370 | (:export-predicate-name-p t) 371 | (:export-accessor-names-p t) 372 | (:documentation "Represents a download item.")) 373 | 374 | (define-class protocol (remote-object) 375 | ((scheme-name 376 | "" 377 | :export t 378 | :reader t 379 | :writer nil 380 | :type string 381 | :documentation "Custom scheme name to handle. 382 | HTTPS is an example of a scheme.") 383 | (privileges 384 | "{standard:true,secure:true,supportFetchAPI:true}" 385 | :export t 386 | :reader t 387 | :writer nil 388 | :type string 389 | :documentation "A string that specifies the scheme's privileges. 390 | See https://www.electronjs.org/docs/latest/api/structures/custom-scheme.")) 391 | (:export-class-name-p t) 392 | (:export-predicate-name-p t) 393 | (:export-accessor-names-p t) 394 | (:documentation "Define custom protocols and intercept existing protocol requests.")) 395 | 396 | (defun list-of-protocols-p (list) 397 | "Return non-nil when LIST is non-nil and elements are of type `protocol'." 398 | (and (consp list) (every #'protocolp list))) 399 | 400 | (deftype list-of-protocols () 401 | '(and list (satisfies list-of-protocols-p))) 402 | 403 | (defun register (protocols) 404 | "Internal function, see the SETF method of `protocols' for the user-facing API." 405 | (declare (type (or list-of-protocols null) protocols)) 406 | (if protocols 407 | (format nil "protocol.registerSchemesAsPrivileged([~{{scheme:'~a',privileges:~a}~^, ~}]);" 408 | (loop for protocol in protocols 409 | collect (scheme-name protocol) 410 | collect (privileges protocol))) 411 | "")) 412 | 413 | (export-always 'format-listener) 414 | (defun format-listener (object event-name callback-string &key once-p) 415 | "Encoding helper for `add-listener'." 416 | (format nil "~a.~a('~(~a~)', ~a)" 417 | (remote-symbol object) 418 | (if once-p "once" "on") 419 | event-name 420 | callback-string)) 421 | 422 | (export-always 'add-listener) 423 | (defgeneric add-listener (object event-name callback &key once-p) 424 | (:method (object (event-name symbol) (callback function) &key once-p) 425 | (multiple-value-bind (thread-id socket-thread socket-path) 426 | (create-node-socket-thread (lambda (_) (declare (ignore _)) 427 | (funcall callback object)) 428 | :interface (interface object)) 429 | (declare (ignore socket-path)) 430 | (push socket-thread (socket-threads object)) 431 | (message 432 | object 433 | (format-listener object 434 | event-name 435 | ;; Send dummy JSON data to trigger the callback. 436 | (format nil "() => {~a.write(`${JSON.stringify('')}\\n`)}" 437 | thread-id) 438 | :once-p once-p)) 439 | socket-thread)) 440 | (:documentation "Register CALLBACK for OBJECT on event EVENT-NAME. 441 | 442 | Since the argument signature of callbacks differs depending on the event, 443 | methods must specialize on EVENT-NAME. The general implementation assumes a 444 | callback that takes OBJECT as its sole argument. 445 | 446 | The callback is added to the end of the listeners array, without checking 447 | whether it has already been added. Callbacks are invoked in the order that they 448 | were added. When ONCE-P is non-nil, the callback runs once.")) 449 | 450 | (defmethod add-listener ((object remote-object) 451 | (event (eql :before-input-event)) 452 | (callback function) 453 | &key once-p) 454 | (declare (ignore once-p)) 455 | (multiple-value-bind (thread-id socket-thread socket-path) 456 | (create-node-synchronous-socket-thread 457 | (lambda (input) 458 | (cl-json:encode-json-to-string 459 | (list (cons "preventDefault" 460 | (apply callback (cons object 461 | input)))))) 462 | :interface (interface object)) 463 | (declare (ignore socket-path)) 464 | (push socket-thread (socket-threads object)) 465 | (message 466 | object 467 | (format-listener (if (web-contents-p object) object (web-contents object)) 468 | event 469 | (format nil 470 | "(event, input) => { 471 | ~a.write(JSON.stringify([ input ]) + '\\\n'); 472 | response = ~a.read(); 473 | if (JSON.parse(response.toString()).preventDefault) { 474 | event.preventDefault(); 475 | } 476 | }" 477 | thread-id 478 | thread-id))))) 479 | --------------------------------------------------------------------------------