X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/b890d44942859c366cac60a84b6c19363d321aaf..b8c8985156e0ce7de77973d5899221116dcc3c96:/src/lisp-on-lines.lisp diff --git a/src/lisp-on-lines.lisp b/src/lisp-on-lines.lisp index 77dab5c..a5415ae 100644 --- 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. + (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))) - `(mewa:make-presentation + `(mewa::make-presentation ,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 ) - (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) - `(let ((,view (lol:make-view ,object + `(let ((,view (lol::make-view ,object :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) - (lol:present ,view)))) + (lol::present ,view)))) (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))) @@ -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) - (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