Function: PARSE-ATTRIBUTE-SPEC

Documentation

Parse an attribute spec into required args, attribute args, other args and the body arg.

Source

(defun parse-attribute-spec (attribute-spec)
  "Parse an attribute spec into required args, attribute args,
  other args and the body arg."
  (let* ((required '())
         (attrs '())
         (flags '())
         (body-var nil)
         (other-attributes nil)
         (custom-attributes nil)
         (put (lambda (item)
                (assert (symbolp item) (item) "Invalid attribute specification at mandatory attribute position: ~A" item)
                (push item required))))
    (dolist (attr attribute-spec)
      ;; the #'string= tom-follery (god i love that word) is so that
      ;; the & symbols can be read in from any package. we're kinda
      ;; faking keywords...
      (if (symbolp attr)
	  (cond
	    ((string= attr '&attribute)
	     (setf put (lambda (item)
			 (if (listp item)
			     (case (length item)
			       (1 (push (list (first item) nil) attrs))
			       (2 (push item attrs))
			       (t (error "Bad &attribute spec: ~S" item)))
			     (push (list item nil) attrs)))))
	    ((string= attr '&flag)
	     (setf put (lambda (item)
			 (push item flags))))
	    ((string= attr '&body)
	     (setf put (lambda (item)
			 (setf body-var item))))
	    ((string= attr '&allow-other-attributes)
	     (setf put (lambda (item)
			 (setf other-attributes item))))
            ((string= attr '&allow-custom-attributes)
	     (setf put (lambda (item)
			 (setf custom-attributes item))))
	    (t (funcall put attr)))
	  (funcall put attr)))
    (list (nreverse required) (nreverse attrs) (nreverse flags)
          other-attributes custom-attributes body-var)))
Source Context