Massive patch to catch up to ucw_dev
authorDrew Crampsie <drewc@tech.coop>
Tue, 6 Dec 2005 06:39:50 +0000 (22:39 -0800)
committerDrew Crampsie <drewc@tech.coop>
Tue, 6 Dec 2005 06:39:50 +0000 (22:39 -0800)
This Patch breaks backwards compatability in a number of ways.

** None of the presentation stuff is exported anymore. UCW now exports the same symbols, and LoL is moving away from the presentation system anyway.
** The ajax stuff is broken and will soon be removed completely in favour of some dojo stuff i've got.

This makes it difficult to create your own components for use with Mewa. The ContextL based system is coming soon.

darcs-hash:20051206063950-5417e-35fe4437c7bd94ccbe149513709d48470c2c9c45.gz

src/components/ajax.lisp
src/lisp-on-lines.lisp
src/packages.lisp
src/presentations.lisp
src/slot-presentations.lisp

index 9092f24..6b4f23f 100644 (file)
@@ -30,7 +30,7 @@
     :documentation  "The lisp value of the object selecting in the drop down")
    (as-value :accessor as-value :initarg :as-value
              :documentation "Function which, when passed a value, returns the string to put in the text box.")
     :documentation  "The lisp value of the object selecting in the drop down")
    (as-value :accessor as-value :initarg :as-value
              :documentation "Function which, when passed a value, returns the string to put in the text box.")
-   (render :accessor render :initarg :render
+   (render-it :accessor render-it :initarg :render
            :documentation "Function which, when passed the component and one of the values render it (the value).")
    (input-size :accessor input-size :initarg :input-size :initform 20)
    (submit-on-select-p 
            :documentation "Function which, when passed the component and one of the values render it (the value).")
    (input-size :accessor input-size :initarg :input-size :initform 20)
    (submit-on-select-p 
@@ -71,30 +71,11 @@ but here's what i use."
   `(generate-ajax-request
     (make-action-url ,component (progn ,@action)))) 
        
   `(generate-ajax-request
     (make-action-url ,component (progn ,@action)))) 
        
-(defaction call-auto-complete ((self t) auto-complete-id value index)
-    (let ((auto-complete (get-session-value (intern auto-complete-id))))
-    (if auto-complete
-        (if index
-           (select-value auto-complete index)
-           (call-auto-complete-from-output auto-complete auto-complete-id value self))
-        (call 'empty-page :message (error "Cannot find")))))
-
-(defaction call-auto-complete-from-output ((auto-complete auto-complete) auto-complete-id value output)
-  (setf (client-value auto-complete) value)
-  (let ((self output))
-    (call (output-component-name auto-complete) :auto-complete auto-complete)
-    (call 'empty-page :message (error "ASD"))))
-
-(defaction select-value ((self auto-complete) index)
-  (let ((index (when (< 0 (length index))
-                (parse-integer index))))
-    (setf (index self) index)
-    (setf (value self) (nth index (list-of-values self)))))
 
 (defun make-auto-complete-url (input-id)
   "creates a url that calls the auto-complete entry-point for INPUT-ID."
   (format nil "auto-complete.ucw?&auto-complete-id=~A&~A=~A" 
 
 (defun make-auto-complete-url (input-id)
   "creates a url that calls the auto-complete entry-point for INPUT-ID."
   (format nil "auto-complete.ucw?&auto-complete-id=~A&~A=~A" 
-         input-id  ucw::+session-parameter-name+ 
+         input-id  "session"  
          (ucw::session.id (ucw::context.session ucw::*context*))))
 
 (defaction on-submit ((l auto-complete))
          (ucw::session.id (ucw::context.session ucw::*context*))))
 
 (defaction on-submit ((l auto-complete))
@@ -111,7 +92,7 @@ but here's what i use."
       (submit-form))))
    
 
       (submit-form))))
    
 
-(defmethod render-on ((res response) (l auto-complete))
+(defmethod render ( (l auto-complete))
   ;; session-values are stored in an eql hash table.
   (let ((input-key (intern (input-id l))))
     ;; We are storing the input components in the session,
   ;; session-values are stored in an eql hash table.
   (let ((input-key (intern (input-id l))))
     ;; We are storing the input components in the session,
@@ -154,7 +135,7 @@ but here's what i use."
 (defcomponent auto-complete-output (window-component)
   ((auto-complete :initarg :auto-complete :accessor auto-complete)))
 
 (defcomponent auto-complete-output (window-component)
   ((auto-complete :initarg :auto-complete :accessor auto-complete)))
 
-(defmethod render-on ((res response) (output auto-complete-output))
+(defmethod render ((output auto-complete-output))
   (let ((auto-complete (auto-complete output)))
     (setf (list-of-values auto-complete)
          (funcall (values-generator auto-complete) (client-value auto-complete)))
   (let ((auto-complete (auto-complete output)))
     (setf (list-of-values auto-complete)
          (funcall (values-generator auto-complete) (client-value auto-complete)))
@@ -163,7 +144,8 @@ but here's what i use."
      (arnesi:dolist* (value (list-of-values auto-complete))
        (<:li 
        :class "auto-complete-list-item"
      (arnesi:dolist* (value (list-of-values auto-complete))
        (<:li 
        :class "auto-complete-list-item"
-       (funcall (render auto-complete) value))))))
+       (funcall (render-it auto-complete) value))))
+    (answer-component output t)))
 
 (defcomponent fkey-auto-complete (auto-complete)
   ())
 
 (defcomponent fkey-auto-complete (auto-complete)
   ())
@@ -197,7 +179,7 @@ but here's what i use."
            (word-search class-name  
                         (search-slots slot)  input)))
                    
            (word-search class-name  
                         (search-slots slot)  input)))
                    
-    (setf (lisp-on-lines::render l)
+    (setf (lisp-on-lines::render-it l)
          (lambda (val) 
            (<ucw:render-component 
             :component (make-presentation val :type :one-line))))))
          (lambda (val) 
            (<ucw:render-component 
             :component (make-presentation val :type :one-line))))))
@@ -216,7 +198,7 @@ but here's what i use."
                   (when (presentation-slot-value slot instance) 
                     (meta-model:explode-foreign-key instance (slot-name slot)))))))
     
                   (when (presentation-slot-value slot instance) 
                     (meta-model:explode-foreign-key instance (slot-name slot)))))))
     
-    (flet ((render () (when foreign-instance (call-next-method))))
+    (flet ((render-s () (when foreign-instance (call-next-method))))
       (if (slot-boundp slot 'ucw::place)
          (cond 
            ((editablep slot)
       (if (slot-boundp slot 'ucw::place)
          (cond 
            ((editablep slot)
@@ -233,8 +215,8 @@ but here's what i use."
                              (<ucw:submit :action  (mewa::search-records slot instance) :value "find" :style "display:inline"))
            ((mewa::linkedp slot)
             (<ucw:a :action (mewa::view-instance slot foreign-instance) 
                              (<ucw:submit :action  (mewa::search-records slot instance) :value "find" :style "display:inline"))
            ((mewa::linkedp slot)
             (<ucw:a :action (mewa::view-instance slot foreign-instance) 
-                    (render)))
+                    (render-s)))
            (t       
            (t       
-            (render)))
+            (render-s)))
          ;; presentation is used only for rendering
          ;; presentation is used only for rendering
-         (render)))))
\ No newline at end of file
+         (render-s)))))
\ No newline at end of file
index 31892be..a5415ae 100644 (file)
@@ -9,6 +9,7 @@
 
 ;;;; ** Initialisation
 ;;;; The following macros are used to initialise a set of database tables as LoL objects.
 
 ;;;; ** Initialisation
 ;;;; The following macros are used to initialise a set of database tables as LoL objects.
+
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun generate-define-view-for-table (table)
     "
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun generate-define-view-for-table (table)
     "
@@ -35,7 +36,7 @@ This involves creating a meta-model, a clsql view-class, and the setting up the
       (when attributes
        (setf args
              (cons `(:attributes ,attributes) args)))
       (when attributes
        (setf args
              (cons `(:attributes ,attributes) args)))
-      `(mewa:make-presentation
+      `(mewa::make-presentation
        ,object
        :type ,type
        ,@(when args
        ,object
        :type ,type
        ,@(when args
@@ -52,13 +53,13 @@ This involves creating a meta-model, a clsql view-class, and the setting up the
 (defmacro present-view ((object &optional (type :viewer) (parent 'self))
                        &body attributes-and-args)
   (arnesi:with-unique-names (view)
 (defmacro present-view ((object &optional (type :viewer) (parent 'self))
                        &body attributes-and-args)
   (arnesi:with-unique-names (view)
-    `(let ((,view (lol:make-view ,object
+    `(let ((,view (lol::make-view ,object
                                 :type ,type
                                 ,@(when (car attributes-and-args)
                                         `(:attributes ',(car attributes-and-args))) 
                                 ,@ (cdr attributes-and-args))))
       (setf (ucw::parent ,view) ,parent)
                                 :type ,type
                                 ,@(when (car attributes-and-args)
                                         `(:attributes ',(car attributes-and-args))) 
                                 ,@ (cdr attributes-and-args))))
       (setf (ucw::parent ,view) ,parent)
-      (lol:present ,view))))
+      (lol::present ,view))))
 
 
 (defmacro call-view ((object &optional (type :viewer) (component 'self component-supplied-p))
 
 
 (defmacro call-view ((object &optional (type :viewer) (component 'self component-supplied-p))
index 4b5e552..c97a07c 100644 (file)
@@ -6,10 +6,36 @@
        :it.bese.ucw
        :clsql
        :contextl)
        :it.bese.ucw
        :clsql
        :contextl)
+  (:nicknames :lol :mewa)
+  
   (:shadowing-import-from
    :iterate
    :with)
   (:shadowing-import-from
    :iterate
    :with)
-  (:nicknames :lol :mewa)
+
+  (:shadowing-import-from
+   :clsql
+   :time-difference
+   :make-time
+   :time-ymd
+   :date
+   :get-time
+   :time-element
+   :time+
+   :date-element)
+
+  (:shadow
+   :present
+   :present-slot
+   :presentation
+   :instance
+   :slot-presentation
+   :integer-slot-presentation
+   :string-slot-presentation
+   :object-presentation
+   :one-line-presentation
+   :presentation-slot-value
+   :get-foreign-instances)
+  
   (:export 
    ;;;; LoL 
    :define-view-for-table
   (:export 
    ;;;; LoL 
    :define-view-for-table
@@ -43,8 +69,6 @@
    :define-attributes
 
    ;; presentation objects
    :define-attributes
 
    ;; presentation objects
-   :present
-   :instance
    :mewa-object-presentation
    :mewa-one-line-presentation
    :mewa-list-presentation
    :mewa-object-presentation
    :mewa-one-line-presentation
    :mewa-list-presentation
    :editablep
    :global-properties
    ;; SLOT presentations
    :editablep
    :global-properties
    ;; SLOT presentations
-   :defslot-presentation
-   :slot-name
+  
    :mewa-relation-slot-presentation
    :mewa-string-slot-presentation
    :mewa-relation-slot-presentation
    :mewa-string-slot-presentation
-   :has-many-slot-presentation
-   :present-slot
-
+   :has-many-slot-presentation 
    :has-a
    :has-many
    :has-very-many
    :has-a
    :has-many
    :has-very-many
index 64f3c24..901548a 100644 (file)
@@ -1,11 +1,15 @@
 (declaim (optimize (speed 0) (space 3) (safety 0)))
 (in-package :lisp-on-lines)
 
 (declaim (optimize (speed 0) (space 3) (safety 0)))
 (in-package :lisp-on-lines)
 
+
+(defmethod render ((self mewa))
+  (lol::present self))
+
 (defaction edit-instance ((self mewa))
   (call-presentation (instance self) :type :editor))
 
 ;;;one-line objects
 (defaction edit-instance ((self mewa))
   (call-presentation (instance self) :type :editor))
 
 ;;;one-line objects
-(defcomponent mewa-one-line-presentation (mewa one-line-presentation)
+(defcomponent mewa-one-line-presentation (mewa lol::one-line-presentation)
   ()
   (:default-initargs
    :attributes-getter #'one-line-attributes-getter
   ()
   (:default-initargs
    :attributes-getter #'one-line-attributes-getter
@@ -16,7 +20,7 @@
       (meta-model::list-keys (instance self))))
 
 ;;;objects
       (meta-model::list-keys (instance self))))
 
 ;;;objects
-(defcomponent mewa-object-presentation (mewa object-presentation) 
+(defcomponent mewa-object-presentation (mewa lol::object-presentation) 
   ((instance :accessor instance :initarg :instance :initform nil)))
 
 (defcomponent mewa-viewer (mewa-object-presentation)
   ((instance :accessor instance :initarg :instance :initform nil)))
 
 (defcomponent mewa-viewer (mewa-object-presentation)
@@ -37,7 +41,7 @@
     (dolist (slot (slots pres))
       (<:tr :class "presentation-slot-row"
            (present-slot-as-row pres slot))))
     (dolist (slot (slots pres))
       (<:tr :class "presentation-slot-row"
            (present-slot-as-row pres slot))))
-    (render-options pres (instance pres)))
+  (render-options pres (instance pres)))
         
 (defmethod present-slot-as-row ((pres mewa-object-presentation) (slot slot-presentation))
   (<:td :class "presentation-slot-label" (<:as-html (label slot)))
         
 (defmethod present-slot-as-row ((pres mewa-object-presentation) (slot slot-presentation))
   (<:td :class "presentation-slot-label" (<:as-html (label slot)))
index c92fa4b..02fb818 100644 (file)
@@ -1,4 +1,7 @@
+;; i know this is horrible, but it works wonders.
 (declaim (optimize (speed 0) (space 3) (safety 0)))
 (declaim (optimize (speed 0) (space 3) (safety 0)))
+
+
 (in-package :lisp-on-lines)
 
 
 (in-package :lisp-on-lines)
 
 
@@ -95,12 +98,12 @@ When T, only the default value for primary keys and the joins are updated.")
        (default-to-now-p :accessor default-to-now-p :initarg :default-to-now-p :initform nil))
        (:type-name clsql-sys:wall-time))
 
        (default-to-now-p :accessor default-to-now-p :initarg :default-to-now-p :initform nil))
        (:type-name clsql-sys:wall-time))
 
-(defmethod presentation-slot-value ((slot clsql-wall-time-slot-presentation) instance)
+(defmethod lol::presentation-slot-value ((slot clsql-wall-time-slot-presentation) instance)
   (let ((date (call-next-method)))
     (when date (multiple-value-bind (y m d) (clsql:time-ymd date)
       (format nil "~a/~a/~a" m d y)))))
 
   (let ((date (call-next-method)))
     (when date (multiple-value-bind (y m d) (clsql:time-ymd date)
       (format nil "~a/~a/~a" m d y)))))
 
-(defmethod (setf presentation-slot-value) ((value string) (slot clsql-wall-time-slot-presentation) instance)
+(defmethod (setf lol::presentation-slot-value) ((value string) (slot clsql-wall-time-slot-presentation) instance)
   (let ((new-time (clsql:parse-date-time (remove #\Space value)))
        (old-time (when (slot-boundp instance (slot-name slot))
                    (slot-value instance (slot-name slot)))))
   (let ((new-time (clsql:parse-date-time (remove #\Space value)))
        (old-time (when (slot-boundp instance (slot-name slot))
                    (slot-value instance (slot-name slot)))))
@@ -112,17 +115,17 @@ When T, only the default value for primary keys and the joins are updated.")
 (defmethod label :around ((slot clsql-wall-time-slot-presentation))
   (concatenate 'string (call-next-method) "  (m/d/y)"))
 
 (defmethod label :around ((slot clsql-wall-time-slot-presentation))
   (concatenate 'string (call-next-method) "  (m/d/y)"))
 
-(defmethod present-slot ((slot clsql-wall-time-slot-presentation) instance)
-  (let ((date (presentation-slot-value slot instance)))
+(defmethod lol::present-slot ((slot clsql-wall-time-slot-presentation) instance)
+  (let ((date (lol::presentation-slot-value slot instance)))
     ;; Default values
     (when (and (not date) (default-to-now-p slot))
     ;; Default values
     (when (and (not date) (default-to-now-p slot))
-      (setf (presentation-slot-value slot instance) (clsql:get-time)))
+      (setf (lol::presentation-slot-value slot instance) (clsql:get-time)))
     ;;simple viewer
     (if (and date (not (editablep slot)))
        (<:as-html date))
     ;; editor
     (when (editablep slot)
     ;;simple viewer
     (if (and date (not (editablep slot)))
        (<:as-html date))
     ;; editor
     (when (editablep slot)
-      (<ucw:input :accessor (presentation-slot-value slot instance) :id (input-id slot) :style "display:inline")
+      (<ucw:input :accessor (lol::presentation-slot-value slot instance) :id (input-id slot) :style "display:inline")
       (<:button :id (trigger-id slot) (<:as-html "[...]"))
       (<:script :type "text/javascript" 
                (<:as-is (format nil " 
       (<:button :id (trigger-id slot) (<:as-html "[...]"))
       (<:script :type "text/javascript" 
                (<:as-is (format nil " 
@@ -217,7 +220,7 @@ Calendar.setup({
 
 (defmethod  present-slot :around ((slot foreign-key-slot-presentation) instance)  
   (setf (foreign-instance slot) 
 
 (defmethod  present-slot :around ((slot foreign-key-slot-presentation) instance)  
   (setf (foreign-instance slot) 
-       (when (presentation-slot-value slot instance) 
+       (when (lol::presentation-slot-value slot instance) 
          (meta-model:explode-foreign-key instance (slot-name slot))))
   (flet ((render () (when (foreign-instance slot)(call-next-method))))
     (if (slot-boundp slot 'ucw::place)
          (meta-model:explode-foreign-key instance (slot-name slot))))
   (flet ((render () (when (foreign-instance slot)(call-next-method))))
     (if (slot-boundp slot 'ucw::place)
@@ -299,7 +302,7 @@ Calendar.setup({
 (defmethod get-foreign-instances ((slot has-many-slot-presentation) instance)
   (slot-value instance (slot-name slot)))
 
 (defmethod get-foreign-instances ((slot has-many-slot-presentation) instance)
   (slot-value instance (slot-name slot)))
 
-(defmethod presentation-slot-value ((slot has-many-slot-presentation) instance)
+(defmethod lol::presentation-slot-value ((slot has-many-slot-presentation) instance)
   (get-foreign-instances slot instance))
 
 (defslot-presentation has-very-many-slot-presentation (has-many-slot-presentation)
   (get-foreign-instances slot instance))
 
 (defslot-presentation has-very-many-slot-presentation (has-many-slot-presentation)
@@ -360,24 +363,24 @@ Calendar.setup({
                :flatp t))
 
 (defmethod present-slot ((slot has-a-slot-presentation) instance)
                :flatp t))
 
 (defmethod present-slot ((slot has-a-slot-presentation) instance)
-;      (<:as-html (presentation-slot-value slot instance))
+;      (<:as-html (lol::presentation-slot-value slot instance))
   (if (editablep slot)
   (if (editablep slot)
-      (progn (<ucw:select :accessor (presentation-slot-value slot instance) :test #'equalp
+      (progn (<ucw:select :accessor (lol::presentation-slot-value slot instance) :test #'equalp
         (when (allow-nil-p slot)
          (<ucw:option :value nil (<:as-html "none")))
        (dolist (option (get-foreign-instances slot instance))
          (<ucw:option :value (find-foreign-slot-value slot option)
         (when (allow-nil-p slot)
          (<ucw:option :value nil (<:as-html "none")))
        (dolist (option (get-foreign-instances slot instance))
          (<ucw:option :value (find-foreign-slot-value slot option)
-                      (lol:present
-                       (lol:make-presentation option
+                      (lol::present
+                       (lol::make-presentation option
                           :type :as-string
                           :initargs
                           `(:attributes ,(attributes slot)))
                        ))))
             (when (creatablep slot)
               (<ucw:submit :action  (create-record-on-foreign-key slot instance) :value "Add New" :style "display:inline"))) 
                           :type :as-string
                           :initargs
                           `(:attributes ,(attributes slot)))
                        ))))
             (when (creatablep slot)
               (<ucw:submit :action  (create-record-on-foreign-key slot instance) :value "Add New" :style "display:inline"))) 
-      (if (presentation-slot-value slot instance)
+      (if (lol::presentation-slot-value slot instance)
          (progn
          (progn
-          (lol:present
+          (lol::present
            (lol:make-presentation (meta-model:explode-foreign-key instance (slot-name slot))
                           :type :one-line
                           :initargs
            (lol:make-presentation (meta-model:explode-foreign-key instance (slot-name slot))
                           :type :one-line
                           :initargs