;;; 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.


(require 'cl-lib)

(declare-function ical:value-type-symbol-p "icalendar-ast.el")

;; Some utilities:
(defun ical:protected-intern (sym-name)
  "Call `intern' on SYM-NAME and return the result, but warn if the
resulting symbol already has icalendar-relevant properties."
  (let ((sym (intern sym-name)))
    (when (or (fboundp sym)
              (get sym 'rx-definition)
              (get sym 'ical:is-type))
      (warn "Symbol `%s' already has iCalendar properties" sym))
    sym))

(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 an URL for further documentation of this type"
  (let* (;; Related functions:
         (type-dname (if print-name
                         (downcase print-name)
                       (string-trim
                        (symbol-name symbolic-name)
                        "icalendar-" "value")))
         (matcher-name (ical:protected-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', except that 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: ical:parameter-name)

:value-face - a face symbol for highlighting valid property values
  (default: ical:parameter-value)

:warn-face - a face symbol for highlighting invalid property values
  (default: ical: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."
  (let* (;; Related function names:
         (param-dname (if param-name
                          (downcase param-name)
                        (string-trim (symbol-name symbolic-name)
                                     "icalendar-" "param")))
         (matcher-name (ical:protected-intern
                        (concat "icalendar-match-" param-dname "-param")))

         (type-predicate-name
          (ical:protected-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 (ical:protected-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)
         ,(format "Matcher for %s parameter (defined by define-param)" param-name)
         (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))
       ;; TODO: integrate param-name with eldoc in icalendar-mode
       )))


;; 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: `ical:property-name')

:value-face - a face symbol for highlighting valid property values
  (default: `ical:property-value')

:warn-face - a face symbol for highlighting invalid property values
  (default: `ical: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"
  (let* (;; Value RX:
        (full-value-rx-name
         (ical:protected-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 (ical:protected-intern
                       (concat "icalendar-match-"
                               property-dname
                               "-property")))
        (type-predicate-name
         (ical:protected-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 any))))

       ;; 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)
         ,(format "Matcher for `%s' property (defined by define-property)"
                  symbolic-name)
         (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: ical:keyword)

:name-face - a face symbol for highlighting the component name
  (default: ical:component-name)

:link - a string containing a URL for documentation of this component"
  (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 (ical:protected-intern
                         (concat "icalendar-" component-dname "-begin")))
         (end-rx-name (ical:protected-intern
                       (concat "icalendar-" component-dname "-end")))
         ;; Related functions:
         (matcher-name
          (ical:protected-intern
           (concat "icalendar-match-" component-dname "-component")))
         (type-predicate-name
          (ical:protected-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)
         ,(format "Matcher for %s component boundaries"
                  (or component-name "unrecognized"))
           (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))

       ;; TODO: integrate component-name with eldoc in icalendar-mode
       )))

(provide 'icalendar-macs)
;; Local Variables:
;; read-symbol-shorthands: (("ical:" . "icalendar-"))
;; End:
;;; icalendar-macs.el ends here