;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; CLOG - The Common Lisp Omnificent GUI ;;;; ;;;; (c) 2020-2022 David Botton ;;;; ;;;; License BSD 3 Clause ;;;; ;;;; ;;;; ;;;; clog-document.lisp ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (cl:in-package :clog) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Implementation - clog-document ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defclass clog-document (clog-obj) ((document-element :reader document-element :initarg :document-element) (head-element :reader head-element :initarg :head-element) (body-element :reader body-element)) (:documentation "CLOG Document Objects encapsulate the document.")) ;;;;;;;;;;;;;;;;;;;;;;;; ;; make-clog-document ;; ;;;;;;;;;;;;;;;;;;;;;;;; (defun make-clog-document (connection-id) "Construct a new clog-document. (Private)" (make-instance 'clog-document :connection-id connection-id :html-id "document" :document-element (make-instance 'clog-element :connection-id connection-id :html-id "documentElement") :head-element (make-instance 'clog-element :connection-id connection-id :html-id "head"))) ;;;;;;;;;;;;;;;;;;;;;; ;; document-element ;; ;;;;;;;;;;;;;;;;;;;;;; (defgeneric document-element (clog-document) (:documentation "Reader for Document Element object")) ;;;;;;;;;;;;;;;;;; ;; head-element ;; ;;;;;;;;;;;;;;;;;; (defgeneric head-element (clog-document) (:documentation "Reader for Head Element object")) ;;;;;;;;;;;;;;;;;; ;; body-element ;; ;;;;;;;;;;;;;;;;;; (defgeneric document-element (clog-document) (:documentation "Reader for Body Element object")) ;;;;;;;;;;;;;; ;; set-body ;; ;;;;;;;;;;;;;; (defgeneric set-body (clog-document body) (:documentation "Set the body slot after creating the clog-document object. (Private)")) (defmethod set-body ((obj clog-document) body) (setf (slot-value obj 'body-element) body)) ;;;;;;;;;;;; ;; domain ;; ;;;;;;;;;;;; (defgeneric domain (clog-document) (:documentation "Get domain.")) (defmethod domain ((obj clog-document)) (query obj "domain")) ;;;;;;;;;;;;;;;;;;;; ;; input-encoding ;; ;;;;;;;;;;;;;;;;;;;; (defgeneric input-encoding (clog-document) (:documentation "Get input encoding.")) (defmethod input-encoding ((obj clog-document)) (query obj "inputEncoding")) ;;;;;;;;;;;;;;;;;;; ;; last-modified ;; ;;;;;;;;;;;;;;;;;;; (defgeneric last-modified (clog-document) (:documentation "Get last modified.")) (defmethod last-modified ((obj clog-document)) (query obj "lastModified")) ;;;;;;;;;;;;; ;; referer ;; ;;;;;;;;;;;;; (defgeneric referer (clog-document) (:documentation "Get referer.")) (defmethod referer ((obj clog-document)) (query obj "referer")) ;;;;;;;;;;; ;; title ;; ;;;;;;;;;;; (defgeneric title (clog-document) (:documentation "Get/setf title.")) (defmethod title ((obj clog-document)) (query obj "title")) (defgeneric set-title (clog-document value)) (defmethod set-title ((obj clog-document) value) (execute obj (format nil "title='~A'" (clog-connection:escape-string value))) value) (defsetf title set-title) ;;;;;;;;;;;;;;;;;; ;; document-url ;; ;;;;;;;;;;;;;;;;;; (defgeneric document-url (clog-document) (:documentation "Get url.")) (defmethod document-url ((obj clog-document)) (query obj "url")) ;;;;;;;;;;;;;;;;; ;; ready-state ;; ;;;;;;;;;;;;;;;;; (defgeneric ready-state (clog-document) (:documentation "Get ready-state.")) (defmethod ready-state ((obj clog-document)) (query obj "readyState")) ;;;;;;;;;;;;;; ;; load-css ;; ;;;;;;;;;;;;;; (defgeneric load-css (clog-document css-url) (:documentation "Load css from CSS-URL.")) (defmethod load-css ((obj clog-document) css-url) (jquery-execute (head-element obj) (format nil "append('')" (escape-string css-url)))) ;;;;;;;;;;;;;;;;; ;; load-script ;; ;;;;;;;;;;;;;;;;; (defgeneric load-script (clog-document script-url) (:documentation "Load script from SCRIPT-URL.")) (defmethod load-script ((obj clog-document) script-url) ;; After we load the script from src we then fire the ;; custom on-load-script event in the next line of ;; script after the load as scripts are loaded ;; synchronously. (Jquery-execute (head-element obj) (format nil "append('~ ')" (escape-string script-url) (escape-string script-url)))) ;;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-load-script ;; ;;;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-load-script (clog-document handler &key cancel-event one-time) (:documentation "Set a HANDLER for script load complete on CLOG-document. the handler (clog-obj data) data is the script-url used to load it. The handler should be installed on the document before calling load-script.")) (defmethod set-on-load-script ((obj clog-document) handler &key (cancel-event nil) (one-time nil)) (set-event obj "on-load-script" (when handler (lambda (data) (funcall handler obj data))) :call-back-script "+data" :cancel-event cancel-event :one-time one-time)) ;;;;;;;;; ;; put ;; ;;;;;;;;; (defgeneric put (clog-document message) (:documentation "Write text to browser document object.")) (defmethod put ((obj clog-document) message) (execute obj (format nil "write('~A')" (escape-string message)))) ;;;;;;;;;;;;;; ;; put-line ;; ;;;;;;;;;;;;;; (defgeneric put-line (clog-document message) (:documentation "Write text to browser document object with new-line.")) (defmethod put-line ((obj clog-document) message) (execute obj (format nil "writeln('~A')" (escape-string message)))) ;;;;;;;;;;;; ;; put-br ;; ;;;;;;;;;;;; (defgeneric put-br (clog-document message) (:documentation "Write text to browser document object with <\br>new-line.")) (defmethod put-br ((obj clog-document) message) (execute obj (format nil "writeln('~A<\br>')" (escape-string message)))) ;;;;;;;;;;;;;; ;; new-line ;; ;;;;;;;;;;;;;; (defgeneric new-line (clog-document) (:documentation "Write to browser document <\br>new-line.")) (defmethod new-line ((obj clog-document)) (execute obj (format nil "writeln('<\br>')"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-full-screen-change ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-full-screen-change (clog-document on-full-screen-change-handler) (:documentation "Set the ON-FULL-SCREEN-CHANGE-HANDLER for CLOG-OBJ. If ON-FULL-SCREEN-CHANGE-HANDLER is nil unbind the event.")) (defmethod set-on-full-screen-change ((obj clog-document) handler) (set-on-event obj "fullscreenchange" handler))