mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2026-01-03 07:42:32 -08:00
Code Issues Projects Releases Wiki Activity

clipboard functions

Browse source
This commit is contained in:
David Botton 2022-06-23 21:54:58 -04:00
parent 50bedfbee8
commit 7f9eac1fde
2 changed files with 37 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

32
source/clog-navigator.lisp
View file

@ -62,3 +62,35 @@
(defmethod vendor ((obj clog-navigator))
(query obj "vendor"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; system-clipboard-write ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgeneric system-clipboard-write (clog-obj text)
(:documentation "Write text to system clipboard"))
(defmethod system-clipboard-write ((obj clog-obj) text)
(js-execute obj (format nil "navigator.clipboard.writeText('~A')"
(escape-string text))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; system-clipboard-read ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgeneric system-clipboard-read (clog-obj &key wait-timeout)
(:documentation "Read text from system clipboard and return text."))
(defmethod system-clipboard-read ((obj clog-obj) &key (wait-timeout 1))
(let ((doc (html-document (connection-body obj)))
(sem (bordeaux-threads:make-semaphore))
ret)
(flet ((on-data (obj data)
(declare (ignore obj))
(bordeaux-threads:signal-semaphore sem)
(setf ret data)))
(set-on-event-with-data doc "on-clip-data" #'on-data :one-time t)
(js-execute obj "navigator.clipboard.readText().then(function(text) {~
$(clog['document']).trigger('on-clip-data', text)})")
(bordeaux-threads:wait-on-semaphore sem :timeout wait-timeout)
ret)))

6
source/clog.lisp
View file

@ -922,7 +922,11 @@ embedded in a native template application.)"
(cookie-enabled-p generic-function)
(language generic-function)
(user-agent generic-function)
(vendor generic-function))
(vendor generic-function)
"CLOG-Navigator - Clipboard"
(system-clipboard-write generic-function)
(system-clipboard-read generic-function))
(defsection @clog-location (:title "CLOG Location Objects")
"Clog-Location - CLOG Location Objects"