60601 eslick@media.mit.edu ;; ;; Keep track of models as they are defined ;; (defvar *models* (make-hash-table) "Keeps track of all the models that have been created using defmodel and creates an admin model to generate widgets on demand") (defvar *registered-models* (make-hash-table) "Keeps track of all the models that have been created using defmodel and ensures that an editing widget has been created for it") (defmacro defmodel (name &rest args) `(progn (defpclass ,name ,@args) (setf (gethash ',name *models*) nil) (when (gethash ',name *registered-models*) (setf (gethash ',name *registered-models*) nil)))) ;; ;; Dynamically create an object that keeps track of these models and provide views ;; ;; ;; Model admin view & creation ;; (defpclass admin-model () ((name :accessor model-name :initarg :name) (description :accessor model-description :initform "" :initarg :description))) (defview admin-table-view (:type table :inherit-from '(:scaffold admin-model)) (widget :hidep t)) (defview admin-data-view (:type data :inherit-from '(:scaffold admin-model)) (widget :hidep t)) (defun register-model (model-class &optional (store *default-store*)) (let ((amod (ensure-admin-model model-class store))) (setf (gethash (class-name model-class) *registered-models*) amod) amod)) (defun ensure-admin-model (class &optional (store *default-store*)) (let* ((objects (find-persistent-objects store 'admin-model)) (model (find (class-name class) objects :key #'model-name))) (if model (progn (setf (model-description model) (documentation class t)) model) (let ((new-model (make-instance 'admin-model :name (class-name class) :description (documentation class t)))) (persist-object store new-model))))) (defun unregister-model (model-name &optional (store *default-store*)) (let ((model (gethash model-name *registered-models*))) (delete-persistent-object store model) (remhash model-name *registered-models*))) ;; ;; Model views ;; (defun make-model-view (model) (make-instance 'gridedit :name (model-name model) :data-class (model-name model) :view (model-table-view-name model) :item-data-view (model-data-view-name model) :item-form-view (model-form-view-name model) :common-ops `((done . ,#'(lambda (w i) (declare (ignore i)) (answer w)))))) (defmethod model-table-view-name (model) (intern (nstring-upcase (format nil "~A-table-view" (model-name model))) (symbol-package (model-name model)))) (defmethod model-data-view-name (model) (intern (nstring-upcase (format nil "~A-data-view" (model-name model))) (symbol-package (model-name model)))) (defmethod model-form-view-name (model) (intern (nstring-upcase (format nil "~A-form-view" (model-name model))) (symbol-package (model-name model)))) ;; ;; Admin widget which interfaces to models ;; (defun make-admin-widget () (make-instance 'composite :widgets (list (make-admin-grid)))) ;; ;; Specialize gridedit ;; (defclass admin-grid (datagrid) ()) (defun make-admin-grid () (make-instance 'admin-grid ;; :name 'admin-grid :data-class 'admin-model :view 'admin-table-view ;; :item-data-view 'admin-data-view :allow-drilldown-p t :autoset-drilled-down-item-p t :on-drilldown (cons :view-models #'goto-model-view))) (defun goto-model-view (widget item) (with-flow widget (yield (make-model-view item)))) (defmethod initialize-instance :after ((admin admin-grid) &rest args) (loop for key being the hash-key of *models* do (unless (gethash key *registered-models*) (register-model (find-class key))))) 3419520988 None Common Lisp TRUE