+
(in-package :mewa)
(defparameter *default-type* :ucw)
;;; maps meta-model slot-types to slot-presentation
-(defparameter *slot-type-map* '(number ucw:currency))
+(defparameter *slot-type-map*
+ '(boolean ucw::mewa-boolean
+ string ucw::mewa-string
+ number ucw::mewa-currency
+ integer ucw::mewa-integer
+ currency ucw::mewa-currency
+ ))
;;; an alist of model-class-name . attributes
;;; should really be a hash-table.
(mapcar #'(lambda (x) (gen-pslot (cadr x)
(string (car x))
(car x)))
- (list-slot-types instance)))
+ (meta-model:list-slot-types instance)))
(defun gen-pslot (type label slot-name)
(append (mapcar #'(lambda (s)
(cons (car s)
(gen-pslot
- (if (meta-model:foreign-key-p model
- 'ucw::foreign-key
- (car s))
- (cadr s))
- (string (car s)) (car s))))
- (meta-model:list-slot-types model))
- (mapcar #'(lambda (s) (cons s (append (gen-pslot 'ucw::has-many (string s) s) `(:presentation (make-presentation ,model :type :one-line)))))
+ (if (meta-model:foreign-key-p model (car s))
+ 'ucw::foreign-key
+ (cadr s))
+ (string (car s)) (car s))))
+ (meta-model:list-slot-types model))
+ (mapcar #'(lambda (s)
+ (cons s (append (gen-pslot 'ucw::has-many (string s) s)
+ `(:presentation
+ (make-presentation
+ ,model
+ :type :one-line)))))
(meta-model:list-has-many model))))
(defmethod set-default-attributes ((model t))
(setf (slots to) (mapcar #'(lambda (x) (prog2
(setf (component.place x) (component.place from))
x))
- (slots to))))
+ (slots to))))
(defmacro call-presentation (object &rest args)
`(present-object ,object :presentation (make-presentation ,object ,@args)))
(defaction cancel-save-instance ((self mewa))
- (answer nil))
+ (cond
+ ((slot-value (instance self) 'clsql-sys::view-database)
+ (meta-model::update-instance-from-records (instance self))
+ (answer self))
+ (t (answer nil))))
(defaction save-instance ((self mewa))
(meta-model:sync-instance (instance self))
(unless (equal new old )
(let ((self (ucw::parent slot)))
(setf (modifiedp self) instance
- (modifications self) (append (list (type-of new) (type-of old) (type-of value) slot instance )))))))
\ No newline at end of file
+ (modifications self) (append (list (type-of new) (type-of old) (type-of value) slot instance )))))))
+
+
+;; 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.