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