From 1d51a2eea8537084e9e681c297422047ae858989 Mon Sep 17 00:00:00 2001 From: drewc Date: Thu, 6 Sep 2007 17:10:35 -0700 Subject: [PATCH] removing historical implementation darcs-hash:20070907001035-39164-b7e33fc79b22c89284a6c591fbb8b21303b0aab8.gz --- LICENSE | 10 - README | 18 -- TODO | 0 lisp-on-lines.asd | 57 ++++- patches/yaclml.lisp | 15 -- reddit-example.lisp | 99 -------- src/attributes/dojo-attributes.lisp | 84 ------- src/attributes/numbers.lisp | 64 ----- src/attributes/relational-attributes.lisp | 132 ---------- src/attributes/standard-attributes.lisp | 293 ---------------------- src/defdisplay.lisp | 99 +++----- src/mewa.lisp | 136 +++------- src/packages.lisp | 36 ++- src/standard-display.lisp | 6 +- src/validation/email-address.lisp | 27 -- src/validation/standard-validation.lisp | 124 --------- src/validation/validation.lisp | 88 ------- 17 files changed, 145 insertions(+), 1143 deletions(-) delete mode 100644 LICENSE delete mode 100644 README delete mode 100644 TODO delete mode 100644 patches/yaclml.lisp delete mode 100644 reddit-example.lisp delete mode 100644 src/attributes/dojo-attributes.lisp delete mode 100644 src/attributes/numbers.lisp delete mode 100644 src/attributes/relational-attributes.lisp delete mode 100644 src/attributes/standard-attributes.lisp delete mode 100644 src/validation/email-address.lisp delete mode 100644 src/validation/standard-validation.lisp delete mode 100644 src/validation/validation.lisp diff --git a/LICENSE b/LICENSE deleted file mode 100644 index 47ddfcd..0000000 --- a/LICENSE +++ /dev/null @@ -1,10 +0,0 @@ -LISP-ON-LINES : A system from rapid web application development. - -Copyright(c) Drew Crampsie, 2004-2005 -With funding from The Tech Co-op (http://tech.coop) - -LISP-ON-LINES is licensed under the terms of the Lisp Lesser GNU -Public License (http://opensource.franz.com/preamble.html), known as -the LLGPL. The LLGPL consists of a preamble (see above URL) and the -LGPL. Where these conflict, the preamble takes precedence. -LISP-ON-LINES is referenced in the preamble as the "LIBRARY." diff --git a/README b/README deleted file mode 100644 index 59beed0..0000000 --- a/README +++ /dev/null @@ -1,18 +0,0 @@ -LISP-ON-LINES - -This is a very early release, and there are more bugs then docs. HERE BE DRAGONS! - -Having said that, LOL has been used to deliver applications and is undergoing extensive development. - -Take a look at the doc/ directory to get started. The (poorly commented) code is your next stop. -Adding docstrings would be a good idea. - -drewc@tech.coop or #tech.coop on freenode for support.. that we have plenty of. - -;; This software is Copyright (c) Drew Crampsie, 2004-2005. -;; You are granted the rights to distribute -;; and use this software as governed by the terms -;; of the Lisp Lesser GNU Public License -;; (http://opensource.franz.com/preamble.html), -;; known as the LLGPL. - diff --git a/TODO b/TODO deleted file mode 100644 index e69de29..0000000 diff --git a/lisp-on-lines.asd b/lisp-on-lines.asd index 12306c7..4e98728 100644 --- a/lisp-on-lines.asd +++ b/lisp-on-lines.asd @@ -9,16 +9,48 @@ (in-package :coop.tech.systems) (defsystem :lisp-on-lines + :license +"Copyright (c) 2004-2007 Drew Crampsie + +Contains portions of ContextL: +Copyright (c) 2005 - 2007 Pascal Costanza + +Permission is hereby granted, free of charge, to any person +obtaining a copy of this software and associated documentation +files (the \"Software\"), to deal in the Software without +restriction, including without limitation the rights to use, +copy, modify, merge, publish, distribute, sublicense, and/or +sell copies of the Software, and to permit persons to whom the +Software is furnished to do so, subject to the following +conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +OTHER DEALINGS IN THE SOFTWARE." :components ((:static-file "lisp-on-lines.asd") - (:module :patches - :components ((:file "yaclml") - (:file "ucw") - (:file "clsql"))) + (:module :src :components ((:file "packages") - (:file "special-initargs") - (:file "properties") - (:file "mewa") + (:file "utilities") + (:file "display") + + (:file "attributes") + + (:file "description-class") + (:file "description") + + + (:file "description-test") + (:file "attribute-test") +#| (:file "mewa") (:file "lisp-on-lines") (:file "defdisplay") (:file "standard-display") @@ -33,16 +65,23 @@ (:file "relational-attributes") (:file "dojo-attributes")) :serial t) + (:module :displays + :components ((:file "inspector")) + + :serial t) (:module :validation :components ((:file "validation") (:file "standard-validation") (:file "email-address")) - :serial t) + :serial t)|# ) :serial t)) :serial t - :depends-on (:arnesi :ucw :meta-model :split-sequence :contextl :cl-ppcre :cl-fad)) + :depends-on (:contextl + :stefil + :arnesi ;:ucw :stefil :meta-model :split-sequence :cl-ppcre :cl-fad + )) (defsystem :lisp-on-lines.example :components ( diff --git a/patches/yaclml.lisp b/patches/yaclml.lisp deleted file mode 100644 index 6a7b26c..0000000 --- a/patches/yaclml.lisp +++ /dev/null @@ -1,15 +0,0 @@ -(in-package :yaclml) - -(defun funcall-with-tag (tag-spec thunk) - (let ((%yaclml-code% nil) - (%yaclml-indentation-depth% 0)) - (declare (special %yaclml-code%)) - ;; build tag's body - (dolist (i (fold-strings - (nreverse - (funcall (gethash (car (ensure-list tag-spec)) *expanders*) - (append (cdr tag-spec) (list - thunk)))))) - (if (functionp i) - (funcall i) - (write-string i *yaclml-stream*))))) \ No newline at end of file diff --git a/reddit-example.lisp b/reddit-example.lisp deleted file mode 100644 index 73821bc..0000000 --- a/reddit-example.lisp +++ /dev/null @@ -1,99 +0,0 @@ -(in-package :lol) - -(defvar *lol-example-application* - (make-instance 'cookie-session-application - :url-prefix "/lisp-on-lines/" - :tal-generator (make-instance 'yaclml:file-system-generator - :cachep t - :root-directories (list *ucw-tal-root*)) - :www-roots (list (merge-pathnames "./" *ucw-tal-root*)) - :debug-on-error t)) - -(defentry-point "reddit" (:application *lol-example-application*) () - (call 'front-page)) - -(defcomponent front-page (simple-window-component) - () - (:default-initargs - :javascript "/dojo/dojo.js")) - -(defmethod render ((self front-page)) - (with-component (self) - (<:h1 (<:as-html "Lisp on Lines : Reddit Example")) - - ( :key #'score)) - -(defattribute link-attribute () - () - (:type-name link)) - -(defdisplay (:description (link link-attribute)) - (<:a :href (url object) - (<:as-html (title object)))) - -(defattribute score-buttons () - () - (:type-name score-buttons)) - -(defdisplay (:description (score score-buttons)) - (@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\"(?:[^\\\"\\r\\\\]|\\\\.|(?:(?:\\r\\n)?[ \\t]))*\"(?:(?:\\r\\n)?[ \\t])*)(?:\\.(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\"(?:[^\\\"\\r\\\\]|\\\\.|(?:(?:\\r\\n)?[ \\t]))*\"(?:(?:\\r\\n)?[ \\t])*))*@(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*)(?:\\.(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*))*|(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\"(?:[^\\\"\\r\\\\]|\\\\.|(?:(?:\\r\\n)?[ \\t]))*\"(?:(?:\\r\\n)?[ \\t])*)*\\<(?:(?:\\r\\n)?[ \\t])*(?:@(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*)(?:\\.(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*))*(?:,@(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*)(?:\\.(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*))*)*:(?:(?:\\r\\n)?[ \\t])*)?(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\"(?:[^\\\"\\r\\\\]|\\\\.|(?:(?:\\r\\n)?[ \\t]))*\"(?:(?:\\r\\n)?[ \\t])*)(?:\\.(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\"(?:[^\\\"\\r\\\\]|\\\\.|(?:(?:\\r\\n)?[ \\t]))*\"(?:(?:\\r\\n)?[ \\t])*))*@(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*)(?:\\.(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*))*\\>(?:(?:\\r\\n)?[ \\t])*)|(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\"(?:[^\\\"\\r\\\\]|\\\\.|(?:(?:\\r\\n)?[ \\t]))*\"(?:(?:\\r\\n)?[ \\t])*)*:(?:(?:\\r\\n)?[ \\t])*(?:(?:(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\"(?:[^\\\"\\r\\\\]|\\\\.|(?:(?:\\r\\n)?[ \\t]))*\"(?:(?:\\r\\n)?[ \\t])*)(?:\\.(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\"(?:[^\\\"\\r\\\\]|\\\\.|(?:(?:\\r\\n)?[ \\t]))*\"(?:(?:\\r\\n)?[ \\t])*))*@(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*)(?:\\.(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*))*|(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\"(?:[^\\\"\\r\\\\]|\\\\.|(?:(?:\\r\\n)?[ \\t]))*\"(?:(?:\\r\\n)?[ \\t])*)*\\<(?:(?:\\r\\n)?[ \\t])*(?:@(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*)(?:\\.(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*))*(?:,@(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*)(?:\\.(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*))*)*:(?:(?:\\r\\n)?[ \\t])*)?(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\"(?:[^\\\"\\r\\\\]|\\\\.|(?:(?:\\r\\n)?[ \\t]))*\"(?:(?:\\r\\n)?[ \\t])*)(?:\\.(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\"(?:[^\\\"\\r\\\\]|\\\\.|(?:(?:\\r\\n)?[ \\t]))*\"(?:(?:\\r\\n)?[ \\t])*))*@(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*)(?:\\.(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*))*\\>(?:(?:\\r\\n)?[ \\t])*)(?:,\\s*(?:(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\"(?:[^\\\"\\r\\\\]|\\\\.|(?:(?:\\r\\n)?[ \\t]))*\"(?:(?:\\r\\n)?[ \\t])*)(?:\\.(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\"(?:[^\\\"\\r\\\\]|\\\\.|(?:(?:\\r\\n)?[ \\t]))*\"(?:(?:\\r\\n)?[ \\t])*))*@(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*)(?:\\.(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*))*|(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\"(?:[^\\\"\\r\\\\]|\\\\.|(?:(?:\\r\\n)?[ \\t]))*\"(?:(?:\\r\\n)?[ \\t])*)*\\<(?:(?:\\r\\n)?[ \\t])*(?:@(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*)(?:\\.(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*))*(?:,@(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*)(?:\\.(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*))*)*:(?:(?:\\r\\n)?[ \\t])*)?(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\"(?:[^\\\"\\r\\\\]|\\\\.|(?:(?:\\r\\n)?[ \\t]))*\"(?:(?:\\r\\n)?[ \\t])*)(?:\\.(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\"(?:[^\\\"\\r\\\\]|\\\\.|(?:(?:\\r\\n)?[ \\t]))*\"(?:(?:\\r\\n)?[ \\t])*))*@(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*)(?:\\.(?:(?:\\r\\n)?[ \\t])*(?:[^()<>@,;:\\\\\".\\[\\] \\000-\\031]+(?:(?:(?:\\r\\n)?[ \\t])+|\\Z|(?=[\\[\"()<>@,;:\\\\\".\\[\\]]))|\\[([^\\[\\]\\r\\\\]|\\\\.)*\\](?:(?:\\r\\n)?[ \\t])*))*\\>(?:(?:\\r\\n)?[ \\t])*))*)?;\\s*)") - -(defvar scanner (cl-ppcre:create-scanner +email-regexp+)) - -(defun validate-email-address (instance attribute value) - (multiple-value-bind (start end) - (cl-ppcre:scan scanner value) - (when (not (and (equal start 0) (equal end (length value)))) - (signal 'attribute-validation-condition - :message (format nil "~A must be a valid email address." - (label attribute)) - :attribute attribute)))) \ No newline at end of file diff --git a/src/validation/standard-validation.lisp b/src/validation/standard-validation.lisp deleted file mode 100644 index 3d616f2..0000000 --- a/src/validation/standard-validation.lisp +++ /dev/null @@ -1,124 +0,0 @@ -(in-package :lisp-on-lines) - -(defstruct invalid-attribute-value - (initial-value nil :read-only t) - (invalid-value nil :read-only t) - (conditions nil :read-only t)) - -(deflayer validate (editor)) - -(defcomponent validation-mixin () - ((validation-conditions - :accessor validation-conditions - :initform nil - :backtrack t) - (inhibit-call-if-invalid-p - :accessor inhibit-call-if-invalid-p - :initform t - :initarg :inhibit-call-if-invalid-p) - (inhibit-answer-if-invalid-p - :accessor inhibit-answer-if-invalid-p - :initform t - :initarg :inhibit-answer-if-invalid-p))) - -(defmethod render :wrap-around ((self validation-mixin)) - (call-next-method) - (setf (validation-conditions self) nil)) - -(defun component-valid-p (component) - (not (validation-conditions component))) - -(defmethod/cc call-component :around ((from validation-mixin) to) - (if (inhibit-call-if-invalid-p from) - (when (component-valid-p from) - (call-next-method from to)) - (call-next-method from to))) - -(defmethod answer-component :around ((target validation-mixin) value) - (if (inhibit-answer-if-invalid-p target) - (when (component-valid-p target) - (call-next-method)) - (call-next-method))) - -(defparameter *invalid-attribute-renderer* - #'(lambda (invalid-attribute-value next-method) - (<:div - :class "lol-invalid-attribute" - (<:ul - :class "lol-invalid-attribute-message" - (dolist (c (invalid-attribute-value-conditions invalid-attribute-value)) - (<:li (<:as-html (message c))))) - (funcall next-method)))) - -(defattribute base-attribute () - () - (:in-layer validate) - (:default-properties - :validate-using nil - :requiredp nil - :required-test 'validate-string-exists)) - -(defdisplay :in-layer validate - :around ((attribute base-attribute) object) - "Set the callback to perform validation -and create invalid-attribute-values when things don't validate. duh " - (let ((callback (or - (callback attribute) - (ucw::make-new-callback - #'(lambda (val) - (setf (attribute-value object attribute) val))))) - ;;;; We need to lexically bind some slots here - ;;;; As by the time the validator runs we'll be in - ;;;; a totally different dynamic scope. - (validators (validate-using attribute)) - (label (label attribute))) - - ;;;; We have a convenience property for :requiredp - (when (requiredp attribute) - (push (required-test attribute) validators)) - - ;;;; Now we create the validation callback - (dletf (((callback attribute) - (ucw::make-new-callback - #'(lambda (val) - (flet ((setter (value) - (ucw::call-callback - (ucw::context.current-frame *context*) - callback - value))) - - ;; We have to do DLETF ,as we will no longer be - ;; in the validation layer at callback-application time. - (dletf (((validate-using attribute) validators) - ((slot-value attribute 'label) label)) - (multiple-value-bind (validp conditions) - (validate-attribute object attribute val) - (if validp - (setter val) - (progn - (setter - (make-invalid-attribute-value - :initial-value (attribute-value object attribute) - :invalid-value val - :conditions conditions)) - (when (subtypep (type-of self) 'validation-mixin) - (setf (validation-conditions self) - (append conditions (validation-conditions self))))))))))))) - - - ;;;; Ok, so if the attribute-value holds an - ;;;; invalid-attribute-value struct, we take the appropriate action - (let ((value (attribute-value object attribute))) - (if (invalid-attribute-value-p value) - (progn - ;;;; set the value back the the previous - ;;;; TODO: does not handle unbound slots - (ucw::call-callback - (ucw::context.current-frame *context*) - callback - (invalid-attribute-value-initial-value value)) - (funcall *invalid-attribute-renderer* - value - #'(lambda () - (call-next-method)))) - (call-next-method)))))) \ No newline at end of file diff --git a/src/validation/validation.lisp b/src/validation/validation.lisp deleted file mode 100644 index ab5961e..0000000 --- a/src/validation/validation.lisp +++ /dev/null @@ -1,88 +0,0 @@ -(in-package :lisp-on-lines) - -;;;; Validation Conditions - -(define-condition validation-condition () - ((message :accessor message :initarg :message :initform "Invalid value") - (value :accessor value :initarg :value :initform (warn "condition was not given a value")))) - -;;;; ** Attributes -(define-condition attribute-validation-condition (validation-condition) - ((attribute :accessor attribute :initarg :attribute :initform nil))) - -(defgeneric validate-attribute (instance attribute &optional value) - (:documentation " -Returns T if the ATTRIBUTE-VALUE in INSTANCE passes all the validation functions. Otherwise, returns (values nil conditions) where CONDITIONS is a list of conditions representing the validation errors the slot.") - (:method (instance attribute &optional (value nil value-provided-p)) - (let ((val (if value-provided-p - value - (attribute-value instance attribute))) - (conditions)) - (handler-bind ((attribute-validation-condition - #'(lambda (c) - (setf conditions (cons c conditions)) - (signal c)))) - - (dolist (f (find-validation-functions instance attribute)) - (funcall f instance attribute val))) - (if conditions - (values nil conditions) - t)))) - - -(defmethod find-validation-functions (instance (attribute standard-attribute)) - (let ((foo (validate-using attribute))) - (warn "validation?~A " foo) - foo)) - - -;;;; ** Instances -(define-condition instance-validation-condition (validation-condition) - ((instance :accessor instance :initarg instance :initform nil) - (conditions :accessor conditions :initarg :conditions :initform nil))) - -(defmethod invalid-instance-p (instance attributes) - (let (condition) - (handler-bind ((instance-validation-condition - #'(lambda (c) - (setf condition c)))) - (validate-instance instance attributes)) - condition)) - -(defmethod validate-instance (instance attributes) - (let (all-conditions) - (dolist (att attributes) - (multiple-value-bind (is-valid-p conditions) - (validate-attribute instance att) - (unless is-valid-p - (setf all-conditions (nconc conditions all-conditions))))) - (if all-conditions - (progn (signal 'instance-validation-condition - :message "Invalid Instance" - :instance instance - :conditions all-conditions) - (values nil all-conditions)) - - t))) - - -;;;; Attribute Validation Functions -;;;; I have not quite figured all this out yet. -;;;; A generic validation system needs more thought than i've given it, but this is a start. - -(defun validate-string-exists (instance attribute value) - (if (or - (not (stringp value)) - (not (< 0 (length value)))) - (signal 'attribute-validation-condition - :message (format nil "You must enter a value for ~A." - (label attribute)) - :attribute attribute))) - - -(defun validate-true (instance attribute value) - (unless value - (signal 'attribute-validation-condition - :message (format nil "~A is required." - (label attribute)) - :attribute attribute))) \ No newline at end of file -- 2.20.1