mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-06-14 12:31:25 +00:00
Thanks to Stefan Monnier for the comments in Bug#74994 leading to most of these changes. Improvements in diary-icalendar.el and related changes: * lisp/calendar/diary-icalendar.el (icalendar-save-binary-atttachment): Rename to `diary-icalendar-save-binary-attachment'. Document internal require. (diary-icalendar-attendee-skeleton-command): Rename to `diary-icalendar-attendee-format-function'. (diary-icalendar-vevent-skeleton-command): Rename to `diary-icalendar-vevent-format-function'. (diary-icalendar-vjournal-skeleton-command): Rename to `diary-icalendar-vjournal-format-function'. (diary-icalendar-vtodo-skeleton-command): Rename to `diary-icalendar-vtodo-format-function'. * doc/emacs/calendar.texi (Diary iCalendar Import) * lisp/calendar/icalendar.el (icalendar-import-format) (icalendar-import-format-summary, icalendar-import-format-description) (icalendar-import-format-location, icalendar-import-format-organizer) (icalendar-import-format-url, icalendar-import-format-uid) (icalendar-import-format-status, icalendar-import-format-class): Update references to renamed functions. (diary-icalendar-attendee-format-function): Fix quoted function name. (diary-icalendar-attendee-format-function) (diary-icalendar-vevent-format-function) (diary-icalendar-vjournal-format-function) (diary-icalendar-vtodo-format-function) (diary-icalendar-after-mailcap-viewer-hook): Improve docstrings. (diary-icalendar-skip-addresses-regexp): Ensure default value is a regexp. (diary-icalendar-description-regexp): Fix :type declaration to agree with default. (diary-icalendar-format-date): Replace unnecessary `calendar-dlet' with `dlet'. (diary-icalendar-vevent-format-function) (diary-icalendar-vjournal-format-function) (diary-icalendar-vtodo-format-function) (diary-icalendar-format-entry) (diary-icalendar-import-buffer-to-buffer) (diary-icalendar--entry-import) (diary-icalendar-import-buffer) (diary-icalendar-import-file): Change "non-marking" to "nonmarking" in variable names for consistency (cf. `diary-nonmarking-symbol'). (diary-icalendar-attendee-skeleton): Remove unnecessary call to `skeleton-insert'. (diary-icalendar-vevent-skeleton) (diary-icalendar-vjournal-skeleton) (diary-icalendar-vtodo-skeleton): Don't insert return values of `let' forms. (diary-icalendar-parse-entry): Call `diary-icalendar-other-properties-parser' with type and properties as arguments, instead of dynamic binding. (diary-icalendar-other-properties-parser): Document the new calling convention. * test/lisp/calendar/diary-icalendar-tests.el (diary-icalendar-test-parse-@-location): Accept the new arguments. Clarify `declare-function' usage: * lisp/calendar/icalendar-parser.el (icalendar-read-time) (icalendar-period-end, icalendar-parse-calendar) (icalendar-index-insert, icalendar-index-get) * lisp/calendar/icalendar-ast.el (icalendar-printable-value-type-symbol-p) (icalendar-ast-node-valid-value-p) * lisp/calendar/icalendar-utils.el (icalendar-date-time-add) (icalendar-dates-until, icalendar-date-time-variant): Move `declare-function' forms to corresponding `require' forms. Improve debugging with icalendar-ast.el macros: * lisp/calendar/icalendar-ast.el (icalendar-make-value-node-of): Add explanatory comment to require. (icalendar--make-param--list, icalendar--make-param--nonlist) (icalendar--make-property--list, icalendar--make-property--nonlist): New functions. (icalendar-make-param, icalendar-make-property): Use them to reduce code generated by these macros. Add (declare (debug ...)) forms. (icalendar-make-component, icalendar-make-node-from-templates): Add (declare (debug ...)) forms. * test/lisp/calendar/icalendar-ast-tests.el: New file. Various other minor changes: * lisp/calendar/icalendar-macs.el (icalendar-define-type): Improve docstring. (icalendar-define-property): Fix deprecation warning: replace 'any' with 'not-newline' in rx definition. * test/lisp/calendar/icalendar-recur-tests.el (icalendar-test-rrule-test): Pass tags on to `ert-deftest' and mark several tests as expensive. * lisp/calendar/calendar.el (diary-date-insertion-form): Remove constants from :set-after list. * lisp/calendar/diary-lib.el (diary-time-regexp): Clarify FIXME comment. * lisp/calendar/icalendar-parser.el (icalendar-x-name): Fix indentation. (icalendar-cal-address): Improve docstring.
1125 lines
51 KiB
EmacsLisp
1125 lines
51 KiB
EmacsLisp
;;; icalendar-macs.el --- Macros for iCalendar -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 2024 Free Software Foundation, Inc.
|
||
|
||
;; Author: Richard Lawrence <rwl@recursewithless.net>
|
||
;; Created: October 2024
|
||
;; Keywords: calendar
|
||
;; Human-Keywords: calendar, iCalendar
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; This file is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; This file is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with this file. If not, see <https://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; This file defines the macros `ical:define-type', `ical:define-param',
|
||
;; `ical:define-property' and `ical:define-component', used in
|
||
;; icalendar-parser.el to define the particular value types, parameters,
|
||
;; properties and components in the standard as type symbols.
|
||
|
||
;; TODOs:
|
||
;; - in the define* macros, :default needs rethinking.
|
||
;; I had made this a string because otherwise you can't distinguish
|
||
;; an unspecified default from an explicit "FALSE" for icalendar-boolean
|
||
;; But this might not be true/might not matter anyway, and it's a pain
|
||
;; to have to read the default value where you need it. Probably
|
||
;; should just change these to be the value as read.
|
||
|
||
|
||
;;; Code:
|
||
|
||
(eval-when-compile (require 'cl-lib))
|
||
|
||
(declare-function ical:ast-node-p "icalendar-ast")
|
||
(declare-function ical:ast-node-type "icalendar-ast")
|
||
(declare-function ical:ast-node-value "icalendar-ast")
|
||
(declare-function ical:type-symbol-p "icalendar-ast")
|
||
(declare-function ical:value-type-symbol-p "icalendar-ast")
|
||
(declare-function ical:expects-list-of-values-p "icalendar-ast")
|
||
|
||
;; Some utilities:
|
||
|
||
(defun ical:format-child-spec (child-spec)
|
||
"Format CHILD-SPEC as a table for use in symbol documentation."
|
||
(concat
|
||
(format "%-30s%6s\n" "Type" "Number")
|
||
(make-string 36 ?-) "\n"
|
||
(mapconcat
|
||
(lambda (type) (format "%-30s%-6s\n" (format "`%s'" type) "1"))
|
||
(plist-get child-spec :one))
|
||
(mapconcat
|
||
(lambda (type) (format "%-30s%-6s\n" (format "`%s'" type) "1+"))
|
||
(plist-get child-spec :one-or-more))
|
||
(mapconcat
|
||
(lambda (type) (format "%-30s%-6s\n" (format "`%s'" type) "0-1"))
|
||
(plist-get child-spec :zero-or-one))
|
||
(mapconcat
|
||
(lambda (type) (format "%-30s%-6s\n" (format "`%s'" type) "0+"))
|
||
(plist-get child-spec :zero-or-more))))
|
||
|
||
|
||
;; Define value types:
|
||
(cl-defmacro ical:define-type (symbolic-name print-name doc specifier matcher
|
||
&key link
|
||
(reader #'identity)
|
||
(printer #'identity))
|
||
"Define an iCalendar value type named SYMBOLIC-NAME.
|
||
|
||
PRINT-NAME should be the string used to represent this type in
|
||
the value of an `icalendar-valuetypeparam' property parameter, or
|
||
nil if this is not a type that should be specified there. DOC
|
||
should be a documentation string for the type. SPECIFIER should
|
||
be a type specifier in the sense of `cl-deftype'. MATCHER should
|
||
be an RX definition body (see `rx-define'; argument lists are not
|
||
supported).
|
||
|
||
Before the type is defined with `cl-deftype', a function will be
|
||
defined named `icalendar-match-PRINT-NAME-value'
|
||
\(or `icalendar-match-OTHER-value', if PRINT-NAME is nil, where
|
||
OTHER is derived from SYMBOLIC-NAME by removing any prefix
|
||
\"icalendar-\" and suffix \"value\"). This function takes a
|
||
string argument and matches it against MATCHER. This function may
|
||
thus occur in SPECIFIER (e.g. in a (satisfies ...) clause).
|
||
|
||
See the functions `icalendar-read-value-node',
|
||
`icalendar-parse-value-node', and `icalendar-print-value-node' to
|
||
convert values defined with this macro to and from their text
|
||
representation in iCalendar format.
|
||
|
||
The following keyword arguments are accepted:
|
||
|
||
:reader - a function to read data of this type. It will be passed
|
||
a string matching MATCHER and should return an Elisp data structure.
|
||
Its name does not need to be quoted. (default: identity)
|
||
|
||
:printer - a function to convert an Elisp data structure of this
|
||
type to a string. Its name does not need to be quoted.
|
||
(default: identity)
|
||
|
||
:link - a string containing a URL for further documentation of this type"
|
||
(declare (doc-string 2))
|
||
(let* (;; Related functions:
|
||
(type-dname (if print-name
|
||
(downcase print-name)
|
||
(string-trim
|
||
(symbol-name symbolic-name)
|
||
"icalendar-" "value")))
|
||
(matcher-name (intern (concat "icalendar-match-" type-dname "-value")))
|
||
;; Documentation:
|
||
(header "It names a value type defined by `icalendar-define-type'.")
|
||
(matcher-doc (format
|
||
"Strings representing values of this type can be matched with
|
||
`%s'.\n" matcher-name))
|
||
(reader-doc (format "They can be read with `%s'\n" reader))
|
||
(printer-doc (format "and printed with `%s'." printer))
|
||
(full-doc (concat header "\n\n" doc "\n\n"
|
||
matcher-doc reader-doc printer-doc "\n\n"
|
||
"A syntax node of this type can be read with
|
||
`icalendar-read-value-node' or parsed with `icalendar-parse-value-node',
|
||
and printed with `icalendar-print-value-node'.")))
|
||
|
||
`(progn
|
||
;; Type metadata needs to be available at both compile time and
|
||
;; run time. In particular, `ical:value-type-symbol-p' needs to
|
||
;; work at compile time.
|
||
(eval-and-compile
|
||
(setplist (quote ,symbolic-name)
|
||
(list
|
||
'ical:is-type t
|
||
'ical:is-value t
|
||
'ical:matcher (function ,matcher-name)
|
||
'ical:value-rx (quote ,symbolic-name)
|
||
'ical:value-reader (function ,reader)
|
||
'ical:value-printer (function ,printer)
|
||
'ical:type-documentation ,full-doc
|
||
'ical:link ,link)))
|
||
|
||
(rx-define ,symbolic-name
|
||
,matcher)
|
||
|
||
(defun ,matcher-name (s)
|
||
,(format "Match string S against rx `%s'." symbolic-name)
|
||
(string-match (rx ,symbolic-name) s))
|
||
|
||
(cl-deftype ,symbolic-name () ,specifier)
|
||
|
||
;; Store the association between the print name and the type
|
||
;; symbol in ical:value-types. The check against print name
|
||
;; here allows us to also define value types that aren't
|
||
;; "really" types according to the standard, like
|
||
;; `ical:geo-coordinates'. Only types that have a
|
||
;; print-name can be specified in a VALUE parameter.
|
||
(when ,print-name
|
||
(push (cons ,print-name (quote ,symbolic-name)) ical:value-types)))))
|
||
|
||
;; TODO: not sure this is needed. I've only used it once in the parser.
|
||
(cl-defmacro ical:define-keyword-type (symbolic-name print-name doc matcher
|
||
&key link
|
||
(reader 'intern)
|
||
(printer 'symbol-name))
|
||
"Like `icalendar-define-type', for types represented by strings.
|
||
String values matching MATCHER are assumed to be type-specific keywords
|
||
that should be interned as symbols when read. (Thus no type specifier
|
||
is necessary: it is always just \\='symbol.) Their printed
|
||
representation is their symbol name."
|
||
`(ical:define-type ,symbolic-name ,print-name ,doc
|
||
'symbol
|
||
,matcher
|
||
:link ,link
|
||
:reader ,reader
|
||
:printer ,printer))
|
||
|
||
|
||
;; Define parameters:
|
||
(cl-defmacro ical:define-param (symbolic-name param-name doc value
|
||
&key quoted
|
||
list-sep
|
||
default
|
||
(unrecognized default)
|
||
((:name-face name-face)
|
||
'ical:parameter-name nondefault-name-face)
|
||
((:value-face value-face)
|
||
'ical:parameter-value nondefault-value-face)
|
||
((:warn-face warn-face)
|
||
'ical:warning nondefault-warn-face)
|
||
extra-faces
|
||
link)
|
||
"Define iCalendar parameter PARAM-NAME under the symbol SYMBOLIC-NAME.
|
||
PARAM-NAME should be the parameter name as it should appear in
|
||
iCalendar data.
|
||
|
||
VALUE should either be a symbol for a value type defined with
|
||
`icalendar-define-type', or an `rx' regular expression. If it is
|
||
a type symbol, the regex, reader and printer functions associated
|
||
with that type will be used when parsing and serializing values.
|
||
If it is a regular expression, it is assumed that the values of
|
||
this parameter are strings which match that regular expression.
|
||
|
||
An `rx' regular expression named SYMBOLIC-NAME which matches the
|
||
parameter is defined:
|
||
Group 1 of this regex matches PARAM-NAME
|
||
(or any valid parameter name, if PARAM-NAME is nil).
|
||
Group 2 matches VALUE, which specifies a correct value
|
||
for this parameter according to RFC5545.
|
||
Group 3, if matched, contains any parameter value which does
|
||
*not* match VALUE, and is incorrect according to the standard.
|
||
|
||
This regex matches the entire string representing this parameter,
|
||
from \";\" to the end of its value. Another regular expression
|
||
named `SYMBOLIC-NAME-value' is also defined to match just the
|
||
value part, after \";PARAM-NAME=\", with groups 2 and 3 as above.
|
||
|
||
A function to match the complete parameter expression called
|
||
`icalendar-match-PARAM-NAME-param' is defined
|
||
\(or `icalendar-match-OTHER-param-value' if PARAM-NAME is nil,
|
||
where OTHER is derived from SYMBOLIC-NAME by removing any prefix
|
||
`icalendar-' and suffix `param'). This function is used
|
||
to provide syntax highlighting in `icalendar-mode'.
|
||
|
||
See the functions `icalendar-read-param-value',
|
||
`icalendar-parse-param-value', `icalendar-parse-params' and
|
||
`icalendar-print-param-node' to convert parameters defined with
|
||
this macro to and from their text representation in iCalendar
|
||
format.
|
||
|
||
The following keyword arguments are accepted:
|
||
|
||
:default - a (string representing the) default value, if the
|
||
parameter is not specified on a given property.
|
||
|
||
:unrecognized - a (string representing the) value which must be
|
||
substituted for values that are not recognized but syntactically
|
||
correct according to RFC5545. Unrecognized values must be in match
|
||
group 5 of the regex determined by VALUE. An unrecognized value will
|
||
be preserved in the syntax tree metadata and printed instead of this
|
||
value when the node is printed. Defaults to any value specified for
|
||
:default.
|
||
|
||
:quoted - non-nil if values of this parameter must always be surrounded
|
||
by (double-)quotation marks when printed, according to RFC5545.
|
||
|
||
:list-sep - if the parameter accepts a list of values, this should be a
|
||
string which separates the values (typically \",\"). If :list-sep is
|
||
non-nil, the value string will first be split on the separator, then
|
||
if :quoted is non-nil, the individual values will be unquoted, then
|
||
each value will be read according to VALUE and collected into a list
|
||
when parsing. When printing, the inverse happens: values are quoted
|
||
if :quoted is non-nil, then joined with :list-sep. Passing this
|
||
argument marks SYMBOLIC-NAME as a type that accepts a list of values
|
||
for `icalendar-expects-list-of-values-p'.
|
||
|
||
:name-face - a face symbol for highlighting the property name
|
||
(default: `icalendar-parameter-name')
|
||
|
||
:value-face - a face symbol for highlighting valid property values
|
||
(default: `icalendar-parameter-value')
|
||
|
||
:warn-face - a face symbol for highlighting invalid property values
|
||
(default: `icalendar-warning')
|
||
|
||
:extra-faces - a list of the form accepted for HIGHLIGHT in
|
||
`font-lock-keywords'. In particular,
|
||
((GROUPNUM FACENAME [OVERRIDE [LAXMATCH]]) ...)
|
||
can be used to apply different faces to different
|
||
match subgroups.
|
||
|
||
:link - a string containing a URL for documentation of this parameter.
|
||
The URL will be provided in the documentation shown by
|
||
`describe-symbol' for SYMBOLIC-NAME."
|
||
(declare (doc-string 2))
|
||
(let* (;; Related function names:
|
||
(param-dname (if param-name
|
||
(downcase param-name)
|
||
(string-trim (symbol-name symbolic-name)
|
||
"icalendar-" "param")))
|
||
(matcher-name (intern (concat "icalendar-match-" param-dname "-param")))
|
||
(type-predicate-name
|
||
(intern (concat "icalendar-" param-dname "-param-p")))
|
||
;; Value regexes:
|
||
(qvalue-rx (if quoted `(seq ?\" ,value ?\") value))
|
||
(values-rx (when list-sep
|
||
`(seq ,qvalue-rx (zero-or-more ,list-sep ,qvalue-rx))))
|
||
(full-value-rx-name
|
||
(intern (concat (symbol-name symbolic-name) "-value")))
|
||
;; Faces:
|
||
(has-faces (or nondefault-name-face nondefault-value-face
|
||
nondefault-warn-face extra-faces))
|
||
;; Documentation:
|
||
(header "It names a parameter type defined by `icalendar-define-param'.")
|
||
(val-list (if list-sep (concat "VAL1" list-sep "VAL2" list-sep "...")
|
||
"VAL"))
|
||
(s (if list-sep "s" "")) ; to make plurals
|
||
(val-doc (concat "VAL" s " "
|
||
"must be " (unless list-sep "a ") (when quoted "quoted ")
|
||
(if (ical:value-type-symbol-p value)
|
||
(format "`%s' value%s" (symbol-name value) s)
|
||
(format "string%s matching rx `%s'" s value))))
|
||
(syntax-doc (format "Syntax: %s=%s\n%s"
|
||
(or param-name "(NAME)") val-list val-doc))
|
||
(full-doc (concat header "\n\n" doc "\n\n" syntax-doc)))
|
||
|
||
`(progn
|
||
;; Type metadata needs to be available at both compile time and
|
||
;; run time. In particular, `ical:value-type-symbol-p' needs to
|
||
;; work at compile time.
|
||
(eval-and-compile
|
||
(setplist (quote ,symbolic-name)
|
||
(list
|
||
'ical:is-type t
|
||
'ical:is-param t
|
||
'ical:matcher (function ,matcher-name)
|
||
'ical:default-value ,default
|
||
'ical:is-quoted ,quoted
|
||
'ical:list-sep ,list-sep
|
||
'ical:substitute-value ,unrecognized
|
||
'ical:matcher (function ,matcher-name)
|
||
'ical:value-type
|
||
(when (ical:value-type-symbol-p (quote ,value))
|
||
(quote ,value))
|
||
'ical:value-rx (quote ,value)
|
||
'ical:values-rx (quote ,values-rx)
|
||
'ical:full-value-rx (quote ,full-value-rx-name)
|
||
'ical:type-documentation ,full-doc
|
||
'ical:link ,link)))
|
||
|
||
;; Regex which matches just the value of the parameter:
|
||
;; Group 2: correct values of the parameter, and
|
||
;; Group 3: incorrect values up to the next parameter
|
||
(rx-define ,full-value-rx-name
|
||
(or (group-n 2 ,(or values-rx qvalue-rx))
|
||
(group-n 3 ical:param-value)))
|
||
|
||
;; Regex which matches the full parameter:
|
||
;; Group 1: the parameter name,
|
||
;; Group 2: correct values of the parameter, and
|
||
;; Group 3: incorrect values up to the next parameter
|
||
(rx-define ,symbolic-name
|
||
(seq ";"
|
||
;; if the parameter name has no printed form, the best we
|
||
;; can do is match ical:param-name:
|
||
(group-n 1 ,(or param-name 'ical:param-name))
|
||
"="
|
||
,full-value-rx-name))
|
||
|
||
;; CL-type to represent syntax nodes for this parameter:
|
||
(defun ,type-predicate-name (node)
|
||
,(format "Return non-nil if NODE represents a %s parameter." param-name)
|
||
(and (ical:ast-node-p node)
|
||
(eq (ical:ast-node-type node) (quote ,symbolic-name))))
|
||
|
||
(cl-deftype ,symbolic-name () '(satisfies ,type-predicate-name))
|
||
|
||
;; Matcher for the full param string, for syntax highlighting:
|
||
(defun ,matcher-name (limit)
|
||
,(concat (format "Matcher for %s parameter.\n" param-name)
|
||
"(Defined by `icalendar-define-param'.)")
|
||
(re-search-forward (rx ,symbolic-name) limit t))
|
||
|
||
;; Entry for font-lock-keywords in icalendar-mode:
|
||
(when ,has-faces
|
||
;; Avoid circular load of icalendar-mode.el in
|
||
;; icalendar-parser.el (which does not use the *-face
|
||
;; keywords), while still allowing external code to add to
|
||
;; font-lock-keywords dynamically:
|
||
(require 'icalendar-mode)
|
||
(push (quote (,matcher-name
|
||
(1 (quote ,name-face) t t)
|
||
(2 (quote ,value-face) t t)
|
||
(3 (quote ,warn-face) t t)
|
||
,@extra-faces))
|
||
ical:font-lock-keywords))
|
||
|
||
;; Associate the print name with the type symbol for
|
||
;; `ical:parse-params' and `ical:print-param':
|
||
(when ,param-name
|
||
(push (cons ,param-name (quote ,symbolic-name)) ical:param-types)))))
|
||
|
||
|
||
;; Define properties:
|
||
(cl-defmacro ical:define-property (symbolic-name property-name doc value
|
||
&key default
|
||
(unrecognized default)
|
||
(default-type
|
||
(if (ical:value-type-symbol-p value)
|
||
value
|
||
'ical:text))
|
||
other-types
|
||
list-sep
|
||
child-spec
|
||
other-validator
|
||
((:name-face name-face)
|
||
'ical:property-name nondefault-name-face)
|
||
((:value-face value-face)
|
||
'ical:property-value nondefault-value-face)
|
||
((:warn-face warn-face)
|
||
'ical:warning nondefault-warn-face)
|
||
extra-faces
|
||
link)
|
||
"Define iCalendar property PROPERTY-NAME under SYMBOLIC-NAME.
|
||
PROPERTY-NAME should be the property name as it should appear in
|
||
iCalendar data.
|
||
|
||
VALUE should either be a symbol for a value type defined with
|
||
`icalendar-define-type', or an `rx' regular expression. If it is
|
||
a type symbol, the regex, reader and printer functions associated
|
||
with that type will be used when parsing and serializing the
|
||
property's value. If it is a regular expression, it is assumed
|
||
that the values are strings of type `icalendar-text' which match
|
||
that regular expression.
|
||
|
||
An `rx' regular expression named SYMBOLIC-NAME is defined to
|
||
match the property:
|
||
Group 1 of this regex matches PROPERTY-NAME.
|
||
Group 2 matches VALUE.
|
||
Group 3, if matched, contains any property value which does
|
||
*not* match VALUE, and is incorrect according to the standard.
|
||
Group 4, if matched, contains the (unparsed) property parameters;
|
||
its boundaries can be used for parsing these.
|
||
|
||
This regex matches the entire string representing this property,
|
||
from the beginning of the content line to the end of its value.
|
||
Another regular expression named `SYMBOLIC-NAME-value' is also
|
||
defined to match just the value part, after the separating colon,
|
||
with groups 2 and 3 as above.
|
||
|
||
A function to match the complete property expression called
|
||
`icalendar-match-PROPERTY-NAME-property' is defined. This
|
||
function is used to provide syntax highlighting in
|
||
`icalendar-mode'.
|
||
|
||
See the functions `icalendar-read-property-value',
|
||
`icalendar-parse-property-value', `icalendar-parse-property', and
|
||
`icalendar-print-property-node' to convert properties defined
|
||
with this macro to and from their text representation in
|
||
iCalendar format.
|
||
|
||
The following keyword arguments are accepted:
|
||
|
||
:default - a (string representing the) default value, if
|
||
the property is not specified in a given component.
|
||
|
||
:unrecognized - a (string representing the) value which must be
|
||
substituted for values that are not recognized but
|
||
syntactically correct according to RFC5545. Unrecognized values
|
||
must be in match group 5 of the regex determined by VALUE. An
|
||
unrecognized value will be preserved in the syntax tree
|
||
metadata and printed instead of this value when the node is
|
||
printed. Defaults to any value specified for :default.
|
||
|
||
:default-type - a type symbol naming the default type of the
|
||
property's value. If the property's value differs from this
|
||
type, an `icalendar-valuetypeparam' parameter will be added to
|
||
the property's syntax node and printed when the node is
|
||
printed. Default is VALUE if VALUE is a value type symbol,
|
||
otherwise the type `icalendar-text'.
|
||
|
||
:other-types - a list of type symbols naming value types other
|
||
than :default-type. These represent alternative types for the
|
||
property's value. If parsing the property's value under its
|
||
default type fails, these types will be tried in turn, and only
|
||
if the property's value matches none of them will an error be
|
||
signaled.
|
||
|
||
:list-sep - if the property accepts a list of values, this should
|
||
be a string which separates the values (typically \",\"). If
|
||
:list-sep is non-nil, the value string will first be split on
|
||
the separator, then each value will be read according to VALUE
|
||
and collected into a list when parsing. When printing, the
|
||
inverse happens: values are printed individually and then
|
||
joined with :list-sep. Passing this argument marks
|
||
SYMBOLIC-NAME as a type that accepts a list of values for
|
||
`icalendar-expects-list-of-values-p'.
|
||
|
||
:child-spec - a plist mapping the following keywords to lists
|
||
of type symbols:
|
||
:one - parameters that must appear exactly once
|
||
:one-or-more - parameters that must appear at least once and
|
||
may appear more than once
|
||
:zero-or-one - parameters that must appear at most once
|
||
:zero-or-more - parameters that may appear more than once
|
||
:allow-others - if non-nil, other parameters besides those listed in
|
||
the above are allowed to appear. (In this case, a
|
||
:zero-or-more clause is redundant.)
|
||
|
||
:other-validator - a function to perform any additional validation of
|
||
the component, beyond what `icalendar-ast-node-valid-p' checks.
|
||
This function should accept one argument, a syntax node. It
|
||
should return non-nil if the node is valid, or signal an
|
||
`icalendar-validation-error' if it is not. Its name does not
|
||
need to be quoted.
|
||
|
||
:name-face - a face symbol for highlighting the property name
|
||
(default: `icalendar-property-name')
|
||
|
||
:value-face - a face symbol for highlighting valid property values
|
||
(default: `icalendar-property-value')
|
||
|
||
:warn-face - a face symbol for highlighting invalid property values
|
||
(default: `icalendar-warning')
|
||
|
||
:extra-faces - a list of the form for HIGHLIGHT in `font-lock-keywords'.
|
||
In particular, ((GROUPNUM FACENAME [OVERRIDE [LAXMATCH]])...)
|
||
can be used to apply different faces to different match subgroups.
|
||
|
||
:link - a string containing a URL for documentation of this property"
|
||
(declare (doc-string 2))
|
||
(let* (;; Value RX:
|
||
(full-value-rx-name
|
||
(intern (concat (symbol-name symbolic-name) "-property-value")))
|
||
(values-rx (when list-sep
|
||
`(seq ,value (zero-or-more ,list-sep ,value))))
|
||
;; Related functions:
|
||
(property-dname (if property-name
|
||
(downcase property-name)
|
||
(string-trim (symbol-name symbolic-name)
|
||
"icalendar-" "-property")))
|
||
(matcher-name
|
||
(intern (concat "icalendar-match-" property-dname "-property")))
|
||
(type-predicate-name
|
||
(intern (concat "icalendar-" property-dname "-property-p")))
|
||
;; Faces:
|
||
(has-faces (or nondefault-name-face nondefault-value-face
|
||
nondefault-warn-face extra-faces))
|
||
;; Documentation:
|
||
(header "It names a property type defined by `icalendar-define-property'.")
|
||
(val-list (if list-sep (concat "VAL1" list-sep "VAL2" list-sep "...")
|
||
"VAL"))
|
||
(default-doc (if default (format "The default value is: \"%s\"\n" default)
|
||
""))
|
||
(s (if list-sep "s" "")) ; to make plurals
|
||
(val-doc (concat "VAL" s " "
|
||
"must be " (unless list-sep "a ")
|
||
(format "value%s of one of the following types:\n" s)
|
||
(string-join
|
||
(cons
|
||
(format "`%s' (default)" default-type)
|
||
(mapcar (lambda (type) (format "`%s'" type))
|
||
other-types))
|
||
"\n")
|
||
default-doc))
|
||
(name-doc (if property-name "" "NAME must match rx `icalendar-name'"))
|
||
(syntax-doc (format "Syntax: %s[;PARAM...]:%s\n%s\n%s\n"
|
||
(or property-name "NAME") val-list name-doc val-doc))
|
||
(child-doc
|
||
(concat
|
||
"The following parameters are required or allowed\n"
|
||
"as children in syntax nodes of this type:\n\n"
|
||
(ical:format-child-spec child-spec)
|
||
(when (plist-get child-spec :allow-others)
|
||
"\nOther parameters of any type are also allowed.\n")))
|
||
(full-doc (concat header "\n\n" doc "\n\n" syntax-doc "\n\n" child-doc)))
|
||
|
||
`(progn
|
||
;; Type metadata needs to be available at both compile time and
|
||
;; run time. In particular, `ical:value-type-symbol-p' needs to
|
||
;; work at compile time.
|
||
(eval-and-compile
|
||
(setplist (quote ,symbolic-name)
|
||
(list
|
||
'ical:is-type t
|
||
'ical:is-property t
|
||
'ical:matcher (function ,matcher-name)
|
||
'ical:default-value ,default
|
||
'ical:default-type (quote ,default-type)
|
||
'ical:other-types (quote ,other-types)
|
||
'ical:list-sep ,list-sep
|
||
'ical:substitute-value ,unrecognized
|
||
'ical:value-type
|
||
(when (ical:value-type-symbol-p (quote ,value))
|
||
(quote ,value))
|
||
'ical:value-rx (quote ,value)
|
||
'ical:values-rx (quote ,values-rx)
|
||
'ical:full-value-rx (quote ,full-value-rx-name)
|
||
'ical:child-spec (quote ,child-spec)
|
||
'ical:other-validator (function ,other-validator)
|
||
'ical:type-documentation ,full-doc
|
||
'ical:link ,link)))
|
||
|
||
;; Value regex which matches:
|
||
;; Group 2: correct values of the property, and
|
||
;; Group 3: incorrect values up to end-of-line (for syntax warnings)
|
||
(rx-define ,full-value-rx-name
|
||
(or (group-n 2 ,(or values-rx value))
|
||
(group-n 3 (zero-or-more not-newline))))
|
||
|
||
;; Full property regex which matches:
|
||
;; Group 1: the property name,
|
||
;; Group 2: correct values of the property, and
|
||
;; Group 3: incorrect values up to end-of-line (for syntax warnings)
|
||
(rx-define ,symbolic-name
|
||
(seq line-start
|
||
(group-n 1 ,(or property-name 'ical:name))
|
||
(group-n 4 (zero-or-more ical:other-param-safe))
|
||
":"
|
||
,full-value-rx-name
|
||
line-end))
|
||
|
||
;; Matcher:
|
||
(defun ,matcher-name (limit)
|
||
,(concat (format "Matcher for `%s' property.\n" symbolic-name)
|
||
"(Defined by icalendar-define-property.)")
|
||
(re-search-forward (rx ,symbolic-name) limit t))
|
||
|
||
;; CL-type to represent syntax nodes for this property:
|
||
(defun ,type-predicate-name (node)
|
||
,(format "Return non-nil if NODE represents a %s property." property-name)
|
||
(and (ical:ast-node-p node)
|
||
(eq (ical:ast-node-type node) (quote ,symbolic-name))))
|
||
|
||
(cl-deftype ,symbolic-name () '(satisfies ,type-predicate-name))
|
||
|
||
;; Associate the print name with the type symbol for
|
||
;; `icalendar-parse-property', `icalendar-print-property-node', etc.:
|
||
(when ,property-name
|
||
(push (cons ,property-name (quote ,symbolic-name)) ical:property-types))
|
||
|
||
;; Generate an entry for font-lock-keywords in icalendar-mode:
|
||
(when ,has-faces
|
||
;; Avoid circular load of icalendar-mode.el in
|
||
;; icalendar-parser.el (which does not use the *-face
|
||
;; keywords), while still allowing external code to add to
|
||
;; font-lock-keywords dynamically:
|
||
(require 'icalendar-mode)
|
||
(push (quote (,matcher-name
|
||
(1 (quote ,name-face) t t)
|
||
(2 (quote ,value-face) t t)
|
||
(3 (quote ,warn-face) t t)
|
||
,@extra-faces))
|
||
ical:font-lock-keywords)))))
|
||
|
||
|
||
;; Define components:
|
||
(cl-defmacro ical:define-component (symbolic-name component-name doc
|
||
&key
|
||
((:keyword-face keyword-face)
|
||
'ical:keyword nondefault-keyword-face)
|
||
((:name-face name-face)
|
||
'ical:component-name nondefault-name-face)
|
||
child-spec
|
||
other-validator
|
||
link)
|
||
"Define iCalendar component COMPONENT-NAME under SYMBOLIC-NAME.
|
||
COMPONENT-NAME should be the name of the component as it should
|
||
appear in iCalendar data.
|
||
|
||
Regular expressions to match the component boundaries are defined
|
||
named `COMPONENT-NAME-begin' and `COMPONENT-NAME-end' (or
|
||
`OTHER-begin' and `OTHER-end', where `OTHER' is derived from
|
||
SYMBOLIC-NAME by removing any prefix `icalendar-' and suffix
|
||
`-component' if COMPONENT-NAME is nil).
|
||
Group 1 of these regexes matches the \"BEGIN\" or \"END\"
|
||
keyword that marks a component boundary.
|
||
Group 2 matches the component name.
|
||
|
||
A function to match the component boundaries is defined called
|
||
`icalendar-match-COMPONENT-NAME-component' (or
|
||
`icalendar-match-OTHER-component', with OTHER as above). This
|
||
function is used to provide syntax highlighting in
|
||
`icalendar-mode'.
|
||
|
||
The following keyword arguments are accepted:
|
||
|
||
:child-spec - a plist mapping the following keywords to lists
|
||
of type symbols:
|
||
:one - properties or components that must appear exactly once
|
||
:one-or-more - properties or components that must appear at least once and
|
||
may appear more than once
|
||
:zero-or-one - properties or components that must appear at most once
|
||
:zero-or-more - properties or components that may appear more than once
|
||
:allow-others - if non-nil, other children besides those listed in the above
|
||
are allowed to appear. (In this case, a :zero-or-more
|
||
clause is redundant.)
|
||
|
||
:other-validator - a function to perform any additional validation of
|
||
the component, beyond what `icalendar-ast-node-valid-p' checks.
|
||
This function should accept one argument, a syntax node. It
|
||
should return non-nil if the node is valid, or signal an
|
||
`icalendar-validation-error' if it is not. Its name does not
|
||
need to be quoted.
|
||
|
||
:keyword-face - a face symbol for highlighting the BEGIN/END keyword
|
||
(default: `icalendar-keyword')
|
||
|
||
:name-face - a face symbol for highlighting the component name
|
||
(default: `icalendar-component-name')
|
||
|
||
:link - a string containing a URL for documentation of this component"
|
||
(declare (doc-string 2))
|
||
(let* (;; Regexes:
|
||
(name-rx (or component-name 'ical:name))
|
||
(component-dname (if component-name
|
||
(downcase component-name)
|
||
(string-trim (symbol-name symbolic-name)
|
||
"icalendar-" "-component")))
|
||
(begin-rx-name (intern (concat "icalendar-" component-dname "-begin")))
|
||
(end-rx-name (intern (concat "icalendar-" component-dname "-end")))
|
||
;; Related functions:
|
||
(matcher-name
|
||
(intern (concat "icalendar-match-" component-dname "-component")))
|
||
(type-predicate-name
|
||
(intern (concat "icalendar-" component-dname "-component-p")))
|
||
;; Faces:
|
||
(has-faces (or nondefault-name-face nondefault-keyword-face))
|
||
;; Documentation:
|
||
(header "It names a component type defined by
|
||
`icalendar-define-component'.")
|
||
(name-doc (if (not component-name)
|
||
"\nNAME must match rx `icalendar-name'"
|
||
""))
|
||
(syntax-doc (format "Syntax:\nBEGIN:%s\n[contentline ...]\nEND:%1$s%s"
|
||
(or component-name "NAME")
|
||
name-doc))
|
||
(child-doc
|
||
(concat
|
||
"The following properties and components are required or "
|
||
"allowed\nas children in syntax nodes of this type:\n\n"
|
||
(ical:format-child-spec child-spec)
|
||
(when (plist-get child-spec :allow-others)
|
||
"\nOther properties and components of any type are also allowed.\n")))
|
||
(full-doc (concat header "\n\n" doc "\n\n" syntax-doc "\n\n" child-doc)))
|
||
|
||
`(progn
|
||
;; Type metadata needs to be available at both compile time and
|
||
;; run time. In particular, `ical:value-type-symbol-p' needs to
|
||
;; work at compile time.
|
||
(eval-and-compile
|
||
(setplist (quote ,symbolic-name)
|
||
(list
|
||
'ical:is-type t
|
||
'ical:is-component t
|
||
'ical:matcher (function ,matcher-name)
|
||
'ical:begin-rx (quote ,begin-rx-name)
|
||
'ical:end-rx (quote ,end-rx-name)
|
||
'ical:child-spec (quote ,child-spec)
|
||
'ical:other-validator (function ,other-validator)
|
||
'ical:type-documentation ,full-doc
|
||
'ical:link ,link)))
|
||
|
||
;; Regexes which match:
|
||
;; Group 1: BEGIN or END, and
|
||
;; Group 2: the component name
|
||
(rx-define ,begin-rx-name
|
||
(seq line-start
|
||
(group-n 1 "BEGIN")
|
||
":"
|
||
(group-n 2 ,name-rx)
|
||
line-end))
|
||
|
||
(rx-define ,end-rx-name
|
||
(seq line-start
|
||
(group-n 1 "END")
|
||
":"
|
||
(group-n 2 ,name-rx)
|
||
line-end))
|
||
|
||
(defun ,matcher-name (limit)
|
||
,(concat (format "Matcher for %s component boundaries.\n"
|
||
(or component-name "unrecognized"))
|
||
"(Defined by `icalendar-define-component'.)")
|
||
(re-search-forward (rx (or ,begin-rx-name ,end-rx-name)) limit t))
|
||
|
||
;; CL-type to represent syntax nodes for this component:
|
||
(defun ,type-predicate-name (node)
|
||
,(format "Return non-nil if NODE represents a %s component."
|
||
(or component-name "unrecognized"))
|
||
(and (ical:ast-node-p node)
|
||
(eq (ical:ast-node-type node) (quote ,symbolic-name))))
|
||
|
||
(cl-deftype ,symbolic-name () '(satisfies ,type-predicate-name))
|
||
|
||
;; Generate an entry for font-lock-keywords in icalendar-mode:
|
||
(when ,has-faces
|
||
;; Avoid circular load of icalendar-mode.el in
|
||
;; icalendar-parser.el (which does not use the *-face
|
||
;; keywords), while still allowing external code to add to
|
||
;; font-lock-keywords dynamically:
|
||
(require 'icalendar-mode)
|
||
(push (quote (,matcher-name
|
||
(1 (quote ,keyword-face) t t)
|
||
(2 (quote ,name-face) t t)))
|
||
ical:font-lock-keywords))
|
||
|
||
;; Associate the print name with the type symbol for
|
||
;; `icalendar-parse-component', `icalendar-print-component' etc.:
|
||
(when ,component-name
|
||
(push (cons ,component-name (quote ,symbolic-name))
|
||
ical:component-types)))))
|
||
|
||
|
||
;; 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 (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)))
|
||
|
||
(defalias 'ical:with-component #'ical:with-node-children
|
||
"Execute BODY with properties of NODE bound as in BINDINGS.
|
||
|
||
NODE should be an iCalendar syntax node representing an iCalendar
|
||
component: `icalendar-vevent', `icalendar-vtodo', `icalendar-vjournal',
|
||
`icalendar-vtimezone', `icalendar-vfreebusy', `icalendar-standard',
|
||
`icalendar-daylight'. It may also be an entire `icalendar-vcalendar'.
|
||
|
||
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.
|
||
:default - the default value, if any, for TYPE
|
||
:first - the first child node of TYPE
|
||
:value-node - the value (which is itself a node) of the node in :first
|
||
:value-type - the type of the node in :value-node.
|
||
:value - the value of the node in :value-node.
|
||
If TYPE expects a list of values, you should use the following keywords
|
||
instead of the previous three:
|
||
:value-nodes - the values (which are themselves nodes) 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 node in :value-node.
|
||
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.")
|
||
|
||
(defmacro ical:with-node-value (node &optional bindings &rest body)
|
||
"Execute BODY with bindings in BINDINGS taken from NODE and its children.
|
||
|
||
NODE should be an iCalendar syntax node representing a property or
|
||
parameter. If NODE is not a syntax node, this form evalutes to nil
|
||
without binding the variables in BINDINGS and without executing BODY.
|
||
|
||
Within BODY, if NODE's value is itself a syntax node, the symbol
|
||
`value-node' will be bound to the syntax node for NODE's value,
|
||
`value-type' will be bound to `value-node's type, and `value' will be
|
||
bound to `value-node's value.
|
||
|
||
If NODE's value is a list of syntax nodes, then within BODY,
|
||
`value-nodes' will be bound to those value nodes, `value-types' will be
|
||
bound to a list of their types, and `values' will be bound to their
|
||
values.
|
||
|
||
If NODE's value is not a syntax node, then `value' is instead bound
|
||
directly to NODE's value, and `value-type' and `value-node' are bound to
|
||
nil.
|
||
|
||
If BODY is nil, it is assumed to be the symbol `value'; thus
|
||
(icalendar-with-node-value some-node)
|
||
is equivalent to
|
||
(icalendar-with-node-value some-node nil value)
|
||
|
||
BINDINGS are passed on to `icalendar-with-node-children' and will be
|
||
available in BODY; see its docstring for their form."
|
||
(let ((vn (gensym "icalendar-node"))
|
||
(val (gensym "icalendar-value"))
|
||
(is-list (gensym "is-list")))
|
||
`(let ((,vn ,node))
|
||
(when (ical:ast-node-p ,vn)
|
||
(let* ((,val (ical:ast-node-value ,vn))
|
||
(value-node (when (ical:ast-node-p ,val) ,val))
|
||
(value-type (when (ical:ast-node-p value-node)
|
||
(ical:ast-node-type value-node)))
|
||
(value (if (ical:ast-node-p value-node)
|
||
(ical:ast-node-value value-node)
|
||
,val))
|
||
(,is-list (ical:expects-list-of-values-p (ical:ast-node-type ,vn)))
|
||
(value-nodes (when ,is-list
|
||
(seq-filter #'ical:ast-node-p ,val)))
|
||
(value-types (when ,is-list
|
||
(mapcar #'ical:ast-node-type value-nodes)))
|
||
(values (when ,is-list
|
||
(mapcar #'ical:ast-node-value value-nodes))))
|
||
(ignore value-type ; Silence the byte compiler when
|
||
value ; one of these goes unused
|
||
value-types
|
||
values)
|
||
(ical:with-node-children ,vn ,bindings ,@(or body (list 'value))))))))
|
||
|
||
(defalias 'ical:with-property #'ical:with-node-value
|
||
"Execute BODY with BINDINGS taken from the value and parameters in NODE.
|
||
|
||
NODE should be an iCalendar syntax node representing a property. If NODE
|
||
is not a syntax node, this form evalutes to nil without binding the
|
||
variables in BINDINGS and without executing BODY.
|
||
|
||
Within BODY, if NODE's value is itself a syntax node, the symbol
|
||
`value-node' will be bound to the syntax node for NODE's value,
|
||
`value-type' will be bound to `value-node's type, and `value' will be
|
||
bound to `value-node's value.
|
||
|
||
If NODE's value is a list of syntax nodes, then within BODY,
|
||
`value-nodes' will be bound to those value nodes, `value-types' will be
|
||
bound to a list of their types, and `values' will be bound to their
|
||
values.
|
||
|
||
If NODE's value is not a syntax node, then `value' is bound directly to
|
||
NODE's value, and `value-type' and `value-node' are bound to nil.
|
||
|
||
BINDINGS are passed on to `icalendar-with-node-children' and will be
|
||
available in BODY; see its docstring for their form.")
|
||
|
||
(defmacro ical:with-param (parameter &rest body)
|
||
"Bind the value in PARAMETER and execute BODY.
|
||
|
||
PARAMETER should be an iCalendar syntax node representing a
|
||
parameter. If PARAMETER is nil, this form evalutes to nil without
|
||
executing BODY.
|
||
|
||
Within BODY, if PARAMETER's value is a syntax node, the symbol
|
||
`value-node' will be bound to that syntax node, `value-type' will be
|
||
bound to the value node's type, and `value' will be bound to the value
|
||
node's value.
|
||
|
||
If PARAMETER's value is not a syntax node, then `value' is bound
|
||
directly to PARAMETER's value, and `value-type' and `value-node' are
|
||
bound to nil."
|
||
`(ical:with-node-value ,parameter nil ,@body))
|
||
|
||
(defmacro ical:with-child-of (node type &optional bindings &rest body)
|
||
"Like `icalendar-with-node-value', but for the relevant node's parent.
|
||
|
||
Find the first child node of type TYPE in NODE, bind that
|
||
child node's value and any of its children in BINDINGS and execute BODY
|
||
with these bindings. If there is no such node, this form evalutes to
|
||
nil without executing BODY.
|
||
|
||
Within BODY, the symbols `value-node', `value-type', and `value' will be
|
||
bound as in `icalendar-with-node-value'.
|
||
If BODY is nil, it is assumed to be the symbol `value'; thus
|
||
(icalendar-with-child-of some-node some-type)
|
||
is equivalent to
|
||
(icalendar-with-child-of some-node some-type nil value)
|
||
|
||
See `icalendar-with-node-children' for the form of BINDINGS."
|
||
(let ((child (gensym "icalendar-node")))
|
||
`(let ((,child (ical:ast-node-first-child-of ,type ,node)))
|
||
(ical:with-node-value ,child ,bindings ,@body))))
|
||
|
||
(defalias 'ical:with-property-of #'ical:with-child-of
|
||
"Like `icalendar-with-property', but for components containing that property.
|
||
|
||
Find the first property node of type TYPE in NODE and execute BODY.
|
||
|
||
Within BODY, the symbols `value-node', `value-type', and `value' will be
|
||
bound to the property's value node, type and value as in
|
||
`icalendar-with-node-value'. If BODY is nil, it is assumed to be the
|
||
symbol `value'; thus
|
||
(icalendar-with-property-of some-component some-type)
|
||
is equivalent to
|
||
(icalendar-with-property-of some-component some-type nil value)
|
||
|
||
BINDINGS can be used to bind the property's parameters; see
|
||
`icalendar-with-node-children' for the form of BINDINGS.")
|
||
|
||
(defmacro ical:with-param-of (node type &rest body)
|
||
"Like `icalendar-with-param', but for properties containing that param.
|
||
|
||
Find the first parameter node of TYPE in NODE and execute BODY.
|
||
|
||
Within BODY, the symbols `value-node', `value-type', and `value' will be
|
||
bound to the parameter's value node, type and value as in
|
||
`icalendar-with-node-value'. If BODY is nil, it is assumed to be the
|
||
symbol `value'; thus
|
||
(icalendar-with-param-of some-property some-type)
|
||
is equivalent to
|
||
(icalendar-with-param-of some-property some-type nil value)"
|
||
`(ical:with-child-of ,node ,type nil ,@body))
|
||
|
||
(provide 'icalendar-macs)
|
||
;; Local Variables:
|
||
;; read-symbol-shorthands: (("ical:" . "icalendar-"))
|
||
;; End:
|
||
;;; icalendar-macs.el ends here
|