HCoop
/
clinton
/
lisp-on-lines.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Massive patch to catch up to ucw_dev
[clinton/lisp-on-lines.git]
/
src
/
lisp-on-lines.lisp
diff --git
a/src/lisp-on-lines.lisp
b/src/lisp-on-lines.lisp
index
77dab5c
..
a5415ae
100644
(file)
--- a/
src/lisp-on-lines.lisp
+++ b/
src/lisp-on-lines.lisp
@@
-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,26
+36,30
@@
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
`(:initargs
'(,@ (mapcan #'identity args)))))))
,object
:type ,type
,@(when args
`(:initargs
'(,@ (mapcan #'identity args)))))))
-(defmethod make-view (object &rest args &key (type :viewer)
(attributes nil)
+(defmethod make-view (object &rest args &key (type :viewer)
&allow-other-keys )
&allow-other-keys )
- (apply #'make-presentation (cdr (%make-view object type attributes args))))
+ (remf args :type)
+ ;(warn "~A ~A" args `(:type ,type :initargs ,@args))
+ (apply #'make-presentation object `(:type ,type ,@ (when args
+ `(:initargs ,args)))))
(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
:type ,type
- :attributes ,(car attributes-and-args)
+ ,@(when (car attributes-and-args)
+ `(:attributes ',(car attributes-and-args)))
,@ (cdr attributes-and-args))))
(setf (ucw::parent ,view) ,parent)
,@ (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))
@@
-83,14
+88,8
@@
This involves creating a meta-model, a clsql view-class, and the setting up the
-(defun %delete-item (item)
- (ignore-errors
- (clsql:delete-instance-records item)))
-(defaction delete-item ((self component) instance)
- (if (%delete-item instance)
- (answer nil)
- (call 'info-message :message "Could not remove item. Try removing associated items first.")))
+
(defmethod word-search (class-name slots search-terms
&key (limit 10) (where (sql-and t)))
(defmethod word-search (class-name slots search-terms
&key (limit 10) (where (sql-and t)))
@@
-103,8
+102,7
@@
This involves creating a meta-model, a clsql view-class, and the setting up the
(defmethod word-search (class-name slots (s string) &rest args)
(defmethod word-search (class-name slots (s string) &rest args)
- (apply #'word-search class-name slots
- (split-sequence:split-sequence #\Space s) args))
+ (apply #'word-search class-name slots (list s) args))
(defmethod word-search-where (class-name slots search-terms &key (format-string "%~a%"))
(sql-or
(defmethod word-search-where (class-name slots search-terms &key (format-string "%~a%"))
(sql-or