: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
`(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"
- input-id ucw::+session-parameter-name+
+ input-id "session"
(ucw::session.id (ucw::context.session ucw::*context*))))
(defaction on-submit ((l auto-complete))
(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,
(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)))
(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)
())
(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))))))
(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)
(<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
- (render)))
+ (render-s)))
;; presentation is used only for rendering
- (render)))))
\ No newline at end of file
+ (render-s)))))
\ No newline at end of file
;;;; ** 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)
"
(when attributes
(setf args
(cons `(:attributes ,attributes) args)))
- `(mewa:make-presentation
+ `(mewa::make-presentation
,object
:type ,type
,@(when args
(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)
- (lol:present ,view))))
+ (lol::present ,view))))
(defmacro call-view ((object &optional (type :viewer) (component 'self component-supplied-p))
:it.bese.ucw
:clsql
:contextl)
+ (:nicknames :lol :mewa)
+
(: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
:define-attributes
;; presentation objects
- :present
- :instance
:mewa-object-presentation
:mewa-one-line-presentation
:mewa-list-presentation
:editablep
:global-properties
;; SLOT presentations
- :defslot-presentation
- :slot-name
+
: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
(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
-(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
(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)
(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)))
+;; i know this is horrible, but it works wonders.
(declaim (optimize (speed 0) (space 3) (safety 0)))
+
+
(in-package :lisp-on-lines)
(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)))))
-(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)))))
(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))
- (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)
- (<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 "
(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)
(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)
: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)
- (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)
- (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")))
- (if (presentation-slot-value slot instance)
+ (if (lol::presentation-slot-value slot instance)
(progn
- (lol:present
+ (lol::present
(lol:make-presentation (meta-model:explode-foreign-key instance (slot-name slot))
:type :one-line
:initargs