Function: icalendar-with-node-children
icalendar-with-node-children is a macro defined in
icalendar-macs.el.gz.
Signature
(icalendar-with-node-children NODE BINDINGS &rest BODY)
Documentation
Execute BODY with BINDINGS to children in NODE.
NODE should be an iCalendar syntax node representing a component or property.
Each binding in BINDINGS should be a list of one of the following forms:
(TYPE VAR)
TYPE should be a type symbol for an iCalendar property or component
which can be a child of COMPONENT. The first child node of TYPE, if
any, will be bound to VAR in BODY.
(TYPE KEY1 VAR1 ...)
For each KEY present, the corresponding VAR will be bound as follows:
:all - a list of all child nodes of TYPE. If this keyword is present,
none of the others are allowed.
:first - the first child node of TYPE
:default - the default value, if any, for TYPE
:value-node - the value of the node in :first
:value-type - the type of the node in :value-node (if it is a node).
:value - the value of the node in :value-node, if it is a node,
or :value-node itself, if it is not.
If TYPE expects a list of values, you should use the following keywords
instead of the previous three:
:value-nodes - the values of the node in :first
:value-types - a list of the types of the nodes in :value-nodes.
:values - a list of the values of the nodes in :value-nodes (if they are
nodes), or the :value-nodes themselves (if they are not).
It is a compile-time error to use the singular keywords with a TYPE that
takes multiple values, or the plural keywords with a TYPE that does not.
Aliases
Source Code
;; Defined in /usr/src/emacs/lisp/calendar/icalendar-macs.el.gz
;; Macros for destructuring and binding AST nodes
(defmacro ical:with-node-children (node bindings &rest body)
"Execute BODY with BINDINGS to children in NODE.
NODE should be an iCalendar syntax node representing a component or
property.
Each binding in BINDINGS should be a list of one of the following forms:
\(TYPE VAR)
TYPE should be a type symbol for an iCalendar property or component
which can be a child of COMPONENT. The first child node of TYPE, if
any, will be bound to VAR in BODY.
\(TYPE KEY1 VAR1 ...)
For each KEY present, the corresponding VAR will be bound as follows:
:all - a list of all child nodes of TYPE. If this keyword is present,
none of the others are allowed.
:first - the first child node of TYPE
:default - the default value, if any, for TYPE
:value-node - the value of the node in :first
:value-type - the type of the node in :value-node (if it is a node).
:value - the value of the node in :value-node, if it is a node,
or :value-node itself, if it is not.
If TYPE expects a list of values, you should use the following keywords
instead of the previous three:
:value-nodes - the values of the node in :first
:value-types - a list of the types of the nodes in :value-nodes.
:values - a list of the values of the nodes in :value-nodes (if they are
nodes), or the :value-nodes themselves (if they are not).
It is a compile-time error to use the singular keywords with a TYPE that
takes multiple values, or the plural keywords with a TYPE that does not."
(declare (debug (form form &rest form))
(indent 2))
;; Static checks on the bindings prevent various annoying bugs:
(dolist (b bindings)
(let ((type (car b))
(kwargs (cdr b)))
(unless (ical:type-symbol-p type)
(error "Not an iCalendar type symbol: %s" type))
(when (and (plist-member kwargs :all)
(> 2 (length kwargs)))
(error ":all may not be combined with other bindings"))
(if (ical:expects-list-of-values-p type)
(when (or (plist-member kwargs :value-node)
(plist-member kwargs :value-type)
(plist-member kwargs :value))
(error "Type `%s' expects a list of values" type))
(when (or (plist-member kwargs :value-nodes)
(plist-member kwargs :value-types)
(plist-member kwargs :values))
(error "Type `%s' does not expect a list of values" type)))))
(let ((nd (gensym "icalendar-node")))
`(let* ((,nd ,node)
,@(mapcan
(lambda (tv)
(let ((type (car tv))
(vars (cdr tv)))
(when (and (symbolp (car vars)) (null (cdr vars)))
;; the simple (TYPE VAR) case:
(setq vars (list :first (car vars))))
(let ((first-var (or (plist-get vars :first)
(gensym "first")))
(default-var (or (plist-get vars :default)
(gensym "default")))
(vnode-var (or (plist-get vars :value-node)
(gensym "value-node")))
(vtype-var (or (plist-get vars :value-type)
(gensym "value-type")))
(vval-var (or (plist-get vars :value)
(gensym "value")))
(vnodes-var (or (plist-get vars :value-nodes)
(gensym "value-nodes")))
(vtypes-var (or (plist-get vars :value-types)
(gensym "value-types")))
(vvals-var (or (plist-get vars :values)
(gensym "values")))
(all-var (or (plist-get vars :all)
(gensym "all")))
;; The corresponding vars for :all are mostly
;; too complicated to be useful, I think, so
;; not implementing them for now.
;; TODO: but it *would* be helpful to have an
;; :all-values clause especially for RDATE and
;; EXDATE, since they both accept lists, and
;; can also occur multiple times.
;; I've found myself needing to write
;; (mapcar #'ical:ast-node-value
;; (apply #'append
;; (mapcar #'ical:ast-node-value rdate-nodes))
;; a bit too often.
)
(delq nil
(list
(when (plist-member vars :all)
`(,all-var (ical:ast-node-children-of
(quote ,type) ,nd)))
(when (not (plist-member vars :all))
`(,first-var (ical:ast-node-first-child-of
(quote ,type) ,nd)))
(when (plist-member vars :default)
`(,default-var (get (quote ,type)
'ical:default-value)))
;; Single value:
(when (or (plist-member vars :value-node)
(plist-member vars :value-type)
(plist-member vars :value))
`(,vnode-var (when (ical:ast-node-p ,first-var)
(ical:ast-node-value ,first-var))))
(when (plist-member vars :value-type)
`(,vtype-var
(when ,vnode-var
(ical:ast-node-type ,vnode-var))))
(when (plist-member vars :value)
`(,vval-var
(when ,vnode-var
(if (ical:ast-node-p ,vnode-var)
(ical:ast-node-value ,vnode-var)
,vnode-var))))
;; List of values:
(when (or (plist-member vars :value-nodes)
(plist-member vars :value-types)
(plist-member vars :values))
`(,vnodes-var
(when (ical:ast-node-p ,first-var)
(ical:ast-node-value ,first-var))))
(when (plist-member vars :value-types)
`(,vtypes-var
(when ,vnodes-var
(mapcar #'ical:ast-node-type ,vnodes-var))))
(when (plist-member vars :values)
`(,vvals-var
(when ,vnodes-var
(if (ical:ast-node-p (car ,vnodes-var))
(mapcar #'ical:ast-node-value
,vnodes-var)
,vnodes-var)))))))))
bindings))
,@body)))