mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-16 17:24:23 +00:00
1e7dae37b8
Fix some misuses of `defconst` and `%s`, avoid uses of the old dynbound dialect of `eval`, delete redundant `:group` arguments, and prefer #' to quote function names. And stop creating alists for completion tables since lists of strings work just as well. * lisp/calendar/appt.el: Delete redundant `:group` arguments. Prefer #' to quote function names. * lisp/calendar/cal-hebrew.el (solar-time-string): Declare function. (calendar-hebrew-read-date, calendar-hebrew-list-yahrzeits): * lisp/calendar/cal-persia.el (calendar-persian-read-date): * lisp/calendar/cal-mayan.el (calendar-mayan-read-haab-date) (calendar-mayan-read-tzolkin-date): * lisp/calendar/cal-julian.el (calendar-julian-goto-date): * lisp/calendar/cal-islam.el (calendar-islamic-read-date): * lisp/calendar/cal-coptic.el (calendar-coptic-read-date): * lisp/calendar/cal-bahai.el (calendar-bahai-read-date): Completion tables can be lists of strings for decades. * lisp/calendar/cal-china.el: Delete redundant `:group` arguments. (calendar-chinese-zodiac-sign-on-or-after) (calendar-chinese-new-moon-on-or-after): Use lexical dialect also for `eval`. * lisp/calendar/cal-dst.el: Delete redundant `:group` arguments. Use lexical dialect also for `eval`. * lisp/calendar/cal-html.el: Delete redundant `:group` arguments. * lisp/calendar/cal-menu.el: Prefer #' to quote function names. * lisp/calendar/cal-tex.el: Delete redundant `:group` arguments. (cal-tex-weekly-common): Use lexical dialect also for `eval`. * lisp/calendar/calendar.el (calendar-mode-map): Prefer #' to quote function names. * lisp/calendar/diary-icalendar.el (di:rrule-sexp-to-recurrence) (di:other-sexp-to-recurrence): Use lexical dialect also for `eval`. * lisp/calendar/diary-lib.el: Delete redundant `:group` arguments. Prefer #' to quote function names. (diary-sexp-entry, diary-offset, diary-remind): Use lexical dialect also for `eval`. * lisp/calendar/icalendar-macs.el (ical:define-param): Fix misuse of `%s` in `format`. * lisp/calendar/icalendar-parser.el (ical:value-types) (ical:param-types, ical:property-types, ical:component-types): Don't use `defconst` on variables we mutate. * lisp/calendar/icalendar-recur.el (icr:current-tz-to-vtimezone) (icr:current-tz-to-vtimezone): Use lexical dialect also for `eval`. * lisp/calendar/icalendar.el: Delete redundant `:group` arguments. * lisp/calendar/lunar.el: Prefer #' to quote function names. * lisp/calendar/solar.el (solar-sunrise-sunset-string) (calendar-sunrise-sunset-month): Use lexical dialect also for `eval`. * lisp/calendar/timeclock.el: Prefer #' to quote function names.
2948 lines
127 KiB
EmacsLisp
2948 lines
127 KiB
EmacsLisp
;;; icalendar.el --- iCalendar implementation -*- lexical-binding: t -*-
|
||
|
||
;; Copyright (C) 2002-2026 Free Software Foundation, Inc.
|
||
|
||
;; Author: Ulf Jasper <ulf.jasper@web.de>
|
||
;; Maintainer: emacs-devel@gnu.org
|
||
;; Created: August 2002
|
||
;; Keywords: calendar
|
||
;; Human-Keywords: calendar, diary, iCalendar, vCalendar
|
||
;; Old-Version: 0.19
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs 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.
|
||
|
||
;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; Most of the code in this file is now obsolete and has been marked as such.
|
||
;; For the new implementation of diary import/export, see diary-icalendar.el.
|
||
;; Error handling code, global variables, and user options relevant for the
|
||
;; entire iCalendar library remain in this file.
|
||
|
||
;; This package is documented in the Emacs Manual.
|
||
|
||
;; Please note:
|
||
;; - Diary entries which have a start time but no end time are assumed to
|
||
;; last for one hour when they are exported.
|
||
;; - Weekly diary entries are assumed to occur the first time in the first
|
||
;; week of the year 2000 when they are exported.
|
||
;; - Yearly diary entries are assumed to occur the first time in the year
|
||
;; 1900 when they are exported.
|
||
;; - Float diary entries are assumed to occur the first time on the
|
||
;; day when they are exported.
|
||
|
||
;;; History:
|
||
|
||
;; 0.07 onwards: see commit logs and ../ChangeLog*.
|
||
|
||
;; 0.06: (2004-10-06)
|
||
;; - Bugfixes regarding icalendar-import-format-*.
|
||
;; - Fix in icalendar-export-file -- thanks to Philipp Grau.
|
||
|
||
;; 0.05: (2003-06-19)
|
||
;; - New import format scheme: Replaced icalendar-import-prefix-*,
|
||
;; icalendar-import-ignored-properties, and
|
||
;; icalendar-import-separator with icalendar-import-format(-*).
|
||
;; - icalendar-import-file and icalendar-export-file
|
||
;; have an extra parameter which should prevent them from
|
||
;; erasing their target files (untested!).
|
||
;; - Tested with Emacs 21.3.2
|
||
|
||
;; 0.04:
|
||
;; - Bugfix: import: double quoted param values did not work
|
||
;; - Read DURATION property when importing.
|
||
;; - Added parameter icalendar-duration-correction.
|
||
|
||
;; 0.03: (2003-05-07)
|
||
;; - Export takes care of european-calendar-style.
|
||
;; - Tested with Emacs 21.3.2 and XEmacs 21.4.12
|
||
|
||
;; 0.02:
|
||
;; - Should work in XEmacs now. Thanks to Len Trigg for the XEmacs patches!
|
||
;; - Added exporting from Emacs diary to ical.
|
||
;; - Some bugfixes, after testing with calendars from https://icalshare.com.
|
||
;; - Tested with Emacs 21.3.2 and XEmacs 21.4.12
|
||
|
||
;; 0.01: (2003-03-21)
|
||
;; - First published version. Trial version. Alpha version.
|
||
|
||
;;; Code:
|
||
|
||
(eval-when-compile (require 'compile))
|
||
(eval-when-compile (require 'cl-lib))
|
||
|
||
;; ======================================================================
|
||
;; Customizables
|
||
;; ======================================================================
|
||
(defgroup icalendar nil
|
||
"iCalendar support."
|
||
:prefix "icalendar-"
|
||
:group 'calendar)
|
||
|
||
(defcustom icalendar-import-format
|
||
"%s%d%l%o"
|
||
"Format for importing events from iCalendar into Emacs diary.
|
||
It defines how iCalendar events are inserted into diary file.
|
||
This may either be a string or a function.
|
||
|
||
In case of a formatting STRING the following specifiers can be used:
|
||
%c Class, see `icalendar-import-format-class'
|
||
%d Description, see `icalendar-import-format-description'
|
||
%l Location, see `icalendar-import-format-location'
|
||
%o Organizer, see `icalendar-import-format-organizer'
|
||
%s Summary, see `icalendar-import-format-summary'
|
||
%t Status, see `icalendar-import-format-status'
|
||
%u URL, see `icalendar-import-format-url'
|
||
%U UID, see `icalendar-import-format-uid'
|
||
|
||
A formatting FUNCTION will be called with a VEVENT as its only
|
||
argument. It must return a string. See
|
||
`icalendar-import-format-sample' for an example."
|
||
:type '(choice
|
||
(string :tag "String")
|
||
(function :tag "Function")))
|
||
|
||
(make-obsolete-variable
|
||
'icalendar-import-format
|
||
"please use `diary-icalendar-vevent-format-function' for import
|
||
formatting instead."
|
||
"31.1")
|
||
|
||
(defcustom icalendar-import-format-summary
|
||
"%s"
|
||
"Format string defining how the summary element is formatted.
|
||
This applies only if the summary is not empty! `%s' is replaced
|
||
by the summary."
|
||
:type 'string)
|
||
|
||
(make-obsolete-variable
|
||
'icalendar-import-format-summary
|
||
"please use `diary-icalendar-vevent-format-function' for import
|
||
formatting instead."
|
||
"31.1")
|
||
|
||
(defcustom icalendar-import-format-description
|
||
"\n Desc: %s"
|
||
"Format string defining how the description element is formatted.
|
||
This applies only if the description is not empty! `%s' is
|
||
replaced by the description."
|
||
:type 'string)
|
||
|
||
(make-obsolete-variable
|
||
'icalendar-import-format-description
|
||
"please use `diary-icalendar-vevent-format-function' for import
|
||
formatting instead."
|
||
"31.1")
|
||
|
||
(defcustom icalendar-import-format-location
|
||
"\n Location: %s"
|
||
"Format string defining how the location element is formatted.
|
||
This applies only if the location is not empty! `%s' is replaced
|
||
by the location."
|
||
:type 'string)
|
||
|
||
(make-obsolete-variable
|
||
'icalendar-import-format-location
|
||
"please use `diary-icalendar-vevent-format-function' for import
|
||
formatting instead."
|
||
"31.1")
|
||
|
||
(defcustom icalendar-import-format-organizer
|
||
"\n Organizer: %s"
|
||
"Format string defining how the organizer element is formatted.
|
||
This applies only if the organizer is not empty! `%s' is
|
||
replaced by the organizer."
|
||
:type 'string)
|
||
|
||
(make-obsolete-variable
|
||
'icalendar-import-format-organizer
|
||
"please use `diary-icalendar-vevent-format-function' for import
|
||
formatting instead."
|
||
"31.1")
|
||
|
||
(defcustom icalendar-import-format-url
|
||
"\n URL: %s"
|
||
"Format string defining how the URL element is formatted.
|
||
This applies only if the URL is not empty! `%s' is replaced by
|
||
the URL."
|
||
:type 'string)
|
||
|
||
(make-obsolete-variable
|
||
'icalendar-import-format-url
|
||
"please use `diary-icalendar-vevent-format-function' for import
|
||
formatting instead."
|
||
"31.1")
|
||
|
||
(defcustom icalendar-import-format-uid
|
||
"\n UID: %s"
|
||
"Format string defining how the UID element is formatted.
|
||
This applies only if the UID is not empty! `%s' is replaced by
|
||
the UID."
|
||
:type 'string
|
||
:version "24.3")
|
||
|
||
(make-obsolete-variable
|
||
'icalendar-import-format-uid
|
||
"please use `diary-icalendar-vevent-format-function' for import
|
||
formatting instead."
|
||
"31.1")
|
||
|
||
(defcustom icalendar-import-format-status
|
||
"\n Status: %s"
|
||
"Format string defining how the status element is formatted.
|
||
This applies only if the status is not empty! `%s' is replaced by
|
||
the status."
|
||
:type 'string)
|
||
|
||
(make-obsolete-variable
|
||
'icalendar-import-format-status
|
||
"please use `diary-icalendar-vevent-format-function' for import
|
||
formatting instead."
|
||
"31.1")
|
||
|
||
(defcustom icalendar-import-format-class
|
||
"\n Class: %s"
|
||
"Format string defining how the class element is formatted.
|
||
This applies only if the class is not empty! `%s' is replaced by
|
||
the class."
|
||
:type 'string)
|
||
|
||
(make-obsolete-variable
|
||
'icalendar-import-format-class
|
||
"please use `diary-icalendar-vevent-format-function' for import
|
||
formatting instead."
|
||
"31.1")
|
||
|
||
(define-obsolete-variable-alias
|
||
'icalendar-recurring-start-year
|
||
'diary-icalendar-recurring-start-year
|
||
"31.1")
|
||
|
||
(define-obsolete-variable-alias
|
||
'icalendar-export-hidden-diary-entries
|
||
'diary-icalendar-export-nonmarking-entries
|
||
"31.1")
|
||
|
||
(defcustom ical:uid-format
|
||
"%h"
|
||
"Format string for unique ID (UID) values for iCalendar components.
|
||
|
||
This string is used by `icalendar-make-uid' to generate UID values when
|
||
creating iCalendar components.
|
||
|
||
The following specifiers are available:
|
||
%c COUNTER, an integer value that is increased each time a uid is
|
||
generated. This may be necessary for systems which do not
|
||
provide time-resolution finer than a second.
|
||
%h HASH, a hash value of the component's contents or system information,
|
||
%t TIMESTAMP, a unique creation timestamp,
|
||
%u USERNAME, the value of `user-login-name'.
|
||
%s (obsolete, ignored)
|
||
|
||
For example, a value of \"%h%t@mydomain.com\" will generate a UID code
|
||
for each entry composed of a hash of the event data, a creation
|
||
timestamp, and your personal domain name."
|
||
:type 'string)
|
||
|
||
(defcustom ical:vcalendar-prodid
|
||
(format "-//gnu.org//GNU Emacs %s//EN" emacs-version)
|
||
"The value of the `icalendar-prodid' property for VCALENDAR objects
|
||
produced by this Emacs."
|
||
:type 'string)
|
||
|
||
(defconst ical:vcalendar-version "2.0"
|
||
"The current version of the VCALENDAR object, used in the
|
||
`icalendar-version' property. \"2.0\" is the version corresponding to
|
||
RFC5545.")
|
||
|
||
(define-obsolete-variable-alias
|
||
'icalendar-export-sexp-enumeration-days
|
||
'diary-icalendar-export-sexp-enumeration-days
|
||
"31.1")
|
||
|
||
(define-obsolete-variable-alias
|
||
'icalendar-export-sexp-enumerate-all
|
||
'diary-icalendar-export-sexp-enumerate-all
|
||
"31.1")
|
||
|
||
(defcustom icalendar-export-alarms
|
||
nil
|
||
"Determine if and how alarms are included in exported diary events."
|
||
:version "25.1"
|
||
:type '(choice (const :tag "Do not include alarms in export"
|
||
nil)
|
||
(list :tag "Create alarms in exported diary entries"
|
||
(integer :tag "Advance time (minutes)"
|
||
:value 10)
|
||
(set :tag "Alarm type"
|
||
(list :tag "Audio"
|
||
(const :tag "Audio" audio))
|
||
(list :tag "Display"
|
||
(const :tag "Display" display))
|
||
(list :tag "Email"
|
||
(const email)
|
||
(repeat :tag "Attendees"
|
||
(string :tag "Email")))))))
|
||
|
||
(make-obsolete-variable
|
||
'icalendar-export-alarms
|
||
"please use the new format in `diary-icalendar-export-alarms' instead."
|
||
"31.1")
|
||
|
||
(defcustom icalendar-debug-level 1
|
||
"Minimum severity for logging iCalendar error messages.
|
||
A value of 2 only logs errors.
|
||
A value of 1 also logs warnings.
|
||
A value of 0 also logs debugging information."
|
||
:type 'integer)
|
||
|
||
(defvar icalendar-debug nil
|
||
"Enable icalendar debug messages.")
|
||
|
||
(make-obsolete-variable
|
||
'icalendar-debug
|
||
'icalendar-debug-level
|
||
"31.1")
|
||
|
||
;; ======================================================================
|
||
;; NO USER SERVICEABLE PARTS BELOW THIS LINE
|
||
;; ======================================================================
|
||
|
||
(defconst icalendar--weekday-array ["SU" "MO" "TU" "WE" "TH" "FR" "SA"])
|
||
|
||
(make-obsolete-variable
|
||
'icalendar--weekday-array
|
||
'icalendar-weekday-numbers
|
||
"31.1")
|
||
|
||
;; ======================================================================
|
||
;; all the other libs we need
|
||
;; ======================================================================
|
||
(require 'calendar)
|
||
(require 'diary-lib)
|
||
|
||
;; ======================================================================
|
||
;; misc
|
||
;; ======================================================================
|
||
(defun icalendar--dmsg (&rest args)
|
||
"Print message ARGS if `icalendar-debug' is non-nil."
|
||
(declare (obsolete icalendar-warn "31.1"))
|
||
(if (or icalendar-debug (= 0 icalendar-debug-level))
|
||
(with-current-buffer (ical:error-buffer)
|
||
(goto-char (point-max))
|
||
(insert (apply #'format-message args))
|
||
(insert "\n"))))
|
||
|
||
;; ======================================================================
|
||
;; Error handling
|
||
;; ======================================================================
|
||
(define-error 'ical:error "iCalendar error")
|
||
|
||
(defconst ical:error-buffer-name "*icalendar-errors*"
|
||
"Name of buffer in which errors are listed when processing iCalendar data.")
|
||
|
||
(defun ical:error-buffer ()
|
||
"Return the iCalendar errors buffer, creating it if necessary.
|
||
The buffer name is based on `icalendar-error-buffer-name'."
|
||
(get-buffer-create ical:error-buffer-name))
|
||
|
||
(defvar ical:inhibit-error-erasure nil
|
||
"When non-nil, `icalendar-init-error-buffer' will not erase the errors
|
||
buffer.")
|
||
|
||
(defun ical:init-error-buffer (&optional err-buffer)
|
||
"Prepare ERR-BUFFER for iCalendar errors.
|
||
ERR-BUFFER defaults to the buffer returned by `icalendar-error-buffer'.
|
||
Erases ERR-BUFFER and places it in `icalendar-errors-mode'."
|
||
(with-current-buffer (or err-buffer (ical:error-buffer))
|
||
(unless ical:inhibit-error-erasure
|
||
(let ((inhibit-read-only t))
|
||
(erase-buffer)))
|
||
(if (not (eq major-mode 'icalendar-errors-mode))
|
||
(icalendar-errors-mode))))
|
||
|
||
(defun ical:errors-p (&optional err-buffer)
|
||
"Return non-nil if iCalendar errors have been reported in ERR-BUFFER.
|
||
ERR-BUFFER defaults to the buffer returned by `icalendar-error-buffer'."
|
||
(with-current-buffer (or err-buffer (ical:error-buffer))
|
||
(not (= (point-min) (point-max)))))
|
||
|
||
(defun ical:warn (msg &rest err-plist)
|
||
"Write a warning to the `icalendar-error-buffer' without signaling an error."
|
||
(plist-put err-plist :message msg)
|
||
(unless (plist-get err-plist :severity)
|
||
(plist-put err-plist :severity 1))
|
||
(ical:handle-generic-error `(ical:warning . ,err-plist)))
|
||
|
||
(defconst ical:error-regexp
|
||
(rx line-start
|
||
(zero-or-one
|
||
(group "("
|
||
(or (group-n 3 "ERROR") (group-n 4 "WARNING") (group-n 5 "INFO"))
|
||
")"))
|
||
(group-n 1 (zero-or-one " *UNFOLDED:") (zero-or-more (not ":"))) ":"
|
||
(zero-or-one (group-n 2 (one-or-more digit)))
|
||
":")
|
||
"Regexp to match iCalendar errors.
|
||
|
||
Group 1 contains the buffer name where the error originated.
|
||
Group 2 contains the buffer position.
|
||
Groups 3-5 match the severity:
|
||
3 matches ERROR
|
||
4 matches WARNING
|
||
5 matches INFO")
|
||
|
||
(cl-defun ical:format-error (&rest error-plist
|
||
&key (message "Unknown error")
|
||
severity
|
||
buffer
|
||
position
|
||
&allow-other-keys)
|
||
"Format iCalendar error data to a string.
|
||
|
||
MESSAGE should be a string; it defaults to \"Unknown error\".
|
||
BUFFER should be a buffer; POSITION should be a position in BUFFER.
|
||
SEVERITY can be 0 for debug information, or 1 for a warning; otherwise
|
||
a genuine error is reported.
|
||
|
||
The returned error message looks like
|
||
|
||
(LEVEL)BUFFER:POSITION: MESSAGE
|
||
DEBUG-INFO...
|
||
|
||
where LEVEL is derived from SEVERITY. DEBUG-INFO contains any additional
|
||
data in ERROR-PLIST, if `icalendar-debug-level' is
|
||
0. `icalendar-error-regexp' matches the fields in such messages."
|
||
(let ((name (copy-sequence (buffer-name buffer)))
|
||
(pos (if (integer-or-marker-p position)
|
||
(format "%d" position)
|
||
""))
|
||
(level (cond ((eq severity 0) "INFO")
|
||
((eq severity 1) "WARNING")
|
||
(t "ERROR")))
|
||
(debug-info (if (not (= 0 icalendar-debug-level))
|
||
""
|
||
(mapconcat ;; (:key val...) => "Key: val\n..."
|
||
(lambda (val)
|
||
(if (keywordp val)
|
||
(capitalize (substring (symbol-name val) 1))
|
||
(format ": %s\n" val)))
|
||
error-plist))))
|
||
;; Make sure buffer name doesn't take too much space:
|
||
(when (< 8 (length name))
|
||
(if (equal " *UNFOLDED:" (substring name 0 11))
|
||
(put-text-property 0 11 'display "..." name)
|
||
(put-text-property 9 (length name) 'display "..." name)))
|
||
(format "(%s)%s:%s: %s\n%s" level name pos message debug-info)))
|
||
|
||
(defun ical:handle-generic-error (err-data &optional err-buffer)
|
||
"Log error data to ERR-BUFFER (default: the iCalendar error buffer).
|
||
ERR-DATA should be a list (ERROR-SYMBOL . SIGNAL-DATA) where
|
||
SIGNAL-DATA is a plist of error data."
|
||
(let* ((signal-data (cdr err-data))
|
||
(err-plist (when (plistp signal-data) signal-data))
|
||
(err-symbol (car err-data))
|
||
(severity (or (plist-get err-plist :severity) 2))
|
||
(buf (current-buffer)))
|
||
(when (<= ical:debug-level severity)
|
||
(with-current-buffer (or err-buffer (ical:error-buffer))
|
||
(goto-char (point-max))
|
||
(let ((inhibit-read-only t))
|
||
(unless (bolp) (insert "\n"))
|
||
(insert (apply #'ical:format-error
|
||
(or err-plist
|
||
(list :buffer buf
|
||
:message
|
||
(format "Unhandled %s error: %s"
|
||
err-symbol signal-data))))))))))
|
||
|
||
(defmacro ical:condition-case (var bodyform &rest handlers)
|
||
"Like `condition-case', but with default handler for unhandled iCalendar errors.
|
||
If none of HANDLERS handles an error, it will be handled by
|
||
`icalendar-handle-generic-error'."
|
||
`(condition-case ,var
|
||
,bodyform
|
||
,@handlers
|
||
(ical:error (ical:handle-generic-error ,var))))
|
||
|
||
;;; Mode based on compilation-mode for navigating error buffer:
|
||
(defun ical:-buffer-from-error ()
|
||
(when-let* ((name (match-string 1)))
|
||
(or (get-buffer name)
|
||
(find-buffer-visiting name))))
|
||
|
||
(defun ical:-filename-from-error ()
|
||
(when-let* ((buf (ical:-buffer-from-error)))
|
||
(buffer-file-name buf)))
|
||
|
||
(defun ical:-lineno-from-error ()
|
||
(when-let* ((buf (ical:-buffer-from-error))
|
||
(posstr (match-string 2))
|
||
(pos (string-to-number posstr)))
|
||
(with-current-buffer buf
|
||
(line-number-at-pos pos))))
|
||
|
||
(defconst ical:error-regexp-alist
|
||
(list (list icalendar-error-regexp
|
||
#'ical:-filename-from-error
|
||
#'ical:-lineno-from-error
|
||
nil
|
||
nil
|
||
nil
|
||
'(2 compilation-line-face)
|
||
'(3 compilation-error-face)
|
||
'(4 compilation-warning-face)
|
||
'(5 compilation-info-face)))
|
||
"Specifies how errors are parsed in `icalendar-errors-mode';
|
||
see `compilation-error-regexp-alist'.")
|
||
|
||
(define-compilation-mode ical:errors-mode "iCalendar Errors"
|
||
"Mode for listing and visiting errors when processing iCalendar data."
|
||
(setq-local compilation-error-regexp-alist ical:error-regexp-alist))
|
||
|
||
;; ======================================================================
|
||
;; UIDs
|
||
;; ======================================================================
|
||
(defvar ical:-uid-count 0
|
||
"Internal counter for creating unique ids.")
|
||
|
||
(defun ical:make-uid (&optional contents _)
|
||
"Construct a unique ID from `icalendar-uid-format'.
|
||
|
||
CONTENTS can be any object which represents the contents of the
|
||
iCalendar component for which the UID is generated. If CONTENTS is a
|
||
string with the text property \\='uid, that property's value will be
|
||
used as the returned UID.
|
||
|
||
Otherwise, CONTENTS will be used to create the hash substituted for
|
||
\\='%h' in `icalendar-uid-format'. If CONTENTS is not given, the hash
|
||
will be based on an internal counter, the system name, and the current
|
||
time in nanoseconds.
|
||
|
||
The second optional argument is for backward compatibility and is ignored."
|
||
(cl-incf icalendar--uid-count)
|
||
(let* ((uid icalendar-uid-format)
|
||
(timestamp (format-time-string "%s%N"))
|
||
(tohash (or contents
|
||
(format "%d%s%s" ical:-uid-count (system-name) timestamp))))
|
||
(if (and (stringp contents) (get-text-property 0 'uid contents))
|
||
;; "Allow other apps (such as org-mode) to create its own uid"
|
||
;; FIXME: is this necessary? If caller already has a UID, why
|
||
;; call this function at all?
|
||
(setq uid (get-text-property 0 'uid contents))
|
||
(progn
|
||
(setq uid (replace-regexp-in-string
|
||
"%c" (format "%d" icalendar--uid-count) uid t t))
|
||
(setq uid (replace-regexp-in-string
|
||
"%t" timestamp uid t t))
|
||
(setq uid (replace-regexp-in-string
|
||
"%h" (format "%d" (abs (sxhash tohash))) uid t t))
|
||
(setq uid (replace-regexp-in-string
|
||
"%u" (or user-login-name "UNKNOWN_USER") uid t t))
|
||
;; `%s' no longer used, but allowed for backward compatibility:
|
||
(setq uid (replace-regexp-in-string "%s" "" uid t t))))
|
||
uid))
|
||
|
||
|
||
;; Essentially everything beyond this point is obsoleted by the new
|
||
;; implementation in diary-icalendar.el. Since the functions below call
|
||
;; each other and they still need to live in this file for now (see
|
||
;; Bug#74994), prevent byte compiler warnings when compiling this file:
|
||
(with-suppressed-warnings
|
||
((obsolete 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
|
||
icalendar-recurring-start-year
|
||
icalendar-export-hidden-diary-entries
|
||
icalendar-export-sexp-enumeration-days
|
||
icalendar-export-sexp-enumerate-all
|
||
icalendar-export-alarms
|
||
icalendar-debug nil
|
||
icalendar--weekday-array
|
||
icalendar--dmsg
|
||
icalendar--get-unfolded-buffer
|
||
icalendar--clean-up-line-endings
|
||
icalendar--rris
|
||
icalendar--read-element
|
||
icalendar--get-event-property
|
||
icalendar--get-event-property-attributes
|
||
icalendar--get-event-properties
|
||
icalendar--get-children
|
||
icalendar--all-events
|
||
icalendar--split-value
|
||
icalendar--convert-tz-offset
|
||
icalendar--parse-vtimezone
|
||
icalendar--get-most-recent-observance
|
||
icalendar--convert-all-timezones
|
||
icalendar--find-time-zone
|
||
icalendar--decode-isodatetime
|
||
icalendar--decode-isoduration
|
||
icalendar--add-decoded-times
|
||
icalendar--datetime-to-american-date
|
||
icalendar--datetime-to-european-date
|
||
icalendar--datetime-to-iso-date
|
||
icalendar--datetime-to-diary-date
|
||
icalendar--datetime-to-colontime
|
||
icalendar--get-month-number
|
||
icalendar--get-weekday-number
|
||
icalendar--get-weekday-numbers
|
||
icalendar--get-weekday-abbrev
|
||
icalendar--date-to-isodate
|
||
icalendar--datestring-to-isodate
|
||
icalendar--diarytime-to-isotime
|
||
icalendar--convert-string-for-export
|
||
icalendar--convert-string-for-import
|
||
icalendar-export-file
|
||
icalendar-export-region
|
||
icalendar--create-uid
|
||
icalendar--convert-to-ical
|
||
icalendar--parse-summary-and-rest
|
||
icalendar--create-ical-alarm
|
||
icalendar--do-create-ical-alarm
|
||
icalendar--convert-ordinary-to-ical
|
||
icalendar-first-weekday-of-year
|
||
icalendar--convert-weekly-to-ical
|
||
icalendar--convert-yearly-to-ical
|
||
icalendar--convert-sexp-to-ical
|
||
icalendar--convert-block-to-ical
|
||
icalendar--convert-float-to-ical
|
||
icalendar--convert-date-to-ical
|
||
icalendar--convert-cyclic-to-ical
|
||
icalendar--convert-anniversary-to-ical
|
||
icalendar-import-file
|
||
icalendar-import-buffer
|
||
icalendar--format-ical-event
|
||
icalendar--convert-ical-to-diary
|
||
icalendar--convert-recurring-to-diary
|
||
icalendar--convert-non-recurring-all-day-to-diary
|
||
icalendar--convert-non-recurring-not-all-day-to-diary
|
||
icalendar--add-diary-entry
|
||
icalendar-import-format-sample
|
||
icalendar-version))
|
||
|
||
;; ======================================================================
|
||
;; Core functionality
|
||
;; Functions for parsing icalendars, importing and so on
|
||
;; ======================================================================
|
||
|
||
(defun icalendar--get-unfolded-buffer (folded-ical-buffer)
|
||
"Return a new buffer containing the unfolded contents of a buffer.
|
||
Folding is the iCalendar way of wrapping long lines. In the
|
||
created buffer all occurrences of CR LF BLANK are replaced by the
|
||
empty string. Argument FOLDED-ICAL-BUFFER is the folded input
|
||
buffer."
|
||
(declare (obsolete icalendar-unfolded-buffer-from-buffer "31.1"))
|
||
(let ((unfolded-buffer (get-buffer-create " *icalendar-work*")))
|
||
(save-current-buffer
|
||
(set-buffer unfolded-buffer)
|
||
(erase-buffer)
|
||
(insert-buffer-substring folded-ical-buffer)
|
||
(icalendar--clean-up-line-endings)
|
||
(goto-char (point-min))
|
||
(while (re-search-forward "\r?\n[ \t]" nil t)
|
||
(replace-match "" nil nil)))
|
||
unfolded-buffer))
|
||
|
||
(defun icalendar--clean-up-line-endings ()
|
||
"Replace DOS- and MAC-like line endings with unix line endings.
|
||
All occurrences of (CR LF) and (LF CF) are replaced with LF in
|
||
the current buffer. This is necessary in buffers which contain a
|
||
mix of different line endings."
|
||
(declare (obsolete nil "31.1"))
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
(while (re-search-forward "\r\n\\|\n\r" nil t)
|
||
(replace-match "\n" nil nil))))
|
||
|
||
(define-obsolete-function-alias 'icalendar--rris
|
||
#'replace-regexp-in-string "27.1")
|
||
|
||
(defun icalendar--read-element (invalue inparams)
|
||
"Recursively read the next iCalendar element in the current buffer.
|
||
INVALUE gives the current iCalendar element we are reading.
|
||
INPARAMS gives the current parameters.....
|
||
This function calls itself recursively for each nested calendar element
|
||
it finds. The current buffer should be an unfolded buffer as returned
|
||
from `icalendar--get-unfolded-buffer'."
|
||
(declare (obsolete "use `icalendar-parse' or one of `icalendar-parse-component',
|
||
`icalendar-parse-property', `icalendar-parse-params' instead." "31.1"))
|
||
(let (element children line name params param param-name param-value
|
||
value
|
||
(continue t))
|
||
(setq children '())
|
||
(while (and continue
|
||
(re-search-forward "^\\([A-Za-z0-9-]+\\)[;:]" nil t))
|
||
(setq name (intern (match-string 1)))
|
||
(backward-char 1)
|
||
(setq params '())
|
||
(setq line '())
|
||
(while (looking-at ";")
|
||
(re-search-forward ";\\([A-Za-z0-9-]+\\)=" nil nil)
|
||
(setq param-name (intern (match-string 1)))
|
||
(re-search-forward "\\(\\([^;,:\"]+\\)\\|\"\\([^\"]+\\)\"\\)[;:]"
|
||
nil t)
|
||
(backward-char 1)
|
||
(setq param-value (or (match-string 2) (match-string 3)))
|
||
(setq param (list param-name param-value))
|
||
(while (looking-at ",")
|
||
(re-search-forward "\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\)"
|
||
nil t)
|
||
(if (match-string 2)
|
||
(setq param-value (match-string 2))
|
||
(setq param-value (match-string 3)))
|
||
(setq param (append param param-value)))
|
||
(setq params (append params param)))
|
||
(unless (looking-at ":")
|
||
(error "Oops"))
|
||
(forward-char 1)
|
||
(let ((start (point)))
|
||
(end-of-line)
|
||
(setq value (buffer-substring start (point))))
|
||
(setq line (list name params value))
|
||
(cond ((eq name 'BEGIN)
|
||
(setq children
|
||
(append children
|
||
(list (icalendar--read-element (intern value)
|
||
params)))))
|
||
((eq name 'END)
|
||
(setq continue nil))
|
||
(t
|
||
(setq element (append element (list line))))))
|
||
(if invalue
|
||
(list invalue inparams element children)
|
||
children)))
|
||
|
||
;; ======================================================================
|
||
;; helper functions for examining events
|
||
;; ======================================================================
|
||
|
||
;;(defsubst icalendar--get-all-event-properties (event)
|
||
;; "Return the list of properties in this EVENT."
|
||
;; (car (cddr event)))
|
||
|
||
(defun icalendar--get-event-property (event prop)
|
||
"For the given EVENT return the value of the first occurrence of PROP."
|
||
(declare (obsolete icalendar-with-component "31.1"))
|
||
(catch 'found
|
||
(let ((props (car (cddr event))) pp)
|
||
(while props
|
||
(setq pp (car props))
|
||
(if (eq (car pp) prop)
|
||
(throw 'found (car (cddr pp))))
|
||
(setq props (cdr props))))
|
||
nil))
|
||
|
||
(defun icalendar--get-event-property-attributes (event prop)
|
||
"For the given EVENT return attributes of the first occurrence of PROP."
|
||
(declare (obsolete icalendar-with-component "31.1"))
|
||
(catch 'found
|
||
(let ((props (car (cddr event))) pp)
|
||
(while props
|
||
(setq pp (car props))
|
||
(if (eq (car pp) prop)
|
||
(throw 'found (cadr pp)))
|
||
(setq props (cdr props))))
|
||
nil))
|
||
|
||
(defun icalendar--get-event-properties (event prop)
|
||
"For the given EVENT return a list of all values of the property PROP."
|
||
(declare (obsolete icalendar-with-component "31.1"))
|
||
(let ((props (car (cddr event))) pp result)
|
||
(while props
|
||
(setq pp (car props))
|
||
(if (eq (car pp) prop)
|
||
(setq result (append (split-string (car (cddr pp)) ",") result)))
|
||
(setq props (cdr props)))
|
||
result))
|
||
|
||
;; (defun icalendar--set-event-property (event prop new-value)
|
||
;; "For the given EVENT set the property PROP to the value NEW-VALUE."
|
||
;; (catch 'found
|
||
;; (let ((props (car (cddr event))) pp)
|
||
;; (while props
|
||
;; (setq pp (car props))
|
||
;; (when (eq (car pp) prop)
|
||
;; (setcdr (cdr pp) new-value)
|
||
;; (throw 'found (car (cddr pp))))
|
||
;; (setq props (cdr props)))
|
||
;; (setq props (car (cddr event)))
|
||
;; (setcar (cddr event)
|
||
;; (append props (list (list prop nil new-value)))))))
|
||
|
||
(defun icalendar--get-children (node name)
|
||
"Return all children of the given NODE which have a name NAME.
|
||
For instance the VCALENDAR node can have VEVENT children as well as VTODO
|
||
children."
|
||
(declare (obsolete icalendar-ast-node-children "31.1"))
|
||
(let ((result nil)
|
||
(children (cadr (cddr node))))
|
||
(when (eq (car node) name)
|
||
(setq result node))
|
||
;;(message "%s" node)
|
||
(when children
|
||
(let ((subresult
|
||
(delq nil
|
||
(mapcar (lambda (n)
|
||
(icalendar--get-children n name))
|
||
children))))
|
||
(if subresult
|
||
(if result
|
||
(setq result (append result subresult))
|
||
(setq result subresult)))))
|
||
result))
|
||
|
||
;; private
|
||
(defun icalendar--all-events (icalendar)
|
||
"Return the list of all existing events in the given ICALENDAR."
|
||
(declare (obsolete icalendar-with-component "31.1"))
|
||
(let ((result '()))
|
||
(mapc (lambda (elt)
|
||
(setq result (append (icalendar--get-children elt 'VEVENT)
|
||
result)))
|
||
(nreverse icalendar))
|
||
result))
|
||
|
||
(defun icalendar--split-value (value-string)
|
||
"Split VALUE-STRING at `;='."
|
||
(declare (obsolete nil "31.1"))
|
||
(let ((result '())
|
||
param-name param-value)
|
||
(when value-string
|
||
(save-current-buffer
|
||
(set-buffer (get-buffer-create " *icalendar-work*"))
|
||
(set-buffer-modified-p nil)
|
||
(erase-buffer)
|
||
(insert value-string)
|
||
(goto-char (point-min))
|
||
(while
|
||
(re-search-forward
|
||
"\\([A-Za-z0-9-]+\\)=\\(\\([^;:]+\\)\\|\"\\([^\"]+\\)\"\\);?"
|
||
nil t)
|
||
(setq param-name (intern (match-string 1)))
|
||
(setq param-value (match-string 2))
|
||
(setq result
|
||
(append result (list (list param-name param-value)))))))
|
||
result))
|
||
|
||
(defun icalendar--convert-tz-offset (alist dst-p)
|
||
"Return a cons of two strings representing a timezone start.
|
||
ALIST is an alist entry from a VTIMEZONE, like STANDARD.
|
||
DST-P is non-nil if this is for daylight savings time.
|
||
The strings are suitable for assembling into a TZ variable."
|
||
(declare (obsolete nil "31.1"))
|
||
(let* ((offsetto (car (cddr (assq 'TZOFFSETTO alist))))
|
||
(offsetfrom (car (cddr (assq 'TZOFFSETFROM alist))))
|
||
(rrule-value (car (cddr (assq 'RRULE alist))))
|
||
(rdate-p (and (assq 'RDATE alist) t))
|
||
(dtstart (car (cddr (assq 'DTSTART alist))))
|
||
(no-dst (or rdate-p (equal offsetto offsetfrom))))
|
||
;; FIXME: the presence of an RDATE is assumed to denote the first day of the year
|
||
(when (and offsetto dtstart (or rrule-value no-dst))
|
||
(let* ((rrule (icalendar--split-value rrule-value))
|
||
(freq (cadr (assq 'FREQ rrule)))
|
||
(bymonth (cadr (assq 'BYMONTH rrule)))
|
||
(byday (cadr (assq 'BYDAY rrule))))
|
||
;; FIXME: we don't correctly handle WKST here.
|
||
(if (or no-dst (and (string= freq "YEARLY") bymonth))
|
||
(cons
|
||
(concat
|
||
;; Fake a name.
|
||
(if dst-p "DST" "STD")
|
||
;; For TZ, OFFSET is added to the local time. So,
|
||
;; invert the values.
|
||
(if (eq (aref offsetto 0) ?-) "+" "-")
|
||
(substring offsetto 1 3)
|
||
":"
|
||
(substring offsetto 3 5))
|
||
;; The start time.
|
||
(let* ((day (if no-dst
|
||
1
|
||
(icalendar--get-weekday-number (substring byday -2))))
|
||
(week (if no-dst
|
||
"1"
|
||
(if (eq day -1)
|
||
byday
|
||
(substring byday 0 -2)))))
|
||
;; "Translate" the iCalendar way to specify the last
|
||
;; (sun|mon|...)day in month to the tzset way.
|
||
(if (string= week "-1") ; last day as iCalendar calls it
|
||
(setq week "5")) ; last day as tzset calls it
|
||
(when no-dst (setq bymonth "1"))
|
||
(concat "M" bymonth "." week "." (if (eq day -1) "0"
|
||
(int-to-string day))
|
||
;; Start time.
|
||
"/"
|
||
(substring dtstart -6 -4)
|
||
":"
|
||
(substring dtstart -4 -2)
|
||
":"
|
||
(substring dtstart -2)))))))))
|
||
|
||
(defun icalendar--parse-vtimezone (alist)
|
||
"Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING).
|
||
Consider only the most recent date specification.
|
||
Return nil if timezone cannot be parsed."
|
||
(declare (obsolete nil "31.1"))
|
||
(let* ((tz-id (icalendar--convert-string-for-import
|
||
(icalendar--get-event-property alist 'TZID)))
|
||
(daylight (cadr (cdar (icalendar--get-most-recent-observance alist 'DAYLIGHT))))
|
||
(day (and daylight (icalendar--convert-tz-offset daylight t)))
|
||
(standard (cadr (cdar (icalendar--get-most-recent-observance alist 'STANDARD))))
|
||
(std (and standard (icalendar--convert-tz-offset standard nil))))
|
||
(if (and tz-id std)
|
||
(cons tz-id
|
||
(if day
|
||
(concat (car std) (car day)
|
||
"," (cdr day) "," (cdr std))
|
||
(car std))))))
|
||
|
||
(defun icalendar--get-most-recent-observance (alist sub-comp)
|
||
"Return the latest observance for SUB-COMP DAYLIGHT or STANDARD.
|
||
ALIST is a VTIMEZONE potentially containing historical records."
|
||
;FIXME?: "most recent" should be relative to a given date
|
||
(declare (obsolete icalendar-recur-tz-observance-on "31.1"))
|
||
(let ((components (icalendar--get-children alist sub-comp)))
|
||
(list
|
||
(car
|
||
(sort components
|
||
(lambda (a b)
|
||
(let* ((get-recent (lambda (n)
|
||
(car
|
||
(sort
|
||
(delq nil
|
||
(mapcar (lambda (p)
|
||
(and (memq (car p) '(DTSTART RDATE))
|
||
(car (cddr p))))
|
||
n))
|
||
#'string-greaterp))))
|
||
(a-recent (funcall get-recent (car (cddr a))))
|
||
(b-recent (funcall get-recent (car (cddr b)))))
|
||
(string-greaterp a-recent b-recent))))))))
|
||
|
||
(defun icalendar--convert-all-timezones (icalendar)
|
||
"Convert all timezones in the ICALENDAR into an alist.
|
||
Each element of the alist is a cons (ID . TZ-STRING),
|
||
like `icalendar--parse-vtimezone'."
|
||
(declare (obsolete nil "31.1"))
|
||
(let (result)
|
||
(dolist (zone (icalendar--get-children (car icalendar) 'VTIMEZONE))
|
||
(setq zone (icalendar--parse-vtimezone zone))
|
||
(if zone
|
||
(setq result (cons zone result))))
|
||
result))
|
||
|
||
(defun icalendar--find-time-zone (prop-list zone-map)
|
||
"Return a timezone string for the time zone in PROP-LIST, or nil if none.
|
||
ZONE-MAP is a timezone alist as returned by `icalendar--convert-all-timezones'."
|
||
(declare (obsolete nil "31.1"))
|
||
(let ((id (plist-get prop-list 'TZID)))
|
||
(if id
|
||
(cdr (assoc id zone-map)))))
|
||
|
||
(defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift
|
||
source-zone
|
||
result-zone)
|
||
"Return ISODATETIMESTRING in format like `decode-time'.
|
||
Converts from ISO-8601 to Emacs representation. If
|
||
ISODATETIMESTRING specifies UTC time (trailing letter Z) the
|
||
decoded time is given in the local time zone! If optional
|
||
parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT
|
||
days.
|
||
SOURCE-ZONE, if provided, is the timezone for decoding the time,
|
||
in any format understood by `encode-time'.
|
||
RESULT-ZONE, if provided, is the timezone for encoding the result
|
||
in any format understood by `decode-time'.
|
||
FIXME: multiple comma-separated values should be allowed!"
|
||
(declare (obsolete icalendar-read-date-time "31.1"))
|
||
(icalendar--dmsg isodatetimestring)
|
||
(if isodatetimestring
|
||
;; day/month/year must be present
|
||
(let ((year (read (substring isodatetimestring 0 4)))
|
||
(month (read (substring isodatetimestring 4 6)))
|
||
(day (read (substring isodatetimestring 6 8)))
|
||
(hour 0)
|
||
(minute 0)
|
||
(second 0))
|
||
(when (> (length isodatetimestring) 12)
|
||
;; hour/minute present
|
||
(setq hour (read (substring isodatetimestring 9 11)))
|
||
(setq minute (read (substring isodatetimestring 11 13))))
|
||
(when (> (length isodatetimestring) 14)
|
||
;; seconds present
|
||
(setq second (read (substring isodatetimestring 13 15))))
|
||
;; FIXME: Support subseconds.
|
||
(when (> (length isodatetimestring) 15)
|
||
(pcase (aref isodatetimestring 15)
|
||
(?Z
|
||
(setq source-zone t))
|
||
((or ?- ?+)
|
||
(setq source-zone
|
||
(concat "UTC" (substring isodatetimestring 15))))))
|
||
;; shift if necessary
|
||
(if day-shift
|
||
(let ((mdy (calendar-gregorian-from-absolute
|
||
(+ (calendar-absolute-from-gregorian
|
||
(list month day year))
|
||
day-shift))))
|
||
(setq month (nth 0 mdy))
|
||
(setq day (nth 1 mdy))
|
||
(setq year (nth 2 mdy))))
|
||
;; create the decoded date-time
|
||
;; FIXME!?!
|
||
(let ((decoded-time (list second minute hour day month year
|
||
nil -1 source-zone)))
|
||
(condition-case nil
|
||
(decode-time (encode-time decoded-time) result-zone)
|
||
(error
|
||
(message "Cannot decode \"%s\"" isodatetimestring)
|
||
;; Hope for the best....
|
||
decoded-time))))
|
||
;; isodatetimestring == nil
|
||
nil))
|
||
|
||
(defun icalendar--decode-isoduration (isodurationstring
|
||
&optional duration-correction)
|
||
"Convert ISODURATIONSTRING into format provided by `decode-time'.
|
||
Converts from ISO-8601 to Emacs representation. If ISODURATIONSTRING
|
||
specifies UTC time (trailing letter Z) the decoded time is given in
|
||
the local time zone!
|
||
|
||
Optional argument DURATION-CORRECTION shortens result by one day.
|
||
|
||
FIXME: TZID-attributes are ignored....!
|
||
FIXME: multiple comma-separated values should be allowed!"
|
||
(declare (obsolete icalendar-read-dur-value "31.1"))
|
||
(if isodurationstring
|
||
(save-match-data
|
||
(string-match
|
||
(concat
|
||
"^P[+-]?\\("
|
||
"\\(\\([0-9]+\\)D\\)" ; days only
|
||
"\\|"
|
||
"\\(\\(\\([0-9]+\\)D\\)?T\\(\\([0-9]+\\)H\\)?" ; opt days
|
||
"\\(\\([0-9]+\\)M\\)?\\(\\([0-9]+\\)S\\)?\\)" ; mand. time
|
||
"\\|"
|
||
"\\(\\([0-9]+\\)W\\)" ; weeks only
|
||
"\\)$") isodurationstring)
|
||
(let ((seconds 0)
|
||
(minutes 0)
|
||
(hours 0)
|
||
(days 0)
|
||
(months 0)
|
||
(years 0))
|
||
(cond
|
||
((match-beginning 2) ;days only
|
||
(setq days (read (substring isodurationstring
|
||
(match-beginning 3)
|
||
(match-end 3))))
|
||
(when duration-correction
|
||
(setq days (1- days))))
|
||
((match-beginning 4) ;days and time
|
||
(if (match-beginning 5)
|
||
(setq days (read (substring isodurationstring
|
||
(match-beginning 6)
|
||
(match-end 6)))))
|
||
(if (match-beginning 7)
|
||
(setq hours (read (substring isodurationstring
|
||
(match-beginning 8)
|
||
(match-end 8)))))
|
||
(if (match-beginning 9)
|
||
(setq minutes (read (substring isodurationstring
|
||
(match-beginning 10)
|
||
(match-end 10)))))
|
||
;; FIXME: Support subseconds.
|
||
(if (match-beginning 11)
|
||
(setq seconds (read (substring isodurationstring
|
||
(match-beginning 12)
|
||
(match-end 12))))))
|
||
((match-beginning 13) ;weeks only
|
||
(setq days (* 7 (read (substring isodurationstring
|
||
(match-beginning 14)
|
||
(match-end 14)))))))
|
||
(list seconds minutes hours days months years)))
|
||
;; isodatetimestring == nil
|
||
nil))
|
||
|
||
(defun icalendar--add-decoded-times (time1 time2)
|
||
"Add TIME1 to TIME2.
|
||
Both times must be given in decoded form. One of these times must be
|
||
valid (year > 1900 or something)."
|
||
(declare (obsolete icalendar-date-time-add "31.1"))
|
||
;; FIXME: does this function exist already? Can we use decoded-time-add?
|
||
(decode-time (encode-time
|
||
;; FIXME: Support subseconds.
|
||
(time-convert (time-add (decoded-time-second time1)
|
||
(decoded-time-second time2))
|
||
'integer)
|
||
(+ (decoded-time-minute time1) (decoded-time-minute time2))
|
||
(+ (decoded-time-hour time1) (decoded-time-hour time2))
|
||
(+ (decoded-time-day time1) (decoded-time-day time2))
|
||
(+ (decoded-time-month time1) (decoded-time-month time2))
|
||
(+ (decoded-time-year time1) (decoded-time-year time2))
|
||
nil
|
||
nil
|
||
;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME?
|
||
)))
|
||
|
||
(defun icalendar--datetime-to-american-date (datetime &optional separator)
|
||
"Convert the decoded DATETIME to American-style format.
|
||
Optional argument SEPARATOR gives the separator between month,
|
||
day, and year. If nil a blank character is used as separator.
|
||
American format: \"month day year\"."
|
||
(declare (obsolete "use `icalendar-date/time-to-date' and
|
||
`diary-icalendar-format-date' instead." "31.1"))
|
||
(if datetime
|
||
(format "%d%s%d%s%d" (nth 4 datetime) ;month
|
||
(or separator " ")
|
||
(nth 3 datetime) ;day
|
||
(or separator " ")
|
||
(nth 5 datetime)) ;year
|
||
;; datetime == nil
|
||
nil))
|
||
|
||
(defun icalendar--datetime-to-european-date (datetime &optional separator)
|
||
"Convert the decoded DATETIME to European format.
|
||
Optional argument SEPARATOR gives the separator between month,
|
||
day, and year. If nil a blank character is used as separator.
|
||
European format: (day month year).
|
||
FIXME"
|
||
(declare (obsolete "use `icalendar-date/time-to-date' and `diary-icalendar-format-date' instead." "31.1"))
|
||
(if datetime
|
||
(format "%d%s%d%s%d" (nth 3 datetime) ;day
|
||
(or separator " ")
|
||
(nth 4 datetime) ;month
|
||
(or separator " ")
|
||
(nth 5 datetime)) ;year
|
||
;; datetime == nil
|
||
nil))
|
||
|
||
(defun icalendar--datetime-to-iso-date (datetime &optional separator)
|
||
"Convert the decoded DATETIME to ISO format.
|
||
Optional argument SEPARATOR gives the separator between month,
|
||
day, and year. If nil a blank character is used as separator.
|
||
ISO format: (year month day)."
|
||
(declare (obsolete "use `icalendar-date/time-to-date' and `diary-icalendar-format-date' instead." "31.1"))
|
||
(if datetime
|
||
(format "%d%s%d%s%d" (nth 5 datetime) ;year
|
||
(or separator " ")
|
||
(nth 4 datetime) ;month
|
||
(or separator " ")
|
||
(nth 3 datetime)) ;day
|
||
;; datetime == nil
|
||
nil))
|
||
|
||
(defun icalendar--datetime-to-diary-date (datetime &optional separator)
|
||
"Convert the decoded DATETIME to diary format.
|
||
Optional argument SEPARATOR gives the separator between month,
|
||
day, and year. If nil a blank character is used as separator.
|
||
Call icalendar--datetime-to-*-date according to the current
|
||
calendar date style."
|
||
(declare (obsolete "use `icalendar-date/time-to-date' and `diary-icalendar-format-date' instead." "31.1"))
|
||
(funcall (intern-soft (format "icalendar--datetime-to-%s-date"
|
||
calendar-date-style))
|
||
datetime separator))
|
||
|
||
(defun icalendar--datetime-to-colontime (datetime)
|
||
"Extract the time part of a decoded DATETIME into 24-hour format.
|
||
Note that this silently ignores seconds."
|
||
(declare (obsolete diary-icalendar-format-time "31.1"))
|
||
(format "%02d:%02d" (nth 2 datetime) (nth 1 datetime)))
|
||
|
||
(defun icalendar--get-month-number (monthname)
|
||
"Return the month number for the given MONTHNAME."
|
||
(declare (obsolete nil "31.1"))
|
||
(catch 'found
|
||
(let ((num 1)
|
||
(m (downcase monthname)))
|
||
(mapc (lambda (month)
|
||
(let ((mm (downcase month)))
|
||
(if (or (string-equal mm m)
|
||
(string-equal (substring mm 0 3) m))
|
||
(throw 'found num))
|
||
(setq num (1+ num))))
|
||
calendar-month-name-array))
|
||
;; Error:
|
||
-1))
|
||
|
||
(defun icalendar--get-weekday-number (abbrevweekday)
|
||
"Return the number for the ABBREVWEEKDAY."
|
||
(declare (obsolete "see `icalendar-weekday-numbers'" "31.1"))
|
||
(if abbrevweekday
|
||
(catch 'found
|
||
(let ((num 0)
|
||
(aw (downcase abbrevweekday)))
|
||
(mapc (lambda (day)
|
||
(let ((d (downcase day)))
|
||
(if (string-equal d aw)
|
||
(throw 'found num))
|
||
(setq num (1+ num))))
|
||
icalendar--weekday-array)))
|
||
;; Error:
|
||
-1))
|
||
|
||
(defun icalendar--get-weekday-numbers (abbrevweekdays)
|
||
"Return the list of numbers for the comma-separated ABBREVWEEKDAYS."
|
||
(declare (obsolete "see `icalendar-weekday-numbers'" "31.1"))
|
||
(when abbrevweekdays
|
||
(let* ((num -1)
|
||
(weekday-alist (mapcar (lambda (day)
|
||
(progn
|
||
(setq num (1+ num))
|
||
(cons (downcase day) num)))
|
||
icalendar--weekday-array)))
|
||
(delq nil
|
||
(mapcar (lambda (abbrevday)
|
||
(cdr (assoc abbrevday weekday-alist)))
|
||
(split-string (downcase abbrevweekdays) ","))))))
|
||
|
||
(defun icalendar--get-weekday-abbrev (weekday)
|
||
"Return the abbreviated WEEKDAY."
|
||
(declare (obsolete "see `icalendar-weekday-numbers'" "31.1"))
|
||
(catch 'found
|
||
(let ((num 0)
|
||
(w (downcase weekday)))
|
||
(mapc (lambda (day)
|
||
(let ((d (downcase day)))
|
||
(if (or (string-equal d w)
|
||
(string-equal (substring d 0 3) w))
|
||
(throw 'found (aref icalendar--weekday-array num)))
|
||
(setq num (1+ num))))
|
||
calendar-day-name-array))
|
||
;; Error:
|
||
nil))
|
||
|
||
(defun icalendar--date-to-isodate (date &optional day-shift)
|
||
"Convert DATE to iso-style date.
|
||
DATE must be a list of the form (month day year).
|
||
If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days."
|
||
(declare (obsolete icalendar-print-date "31.1"))
|
||
(let ((mdy (calendar-gregorian-from-absolute
|
||
(+ (calendar-absolute-from-gregorian date)
|
||
(or day-shift 0)))))
|
||
(format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))))
|
||
|
||
|
||
(defun icalendar--datestring-to-isodate (datestring &optional day-shift year-shift)
|
||
"Convert diary-style DATESTRING to iso-style date.
|
||
If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days
|
||
-- DAY-SHIFT must be either nil or an integer. If YEAR-SHIFT is
|
||
non-nil, the result is shifted by YEAR-SHIFT years -- YEAR-SHIFT
|
||
must be either nil or an integer. This function tries to figure
|
||
the date style from DATESTRING itself. If that is not possible
|
||
it uses the current calendar date style."
|
||
(declare (obsolete "use `diary-icalendar-parse-date-form' and `icalendar-print-date' instead." "31.1"))
|
||
(let ((day -1) month year)
|
||
(save-match-data
|
||
(cond ( ;; iso-style numeric date
|
||
(string-match (concat "\\s-*"
|
||
"\\([0-9]\\{4\\}\\)[ \t/-]\\s-*"
|
||
"0?\\([1-9][0-9]?\\)[ \t/-]\\s-*"
|
||
"0?\\([1-9][0-9]?\\)")
|
||
datestring)
|
||
(setq year (read (substring datestring (match-beginning 1)
|
||
(match-end 1))))
|
||
(setq month (read (substring datestring (match-beginning 2)
|
||
(match-end 2))))
|
||
(setq day (read (substring datestring (match-beginning 3)
|
||
(match-end 3)))))
|
||
( ;; non-iso numeric date -- must rely on configured
|
||
;; calendar style
|
||
(string-match (concat "\\s-*"
|
||
"0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
|
||
"0?\\([1-9][0-9]?\\),?[ \t/]\\s-*"
|
||
"\\([0-9]\\{4\\}\\)")
|
||
datestring)
|
||
(setq day (read (substring datestring (match-beginning 1)
|
||
(match-end 1))))
|
||
(setq month (read (substring datestring (match-beginning 2)
|
||
(match-end 2))))
|
||
(setq year (read (substring datestring (match-beginning 3)
|
||
(match-end 3))))
|
||
(if (eq calendar-date-style 'american)
|
||
(let ((x month))
|
||
(setq month day)
|
||
(setq day x))))
|
||
( ;; date contains month names -- iso style
|
||
(string-match (concat "\\s-*"
|
||
"\\([0-9]\\{4\\}\\)[ \t/]\\s-*"
|
||
"\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
|
||
"0?\\([123]?[0-9]\\)")
|
||
datestring)
|
||
(setq year (read (substring datestring (match-beginning 1)
|
||
(match-end 1))))
|
||
(setq month (icalendar--get-month-number
|
||
(substring datestring (match-beginning 2)
|
||
(match-end 2))))
|
||
(setq day (read (substring datestring (match-beginning 3)
|
||
(match-end 3)))))
|
||
( ;; date contains month names -- european style
|
||
(string-match (concat "\\s-*"
|
||
"0?\\([123]?[0-9]\\)[ \t/]\\s-*"
|
||
"\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
|
||
"\\([0-9]\\{4\\}\\)")
|
||
datestring)
|
||
(setq day (read (substring datestring (match-beginning 1)
|
||
(match-end 1))))
|
||
(setq month (icalendar--get-month-number
|
||
(substring datestring (match-beginning 2)
|
||
(match-end 2))))
|
||
(setq year (read (substring datestring (match-beginning 3)
|
||
(match-end 3)))))
|
||
( ;; date contains month names -- american style
|
||
(string-match (concat "\\s-*"
|
||
"\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
|
||
"0?\\([123]?[0-9]\\),?[ \t/]\\s-*"
|
||
"\\([0-9]\\{4\\}\\)")
|
||
datestring)
|
||
(setq day (read (substring datestring (match-beginning 2)
|
||
(match-end 2))))
|
||
(setq month (icalendar--get-month-number
|
||
(substring datestring (match-beginning 1)
|
||
(match-end 1))))
|
||
(setq year (read (substring datestring (match-beginning 3)
|
||
(match-end 3)))))
|
||
(t
|
||
nil)))
|
||
(when year-shift
|
||
(setq year (+ year year-shift)))
|
||
|
||
(if (> day 0)
|
||
(let ((mdy (calendar-gregorian-from-absolute
|
||
(+ (calendar-absolute-from-gregorian (list month day
|
||
year))
|
||
(or day-shift 0)))))
|
||
(icalendar--dmsg (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))
|
||
(format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))
|
||
nil)))
|
||
|
||
(defun icalendar--diarytime-to-isotime (timestring ampmstring)
|
||
"Convert a time like 9:30pm to an iso-conform string like T213000.
|
||
In this example the TIMESTRING would be \"9:30\" and the
|
||
AMPMSTRING would be \"pm\". The minutes may be missing as long
|
||
as the colon is missing as well, i.e. \"9\" is allowed as
|
||
TIMESTRING and has the same result as \"9:00\"."
|
||
(declare (obsolete "use `diary-icalendar-parse-time' and `icalendar-print-date-time' instead." "31.1"))
|
||
(if timestring
|
||
(let* ((parts (save-match-data (split-string timestring ":")))
|
||
(h (car parts))
|
||
(m (if (cdr parts) (cadr parts)
|
||
(if (> (length h) 2) "" "00")))
|
||
(starttimenum (read (concat h m))))
|
||
;; take care of am/pm style
|
||
;; Be sure *not* to convert 12:00pm - 12:59pm to 2400-2459
|
||
(if (and ampmstring (string= "pm" ampmstring) (< starttimenum 1200))
|
||
(setq starttimenum (+ starttimenum 1200)))
|
||
;; Similar effect with 12:00am - 12:59am (need to convert to 0000-0059)
|
||
(if (and ampmstring (string= "am" ampmstring) (>= starttimenum 1200))
|
||
(setq starttimenum (- starttimenum 1200)))
|
||
(format "T%04d00" starttimenum))
|
||
nil))
|
||
|
||
(defun icalendar--convert-string-for-export (string)
|
||
"Escape comma and other critical characters in STRING."
|
||
(string-replace "," "\\," string))
|
||
|
||
(defun icalendar--convert-string-for-import (string)
|
||
"Remove escape chars for comma, semicolon etc. from STRING."
|
||
(string-replace
|
||
"\\n" "\n " (string-replace
|
||
"\\\"" "\"" (string-replace
|
||
"\\;" ";" (string-replace
|
||
"\\," "," string)))))
|
||
|
||
;; ======================================================================
|
||
;; Export -- convert emacs-diary to iCalendar
|
||
;; ======================================================================
|
||
|
||
;;;###autoload
|
||
(defun icalendar-export-file (diary-filename ical-filename)
|
||
"Export diary file to iCalendar format.
|
||
All diary entries in the file DIARY-FILENAME are converted to iCalendar
|
||
format. The result is appended to the file ICAL-FILENAME."
|
||
(declare (obsolete diary-icalendar-export-file "31.1"))
|
||
(interactive "FExport diary data from file: \n\
|
||
Finto iCalendar file: ")
|
||
(save-current-buffer
|
||
(set-buffer (find-file diary-filename))
|
||
(icalendar-export-region (point-min) (point-max) ical-filename)))
|
||
|
||
(defun icalendar--create-uid (entry-full contents)
|
||
"Construct a unique iCalendar UID for a diary entry.
|
||
ENTRY-FULL is the full diary entry string. CONTENTS is the
|
||
current iCalendar object, as a string. Increase
|
||
`icalendar--uid-count'. Returns the UID string."
|
||
(declare (obsolete icalendar-make-uid "31.1"))
|
||
(let ((uid icalendar-uid-format))
|
||
(if
|
||
;; Allow other apps (such as org-mode) to create its own uid
|
||
(get-text-property 0 'uid entry-full)
|
||
(setq uid (get-text-property 0 'uid entry-full))
|
||
(setq uid (replace-regexp-in-string
|
||
"%c"
|
||
(format "%d" icalendar--uid-count)
|
||
uid t t))
|
||
(setq icalendar--uid-count (1+ icalendar--uid-count))
|
||
(setq uid (replace-regexp-in-string
|
||
"%t"
|
||
(format-time-string "%s%N")
|
||
uid t t))
|
||
(setq uid (replace-regexp-in-string
|
||
"%h"
|
||
(format "%d" (abs (sxhash entry-full))) uid t t))
|
||
(setq uid (replace-regexp-in-string
|
||
"%u" (or user-login-name "UNKNOWN_USER") uid t t))
|
||
(let ((dtstart (if (string-match "^DTSTART[^:]*:\\([0-9]*\\)" contents)
|
||
(substring contents (match-beginning 1) (match-end 1))
|
||
"DTSTART")))
|
||
(setq uid (replace-regexp-in-string "%s" dtstart uid t t))))
|
||
;; Return the UID string
|
||
uid))
|
||
|
||
;;;###autoload
|
||
(defun icalendar-export-region (min max ical-filename)
|
||
"Export region in diary file to iCalendar format.
|
||
All diary entries in the region from MIN to MAX in the current buffer are
|
||
converted to iCalendar format. The result is appended to the file
|
||
ICAL-FILENAME.
|
||
This function attempts to return t if something goes wrong. In this
|
||
case an error string which describes all the errors and problems is
|
||
written into the buffer `*icalendar-errors*'."
|
||
(declare (obsolete diary-icalendar-export-region "31.1"))
|
||
(interactive "r
|
||
FExport diary data into iCalendar file: ")
|
||
(let ((result "")
|
||
(entry-main "")
|
||
(entry-rest "")
|
||
(entry-full "")
|
||
(header "")
|
||
(contents)
|
||
(alarm)
|
||
(found-error nil)
|
||
(nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol)
|
||
"?"))
|
||
(other-elements nil)
|
||
(cns-cons-or-list nil))
|
||
;; prepare buffer with error messages
|
||
(save-current-buffer
|
||
(set-buffer (get-buffer-create "*icalendar-errors*"))
|
||
(erase-buffer))
|
||
|
||
;; here we go
|
||
(save-excursion
|
||
(goto-char min)
|
||
(while (re-search-forward
|
||
;; possibly ignore hidden entries beginning with "&"
|
||
(if icalendar-export-hidden-diary-entries
|
||
"^\\([^ \t\n#].+\\)\\(\\(\n[ \t].*\\)*\\)"
|
||
"^\\([^ \t\n&#].+\\)\\(\\(\n[ \t].*\\)*\\)")
|
||
max t)
|
||
(setq entry-main (match-string 1))
|
||
(if (match-beginning 2)
|
||
(setq entry-rest (match-string 2))
|
||
(setq entry-rest ""))
|
||
(setq entry-full (concat entry-main entry-rest))
|
||
|
||
(condition-case error-val
|
||
(progn
|
||
(setq cns-cons-or-list
|
||
(icalendar--convert-to-ical nonmarker entry-main))
|
||
(setq other-elements (icalendar--parse-summary-and-rest
|
||
entry-full))
|
||
(mapc (lambda (contents-n-summary)
|
||
(setq contents (concat (car contents-n-summary)
|
||
"\nSUMMARY:"
|
||
(cdr contents-n-summary)))
|
||
(let ((cla (cdr (assoc 'cla other-elements)))
|
||
(des (cdr (assoc 'des other-elements)))
|
||
(loc (cdr (assoc 'loc other-elements)))
|
||
(org (cdr (assoc 'org other-elements)))
|
||
(sta (cdr (assoc 'sta other-elements)))
|
||
;; (sum (cdr (assoc 'sum other-elements)))
|
||
(url (cdr (assoc 'url other-elements)))
|
||
(uid (cdr (assoc 'uid other-elements))))
|
||
(if cla
|
||
(setq contents (concat contents "\nCLASS:" cla)))
|
||
(if des
|
||
(setq contents (concat contents "\nDESCRIPTION:"
|
||
des)))
|
||
(if loc
|
||
(setq contents (concat contents "\nLOCATION:" loc)))
|
||
(if org
|
||
(setq contents (concat contents "\nORGANIZER:"
|
||
org)))
|
||
(if sta
|
||
(setq contents (concat contents "\nSTATUS:" sta)))
|
||
;;(if sum
|
||
;; (setq contents (concat contents "\nSUMMARY:" sum)))
|
||
(if url
|
||
(setq contents (concat contents "\nURL:" url)))
|
||
|
||
(setq header (concat "\nBEGIN:VEVENT\nUID:"
|
||
(or uid
|
||
(icalendar--create-uid
|
||
entry-full contents))))
|
||
(setq alarm (icalendar--create-ical-alarm
|
||
(cdr contents-n-summary))))
|
||
(setq result (concat result header contents alarm
|
||
"\nEND:VEVENT")))
|
||
(if (and (consp cns-cons-or-list)
|
||
(not (listp (cdr cns-cons-or-list))))
|
||
(list cns-cons-or-list)
|
||
cns-cons-or-list)))
|
||
;; handle errors
|
||
(error
|
||
(setq found-error t)
|
||
(save-current-buffer
|
||
(set-buffer (get-buffer-create "*icalendar-errors*"))
|
||
(insert (format-message "Error in line %d -- %s: `%s'\n"
|
||
(count-lines (point-min) (point))
|
||
error-val
|
||
entry-main))))))
|
||
|
||
;; we're done, insert everything into the file
|
||
(save-current-buffer
|
||
(let ((coding-system-for-write 'utf-8))
|
||
(set-buffer (find-file ical-filename))
|
||
(goto-char (point-max))
|
||
(insert "BEGIN:VCALENDAR")
|
||
(insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN")
|
||
(insert "\nVERSION:2.0")
|
||
(insert result)
|
||
(insert "\nEND:VCALENDAR\n")
|
||
;; save the diary file
|
||
(save-buffer)
|
||
(unless found-error
|
||
(bury-buffer)))))
|
||
found-error))
|
||
|
||
(defun icalendar--convert-to-ical (nonmarker entry-main)
|
||
"Convert a diary entry to iCalendar format.
|
||
NONMARKER is a regular expression matching the start of non-marking
|
||
entries. ENTRY-MAIN is the first line of the diary entry."
|
||
(declare (obsolete "use `diary-icalendar-parse-entry' and `icalendar-print-component-node' instead." "31.1"))
|
||
(or
|
||
(unless icalendar-export-sexp-enumerate-all
|
||
(or
|
||
;; anniversaries -- %%(diary-anniversary ...)
|
||
(icalendar--convert-anniversary-to-ical nonmarker entry-main)
|
||
;; cyclic events -- %%(diary-cyclic ...)
|
||
(icalendar--convert-cyclic-to-ical nonmarker entry-main)
|
||
;; diary-date -- %%(diary-date ...)
|
||
(icalendar--convert-date-to-ical nonmarker entry-main)
|
||
;; float events -- %%(diary-float ...)
|
||
(icalendar--convert-float-to-ical nonmarker entry-main)
|
||
;; block events -- %%(diary-block ...)
|
||
(icalendar--convert-block-to-ical nonmarker entry-main)))
|
||
;; other sexp diary entries
|
||
(icalendar--convert-sexp-to-ical nonmarker entry-main)
|
||
;; weekly by day -- Monday 8:30 Team meeting
|
||
(icalendar--convert-weekly-to-ical nonmarker entry-main)
|
||
;; yearly by day -- 1 May Tag der Arbeit
|
||
(icalendar--convert-yearly-to-ical nonmarker entry-main)
|
||
;; "ordinary" events, start and end time given
|
||
;; 1 Feb 2003 blah
|
||
(icalendar--convert-ordinary-to-ical nonmarker entry-main)
|
||
;; everything else
|
||
;; Oops! what's that?
|
||
(error "Could not parse entry")))
|
||
|
||
(defun icalendar--parse-summary-and-rest (summary-and-rest)
|
||
"Parse SUMMARY-AND-REST from a diary to fill iCalendar properties.
|
||
Returns an alist."
|
||
(declare (obsolete diary-icalendar-parse-entry "31.1"))
|
||
(save-match-data
|
||
(if (functionp icalendar-import-format)
|
||
;; can't do anything
|
||
nil
|
||
;; split summary-and-rest
|
||
(let* ((case-fold-search nil)
|
||
(s icalendar-import-format)
|
||
(p-cla (or (string-match "%c" icalendar-import-format) -1))
|
||
(p-des (or (string-match "%d" icalendar-import-format) -1))
|
||
(p-loc (or (string-match "%l" icalendar-import-format) -1))
|
||
(p-org (or (string-match "%o" icalendar-import-format) -1))
|
||
(p-sum (or (string-match "%s" icalendar-import-format) -1))
|
||
(p-sta (or (string-match "%t" icalendar-import-format) -1))
|
||
(p-url (or (string-match "%u" icalendar-import-format) -1))
|
||
(p-uid (or (string-match "%U" icalendar-import-format) -1))
|
||
(p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url p-uid) #'<))
|
||
(ct 0)
|
||
pos-cla pos-des pos-loc pos-org pos-sta pos-url pos-uid) ;pos-sum
|
||
(dotimes (i (length p-list))
|
||
;; Use 'ct' to keep track of current position in list
|
||
(cond ((and (>= p-cla 0) (= (nth i p-list) p-cla))
|
||
(setq ct (+ ct 1))
|
||
(setq pos-cla (* 2 ct)))
|
||
((and (>= p-des 0) (= (nth i p-list) p-des))
|
||
(setq ct (+ ct 1))
|
||
(setq pos-des (* 2 ct)))
|
||
((and (>= p-loc 0) (= (nth i p-list) p-loc))
|
||
(setq ct (+ ct 1))
|
||
(setq pos-loc (* 2 ct)))
|
||
((and (>= p-org 0) (= (nth i p-list) p-org))
|
||
(setq ct (+ ct 1))
|
||
(setq pos-org (* 2 ct)))
|
||
((and (>= p-sta 0) (= (nth i p-list) p-sta))
|
||
(setq ct (+ ct 1))
|
||
(setq pos-sta (* 2 ct)))
|
||
((and (>= p-sum 0) (= (nth i p-list) p-sum))
|
||
(setq ct (+ ct 1))
|
||
;; (setq pos-sum (* 2 ct))
|
||
)
|
||
((and (>= p-url 0) (= (nth i p-list) p-url))
|
||
(setq ct (+ ct 1))
|
||
(setq pos-url (* 2 ct)))
|
||
((and (>= p-uid 0) (= (nth i p-list) p-uid))
|
||
(setq ct (+ ct 1))
|
||
(setq pos-uid (* 2 ct)))) )
|
||
(mapc (lambda (ij)
|
||
(setq s (replace-regexp-in-string (car ij) (cadr ij) s t t)))
|
||
(list
|
||
;; summary must be first! because of %s
|
||
(list "%s"
|
||
(concat "\\(" icalendar-import-format-summary "\\)??"))
|
||
(list "%c"
|
||
(concat "\\(" icalendar-import-format-class "\\)??"))
|
||
(list "%d"
|
||
(concat "\\(" icalendar-import-format-description "\\)??"))
|
||
(list "%l"
|
||
(concat "\\(" icalendar-import-format-location "\\)??"))
|
||
(list "%o"
|
||
(concat "\\(" icalendar-import-format-organizer "\\)??"))
|
||
(list "%t"
|
||
(concat "\\(" icalendar-import-format-status "\\)??"))
|
||
(list "%u"
|
||
(concat "\\(" icalendar-import-format-url "\\)??"))
|
||
(list "%U"
|
||
(concat "\\(" icalendar-import-format-uid "\\)??"))))
|
||
;; Need the \' regexp in order to detect multi-line items
|
||
(setq s (concat "\\`"
|
||
(replace-regexp-in-string "%s" "\\([^z-a]*?\\)" s nil t)
|
||
"\\'"))
|
||
(if (string-match s summary-and-rest)
|
||
(let (cla des loc org sta url uid) ;; sum
|
||
;; (if (and pos-sum (match-beginning pos-sum))
|
||
;; (setq sum (substring summary-and-rest
|
||
;; (match-beginning pos-sum)
|
||
;; (match-end pos-sum))))
|
||
(if (and pos-cla (match-beginning pos-cla))
|
||
(setq cla (substring summary-and-rest
|
||
(match-beginning pos-cla)
|
||
(match-end pos-cla))))
|
||
(if (and pos-des (match-beginning pos-des))
|
||
(setq des (substring summary-and-rest
|
||
(match-beginning pos-des)
|
||
(match-end pos-des))))
|
||
(if (and pos-loc (match-beginning pos-loc))
|
||
(setq loc (substring summary-and-rest
|
||
(match-beginning pos-loc)
|
||
(match-end pos-loc))))
|
||
(if (and pos-org (match-beginning pos-org))
|
||
(setq org (substring summary-and-rest
|
||
(match-beginning pos-org)
|
||
(match-end pos-org))))
|
||
(if (and pos-sta (match-beginning pos-sta))
|
||
(setq sta (substring summary-and-rest
|
||
(match-beginning pos-sta)
|
||
(match-end pos-sta))))
|
||
(if (and pos-url (match-beginning pos-url))
|
||
(setq url (substring summary-and-rest
|
||
(match-beginning pos-url)
|
||
(match-end pos-url))))
|
||
(if (and pos-uid (match-beginning pos-uid))
|
||
(setq uid (substring summary-and-rest
|
||
(match-beginning pos-uid)
|
||
(match-end pos-uid))))
|
||
(list (if cla (cons 'cla cla) nil)
|
||
(if des (cons 'des des) nil)
|
||
(if loc (cons 'loc loc) nil)
|
||
(if org (cons 'org org) nil)
|
||
(if sta (cons 'sta sta) nil)
|
||
;;(if sum (cons 'sum sum) nil)
|
||
(if url (cons 'url url) nil)
|
||
(if uid (cons 'uid uid) nil))))))))
|
||
|
||
(defun icalendar--create-ical-alarm (summary)
|
||
"Return VALARM blocks for the given SUMMARY."
|
||
(declare (obsolete diary-icalendar-add-valarms "31.1"))
|
||
(when icalendar-export-alarms
|
||
(let* ((advance-time (car icalendar-export-alarms))
|
||
(alarm-specs (cadr icalendar-export-alarms))
|
||
(fun (lambda (spec)
|
||
(icalendar--do-create-ical-alarm advance-time spec summary))))
|
||
(mapconcat fun alarm-specs ""))))
|
||
|
||
(defun icalendar--do-create-ical-alarm (advance-time alarm-spec summary)
|
||
"Return a VALARM block.
|
||
Argument ADVANCE-TIME is a number giving the time when the alarm
|
||
fires (minutes before the respective event). Argument ALARM-SPEC
|
||
is a list which must be one of (audio), (display) or
|
||
\(email (ADDRESS1 ...)), see `icalendar-export-alarms'. Argument
|
||
SUMMARY is a string which contains a short description for the
|
||
alarm."
|
||
(declare (obsolete diary-icalendar-add-valarms "31.1"))
|
||
(let* ((action (car alarm-spec))
|
||
(act (format "\nACTION:%s"
|
||
(cdr (assoc action '((audio . "AUDIO")
|
||
(display . "DISPLAY")
|
||
(email . "EMAIL"))))))
|
||
(tri (format "\nTRIGGER:-PT%dM" advance-time))
|
||
(des (if (memq action '(display email))
|
||
(format "\nDESCRIPTION:%s" summary)
|
||
""))
|
||
(sum (if (eq action 'email)
|
||
(format "\nSUMMARY:%s" summary)
|
||
""))
|
||
(att (if (eq action 'email)
|
||
(mapconcat (lambda (i)
|
||
(format "\nATTENDEE:MAILTO:%s" i))
|
||
(cadr alarm-spec) "")
|
||
"")))
|
||
|
||
(concat "\nBEGIN:VALARM" act tri des sum att "\nEND:VALARM")))
|
||
|
||
;; subroutines for icalendar-export-region
|
||
(defun icalendar--convert-ordinary-to-ical (nonmarker entry-main)
|
||
"Convert \"ordinary\" diary entry to iCalendar format.
|
||
NONMARKER is a regular expression matching the start of non-marking
|
||
entries. ENTRY-MAIN is the first line of the diary entry."
|
||
(declare (obsolete "use `diary-icalendar-parse-entry' and `icalendar-print-component-node' instead." "31.1"))
|
||
(if (string-match
|
||
(concat nonmarker
|
||
"\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-*" ; date
|
||
"\\(\\([0-9][0-9]?\\(:[0-9][0-9]\\)?\\)\\([ap]m\\)?" ; start time
|
||
"\\("
|
||
"-\\([0-9][0-9]?\\(:[0-9][0-9]\\)?\\)\\([ap]m\\)?\\)?" ; end time
|
||
"\\)?"
|
||
"\\s-*\\(.*?\\) ?$")
|
||
entry-main)
|
||
(let* ((datetime (substring entry-main (match-beginning 1)
|
||
(match-end 1)))
|
||
(startisostring (icalendar--datestring-to-isodate
|
||
datetime))
|
||
(endisostring (icalendar--datestring-to-isodate
|
||
datetime 1))
|
||
(endisostring1)
|
||
(starttimestring (icalendar--diarytime-to-isotime
|
||
(if (match-beginning 3)
|
||
(substring entry-main
|
||
(match-beginning 3)
|
||
(match-end 3))
|
||
nil)
|
||
(if (match-beginning 5)
|
||
(substring entry-main
|
||
(match-beginning 5)
|
||
(match-end 5))
|
||
nil)))
|
||
(endtimestring (icalendar--diarytime-to-isotime
|
||
(if (match-beginning 7)
|
||
(substring entry-main
|
||
(match-beginning 7)
|
||
(match-end 7))
|
||
nil)
|
||
(if (match-beginning 9)
|
||
(substring entry-main
|
||
(match-beginning 9)
|
||
(match-end 9))
|
||
nil)))
|
||
(summary (icalendar--convert-string-for-export
|
||
(substring entry-main (match-beginning 10)
|
||
(match-end 10)))))
|
||
(icalendar--dmsg "ordinary %s" entry-main)
|
||
|
||
(unless startisostring
|
||
(error "Could not parse date"))
|
||
|
||
;; If only start-date is specified, then end-date is next day,
|
||
;; otherwise it is same day.
|
||
(setq endisostring1 (if starttimestring
|
||
startisostring
|
||
endisostring))
|
||
|
||
(when starttimestring
|
||
(unless endtimestring
|
||
(let ((time
|
||
(read (replace-regexp-in-string "^T0?" ""
|
||
starttimestring))))
|
||
(if (< time 230000)
|
||
;; Case: ends on same day
|
||
(setq endtimestring (format "T%06d"
|
||
(+ 10000 time)))
|
||
;; Case: ends on next day
|
||
(setq endtimestring (format "T%06d"
|
||
(- time 230000)))
|
||
(setq endisostring1 endisostring)) )))
|
||
|
||
(cons (concat "\nDTSTART;"
|
||
(if starttimestring "VALUE=DATE-TIME:"
|
||
"VALUE=DATE:")
|
||
startisostring
|
||
(or starttimestring "")
|
||
"\nDTEND;"
|
||
(if endtimestring "VALUE=DATE-TIME:"
|
||
"VALUE=DATE:")
|
||
endisostring1
|
||
(or endtimestring ""))
|
||
summary))
|
||
;; no match
|
||
nil))
|
||
|
||
(defun icalendar-first-weekday-of-year (abbrevweekday year)
|
||
"Find the first ABBREVWEEKDAY in a given YEAR.
|
||
Returns day number."
|
||
(declare (obsolete icalendar-nth-weekday-in "31.1"))
|
||
(let* ((day-of-week-jan01 (calendar-day-of-week (list 1 1 year)))
|
||
(result (+ 1
|
||
(- (icalendar--get-weekday-number abbrevweekday)
|
||
day-of-week-jan01))))
|
||
(cond ((<= result 0)
|
||
(setq result (+ result 7)))
|
||
((> result 7)
|
||
(setq result (- result 7))))
|
||
result))
|
||
|
||
(defun icalendar--convert-weekly-to-ical (nonmarker entry-main)
|
||
"Convert weekly diary entry to iCalendar format.
|
||
NONMARKER is a regular expression matching the start of non-marking
|
||
entries. ENTRY-MAIN is the first line of the diary entry."
|
||
(declare (obsolete "use `diary-icalendar-parse-entry' and `icalendar-print-component-node' instead." "31.1"))
|
||
(if (and (string-match (concat nonmarker
|
||
"\\([a-z]+\\)\\s-+"
|
||
"\\(\\([0-9][0-9]?:[0-9][0-9]\\)"
|
||
"\\([ap]m\\)?"
|
||
"\\(-"
|
||
"\\([0-9][0-9]?:[0-9][0-9]\\)"
|
||
"\\([ap]m\\)?\\)?"
|
||
"\\)?"
|
||
"\\s-*\\(.*?\\) ?$")
|
||
entry-main)
|
||
(icalendar--get-weekday-abbrev
|
||
(substring entry-main (match-beginning 1)
|
||
(match-end 1))))
|
||
(let* ((day (icalendar--get-weekday-abbrev
|
||
(substring entry-main (match-beginning 1)
|
||
(match-end 1))))
|
||
(starttimestring (icalendar--diarytime-to-isotime
|
||
(if (match-beginning 3)
|
||
(substring entry-main
|
||
(match-beginning 3)
|
||
(match-end 3))
|
||
nil)
|
||
(if (match-beginning 4)
|
||
(substring entry-main
|
||
(match-beginning 4)
|
||
(match-end 4))
|
||
nil)))
|
||
(endtimestring (icalendar--diarytime-to-isotime
|
||
(if (match-beginning 6)
|
||
(substring entry-main
|
||
(match-beginning 6)
|
||
(match-end 6))
|
||
nil)
|
||
(if (match-beginning 7)
|
||
(substring entry-main
|
||
(match-beginning 7)
|
||
(match-end 7))
|
||
nil)))
|
||
(summary (icalendar--convert-string-for-export
|
||
(substring entry-main (match-beginning 8)
|
||
(match-end 8)))))
|
||
(icalendar--dmsg "weekly %s" entry-main)
|
||
|
||
(when starttimestring
|
||
(unless endtimestring
|
||
(let ((time (read
|
||
(replace-regexp-in-string "^T0?" ""
|
||
starttimestring))))
|
||
(setq endtimestring (format "T%06d"
|
||
(+ 10000 time))))))
|
||
(cons (concat "\nDTSTART;"
|
||
(if starttimestring
|
||
"VALUE=DATE-TIME:"
|
||
"VALUE=DATE:")
|
||
;; Find the first requested weekday of the
|
||
;; start year
|
||
(funcall 'format "%04d%02d%02d"
|
||
icalendar-recurring-start-year 1
|
||
(icalendar-first-weekday-of-year
|
||
day icalendar-recurring-start-year))
|
||
(or starttimestring "")
|
||
"\nDTEND;"
|
||
(if endtimestring
|
||
"VALUE=DATE-TIME:"
|
||
"VALUE=DATE:")
|
||
(funcall 'format "%04d%02d%02d"
|
||
;; end is non-inclusive!
|
||
icalendar-recurring-start-year 1
|
||
(+ (icalendar-first-weekday-of-year
|
||
day icalendar-recurring-start-year)
|
||
(if endtimestring 0 1)))
|
||
(or endtimestring "")
|
||
"\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY="
|
||
day)
|
||
summary))
|
||
;; no match
|
||
nil))
|
||
|
||
(defun icalendar--convert-yearly-to-ical (nonmarker entry-main)
|
||
"Convert yearly diary entry to iCalendar format.
|
||
NONMARKER is a regular expression matching the start of non-marking
|
||
entries. ENTRY-MAIN is the first line of the diary entry."
|
||
(declare (obsolete "use `diary-icalendar-parse-entry' and `icalendar-print-component-node' instead." "31.1"))
|
||
(if (string-match (concat nonmarker
|
||
(if (eq calendar-date-style 'european)
|
||
"\\([0-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
|
||
"\\([a-z]+\\)\\s-+\\([0-9]+[0-9]?\\)\\s-+")
|
||
"\\*?\\s-*"
|
||
"\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
|
||
"\\("
|
||
"-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
|
||
"\\)?"
|
||
"\\s-*\\([^0-9]+.*?\\) ?$" ; must not match years
|
||
)
|
||
entry-main)
|
||
(let* ((daypos (if (eq calendar-date-style 'european) 1 2))
|
||
(monpos (if (eq calendar-date-style 'european) 2 1))
|
||
(day (read (substring entry-main
|
||
(match-beginning daypos)
|
||
(match-end daypos))))
|
||
(month (icalendar--get-month-number
|
||
(substring entry-main
|
||
(match-beginning monpos)
|
||
(match-end monpos))))
|
||
(starttimestring (icalendar--diarytime-to-isotime
|
||
(if (match-beginning 4)
|
||
(substring entry-main
|
||
(match-beginning 4)
|
||
(match-end 4))
|
||
nil)
|
||
(if (match-beginning 5)
|
||
(substring entry-main
|
||
(match-beginning 5)
|
||
(match-end 5))
|
||
nil)))
|
||
(endtimestring (icalendar--diarytime-to-isotime
|
||
(if (match-beginning 7)
|
||
(substring entry-main
|
||
(match-beginning 7)
|
||
(match-end 7))
|
||
nil)
|
||
(if (match-beginning 8)
|
||
(substring entry-main
|
||
(match-beginning 8)
|
||
(match-end 8))
|
||
nil)))
|
||
(summary (icalendar--convert-string-for-export
|
||
(substring entry-main (match-beginning 9)
|
||
(match-end 9)))))
|
||
(icalendar--dmsg "yearly %s" entry-main)
|
||
|
||
(when starttimestring
|
||
(unless endtimestring
|
||
(let ((time (read
|
||
(replace-regexp-in-string "^T0?" ""
|
||
starttimestring))))
|
||
(setq endtimestring (format "T%06d"
|
||
(+ 10000 time))))))
|
||
(cons (concat "\nDTSTART;"
|
||
(if starttimestring "VALUE=DATE-TIME:"
|
||
"VALUE=DATE:")
|
||
(format "1900%02d%02d" month day)
|
||
(or starttimestring "")
|
||
"\nDTEND;"
|
||
(if endtimestring "VALUE=DATE-TIME:"
|
||
"VALUE=DATE:")
|
||
;; end is not included! shift by one day
|
||
(icalendar--date-to-isodate
|
||
(list month day 1900)
|
||
(if endtimestring 0 1))
|
||
(or endtimestring "")
|
||
"\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH="
|
||
(format "%d" month)
|
||
";BYMONTHDAY="
|
||
(format "%d" day))
|
||
summary))
|
||
;; no match
|
||
nil))
|
||
|
||
(defun icalendar--convert-sexp-to-ical (nonmarker entry-main &optional start)
|
||
"Convert sexp diary entry to iCalendar format.
|
||
Enumerate the evaluated sexp entry for the next
|
||
`icalendar-export-sexp-enumeration-days' days. NONMARKER is a
|
||
regular expression matching the start of non-marking entries.
|
||
ENTRY-MAIN is the first line of the diary entry.
|
||
|
||
Optional argument START determines the first day of the
|
||
enumeration, given as a Lisp time value -- used for test purposes."
|
||
(declare (obsolete "use `diary-icalendar-parse-entry' and `icalendar-print-component-node' instead." "31.1"))
|
||
(cond ((string-match (concat nonmarker
|
||
"%%(and \\(([^)]+)\\))\\(\\s-*.*?\\) ?$")
|
||
entry-main)
|
||
;; simple sexp entry as generated by icalendar.el: strip off the
|
||
;; unnecessary (and)
|
||
(icalendar--dmsg "diary-sexp from icalendar.el %s" entry-main)
|
||
(icalendar--convert-to-ical
|
||
nonmarker
|
||
(concat "%%"
|
||
(substring entry-main (match-beginning 1) (match-end 1))
|
||
(substring entry-main (match-beginning 2) (match-end 2)))))
|
||
((string-match (concat nonmarker
|
||
"%%\\(([^)]+)\\)\\s-*\\(.*\\)")
|
||
entry-main)
|
||
;; regular sexp entry
|
||
(icalendar--dmsg "diary-sexp %s" entry-main)
|
||
(let* ((entry-main (substring entry-main 2))
|
||
(res (read-from-string entry-main))
|
||
(p1 (prin1-to-string (car res)))
|
||
(p2 (substring entry-main (cdr res)))
|
||
(now (or start (current-time))))
|
||
(delete nil
|
||
(mapcar
|
||
(lambda (offset)
|
||
(let* ((day (decode-time (time-add now
|
||
(* 60 60 24 offset))))
|
||
(d (decoded-time-day day))
|
||
(m (decoded-time-month day))
|
||
(y (decoded-time-year day))
|
||
(se (diary-sexp-entry p1 p2 (list m d y)))
|
||
(see (cond ((stringp se) se)
|
||
((consp se) (cdr se))
|
||
(t nil))))
|
||
(cond ((null see)
|
||
nil)
|
||
((stringp see)
|
||
(let ((calendar-date-style 'iso))
|
||
(icalendar--convert-ordinary-to-ical
|
||
nonmarker (format "%4d/%02d/%02d %s" y m d see))))
|
||
(;TODO:
|
||
(error "Unsupported Sexp-entry: %s"
|
||
entry-main)))))
|
||
(number-sequence
|
||
0 (- icalendar-export-sexp-enumeration-days 1))))))
|
||
(t
|
||
;; no match
|
||
nil)))
|
||
|
||
(defun icalendar--convert-block-to-ical (nonmarker entry-main)
|
||
"Convert block diary entry to iCalendar format.
|
||
NONMARKER is a regular expression matching the start of non-marking
|
||
entries. ENTRY-MAIN is the first line of the diary entry."
|
||
(declare (obsolete "use `diary-icalendar-parse-entry' and `icalendar-print-component-node' instead." "31.1"))
|
||
(if (string-match (concat nonmarker
|
||
"%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)"
|
||
" +\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
|
||
"\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
|
||
"\\("
|
||
"-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
|
||
"\\)?"
|
||
"\\s-*\\(.*?\\) ?$")
|
||
entry-main)
|
||
(let* ((startstring (substring entry-main
|
||
(match-beginning 1)
|
||
(match-end 1)))
|
||
(endstring (substring entry-main
|
||
(match-beginning 2)
|
||
(match-end 2)))
|
||
(startisostring (icalendar--datestring-to-isodate
|
||
startstring))
|
||
(endisostring (icalendar--datestring-to-isodate
|
||
endstring))
|
||
(endisostring+1 (icalendar--datestring-to-isodate
|
||
endstring 1))
|
||
(starttimestring (icalendar--diarytime-to-isotime
|
||
(if (match-beginning 4)
|
||
(substring entry-main
|
||
(match-beginning 4)
|
||
(match-end 4))
|
||
nil)
|
||
(if (match-beginning 5)
|
||
(substring entry-main
|
||
(match-beginning 5)
|
||
(match-end 5))
|
||
nil)))
|
||
(endtimestring (icalendar--diarytime-to-isotime
|
||
(if (match-beginning 7)
|
||
(substring entry-main
|
||
(match-beginning 7)
|
||
(match-end 7))
|
||
nil)
|
||
(if (match-beginning 8)
|
||
(substring entry-main
|
||
(match-beginning 8)
|
||
(match-end 8))
|
||
nil)))
|
||
(summary (icalendar--convert-string-for-export
|
||
(substring entry-main (match-beginning 9)
|
||
(match-end 9)))))
|
||
(icalendar--dmsg "diary-block %s" entry-main)
|
||
(when starttimestring
|
||
(unless endtimestring
|
||
(let ((time
|
||
(read (replace-regexp-in-string "^T0?" ""
|
||
starttimestring))))
|
||
(setq endtimestring (format "T%06d"
|
||
(+ 10000 time))))))
|
||
(if starttimestring
|
||
;; with time -> write rrule
|
||
(cons (concat "\nDTSTART;VALUE=DATE-TIME:"
|
||
startisostring
|
||
starttimestring
|
||
"\nDTEND;VALUE=DATE-TIME:"
|
||
startisostring
|
||
endtimestring
|
||
"\nRRULE:FREQ=DAILY;INTERVAL=1;UNTIL="
|
||
endisostring)
|
||
summary)
|
||
;; no time -> write long event
|
||
(cons (concat "\nDTSTART;VALUE=DATE:" startisostring
|
||
"\nDTEND;VALUE=DATE:" endisostring+1)
|
||
summary)))
|
||
;; no match
|
||
nil))
|
||
|
||
(defun icalendar--convert-float-to-ical (nonmarker entry-main)
|
||
"Convert float diary entry to iCalendar format -- partially unsupported!
|
||
|
||
FIXME! DAY from `diary-float' yet unimplemented.
|
||
|
||
NONMARKER is a regular expression matching the start of non-marking
|
||
entries. ENTRY-MAIN is the first line of the diary entry."
|
||
(declare (obsolete "use `diary-icalendar-parse-entry' and `icalendar-print-component-node' instead." "31.1"))
|
||
(if (string-match (concat nonmarker "%%\\((diary-float .+\\) ?$") entry-main)
|
||
(with-temp-buffer
|
||
(insert (match-string 1 entry-main))
|
||
(goto-char (point-min))
|
||
(let* ((sexp (read (current-buffer))) ;using `read' here
|
||
;easier than regexp
|
||
;matching, esp. with
|
||
;different forms of
|
||
;MONTH
|
||
(month-exp (nth 1 sexp))
|
||
(months (cond ((eq month-exp t) nil) ; don't add a BYMONTH clause
|
||
((integerp month-exp) (list month-exp))
|
||
(t month-exp)))
|
||
(dayname (nth 2 sexp))
|
||
(n (nth 3 sexp))
|
||
(day (nth 4 sexp))
|
||
(dtstart
|
||
;; Start on the first day matching the rule in
|
||
;; icalendar-recurring-start-year:
|
||
(calendar-nth-named-day n dayname
|
||
(if months (apply #'min months) 1)
|
||
icalendar-recurring-start-year))
|
||
(summary
|
||
(replace-regexp-in-string
|
||
"\\(^\s+\\|\s+$\\)" ""
|
||
(buffer-substring (point) (point-max)))))
|
||
|
||
(when day
|
||
(progn
|
||
(icalendar--dmsg "diary-float %s" entry-main)
|
||
(error "Don't know if or how to implement day in `diary-float'")))
|
||
|
||
(cons (concat
|
||
"\nDTSTART;VALUE=DATE:"
|
||
(format "%04d%02d%02d"
|
||
(calendar-extract-year dtstart)
|
||
(calendar-extract-month dtstart)
|
||
(calendar-extract-day dtstart))
|
||
"\nRRULE:"
|
||
(if months
|
||
"FREQ=YEARLY;BYMONTH="
|
||
"FREQ=MONTHLY")
|
||
(when months
|
||
(mapconcat
|
||
(lambda (m) (number-to-string m))
|
||
months ","))
|
||
";BYDAY="
|
||
(number-to-string n)
|
||
(aref icalendar--weekday-array dayname))
|
||
summary)))
|
||
;; no match
|
||
nil))
|
||
|
||
(defun icalendar--convert-date-to-ical (nonmarker entry-main)
|
||
"Convert `diary-date' diary entry to iCalendar format -- unsupported!
|
||
|
||
FIXME!
|
||
|
||
NONMARKER is a regular expression matching the start of non-marking
|
||
entries. ENTRY-MAIN is the first line of the diary entry."
|
||
(declare (obsolete "use `diary-icalendar-parse-entry' and `icalendar-print-component-node' instead." "31.1"))
|
||
(if (string-match (concat nonmarker
|
||
"%%(diary-date \\([^)]+\\))\\s-*\\(.*?\\) ?$")
|
||
entry-main)
|
||
(progn
|
||
(icalendar--dmsg "diary-date %s" entry-main)
|
||
(error "`diary-date' is not supported yet"))
|
||
;; no match
|
||
nil))
|
||
|
||
(defun icalendar--convert-cyclic-to-ical (nonmarker entry-main)
|
||
"Convert `diary-cyclic' diary entry to iCalendar format.
|
||
NONMARKER is a regular expression matching the start of non-marking
|
||
entries. ENTRY-MAIN is the first line of the diary entry."
|
||
(declare (obsolete "use `diary-icalendar-parse-entry' and `icalendar-print-component-node' instead." "31.1"))
|
||
(if (string-match (concat nonmarker
|
||
"%%(diary-cyclic \\([^ ]+\\) +"
|
||
"\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
|
||
"\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
|
||
"\\("
|
||
"-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
|
||
"\\)?"
|
||
"\\s-*\\(.*?\\) ?$")
|
||
entry-main)
|
||
(let* ((frequency (substring entry-main (match-beginning 1)
|
||
(match-end 1)))
|
||
(datetime (substring entry-main (match-beginning 2)
|
||
(match-end 2)))
|
||
(startisostring (icalendar--datestring-to-isodate
|
||
datetime))
|
||
(endisostring (icalendar--datestring-to-isodate
|
||
datetime))
|
||
(endisostring+1 (icalendar--datestring-to-isodate
|
||
datetime 1))
|
||
(starttimestring (icalendar--diarytime-to-isotime
|
||
(if (match-beginning 4)
|
||
(substring entry-main
|
||
(match-beginning 4)
|
||
(match-end 4))
|
||
nil)
|
||
(if (match-beginning 5)
|
||
(substring entry-main
|
||
(match-beginning 5)
|
||
(match-end 5))
|
||
nil)))
|
||
(endtimestring (icalendar--diarytime-to-isotime
|
||
(if (match-beginning 7)
|
||
(substring entry-main
|
||
(match-beginning 7)
|
||
(match-end 7))
|
||
nil)
|
||
(if (match-beginning 8)
|
||
(substring entry-main
|
||
(match-beginning 8)
|
||
(match-end 8))
|
||
nil)))
|
||
(summary (icalendar--convert-string-for-export
|
||
(substring entry-main (match-beginning 9)
|
||
(match-end 9)))))
|
||
(icalendar--dmsg "diary-cyclic %s" entry-main)
|
||
(when starttimestring
|
||
(unless endtimestring
|
||
(let ((time
|
||
(read (replace-regexp-in-string "^T0?" ""
|
||
starttimestring))))
|
||
(setq endtimestring (format "T%06d"
|
||
(+ 10000 time))))))
|
||
(cons (concat "\nDTSTART;"
|
||
(if starttimestring "VALUE=DATE-TIME:"
|
||
"VALUE=DATE:")
|
||
startisostring
|
||
(or starttimestring "")
|
||
"\nDTEND;"
|
||
(if endtimestring "VALUE=DATE-TIME:"
|
||
"VALUE=DATE:")
|
||
(if endtimestring endisostring endisostring+1)
|
||
(or endtimestring "")
|
||
"\nRRULE:FREQ=DAILY;INTERVAL=" frequency
|
||
;; strange: korganizer does not expect
|
||
;; BYSOMETHING here...
|
||
)
|
||
summary))
|
||
;; no match
|
||
nil))
|
||
|
||
(defun icalendar--convert-anniversary-to-ical (nonmarker entry-main)
|
||
"Convert `diary-anniversary' diary entry to iCalendar format.
|
||
NONMARKER is a regular expression matching the start of non-marking
|
||
entries. ENTRY-MAIN is the first line of the diary entry."
|
||
(declare (obsolete "use `diary-icalendar-parse-entry' and `icalendar-print-component-node' instead." "31.1"))
|
||
(if (string-match (concat nonmarker
|
||
"%%(diary-anniversary \\([^)]+\\))\\s-*"
|
||
"\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
|
||
"\\("
|
||
"-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
|
||
"\\)?"
|
||
"\\s-*\\(.*?\\) ?$")
|
||
entry-main)
|
||
(let* ((datetime (substring entry-main (match-beginning 1)
|
||
(match-end 1)))
|
||
(startisostring (icalendar--datestring-to-isodate
|
||
datetime nil 1))
|
||
(endisostring (icalendar--datestring-to-isodate
|
||
datetime 1 1))
|
||
(starttimestring (icalendar--diarytime-to-isotime
|
||
(if (match-beginning 3)
|
||
(substring entry-main
|
||
(match-beginning 3)
|
||
(match-end 3))
|
||
nil)
|
||
(if (match-beginning 4)
|
||
(substring entry-main
|
||
(match-beginning 4)
|
||
(match-end 4))
|
||
nil)))
|
||
(endtimestring (icalendar--diarytime-to-isotime
|
||
(if (match-beginning 6)
|
||
(substring entry-main
|
||
(match-beginning 6)
|
||
(match-end 6))
|
||
nil)
|
||
(if (match-beginning 7)
|
||
(substring entry-main
|
||
(match-beginning 7)
|
||
(match-end 7))
|
||
nil)))
|
||
(summary (icalendar--convert-string-for-export
|
||
(substring entry-main (match-beginning 8)
|
||
(match-end 8)))))
|
||
(icalendar--dmsg "diary-anniversary %s" entry-main)
|
||
(when starttimestring
|
||
(unless endtimestring
|
||
(let ((time
|
||
(read (replace-regexp-in-string "^T0?" ""
|
||
starttimestring))))
|
||
(setq endtimestring (format "T%06d"
|
||
(+ 10000 time))))))
|
||
(cons (concat "\nDTSTART;"
|
||
(if starttimestring "VALUE=DATE-TIME:"
|
||
"VALUE=DATE:")
|
||
startisostring
|
||
(or starttimestring "")
|
||
"\nDTEND;"
|
||
(if endtimestring "VALUE=DATE-TIME:"
|
||
"VALUE=DATE:")
|
||
endisostring
|
||
(or endtimestring "")
|
||
"\nRRULE:FREQ=YEARLY;INTERVAL=1"
|
||
;; the following is redundant,
|
||
;; but korganizer seems to expect this... ;(
|
||
;; and evolution doesn't understand it... :(
|
||
;; so... who is wrong?!
|
||
";BYMONTH="
|
||
(substring startisostring 4 6)
|
||
";BYMONTHDAY="
|
||
(substring startisostring 6 8))
|
||
summary))
|
||
;; no match
|
||
nil))
|
||
|
||
;; ======================================================================
|
||
;; Import -- convert iCalendar to emacs-diary
|
||
;; ======================================================================
|
||
|
||
;;;###autoload
|
||
(defun icalendar-import-file (ical-filename diary-filename
|
||
&optional non-marking)
|
||
"Import an iCalendar file and append to a diary file.
|
||
Argument ICAL-FILENAME output iCalendar file.
|
||
Argument DIARY-FILENAME input `diary-file'.
|
||
Optional argument NON-MARKING determines whether events are created as
|
||
non-marking or not."
|
||
(declare (obsolete diary-icalendar-import-file "31.1"))
|
||
(interactive "fImport iCalendar data from file: \nFInto diary file: \nP")
|
||
;; clean up the diary file
|
||
(save-current-buffer
|
||
;; now load and convert from the ical file
|
||
(set-buffer (find-file ical-filename))
|
||
(icalendar-import-buffer diary-filename t non-marking)))
|
||
|
||
;;;###autoload
|
||
(defun icalendar-import-buffer (&optional diary-filename do-not-ask
|
||
non-marking)
|
||
"Extract iCalendar events from current buffer.
|
||
|
||
This function searches the current buffer for the first iCalendar
|
||
object, reads it and adds all VEVENT elements to the diary
|
||
DIARY-FILENAME.
|
||
|
||
It will ask for each appointment whether to add it to the diary
|
||
unless DO-NOT-ASK is non-nil. When called interactively,
|
||
DO-NOT-ASK is nil, so that you are asked for each event.
|
||
|
||
NON-MARKING determines whether diary events are created as
|
||
non-marking.
|
||
|
||
Return code t means that importing worked well, return code nil
|
||
means that an error has occurred. Error messages will be in the
|
||
buffer `*icalendar-errors*'."
|
||
(declare (obsolete diary-icalendar-import-buffer "31.1"))
|
||
(interactive)
|
||
(save-current-buffer
|
||
;; prepare ical
|
||
(message "Preparing iCalendar...")
|
||
(set-buffer (icalendar--get-unfolded-buffer (current-buffer)))
|
||
(goto-char (point-min))
|
||
(message "Preparing iCalendar...done")
|
||
(if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t)
|
||
(let (ical-contents ical-errors)
|
||
;; read ical
|
||
(message "Reading iCalendar...")
|
||
(beginning-of-line)
|
||
(setq ical-contents (icalendar--read-element nil nil))
|
||
(message "Reading iCalendar...done")
|
||
;; convert ical
|
||
(message "Converting iCalendar...")
|
||
(setq ical-errors (icalendar--convert-ical-to-diary
|
||
ical-contents
|
||
diary-filename do-not-ask non-marking))
|
||
(when diary-filename
|
||
;; save the diary file if it is visited already
|
||
(let ((b (find-buffer-visiting diary-filename)))
|
||
(when b
|
||
(save-current-buffer
|
||
(set-buffer b)
|
||
(save-buffer)))))
|
||
(message "Converting iCalendar...done")
|
||
;; return t if no error occurred
|
||
(not ical-errors))
|
||
(message
|
||
"Current buffer does not contain iCalendar contents!")
|
||
;; return nil, i.e. import did not work
|
||
nil)))
|
||
|
||
(defun icalendar--format-ical-event (event)
|
||
"Create a string representation of an iCalendar EVENT."
|
||
(declare (obsolete diary-icalendar-format-entry "31.1"))
|
||
(if (functionp icalendar-import-format)
|
||
(funcall icalendar-import-format event)
|
||
(let ((string icalendar-import-format)
|
||
(case-fold-search nil)
|
||
(conversion-list
|
||
'(("%c" CLASS icalendar-import-format-class)
|
||
("%d" DESCRIPTION icalendar-import-format-description)
|
||
("%l" LOCATION icalendar-import-format-location)
|
||
("%o" ORGANIZER icalendar-import-format-organizer)
|
||
("%s" SUMMARY icalendar-import-format-summary)
|
||
("%t" STATUS icalendar-import-format-status)
|
||
("%u" URL icalendar-import-format-url)
|
||
("%U" UID icalendar-import-format-uid))))
|
||
;; convert the specifiers in the format string
|
||
(mapc (lambda (i)
|
||
(let* ((spec (car i))
|
||
(prop (cadr i))
|
||
(format (car (cddr i)))
|
||
(contents (icalendar--get-event-property event prop))
|
||
(formatted-contents ""))
|
||
(when (and contents (> (length contents) 0))
|
||
(setq formatted-contents
|
||
(replace-regexp-in-string "%s"
|
||
(icalendar--convert-string-for-import
|
||
contents)
|
||
(symbol-value format)
|
||
t t)))
|
||
(setq string (replace-regexp-in-string spec
|
||
formatted-contents
|
||
string
|
||
t t))))
|
||
conversion-list)
|
||
string)))
|
||
|
||
(defun icalendar--convert-ical-to-diary (ical-list diary-filename
|
||
&optional do-not-ask
|
||
non-marking)
|
||
"Convert iCalendar data to an Emacs diary file.
|
||
Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a
|
||
DIARY-FILENAME. If DO-NOT-ASK is nil the user is asked for each event
|
||
whether to actually import it. NON-MARKING determines whether diary
|
||
events are created as non-marking.
|
||
This function attempts to return t if something goes wrong. In this
|
||
case an error string which describes all the errors and problems is
|
||
written into the buffer `*icalendar-errors*'."
|
||
(declare (obsolete diary-icalendar-import-buffer "31.1"))
|
||
(let* ((ev (icalendar--all-events ical-list))
|
||
(error-string "")
|
||
(event-ok t)
|
||
(found-error nil)
|
||
(zone-map (icalendar--convert-all-timezones ical-list))
|
||
e diary-string)
|
||
;; step through all events/appointments
|
||
(while ev
|
||
(setq e (car ev))
|
||
(setq ev (cdr ev))
|
||
(setq event-ok nil)
|
||
(condition-case error-val
|
||
(let* ((dtstart (icalendar--get-event-property e 'DTSTART))
|
||
(dtstart-zone (icalendar--find-time-zone
|
||
(icalendar--get-event-property-attributes
|
||
e 'DTSTART)
|
||
zone-map))
|
||
(dtstart-dec (icalendar--decode-isodatetime dtstart nil
|
||
dtstart-zone))
|
||
(start-d (icalendar--datetime-to-diary-date
|
||
dtstart-dec))
|
||
(start-t (and dtstart
|
||
(> (length dtstart) 8)
|
||
(icalendar--datetime-to-colontime dtstart-dec)))
|
||
(dtend (icalendar--get-event-property e 'DTEND))
|
||
(dtend-zone (icalendar--find-time-zone
|
||
(icalendar--get-event-property-attributes
|
||
e 'DTEND)
|
||
zone-map))
|
||
(dtend-dec (icalendar--decode-isodatetime dtend
|
||
nil dtend-zone))
|
||
(dtend-1-dec (icalendar--decode-isodatetime dtend -1
|
||
dtend-zone))
|
||
end-d
|
||
end-1-d
|
||
end-t
|
||
(summary (icalendar--convert-string-for-import
|
||
(or (icalendar--get-event-property e 'SUMMARY)
|
||
"No summary")))
|
||
(rrule (icalendar--get-event-property e 'RRULE))
|
||
(rdate (icalendar--get-event-property e 'RDATE))
|
||
(duration (icalendar--get-event-property e 'DURATION)))
|
||
(icalendar--dmsg "%s: `%s'" start-d summary)
|
||
;; check whether start-time is missing
|
||
(if (and dtstart
|
||
(string=
|
||
(cadr (icalendar--get-event-property-attributes
|
||
e 'DTSTART))
|
||
"DATE"))
|
||
(setq start-t nil))
|
||
(when duration
|
||
(let ((dtend-dec-d (icalendar--add-decoded-times
|
||
dtstart-dec
|
||
(icalendar--decode-isoduration duration)))
|
||
(dtend-1-dec-d (icalendar--add-decoded-times
|
||
dtstart-dec
|
||
(icalendar--decode-isoduration duration
|
||
t))))
|
||
(if (and dtend-dec (not (eq dtend-dec dtend-dec-d)))
|
||
(message "Inconsistent endtime and duration for %s"
|
||
summary))
|
||
(setq dtend-dec dtend-dec-d)
|
||
(setq dtend-1-dec dtend-1-dec-d)))
|
||
(setq end-d (if dtend-dec
|
||
(icalendar--datetime-to-diary-date dtend-dec)
|
||
start-d))
|
||
(setq end-1-d (if dtend-1-dec
|
||
(icalendar--datetime-to-diary-date dtend-1-dec)
|
||
start-d))
|
||
(setq end-t (if (and
|
||
dtend-dec
|
||
(not (string=
|
||
(cadr
|
||
(icalendar--get-event-property-attributes
|
||
e 'DTEND))
|
||
"DATE")))
|
||
(icalendar--datetime-to-colontime dtend-dec)))
|
||
(icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d)
|
||
(cond
|
||
;; recurring event
|
||
(rrule
|
||
(setq diary-string
|
||
(icalendar--convert-recurring-to-diary e dtstart-dec start-t
|
||
end-t))
|
||
(setq event-ok t))
|
||
(rdate
|
||
(icalendar--dmsg "rdate event")
|
||
(setq diary-string "")
|
||
(mapc (lambda (_datestring)
|
||
(setq diary-string
|
||
(concat diary-string "......")))
|
||
(icalendar--split-value rdate)))
|
||
;; non-recurring event
|
||
;; all-day event
|
||
((not (string= start-d end-d))
|
||
(setq diary-string
|
||
(icalendar--convert-non-recurring-all-day-to-diary
|
||
start-d end-1-d))
|
||
(setq event-ok t))
|
||
;; not all-day
|
||
((and start-t (or (not end-t)
|
||
(not (string= start-t end-t))))
|
||
(setq diary-string
|
||
(icalendar--convert-non-recurring-not-all-day-to-diary
|
||
dtstart-dec start-t end-t))
|
||
(setq event-ok t))
|
||
;; all-day event
|
||
(t
|
||
(icalendar--dmsg "all day event")
|
||
(setq diary-string (icalendar--datetime-to-diary-date
|
||
dtstart-dec "/"))
|
||
(setq event-ok t)))
|
||
;; add all other elements unless the user doesn't want to have
|
||
;; them
|
||
(if event-ok
|
||
(progn
|
||
(setq diary-string
|
||
(concat diary-string " "
|
||
(icalendar--format-ical-event e)))
|
||
(if do-not-ask (setq summary nil))
|
||
;; add entry to diary and store actual name of diary
|
||
;; file (in case it was nil)
|
||
(setq diary-filename
|
||
(icalendar--add-diary-entry diary-string diary-filename
|
||
non-marking summary)))
|
||
;; event was not ok
|
||
(setq found-error t)
|
||
(setq error-string
|
||
(format "%s\nCannot handle this event:%s"
|
||
error-string e))))
|
||
;; FIXME: inform user about ignored event properties
|
||
;; handle errors
|
||
(error
|
||
(message "Ignoring event \"%s\"" e)
|
||
(setq found-error t)
|
||
(setq error-string (format "%s\n%s\nCannot handle this event: %s"
|
||
error-val error-string e))
|
||
(message "%s" error-string))))
|
||
|
||
;; insert final newline
|
||
(if diary-filename
|
||
(let ((b (find-buffer-visiting diary-filename)))
|
||
(when b
|
||
(save-current-buffer
|
||
(set-buffer b)
|
||
(goto-char (point-max))
|
||
(insert "\n")))))
|
||
(if found-error
|
||
(save-current-buffer
|
||
(set-buffer (get-buffer-create "*icalendar-errors*"))
|
||
(erase-buffer)
|
||
(insert error-string)))
|
||
(message "Converting iCalendar...done")
|
||
found-error))
|
||
|
||
;; subroutines for importing
|
||
(defun icalendar--convert-recurring-to-diary (e dtstart-dec start-t end-t)
|
||
"Convert recurring iCalendar event E to diary format.
|
||
|
||
DTSTART-DEC is the DTSTART property of E.
|
||
START-T is the event's start time in diary format.
|
||
END-T is the event's end time in diary format."
|
||
(declare (obsolete diary-icalendar-format-entry "31.1"))
|
||
(icalendar--dmsg "recurring event")
|
||
(let* ((rrule (icalendar--get-event-property e 'RRULE))
|
||
(rrule-props (icalendar--split-value rrule))
|
||
(frequency (cadr (assoc 'FREQ rrule-props)))
|
||
(until (cadr (assoc 'UNTIL rrule-props)))
|
||
(count (cadr (assoc 'COUNT rrule-props)))
|
||
(interval (read (or (cadr (assoc 'INTERVAL rrule-props)) "1")))
|
||
(dtstart-conv (icalendar--datetime-to-diary-date dtstart-dec))
|
||
(until-conv (icalendar--datetime-to-diary-date
|
||
(icalendar--decode-isodatetime until)))
|
||
(until-1-conv (icalendar--datetime-to-diary-date
|
||
(icalendar--decode-isodatetime until -1)))
|
||
(result ""))
|
||
|
||
;; FIXME FIXME interval!!!!!!!!!!!!!
|
||
|
||
(when count
|
||
(if until
|
||
(message "Must not have UNTIL and COUNT -- ignoring COUNT element!")
|
||
(let ((until-1 0))
|
||
(cond ((string-equal frequency "DAILY")
|
||
(setq until (icalendar--add-decoded-times
|
||
dtstart-dec
|
||
(list 0 0 0 (* (read count) interval) 0 0)))
|
||
(setq until-1 (icalendar--add-decoded-times
|
||
dtstart-dec
|
||
(list 0 0 0 (* (- (read count) 1) interval)
|
||
0 0)))
|
||
)
|
||
((string-equal frequency "WEEKLY")
|
||
(setq until (icalendar--add-decoded-times
|
||
dtstart-dec
|
||
(list 0 0 0 (* (read count) 7 interval) 0 0)))
|
||
(setq until-1 (icalendar--add-decoded-times
|
||
dtstart-dec
|
||
(list 0 0 0 (* (- (read count) 1) 7
|
||
interval) 0 0)))
|
||
)
|
||
((string-equal frequency "MONTHLY")
|
||
(setq until (icalendar--add-decoded-times
|
||
dtstart-dec (list 0 0 0 0 (* (- (read count) 1)
|
||
interval) 0)))
|
||
(setq until-1 (icalendar--add-decoded-times
|
||
dtstart-dec (list 0 0 0 0 (* (- (read count) 1)
|
||
interval) 0)))
|
||
)
|
||
((string-equal frequency "YEARLY")
|
||
(setq until (icalendar--add-decoded-times
|
||
dtstart-dec (list 0 0 0 0 0 (* (- (read count) 1)
|
||
interval))))
|
||
(setq until-1 (icalendar--add-decoded-times
|
||
dtstart-dec
|
||
(list 0 0 0 0 0 (* (- (read count) 1)
|
||
interval))))
|
||
)
|
||
(t
|
||
(message "Cannot handle COUNT attribute for `%s' events."
|
||
frequency)))
|
||
(setq until-conv (icalendar--datetime-to-diary-date until))
|
||
(setq until-1-conv (icalendar--datetime-to-diary-date until-1))
|
||
))
|
||
)
|
||
(cond ((string-equal frequency "WEEKLY")
|
||
(let* ((byday (cadr (assoc 'BYDAY rrule-props)))
|
||
(weekdays
|
||
(icalendar--get-weekday-numbers byday))
|
||
(weekday-clause
|
||
(when (> (length weekdays) 1)
|
||
(format "(memq (calendar-day-of-week date) '%s) "
|
||
weekdays))))
|
||
(if (not start-t)
|
||
(progn
|
||
;; weekly and all-day
|
||
(icalendar--dmsg "weekly all-day")
|
||
(if until
|
||
(setq result
|
||
(format
|
||
(concat "%%%%(and "
|
||
"%s"
|
||
"(diary-block %s %s))")
|
||
(or weekday-clause
|
||
(format "(diary-cyclic %d %s) "
|
||
(* interval 7)
|
||
dtstart-conv))
|
||
dtstart-conv
|
||
(if count until-1-conv until-conv)
|
||
))
|
||
(setq result
|
||
(format "%%%%(and %s(diary-cyclic %d %s))"
|
||
(or weekday-clause "")
|
||
(if weekday-clause 1 (* interval 7))
|
||
dtstart-conv))))
|
||
;; weekly and not all-day
|
||
(icalendar--dmsg "weekly not-all-day")
|
||
(if until
|
||
(setq result
|
||
(format
|
||
(concat "%%%%(and "
|
||
"%s"
|
||
"(diary-block %s %s)) "
|
||
"%s%s%s")
|
||
(or weekday-clause
|
||
(format "(diary-cyclic %d %s) "
|
||
(* interval 7)
|
||
dtstart-conv))
|
||
dtstart-conv
|
||
until-conv
|
||
(or start-t "")
|
||
(if end-t "-" "") (or end-t "")))
|
||
;; no limit
|
||
;; FIXME!!!!
|
||
;; DTSTART;VALUE=DATE-TIME:20030919T090000
|
||
;; DTEND;VALUE=DATE-TIME:20030919T113000
|
||
(setq result
|
||
(format
|
||
"%%%%(and %s(diary-cyclic %d %s)) %s%s%s"
|
||
(or weekday-clause "")
|
||
(if weekday-clause 1 (* interval 7))
|
||
dtstart-conv
|
||
(or start-t "")
|
||
(if end-t "-" "") (or end-t "")))))))
|
||
;; yearly
|
||
((string-equal frequency "YEARLY")
|
||
(icalendar--dmsg "yearly")
|
||
(if until
|
||
(let ((day (nth 3 dtstart-dec))
|
||
(month (nth 4 dtstart-dec)))
|
||
(setq result (concat "%%(and (diary-date "
|
||
(cond ((eq calendar-date-style 'iso)
|
||
(format "t %d %d" month day))
|
||
((eq calendar-date-style 'european)
|
||
(format "%d %d t" day month))
|
||
((eq calendar-date-style 'american)
|
||
(format "%d %d t" month day)))
|
||
") (diary-block "
|
||
dtstart-conv
|
||
" "
|
||
until-conv
|
||
")) "
|
||
(or start-t "")
|
||
(if end-t "-" "")
|
||
(or end-t ""))))
|
||
(setq result (format
|
||
"%%%%(diary-anniversary %s) %s%s%s"
|
||
(let* ((year (nth 5 dtstart-dec))
|
||
(dtstart-1y-dec (copy-sequence dtstart-dec)))
|
||
(setf (nth 5 dtstart-1y-dec) (1- year))
|
||
(icalendar--datetime-to-diary-date dtstart-1y-dec))
|
||
(or start-t "")
|
||
(if end-t "-" "") (or end-t "")))))
|
||
;; monthly
|
||
((string-equal frequency "MONTHLY")
|
||
(icalendar--dmsg "monthly")
|
||
(let* ((byday (cadr (assoc 'BYDAY rrule-props)))
|
||
(count-weekday
|
||
(and byday
|
||
(save-match-data
|
||
(when (string-match "\\(-?[0-9]+\\)\\([A-Z][A-Z]\\)"
|
||
byday)
|
||
(cons (substring byday
|
||
(match-beginning 1)
|
||
(match-end 1))
|
||
(substring byday
|
||
(match-beginning 2)
|
||
(match-end 2)))))))
|
||
(rule-part
|
||
(if count-weekday
|
||
(let ((count (car count-weekday))
|
||
(weekdaynum (icalendar--get-weekday-number
|
||
(cdr count-weekday))))
|
||
;; FIXME: this is valid only for interval==1
|
||
(format "(diary-float t %s %s)" weekdaynum count))
|
||
(format "(diary-date %s)"
|
||
(let ((day (nth 3 dtstart-dec)))
|
||
(cond ((eq calendar-date-style 'iso)
|
||
(format "t t %d" day))
|
||
((eq calendar-date-style 'european)
|
||
(format "%d t t" day))
|
||
((eq calendar-date-style 'american)
|
||
(format "t %d t" day))))))))
|
||
(setq result
|
||
(format
|
||
"%%%%(and %s (diary-block %s %s)) %s%s%s"
|
||
rule-part
|
||
dtstart-conv
|
||
(if until
|
||
until-conv
|
||
(if (eq calendar-date-style 'iso) "9999 1 1" "1 1 9999")) ;; FIXME: should be unlimited
|
||
(or start-t "")
|
||
(if end-t "-" "") (or end-t "")))))
|
||
;; daily
|
||
((and (string-equal frequency "DAILY"))
|
||
(if until
|
||
(setq result
|
||
(format
|
||
(concat "%%%%(and (diary-cyclic %s %s) "
|
||
"(diary-block %s %s)) %s%s%s")
|
||
interval dtstart-conv dtstart-conv
|
||
(if count until-1-conv until-conv)
|
||
(or start-t "")
|
||
(if end-t "-" "") (or end-t "")))
|
||
(setq result
|
||
(format
|
||
"%%%%(and (diary-cyclic %s %s)) %s%s%s"
|
||
interval
|
||
dtstart-conv
|
||
(or start-t "")
|
||
(if end-t "-" "") (or end-t ""))))))
|
||
;; Handle exceptions from recurrence rules
|
||
(let ((ex-dates (icalendar--get-event-properties e 'EXDATE)))
|
||
(while ex-dates
|
||
(let* ((ex-start (icalendar--decode-isodatetime
|
||
(car ex-dates)))
|
||
(ex-d (icalendar--datetime-to-diary-date
|
||
ex-start)))
|
||
(setq result
|
||
(replace-regexp-in-string "^%%(\\(and \\)?"
|
||
(format
|
||
"%%%%(and (not (diary-date %s)) "
|
||
ex-d)
|
||
result)))
|
||
(setq ex-dates (cdr ex-dates))))
|
||
;; FIXME: exception rules are not recognized
|
||
(if (icalendar--get-event-property e 'EXRULE)
|
||
(setq result
|
||
(concat result
|
||
"\n Exception rules: "
|
||
(icalendar--get-event-properties
|
||
e 'EXRULE))))
|
||
result))
|
||
|
||
(defun icalendar--convert-non-recurring-all-day-to-diary (start-d end-d)
|
||
"Convert non-recurring iCalendar EVENT to diary format.
|
||
|
||
DTSTART is the decoded DTSTART property of E.
|
||
Argument START-D gives the first day.
|
||
Argument END-D gives the last day."
|
||
(declare (obsolete diary-icalendar-format-time-range "31.1"))
|
||
(icalendar--dmsg "non-recurring all-day event")
|
||
(format "%%%%(and (diary-block %s %s))" start-d end-d))
|
||
|
||
(defun icalendar--convert-non-recurring-not-all-day-to-diary (dtstart-dec
|
||
start-t
|
||
end-t)
|
||
"Convert recurring icalendar EVENT to diary format.
|
||
|
||
DTSTART-DEC is the decoded DTSTART property of E.
|
||
START-T is the event's start time in diary format.
|
||
END-T is the event's end time in diary format."
|
||
(declare (obsolete diary-icalendar-format-time-range "31.1"))
|
||
(icalendar--dmsg "not all day event")
|
||
(cond (end-t
|
||
(format "%s %s-%s"
|
||
(icalendar--datetime-to-diary-date
|
||
dtstart-dec "/")
|
||
start-t end-t))
|
||
(t
|
||
(format "%s %s"
|
||
(icalendar--datetime-to-diary-date
|
||
dtstart-dec "/")
|
||
start-t))))
|
||
|
||
(defun icalendar--add-diary-entry (string diary-filename non-marking
|
||
&optional summary)
|
||
"Add STRING to the diary file DIARY-FILENAME.
|
||
STRING must be a properly formatted valid diary entry. NON-MARKING
|
||
determines whether diary events are created as non-marking. If
|
||
SUMMARY is not nil it must be a string that gives the summary of the
|
||
entry. In this case the user will be asked whether he wants to insert
|
||
the entry."
|
||
(declare (obsolete "see `diary-icalendar-post-entry-format-hook' and
|
||
`diary-icalendar--entry-import'" "31.1"))
|
||
(when (or (not summary)
|
||
(y-or-n-p (format-message "Add appointment for `%s' to diary? "
|
||
summary)))
|
||
(when summary
|
||
(setq non-marking
|
||
(y-or-n-p "Make appointment non-marking? ")))
|
||
(unless diary-filename
|
||
(setq diary-filename
|
||
(read-file-name "Add appointment to this diary file: ")))
|
||
(diary-make-entry string non-marking diary-filename t t))
|
||
;; return diary-filename in case it has been changed interactively
|
||
diary-filename)
|
||
|
||
;; ======================================================================
|
||
;; Examples
|
||
;; ======================================================================
|
||
(defun icalendar-import-format-sample (event)
|
||
"Example function for formatting an iCalendar EVENT."
|
||
(declare (obsolete "see `diary-icalendar-vevent-skeleton'" "31.1"))
|
||
(format (concat "SUMMARY='%s' DESCRIPTION='%s' LOCATION='%s' ORGANIZER='%s' "
|
||
"STATUS='%s' URL='%s' CLASS='%s'")
|
||
(or (icalendar--get-event-property event 'SUMMARY) "")
|
||
(or (icalendar--get-event-property event 'DESCRIPTION) "")
|
||
(or (icalendar--get-event-property event 'LOCATION) "")
|
||
(or (icalendar--get-event-property event 'ORGANIZER) "")
|
||
(or (icalendar--get-event-property event 'STATUS) "")
|
||
(or (icalendar--get-event-property event 'URL) "")
|
||
(or (icalendar--get-event-property event 'CLASS) "")))
|
||
|
||
) ; Closes the top-level `with-suppressed-warnings' form above
|
||
|
||
;; Obsolete
|
||
|
||
(defconst icalendar-version "0.19" "Version number of icalendar.el.")
|
||
(make-obsolete-variable 'icalendar-version 'emacs-version "28.1")
|
||
|
||
(provide 'icalendar)
|
||
|
||
;; Local Variables:
|
||
;; read-symbol-shorthands: (("ical:" . "icalendar-"))
|
||
;; End:
|
||
;;; icalendar.el ends here
|