diff --git a/base/macros/source/define-object.lisp b/base/macros/source/define-object.lisp
index 3d23a8606de14faaabdc1d5406bf829b8a534a52..b3f02b0097967e444c75f9a7b20336c8afe0e4c4 100755
--- a/base/macros/source/define-object.lisp
+++ b/base/macros/source/define-object.lisp
@@ -750,7 +750,8 @@ overview of define-object syntax."
(defun make-standard-slots ()
`((gdl-acc::%version-tree% :accessor gdl-acc::%version-tree% :initform nil)
(gdl-acc::%toplevel-inputs% :accessor gdl-acc::%toplevel-inputs% :initform nil :initarg :%toplevel-inputs%)
- (gdl-acc::%root% :accessor gdl-acc::%root% :initform nil :initarg :%root%)))
+ (gdl-acc::%root% :accessor gdl-acc::%root% :initform nil :initarg :%root%)
+ (gdl-acc::%god-parents% :accessor gdl-acc::%god-parents% :initform nil :initarg :%god-parents%)))
(defun first-symbol (list)
diff --git a/base/rest/source/make-part.lisp b/base/rest/source/make-part.lisp
index 304962a84a6a11cbacbb1074996c6a2881ec42af..d571bcd92e4451c48e9d37619966c0085d221cfa 100755
--- a/base/rest/source/make-part.lisp
+++ b/base/rest/source/make-part.lisp
@@ -74,16 +74,20 @@ The argument ~s, and its value ~s, have been ignored
:arguments (object-name \"Symbol. Should name a GDL object type.\"
arguments \"spliced-in plist. A plist of keyword symbols and values for initial input-slots.\")"
+
+
(let (*notify-cons*
(keys (plist-keys args))
(vals (plist-values args)))
(let ((object (apply #'make-instance
object-type
- :allow-other-keys t
+ :allow-other-keys t ;; FLAG -- tell me again why we should allow other keys?
(append (list :%name% (list (format nil "~a" object-type) nil t)
- :%parent% (list nil nil t))
+ :%parent% (list nil nil t)
+ :%god-parents% (getf args :god-parents))
(mapcan #'(lambda(key val)
- (list key (list val nil t)))
+ (unless (eql key :god-parents)
+ (list key (list val nil t))))
keys vals)))))
(setf (gdl-acc::%root% object) object
diff --git a/base/rest/source/quantification.lisp b/base/rest/source/quantification.lisp
index 40dc8470cf9e374aab9eec9873fcfc4ab4fa97b4..762e85abdcffc9dccb00af0669e809aea98bf067 100755
--- a/base/rest/source/quantification.lisp
+++ b/base/rest/source/quantification.lisp
@@ -28,7 +28,9 @@
extra parentheses around the message in the reference chain and using the index number. But the aggregate itself also supports certain
messages, documented here. One message, number-of-elements, is not listed in the normal messages section because it is
internal. It can be used, and returns an integer representing the cardinality of the aggregate.")
-
+ :input-slots
+ ((remember-children? nil))
+
:computed-slots
((index nil)
diff --git a/base/rest/source/vanilla-mixin.lisp b/base/rest/source/vanilla-mixin.lisp
index 55f86eb3a0b3c2a17fc4bc9630d3d1f1856aae4c..d2444400214528150ee1b4bd61b69407f6b4e030 100644
--- a/base/rest/source/vanilla-mixin.lisp
+++ b/base/rest/source/vanilla-mixin.lisp
@@ -36,7 +36,7 @@ toplevel of the define-object form.")
:input-slots
(
-
+
(remote-id nil :settable)
(quantify-box (or (the parent) self))
@@ -99,7 +99,7 @@ nil "~a~a~a" (the :name-for-display)
:computed-slots
- (
+ ((remember-children? nil)
(%corners% nil)
(%vertex-array% nil)
@@ -388,41 +388,41 @@ or all mixins from the entire inheritance hierarchy.\")"
:arguments (slot \"Keyword Symbol\")
:key (force? \"Boolean. Specify as t if you want to force non-settable slots to recompute (e.g.
reading from databases or external files). Defaults to nil.\")"
- restore-slot-default!
- (attribute &key (force? *force-restore-slot-default?*))
- (when (or force? (eql (the (slot-status attribute)) :set))
- (let (*leaf-resets*)
- (let ((slot (glisp:intern (symbol-name attribute) :gdl-acc)))
- (unless (eq (first (ensure-list (slot-value self slot))) 'gdl-rule::%unbound%)
- (unbind-dependent-slots self slot)
- (setf (slot-value self slot)
- (if *remember-previous-slot-values?*
- (list 'gdl-rule::%unbound% nil nil (first (slot-value self slot)))
- 'gdl-rule::%unbound%))))
- (let ((root (let ((maybe-root (the :root)))
- (if (the-object maybe-root root?)
- maybe-root
- (the-object maybe-root parent))))
+ restore-slot-default!
+ (attribute &key (force? *force-restore-slot-default?*))
+ (when (or force? (eql (the (slot-status attribute)) :set))
+ (let (*leaf-resets*)
+ (let ((slot (glisp:intern (symbol-name attribute) :gdl-acc)))
+ (unless (eq (first (ensure-list (slot-value self slot))) 'gdl-rule::%unbound%)
+ (unbind-dependent-slots self slot)
+ (setf (slot-value self slot)
+ (if (or *remember-previous-slot-values?* (the remember-children?))
+ (list 'gdl-rule::%unbound% nil nil (first (slot-value self slot)))
+ 'gdl-rule::%unbound%))))
+ (let ((root (let ((maybe-root (the :root)))
+ (if (the-object maybe-root root?)
+ maybe-root
+ (the-object maybe-root parent))))
- ;;(root-path (remove :root-object-object (the root-path)))
- (root-path (the root-path))
+ ;;(root-path (remove :root-object-object (the root-path)))
+ (root-path (the root-path))
- )
- ;;
- ;; FLAG -- this pushnew should never be necessary...
- ;;
- (pushnew (list root-path)
- (gdl-acc::%version-tree% root) :test #'equalp :key #'(lambda(item) (list (first item))))
- (setf (rest (assoc root-path (gdl-acc::%version-tree% root) :test #'equalp))
- (remove-plist-key (rest (assoc root-path
- (gdl-acc::%version-tree% root) :test #'equalp)) attribute))
-
- (setf (gdl-acc::%version-tree% root)
- (double-length-sort (gdl-acc::%version-tree% root))))
-
- (when *eager-setting-enabled?*
- (dolist (reset *leaf-resets*)
- (the-object (first reset) (evaluate (second reset))))))))
+ )
+ ;;
+ ;; FLAG -- this pushnew should never be necessary...
+ ;;
+ (pushnew (list root-path)
+ (gdl-acc::%version-tree% root) :test #'equalp :key #'(lambda(item) (list (first item))))
+ (setf (rest (assoc root-path (gdl-acc::%version-tree% root) :test #'equalp))
+ (remove-plist-key (rest (assoc root-path
+ (gdl-acc::%version-tree% root) :test #'equalp)) attribute))
+
+ (setf (gdl-acc::%version-tree% root)
+ (double-length-sort (gdl-acc::%version-tree% root))))
+
+ (when *eager-setting-enabled?*
+ (dolist (reset *leaf-resets*)
+ (the-object (first reset) (evaluate (second reset))))))))
;;
;; FLAG -- remove this defunct version.
@@ -1267,7 +1267,8 @@ a separate object hierarchy." object self)))
(if (third slot-value)
(setf (second (slot-value object slot)) nil)
(setf (slot-value object slot)
- (if (or updating? (not *remember-previous-slot-values?*))
+ (if (and (not (the-object object remember-children?))
+ (or updating? (not *remember-previous-slot-values?*)))
'gdl-rule::%unbound%
(list 'gdl-rule::%unbound% nil nil (first (slot-value object slot))))))))
(when (and (find-class 'gdl-remote nil) (typep object 'gdl-remote))
diff --git a/demos/robot/source/assembly.lisp b/demos/robot/source/assembly.lisp
index c644c69cf923ac2d21c5a6e212d5e529efa446cc..731667bca8434540459adc1b8b9768832496b69f 100755
--- a/demos/robot/source/assembly.lisp
+++ b/demos/robot/source/assembly.lisp
@@ -213,7 +213,7 @@ to the src/ directory distributed with GDL.
:objects
((base :type 'robot-base
- :display-controls (merge-display-controls (list :color :blue-sky))
+ :display-controls (merge-display-controls (list :color :orange))
:height (* (the height) 0.4)
:width (* (the width) 0.2)
:length (* (the length) 0.2)
diff --git a/geom-base/drawing/source/base-view.lisp b/geom-base/drawing/source/base-view.lisp
index 3aeb0c5f07066be90f5f399dcb2b574c95707b9a..746c579b2de4eb5d5440ce5f6161dcdb31402c74 100755
--- a/geom-base/drawing/source/base-view.lisp
+++ b/geom-base/drawing/source/base-view.lisp
@@ -67,7 +67,7 @@ makes sense for viewing it."
:input-slots
(
-
+ (empty-display-list-message nil)
;;(touched-geometry nil)
(width (the page-width))
diff --git a/geom-base/wire/source/utilities.lisp b/geom-base/wire/source/utilities.lisp
index 273f5ac3f212b7e8203273186725cd992680c790..23c0639b6991a11de234de444f302a94ffb9e7fb 100644
--- a/geom-base/wire/source/utilities.lisp
+++ b/geom-base/wire/source/utilities.lisp
@@ -27,6 +27,7 @@
(local-object-boxes (remove nil (mapcar #'(lambda(object) (when (typep object 'base-object)
(the-object object local-box)))
local-objects))))
+
(let (xmin ymin zmin xmax ymax zmax)
(mapcar #'(lambda(box)
(let ((min (first box)) (max (second box)))
diff --git a/gwl-graphics/gwl/source/base-ajax-graphics-sheet.lisp b/gwl-graphics/gwl/source/base-ajax-graphics-sheet.lisp
index 4658f9dd7c25db5214788829d788d3f07c4dc979..3bd5e01369e2f281c86144234b7c34be62150e31 100755
--- a/gwl-graphics/gwl/source/base-ajax-graphics-sheet.lisp
+++ b/gwl-graphics/gwl/source/base-ajax-graphics-sheet.lisp
@@ -36,6 +36,8 @@ Raphael vector graphics."
:input-slots
((respondent (the bashee) :defaulting)
+ (empty-display-list-message nil)
+
("Number. Thickness of default border around graphics viewport.
Default is 1." viewport-border-default 1)
@@ -153,13 +155,16 @@ value of the image-format-selector, which itself defaults to :raphael."
(write-the view-object cad-output))))))
- (svg-string (unless (the no-graphics?)
- (with-error-handling ()
- (with-output-to-string (ss)
- (with-format (svg ss
- :background-color (the background-color)
- :foreground-color (the foreground-color))
- (write-the view-object cad-output))))))
+ (svg-string (if (the no-graphics?)
+ (with-cl-who-string ()
+ ((:div :id "empty-viewport" :class "empty-viewport")
+ (:p (:h2 (str (the empty-display-list-message))))))
+ (with-error-handling ()
+ (with-output-to-string (ss)
+ (with-format (svg ss
+ :background-color (the background-color)
+ :foreground-color (the foreground-color))
+ (write-the view-object cad-output))))))
("String of valid HTML. This can be used to
@@ -259,6 +264,7 @@ x3draw();
zoom-factor-renderer)
:page-length (the length)
:page-width (the width)
+ :empty-display-list-message (the empty-display-list-message)
:objects (the display-list-objects)
:object-roots (the display-list-object-roots))
@@ -448,28 +454,13 @@ to call the :write-embedded-x3d-world function."))
)
(:|Scene|
- ((:|navigationinfo| :|id| "navi" :|transitionTime| "0.1"))
+ ((:|navigationinfo| :|id| "navi" :|transitionTime| "0.0"
+ ))
(with-format (x3d *stream*)
(let ((*onclick-function* (the onclick-function)))
- (write-the view-object cad-output))))))
- ((:script :type "text/javascript")
-
- ;;"x3draw();"
-
- #+nil
- (fmt
- "
-x3dom.reload();
-// document.getElementById('view-~(~a~)').setAttribute('set_bind', 'true');
-// xruntime = document.getElementById('x3dom-1').runtime;
-//xruntime.resetView();
-"
- (the view-selector value)
- )
-
- )))))))
+ (write-the view-object cad-output))))))))))))
(raster-graphics
diff --git a/gwl-graphics/gwl/source/web-drawing.lisp b/gwl-graphics/gwl/source/web-drawing.lisp
index 45b16a706ccfb7d7f09602a0716de5e300bb7833..0ee66698a2a887fc8a2a5f4cd1ea5aa7b5e40268 100755
--- a/gwl-graphics/gwl/source/web-drawing.lisp
+++ b/gwl-graphics/gwl/source/web-drawing.lisp
@@ -131,7 +131,7 @@ application-mixin, you can include one object of this type in the ui-display-lis
from the base-ajax-graphics-sheet and based on its root-path, but can be specified manually
if you are making a web-drawing on your own. Defaults (in the standalone case) to \"RaphaelCanvas\""
raphael-canvas-id "RaphaelCanvas")
-
+
("3D vector. This is the normal vector of the view plane onto which to project the 3D objects. Defaults to (getf *standard-views* :top)."
projection-vector (getf *standard-views* :top))
diff --git a/gwl-graphics/svg/source/lenses.lisp b/gwl-graphics/svg/source/lenses.lisp
index c43741b33ad00be5cb0a2cf217f1178971d185f7..788c393b4e63ca8be73d6870113ce21da009f2c3 100755
--- a/gwl-graphics/svg/source/lenses.lisp
+++ b/gwl-graphics/svg/source/lenses.lisp
@@ -36,18 +36,18 @@
(when parent-scale (the-object child-view (set-slot! :user-scale parent-scale)))
(let ((width (the-object child-view width))
(length (the-object child-view length)))
-
+
(with-html-output (*stream*)
((:div
:onmousedown (when (the parent vector-graphics-onclick?)
(the parent (gdl-ajax-call :function-key :dig-point :bashee (the parent)
:respondent (the parent :respondent)))))
- ((:svg :id "svg-1" :viewBox (format nil "0 0 ~a ~a" width length) :width width :height length
- )
-
- (with-translated-state (:svg (make-point (- (get-x view-center))
- (- (get-y view-center))))
- (write-the-object child-view cad-output)))
+
+ ((:svg :id "svg-1" :viewBox (format nil "0 0 ~a ~a" width length) :width width :height length)
+
+ (with-translated-state (:svg (make-point (- (get-x view-center))
+ (- (get-y view-center))))
+ (write-the-object child-view cad-output)))
((:script :type "text/javascript")
"
var panZoomSVG1 = svgPanZoom('#svg-1', {
@@ -58,6 +58,7 @@
minZoom: 0.01,
maxZoom: 100,
center: true});"))))
+
(when parent-scale (the-object child-view (set-slot! :user-scale old-scale)))))
(the views))))))))
diff --git a/gwl/ajax/source/ajax.lisp b/gwl/ajax/source/ajax.lisp
index 06123ac1ccf2c87b1162e5090887d2e7d62f027c..90ad322fd59a2103d27faff7b92fbfc0c32e545f 100644
--- a/gwl/ajax/source/ajax.lisp
+++ b/gwl/ajax/source/ajax.lisp
@@ -155,10 +155,13 @@
(when (and respondent (the-object respondent root)
(typep (the-object respondent root) 'session-control-mixin))
(the-object respondent root (set-expires-at)))
+
- (when (and respondent (the-object respondent root)
- (the-object respondent root (set-time-last-touched!))))
-
+ (when (and respondent (the-object respondent root)
+ (typep (the-object respondent root) 'session-control-mixin))
+ (the-object respondent root (set-time-last-touched!)))
+
+ #+nil ;; FLAG -- add this back when cleaning up remote-objects.
(when (and respondent (the-object respondent root)
(the-object respondent root (set-remote-host! req))))
@@ -248,11 +251,9 @@
(:document
(mapc #'(lambda(replace-pair js-to-eval-status)
-
-
(declare (ignore js-to-eval-status)) ;; this can play into the flag
- (print-variables (base64-decode-safe (getf replace-pair :dom-id)))
+ (when *debug?* (print-variables (base64-decode-safe (getf replace-pair :dom-id))))
(destructuring-bind (&key dom-id inner-html js-to-eval) replace-pair
(let ((js-to-eval? (and js-to-eval (not (string-equal js-to-eval "")))))
(when (or inner-html js-to-eval?)
@@ -305,6 +306,7 @@ You can reload to get previous state" *ajax-timeout*))
(progn
(when *debug?* (print-variables (the stale?) (the section root-path)))
+ ;;(print-variables (the section root-path))
(when t ;; (the stale?) ;; already filtering for stale? before calling now.
(list :dom-id (the dom-id)