[bknr-cvs] hans changed trunk/
BKNR Commits
bknr at bknr.net
Tue Jul 29 12:13:33 UTC 2008
Revision: 3677
Author: hans
URL: http://bknr.net/trac/changeset/3677
INITIALIZE-PERSISTENT-INSTANCE now receives the initargs supplied
to MAKE-OBJECT.
U trunk/bknr/datastore/src/data/object.lisp
U trunk/bknr/web/src/frontend/frontend-config.lisp
U trunk/bknr/web/src/rss/rss.lisp
U trunk/bknr/web/src/sysclasses/user.lisp
U trunk/projects/bos/m2/allocation.lisp
U trunk/projects/bos/m2/m2.lisp
U trunk/projects/bos/m2/poi.lisp
Modified: trunk/bknr/datastore/src/data/object.lisp
===================================================================
--- trunk/bknr/datastore/src/data/object.lisp 2008-07-29 12:09:21 UTC (rev 3676)
+++ trunk/bknr/datastore/src/data/object.lisp 2008-07-29 12:13:33 UTC (rev 3677)
@@ -244,19 +244,19 @@
:timestamp (get-universal-time)
:args (append (list object (if (symbolp class) class (class-name class))) args))))
-(defgeneric initialize-persistent-instance (store-object)
+(defgeneric initialize-persistent-instance (store-object &key)
(:documentation
- "Initializes the persistent aspects of a persistent object. This method is called
-at the creationg of a persistent object, but not when the object is loaded from a
-snapshot."))
+ "Initializes the persistent aspects of a persistent object. This
+method is called at the creation of a persistent object, but not when
+the object is loaded from a snapshot."))
(defgeneric initialize-transient-instance (store-object)
(:documentation
- "Initializes the transient aspects of a persistent object. This method is called
-whenever a persistent object is initialized, also when the object is loaded from
-a snapshot."))
+ "Initializes the transient aspects of a persistent object. This
+method is called whenever a persistent object is initialized, also
+when the object is loaded from a snapshot."))
-(defmethod initialize-persistent-instance ((object store-object)))
+(defmethod initialize-persistent-instance ((object store-object) &key))
(defmethod initialize-transient-instance ((object store-object)))
(defmethod store-object-persistent-slots ((object store-object))
@@ -641,7 +641,7 @@
(if restoring
(remove-transient-slot-initargs (find-class class-name) initargs)
initargs)))
- (initialize-persistent-instance obj)
+ (apply #'initialize-persistent-instance obj initargs)
(initialize-transient-instance obj)
(setf error nil)
obj)
Modified: trunk/bknr/web/src/frontend/frontend-config.lisp
===================================================================
--- trunk/bknr/web/src/frontend/frontend-config.lisp 2008-07-29 12:09:21 UTC (rev 3676)
+++ trunk/bknr/web/src/frontend/frontend-config.lisp 2008-07-29 12:13:33 UTC (rev 3677)
@@ -9,7 +9,8 @@
(cl-interpol:disable-interpol-syntax))))
(defun cachable-prefixes-regex ()
- (format nil "^(~{~A~^|~})" (mapcar #'page-handler-prefix (website-cachable-handlers bknr.web:*website*))))
+ (format nil "^(~{~A~^|~})"
+ (mapcar #'page-handler-prefix (website-cachable-handlers bknr.web::*website*))))
(defun generate-frontend-config (stream &key
backend-port)
Modified: trunk/bknr/web/src/rss/rss.lisp
===================================================================
--- trunk/bknr/web/src/rss/rss.lisp 2008-07-29 12:09:21 UTC (rev 3676)
+++ trunk/bknr/web/src/rss/rss.lisp 2008-07-29 12:13:33 UTC (rev 3677)
@@ -147,7 +147,7 @@
(:method ((channel (eql nil)) item)
(warn "no RSS channel defined for item ~A" item)))
-(defmethod initialize-persistent-instance :after ((rss-item rss-item))
+(defmethod initialize-persistent-instance :after ((rss-item rss-item) &key)
(add-item (rss-item-channel rss-item) rss-item))
(defmethod destroy-object :before ((rss-item rss-item))
Modified: trunk/bknr/web/src/sysclasses/user.lisp
===================================================================
--- trunk/bknr/web/src/sysclasses/user.lisp 2008-07-29 12:09:21 UTC (rev 3676)
+++ trunk/bknr/web/src/sysclasses/user.lisp 2008-07-29 12:13:33 UTC (rev 3677)
@@ -60,7 +60,7 @@
(user-login object)
"unbound"))))
-(defmethod initialize-persistent-instance ((user user))
+(defmethod initialize-persistent-instance ((user user) &key)
(let* ((plaintext-password (slot-value user 'password))
(password (when plaintext-password (crypt-md5 plaintext-password (make-salt)))))
(setf (slot-value user 'password) password)))
@@ -72,7 +72,7 @@
(define-persistent-class smb-user (user)
())
-(defmethod initialize-persistent-instance ((user smb-user))
+(defmethod initialize-persistent-instance ((user smb-user) &key)
(let* ((plaintext-password (slot-value user 'password)))
(when plaintext-password
(set-smb-password (user-login user) plaintext-password))
Modified: trunk/projects/bos/m2/allocation.lisp
===================================================================
--- trunk/projects/bos/m2/allocation.lisp 2008-07-29 12:09:21 UTC (rev 3676)
+++ trunk/projects/bos/m2/allocation.lisp 2008-07-29 12:13:33 UTC (rev 3677)
@@ -34,7 +34,7 @@
:unbound)
(store-object-id allocation-area))))
-(defmethod initialize-persistent-instance :after ((allocation-area allocation-area))
+(defmethod initialize-persistent-instance :after ((allocation-area allocation-area) &key)
(with-slots (total-m2s free-m2s) allocation-area
(setf total-m2s (calculate-total-m2-count allocation-area))
(setf free-m2s (- total-m2s (calculate-allocated-m2-count allocation-area))))
Modified: trunk/projects/bos/m2/m2.lisp
===================================================================
--- trunk/projects/bos/m2/m2.lisp 2008-07-29 12:09:21 UTC (rev 3676)
+++ trunk/projects/bos/m2/m2.lisp 2008-07-29 12:13:33 UTC (rev 3677)
@@ -276,7 +276,7 @@
(defun contract-p (object)
(equal (class-of object) (find-class 'contract)))
-(defmethod initialize-persistent-instance :after ((contract contract))
+(defmethod initialize-persistent-instance :after ((contract contract) &key)
(pushnew contract (sponsor-contracts (contract-sponsor contract)))
(dolist (m2 (contract-m2s contract))
(setf (m2-contract m2) contract))
@@ -377,7 +377,11 @@
(dolist (m2 (contract-m2s contract))
(collect (list (m2-x m2) (m2-y m2))))))
-(defun contracts-bounding-box (&optional (contracts (class-instances 'contract)))
+(defun all-contracts ()
+ "Return list of all contracts in the system."
+ (class-instances 'all-contracts))
+
+(defun contracts-bounding-box (&optional (contracts (all-contracts)))
(geometry:with-bounding-box-collect (collect)
(dolist (contract contracts)
(dolist (m2 (contract-m2s contract))
Modified: trunk/projects/bos/m2/poi.lisp
===================================================================
--- trunk/projects/bos/m2/poi.lisp 2008-07-29 12:09:21 UTC (rev 3676)
+++ trunk/projects/bos/m2/poi.lisp 2008-07-29 12:13:33 UTC (rev 3677)
@@ -30,7 +30,7 @@
(when poi
(setf (poi-images poi) (remove poi-image (poi-images poi))))))
-(defmethod initialize-persistent-instance :after ((poi-image poi-image))
+(defmethod initialize-persistent-instance :after ((poi-image poi-image) &key)
(setf (poi-images (poi-image-poi poi-image)) (append (poi-images (poi-image-poi poi-image)) (list poi-image))))
(deftransaction update-poi-image (poi-image language
@@ -53,6 +53,7 @@
(name :read :index-type string-unique-index
:index-reader find-poi :index-values all-pois
:documentation "Symbolischer Name")
+ (published :update :initform nil)
(title :update :initform (make-string-hash-table) :documentation "Angezeigter Name")
(subtitle :update :initform (make-string-hash-table) :documentation "Unterschrift")
(description :update :initform (make-string-hash-table) :documentation "Beschreibungstext")
More information about the Bknr-cvs
mailing list