Function: diary-icalendar-offset-sexp-to-nodes

diary-icalendar-offset-sexp-to-nodes is a byte-compiled function defined in diary-icalendar.el.gz.

Signature

(diary-icalendar-offset-sexp-to-nodes SEXP)

Documentation

Convert a diary-offset SEXP to a list of property nodes.

SEXP must have the form (diary-offset INNER-SEXP NDAYS). The conversion is only possible for relatively simple cases of INNER-SEXP. The INNER-SEXP is first converted to a list of property nodes (see diary-icalendar-export-sexp), and then any date, time, period, and recurrence rule values in these nodes are adjusted NDAYS forward.

Source Code

;; Defined in /usr/src/emacs/lisp/calendar/diary-icalendar.el.gz
(defun di:offset-sexp-to-nodes (sexp)
  "Convert a `diary-offset' SEXP to a list of property nodes.

SEXP must have the form (diary-offset INNER-SEXP NDAYS).  The conversion
is only possible for relatively simple cases of INNER-SEXP.  The
INNER-SEXP is first converted to a list of property nodes (see
`diary-icalendar-export-sexp'), and then any date, time, period, and
recurrence rule values in these nodes are adjusted NDAYS forward."
  (let* ((arg1 (nth 1 sexp))
         (inner-sexp (if (eq (car arg1) 'quote)
                         (eval arg1 nil) ; unquote a quoted inner sexp
                       arg1))
         (nodes (di:sexp-to-nodes inner-sexp))
         (ndays (nth 2 sexp)))
    (dolist (node nodes)
      (ical:with-property node nil
       (cl-case (ical:ast-node-type node)
         ((ical:dtstart ical:dtend)
          (ical:ast-node-set-value
           value-node
           (ical:date/time-add value :day ndays)))
         (ical:exdate
          (dolist (val-node value-nodes)
            (ical:with-node-value val-node nil
              (ical:ast-node-set-value
               val-node
               (ical:date/time-add value :day ndays)))))
         (ical:rdate
          (dolist (val-node value-nodes)
            (ical:ast-node-set-value
              val-node
              (ical:with-node-value val-node nil
               (cl-typecase value
                (ical:period
                 (ical:make-period
                  (ical:date/time-add (ical:period-start value) :day ndays)
                  :end (when (ical:period--defined-end value)
                         (ical:date/time-add
                          (ical:period--defined-end value) :day ndays))
                  :duration (ical:period-dur-value value)))
                (t (ical:date/time-add value :day ndays)))))))
         (ical:rrule
          (let ((mdays (ical:rrule-by* 'BYMONTHDAY value))
                (ydays (ical:rrule-by* 'BYYEARDAY value))
                (dows (ical:rrule-by* 'BYDAY value))
                (bad-clause
                 (cond ((ical:rrule-by* 'BYSETPOS value) 'BYSETPOS)
                       ((ical:rrule-by* 'BYWEEKNO value) 'BYWEEKNO))))
            ;; We can't reliably subtract days in the following cases, so bail:
            (when (< 28 ndays)
              (di:signal-export-error
               (format "Cannot export `diary-offset' with large offset %d" ndays)))
            (when bad-clause
              (di:signal-export-error
               (format "Cannot export `diary-offset': inner SEXP %s contains %s"
                       sexp bad-clause)))
            (when (seq-some (lambda (md)
                              (or (and (< 0 md) (< 28 (+ md ndays)))
                                  (and (< md 0) (< 0 (+ md ndays)))))
                            mdays)
              (di:signal-export-error
               (format "Cannot export `diary-offset': inner SEXP %s contains %s"
                       inner-sexp
                       "BYMONTHDAY clause that could cross month bounds")))
            (when (seq-some (lambda (yd)
                              (or (and (< 0 yd) (< 365 (+ yd ndays)))
                                  (and (< yd 0) (< 0 (+ yd ndays)))))
                            ydays)
              (di:signal-export-error
               (format "Cannot export `diary-offset': inner SEXP %s contains %s"
                       inner-sexp
                       "BYYEARDAY clause that could cross year bounds")))
            ;; Adjust the rule's clauses to account for the offset:
            (when mdays
              (setf (alist-get 'BYMONTHDAY value)
                    (list
                     (mapcar (apply-partially #'+ ndays) mdays))))
            (when ydays
              (setf (alist-get 'BYYEARDAY value)
                    (list
                     (mapcar (apply-partially #'+ ndays) ydays))))
            (when dows
              (setf (alist-get 'BYDAY value)
                    (list
                     (mapcar
                      (lambda (dow)
                        (if (integerp dow)
                            (mod (+ dow ndays) 7)
                          (let* ((wkday (car dow))
                                 (shifted (+ wkday ndays))
                                 (new-wkday (mod shifted 7))
                                 (new-offs
                                  (cond
                                   ;; if shifted is not between 0 and 7,
                                   ;; we moved into another week, so we need
                                   ;; to modify the offset within the month/year
                                   ;; by the number of weeks moved:
                                   ((< 7 shifted)
                                    (+ (/ shifted 7) (cdr dow)))
                                   ((< shifted 0)
                                    (+ -1 (/ shifted 7) (cdr dow)))
                                   ;; otherwise it stays the same:
                                   (t (cdr dow)))))
                            (cons new-wkday new-offs))))
                      dows)))))))))
    ;; Return the modified nodes:
    nodes))