> What is the syntax for adding new fields? I haven't seen any examples
> of it anywhere.
It's the same for the "company" slot you posted. Currently, we don't do
any slot combination like CLOS does; we just use direct override. So in
the example, the `company' slot works by shadowing the inherited one.
If you want to see how inheritance works, apply the attached patch
before reading get-object-view-fields (the patch will be pushed to dev
once I'm more comfortable with it).
--~--~---------~--~----~------------~-------~--~----~
You received this message because you are subscribed to the Google Groups
"weblocks" group.
To post to this group, send email to [email protected]
To unsubscribe from this group, send email to
[email protected]
For more options, visit this group at
http://groups.google.com/group/weblocks?hl=en
-~----------~----~----~----~------~----~------~--~---
diff --git a/src/views/view/utils.lisp b/src/views/view/utils.lisp
--- a/src/views/view/utils.lisp
+++ b/src/views/view/utils.lisp
@@ -33,6 +33,86 @@
if it was mixed into the view."
field object parent-info)
+(defun factor-overridden-fields (field-info-list)
+ "Overrides parent fields redefined in children."
+ ;; XXX this is less quite inefficient (at least n^2 + n*log(n))
+ #+lp-view-field-debug
+ (format t "fil: ~S~%" field-info-list)
+ (labels ((field-key (field-info)
+ (cons (fi-slot-name field-info)
+ (awhen (parent field-info)
+ (view-field-slot-name (field-info-field IT)))))
+ (fi-slot-name (field-info)
+ (view-field-slot-name (field-info-field field-info)))
+ (parent (field-info)
+ (field-info-parent-info field-info))
+ (mixin-p (field-info)
+ (typep (field-info-field field-info) 'mixin-view-field)))
+ #+lp-view-field-debug
+ (format t "in: ~S~%" (mapcar (compose #'describe #'field-info-field) field-info-list))
+ (let ((fields (remove-duplicates field-info-list
+ :test #'equal :key #'field-key)))
+ (multiple-value-bind (expanded-mixin-fields true-inline-fields)
+ (partition fields (disjoin #'parent #'mixin-p))
+ (setf expanded-mixin-fields
+ (remove-if (curry-after #'find true-inline-fields
+ :test #'equal :key #'fi-slot-name)
+ expanded-mixin-fields))
+ (let* ((pos-table
+ (let ((pos-table (make-hash-table :test 'equal)))
+ (loop for pos from 0
+ ;; We use field-info-list instead of FIELDS
+ ;; below, with backward filling (like `find'),
+ ;; for compatibility with r1132:980bccf and
+ ;; older.
+ for field in field-info-list
+ for key = (field-key field)
+ unless (nth-value 1 (gethash key pos-table))
+ do (setf (gethash key pos-table) pos))
+ pos-table))
+ (merged-fields
+ (sort (union true-inline-fields expanded-mixin-fields)
+ #'< :key (f_ (gethash (field-key _) pos-table 0)))))
+ #+lp-view-field-debug
+ (progn
+ (format t "true inline: ~S~%" (mapcar #'field-key true-inline-fields))
+ (format t "expanded ~S~%" (mapcar #'field-key expanded-mixin-fields))
+ (format t "fields ~S~%" (mapcar #'field-key fields))
+ (format t "merged ~S~%" (mapcar (compose #'describe #'field-info-field) merged-fields)))
+ merged-fields)))))
+
+(defun map-view-field-info-list (proc view-designator obj parent-field-info)
+ "Walk a full list of view fields, including inherited fields."
+ (let ((view (when view-designator
+ (find-view view-designator))))
+ (when view
+ (map-view-field-info-list proc (view-inherit-from view) obj
+ parent-field-info)
+ (dolist (field (view-fields view))
+ (funcall proc (make-field-info :field field :object obj
+ :parent-info parent-field-info))))))
+
+(defun map-expanding-mixin-fields (proc field-info-list &optional include-invisible-p)
+ "Expands mixin fields into inline fields. Returns two values - a
+list of expanded field-infos, and true if at least one field has been
+expanded."
+ (labels ((map-emf (field-info)
+ (let ((field (field-info-field field-info))
+ (obj (field-info-object field-info)))
+ (etypecase field
+ (inline-view-field (funcall proc field-info))
+ (mixin-view-field
+ (when (or include-invisible-p
+ (not (view-field-hide-p field)))
+ (map-view-field-info-list
+ #'map-emf
+ (mixin-view-field-view field)
+ (when obj
+ (or (obtain-view-field-value field obj)
+ (funcall (mixin-view-field-init-form field))))
+ field-info)))))))
+ (mapc #'map-emf field-info-list)))
+
(defun get-object-view-fields (obj view-designator &rest args
&key include-invisible-p (expand-mixins t) custom-fields
&allow-other-keys)
@@ -55,101 +135,26 @@
view-field. Field-info structures are inserted as is, and view-fields
are wrapped in field-info structures with common-sense defaults."
(declare (ignore args))
- (labels ((compute-view-field-info-list (view-designator obj parent-field-info)
- "Computes a full list of view fields, including inherited
- fields. Returns a list of field-infos."
- (let ((view (when view-designator
- (find-view view-designator))))
- (when view
- (append (compute-view-field-info-list
- (view-inherit-from view) obj
- parent-field-info)
- (mapcar (lambda (field)
- (make-field-info :field field :object obj
- :parent-info parent-field-info))
- (view-fields view))))))
- (factor-overriden-fields (field-info-list)
- "Overrides parent fields redefined in children."
- ;(format t "fil: ~S~%" field-info-list)
- (flet ((field-key (field-info &aux (field (field-info-field field-info)))
- (cons (view-field-slot-name field) (awhen (field-info-parent-info field-info)
- (view-field-slot-name (field-info-field IT)))))
- (parent (field-info &aux (field (field-info-field field-info)))
- (field-info-parent-info field-info))
- (mixin-p (field-info &aux (field (field-info-field field-info)))
- (typep field 'mixin-view-field)))
- ;(format t "in: ~S~%" (mapcar (compose #'describe #'field-info-field) field-info-list))
- (let* ((fields (remove-duplicates field-info-list :key #'field-key :from-end nil))
- (true-inline-fields (remove-duplicates fields :test #'equal
- :key (compose #'view-field-slot-name #'field-info-field)
- :from-end nil))
- (true-inline-fields (remove-if (lambda (fi) (or (parent fi) (mixin-p fi))) true-inline-fields
- :from-end t))
- (expanded-mixin-fields (remove-if-not (lambda (fi) (or (parent fi) (mixin-p fi)))
- fields))
- (expanded-mixin-fields (remove-duplicates expanded-mixin-fields :test #'equal :key #'field-key))
- (expanded-mixin-fields (remove-if (curry-after #'find true-inline-fields
- :test #'equal :key (compose #'view-field-slot-name
- #'field-info-field)
- :from-end nil) expanded-mixin-fields))
- (merged-fields (sort (union true-inline-fields expanded-mixin-fields)
- #'< :key (lambda (field)
- (flet ((pos (field where)
- (let ((r (position (field-key field) where :key #'field-key :test #'equal)))
- ;(format t "field: ~S / where: ~S -> ~S%" (field-key field)
- ; (mapcar #'field-key where) r)
- r
- )))
- (let ((result (or (pos field fields)
- (pos field true-inline-fields)
- (pos field expanded-mixin-fields)
- 0)))
- #+(or)(format t "result for field ~A: ~A~%" field result) result))))))
- ;(format t "true inline: ~S~%" (mapcar #'field-key true-inline-fields))
- ;(format t "expanded ~S~%" (mapcar #'field-key expanded-mixin-fields))
- ;(format t "fields ~S~%" (mapcar #'field-key fields))
- ;(format t "merged ~S~%" (mapcar (compose #'describe #'field-info-field) merged-fields))
- merged-fields))) ; XXX this is quite inefficient (at least n^2 + n*log(n))
- (expand-mixin-fields (field-info-list)
- "Expands mixin fields into inline fields. Returns two
- values - a list of expanded field-infos, and true if at
- least one field has been expanded."
- (apply #'append
- (mapcar (lambda (field-info)
- (let ((field (field-info-field field-info))
- (obj (field-info-object field-info)))
- (etypecase field
- (inline-view-field (list field-info))
- (mixin-view-field (when (or include-invisible-p
- (not (view-field-hide-p field)))
- (compute-view-field-info-list
- (mixin-view-field-view field)
- (when obj
- (or (obtain-view-field-value field obj)
- (funcall (mixin-view-field-init-form field))))
- field-info))))))
- field-info-list)))
- (custom-field->field-info (custom-field)
+ (labels ((custom-field->field-info (custom-field)
(etypecase custom-field
(field-info custom-field)
(view-field (make-field-info :field custom-field
:object obj
:parent-info nil)))))
- (let* ((initial-step (factor-overriden-fields
- (compute-view-field-info-list view-designator obj nil)))
- (results
- (if expand-mixins
- (loop for field-info-list = initial-step
- then (factor-overriden-fields
- (expand-mixin-fields field-info-list))
- until (notany (lambda (field-info)
- (typep (field-info-field field-info) 'mixin-view-field))
- field-info-list)
- finally (return (if include-invisible-p
- field-info-list
- (remove-if #'view-field-hide-p field-info-list
- :key #'field-info-field))))
- initial-step)))
+ (let* ((results (factor-overridden-fields
+ (let ((expansion '()))
+ (map-view-field-info-list (f_ (push _ expansion))
+ view-designator obj nil)
+ (nreverse expansion)))))
+ (when expand-mixins
+ (setf results (factor-overridden-fields
+ (let ((expansion '()))
+ (map-expanding-mixin-fields
+ (f_ (push _ expansion)) results include-invisible-p)
+ (nreverse expansion)))))
+ (unless include-invisible-p
+ (setf results (remove-if #'view-field-hide-p results
+ :key #'field-info-field)))
(dolist (custom-field custom-fields results)
(if (consp custom-field)
(insert-at (custom-field->field-info (cdr custom-field)) results (car custom-field))
The syntax is the [FIELD-NAME | (FIELD-NAME ...)] described in defview's
docstring. Full details start with the "FIELD-NAME" entry in the
docstring.
> I've been poring over the code (and documentation strings) in
> compiler.lisp, but I don't see how this can be easily done.
To really get this, you need to chase down the relevant classes. For a
view with `:type form' (where `form' has symbol-package=weblocks), the
VIEW-KWARGS available are initargs defined by class `form-view' (and so
inherited, such as the :caption arg from class `view'), and the
FIELD-KWARGS available are those on `form-view-field'. Lots of this can
be overridden using the relevant generic functions.
The nice thing about the `...' syntax is that Emacs understands that
it's a symbol delimiter. To learn more about a symbol the defview
docstring talks about, just stick point there, hit M-., and read. For
example, to read up on the `form-view' slot `satisfies', stick point in
the form-view part, hit M-., and find the slot docstring for `satisfies'
in the list of slots it has.
--
Sorry but you say Nibiru is a Hoax? Doesnt Exist? So maybe The
Sumerian people doesnt exist also! --Anonymous by way of SkI
