(setf (find-attribute t :viewer) 
      '(mewa-object-presentation :global-properties (:editablep nil))
      (find-attribute t :editor)
      '(mewa-object-presentation :global-properties (:editablep t))
      (find-attribute t :one-line)
      '(mewa::mewa-one-line-presentation)
      (find-attribute t :listing)
      '(mewa::mewa-list-presentation :global-properties (:editablep nil) :editablep t))

(def-view-class/table "commercial")
(def-view-class/table "codes")
(def-view-class/table "contract")
(def-view-class/table "policy")
(def-view-class/table "claim")
(def-view-class/table "claim-history")
(def-view-class/table "claimtransaction")
(def-view-class/table "person")

(set-default-attributes (make-instance 'commercial))
(set-default-attributes (make-instance 'codes))
(set-default-attributes (make-instance 'contract))
(set-default-attributes (make-instance 'policy))
(set-default-attributes (make-instance 'claim))
(set-default-attributes (make-instance 'claim-history))
(set-default-attributes (make-instance 'claimtransaction))
(set-default-attributes (make-instance 'person))

(defcomponent person-display (mewa-object-presentation)
  ())

(defcomponent one-line-person (mewa::mewa-one-line-presentation)
  ()
  (:default-initargs :attributes '(first-name last-name company-name)))

(setf (find-attribute 'person :one-line) '(one-line-person))

(set-attribute 'person 'person-type-code '(code-select :category 1))



(defcomponent new-person (person-display)
  ()
  (:default-initargs 
      :attributes '(first-name last-name company-name)))

(defaction ok  ((self new-person) &optional arg)
  (declare (ignore arg))
  (answer (instance self)))

(set-attribute 'person :new-person '(new-person))

)

								    

(defmethod mewa::attributes :around ((self person-display))
  "Remove a few attributes from the default"
  (remove-if #'(lambda (x) (or (eql x 'claim-history->adjuster-id)
			       (eql x 'user-password))) 
			(call-next-method)))

(defmethod mewa::attributes :around ((self mewa-object-presentation))
  "Remove a few attributes from the default"
  (remove-if #'(lambda (x) (or (eql x 'loss-detail)
			       (eql x 'user-password)
			       (eql x 'rec-version)
			       (eql x 'cause-code)
			       (eql x 'risk-number))) 
			(call-next-method)))

(setf (find-attribute 'person :viewer) '(person-display :global-properties (:editablep nil)))

(setf (find-attribute 'person 'claim->adjuster-id) '(ucw::has-very-many :label "Claims as Adjuster" :slot-name claim->adjuster-id ) )

(set-attribute 'person 'policy->agent-id '(ucw::has-very-many :label "Policies as Agent"))

(set-attribute 'contract 'commercial->contract-id '(ucw::has-very-many))


(setf (find-attribute 'claim 'status-code) '(code-select :category 4 :label "Status :" :slot-name status-code))

(set-attribute 'claim 'loss-code '(code-select :category 15))
(set-attribute 'claim 'policy-type-code '(code-select :category 3))
(set-attribute 'claim 'cause-code '(code-select :category 6))

(set-attribute 'claim :one-line '(mewa-one-line-presentation :attributes (claim-id loss-code policy-type-code)))


(set-attribute 'policy 'policy-type-code '(code-select :category 3))

(set-attribute 'person 'policy->company-id '(ucw::has-very-many))
(set-attribute 'policy :one-line '(mewa-one-line-presentation :attributes (policy-type-code insured-id effective-date expiry-date)))


(set-attribute 'commercial 'industry-code '(code-select :category 12))
(set-attribute 'commercial 'coverage-code '(code-select :category 13))
(setf (find-attribute 'commercial :one-line) '(mewa-one-line-presentation :attributes (industry-code policy-id ) ))

(set-attribute 'claimtransaction 'transaction-type-code '(code-select :category 17))
(set-attribute 'claimtransaction 'expense-code '(code-select :category 7))
(set-attribute 'claimtransaction :one-line '(mewa-one-line-presentation :attributes (transaction-type-code expense-code amount)))

(defaction edit ((self component))
  (call-presentation (instance self) :type :editor))

(defmethod render-on :wrapping ((res response) (self mewa-object-presentation))
  (<:h2 (<:as-html (class-name (class-of (instance self)))))
  (<ucw:a :action (edit self) (<:as-html "(edit)"))
  (call-next-method))

(defmethod (setf presentation-slot-value) :before (value (slot slot-presentation) instance)
  (setf (mewa::modifiedp (ucw::parent slot)) instance))



(defaction ok ((self mewa) &optional arg)
  (declare (ignore arg))
  (when (mewa::modifiedp self)
      (call 'info-message :message "modified")
      (add-recent-change (user (body (context.window-component *context*)))  (mewa::modifiedp self))
            (setf (mewa::modifiedp self) nil))

      (answer self))

;;this is in the render-on for my front page :

 (let ((p (make-instance 'person :person-type-code nil)))
   (<:as-html "Add Person :")
  (<ucw:render-component :component (make-presentation p :type :one-line :initargs '(:attributes ((person-type-code :editablep t))))) 
  (<ucw:submit :action (new-person self p) :value  "add"))


;;which creates a drop down list of type codes and a button to click. the ;;new-person action at the bottom takes over from there. First we chack for similar contacts in the database. if they exist we allow them the option to choose one, otherwise return the one we've created.

(defcomponent new-person (person-display)
  ()
  (:default-initargs 
      :attributes '(first-name last-name company-name)))

(defcomponent person-chooser (mewa::mewa-list-presentation)
  ()
  (:default-initargs
      :attributes '(first-name 
		   last-name
		   company-name
		   address
		   city)
    :global-properties '(:editablep nil)
    :editablep nil
    :deleteablep nil))

(defmethod render-on :wrapping ((res response) (self person-chooser))
  (<:p (<:as-html "Similar contact(s) in database. You can :")
       (<:ul
	(<:li (<:as-html "Select one of the contacts below"))
	(<:li (<ucw:a :action (answer (instance self)) 
		      (<:as-html "Continue, adding a new contact")))))
  (call-next-method))
  

(defaction ok  ((self new-person) &optional arg)
  (declare (ignore arg))
  (answer (instance self)))

(set-attribute 'person :new-person '(new-person))

(defaction find-or-return-named-person ((self component) (person person))
  (let* ((search-slots '(first-name last-name company-name)) 
	 (names 
	  (loop for slot in search-slots 
		nconc (split-sequence:split-sequence #\Space 
						     (slot-value person slot))))
	 (instances 
	  (select 'person 
		  :where 
		  (sql-or  
		   (mapcar #'(lambda (x) 
			       (when (< 0 (length x)) 
				 (apply #'sql-or 
					(mapcar #'(lambda (y)  
						    (sql-uplike
						     (sql-slot-value 'person y)
						     (format nil "%~a%" x)))
						search-slots))))
			  names))
		  :flatp t)))
    ;;;(call 'info-message :message instances)
    (if instances
	(call-component self (make-presentation person 
						:type 'person-chooser
						:initargs 
						`(:instances ,instances))))))

(defaction new-person ((self component) person)
  (let ((named-person 
	 (call-component self
			 (make-presentation person 
					    :type :new-person 
					    :initargs '(:global-properties 
						        (:size 25 :editablep t))))))
    (when named-person
      (call-component self (make-presentation
			    (find-or-return-named-person self named-person)
			    :type :editor)))))

(defaction find-or-return-named-person ((self component) (person person))
  (let* ((search-slots '(first-name last-name company-name)) 
	 (names 
	  (loop for slot in search-slots 
		nconc (split-sequence:split-sequence #\Space 
						     (slot-value person slot))))
	 (instances 
	  (select 'person 
		  :where 
		  (sql-or  
		   (mapcar #'(lambda (x) 
			       (when (< 0 (length x)) 
				 (apply #'sql-or 
					(mapcar #'(lambda (y)  
						    (sql-uplike
						     (sql-slot-value 'person y)
						     (format nil "%~a%" x)))
						search-slots))))
			  names))
		  :flatp t)))
    ;;;(call 'info-message :message instances)
    (if instances
	(call-component self (make-presentation person 
						:type 'person-chooser
						:initargs 
						`(:instances ,instances)))
	person)))