From 5589cde8973b52043fdabd367d07ca115fd176c9 Mon Sep 17 00:00:00 2001 From: David Botton Date: Thu, 24 Dec 2020 21:29:42 -0500 Subject: [PATCH] Flesh out the DOM structure --- clog-base.lisp | 3 +- clog-body.lisp | 72 +++++++++++++++++++++++++++++++++++++++++ clog-document.lisp | 25 ++++++++++++++ clog-location.lisp | 25 ++++++++++++++ clog-navigator.lisp | 25 ++++++++++++++ clog-system.lisp | 6 ++-- clog-window.lisp | 53 ++++++++++++++++++++++++++++++ clog.asd | 7 +++- clog.lisp | 50 ++++++++++++++++++++++++++-- static-files/js/boot.js | 6 ++++ test/test-clog.lisp | 4 ++- 11 files changed, 267 insertions(+), 9 deletions(-) create mode 100644 clog-body.lisp create mode 100644 clog-document.lisp create mode 100644 clog-location.lisp create mode 100644 clog-navigator.lisp create mode 100644 clog-window.lisp diff --git a/clog-base.lisp b/clog-base.lisp index e8f78ad..c68f7ec 100644 --- a/clog-base.lisp +++ b/clog-base.lisp @@ -35,8 +35,7 @@ lisp and the HTML DOM element.")) (defun make-clog-obj (connection-id html-id) "Construct a new clog-obj. (Private)" - (make-instance 'clog-obj :connection-id connection-id - :html-id html-id)) + (make-instance 'clog-obj :connection-id connection-id :html-id html-id)) ;;;;;;;;;;;;;;; ;; script-id ;; diff --git a/clog-body.lisp b/clog-body.lisp new file mode 100644 index 0000000..bc266cd --- /dev/null +++ b/clog-body.lisp @@ -0,0 +1,72 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; CLOG - The Common Lisp Omnificent GUI ;;;; +;;;; (c) 2020-2021 David Botton ;;;; +;;;; License BSD 3 Clause ;;;; +;;;; ;;;; +;;;; clog-window.lisp ;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl:in-package :clog) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Implementation - clog-body +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass clog-body (clog-obj) + ((window + :reader window + :initarg :window) + (document + :reader html-document + :initarg :document) + (location + :reader location + :initarg :location) + (navigator + :reader navigator + :initarg :navigator)) + (:documentation "CLOG Body Object encapsulate the view in the window.")) + +;;;;;;;;;;;;;;;;;;;;;; +;; make-clog-window ;; +;;;;;;;;;;;;;;;;;;;;;; + +(defun make-clog-body (connection-id) + "Construct a new clog-body object." + (make-instance + 'clog-body + :connection-id connection-id :html-id 0 + :window (make-instance 'clog-window :connection-id connection-id) + :window (make-instance 'clog-document :connection-id connection-id) + :window (make-instance 'clog-location :connection-id connection-id) + :window (make-instance 'clog-navigator :connection-id connection-id))) + +;;;;;;;;;;;; +;; window ;; +;;;;;;;;;;;; + +(defgeneric window (clog-body) + (:documentation "Reader for CLOG-Window object")) + +;;;;;;;;;;;;;; +;; document ;; +;;;;;;;;;;;;;; + +(defgeneric html-document (clog-body) + (:documentation "Reader for CLOG-Document object")) + +;;;;;;;;;;;;;; +;; location ;; +;;;;;;;;;;;;;; + +(defgeneric location (clog-body) + (:documentation "Reader for CLOG-Location object")) + +;;;;;;;;;;;;;;; +;; navigator ;; +;;;;;;;;;;;;;;; + +(defgeneric navigator (clog-body) + (:documentation "Reader for CLOG-Navigator object")) + diff --git a/clog-document.lisp b/clog-document.lisp new file mode 100644 index 0000000..2736e76 --- /dev/null +++ b/clog-document.lisp @@ -0,0 +1,25 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; CLOG - The Common Lisp Omnificent GUI ;;;; +;;;; (c) 2020-2021 David Botton ;;;; +;;;; License BSD 3 Clause ;;;; +;;;; ;;;; +;;;; clog-document.lisp ;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl:in-package :clog) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Implementation - clog-document +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass clog-document (clog-obj)() + (: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")) diff --git a/clog-location.lisp b/clog-location.lisp new file mode 100644 index 0000000..21712a9 --- /dev/null +++ b/clog-location.lisp @@ -0,0 +1,25 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; CLOG - The Common Lisp Omnificent GUI ;;;; +;;;; (c) 2020-2021 David Botton ;;;; +;;;; License BSD 3 Clause ;;;; +;;;; ;;;; +;;;; clog-location.lisp ;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl:in-package :clog) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Implementation - clog-location +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass clog-location (clog-obj)() + (:documentation "CLOG Location Objects encapsulate the location.")) + +;;;;;;;;;;;;;;;;;;;;;;;; +;; make-clog-location ;; +;;;;;;;;;;;;;;;;;;;;;;;; + +(defun make-clog-location (connection-id) + "Construct a new clog-location. (Private)" + (make-instance 'clog-location :connection-id connection-id :html-id "location")) diff --git a/clog-navigator.lisp b/clog-navigator.lisp new file mode 100644 index 0000000..6fda600 --- /dev/null +++ b/clog-navigator.lisp @@ -0,0 +1,25 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; CLOG - The Common Lisp Omnificent GUI ;;;; +;;;; (c) 2020-2021 David Botton ;;;; +;;;; License BSD 3 Clause ;;;; +;;;; ;;;; +;;;; clog-navigator.lisp ;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl:in-package :clog) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Implementation - clog-navigator +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass clog-navigator (clog-obj)() + (:documentation "CLOG Navigator Objects encapsulate the navigator.")) + +;;;;;;;;;;;;;;;;;;;;;;;;; +;; make-clog-navigator ;; +;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun make-clog-navigator (connection-id) + "Construct a new clog-navigator. (Private)" + (make-instance 'clog-navigator :connection-id connection-id :html-id "navigator")) diff --git a/clog-system.lisp b/clog-system.lisp index fcfe3cb..968c0ee 100644 --- a/clog-system.lisp +++ b/clog-system.lisp @@ -19,10 +19,10 @@ (defvar *on-new-window* nil "Store the on-new-window handler") -(defun on-connect (id) +(defun on-connect (connection-id) (when cc:*verbose-output* - (format t "Start new window handler on connection-id - ~A" id)) - (let ((body (make-clog-obj id 0))) + (format t "Start new window handler on connection-id - ~A" connection-id)) + (let ((body (make-clog-body connection-id))) (funcall *on-new-window* body))) (defun initialize (on-new-window diff --git a/clog-window.lisp b/clog-window.lisp new file mode 100644 index 0000000..2e7a1c4 --- /dev/null +++ b/clog-window.lisp @@ -0,0 +1,53 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; CLOG - The Common Lisp Omnificent GUI ;;;; +;;;; (c) 2020-2021 David Botton ;;;; +;;;; License BSD 3 Clause ;;;; +;;;; ;;;; +;;;; clog-window.lisp ;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl:in-package :clog) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Implementation - clog-window +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass clog-window (clog-obj)() + (:documentation "CLOG Window Objects encapsulate the window.")) + +;;;;;;;;;;;;;;;;;;;;;; +;; make-clog-window ;; +;;;;;;;;;;;;;;;;;;;;;; + +(defun make-clog-window (connection-id) + "Construct a new clog-window. (Private)" + (make-instance 'clog-window :connection-id connection-id :html-id "window")) + +;;;;;;;;;;;;;;;;; +;; window-name ;; +;;;;;;;;;;;;;;;;; + +(defgeneric window-name (clog-window) + (:documentation "Get/Setf name for use by hyperlink \"target\" for this +window.")) + +(defmethod window-name ((obj clog-window)) + (property obj "name")) + +(defgeneric set-window-name (clog-window value)) + +(defmethod set-window-name ((obj clog-window) value) + (setf (property obj "name") value)) +(defsetf window-name set-window-name) + +;;;;;;;;;;; +;; alert ;; +;;;;;;;;;;; + +(defgeneric alert (clog-window message) + (:documentation "Launch an alert box. Note that as long as not dismissed +events and messages may not be trasmitted on most browsers.")) + +(defmethod alert ((obj clog-window) message) + (cc:alert-box (connection-id obj) message)) diff --git a/clog.asd b/clog.asd index e5166d1..b8f408e 100644 --- a/clog.asd +++ b/clog.asd @@ -15,4 +15,9 @@ (:file "clog") (:file "clog-system") (:file "clog-utilities") - (:file "clog-base"))) + (:file "clog-base") + (:file "clog-window") + (:file "clog-document") + (:file "clog-location") + (:file "clog-navigator") + (:file "clog-body"))) diff --git a/clog.lisp b/clog.lisp index 8c2fb1f..efa068b 100644 --- a/clog.lisp +++ b/clog.lisp @@ -29,7 +29,12 @@ application." (@clog-system section) (@clog-utilities section) - (@clog-objs section)) + (@clog-obj section) + (@clog-body section) + (@clog-window section) + (@clog-document section) + (@clog-location section) + (@clog-navigator section)) (defsection @clog-system (:title "CLOG System") "CLOG Startup and Shutdown" @@ -41,7 +46,7 @@ application." (js-true-p function) (open-browser function)) -(defsection @clog-objs (:title "CLOG Objects") +(defsection @clog-obj (:title "CLOG Objects") "CLOG-Obj - Base class for CLOG Objects" (clog-obj class) @@ -102,11 +107,52 @@ application." (set-on-paste generic-function)) ;; need to add drag and drop events +(defsection @clog-body (:title "CLOG Body Objects") + "CLOG-Body - CLOG Body Objects" + (clog-body class) + + "CLOG-Body - Properties" + (window generic-function) + (html-document generic-function) + (location generic-function) + (navigator generic-function)) + +(defsection @clog-window (:title "CLOG Window Objects") + "CLOG-Window - CLOG Window Objects" + (clog-window class) + + "CLOG-Window - Properties" + (window-name generic-function) + + "CLOG-Window - Methods" + (alert generic-function)) + +(defsection @clog-document (:title "CLOG Document Objects") + "CLOG-Document - CLOG Document Objects" + (clog-document class)) + +(defsection @clog-location (:title "CLOG Location Objects") + "CLOG-Location - CLOG Location Objects" + (clog-location class)) + +(defsection @clog-navigator (:title "CLOG Navigator Objects") + "CLOG-Navigator - CLOG Navigator Objects" + (clog-navigator class)) + +(defsection @clog-location (:title "CLOG Location Objects") + "CLOG-Location - CLOG Location Objects" + (clog-location class)) + (export 'make-markup) (defun make-markup () (load "clog.lisp") (load "clog-base.lisp") + (load "clog-window.lisp") + (load "clog-navigator.lisp") + (load "clog-document.lisp") + (load "clog-location.lisp") (load "clog-system.lisp") (load "clog-utilities.lisp") + (load "clog-body.lisp") (describe clog:@CLOG-MANUAL)) diff --git a/static-files/js/boot.js b/static-files/js/boot.js index 0d9acdb..9625a4c 100644 --- a/static-files/js/boot.js +++ b/static-files/js/boot.js @@ -72,6 +72,12 @@ $( document ).ready(function() { var s = document.location.search; var tokens; var r = /[?&]?([^=]+)=([^&]*)/g; + + clog['body']=document.body; + clog['window']=window; + clog['navigator']=navigator; + clog['document']=window.document; + clog['location']=window.location; s = s.split("+").join(" "); diff --git a/test/test-clog.lisp b/test/test-clog.lisp index aa9570e..8c018ce 100644 --- a/test/test-clog.lisp +++ b/test/test-clog.lisp @@ -5,8 +5,10 @@ (in-package :test-clog) (defvar *last-obj*) +(defvar *last-win*) (defun on-new-window (win) + (setf *last-win* win) (let ((tmp)) (clog-connection:put-line (clog::connection-id win) "") (setf tmp (attach-as-child win "myid")) @@ -15,7 +17,7 @@ (when (equal (property tmp "draggable") (setf (property tmp "innerHTML") "

I am draggable

"))) (setf tmp (create-child win "