Real clipboard use and navigation prevention

This commit is contained in:
David Botton 2021-02-16 10:13:40 -05:00
parent a446e5b2c7
commit 1e920510ea
2 changed files with 34 additions and 7 deletions

View file

@ -423,8 +423,9 @@ is nil unbind the event."))
;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgeneric set-on-before-unload (clog-window on-before-unload-handler) (defgeneric set-on-before-unload (clog-window on-before-unload-handler)
(:documentation "Set the ON-BEFORE-UNLOAD-HANDLER for CLOG-OBJ. If (:documentation "Set the ON-BEFORE-UNLOAD-HANDLER for CLOG-WINDOW.
ON-BEFORE-UNLOAD-HANDLER is nil unbind the event.")) Return and empty string in order to prevent navigation off page.
If ON-BEFORE-UNLOAD-HANDLER is nil unbind the event."))
(defmethod set-on-before-unload ((obj clog-window) handler) (defmethod set-on-before-unload ((obj clog-window) handler)
(set-event obj "beforeunload" (set-event obj "beforeunload"

View file

@ -154,12 +154,29 @@
(sleep 2) (sleep 2)
(setf (window-title cw) fname)))) (setf (window-title cw) fname))))
(defun do-ide-edit-undo (obj)
(let ((cw (current-window obj)))
(when cw
(do-ide-edit-copy obj)
(js-execute obj (format nil "editor_~A.execCommand('undo')"
(html-id cw))))))
(defun do-ide-edit-redo (obj)
(let ((cw (current-window obj)))
(when cw
(do-ide-edit-copy obj)
(js-execute obj (format nil "editor_~A.execCommand('redo')"
(html-id cw))))))
(defun do-ide-edit-copy (obj) (defun do-ide-edit-copy (obj)
(let ((cw (current-window obj))) (let ((cw (current-window obj)))
(when cw (when cw
(let* ((app (connection-data-item obj "app-data"))) (let* ((app (connection-data-item obj "app-data")))
(setf (copy-buf app) (js-query obj (format nil "editor_~A.getCopyText();" (setf (copy-buf app) (js-query obj
(html-id cw)))))))) (format nil "editor_~A.execCommand('copy');~
navigator.clipboard.writeText(editor_~A.getCopyText());~
editor_~A.getCopyText();"
(html-id cw) (html-id cw) (html-id cw))))))))
(defun do-ide-edit-cut (obj) (defun do-ide-edit-cut (obj)
(let ((cw (current-window obj))) (let ((cw (current-window obj)))
@ -172,9 +189,12 @@
(let ((cw (current-window obj))) (let ((cw (current-window obj)))
(when cw (when cw
(let ((app (connection-data-item obj "app-data"))) (let ((app (connection-data-item obj "app-data")))
(js-execute obj (format nil "editor_~A.execCommand('paste', '~A')" ;; Note this methods uses the global clip buffer and not (copy-buf app)
(html-id cw) ;; on copy and paste we set both the global and local buffer.
(escape-string (copy-buf app)))))))) (js-execute obj (format nil "navigator.clipboard.readText().then(function(text) {~
editor_~A.execCommand('paste', text)~
})"
(html-id cw)))))))
(defun do-ide-lisp-eval-file (obj) (defun do-ide-lisp-eval-file (obj)
(let ((cw (current-window obj))) (let ((cw (current-window obj)))
@ -225,6 +245,8 @@
(create-gui-menu-item file :content "Open" :on-click #'do-ide-file-open) (create-gui-menu-item file :content "Open" :on-click #'do-ide-file-open)
(create-gui-menu-item file :content "Save" :on-click #'do-ide-file-save) (create-gui-menu-item file :content "Save" :on-click #'do-ide-file-save)
(create-gui-menu-item file :content "Save As" :on-click #'do-ide-file-save-as) (create-gui-menu-item file :content "Save As" :on-click #'do-ide-file-save-as)
(create-gui-menu-item edit :content "Undo" :on-click #'do-ide-edit-undo)
(create-gui-menu-item edit :content "Redo" :on-click #'do-ide-edit-redo)
(create-gui-menu-item edit :content "Copy" :on-click #'do-ide-edit-copy) (create-gui-menu-item edit :content "Copy" :on-click #'do-ide-edit-copy)
(create-gui-menu-item edit :content "Cut" :on-click #'do-ide-edit-cut) (create-gui-menu-item edit :content "Cut" :on-click #'do-ide-edit-cut)
(create-gui-menu-item edit :content "Paste" :on-click #'do-ide-edit-paste) (create-gui-menu-item edit :content "Paste" :on-click #'do-ide-edit-paste)
@ -234,6 +256,10 @@
(create-gui-menu-window-select wind) (create-gui-menu-window-select wind)
(create-gui-menu-item help :content "About" :on-click #'do-ide-help-about) (create-gui-menu-item help :content "About" :on-click #'do-ide-help-about)
(create-gui-menu-full-screen menu)) (create-gui-menu-full-screen menu))
(set-on-before-unload (window body) (lambda(obj)
;; return empty string to prevent nav off page
""))
(run body)) (run body))
(defun start-demo () (defun start-demo ()