From bknr at bknr.net Wed Jul 4 18:18:41 2007 From: bknr at bknr.net (bknr at bknr.net) Date: Wed, 4 Jul 2007 14:18:41 -0400 (EDT) Subject: [bknr-cvs] r2166 - trunk/projects/lisp-ecoop/website/templates Message-ID: <20070704181841.D3BA5830A0@common-lisp.net> Author: pcostanza Date: 2007-07-04 14:18:40 -0400 (Wed, 04 Jul 2007) New Revision: 2166 Modified: trunk/projects/lisp-ecoop/website/templates/home.xml trunk/projects/lisp-ecoop/website/templates/menu.xml trunk/projects/lisp-ecoop/website/templates/news.xml trunk/projects/lisp-ecoop/website/templates/programme.xml Log: Uploaded the workshop programme. Modified: trunk/projects/lisp-ecoop/website/templates/home.xml =================================================================== --- trunk/projects/lisp-ecoop/website/templates/home.xml 2007-06-11 14:49:57 UTC (rev 2165) +++ trunk/projects/lisp-ecoop/website/templates/home.xml 2007-07-04 18:18:40 UTC (rev 2166) @@ -11,8 +11,8 @@

Important News

The workshop programme is now online.
Alexander Repenning will be giving a keynote presentation about Antiobjects: Mapping Game AI to Massively Parallel Architectures using Collaborative Diffusion.
The submission deadline for papers, essays and breakout group proposals has been extended to May 31.

Important Dates

Modified: trunk/projects/lisp-ecoop/website/templates/menu.xml =================================================================== --- trunk/projects/lisp-ecoop/website/templates/menu.xml 2007-06-11 14:49:57 UTC (rev 2165) +++ trunk/projects/lisp-ecoop/website/templates/menu.xml 2007-07-04 18:18:40 UTC (rev 2166) @@ -3,14 +3,14 @@ + - - - Modified: trunk/projects/lisp-ecoop/website/templates/news.xml =================================================================== --- trunk/projects/lisp-ecoop/website/templates/news.xml 2007-06-11 14:49:57 UTC (rev 2165) +++ trunk/projects/lisp-ecoop/website/templates/news.xml 2007-07-04 18:18:40 UTC (rev 2166) @@ -5,6 +5,12 @@

News

July 4, 2007

+ +

The workshop programme is now online.

May 17, 2007

9:00 - 10:30

First session
Introduction
Alexander Repenning, "Antiobjects: Mapping Game AI to Massively Parallel Architectures using Collaborative Diffusion"

10:30 - 11:00

11:00 - 12:30

Second session
S?bastien Mosser, "Are functional languages a good way to represent productive meta-models?"
Pierre Thierry, Simon E.B. Thierry, "Dynamic data models: an application of MOP-based persistence in Common Lisp"

12:30 - 14:00

14:00 - 15:30

Third session
Christophe Rhodes, "CLOS discriminating functions and user-defined specializers"
Jim Newton, "Specialization Oriented Programming"

15:30 - 16:00

Coffee break

16:00 - 17:00

16:00 - 18:00

Final session
Nikodemus Siivola, "Thread and Interrupt Safe Method Dispatch in PCL"
Pascal Costanza, Robert Hirschfeld, "Recent Developments in ContextL and Context-oriented Programming"
Wrap Up

From bknr at bknr.net Sat Jul 7 12:40:53 2007 From: bknr at bknr.net (bknr at bknr.net) Date: Sat, 7 Jul 2007 08:40:53 -0400 (EDT) Subject: [bknr-cvs] r2167 - trunk/bknr/src/data Message-ID: <20070707124053.5806E4E01E@common-lisp.net> Author: hhubner Date: 2007-07-07 08:40:47 -0400 (Sat, 07 Jul 2007) New Revision: 2167 Modified: trunk/bknr/src/data/TODO trunk/bknr/src/data/object.lisp Log: Fix for a problem reported by Kamen Tomov: When restoring, slots marked as transient would be re-initialized with whatever initarg they received when the object was first created. While the correct behavior could be debated, it is certainly not right to persist the initialization values. Thus, this patch filters out initargs for transient slots upon restore. Modified: trunk/bknr/src/data/TODO =================================================================== --- trunk/bknr/src/data/TODO 2007-07-04 18:18:40 UTC (rev 2166) +++ trunk/bknr/src/data/TODO 2007-07-07 12:40:47 UTC (rev 2167) @@ -4,9 +4,13 @@ - tutorial fertig schreiben -x die ganzen funktionen mit multiple stores mal zurecht refaktoren - fuer einen single store +- import-image anschauen, nicht mehr failsafe -- relaxed-references bei objekten +- Revise and document make-object und initargs behaviour. Upon +restore, initargs for transient slots are ignored now, but this is not +completely thought out. It would better not to log initargs for +transient slots in the first place. -- import-image anschauen, nicht mehr failsafe +- tx-persistent-change-class does not maintain indices + +- XXXX broken initialize-persistent-instance (?) Modified: trunk/bknr/src/data/object.lisp =================================================================== --- trunk/bknr/src/data/object.lisp 2007-07-04 18:18:40 UTC (rev 2166) +++ trunk/bknr/src/data/object.lisp 2007-07-07 12:40:47 UTC (rev 2167) @@ -1,7 +1,5 @@ ;;; MOP based object subsystem for the BKNR datastore -;;; XXX tx-persistent-change-class does not maintain indices - (in-package :bknr.datastore) (cl-interpol:enable-interpol-syntax) @@ -18,10 +16,19 @@ (error "Could not find a store-object-subsystem in the current store ~a." *store*)) subsystem)) -;;; eval-when in order to have store-object-with-id on compilation (defclass persistent-class (indexed-class) - ()) + ((transient-slot-initargs :initform nil + :accessor persistent-class-transient-slot-initargs))) +(defmethod determine-transient-slot-initargs ((class persistent-class)) + (with-slots (transient-slot-initargs) class + (setf transient-slot-initargs nil) + (dolist (slot (class-slots class)) + (when (and (typep slot 'persistent-effective-slot-definition) + (persistent-effective-slot-definition-transient slot) + (slot-definition-initargs slot)) + (pushnew (car (slot-definition-initargs slot)) transient-slot-initargs))))) + (defmethod validate-superclass ((sub persistent-class) (super indexed-class)) t) @@ -32,8 +39,13 @@ (warn "updating ~A instances of ~A for class changes" (length (class-instances class)) class)) (mapc #'reinitialize-instance (class-instances class))) +(defmethod instance :after ((class persistent-class) &rest args) + (declare (ignore args)) + (determine-transient-slot-initargs class)) + (defmethod reinitialize-instance :after ((class persistent-class) &rest args) (declare (ignore args)) + (determine-transient-slot-initargs class) (when *store* (update-instances-for-changed-class (class-name class)) (unless *suppress-schema-warnings* @@ -45,8 +57,11 @@ (relaxed-object-reference :initarg :relaxed-object-reference :initform nil))) (defclass persistent-effective-slot-definition (index-effective-slot-definition) - ((transient :initarg :transient :initform nil) - (relaxed-object-reference :initarg :relaxed-object-reference :initform nil))) + ((transient :initarg :transient + :initform nil + :reader persistent-effective-slot-definition-transient) + (relaxed-object-reference :initarg :relaxed-object-reference + :initform nil))) (defmethod persistent-slot-p ((slot standard-effective-slot-definition)) nil) @@ -130,7 +145,6 @@ (defmethod initialize-instance :around ((object store-object) &key &allow-other-keys) - ;; XXXX broken initialize-persistent-instance (if (in-anonymous-transaction-p) (prog1 (call-next-method) @@ -536,17 +550,28 @@ (format t "clearing indices for class ~A~%" (class-name class-name)) (clear-class-indices class-name))) class-layouts)))))))) + +(defun remove-transient-slot-initargs (class initializers) + "Remove all initializers for transient slots" + (loop for (keyword value) on initializers by #'cddr + unless (find keyword (persistent-class-transient-slot-initargs class)) + collect keyword + and + collect value)) ;;; create object transaction, should not be called from user code, as we have to give it ;;; a unique id in the initargs. After the object is created, the persistent and the ;;; transient instances are initialized -(defun tx-make-object (class &rest initargs) +(defun tx-make-object (class-name &rest initargs) (let (obj (error t)) (unwind-protect - (progn - (setf obj (apply #'make-instance class initargs)) - (unless (eq (store-state *store*) :restore) + (let ((restoring (eq (store-state *store*) :restore))) + (setf obj (apply #'make-instance class-name + (if restoring + (remove-transient-slot-initargs (find-class class-name) initargs) + initargs))) + (unless restoring (initialize-persistent-instance obj)) (initialize-transient-instance obj) (setf error nil) @@ -554,11 +579,11 @@ (when (and error obj) (destroy-object obj))))) -(defun make-object (class &rest initargs) - "Make a persistent object of class CLASS. Calls MAKE-INSTANCE with INITARGS." +(defun make-object (class-name &rest initargs) + "Make a persistent object of class named CLASS-NAME. Calls MAKE-INSTANCE with INITARGS." (execute (make-instance 'transaction :function-symbol 'tx-make-object - :args (append (list class + :args (append (list class-name :id (id-counter (store-object-subsystem))) initargs)))) From bknr at bknr.net Sat Jul 7 12:41:44 2007 From: bknr at bknr.net (bknr at bknr.net) Date: Sat, 7 Jul 2007 08:41:44 -0400 (EDT) Subject: [bknr-cvs] r2168 - trunk/bknr/src/web Message-ID: <20070707124144.848AF5600B@common-lisp.net> Author: hhubner Date: 2007-07-07 08:41:43 -0400 (Sat, 07 Jul 2007) New Revision: 2168 Modified: trunk/bknr/src/web/handlers.lisp trunk/bknr/src/web/user-handlers.lisp trunk/bknr/src/web/web-macros.lisp Log: Push around some definitions to reduce the number of warnings. Modified: trunk/bknr/src/web/handlers.lisp =================================================================== --- trunk/bknr/src/web/handlers.lisp 2007-07-07 12:40:47 UTC (rev 2167) +++ trunk/bknr/src/web/handlers.lisp 2007-07-07 12:41:43 UTC (rev 2168) @@ -499,3 +499,64 @@ (ensure-directories-exist spool-dir) spool-dir)) +(defmethod website-show-page ((website website) fn title) + (html + (princ "" *html-stream*) + (princ #\Newline *html-stream*) + (:html + (:head + (header :title title)) + ((:body :class "cms") + ((:div :class "navigation") + (logo) + (:h1 (:princ-safe (website-name website))) + (navigation)) + (:h1 (:princ-safe title)) + (funcall fn) + (session-info))))) + +(defmethod website-show-error-page ((website website) error) + (if (website-template-handler website) + (send-error-response (website-template-handler website) *req* (princ-to-string error)) + (html + (princ "" *html-stream*) + (princ #\Newline *html-stream*) + (:html + (:head + (header :title "Error processing your request")) + ((:body :class "cms") + (:h1 "Error processing your request") + (:p "While processing your request, an error occured:") + ((:div :class "error") + (:princ-safe error))))))) + +(defun show-page-with-error-handlers (fn req &key response title) + (unless response + (setf response *response-ok*)) ; can't default because used from macros and *response-ok* is not a constant + (if (member :notrap net.aserve::*debug-current*) + (with-bknr-http-response (req :content-type "text/html; charset=UTF-8" :response response) + (with-http-body (req *ent*) + (website-show-page *website* fn title))) + (handler-case + (let ((body (with-output-to-string (*html-stream*) + (website-show-page *website* fn title)))) + (with-bknr-http-response (req :content-type "text/html; charset=UTF-8" :response response) + (with-http-body (req *ent*) + (princ body *html-stream*)))) + (serious-condition (c) + (with-bknr-http-response (req :content-type "text/html; charset=UTF-8" :response *response-internal-server-error*) + (with-http-body (req *ent*) + (website-show-error-page *website* c))))))) + +(defmacro with-bknr-page ((&rest args) &body body) + `(show-page-with-error-handlers (lambda () (html , at body)) , at args)) + +#+(or) +(defmacro with-bknr-site-template ((req &key title) &rest body) + `(with-bknr-http-response (,req :content-type "text/html") + (with-http-body (,req ,ent) + (include + :template "toplevel-template" + :tag-body (with-output-to-string (*html-stream*) + , at body))))) + Modified: trunk/bknr/src/web/user-handlers.lisp =================================================================== --- trunk/bknr/src/web/user-handlers.lisp 2007-07-07 12:40:47 UTC (rev 2167) +++ trunk/bknr/src/web/user-handlers.lisp 2007-07-07 12:41:43 UTC (rev 2168) @@ -71,7 +71,7 @@ (defmethod handle-object-form ((handler user-handler) action (user user) req) (with-bknr-page (req :title #?"$((class-name (class-of user))) $((user-login user))") - (bknr.images:user-image :user (user-login user)) + #+(or) (bknr.images:user-image :user (user-login user)) (user-form :user-id (store-object-id user)))) (defmethod handle-object-form ((handler user-handler) (action (eql :search)) user req) Modified: trunk/bknr/src/web/web-macros.lisp =================================================================== --- trunk/bknr/src/web/web-macros.lisp 2007-07-07 12:40:47 UTC (rev 2167) +++ trunk/bknr/src/web/web-macros.lisp 2007-07-07 12:41:43 UTC (rev 2168) @@ -2,12 +2,20 @@ (enable-interpol-syntax) +(defvar *bknr-debug* nil) +(defvar *website* nil) + +(defvar *website-modules* (make-hash-table :test #'equal)) + (defvar *req* nil "Current request") (defvar *ent* nil "Current entity") (defvar *session* nil "Current session") (defvar *user* nil "Current user") (defvar *req-var-hash* nil "Request variables") +(defmacro with-bknr-page ((&rest args) &body body) + `(show-page-with-error-handlers (lambda () (html , at body)) , at args)) + (defmacro with-cookies ((request &rest names) &rest body) (let ((cookies (gensym))) `(let ((,cookies (get-cookie-values ,request))) @@ -77,67 +85,6 @@ , at body) (register-tag-function ,(package-name *package*) ,(symbol-name name) (fdefinition ',name)))) -(defmethod website-show-page ((website website) fn title) - (html - (princ "" *html-stream*) - (princ #\Newline *html-stream*) - (:html - (:head - (header :title title)) - ((:body :class "cms") - ((:div :class "navigation") - (logo) - (:h1 (:princ-safe (website-name website))) - (navigation)) - (:h1 (:princ-safe title)) - (funcall fn) - (session-info))))) - -(defmethod website-show-error-page ((website website) error) - (if (website-template-handler website) - (send-error-response (website-template-handler website) *req* (princ-to-string error)) - (html - (princ "" *html-stream*) - (princ #\Newline *html-stream*) - (:html - (:head - (header :title "Error processing your request")) - ((:body :class "cms") - (:h1 "Error processing your request") - (:p "While processing your request, an error occured:") - ((:div :class "error") - (:princ-safe error))))))) - -(defun show-page-with-error-handlers (fn req &key response title) - (unless response - (setf response *response-ok*)) ; can't default because used from macros and *response-ok* is not a constant - (if (member :notrap net.aserve::*debug-current*) - (with-bknr-http-response (req :content-type "text/html; charset=UTF-8" :response response) - (with-http-body (req *ent*) - (website-show-page *website* fn title))) - (handler-case - (let ((body (with-output-to-string (*html-stream*) - (website-show-page *website* fn title)))) - (with-bknr-http-response (req :content-type "text/html; charset=UTF-8" :response response) - (with-http-body (req *ent*) - (princ body *html-stream*)))) - (serious-condition (c) - (with-bknr-http-response (req :content-type "text/html; charset=UTF-8" :response *response-internal-server-error*) - (with-http-body (req *ent*) - (website-show-error-page *website* c))))))) - -(defmacro with-bknr-page ((&rest args) &body body) - `(show-page-with-error-handlers (lambda () (html , at body)) , at args)) - -#+(or) -(defmacro with-bknr-site-template ((req &key title) &rest body) - `(with-bknr-http-response (,req :content-type "text/html") - (with-http-body (,req ,ent) - (include - :template "toplevel-template" - :tag-body (with-output-to-string (*html-stream*) - , at body))))) - (defmacro html-text-input (variable size &optional maxsize) `((:input :type "text" :size ,(format nil "~a" size)