Skip to content

Commit

Permalink
Enable entries to be managed either by Org or Google Calendar
Browse files Browse the repository at this point in the history 
Fixes kidd#127.
  • Loading branch information
@telotortium
telotortium committed Mar 4, 2021
1 parent ff55b21 commit 673a9fb
Showing 1 changed file with 142 additions and 28 deletions.
170 changes: 142 additions & 28 deletions org-gcal.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -161,6 +161,66 @@ Note that whether a headline is removed is still controlled by
:group 'org-gcal
:type 'boolean)

(defcustom org-gcal-managed-newly-fetched-mode "gcal"
"Default value of ‘org-gcal-managed-property’ on newly-fetched events.
This is the value set on events fetched from a calendar by ‘org-gcal-sync’ and
‘org-gcal-fetch’.
Values:
- “org”: Event is intended to be managed primarily by org-gcal. These events
will be pushed to Google Calendar by ‘org-gcal-sync’, ‘org-gcal-sync-buffer’,
and ‘org-gcal-post-at-point’ if they have been modified in the Org file. If
the ETag is out of sync with Google Calendar, the Org headline will still be
updated from Google Calendar.
- “gcal”: Event is intended to be managed primarily by org-gcal. These events
will not be pushed to Google Calendar by bulk update functions like
‘org-gcal-sync’, ‘org-gcal-sync-buffer’. When running
‘org-gcal-post-at-point’, the user will be prompted to approve pushing the
event by default."
:group 'org-gcal
:type '(choice
(const :tag "Event managed on Google Calendar" "gcal")
(const :tag "Event managed in Org file" "org")))

(defcustom org-gcal-managed-update-existing-mode "gcal"
"Default value of ‘org-gcal-managed-property’ for existing events without it.
This is the value set on existing entries containing calendar events when they
are updated by ‘org-gcal-sync’, ‘org-gcal-fetch', or ‘org-gcal-post-at-point’
and don’t yet have a value for ‘org-gcal-managed-property’ set.
Values: see ‘org-gcal-managed-newly-fetched-mode’."
:group 'org-gcal
:type '(choice
(const :tag "Event managed on Google Calendar" "gcal")
(const :tag "Event managed in Org file" "org")))

(defcustom org-gcal-managed-create-from-entry-mode "org"
"Default value of ‘org-gcal-managed-property’ when creating event from entry.
This is the value set when ‘org-gcal-post-at-point’ creates a Google Calendar
event from an Org-mode entry. This is used when ‘org-gcal-calendar-id-property’
or ‘org-gcal-entry-id-property’ is missing from an entry. If these are present,
‘org-gcal-managed-update-existing-mode’ is used instead.
Values: see ‘org-gcal-managed-newly-fetched-mode’."
:group 'org-gcal
:type '(choice
(const :tag "Event managed on Google Calendar" "gcal")
(const :tag "Event managed in Org file" "org")))

(defcustom org-gcal-managed-post-at-point-update-existing 'prompt
"Behavior when running ‘org-gcal-post-at-point’ on existing entries."

:group 'org-gcal
:type '(choice
(const :tag "Never push to Google Calendar" 'never-push)
(const :tag "Prompt whether to push to Google Calendar if run manually, never push during syncs" 'prompt)
(const :tag "Prompt whether to push to Google Calendar, even during syncs" 'prompt-sync)
(const :tag "Always push to Google Calendar" 'always-push)))

(defcustom org-gcal-recurring-events-mode 'top-level
"How to treat instances of recurring events not already fetched.
Expand Down Expand Up @@ -192,6 +252,13 @@ Org-mode property on org-gcal entries that records the ETag."
:group 'org-gcal
:type 'string)

(defcustom org-gcal-managed-property "org-gcal-managed"
" Org-mode property on org-gcal entries that records how an event is managed.
For values the property can take, see ‘org-gcal-managed-newly-fetched-mode’."
:group 'org-gcal
:type 'string)

(defcustom org-gcal-drawer-name "org-gcal"
"\
Name of drawer in which event time and description are stored on org-gcal
Expand Down Expand Up @@ -618,7 +685,10 @@ Any parent recurring events are appended in-place to the list PARENT-EVENTS."
;; default fetch file.
(atomic-change-group
(insert "\n* ")
(org-gcal--update-entry calendar-id event))
(org-with-point-at (point)
(org-gcal--update-entry calendar-id event)
(org-entry-put (point) org-gcal-managed-property
org-gcal-managed-newly-fetched-mode)))
nil)))
collect it)))

Expand All @@ -645,7 +715,8 @@ have been moved from the default fetch file. CALENDAR-ID is defined in
(progn
(org-gcal--update-entry calendar-id event)
(deferred:succeed nil))
(org-gcal-post-at-point nil skip-export))))
(org-gcal-post-at-point nil skip-export
(org-gcal--sync-get-update-existing)))))
;; Log but otherwise ignore errors.
(deferred:error it
(lambda (err)
Expand All @@ -661,6 +732,12 @@ have been moved from the default fetch file. CALENDAR-ID is defined in
(interactive)
(setq org-gcal--sync-lock nil))

(defun org-gcal--sync-get-update-existing ()
"Obtain value of ‘org-gcal-managed-post-at-point-update-existing’ for syncs."
(if (equal org-gcal-managed-post-at-point-update-existing 'prompt)
'never-push
org-gcal-managed-post-at-point-update-existing))

;;;###autoload
(defun org-gcal-fetch ()
"Fetch event data from google calendar."
Expand Down Expand Up @@ -720,7 +797,8 @@ Set SILENT to non-nil to inhibit notifications."
(org-with-point-at marker
(set-marker marker nil)
(deferred:$
(org-gcal-post-at-point nil skip-export)
(org-gcal-post-at-point nil skip-export
(org-gcal--sync-get-update-existing))
(deferred:error it
(lambda (err)
(message "org-gcal-sync-buffer: error: %s" err)))))))
Expand Down Expand Up @@ -936,15 +1014,17 @@ This will also update the stored ID locations using
(list :start start :end end :desc desc)))

;;;###autoload
(defun org-gcal-post-at-point (&optional skip-import skip-export)
"\
Post entry at point to current calendar. This overwrites the event on the
server with the data from the entry, except if the ‘org-gcal-etag-property’ is
present and is out of sync with the server, in which case the entry is
overwritten with data from the server instead.
(defun org-gcal-post-at-point (&optional skip-import skip-export existing-mode)
"Post entry at point to current calendar.
If SKIP-IMPORT is not nil, don’t overwrite the entry with data from the server.
If SKIP-EXPORT is not nil, don’t overwrite the event on the server."
This overwrites the event on the server with the data from the entry, except if
the ‘org-gcal-etag-property’ is present and is out of sync with the server, in
which case the entry is overwritten with data from the server instead.
If SKIP-IMPORT is not nil, don’t overwrite the entry with data from the server.
If SKIP-EXPORT is not nil, don’t overwrite the event on the server.
For valid values of EXISTING-MODE see
‘org-gcal-managed-post-at-point-update-existing'."
(interactive)
(org-gcal--ensure-token)
(save-excursion
Expand All @@ -964,14 +1044,42 @@ This will also update the stored ID locations using
(recurrence (org-entry-get (point) "recurrence"))
(event-id (org-gcal--get-id (point)))
(etag (org-entry-get (point) org-gcal-etag-property))
(managed (org-entry-get (point) org-gcal-managed-property))
(calendar-id
(org-entry-get (point) org-gcal-calendar-id-property)))
;; Set ‘org-gcal-managed-property’ if not present.
(unless (and managed (member managed '("org" "gcal")))
(let ((x
(if (and calendar-id event-id)
org-gcal-managed-update-existing-mode
org-gcal-managed-create-from-entry-mode)))
(org-entry-put (point) org-gcal-managed-property x)
(setq managed x)))
;; Fill in Calendar ID if not already present.
(unless calendar-id
(setq calendar-id
(completing-read "Calendar ID: "
(mapcar #'car org-gcal-file-alist)))
(org-entry-put (point) org-gcal-calendar-id-property calendar-id))
(when (equal managed "gcal")
(unless existing-mode
(setq existing-mode org-gcal-managed-post-at-point-update-existing))
(pcase existing-mode
('never-push
(setq skip-export t))
;; PROMPT and PROMPT-SYNC are handled identically here. When syncing
;; PROMPT is mapped to NEVER-PUSH in the calling function, while
;; PROMPT-SYNC is left unchanged.
;; Only when manually running ‘org-gcal-post-at-point’ should PROMPT
;; be seen here.
((or 'prompt 'prompt-sync)
(unless (y-or-n-p (format "Push event to Google Calendar?\n\n%s\n\n"
smry))
(setq skip-export t)))
('always-push nil)
(val
(user-error "Bad value %S of EXISTING-MODE passed to ‘org-gcal-post-at-point’. For valid values see ‘org-gcal-managed-post-at-point-update-existing’."
val))))
;; Read currently-present start and end times and description. Fill in a
;; reasonable start and end time if either is missing.
(let* ((time-desc (org-gcal--get-time-and-desc))
Expand Down Expand Up @@ -1580,12 +1688,16 @@ Returns a ‘deferred’ object that can be used to wait for completion."
(a-token (or a-token (org-gcal--get-access-token))))
(deferred:try
(deferred:$
(request-deferred
(apply
#'request-deferred
(concat
(org-gcal-events-url calendar-id)
(when (and event-id etag)
(concat "/" event-id)))
:type (if event-id "PATCH" "POST")
:type (cond
(skip-export "GET")
(event-id "PATCH")
(t "POST"))
:headers (append
`(("Content-Type" . "application/json")
("Accept" . "application/json")
Expand All @@ -1596,21 +1708,23 @@ Returns a ‘deferred’ object that can be used to wait for completion."
(error "Event cannot have ETag set when event ID absent"))
(t
`(("If-Match" . ,etag)))))
:data (encode-coding-string
(json-encode
(append
`(("summary" . ,smry)
("location" . ,loc)
("description" . ,desc))
(if (and start end)
`(("start" (,stime . ,start) (,stime-alt . nil))
("end" (,etime . ,(if (equal "date" etime)
(org-gcal--iso-next-day end)
end))
(,etime-alt . nil)))
nil)))
'utf-8)
:parser 'org-gcal--json-read)
:parser 'org-gcal--json-read
(unless skip-export
(list
:data (encode-coding-string
(json-encode
(append
`(("summary" . ,smry)
("location" . ,loc)
("description" . ,desc))
(if (and start end)
`(("start" (,stime . ,start) (,stime-alt . nil))
("end" (,etime . ,(if (equal "date" etime)
(org-gcal--iso-next-day end)
end))
(,etime-alt . nil)))
nil)))
'utf-8))))
(deferred:nextc it
(lambda (response)
(let
Expand Down

0 comments on commit 673a9fb

Please sign in to comment.