Function: diary-icalendar-parse-date-form

diary-icalendar-parse-date-form is a byte-compiled function defined in diary-icalendar.el.gz.

Signature

(diary-icalendar-parse-date-form)

Documentation

Parse a date matching diary-date-forms on the current line.

If a date is found, moves the current restriction past the end of the date and returns a list (MONTH DAY YEAR), where each value is an integer or t if the date is generic in that unit. Otherwise returns nil.

Source Code

;; Defined in /usr/src/emacs/lisp/calendar/diary-icalendar.el.gz
;; TODO: move to diary-lib?
(defun di:parse-date-form ()
  "Parse a date matching `diary-date-forms' on the current line.

If a date is found, moves the current restriction past the end of the
date and returns a list (MONTH DAY YEAR), where each value is an integer
or t if the date is generic in that unit.  Otherwise returns nil."
  (goto-char (point-min))
  (catch 'date
    (let (date-regexp backup)
      (dolist (date-sexp diary-date-forms)
        (when (eq 'backup (car date-sexp))
          (setq date-sexp (cdr date-sexp))
          (setq backup t))
        (setq date-regexp (di:date-form-to-regexp date-sexp))
        (when backup (beginning-of-line))
        (when (let ((case-fold-search t))
                (re-search-forward date-regexp nil t))
          (let ((year
                 (let ((match (match-string 1)))
                   (if (or (null match) (equal match "*"))
                       t
                     (if (and diary-abbreviated-year-flag (length= match 2))
                         ;; from diary-lib.el:
                         ;; Add 2-digit year to current century.
                         ;; If more than 50 years in the future,
                         ;; assume last century.  If more than 50
                         ;; years in the past, assume next century.
                         (let* ((current-y
                                 (calendar-extract-year (calendar-current-date)))
                                (y (+ (string-to-number match)
                                      ;; Current century, eg 2000.
                                      (* 100 (/ current-y 100))))
                                (offset (- y current-y)))
                           (cond ((> offset 50)
                                  (- y 100))
                                 ((< offset -50)
                                  (+ y 100))
                                 (t y)))
                       (string-to-number match)))))
                (month
                 (let ((month-num (match-string 2))
                       (month-name (match-string 4)))
                   (cond ((or (equal month-name "*") (equal month-num "*")) t)
                         (month-num (string-to-number month-num))
                         (month-name
                          (alist-get
                           (capitalize month-name)
                           (calendar-make-alist
                            calendar-month-name-array
                            1 nil
                            calendar-month-abbrev-array
                            (mapcar (lambda (e) (format "%s." e))
                                    calendar-month-abbrev-array))
                           nil nil #'equal)))))
                (day
                 (let ((day-num (match-string 3))
                       (day-name (match-string 5)))
                   (cond
                    ;; We don't care about the day name here, unless it
                    ;; is "*", since it won't help us identify a day of
                    ;; the month.  Weekly entries under a weekday name
                    ;; are parsed by `di:parse-weekday-name', below.
                    ((or (equal day-name "*") (equal day-num "*")) t)
                    (day-num (string-to-number day-num))))))
            (when (and year month day)
              (narrow-to-region (match-end 0) (point-max))
              (throw 'date (list month day year)))))))))