Flesh out the DOM structure

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
+  (make-instance 'clog-obj :connection-id connection-id :html-id html-id))
-			   :html-id html-id))
 
 ;;;;;;;;;;;;;;;
 ;; script-id ;;

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"))
+

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"))

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"))

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"))

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))
+    (format t "Start new window handler on connection-id - ~A" connection-id))
-  (let ((body (make-clog-obj id 0)))
+  (let ((body (make-clog-body connection-id)))
     (funcall *on-new-window* body)))
     
 (defun initialize (on-new-window

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))

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")))

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))
   

static-files/js/boot.js

@@ -73,6 +73,12 @@ $( document ).ready(function() {
     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(" ");
     
     while (tokens = r.exec(s)) {

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) "<button id='myid'>In html</button>")
     (setf tmp (attach-as-child win "myid"))
@@ -15,7 +17,7 @@
     (when (equal (property tmp "draggable")
 		 (setf (property tmp "innerHTML") "<h2>I am draggable</h2>")))
     (setf tmp (create-child win "<button>test</botton>"))
-    (set-on-click tmp (lambda () (clog-connection:alert-box (clog::connection-id win) "clicked")))
+    (set-on-click tmp (lambda () (alert (window win) "clicked")))
     (setf (width tmp) 300)
     (setf (height tmp) 50)
     (create-child win (format nil "<H2>~A</H2>" (gethash "connection-id" (connection-data win))))