Commit fd489adf authored by Dave Cooper's avatar Dave Cooper
Browse files

Add warning for setting slots from body of cached slots. Update copyright year in banner.

parent 35e0db33
(:gdl-geom-base)
(:gdl-geom-base :cl-fad)
......@@ -4,7 +4,7 @@
:author
"Genworks and Dave Cooper unless otherwise indicated"
:license "AGPL unless otherwise indicated" :serial t
:version "2012090900" :depends-on (:gdl-geom-base)
:version "2012090900" :depends-on (:gdl-geom-base :cl-fad)
:components
((:lisp "source/package") (:lisp "source/genworks")
(:lisp "source/app") (:lisp "source/distro")))
\ No newline at end of file
......@@ -35,16 +35,17 @@
#+clozure (ccl::recursive-copy-directory from-dir to-dir ))
#-(or allegro (and unix lispworks))
(warn "~&Please implement delete-directory-and-files for the currently running lisp.~%")
(defun delete-directory-and-files (target &key force quiet (if-does-not-exist :error))
#+lispworks (declare (ignore force quiet))
#-allegro (declare (ignore force quiet))
(cond ((probe-file target)
#+lispworks (system:run-shell-command (format nil "rm -rf ~a" target))
#+allegro (excl.osi:delete-directory-and-files
target :force force :quiet quiet))
target :force force :quiet quiet)
#-(or allegro (and unix lispworks))
(cl-fad:delete-directory-and-files target :if-does-not-exist if-does-not-exist))
((null if-does-not-exist) nil)
(t (ecase if-does-not-exist
(:ignore nil)
(:warn (warn "Target ~s does not exist.~%" target))
(:error (error "Target ~s does not exist.~%" target))))))
......
......@@ -57,7 +57,7 @@
"
Copyright 2002-2011 Genworks International
Copyright 2013 Genworks International
This is the General-purpose Declarative Language (GenDL).
......
......@@ -107,6 +107,22 @@
part-type-symbol
name
special-keys)
(when (and part-type-symbol
(atom part-type-symbol)
(eql part-type-symbol 'remote-object)
(not *compile-for-dgdl?*))
(warn "You are compiling an object of type 'remote-oject,
and you have *compile-for-dgdl?* set to nil.
You probably want to do
(setq gdl:*compile-for-dgdl?* t)
and then compile this again.~%"))
(when (and part-type-symbol
(atom part-type-symbol)
(not (eql part-type-symbol 'remote-object)))
......
......@@ -423,12 +423,41 @@ as <tt>:settable</tt> for this to work properly. Any dependent slots in the tree
respond accordingly when they are next demanded. Note that the slot must be specified as a keyword
symbol (i.e. prepended with a colon (``:'')), otherwise it will be evaluated as a variable according
to normal Lisp functional evaluation rules.
<p>
Note also that this must not be called (either directly or indirectly)
from within the body of a Gendl computed-slot. The caching and
dependency tracking mechanism in Gendl will not work properly if this
is called from the body of a computed-slot, and furthermore a runtime
error will be generated.
</p>
:arguments (slot \"Keyword Symbol\"
value \"Lisp Object. (e.g. Number, String, List, etc.)\")
:&key ((remember? t) \"Boolean. Determines whether to save in current version-tree.\")"
set-slot!
(attribute value &key (remember? t))
(attribute value &key (remember? t) (warn-on-non-toplevel? t))
(when (and warn-on-non-toplevel?
*notify-cons*)
(warn "It is not possible to call set-slot! from within dependency-tracking context, e.g. from the body of a computed-slot.
Set-slot was called on
~s
with value
~s
from
~s.~%"
(cons 'the (append (reverse (the root-path))
(list (make-keyword attribute))))
value
(cons 'the (append (reverse (the-object (first *notify-cons*) root-path))
(list (make-keyword (second *notify-cons*)))))))
(unless (eql attribute :%primary?%)
(when (not *run-with-dependency-tracking?*)
(error "Dependency Tracking must be enabled in order to forcibly
......
......@@ -269,7 +269,8 @@ checkbox-form-control."
(the (set-slot! :%html-section-root-paths% (pushnew (the-object section root-path)
html-sections
:test #'equalp)
:remember? nil)))
:remember? nil
:warn-on-non-toplevel? nil)))
(when *debug?*
(format *trace-output* "~&After:~%")
......
......@@ -205,9 +205,9 @@
:type (read-safe-string (getf args-list :type))))
(new-id (make-keyword (make-new-instance-id))))
(the-object object (set-slot! :%name% name))
(the-object object (set-slot! :remote-id new-id :remember? nil))
(the-object object (set-slot! :%index% index))
(the-object object (set-slot! :%name% name :warn-on-non-toplevel? nil))
(the-object object (set-slot! :remote-id new-id :remember? nil :warn-on-non-toplevel? nil))
(the-object object (set-slot! :%index% index :warn-on-non-toplevel? nil))
(setf (slot-value object 'gdl-acc::%parent%)
(list (evaluate-object (first parent-form) (rest parent-form)) nil t))
(setf (gethash new-id *remote-objects-hash*) object)
......
......@@ -40,7 +40,7 @@
(read-safe-string (net.aserve.client:do-http-request
(format nil "http://~a:~a/make-remote-object?args=~a"
(the host) (the port) encoded-args)))))
(the (set-slot! :previous-id new-id :remember? nil))
(the (set-slot! :previous-id new-id :remember? nil :warn-on-non-toplevel? nil))
new-id))) :settable))
......@@ -149,7 +149,7 @@
(eql (second result) :no-such-object))
(progn
(warn "~&Remote object returned error, creating a new one...~%")
(the (set-slot! :remote-id nil))
(the (set-slot! :remote-id nil :warn-on-non-toplevel? nil))
(the (restore-slot-default! :remote-id))
(the (send (:apply (cons message args))))))
((and (consp result) (eql (first result) :error))
......@@ -224,7 +224,7 @@
(let ((id (or (the-object item root local-remote-id)
(let ((new-id (make-keyword (make-new-instance-id))))
(setf (gethash new-id *remote-objects-hash*) (the-object item root))
(the-object item root (set-slot! :local-remote-id new-id :remember? nil))
(the-object item root (set-slot! :local-remote-id new-id :remember? nil :warn-on-non-toplevel? nil))
new-id))))
(encode-object-for-http item id)))
......@@ -232,7 +232,7 @@
(let ((id (or (the-object item root remote-id)
(let ((new-id (make-keyword (make-new-instance-id))))
(setf (gethash new-id *remote-objects-hash*) (the-object item root))
(the-object item root (set-slot! :remote-id new-id :remember? nil))
(the-object item root (set-slot! :remote-id new-id :remember? nil :warn-on-non-toplevel? nil))
new-id))))
(encode-object-for-http item id)))
......
(in-package :gdl-user)
#|
To use:
1. (setq *compile-for-dgdl?* t)
2. Compile & load this file in the "primary" Gendl session.
3. Start a separate Gendl session (this should start by default on 9001)
4. compile & load this file in the "secondary" Gendl session
*compile-for-dgdl?* should not be necessary on the secondary session but
will not hurt.
5. On the primary session, try:
(make-self 'container)
(the remote-1 slot-1)
This should return "one"
|#
(define-object container ()
:objects ((remote-1 :type 'remote-object
:remote-type 'remote-1
:port 9001
:host "localhost")))
(define-object remote-1 ()
:computed-slots
((slot-1 "one")))
\ No newline at end of file
......@@ -21,10 +21,6 @@
(in-package :surf)
(eval-when (:compile-toplevel :load-toplevel :execute) (ql:quickload :uffi))
(define-lens (nurbs vanilla-mixin)()
:output-functions
((cad-output-tree ()
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment