diff --git a/org-gcal.el b/org-gcal.el index 043b439..34f2082 100644 --- a/org-gcal.el +++ b/org-gcal.el @@ -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. @@ -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 @@ -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))) @@ -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) @@ -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." @@ -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))))))) @@ -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 @@ -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)) @@ -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") @@ -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