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@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@huebner.org" + :version "0" + :maintainer "Hans Huebner hans@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@huebner.org" - :version "0" - :maintainer "Hans Huebner hans@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*) + ,@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*))