[bknr-cvs] r1835 - trunk/projects/lisp-ecoop/src
bknr at bknr.net
bknr at bknr.net
Fri Feb 17 19:41:42 UTC 2006
Author: hhubner
Date: 2006-02-17 13:41:42 -0600 (Fri, 17 Feb 2006)
New Revision: 1835
Added:
trunk/projects/lisp-ecoop/src/lisp-ecoop.asd
trunk/projects/lisp-ecoop/src/macros.lisp
Removed:
trunk/projects/lisp-ecoop/src/lisp-ecoop05.asd
Modified:
trunk/projects/lisp-ecoop/src/config.lisp
trunk/projects/lisp-ecoop/src/handlers.lisp
trunk/projects/lisp-ecoop/src/packages.lisp
trunk/projects/lisp-ecoop/src/participant.lisp
trunk/projects/lisp-ecoop/src/schedule.lisp
trunk/projects/lisp-ecoop/src/webserver.lisp
Log:
More pending changes from my now-dead hard drive. Praise VMware!
Modified: trunk/projects/lisp-ecoop/src/config.lisp
===================================================================
--- trunk/projects/lisp-ecoop/src/config.lisp 2006-02-14 21:57:58 UTC (rev 1834)
+++ trunk/projects/lisp-ecoop/src/config.lisp 2006-02-17 19:41:42 UTC (rev 1835)
@@ -3,7 +3,7 @@
;; URL für BASE HREFs
(defparameter *website-url* "http://lisp-ecoop.bknr.net")
-(defparameter *root-directory* #p"home:bknr-svn/lisp-ecoop/")
+(defparameter *root-directory* #p"home:bknr-svn/projects/lisp-ecoop/")
(defparameter *store-directory* (merge-pathnames #p"datastore/" *root-directory*))
@@ -12,5 +12,6 @@
(defparameter *webserver-port* 8081)
(defparameter *default-mail-from* "postmaster at lisp-ecoop.bknr.net")
-(defparameter *default-mail-subject* "Mail from the LISP ECOOP05 Website")
-(defparameter *smtp-server* "127.0.0.1")
\ No newline at end of file
+(defparameter *default-mail-subject* "Mail from the LISP ECOOP Website")
+(defparameter *smtp-server* "127.0.0.1")
+
Modified: trunk/projects/lisp-ecoop/src/handlers.lisp
===================================================================
--- trunk/projects/lisp-ecoop/src/handlers.lisp 2006-02-14 21:57:58 UTC (rev 1834)
+++ trunk/projects/lisp-ecoop/src/handlers.lisp 2006-02-17 19:41:42 UTC (rev 1835)
@@ -67,7 +67,7 @@
())
(defmethod handle ((handler page-handler) req)
- (with-lisp-ecoop-page (req "LISP-ECOOP05 Administration")
+ (with-lisp-ecoop-page (req "LISP-ECOOP Administration")
"Please choose an administrative task from the menu"))
(define-bknr-webserver-module participants
Copied: trunk/projects/lisp-ecoop/src/lisp-ecoop.asd (from rev 1829, trunk/projects/lisp-ecoop/src/lisp-ecoop05.asd)
===================================================================
--- trunk/projects/lisp-ecoop/src/lisp-ecoop05.asd 2006-02-11 09:19:59 UTC (rev 1829)
+++ trunk/projects/lisp-ecoop/src/lisp-ecoop.asd 2006-02-17 19:41:42 UTC (rev 1835)
@@ -0,0 +1,30 @@
+;;;; -*- Mode: LISP -*-
+
+(in-package :cl-user)
+
+(defpackage :lisp-ecoop.system
+ (:use :cl :asdf))
+
+(in-package :lisp-ecoop.system)
+
+(defsystem :lisp-ecoop
+ :name "worldpay test"
+ :author "Hans Huebner <hans at huebner.org>"
+ :version "0"
+ :maintainer "Hans Huebner <hans at huebner.org>"
+ :licence "BSD"
+ :description "BKNR Test Web Server"
+ :long-description ""
+
+ :depends-on (:bknr-modules :cxml :klammerscript)
+
+ :components ((:file "packages")
+ (:file "config" :depends-on ("packages"))
+ (:file "macros" :depends-on ("config"))
+ (:file "schedule" :depends-on ("macros"))
+ (:file "participant" :depends-on ("macros" "schedule"))
+ (:file "mail" :depends-on ("participant"))
+ (:file "tags" :depends-on ("participant"))
+ (:file "handlers" :depends-on ("participant"))
+ (:file "webserver" :depends-on ("handlers"))
+ (:file "init" :depends-on ("webserver"))))
Deleted: trunk/projects/lisp-ecoop/src/lisp-ecoop05.asd
===================================================================
--- trunk/projects/lisp-ecoop/src/lisp-ecoop05.asd 2006-02-14 21:57:58 UTC (rev 1834)
+++ trunk/projects/lisp-ecoop/src/lisp-ecoop05.asd 2006-02-17 19:41:42 UTC (rev 1835)
@@ -1,30 +0,0 @@
-;;;; -*- Mode: LISP -*-
-
-(in-package :cl-user)
-
-(defpackage :lisp-ecoop.system
- (:use :cl :asdf))
-
-(in-package :lisp-ecoop.system)
-
-(defsystem :lisp-ecoop
- :name "worldpay test"
- :author "Hans Huebner <hans at huebner.org>"
- :version "0"
- :maintainer "Hans Huebner <hans at huebner.org>"
- :licence "BSD"
- :description "BKNR Test Web Server"
- :long-description ""
-
- :depends-on (:bknr-modules :cxml :klammerscript)
-
- :components ((:file "packages")
- (:file "macros" :depends-on ("packages"))
- (:file "config" :depends-on ("macros"))
- (:file "schedule" :depends-on ("config"))
- (:file "participant" :depends-on ("config" "schedule"))
- (:file "mail" :depends-on ("participant"))
- (:file "tags" :depends-on ("participant"))
- (:file "handlers" :depends-on ("participant"))
- (:file "webserver" :depends-on ("handlers"))
- (:file "init" :depends-on ("webserver"))))
Added: trunk/projects/lisp-ecoop/src/macros.lisp
===================================================================
--- trunk/projects/lisp-ecoop/src/macros.lisp 2006-02-14 21:57:58 UTC (rev 1834)
+++ trunk/projects/lisp-ecoop/src/macros.lisp 2006-02-17 19:41:42 UTC (rev 1835)
@@ -0,0 +1,43 @@
+(in-package :lisp-ecoop)
+
+(defvar *dtd* (ext:unix-namestring (merge-pathnames #p"src/lisp-ecoop.dtd" lisp-ecoop.config::*root-directory*)))
+
+(defun compute-slot (class slot)
+ (destructuring-bind (name access &rest rest &key attribute element &allow-other-keys) slot
+ (let* ((initarg (make-keyword-from-string (symbol-name name)))
+ (package (symbol-package class))
+ (accessor (intern (concatenate 'string (symbol-name class) "-"
+ (symbol-name name)) package)))
+ (push initarg rest)
+ (push :initarg rest)
+ (when (eql attribute t)
+ (setf attribute (string-downcase (symbol-name name))))
+ (when (eql element t)
+ (setf element (string-downcase (symbol-name name))))
+ (unless (or attribute element)
+ (push (string-downcase (symbol-name name)) rest)
+ (push :element rest))
+ (case access
+ (:read
+ (push accessor rest)
+ (push :reader rest))
+ (:update
+ (push accessor rest)
+ (push :accessor rest))
+ (:none)
+ (t (error "unknown access option ~A in slot ~A of class ~A."
+ access slot class)))
+ (cons name rest))))
+
+(defmacro define-lisp-ecoop-class (class (&rest superclasses) slots &rest class-options)
+ (let ((superclasses (or superclasses '(store-object)))
+ (slots (mapcar #'(lambda (slot) (compute-slot class slot))
+ slots)))
+ ;; the eval-when is there to create the index access functions at compile time
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defclass ,class ,superclasses
+ ,slots
+ (:metaclass persistent-xml-class)
+ (:dtd-name *dtd*)
+ , at class-options))))
+
Modified: trunk/projects/lisp-ecoop/src/packages.lisp
===================================================================
--- trunk/projects/lisp-ecoop/src/packages.lisp 2006-02-14 21:57:58 UTC (rev 1834)
+++ trunk/projects/lisp-ecoop/src/packages.lisp 2006-02-17 19:41:42 UTC (rev 1835)
@@ -9,7 +9,8 @@
#:*store-directory*
#:*default-mail-from*
#:*default-mail-subject*
- #:*smtp-server*))
+ #:*smtp-server*
+ #:*dtd*))
(defpackage :lisp-ecoop.imageproc
(:use :cl
@@ -34,8 +35,7 @@
:lisp-ecoop.config
:net.aserve
:net.post-office
- :xhtml-generator
- :js)
+ :xhtml-generator)
(:shadowing-import-from :cl-interpol #:quote-meta-chars)
(:export #:participant
#:all-participants
Modified: trunk/projects/lisp-ecoop/src/participant.lisp
===================================================================
--- trunk/projects/lisp-ecoop/src/participant.lisp 2006-02-14 21:57:58 UTC (rev 1834)
+++ trunk/projects/lisp-ecoop/src/participant.lisp 2006-02-17 19:41:42 UTC (rev 1835)
@@ -2,11 +2,11 @@
(enable-interpol-syntax)
-(define-persistent-class submission (blob)
- ((title :update :documentation "Title of the submission" :initform nil)
- (abstract :update :documentation "Abstract or short description" :initform nil)
- (submitters :update :documentation "List of participants who submitted this" :initform nil)
- (timeslot :update :documentation "Timeslot scheduled for this submission" :initform nil))
+(define-lisp-ecoop-class submission (blob)
+ ((title :update :documentation "Title of the submission" :initform nil :attribute t)
+ (abstract :update :documentation "Abstract or short description" :initform nil :element t)
+ (submitters :update :documentation "List of participants who submitted this" :initform nil :element t)
+ (timeslot :update :documentation "Timeslot scheduled for this submission" :initform nil :attribute t))
(:default-initargs :type "application/pdf"))
(defmethod destroy-object :before ((timeslot timeslot))
@@ -24,13 +24,13 @@
(setf (submission-submitters submission) (remove submitter (submission-submitters submission)))
(setf (participant-submissions submitter) (remove submission (participant-submissions submitter))))
-(define-persistent-class paper (submission)
+(define-lisp-ecoop-class paper (submission)
())
(defmethod submission-type ((paper paper))
"Paper")
-(define-persistent-class breakout-group-proposal (submission)
+(define-lisp-ecoop-class breakout-group-proposal (submission)
())
(defmethod submission-type ((breakout-group-proposal breakout-group-proposal))
@@ -42,7 +42,7 @@
((:a :href #?"/submission/$((store-object-id submission))")
(:princ-safe (submission-title submission))))))
-(define-persistent-class participant (user)
+(define-lisp-ecoop-class participant (user)
((url :update :documentation "Personal Website URL" :initform nil)
(picture :update :documentation "Photo of the participant")
(submissions :update :documentation "Submitted documents" :initform nil)
@@ -86,9 +86,9 @@
(format nil "~(~36,6,'0R~)" (random (parse-integer "1000000" :radix 36))))
(defmethod send-welcome-mail ((participant participant) initial-password)
- (user-send-mail participant :subject "Your account on the LISP ECOOP 05 workshop website has been created"
+ (user-send-mail participant :subject "Your account on the LISP ECOOP workshop website has been created"
:text (format nil
-"Your participant account on the LISP ECOOP05 Workshop website has
+"Your participant account on the LISP ECOOP Workshop website has
been created. Please visit your personal profile page on
http://lisp-ecoop.bknr.net/edit-profile/ to change your password
andupdate your profile information.
@@ -106,9 +106,9 @@
(defmethod participant-reset-password (participant &optional (password (generate-random-password)))
(set-user-password participant password)
(user-send-mail participant
- :subject "Your password for the LISP ECOOP 05 workshop website"
+ :subject "Your password for the LISP ECOOP workshop website"
:text (format nil
-"Your password on the LISP ECOOP 05 Workshop website has been reset.
+"Your password on the LISP ECOOP Workshop website has been reset.
Please visit your personal profile page on
http://lisp-ecoop.bknr.net/edit-profile/~A to change your password
and update your profile information.
Modified: trunk/projects/lisp-ecoop/src/schedule.lisp
===================================================================
--- trunk/projects/lisp-ecoop/src/schedule.lisp 2006-02-14 21:57:58 UTC (rev 1834)
+++ trunk/projects/lisp-ecoop/src/schedule.lisp 2006-02-17 19:41:42 UTC (rev 1835)
@@ -2,10 +2,16 @@
(enable-interpol-syntax)
-(define-persistent-class timeslot ()
- ((begin-time :update :documentation "Start of the presentation/session (universal time)")
- (duration :update :documentation "Length of the presentation/session (seconds)")
- (content :update :documentation "Content of the timeslot, may be any object which responds to print-object-as-html")))
+(define-lisp-ecoop-class timeslot ()
+ ((begin-time :update
+ :attribute t
+ :documentation "Start of the presentation/session (universal time)")
+ (duration :update
+ :attribute t
+ :documentation "Length of the presentation/session (seconds)")
+ (content :update
+ :attribute t
+ :documentation "Content of the timeslot, may be any object which responds to print-object-as-html")))
(defmethod timeslot-end-time ((timeslot timeslot))
(+ (timeslot-begin-time timeslot)
Modified: trunk/projects/lisp-ecoop/src/webserver.lisp
===================================================================
--- trunk/projects/lisp-ecoop/src/webserver.lisp 2006-02-14 21:57:58 UTC (rev 1834)
+++ trunk/projects/lisp-ecoop/src/webserver.lisp 2006-02-17 19:41:42 UTC (rev 1835)
@@ -15,9 +15,8 @@
1 0 :every :every))
(make-instance 'website
- :name "LISP ECOOP 2005 CMS"
- :handler-definitions `(("/js-drag" js-drag-handler)
- ("/" redirect-handler
+ :name "LISP ECOOP CMS"
+ :handler-definitions `(("/" redirect-handler
:to "/home")
("/" template-handler
:destination ,(namestring (merge-pathnames #p"templates/" *website-directory*))
More information about the Bknr-cvs
mailing list