diff --git a/org-gcal-pkg.el b/org-gcal-pkg.el index a004b84..2a2a6cf 100644 --- a/org-gcal-pkg.el +++ b/org-gcal-pkg.el @@ -1,12 +1,12 @@ ;; Keep in sync with Package-Requires lines in the package files. (define-package "org-gcal" "0.5.0" "Org sync with Google Calendar" - '((aio "1.0") - (alert "1.2") - (elnode "20190702.1509") - (emacs "26.1") - (iter2 "1.0") - (org "9.3") - (persist "0.4") - (request "20190901") - (request-deferred "20181129"))) + '((aio "1.0") + (alert "1.2") + (elnode "20190702.1509") + (emacs "26.1") + (iter2 "1.0") + (org "9.3") + (persist "0.4") + (request "20190901") + (request-deferred "20181129"))) diff --git a/org-gcal.el b/org-gcal.el index 032fad5..c862665 100644 --- a/org-gcal.el +++ b/org-gcal.el @@ -329,8 +329,8 @@ Returns a URL for recurrent event EVENT-ID on calendar CALENDAR-ID." event) (persist-defvar - org-gcal--sync-tokens nil - "Storage for Calendar API sync tokens, used for performing incremental sync. + org-gcal--sync-tokens nil + "Storage for Calendar API sync tokens, used for performing incremental sync. This is a a hash table mapping calendar IDs (as given in ‘org-gcal-fetch-file-alist’) to a list (EXPIRES SYNC-TOKEN). EXPIRES is an @@ -369,36 +369,36 @@ AIO version: ‘org-gcal-sync-aio'." (let ((up-time (org-gcal--up-time)) (down-time (org-gcal--down-time))) (deferred:try - (deferred:$ ; Migrated to AIO - (deferred:loop org-gcal-fetch-file-alist - (lambda (calendar-id-file) - (deferred:$ ; Migrated to AIO - (org-gcal--sync-calendar calendar-id-file skip-export silent - up-time down-time) - (deferred:succeed nil) - (deferred:nextc it - (lambda (_) - (org-gcal--notify "Completed event fetching ." - (concat "Events fetched into\n" - (cdr calendar-id-file)) - silent) - (deferred:succeed nil)))))) - ;; After syncing new events to Org, sync existing events in Org. - (deferred:nextc it - (lambda (_) - (org-generic-id-update-id-locations org-gcal-entry-id-property) - (when t - (mapc - (lambda (file) - (with-current-buffer (find-file-noselect file 'nowarn) - (org-with-wide-buffer - (org-gcal--sync-unlock) - (org-gcal-sync-buffer skip-export silent 'filter-time - 'filter-managed)))) - (org-generic-id-files)))))) - :finally - (lambda () - (org-gcal--sync-unlock))))) + (deferred:$ ; Migrated to AIO + (deferred:loop org-gcal-fetch-file-alist + (lambda (calendar-id-file) + (deferred:$ ; Migrated to AIO + (org-gcal--sync-calendar calendar-id-file skip-export silent + up-time down-time) + (deferred:succeed nil) + (deferred:nextc it + (lambda (_) + (org-gcal--notify "Completed event fetching ." + (concat "Events fetched into\n" + (cdr calendar-id-file)) + silent) + (deferred:succeed nil)))))) + ;; After syncing new events to Org, sync existing events in Org. + (deferred:nextc it + (lambda (_) + (org-generic-id-update-id-locations org-gcal-entry-id-property) + (when t + (mapc + (lambda (file) + (with-current-buffer (find-file-noselect file 'nowarn) + (org-with-wide-buffer + (org-gcal--sync-unlock) + (org-gcal-sync-buffer skip-export silent 'filter-time + 'filter-managed)))) + (org-generic-id-files)))))) + :finally + (lambda () + (org-gcal--sync-unlock))))) ;;;###autoload (defun org-gcal-sync-aio () @@ -433,17 +433,17 @@ SKIP-EXPORT. Set SILENT to non-nil to inhibit notifications." calendar-id-file skip-export silent up-time down-time)))) (org-gcal-tmp-dbgmsg "result: %S" x)) (org-gcal-tmp-dbgmsg "Processing done: %S" calendar-id-file)) - ;; (let* - ;; ((promises - ;; (cl-loop for calendar-id-file in org-gcal-fetch-file-alist - ;; collect - ;; (org-gcal--sync-calendar-promise - ;; calendar-id-file skip-export silent up-time down-time))) - ;; (select (aio-make-select promises))) - ;; (cl-loop repeat (length promises) - ;; for next = (aio-await (aio-select select)) - ;; do (aio-await next)) - ;; nil) + ;; (let* + ;; ((promises + ;; (cl-loop for calendar-id-file in org-gcal-fetch-file-alist + ;; collect + ;; (org-gcal--sync-calendar-promise + ;; calendar-id-file skip-export silent up-time down-time))) + ;; (select (aio-make-select promises))) + ;; (cl-loop repeat (length promises) + ;; for next = (aio-await (aio-select select)) + ;; do (aio-await next)) + ;; nil) ((debug t) (org-gcal--sync-unlock) (org-gcal--notify @@ -464,13 +464,13 @@ For CALENDAR-ID-FILE SKIP-EXPORT SILENT UP-TIME DOWN-TIME see that function." up-time down-time)) (org-gcal--notify "Completed event fetching ." (concat "Events fetched into\n" - (cdr calendar-id-file)) + (cdr calendar-id-file)) silent) (org-gcal-tmp-dbgmsg "returning nil") (lambda () nil)) (defun org-gcal--sync-calendar (calendar-id-file skip-export silent - up-time down-time) + up-time down-time) "Sync events for CALENDAR-ID-FILE. CALENDAR-ID-FILE is a cons in ‘org-gcal-fetch-file-alist’, for which see. For @@ -484,40 +484,40 @@ AIO version: ‘org-gcal--sync-calendar-aio’." ;; element. (parent-events (list 'dummy))) (deferred:try - (deferred:$ ; Migrated to AIO - (org-gcal--sync-calendar-events - calendar-id-file skip-export silent nil up-time down-time parent-events) - (deferred:nextc it - (lambda (_) - (deferred:loop - ;; Strip dummy first element and remove duplicates - (cl-remove-duplicates (cdr parent-events) :test #'string=) - (lambda (parent-event-id) - (when (eq org-gcal-recurring-events-mode 'nested) - ;; Catch - (deferred:try ; Migrated to AIO - (deferred:$ - (org-gcal--sync-event - calendar-id-file parent-event-id skip-export) - (org-gcal--sync-instances - calendar-id-file parent-event-id skip-export silent nil - up-time down-time)) - :catch - (lambda (err) - (org-gcal--notify - (format - "org-gcal--sync-calendar(calendar-id-file=%S)" - calendar-id-file) - (format - "for parent-event-id %S: error: %S" - parent-event-id err)))))))))) - :catch - (lambda (err) - (org-gcal--notify - (format - "org-gcal--sync-calendar(calendar-id-file=%S)" - calendar-id-file) - (format "error: %S" err)))))) + (deferred:$ ; Migrated to AIO + (org-gcal--sync-calendar-events + calendar-id-file skip-export silent nil up-time down-time parent-events) + (deferred:nextc it + (lambda (_) + (deferred:loop + ;; Strip dummy first element and remove duplicates + (cl-remove-duplicates (cdr parent-events) :test #'string=) + (lambda (parent-event-id) + (when (eq org-gcal-recurring-events-mode 'nested) + ;; Catch + (deferred:try ; Migrated to AIO + (deferred:$ + (org-gcal--sync-event + calendar-id-file parent-event-id skip-export) + (org-gcal--sync-instances + calendar-id-file parent-event-id skip-export silent nil + up-time down-time)) + :catch + (lambda (err) + (org-gcal--notify + (format + "org-gcal--sync-calendar(calendar-id-file=%S)" + calendar-id-file) + (format + "for parent-event-id %S: error: %S" + parent-event-id err)))))))))) + :catch + (lambda (err) + (org-gcal--notify + (format + "org-gcal--sync-calendar(calendar-id-file=%S)" + calendar-id-file) + (format "error: %S" err)))))) (aio-iter2-defun org-gcal--sync-calendar-aio (calendar-id-file skip-export silent up-time down-time) @@ -547,7 +547,7 @@ Returns a promise to wait for completion." (defun org-gcal--sync-calendar-events (calendar-id-file skip-export silent page-token up-time down-time - parent-events) + parent-events) "Sync events for CALENDAR-ID-FILE. CALENDAR-ID-FILE is a cons in ‘org-gcal-fetch-file-alist’, for which see. For @@ -561,33 +561,33 @@ AIO version: ‘org-gcal--sync-calendar-events-aio'" (calendar-file (cdr calendar-id-file)) (page-token-cons '(dummy))) (deferred:$ ; Migrated to AIO - (org-gcal--sync-request-events calendar-id page-token up-time down-time) - (deferred:nextc it - (lambda (response) - (let ((retry-fn - (lambda () - (org-gcal--sync-calendar-events - calendar-id-file skip-export silent page-token - up-time down-time parent-events)))) - (org-gcal--sync-handle-response - response calendar-id-file page-token-cons down-time retry-fn)))) - (deferred:nextc it - (lambda (events) - (org-gcal--sync-handle-events calendar-id calendar-file - events nil up-time down-time - parent-events))) - (deferred:nextc it - (lambda (entries) - (org-gcal--sync-update-entries calendar-id entries skip-export))) - ;; Retrieve the next page of results if needed. - (deferred:nextc it - (lambda (_) - (let ((pt (car (last page-token-cons)))) - (if pt - (org-gcal--sync-calendar-events - calendar-id-file skip-export silent pt - up-time down-time parent-events) - (deferred:succeed nil)))))))) + (org-gcal--sync-request-events calendar-id page-token up-time down-time) + (deferred:nextc it + (lambda (response) + (let ((retry-fn + (lambda () + (org-gcal--sync-calendar-events + calendar-id-file skip-export silent page-token + up-time down-time parent-events)))) + (org-gcal--sync-handle-response + response calendar-id-file page-token-cons down-time retry-fn)))) + (deferred:nextc it + (lambda (events) + (org-gcal--sync-handle-events calendar-id calendar-file + events nil up-time down-time + parent-events))) + (deferred:nextc it + (lambda (entries) + (org-gcal--sync-update-entries calendar-id entries skip-export))) + ;; Retrieve the next page of results if needed. + (deferred:nextc it + (lambda (_) + (let ((pt (car (last page-token-cons)))) + (if pt + (org-gcal--sync-calendar-events + calendar-id-file skip-export silent pt + up-time down-time parent-events) + (deferred:succeed nil)))))))) (aio-iter2-defun org-gcal--sync-calendar-events-aio (calendar-id-file skip-export silent page-token up-time down-time @@ -641,33 +641,33 @@ AIO version: ‘org-gcal--sync-instances-aio'" (calendar-file (cdr calendar-id-file)) (page-token-cons '(dummy))) (deferred:$ ; Migrated to AIO - (org-gcal--sync-request-instances calendar-id parent-event-id - up-time down-time page-token) - (deferred:nextc it - (lambda (response) - (let ((retry-fn - (lambda () - (org-gcal--sync-instances - calendar-id-file parent-event-id skip-export silent - page-token up-time down-time)))) - (org-gcal--sync-handle-response - response calendar-id-file page-token-cons down-time retry-fn)))) - (deferred:nextc it - (lambda (events) - (org-gcal--sync-handle-events calendar-id calendar-file - events t up-time down-time nil))) - (deferred:nextc it - (lambda (entries) - (org-gcal--sync-update-entries calendar-id entries skip-export))) - ;; Retrieve the next page of results if needed. - (deferred:nextc it - (lambda (_) - (let ((pt (car (last page-token-cons)))) - (if pt - (org-gcal--sync-instances - calendar-id-file parent-event-id skip-export silent - pt up-time down-time) - (deferred:succeed nil)))))))) + (org-gcal--sync-request-instances calendar-id parent-event-id + up-time down-time page-token) + (deferred:nextc it + (lambda (response) + (let ((retry-fn + (lambda () + (org-gcal--sync-instances + calendar-id-file parent-event-id skip-export silent + page-token up-time down-time)))) + (org-gcal--sync-handle-response + response calendar-id-file page-token-cons down-time retry-fn)))) + (deferred:nextc it + (lambda (events) + (org-gcal--sync-handle-events calendar-id calendar-file + events t up-time down-time nil))) + (deferred:nextc it + (lambda (entries) + (org-gcal--sync-update-entries calendar-id entries skip-export))) + ;; Retrieve the next page of results if needed. + (deferred:nextc it + (lambda (_) + (let ((pt (car (last page-token-cons)))) + (if pt + (org-gcal--sync-instances + calendar-id-file parent-event-id skip-export silent + pt up-time down-time) + (deferred:succeed nil)))))))) (aio-iter2-defun org-gcal--sync-instances-aio (calendar-id-file parent-event-id skip-export silent page-token @@ -724,16 +724,16 @@ AIO version: ‘org-gcal--sync-event-aio'" (calendar-file (cdr calendar-id-file))) (deferred:$ ; Migrated to AIO - (org-gcal--get-event calendar-id event-id) - (deferred:nextc it - (lambda (event) (vector (request-response-data event)))) - (deferred:nextc it - (lambda (events) - (org-gcal--sync-handle-events calendar-id calendar-file - events nil nil nil nil))) - (deferred:nextc it - (lambda (entries) - (org-gcal--sync-update-entries calendar-id entries skip-export)))))) + (org-gcal--get-event calendar-id event-id) + (deferred:nextc it + (lambda (event) (vector (request-response-data event)))) + (deferred:nextc it + (lambda (events) + (org-gcal--sync-handle-events calendar-id calendar-file + events nil nil nil nil))) + (deferred:nextc it + (lambda (entries) + (org-gcal--sync-update-entries calendar-id entries skip-export)))))) (aio-iter2-defun org-gcal--sync-event-aio (calendar-id-file event-id skip-export) @@ -849,7 +849,7 @@ AIO version: ‘org-gcal--sync-request-instances-aio'" :parser 'org-gcal--json-read)) (aio-iter2-defun org-gcal--sync-request-instances-aio - (calendar-id event-id up-time down-time page-token) + (calendar-id event-id up-time down-time page-token) "Request instances of recurring event EVENT-ID on CALENDAR-ID." (aio-await (org-gcal--aio-request-catch-error @@ -898,10 +898,10 @@ AIO version: ‘org-gcal--sync-handle-response-aio'" "Received HTTP 401" "OAuth token expired. Now trying to refresh-token") (deferred:$ - (org-gcal--refresh-token calendar-id) - (deferred:nextc it - (lambda (_unused) - (funcall retry-fn))))) + (org-gcal--refresh-token calendar-id) + (deferred:nextc it + (lambda (_unused) + (funcall retry-fn))))) ((eq 403 status-code) (org-gcal--notify "Received HTTP 403" "Ensure you enabled the Calendar API through the Developers Console, then try again.") @@ -1021,7 +1021,7 @@ call this function again with the same arguments as before." (defun org-gcal--sync-handle-events (calendar-id calendar-file events recurring-instances? up-time down-time - parent-events) + parent-events) "Handle a list of EVENTS fetched from the Calendar API. CALENDAR-ID and CALENDAR-FILE are defined in ‘org-gcal--sync-inner'. @@ -1108,8 +1108,8 @@ AIO version: ‘org-gcal--sync-handle-events-aio'" collect it))) (aio-iter2-defun org-gcal--sync-handle-events-aio - (calendar-id calendar-file events recurring-instances? up-time down-time - parent-events) + (calendar-id calendar-file events recurring-instances? up-time down-time + parent-events) "Handle a list of EVENTS fetched from the Calendar API. CALENDAR-ID and CALENDAR-FILE are defined in ‘org-gcal--sync-inner'. @@ -1202,29 +1202,29 @@ have been moved from the default fetch file. CALENDAR-ID is defined in AIO version: ‘org-gcal--sync-update-entries-aio'" (deferred:$ ; Migrated to AIO - (deferred:loop entries - (lambda (entry) - (deferred:$ ; Migrated to AIO - (let ((marker (or (org-gcal--event-entry-marker entry) - (org-gcal--id-find (org-gcal--event-entry-entry-id entry)))) - (event (org-gcal--event-entry-event entry))) - (org-with-point-at marker - ;; If skipping exports, just overwrite current entry's - ;; calendar data with what's been retrieved from the - ;; server. Otherwise, sync the entry at the current - ;; point. - (set-marker marker nil) - (if (and skip-export event) - (progn - (org-gcal--update-entry calendar-id event 'update-existing) - (deferred:succeed nil)) - (org-gcal-post-at-point nil skip-export - (org-gcal--sync-get-update-existing))))) - ;; Log but otherwise ignore errors. - (deferred:error it - (lambda (err) - (message "org-gcal-sync: error: %s" err)))))) - (deferred:succeed nil))) + (deferred:loop entries + (lambda (entry) + (deferred:$ ; Migrated to AIO + (let ((marker (or (org-gcal--event-entry-marker entry) + (org-gcal--id-find (org-gcal--event-entry-entry-id entry)))) + (event (org-gcal--event-entry-event entry))) + (org-with-point-at marker + ;; If skipping exports, just overwrite current entry's + ;; calendar data with what's been retrieved from the + ;; server. Otherwise, sync the entry at the current + ;; point. + (set-marker marker nil) + (if (and skip-export event) + (progn + (org-gcal--update-entry calendar-id event 'update-existing) + (deferred:succeed nil)) + (org-gcal-post-at-point nil skip-export + (org-gcal--sync-get-update-existing))))) + ;; Log but otherwise ignore errors. + (deferred:error it + (lambda (err) + (message "org-gcal-sync: error: %s" err)))))) + (deferred:succeed nil))) (aio-iter2-defun org-gcal--sync-update-entries-aio (calendar-id entries skip-export) "Update headlines given by ‘org-gcal--event-entry’ ENTRIES. @@ -1299,20 +1299,20 @@ AIO version: see ‘org-gcal-sync-buffer-aio'." (let* ((name (or (buffer-file-name) (buffer-name)))) (deferred:try - (deferred:$ ; Migrated to AIO - (org-gcal--sync-buffer-inner skip-export silent filter-date - filter-managed - (point-min-marker)) - (deferred:nextc it - (lambda (_) - (org-gcal--notify "Completed syncing events in buffer." - (concat "Events synced in\n" name) - silent) - (deferred:succeed nil)))) - :finally - (lambda () - (org-generic-id-update-id-locations org-gcal-entry-id-property) - (org-gcal--sync-unlock))))) + (deferred:$ ; Migrated to AIO + (org-gcal--sync-buffer-inner skip-export silent filter-date + filter-managed + (point-min-marker)) + (deferred:nextc it + (lambda (_) + (org-gcal--notify "Completed syncing events in buffer." + (concat "Events synced in\n" name) + silent) + (deferred:succeed nil)))) + :finally + (lambda () + (org-generic-id-update-id-locations org-gcal-entry-id-property) + (org-gcal--sync-unlock))))) ;;;###autoload (defun org-gcal-sync-buffer-aio () @@ -1374,106 +1374,106 @@ AIO version: see ‘org-gcal--sync-buffer-inner-aio’." (not (catch 'block (deferred:$ ; Migrated to AIO - (deferred:succeed nil) - (deferred:nextc it - ;; Returns (wrapped in deferred object): - ;; - marker within current headline if there are still headlines - ;; left in the file. - ;; - nil if there are no more headlines. - (lambda (_) - (org-gcal--with-point-at-no-widen marker - ;; By default set next position of marker to nil. We’ll set it below if - ;; there remains more to edit. - (setq marker nil) - (let* ((drawer-point - (lambda () - (re-search-forward - (format "^[ \t]*:%s:[ \t]*$" org-gcal-drawer-name) - (point-max) - 'noerror))) - (marker-for-post - (cond - ((eq major-mode 'org-mode) - (when (funcall drawer-point) - (setq marker (point-marker)) - marker)) - ((eq major-mode 'org-agenda-mode) - (while (and (not marker) (not (eobp))) - (when-let ((agenda-marker (point-marker)) - (org-marker (org-get-at-bol 'org-hd-marker))) - (org-with-point-at org-marker - (org-narrow-to-element) - (when (funcall drawer-point) - (setq marker agenda-marker) - (point-marker))))) - ;; If org-marker isn’t found on this line, go to the next one. - (forward-line 1)) - (t - (user-error "Unsupported major mode %s in current buffer" - major-mode))))) - (if (and marker marker-for-post) - (org-with-point-at marker-for-post - (let* ((time-desc (org-gcal--get-time-and-desc)) - (start - (plist-get time-desc :start)) - (start - (and start - (org-gcal--parse-calendar-time-string start))) - (end (plist-get time-desc :end)) - (end - (and end - (org-gcal--parse-calendar-time-string end)))) - (if - ;; Skip posting the headline under these - ;; conditions - (or - ;; Don’t sync events if ‘filter-date’ is set - ;; and event is too far in the past or - ;; future. - (and filter-date - (or - (not start) (not end) - (time-less-p start (org-gcal--up-time)) - (time-less-p (org-gcal--down-time) end))) - ;; Don’t sync if ‘filter-managed’ is set and - ;; headline is not managed by Org (see - ;; ‘org-gcal-managed-property') - (and filter-managed - (not - (string= - "org" - (org-entry-get - (point) - org-gcal-managed-property))))) - (deferred:succeed marker) - (deferred:try - (deferred:$ ; Migrated to AIO - ;; Try to avoid hanging Emacs during - ;; interactive use by waiting until Emacs is - ;; idle. - (deferred:wait-idle 1000) - (deferred:nextc it - (lambda (_) - (org-with-point-at marker-for-post - (org-gcal-post-at-point nil skip-export - (org-gcal--sync-get-update-existing)))))) - :catch - (lambda (err) - (message "org-gcal-sync-buffer: at %S event %S: error: %s" - marker-for-post time-desc err)) - :finally - (lambda (_) - (deferred:succeed marker)))))) - (deferred:succeed nil)))))) - (deferred:nextc it - (lambda (m) - (when m - (setq marker m) - (throw 'block nil)) - (deferred:succeed nil))) - (deferred:error it - (lambda (err) - (message "org-gcal-sync-buffer: error: %s" err))))))) + (deferred:succeed nil) + (deferred:nextc it + ;; Returns (wrapped in deferred object): + ;; - marker within current headline if there are still headlines + ;; left in the file. + ;; - nil if there are no more headlines. + (lambda (_) + (org-gcal--with-point-at-no-widen marker + ;; By default set next position of marker to nil. We’ll set it below if + ;; there remains more to edit. + (setq marker nil) + (let* ((drawer-point + (lambda () + (re-search-forward + (format "^[ \t]*:%s:[ \t]*$" org-gcal-drawer-name) + (point-max) + 'noerror))) + (marker-for-post + (cond + ((eq major-mode 'org-mode) + (when (funcall drawer-point) + (setq marker (point-marker)) + marker)) + ((eq major-mode 'org-agenda-mode) + (while (and (not marker) (not (eobp))) + (when-let ((agenda-marker (point-marker)) + (org-marker (org-get-at-bol 'org-hd-marker))) + (org-with-point-at org-marker + (org-narrow-to-element) + (when (funcall drawer-point) + (setq marker agenda-marker) + (point-marker))))) + ;; If org-marker isn’t found on this line, go to the next one. + (forward-line 1)) + (t + (user-error "Unsupported major mode %s in current buffer" + major-mode))))) + (if (and marker marker-for-post) + (org-with-point-at marker-for-post + (let* ((time-desc (org-gcal--get-time-and-desc)) + (start + (plist-get time-desc :start)) + (start + (and start + (org-gcal--parse-calendar-time-string start))) + (end (plist-get time-desc :end)) + (end + (and end + (org-gcal--parse-calendar-time-string end)))) + (if + ;; Skip posting the headline under these + ;; conditions + (or + ;; Don’t sync events if ‘filter-date’ is set + ;; and event is too far in the past or + ;; future. + (and filter-date + (or + (not start) (not end) + (time-less-p start (org-gcal--up-time)) + (time-less-p (org-gcal--down-time) end))) + ;; Don’t sync if ‘filter-managed’ is set and + ;; headline is not managed by Org (see + ;; ‘org-gcal-managed-property') + (and filter-managed + (not + (string= + "org" + (org-entry-get + (point) + org-gcal-managed-property))))) + (deferred:succeed marker) + (deferred:try + (deferred:$ ; Migrated to AIO + ;; Try to avoid hanging Emacs during + ;; interactive use by waiting until Emacs is + ;; idle. + (deferred:wait-idle 1000) + (deferred:nextc it + (lambda (_) + (org-with-point-at marker-for-post + (org-gcal-post-at-point nil skip-export + (org-gcal--sync-get-update-existing)))))) + :catch + (lambda (err) + (message "org-gcal-sync-buffer: at %S event %S: error: %s" + marker-for-post time-desc err)) + :finally + (lambda (_) + (deferred:succeed marker)))))) + (deferred:succeed nil)))))) + (deferred:nextc it + (lambda (m) + (when m + (setq marker m) + (throw 'block nil)) + (deferred:succeed nil))) + (deferred:error it + (lambda (err) + (message "org-gcal-sync-buffer: error: %s" err))))))) (deferred:succeed nil)) (aio-iter2-defun org-gcal--sync-buffer-inner-aio @@ -1637,11 +1637,11 @@ Calendar. For SILENT and FILTER-DATE see ‘org-gcal-sync-buffer’." "Log a debug message using ‘message’ with FORMAT-STRING and ARGS. Only logs when ‘org-gcal-debug’ is set." (when org-gcal-debug - (apply #'message (concat "[org-gcal-dbgmsg] " format-string) args))) + (apply #'message (concat "[org-gcal-dbgmsg] " format-string) args))) (defun org-gcal-tmp-dbgmsg (format-string &rest args) "Log a debug message using ‘message’ with FORMAT-STRING and ARGS. Meant to be removed before code merged upstream." - (apply #'message (concat "[org-gcal-tmp-dbgmsg] " format-string) args)) + (apply #'message (concat "[org-gcal-tmp-dbgmsg] " format-string) args)) (defun org-gcal--headline () "Get bare headline at current point." @@ -1751,7 +1751,7 @@ This will also update the stored ID locations using '(and string-start (submatch-n 1 - (1+ (not (any ?/ ?\n)))) + (1+ (not (any ?/ ?\n)))) ?/ (submatch-n 2 (1+ (not (any ?/ ?\n)))) string-end)) @@ -1782,9 +1782,9 @@ not present." ;; Parse :org-gcal: drawer for event time and description. (when (re-search-forward - (format "^[ \t]*:%s:[ \t]*$" org-gcal-drawer-name) - (save-excursion (outline-next-heading) (point)) - 'noerror) + (format "^[ \t]*:%s:[ \t]*$" org-gcal-drawer-name) + (save-excursion (outline-next-heading) (point)) + 'noerror) ;; First read any event time from the drawer if present. It's located ;; at the beginning of the drawer. (save-excursion @@ -2008,12 +2008,12 @@ Returns a promise to wait for completion." (org-with-point-at marker (org-gcal-tmp-dbgmsg "marker %S" marker) (org-gcal-tmp-dbgmsg "org-gcal-managed-post-at-point-update-existing: %S" - org-gcal-managed-post-at-point-update-existing) + org-gcal-managed-post-at-point-update-existing) ;; Post entry at point in org-agenda buffer. (when (eq major-mode 'org-agenda-mode) - (let ((m (org-get-at-bol 'org-hd-marker))) - (set-buffer (marker-buffer m)) - (goto-char (marker-position m)))) + (let ((m (org-get-at-bol 'org-hd-marker))) + (set-buffer (marker-buffer m)) + (goto-char (marker-position m)))) (end-of-line) (org-gcal--back-to-heading) (move-beginning-of-line nil) @@ -2027,9 +2027,9 @@ Returns a promise to wait for completion." (when-let ((link-string (or (org-entry-get (point) "link") (nth 0 - (org-entry-get-multivalued-property + (org-entry-get-multivalued-property (point) "ROAM_REFS"))))) - (org-gcal--source-from-link-string link-string))) + (org-gcal--source-from-link-string link-string))) (transparency (or (org-entry-get (point) "TRANSPARENCY") org-gcal-default-transparency)) (recurrence (org-entry-get (point) "recurrence")) @@ -2043,41 +2043,41 @@ Returns a promise to wait for completion." (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))) + 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 - ;; Completes read with prompts like "CALENDAR-FILE (CALENDAR-ID)", - ;; and then uses ‘replace-regexp-in-string’ to extract just - ;; CALENDAR-ID. - (replace-regexp-in-string - ".*(\\(.*?\\))$" "\\1" - (completing-read "Calendar ID: " - (mapcar - (lambda (x) (format "%s (%s)" (cdr x) (car x))) - org-gcal-fetch-file-alist)))) + ;; Completes read with prompts like "CALENDAR-FILE (CALENDAR-ID)", + ;; and then uses ‘replace-regexp-in-string’ to extract just + ;; CALENDAR-ID. + (replace-regexp-in-string + ".*(\\(.*?\\))$" "\\1" + (completing-read "Calendar ID: " + (mapcar + (lambda (x) (format "%s (%s)" (cdr x) (car x))) + org-gcal-fetch-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)) + (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 "Google Calendar event:\n\n%s\n\nPush to calendar?" - smry)) + ('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 "Google Calendar event:\n\n%s\n\nPush to calendar?" + 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)))) + ('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)) @@ -2085,28 +2085,28 @@ Returns a promise to wait for completion." (end (plist-get time-desc :end)) (desc (plist-get time-desc :desc))) (unless end - (let* ((start-time (or start (org-read-date 'with-time 'to-time))) - (min-duration 5) - (resolution 5) - (duration-default - (org-duration-from-minutes - (max - min-duration + (let* ((start-time (or start (org-read-date 'with-time 'to-time))) + (min-duration 5) + (resolution 5) + (duration-default + (org-duration-from-minutes + (max + min-duration ;; Round up to the nearest multiple of ‘resolution’ minutes. - (* resolution - (ceiling - (/ (- (org-duration-to-minutes - (or (org-element-property :EFFORT elem) "0:00")) - (org-clock-sum-current-item)) - resolution)))))) - (duration (read-from-minibuffer "Duration: " duration-default)) - (duration-minutes (org-duration-to-minutes duration)) - (duration-seconds (* 60 duration-minutes)) - (end-time (time-add start-time duration-seconds))) + (* resolution + (ceiling + (/ (- (org-duration-to-minutes + (or (org-element-property :EFFORT elem) "0:00")) + (org-clock-sum-current-item)) + resolution)))))) + (duration (read-from-minibuffer "Duration: " duration-default)) + (duration-minutes (org-duration-to-minutes duration)) + (duration-seconds (* 60 duration-minutes)) + (end-time (time-add start-time duration-seconds))) (setq start (org-gcal--format-time2iso start-time) - end (org-gcal--format-time2iso end-time)))) + end (org-gcal--format-time2iso end-time)))) (when recurrence - (setq start nil end nil)) + (setq start nil end nil)) (org-gcal-tmp-dbgmsg "About to call org-gcal--post-event-aio") (aio-await (org-gcal--post-event-aio @@ -2141,39 +2141,39 @@ delete calendar info from events on calendars you no longer have access to." (if (and event-id (y-or-n-p (format "Event to delete:\n\n%s\n\nReally delete?" smry))) (deferred:try - (org-gcal--delete-event calendar-id event-id etag (copy-marker marker)) - :catch - (lambda (err) - (org-gcal-tmp-dbgmsg "Setting delete-error to %S" err) - (setq delete-error err)) - :finally - (lambda (_unused) - ;; Only clear org-gcal from headline if successful or we were - ;; forced to. - (org-gcal-tmp-dbgmsg "clear-gcal-info delete-error: %S %S" - clear-gcal-info delete-error) - (when (or clear-gcal-info (null delete-error)) - ;; Delete :org-gcal: drawer after deleting event. This will preserve - ;; the ID for links, but will ensure functions in this module don’t - ;; identify the entry as a Calendar event. - (org-with-point-at marker - (when (re-search-forward - (format - "^[ \t]*:%s:[^z-a]*?\n[ \t]*:END:[ \t]*\n?" - (regexp-quote org-gcal-drawer-name)) - (save-excursion (outline-next-heading) (point)) - 'noerror) - (replace-match "" 'fixedcase)) - (org-entry-delete marker org-gcal-calendar-id-property) - (org-entry-delete marker org-gcal-entry-id-property)) - ;; Finally cancel and delete the event if this is configured. - (org-with-point-at marker - (org-back-to-heading) - (org-gcal--handle-cancelled-entry))) - (if delete-error - (error "org-gcal-delete-at-point: For %s %s: error: %S" - calendar-id event-id delete-error) - (deferred:succeed nil)))) + (org-gcal--delete-event calendar-id event-id etag (copy-marker marker)) + :catch + (lambda (err) + (org-gcal-tmp-dbgmsg "Setting delete-error to %S" err) + (setq delete-error err)) + :finally + (lambda (_unused) + ;; Only clear org-gcal from headline if successful or we were + ;; forced to. + (org-gcal-tmp-dbgmsg "clear-gcal-info delete-error: %S %S" + clear-gcal-info delete-error) + (when (or clear-gcal-info (null delete-error)) + ;; Delete :org-gcal: drawer after deleting event. This will preserve + ;; the ID for links, but will ensure functions in this module don’t + ;; identify the entry as a Calendar event. + (org-with-point-at marker + (when (re-search-forward + (format + "^[ \t]*:%s:[^z-a]*?\n[ \t]*:END:[ \t]*\n?" + (regexp-quote org-gcal-drawer-name)) + (save-excursion (outline-next-heading) (point)) + 'noerror) + (replace-match "" 'fixedcase)) + (org-entry-delete marker org-gcal-calendar-id-property) + (org-entry-delete marker org-gcal-entry-id-property)) + ;; Finally cancel and delete the event if this is configured. + (org-with-point-at marker + (org-back-to-heading) + (org-gcal--handle-cancelled-entry))) + (if delete-error + (error "org-gcal-delete-at-point: For %s %s: error: %S" + calendar-id event-id delete-error) + (deferred:succeed nil)))) (deferred:succeed nil))))) (defun org-gcal--get-access-token (calendar-id) @@ -2280,16 +2280,16 @@ Return promise for the new access token." (goto-char (point-min)) (while (re-search-forward org-heading-regexp nil t) (let ((properties (org-entry-properties))) - ; Check if headline is managed by `org-gcal', and hasn't been archived - ; yet. Only in that case, potentially archive. + ; Check if headline is managed by `org-gcal', and hasn't been archived + ; yet. Only in that case, potentially archive. (when (and (assoc "ORG-GCAL-MANAGED" properties) (not (assoc "ARCHIVE_TIME" properties))) - ; Go to beginning of line to parse the headline + ; Go to beginning of line to parse the headline (beginning-of-line) (let ((elem (org-element-headline-parser (point-max) t))) - ; Go to next timestamp to parse it + ; Go to next timestamp to parse it (condition-case nil (goto-char (cdr (org-gcal--timestamp-successor))) (error (error "Org-gcal error: Couldn't parse %s" @@ -2329,7 +2329,7 @@ Return promise for the new access token." (insert-file-contents file) (goto-char (point-min)) (condition-case nil - (read (current-buffer)) + (read (current-buffer)) (end-of-file nil)))) (defun org-gcal--json-read () @@ -2406,7 +2406,7 @@ Emacs encoded time is the format returned by ‘encode-time’." ;; nil. ‘encode-time’ can’t tolerate that, so instead set the time ;; to 00:00:00. `(0 0 0 . - ,(nthcdr 3 (parse-time-string time-string)))))) + ,(nthcdr 3 (parse-time-string time-string)))))) (defun org-gcal--down-time () "Convert ‘org-gcal-down-days’ to Emacs encoded time." @@ -2727,52 +2727,52 @@ object. AIO version: ‘org-gcal--get-event-aio’." (let* ((a-token (org-gcal--get-access-token calendar-id))) (deferred:$ - (request-deferred - (concat - (org-gcal-events-url calendar-id) - (concat "/" event-id)) - :type "GET" - :headers - `(("Accept" . "application/json") - ("Authorization" . ,(format "Bearer %s" a-token))) - :parser 'org-gcal--json-read) - (deferred:nextc it - (lambda (response) - (let - ((_data (request-response-data response)) - (status-code (request-response-status-code response)) - (error-thrown (request-response-error-thrown response))) - (cond - ;; If there is no network connectivity, the response will not - ;; include a status code. - ((eq status-code nil) - (org-gcal--notify - "Got Error" - "Could not contact remote service. Please check your network connectivity.") - (error "Network connectivity issue")) - ((eq 401 (or (plist-get (plist-get (request-response-data response) :error) :code) - status-code)) - (org-gcal--notify - "Received HTTP 401" - "OAuth token expired. Now trying to refresh token.") - (deferred:$ - (org-gcal--refresh-token calendar-id) - (deferred:nextc it - (lambda (_unused) - (org-gcal--get-event calendar-id event-id))))) - ;; Generic error-handler meant to provide useful information about - ;; failure cases not otherwise explicitly specified. - ((not (eq error-thrown nil)) - (org-gcal--notify - (concat "Status code: " (number-to-string status-code)) - (format "%s %s: %s" - calendar-id - event-id - (pp-to-string error-thrown))) - (error "org-gcal--get-event: Got error %S for %s %s: %S" - status-code calendar-id event-id error-thrown)) - ;; Fetch was successful. - (t response)))))))) + (request-deferred + (concat + (org-gcal-events-url calendar-id) + (concat "/" event-id)) + :type "GET" + :headers + `(("Accept" . "application/json") + ("Authorization" . ,(format "Bearer %s" a-token))) + :parser 'org-gcal--json-read) + (deferred:nextc it + (lambda (response) + (let + ((_data (request-response-data response)) + (status-code (request-response-status-code response)) + (error-thrown (request-response-error-thrown response))) + (cond + ;; If there is no network connectivity, the response will not + ;; include a status code. + ((eq status-code nil) + (org-gcal--notify + "Got Error" + "Could not contact remote service. Please check your network connectivity.") + (error "Network connectivity issue")) + ((eq 401 (or (plist-get (plist-get (request-response-data response) :error) :code) + status-code)) + (org-gcal--notify + "Received HTTP 401" + "OAuth token expired. Now trying to refresh token.") + (deferred:$ + (org-gcal--refresh-token calendar-id) + (deferred:nextc it + (lambda (_unused) + (org-gcal--get-event calendar-id event-id))))) + ;; Generic error-handler meant to provide useful information about + ;; failure cases not otherwise explicitly specified. + ((not (eq error-thrown nil)) + (org-gcal--notify + (concat "Status code: " (number-to-string status-code)) + (format "%s %s: %s" + calendar-id + event-id + (pp-to-string error-thrown))) + (error "org-gcal--get-event: Got error %S for %s %s: %S" + status-code calendar-id event-id error-thrown)) + ;; Fetch was successful. + (t response)))))))) (aio-iter2-defun org-gcal--get-event-aio (calendar-id event-id) "Retrieves a Google Calendar event given a CALENDAR-ID and EVENT-ID. @@ -2794,34 +2794,34 @@ Returns an ‘aio-promise’ for a ‘request-response' object." (_data (request-response-data response)) (status-code (request-response-status-code response)) (error-thrown (request-response-error-thrown response))) - (cond - ;; If there is no network connectivity, the response will not - ;; include a status code. - ((eq status-code nil) - (org-gcal--notify - "Got Error" - "Could not contact remote service. Please check your network connectivity.") - (error "Network connectivity issue")) - ((eq 401 (or (plist-get (plist-get (request-response-data response) :error) :code) - status-code)) - (org-gcal--notify - "Received HTTP 401" - "OAuth token expired. Now trying to refresh token.") - (aio-await (org-gcal--refresh-token-aio calendar-id)) - (aio-await (org-gcal--get-event-aio calendar-id event-id))) - ;; Generic error-handler meant to provide useful information about - ;; failure cases not otherwise explicitly specified. - ((not (eq error-thrown nil)) - (org-gcal--notify - (concat "Status code: " (number-to-string status-code)) - (format "%s %s: %s" - calendar-id - event-id - (pp-to-string error-thrown))) - (error "org-gcal--get-event-aio: Got error %S for %s %s: %S" - status-code calendar-id event-id error-thrown)) - ;; Fetch was successful. - (t response)))) + (cond + ;; If there is no network connectivity, the response will not + ;; include a status code. + ((eq status-code nil) + (org-gcal--notify + "Got Error" + "Could not contact remote service. Please check your network connectivity.") + (error "Network connectivity issue")) + ((eq 401 (or (plist-get (plist-get (request-response-data response) :error) :code) + status-code)) + (org-gcal--notify + "Received HTTP 401" + "OAuth token expired. Now trying to refresh token.") + (aio-await (org-gcal--refresh-token-aio calendar-id)) + (aio-await (org-gcal--get-event-aio calendar-id event-id))) + ;; Generic error-handler meant to provide useful information about + ;; failure cases not otherwise explicitly specified. + ((not (eq error-thrown nil)) + (org-gcal--notify + (concat "Status code: " (number-to-string status-code)) + (format "%s %s: %s" + calendar-id + event-id + (pp-to-string error-thrown))) + (error "org-gcal--get-event-aio: Got error %S for %s %s: %S" + status-code calendar-id event-id error-thrown)) + ;; Fetch was successful. + (t response)))) (aio-iter2-defun org-gcal--overwrite-event (calendar-id event-id marker) "Overwrite event specified by CALENDAR-ID and EVENT-ID at MARKER. @@ -2858,134 +2858,134 @@ AIO version: ‘org-gcal--post-event-aio’." (etime-alt (org-gcal--param-date-alt end)) (a-token (or a-token (org-gcal--get-access-token calendar-id)))) (deferred:try - (deferred:$ ; Migrated to AIO - (apply - #'request-deferred - (concat - (org-gcal-events-url calendar-id) - (when event-id - (concat "/" (url-hexify-string event-id)))) - :type (cond - (skip-export "GET") - (event-id "PATCH") - (t "POST")) - :headers (append - `(("Content-Type" . "application/json") - ("Accept" . "application/json") - ("Authorization" . ,(format "Bearer %s" a-token))) - (cond - ((null etag) nil) - ((null event-id) - (error "org-gcal--post-event: %s %s %s: %s" - (point-marker) calendar-id event-id - "Event cannot have ETag set when event ID absent")) - (t - `(("If-Match" . ,etag))))) - :parser 'org-gcal--json-read - (unless skip-export - (list - :data (encode-coding-string - (json-encode - (append - `(("summary" . ,smry) - ("location" . ,loc) - ("source" . ,source) - ("transparency" . ,transparency) - ("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 - ((_temp (request-response-data response)) - (status-code (request-response-status-code response)) - (error-msg (request-response-error-thrown response))) - (cond - ;; If there is no network connectivity, the response will not - ;; include a status code. - ((eq status-code nil) - (org-gcal--notify - "Got Error" - "Could not contact remote service. Please check your network connectivity.") - (error "Network connectivity issue")) - ((eq 401 (or (plist-get (plist-get (request-response-data response) :error) :code) - status-code)) - (org-gcal--notify - "Received HTTP 401" - "OAuth token expired. Now trying to refresh-token") - (deferred:$ - (org-gcal--refresh-token calendar-id) - (deferred:nextc it - (lambda (_unused) - (org-gcal--post-event start end smry loc source desc calendar-id - marker transparency etag event-id nil - skip-import skip-export))))) - ;; ETag on current entry is stale. This means the event on the - ;; server has been updated. In that case, update the event using - ;; the data from the server. - ((eq status-code 412) - (unless skip-import - (org-gcal--notify - "Received HTTP 412" - (format "ETag stale for %s\n%s\n\n%s" - smry - (org-gcal--format-entry-id calendar-id event-id) - "Will overwrite this entry with event from server.")) - (deferred:try - (deferred:$ ; Migrated to AIO - (org-gcal--get-event calendar-id event-id) - (deferred:nextc it - (lambda (response) - (save-excursion - (with-current-buffer (marker-buffer marker) - (goto-char (marker-position marker)) - (org-gcal--update-entry - calendar-id - (request-response-data response) - (if event-id 'update-existing 'create-from-entry)))) - (deferred:succeed nil)))) - :catch - (lambda (err) - (if (string-match "(error http 404)" (cadr err)) - (org-with-point-at marker - (org-entry-delete marker org-gcal-calendar-id-property) - (org-entry-delete marker org-gcal-entry-id-property) - (org-entry-delete marker org-gcal-etag-property) - (org-back-to-heading) - (org-gcal--handle-cancelled-entry)) - (signal (car err) (cdr err))))))) - ;; Generic error-handler meant to provide useful information about - ;; failure cases not otherwise explicitly specified. - ((not (eq error-msg nil)) - (org-gcal--notify - (concat "Status code: " (number-to-string status-code)) - (pp-to-string error-msg)) - (error "Got error %S: %S" status-code error-msg)) - ;; Fetch was successful. - (t - (unless skip-export - (let* ((data (request-response-data response))) - (save-excursion - (with-current-buffer (marker-buffer marker) - (goto-char (marker-position marker)) - ;; Update the entry to add ETag, as well as other - ;; properties if this is a newly-created event. - (org-gcal--update-entry calendar-id data - (if event-id - 'update-existing - 'create-from-entry)))) - (org-gcal--notify "Event Posted" - (concat "Org-gcal post event\n " (plist-get data :summary))))) - (deferred:succeed nil))))))) - :finally - (lambda (_) - (set-marker marker nil))))) + (deferred:$ ; Migrated to AIO + (apply + #'request-deferred + (concat + (org-gcal-events-url calendar-id) + (when event-id + (concat "/" (url-hexify-string event-id)))) + :type (cond + (skip-export "GET") + (event-id "PATCH") + (t "POST")) + :headers (append + `(("Content-Type" . "application/json") + ("Accept" . "application/json") + ("Authorization" . ,(format "Bearer %s" a-token))) + (cond + ((null etag) nil) + ((null event-id) + (error "org-gcal--post-event: %s %s %s: %s" + (point-marker) calendar-id event-id + "Event cannot have ETag set when event ID absent")) + (t + `(("If-Match" . ,etag))))) + :parser 'org-gcal--json-read + (unless skip-export + (list + :data (encode-coding-string + (json-encode + (append + `(("summary" . ,smry) + ("location" . ,loc) + ("source" . ,source) + ("transparency" . ,transparency) + ("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 + ((_temp (request-response-data response)) + (status-code (request-response-status-code response)) + (error-msg (request-response-error-thrown response))) + (cond + ;; If there is no network connectivity, the response will not + ;; include a status code. + ((eq status-code nil) + (org-gcal--notify + "Got Error" + "Could not contact remote service. Please check your network connectivity.") + (error "Network connectivity issue")) + ((eq 401 (or (plist-get (plist-get (request-response-data response) :error) :code) + status-code)) + (org-gcal--notify + "Received HTTP 401" + "OAuth token expired. Now trying to refresh-token") + (deferred:$ + (org-gcal--refresh-token calendar-id) + (deferred:nextc it + (lambda (_unused) + (org-gcal--post-event start end smry loc source desc calendar-id + marker transparency etag event-id nil + skip-import skip-export))))) + ;; ETag on current entry is stale. This means the event on the + ;; server has been updated. In that case, update the event using + ;; the data from the server. + ((eq status-code 412) + (unless skip-import + (org-gcal--notify + "Received HTTP 412" + (format "ETag stale for %s\n%s\n\n%s" + smry + (org-gcal--format-entry-id calendar-id event-id) + "Will overwrite this entry with event from server.")) + (deferred:try + (deferred:$ ; Migrated to AIO + (org-gcal--get-event calendar-id event-id) + (deferred:nextc it + (lambda (response) + (save-excursion + (with-current-buffer (marker-buffer marker) + (goto-char (marker-position marker)) + (org-gcal--update-entry + calendar-id + (request-response-data response) + (if event-id 'update-existing 'create-from-entry)))) + (deferred:succeed nil)))) + :catch + (lambda (err) + (if (string-match "(error http 404)" (cadr err)) + (org-with-point-at marker + (org-entry-delete marker org-gcal-calendar-id-property) + (org-entry-delete marker org-gcal-entry-id-property) + (org-entry-delete marker org-gcal-etag-property) + (org-back-to-heading) + (org-gcal--handle-cancelled-entry)) + (signal (car err) (cdr err))))))) + ;; Generic error-handler meant to provide useful information about + ;; failure cases not otherwise explicitly specified. + ((not (eq error-msg nil)) + (org-gcal--notify + (concat "Status code: " (number-to-string status-code)) + (pp-to-string error-msg)) + (error "Got error %S: %S" status-code error-msg)) + ;; Fetch was successful. + (t + (unless skip-export + (let* ((data (request-response-data response))) + (save-excursion + (with-current-buffer (marker-buffer marker) + (goto-char (marker-position marker)) + ;; Update the entry to add ETag, as well as other + ;; properties if this is a newly-created event. + (org-gcal--update-entry calendar-id data + (if event-id + 'update-existing + 'create-from-entry)))) + (org-gcal--notify "Event Posted" + (concat "Org-gcal post event\n " (plist-get data :summary))))) + (deferred:succeed nil))))))) + :finally + (lambda (_) + (set-marker marker nil))))) (aio-iter2-defun org-gcal--post-event-aio (start end smry loc source desc calendar-id marker transparency &optional etag event-id a-token skip-import skip-export) "Create or update an event on Google Calendar. @@ -3118,84 +3118,84 @@ Returns a ‘deferred’ object that can be used to wait for completion. AIO version: ‘org-gcal--delete-event-aio’." (let ((a-token (or a-token (org-gcal--get-access-token calendar-id)))) (deferred:try - (deferred:$ ; Migrated to AIO - (request-deferred - (concat - (org-gcal-events-url calendar-id) - (concat "/" event-id)) - :type "DELETE" - :headers (append - `(("Content-Type" . "application/json") - ("Accept" . "application/json") - ("Authorization" . ,(format "Bearer %s" a-token))) - (cond - ((null etag) nil) - ((null event-id) - (error "Event cannot have ETag set when event ID absent")) - (t - `(("If-Match" . ,etag))))) - - :parser 'org-gcal--json-read) - (deferred:nextc it - (lambda (response) - (let - ((_temp (request-response-data response)) - (status-code (request-response-status-code response)) - (error-msg (request-response-error-thrown response))) - (cond - ;; If there is no network connectivity, the response will not - ;; include a status code. - ((eq status-code nil) - (org-gcal--notify - "Got Error" - "Could not contact remote service. Please check your network connectivity.") - (error "Network connectivity issue")) - ((eq 401 (or (plist-get (plist-get (request-response-data response) :error) :code) - status-code)) - (org-gcal--notify - "Received HTTP 401" - "OAuth token expired. Now trying to refresh-token") - (deferred:$ - (org-gcal--refresh-token calendar-id) - (deferred:nextc it - (lambda (_unused) - (org-gcal--delete-event calendar-id event-id - etag marker nil))))) - ;; ETag on current entry is stale. This means the event on the - ;; server has been updated. In that case, update the event using - ;; the data from the server. - ((eq status-code 412) - (org-gcal--notify - "Received HTTP 412" - (format "ETag stale for entry %s\n\n%s" - (org-gcal--format-entry-id calendar-id event-id) - "Will overwrite this entry with event from server.")) - (deferred:$ ; Migrated to AIO - (org-gcal--get-event calendar-id event-id) - (deferred:nextc it - (lambda (response) - (save-excursion - (with-current-buffer (marker-buffer marker) - (goto-char (marker-position marker)) - (org-gcal--update-entry - calendar-id - (request-response-data response) - 'update-existing))) - (deferred:succeed nil))))) - ;; Generic error-handler meant to provide useful information about - ;; failure cases not otherwise explicitly specified. - ((not (eq error-msg nil)) - (org-gcal--notify - (concat "Status code: " (number-to-string status-code)) - (pp-to-string error-msg)) - (error "Got error %S: %S" status-code error-msg)) - ;; Fetch was successful. - (t - (org-gcal--notify "Event Deleted" "Org-gcal deleted event") - (deferred:succeed nil))))))) - :finally - (lambda (_) - (set-marker marker nil))))) + (deferred:$ ; Migrated to AIO + (request-deferred + (concat + (org-gcal-events-url calendar-id) + (concat "/" event-id)) + :type "DELETE" + :headers (append + `(("Content-Type" . "application/json") + ("Accept" . "application/json") + ("Authorization" . ,(format "Bearer %s" a-token))) + (cond + ((null etag) nil) + ((null event-id) + (error "Event cannot have ETag set when event ID absent")) + (t + `(("If-Match" . ,etag))))) + + :parser 'org-gcal--json-read) + (deferred:nextc it + (lambda (response) + (let + ((_temp (request-response-data response)) + (status-code (request-response-status-code response)) + (error-msg (request-response-error-thrown response))) + (cond + ;; If there is no network connectivity, the response will not + ;; include a status code. + ((eq status-code nil) + (org-gcal--notify + "Got Error" + "Could not contact remote service. Please check your network connectivity.") + (error "Network connectivity issue")) + ((eq 401 (or (plist-get (plist-get (request-response-data response) :error) :code) + status-code)) + (org-gcal--notify + "Received HTTP 401" + "OAuth token expired. Now trying to refresh-token") + (deferred:$ + (org-gcal--refresh-token calendar-id) + (deferred:nextc it + (lambda (_unused) + (org-gcal--delete-event calendar-id event-id + etag marker nil))))) + ;; ETag on current entry is stale. This means the event on the + ;; server has been updated. In that case, update the event using + ;; the data from the server. + ((eq status-code 412) + (org-gcal--notify + "Received HTTP 412" + (format "ETag stale for entry %s\n\n%s" + (org-gcal--format-entry-id calendar-id event-id) + "Will overwrite this entry with event from server.")) + (deferred:$ ; Migrated to AIO + (org-gcal--get-event calendar-id event-id) + (deferred:nextc it + (lambda (response) + (save-excursion + (with-current-buffer (marker-buffer marker) + (goto-char (marker-position marker)) + (org-gcal--update-entry + calendar-id + (request-response-data response) + 'update-existing))) + (deferred:succeed nil))))) + ;; Generic error-handler meant to provide useful information about + ;; failure cases not otherwise explicitly specified. + ((not (eq error-msg nil)) + (org-gcal--notify + (concat "Status code: " (number-to-string status-code)) + (pp-to-string error-msg)) + (error "Got error %S: %S" status-code error-msg)) + ;; Fetch was successful. + (t + (org-gcal--notify "Event Deleted" "Org-gcal deleted event") + (deferred:succeed nil))))))) + :finally + (lambda (_) + (set-marker marker nil))))) (aio-iter2-defun org-gcal--delete-event-aio (calendar-id event-id etag marker &optional a-token) "Delete an event on Calendar CALENDAR-ID with EVENT-ID. @@ -3207,66 +3207,66 @@ overwrite the event at MARKER if the event has changed on the server. Returns an ‘aio-promise’ object that can be used to wait for completion." (prog1 nil - (let* - ((a-token (or a-token (org-gcal--get-access-token calendar-id))) - (response - (aio-await - (org-gcal--aio-request-catch-error - (concat - (org-gcal-events-url calendar-id) - (concat "/" event-id)) - :type "DELETE" - :headers (append - `(("Content-Type" . "application/json") - ("Accept" . "application/json") - ("Authorization" . ,(format "Bearer %s" a-token))) - (cond - ((null etag) nil) - ((null event-id) - (error "Event cannot have ETag set when event ID absent")) - (t - `(("If-Match" . ,etag))))) - :parser 'org-gcal--json-read))) - (status-code (request-response-status-code response)) - (error-msg (request-response-error-thrown response))) - (cond - ;; If there is no network connectivity, the response will not - ;; include a status code. - ((eq status-code nil) - (org-gcal--notify - "Got Error" - "Could not contact remote service. Please check your network connectivity.") - (error "Network connectivity issue")) - ((eq 401 (or (plist-get (plist-get (request-response-data response) :error) :code) - status-code)) - (org-gcal--notify - "Received HTTP 401" - "OAuth token expired. Now trying to refresh-token") - (aio-await (org-gcal--refresh-token-aio calendar-id)) - (aio-await - (org-gcal--delete-event-aio - calendar-id event-id etag marker nil))) - ;; ETag on current entry is stale. This means the event on the - ;; server has been updated. In that case, update the event using - ;; the data from the server. - ((eq status-code 412) - (org-gcal--notify - "Received HTTP 412" - (format "ETag stale for entry %s\n\n%s" - (org-gcal--format-entry-id calendar-id event-id) - "Will overwrite this entry with event from server.")) - (aio-await (org-gcal--overwrite-event calendar-id event-id marker))) - ;; Generic error-handler meant to provide useful information about - ;; failure cases not otherwise explicitly specified. - ((not (eq error-msg nil)) - (org-gcal--notify - (concat "Status code: " (number-to-string status-code)) - (pp-to-string error-msg)) - (error "Got error %S: %S" status-code error-msg)) - ;; Fetch was successful. - (t - (org-gcal--notify "Event Deleted" "Org-gcal deleted event")))) - (set-marker marker nil))) + (let* + ((a-token (or a-token (org-gcal--get-access-token calendar-id))) + (response + (aio-await + (org-gcal--aio-request-catch-error + (concat + (org-gcal-events-url calendar-id) + (concat "/" event-id)) + :type "DELETE" + :headers (append + `(("Content-Type" . "application/json") + ("Accept" . "application/json") + ("Authorization" . ,(format "Bearer %s" a-token))) + (cond + ((null etag) nil) + ((null event-id) + (error "Event cannot have ETag set when event ID absent")) + (t + `(("If-Match" . ,etag))))) + :parser 'org-gcal--json-read))) + (status-code (request-response-status-code response)) + (error-msg (request-response-error-thrown response))) + (cond + ;; If there is no network connectivity, the response will not + ;; include a status code. + ((eq status-code nil) + (org-gcal--notify + "Got Error" + "Could not contact remote service. Please check your network connectivity.") + (error "Network connectivity issue")) + ((eq 401 (or (plist-get (plist-get (request-response-data response) :error) :code) + status-code)) + (org-gcal--notify + "Received HTTP 401" + "OAuth token expired. Now trying to refresh-token") + (aio-await (org-gcal--refresh-token-aio calendar-id)) + (aio-await + (org-gcal--delete-event-aio + calendar-id event-id etag marker nil))) + ;; ETag on current entry is stale. This means the event on the + ;; server has been updated. In that case, update the event using + ;; the data from the server. + ((eq status-code 412) + (org-gcal--notify + "Received HTTP 412" + (format "ETag stale for entry %s\n\n%s" + (org-gcal--format-entry-id calendar-id event-id) + "Will overwrite this entry with event from server.")) + (aio-await (org-gcal--overwrite-event calendar-id event-id marker))) + ;; Generic error-handler meant to provide useful information about + ;; failure cases not otherwise explicitly specified. + ((not (eq error-msg nil)) + (org-gcal--notify + (concat "Status code: " (number-to-string status-code)) + (pp-to-string error-msg)) + (error "Got error %S: %S" status-code error-msg)) + ;; Fetch was successful. + (t + (org-gcal--notify "Event Deleted" "Org-gcal deleted event")))) + (set-marker marker nil))) (declare-function org-capture-goto-last-stored "org-capture" ()) (defun org-gcal--capture-post () @@ -3354,7 +3354,7 @@ non-nil." (when (and org-gcal-notify-p (not silent)) (if org-gcal-logo-file (alert message :title title :icon org-gcal-logo-file) - (alert message :title title)) + (alert message :title title)) (alert message :title title :style 'message)))) (defun org-gcal--time-to-seconds (plst) @@ -3382,22 +3382,22 @@ background processes." (run-at-time nil 0.5 (cl-defun org-gcal--aio-wait-for-background-timer (promise tc) - (org-gcal-tmp-dbgmsg "org-gcal--aio-wait-for-background-timer: %S %S" promise tc) - (condition-case err - (cond - ((null (car tc)) nil) - ((null (aio-result promise)) - (accept-process-output nil 0.001) - nil) - (t - (cancel-timer (car tc)) - (org-gcal-tmp-dbgmsg "org-gcal--aio-wait-for-background: promise result: %S" - (aio-result promise)))) - ;; Cancel timer on signal so that it doesn’t hang around forever. - (error - (cancel-timer (car tc)) - (org-gcal-tmp-dbgmsg "org-gcal--aio-wait-for-background-timer: error %s" err) - (signal (car err) (cdr err))))) + (org-gcal-tmp-dbgmsg "org-gcal--aio-wait-for-background-timer: %S %S" promise tc) + (condition-case err + (cond + ((null (car tc)) nil) + ((null (aio-result promise)) + (accept-process-output nil 0.001) + nil) + (t + (cancel-timer (car tc)) + (org-gcal-tmp-dbgmsg "org-gcal--aio-wait-for-background: promise result: %S" + (aio-result promise)))) + ;; Cancel timer on signal so that it doesn’t hang around forever. + (error + (cancel-timer (car tc)) + (org-gcal-tmp-dbgmsg "org-gcal--aio-wait-for-background-timer: error %s" err) + (signal (car err) (cdr err))))) promise timer-cell)) (car timer-cell))) @@ -3405,7 +3405,7 @@ background processes." ;; Required to ‘define-error’ in order to properly ‘signal’ and be able to catch ;; it in ‘condition-case’. (define-error 'org-gcal--aio-request - "org-gcal HTTP request encountered error") + "org-gcal HTTP request encountered error") (cl-defun org-gcal--aio-request (url &rest settings) "Wraps ‘request' in a promise. @@ -3462,175 +3462,175 @@ since these keys are used by this function to set up the promise resolution." nil))) ;; FIXME: this might be the right one, not sure. -;(aio-defun org-gcal--post-event-aio (start end smry loc desc calendar-id marker &optional etag event-id a-token skip-import skip-export) -; "\ -;Creates or updates an event on Calendar CALENDAR-ID with attributes START, END, -;SMRY, LOC, DESC. The Org buffer and point from which the event is read is given -;by MARKER. -; -;If ETAG is provided, it is used to retrieve the event data from the server and -;overwrite the event at MARKER if the event has changed on the server. MARKER is -;destroyed by this function. -; -;Returns a ‘aio-promise’ object that can be used to wait for completion." -; (let ((stime (org-gcal--param-date start)) -; (etime (org-gcal--param-date end)) -; (stime-alt (org-gcal--param-date-alt start)) -; (etime-alt (org-gcal--param-date-alt end)) -; (a-token (or a-token (org-gcal--get-access-token calendar-id)))) -; (let* ((response -; (aio-await (apply -; #'org-gcal--aio-request -; (concat -; (org-gcal-events-url calendar-id) -; (when event-id -; (concat "/" event-id))) -; :type (cond -; (skip-export "GET") -; (event-id "PATCH") -; (t "POST")) -; :headers (append -; `(("Content-Type" . "application/json") -; ("Accept" . "application/json") -; ("Authorization" . ,(format "Bearer %s" a-token))) -; (cond -; ((null etag) nil) -; ((null event-id) -; (error "Event cannot have ETag set when event ID absent")) -; (t -; `(("If-Match" . ,etag))))) -; :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))))))) -; (message "%s" (pp-to-string (request-response-data response)))))) -; ;; (deferred:try -; ;; (deferred:$ -; ;; (apply -; ;; #'request-deferred -; ;; (concat -; ;; (org-gcal-events-url calendar-id) -; ;; (when event-id -; ;; (concat "/" event-id))) -; ;; :type (cond -; ;; (skip-export "GET") -; ;; (event-id "PATCH") -; ;; (t "POST")) -; ;; :headers (append -; ;; `(("Content-Type" . "application/json") -; ;; ("Accept" . "application/json") -; ;; ("Authorization" . ,(format "Bearer %s" a-token))) -; ;; (cond -; ;; ((null etag) nil) -; ;; ((null event-id) -; ;; (error "Event cannot have ETag set when event ID absent")) -; ;; (t -; ;; `(("If-Match" . ,etag))))) -; ;; :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 -; ;; ((_temp (request-response-data response)) -; ;; (status-code (request-response-status-code response)) -; ;; (error-msg (request-response-error-thrown response))) -; ;; (cond -; ;; ;; If there is no network connectivity, the response will not -; ;; ;; include a status code. -; ;; ((eq status-code nil) -; ;; (org-gcal--notify -; ;; "Got Error" -; ;; "Could not contact remote service. Please check your network connectivity.") -; ;; (error "Network connectivity issue")) -; ;; ((eq 401 (or (plist-get (plist-get (request-response-data response) :error) :code) -; ;; status-code)) -; ;; (org-gcal--notify -; ;; "Received HTTP 401" -; ;; "OAuth token expired. Now trying to refresh-token") -; ;; (deferred:$ -; ;; (org-gcal--refresh-token calendar-id) -; ;; (deferred:nextc it -; ;; (lambda (_unused) -; ;; (org-gcal--post-event start end smry loc desc calendar-id -; ;; marker etag event-id nil -; ;; skip-import skip-export))))) -; ;; ;; ETag on current entry is stale. This means the event on the -; ;; ;; server has been updated. In that case, update the event using -; ;; ;; the data from the server. -; ;; ((eq status-code 412) -; ;; (unless skip-import -; ;; (org-gcal--notify -; ;; "Received HTTP 412" -; ;; (format "ETag stale for %s\n%s\n\n%s" -; ;; smry -; ;; (org-gcal--format-entry-id calendar-id event-id) -; ;; "Will overwrite this entry with event from server.")) -; ;; (deferred:$ -; ;; (org-gcal--get-event calendar-id event-id) -; ;; (deferred:nextc it -; ;; (lambda (response) -; ;; (save-excursion -; ;; (with-current-buffer (marker-buffer marker) -; ;; (goto-char (marker-position marker)) -; ;; (org-gcal--update-entry -; ;; calendar-id -; ;; (request-response-data response) -; ;; (if event-id 'update-existing 'create-from-entry)))) -; ;; (deferred:succeed nil)))))) -; ;; ;; Generic error-handler meant to provide useful information about -; ;; ;; failure cases not otherwise explicitly specified. -; ;; ((not (eq error-msg nil)) -; ;; (org-gcal--notify -; ;; (concat "Status code: " (number-to-string status-code)) -; ;; (pp-to-string error-msg)) -; ;; (error "Got error %S: %S" status-code error-msg)) -; ;; ;; Fetch was successful. -; ;; (t -; ;; (unless skip-export -; ;; (let* ((data (request-response-data response))) -; ;; (save-excursion -; ;; (with-current-buffer (marker-buffer marker) -; ;; (goto-char (marker-position marker)) -; ;; ;; Update the entry to add ETag, as well as other -; ;; ;; properties if this is a newly-created event. -; ;; (org-gcal--update-entry calendar-id data -; ;; (if event-id -; ;; 'update-existing -; ;; 'create-from-entry)))) -; ;; (org-gcal--notify "Event Posted" -; ;; (concat "Org-gcal post event\n " (plist-get data :summary))))) -; ;; (deferred:succeed nil))))))) -; ;; :finally -; ;; (lambda (_) -; ;; (set-marker marker nil))))) + ;(aio-defun org-gcal--post-event-aio (start end smry loc desc calendar-id marker &optional etag event-id a-token skip-import skip-export) + ; "\ + ;Creates or updates an event on Calendar CALENDAR-ID with attributes START, END, + ;SMRY, LOC, DESC. The Org buffer and point from which the event is read is given + ;by MARKER. + ; + ;If ETAG is provided, it is used to retrieve the event data from the server and + ;overwrite the event at MARKER if the event has changed on the server. MARKER is + ;destroyed by this function. + ; + ;Returns a ‘aio-promise’ object that can be used to wait for completion." + ; (let ((stime (org-gcal--param-date start)) + ; (etime (org-gcal--param-date end)) + ; (stime-alt (org-gcal--param-date-alt start)) + ; (etime-alt (org-gcal--param-date-alt end)) + ; (a-token (or a-token (org-gcal--get-access-token calendar-id)))) + ; (let* ((response + ; (aio-await (apply + ; #'org-gcal--aio-request + ; (concat + ; (org-gcal-events-url calendar-id) + ; (when event-id + ; (concat "/" event-id))) + ; :type (cond + ; (skip-export "GET") + ; (event-id "PATCH") + ; (t "POST")) + ; :headers (append + ; `(("Content-Type" . "application/json") + ; ("Accept" . "application/json") + ; ("Authorization" . ,(format "Bearer %s" a-token))) + ; (cond + ; ((null etag) nil) + ; ((null event-id) + ; (error "Event cannot have ETag set when event ID absent")) + ; (t + ; `(("If-Match" . ,etag))))) + ; :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))))))) + ; (message "%s" (pp-to-string (request-response-data response)))))) + ; ;; (deferred:try + ; ;; (deferred:$ + ; ;; (apply + ; ;; #'request-deferred + ; ;; (concat + ; ;; (org-gcal-events-url calendar-id) + ; ;; (when event-id + ; ;; (concat "/" event-id))) + ; ;; :type (cond + ; ;; (skip-export "GET") + ; ;; (event-id "PATCH") + ; ;; (t "POST")) + ; ;; :headers (append + ; ;; `(("Content-Type" . "application/json") + ; ;; ("Accept" . "application/json") + ; ;; ("Authorization" . ,(format "Bearer %s" a-token))) + ; ;; (cond + ; ;; ((null etag) nil) + ; ;; ((null event-id) + ; ;; (error "Event cannot have ETag set when event ID absent")) + ; ;; (t + ; ;; `(("If-Match" . ,etag))))) + ; ;; :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 + ; ;; ((_temp (request-response-data response)) + ; ;; (status-code (request-response-status-code response)) + ; ;; (error-msg (request-response-error-thrown response))) + ; ;; (cond + ; ;; ;; If there is no network connectivity, the response will not + ; ;; ;; include a status code. + ; ;; ((eq status-code nil) + ; ;; (org-gcal--notify + ; ;; "Got Error" + ; ;; "Could not contact remote service. Please check your network connectivity.") + ; ;; (error "Network connectivity issue")) + ; ;; ((eq 401 (or (plist-get (plist-get (request-response-data response) :error) :code) + ; ;; status-code)) + ; ;; (org-gcal--notify + ; ;; "Received HTTP 401" + ; ;; "OAuth token expired. Now trying to refresh-token") + ; ;; (deferred:$ + ; ;; (org-gcal--refresh-token calendar-id) + ; ;; (deferred:nextc it + ; ;; (lambda (_unused) + ; ;; (org-gcal--post-event start end smry loc desc calendar-id + ; ;; marker etag event-id nil + ; ;; skip-import skip-export))))) + ; ;; ;; ETag on current entry is stale. This means the event on the + ; ;; ;; server has been updated. In that case, update the event using + ; ;; ;; the data from the server. + ; ;; ((eq status-code 412) + ; ;; (unless skip-import + ; ;; (org-gcal--notify + ; ;; "Received HTTP 412" + ; ;; (format "ETag stale for %s\n%s\n\n%s" + ; ;; smry + ; ;; (org-gcal--format-entry-id calendar-id event-id) + ; ;; "Will overwrite this entry with event from server.")) + ; ;; (deferred:$ + ; ;; (org-gcal--get-event calendar-id event-id) + ; ;; (deferred:nextc it + ; ;; (lambda (response) + ; ;; (save-excursion + ; ;; (with-current-buffer (marker-buffer marker) + ; ;; (goto-char (marker-position marker)) + ; ;; (org-gcal--update-entry + ; ;; calendar-id + ; ;; (request-response-data response) + ; ;; (if event-id 'update-existing 'create-from-entry)))) + ; ;; (deferred:succeed nil)))))) + ; ;; ;; Generic error-handler meant to provide useful information about + ; ;; ;; failure cases not otherwise explicitly specified. + ; ;; ((not (eq error-msg nil)) + ; ;; (org-gcal--notify + ; ;; (concat "Status code: " (number-to-string status-code)) + ; ;; (pp-to-string error-msg)) + ; ;; (error "Got error %S: %S" status-code error-msg)) + ; ;; ;; Fetch was successful. + ; ;; (t + ; ;; (unless skip-export + ; ;; (let* ((data (request-response-data response))) + ; ;; (save-excursion + ; ;; (with-current-buffer (marker-buffer marker) + ; ;; (goto-char (marker-position marker)) + ; ;; ;; Update the entry to add ETag, as well as other + ; ;; ;; properties if this is a newly-created event. + ; ;; (org-gcal--update-entry calendar-id data + ; ;; (if event-id + ; ;; 'update-existing + ; ;; 'create-from-entry)))) + ; ;; (org-gcal--notify "Event Posted" + ; ;; (concat "Org-gcal post event\n " (plist-get data :summary))))) + ; ;; (deferred:succeed nil))))))) + ; ;; :finally + ; ;; (lambda (_) + ; ;; (set-marker marker nil))))) (aio-iter2-defun org-gcal--aio-request-catch-error (url &rest settings) "Call ‘org-gcal--aio-request’ without signaling if HTTP response is not 200. diff --git a/org-generic-id.el b/org-generic-id.el index 13aa9e2..cc29e79 100644 --- a/org-generic-id.el +++ b/org-generic-id.el @@ -109,8 +109,8 @@ they would otherwise be garbage collected (after being killed, for example).") res)) (persist-defvar - org-generic-id--last-update-id-time nil - "Time at which ‘org-generic-id-update-id-locations’ last completed. + org-generic-id--last-update-id-time nil + "Time at which ‘org-generic-id-update-id-locations’ last completed. This is a plist mapping each ID-PROP to the last time that ID-PROP was updated. For documentation on ID-PROP see ‘org-generic-id-find’.") @@ -214,8 +214,8 @@ diagnostic and progress messages." (nfiles (length files)) (id-regexp (rx-to-string `(seq bol (0+ (any "\t ")) - ,(format ":%s:" id-prop) - (1+ " ") (not (any " "))))) + ,(format ":%s:" id-prop) + (1+ " ") (not (any " "))))) (seen-ids nil) (ndup 0) (i 0)) @@ -521,9 +521,9 @@ This function converts ID-PROP to a symbol in order to query org-generic-id--files (buffer-file-name) (current-buffer))) (defun org-generic-id--files-kill-buffer-hook () - "Update ‘org-generic-id--files’ after a buffer is killed." - (org-generic-id--files-buffer-hook-impl - org-generic-id--files (buffer-file-name) nil)) + "Update ‘org-generic-id--files’ after a buffer is killed." + (org-generic-id--files-buffer-hook-impl + org-generic-id--files (buffer-file-name) nil)) (defun org-generic-id--files-buffer-hook-impl (file-to-buf fname buf) "Update FILE-TO-BUF to associate FNAME with BUF. diff --git a/test/org-gcal-test.el b/test/org-gcal-test.el index 63af530..c331956 100644 --- a/test/org-gcal-test.el +++ b/test/org-gcal-test.el @@ -109,7 +109,7 @@ aio-timeout to cause the test to fail." (replace-regexp-in-string "\"dateTime\": \"2019-10-06T21:00:00-07:00\"" "\"date\": \"2019-10-07\"" - org-gcal-test-event-json))) + org-gcal-test-event-json))) (defmacro org-gcal-test--with-temp-buffer (contents &rest body) "Create a ‘org-mode’ enabled temp buffer with CONTENTS. @@ -133,9 +133,9 @@ with ‘aio’ code. As setting ‘iter2-detect-nested-lambda-yields’ to t wi enforces that pattern." (declare (indent 0) (debug t)) `(with-mock - (aio-wait-for - (aio-iter2-with-async - ,@body)))) + (aio-wait-for + (aio-iter2-with-async + ,@body)))) (defmacro org-gcal-test--dynamic-let (bindings &rest body) "Temporarily bind VALUEs to PLACEs. @@ -159,14 +159,14 @@ created by ‘run-at-time’). (lambda (binding) `(progn (setq ,orig - (plist-put ,orig ',(car binding) ,(car binding))) + (plist-put ,orig ',(car binding) ,(car binding))) (setq ,(car binding) ,@(cdr binding)))) bindings) ,@body) (progn ,@(mapcar (lambda (binding) - `(setq ,(car binding) (plist-get ,orig ',(car binding)))) + `(setq ,(car binding) (plist-get ,orig ',(car binding)))) bindings)))))) (defun org-gcal-test--json-read-string (json) @@ -207,7 +207,7 @@ created by ‘run-at-time’). (let ((data '(:foo :bar))) (org-gcal--save-sexp data file) (should (string-equal (buffer-string) - "")) + "")) (should (equal (org-gcal--read-file-contents file) `(:token ,data :elem nil))) (setq data '(:baz :quux)) @@ -233,7 +233,7 @@ object." (should (equal (org-element-property :LOCATION elem) "Foobar's desk")) (should (equal (org-element-property :LINK elem) - "[[https://google.com][Google]]")) + "[[https://google.com][Google]]")) (should (equal (org-element-property :TRANSPARENCY elem) "opaque")) (should (equal (org-element-property :CALENDAR-ID elem) @@ -287,7 +287,7 @@ Old event description (should (equal (org-element-property :LOCATION elem) "Foobar's desk")) (should (equal (org-element-property :LINK elem) - "[[https://google.com][Google]]")) + "[[https://google.com][Google]]")) (should (equal (org-element-property :TRANSPARENCY elem) "opaque")) (should (equal (org-element-property :CALENDAR-ID elem) @@ -533,7 +533,7 @@ Second paragraph "Same as ‘org-gcal-test--update-existing-entry’, but with SCHEDULED property." (org-gcal-test--with-temp-buffer - "\ + "\ * Old event summary SCHEDULED: <9999-10-06 Sun 17:00-21:00> :PROPERTIES: @@ -548,37 +548,37 @@ SCHEDULED: <9999-10-06 Sun 17:00-21:00> Old event description :END: " - (org-gcal--update-entry org-gcal-test-calendar-id - org-gcal-test-event) - (org-back-to-heading) - (let ((elem (org-element-at-point))) - (should (equal (org-element-property - :raw-value - (org-element-property :scheduled elem)) - "<2019-10-06 Sun 17:00-21:00>")) - (should (equal (org-gcal-test--title-to-string elem) - "My event summary")) - (should (equal (org-element-property :ETAG elem) - "\"12344321\"")) - (should (equal (org-element-property :LOCATION elem) - "Foobar's desk")) - (should (equal (org-element-property :LINK elem) - "[[https://google.com][Google]]")) - (should (equal (org-element-property :TRANSPARENCY elem) - "opaque")) - (should (equal (org-element-property :CALENDAR-ID elem) - "foo@foobar.com")) - (should (equal (org-element-property :ENTRY-ID elem) - "foobar1234/foo@foobar.com"))) - ;; Check contents of "org-gcal" drawer - (re-search-forward ":org-gcal:") - (let ((elem (org-element-at-point))) - (should (equal (org-element-property :drawer-name elem) - "org-gcal")) - (should (equal (buffer-substring-no-properties - (org-element-property :contents-begin elem) - (org-element-property :contents-end elem)) - "\ + (org-gcal--update-entry org-gcal-test-calendar-id + org-gcal-test-event) + (org-back-to-heading) + (let ((elem (org-element-at-point))) + (should (equal (org-element-property + :raw-value + (org-element-property :scheduled elem)) + "<2019-10-06 Sun 17:00-21:00>")) + (should (equal (org-gcal-test--title-to-string elem) + "My event summary")) + (should (equal (org-element-property :ETAG elem) + "\"12344321\"")) + (should (equal (org-element-property :LOCATION elem) + "Foobar's desk")) + (should (equal (org-element-property :LINK elem) + "[[https://google.com][Google]]")) + (should (equal (org-element-property :TRANSPARENCY elem) + "opaque")) + (should (equal (org-element-property :CALENDAR-ID elem) + "foo@foobar.com")) + (should (equal (org-element-property :ENTRY-ID elem) + "foobar1234/foo@foobar.com"))) + ;; Check contents of "org-gcal" drawer + (re-search-forward ":org-gcal:") + (let ((elem (org-element-at-point))) + (should (equal (org-element-property :drawer-name elem) + "org-gcal")) + (should (equal (buffer-substring-no-properties + (org-element-property :contents-begin elem) + (org-element-property :contents-end elem)) + "\ My event description Second paragraph @@ -587,7 +587,7 @@ Second paragraph (ert-deftest org-gcal-test--update-existing-entry-with-id () "Verify that existing IDs in an existing headline will be preserved." (org-gcal-test--with-temp-buffer - "\ + "\ * Old event summary :PROPERTIES: :LOCATION: Somewhere else @@ -602,36 +602,36 @@ Second paragraph Old event description :END: " - (org-gcal--update-entry org-gcal-test-calendar-id - org-gcal-test-event) - (org-back-to-heading) - (let ((elem (org-element-at-point))) - (should (equal (org-gcal-test--title-to-string elem) - "My event summary")) - (should (equal (org-element-property :ETAG elem) - "\"12344321\"")) - (should (equal (org-element-property :LOCATION elem) - "Foobar's desk")) - (should (equal (org-element-property :LINK elem) - "[[https://google.com][Google]]")) - (should (equal (org-element-property :TRANSPARENCY elem) - "opaque")) - (should (equal (org-element-property :CALENDAR-ID elem) - "foo@foobar.com"))) - ;; The canonical ID should be that generated by org-gcal. - (should (equal (org-gcal--all-property-local-values (point) org-gcal-entry-id-property nil) - '("foobar1234/foo@foobar.com"))) - (should (equal (org-entry-get (point) org-gcal-entry-id-property) - '"foobar1234/foo@foobar.com")) - ;; Check contents of "org-gcal" drawer - (re-search-forward ":org-gcal:") - (let ((elem (org-element-at-point))) - (should (equal (org-element-property :drawer-name elem) - "org-gcal")) - (should (equal (buffer-substring-no-properties - (org-element-property :contents-begin elem) - (org-element-property :contents-end elem)) - "\ + (org-gcal--update-entry org-gcal-test-calendar-id + org-gcal-test-event) + (org-back-to-heading) + (let ((elem (org-element-at-point))) + (should (equal (org-gcal-test--title-to-string elem) + "My event summary")) + (should (equal (org-element-property :ETAG elem) + "\"12344321\"")) + (should (equal (org-element-property :LOCATION elem) + "Foobar's desk")) + (should (equal (org-element-property :LINK elem) + "[[https://google.com][Google]]")) + (should (equal (org-element-property :TRANSPARENCY elem) + "opaque")) + (should (equal (org-element-property :CALENDAR-ID elem) + "foo@foobar.com"))) + ;; The canonical ID should be that generated by org-gcal. + (should (equal (org-gcal--all-property-local-values (point) org-gcal-entry-id-property nil) + '("foobar1234/foo@foobar.com"))) + (should (equal (org-entry-get (point) org-gcal-entry-id-property) + '"foobar1234/foo@foobar.com")) + ;; Check contents of "org-gcal" drawer + (re-search-forward ":org-gcal:") + (let ((elem (org-element-at-point))) + (should (equal (org-element-property :drawer-name elem) + "org-gcal")) + (should (equal (buffer-substring-no-properties + (org-element-property :contents-begin elem) + (org-element-property :contents-end elem)) + "\ <2019-10-06 Sun 17:00-21:00> My event description @@ -678,7 +678,7 @@ Second paragraph (ert-deftest org-gcal-test--post-at-point-aio-basic () "Verify basic case of ‘org-gcal-post-to-point-aio’." (org-gcal-test--with-temp-buffer - "\ + "\ * My event summary :PROPERTIES: :ETag: \"12344321\" @@ -696,32 +696,32 @@ My event description Second paragraph :END: " - (org-gcal-test--with-mock-aio - (stub org-gcal--time-zone => '(0 "UTC")) - (stub org-generic-id-add-location => nil) - (stub org-gcal--ensure-token-aio => (aio-iter2-lambda () nil)) - (stub org-gcal--get-access-token => "my_access_token") - (stub org-gcal--refresh-token-aio => (aio-iter2-lambda () "test_access_token")) - (mock (org-gcal--post-event-aio - "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" - "My event summary" "Foobar's desk" - `((url . "https://google.com") (title . "Google")) - "My event description\n\nSecond paragraph" - "foo@foobar.com" - * "opaque" "\"12344321\"" "foobar1234" - * * *) - => (aio-iter2-lambda () nil)) - (org-gcal-test--dynamic-let - ((org-gcal-managed-post-at-point-update-existing 'always-push)) - (org-back-to-heading) - (message "About to call org-gcal-post-at-point-aio") - (aio-await (org-gcal-post-at-point-aio-promise)))))) + (org-gcal-test--with-mock-aio + (stub org-gcal--time-zone => '(0 "UTC")) + (stub org-generic-id-add-location => nil) + (stub org-gcal--ensure-token-aio => (aio-iter2-lambda () nil)) + (stub org-gcal--get-access-token => "my_access_token") + (stub org-gcal--refresh-token-aio => (aio-iter2-lambda () "test_access_token")) + (mock (org-gcal--post-event-aio + "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" + "My event summary" "Foobar's desk" + `((url . "https://google.com") (title . "Google")) + "My event description\n\nSecond paragraph" + "foo@foobar.com" + * "opaque" "\"12344321\"" "foobar1234" + * * *) + => (aio-iter2-lambda () nil)) + (org-gcal-test--dynamic-let + ((org-gcal-managed-post-at-point-update-existing 'always-push)) + (org-back-to-heading) + (message "About to call org-gcal-post-at-point-aio") + (aio-await (org-gcal-post-at-point-aio-promise)))))) (ert-deftest org-gcal-test--post-at-point-api-response () "Verify that ‘org-gcal-post-to-point’ updates an event using the data returned from the Google Calendar API." (org-gcal-test--with-temp-buffer - "\ + "\ * Original summary :PROPERTIES: :ETag: \"12344321\" @@ -739,51 +739,51 @@ Original description Original second paragraph :END: " - (defvar update-entry-hook-called nil) - (setq update-entry-hook-called nil) - (let (org-gcal-after-update-entry-functions) - (defun update-entry-hook (calendar-id event update-mode) - (message "update-entry-hook %S %S %S" calendar-id event update-mode) - (setq update-entry-hook-called t)) - (add-hook 'org-gcal-after-update-entry-functions #'update-entry-hook) - (with-mock - (stub org-gcal--time-zone => '(0 "UTC")) - (stub org-generic-id-add-location => nil) - (stub org-gcal--get-access-token => "my_access_token") - (stub org-gcal--refresh-token => (deferred:succeed "test_access_token")) - (stub request-deferred => - (deferred:succeed - (make-request-response - :status-code 200 - :data org-gcal-test-event))) - (let ((org-gcal-managed-post-at-point-update-existing 'always-push)) - (org-gcal-post-at-point) - (org-back-to-heading) - (should (equal update-entry-hook-called t)) - (let ((elem (org-element-at-point))) - (should (equal (org-gcal-test--title-to-string elem) - "My event summary")) - (should (equal (org-element-property :ETAG elem) - "\"12344321\"")) - (should (equal (org-element-property :LOCATION elem) - "Foobar's desk")) - (should (equal (org-element-property :LINK elem) - "[[https://google.com][Google]]")) - (should (equal (org-element-property :TRANSPARENCY elem) - "opaque")) - (should (equal (org-element-property :CALENDAR-ID elem) - "foo@foobar.com")) - (should (equal (org-element-property :ENTRY-ID elem) - "foobar1234/foo@foobar.com"))) - ;; Check contents of "org-gcal" drawer - (re-search-forward ":org-gcal:") - (let ((elem (org-element-at-point))) - (should (equal (org-element-property :drawer-name elem) - "org-gcal")) - (should (equal (buffer-substring-no-properties - (org-element-property :contents-begin elem) - (org-element-property :contents-end elem)) - "\ + (defvar update-entry-hook-called nil) + (setq update-entry-hook-called nil) + (let (org-gcal-after-update-entry-functions) + (defun update-entry-hook (calendar-id event update-mode) + (message "update-entry-hook %S %S %S" calendar-id event update-mode) + (setq update-entry-hook-called t)) + (add-hook 'org-gcal-after-update-entry-functions #'update-entry-hook) + (with-mock + (stub org-gcal--time-zone => '(0 "UTC")) + (stub org-generic-id-add-location => nil) + (stub org-gcal--get-access-token => "my_access_token") + (stub org-gcal--refresh-token => (deferred:succeed "test_access_token")) + (stub request-deferred => + (deferred:succeed + (make-request-response + :status-code 200 + :data org-gcal-test-event))) + (let ((org-gcal-managed-post-at-point-update-existing 'always-push)) + (org-gcal-post-at-point) + (org-back-to-heading) + (should (equal update-entry-hook-called t)) + (let ((elem (org-element-at-point))) + (should (equal (org-gcal-test--title-to-string elem) + "My event summary")) + (should (equal (org-element-property :ETAG elem) + "\"12344321\"")) + (should (equal (org-element-property :LOCATION elem) + "Foobar's desk")) + (should (equal (org-element-property :LINK elem) + "[[https://google.com][Google]]")) + (should (equal (org-element-property :TRANSPARENCY elem) + "opaque")) + (should (equal (org-element-property :CALENDAR-ID elem) + "foo@foobar.com")) + (should (equal (org-element-property :ENTRY-ID elem) + "foobar1234/foo@foobar.com"))) + ;; Check contents of "org-gcal" drawer + (re-search-forward ":org-gcal:") + (let ((elem (org-element-at-point))) + (should (equal (org-element-property :drawer-name elem) + "org-gcal")) + (should (equal (buffer-substring-no-properties + (org-element-property :contents-begin elem) + (org-element-property :contents-end elem)) + "\ <2019-10-06 Sun 17:00-21:00> My event description @@ -796,8 +796,8 @@ Second paragraph ;; need to define it outside the ‘aio-iter2-with-async’ block so that ;; this macro doesn’t transform it. (defun org-gcal-test--update-entry-hook (calendar-id event update-mode) - (org-gcal-tmp-dbgmsg "update-entry-hook %S %S %S" calendar-id event update-mode) - (setq update-entry-hook-called t)) + (org-gcal-tmp-dbgmsg "update-entry-hook %S %S %S" calendar-id event update-mode) + (setq update-entry-hook-called t)) (defvar org-gcal-test--update-entry-hook-called nil) (defun org-gcal-test--test-event-handler (httpcon) (org-gcal-tmp-dbgmsg "in test-event-handler: %S %S" @@ -852,8 +852,8 @@ Original second paragraph (aio-await (org-gcal-post-at-point-aio-promise)) (org-gcal-tmp-dbgmsg "org-back-to-heading") (org-back-to-heading) - ;; Disable this for now - the hook seems not to be always called, and - ;; I’m not sure why. + ;; Disable this for now - the hook seems not to be always called, and + ;; I’m not sure why. (should (equal update-entry-hook-called t)) (let ((elem (org-element-at-point))) (should (equal (org-gcal-test--title-to-string elem) @@ -870,7 +870,7 @@ Original second paragraph "foo@foobar.com")) (should (equal (org-element-property :ENTRY-ID elem) "foobar1234/foo@foobar.com"))) - ;; Check contents of "org-gcal" drawer + ;; Check contents of "org-gcal" drawer (re-search-forward ":org-gcal:") (let ((elem (org-element-at-point))) (should (equal (org-element-property :drawer-name elem) @@ -891,7 +891,7 @@ Second paragraph "Verify ‘org-gcal-post-at-point’ with ‘org-gcal-managed-update-existing-mode’ set to \"gcal\"." (org-gcal-test--with-temp-buffer - "\ + "\ * My event summary :PROPERTIES: :ETag: \"12344321\" @@ -909,28 +909,28 @@ My event description Second paragraph :END: " - (with-mock - (stub org-gcal--time-zone => '(0 "UTC")) - (stub org-generic-id-add-location => nil) - (stub org-gcal--get-access-token => "my_access_token") - (stub org-gcal--refresh-token => (deferred:succeed "test_access_token")) - (mock (org-gcal--post-event "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" - "My event summary" "Foobar's desk" - '((url . "https://google.com") (title . "Google")) - "My event description\n\nSecond paragraph" - "foo@foobar.com" - * "opaque" "\"12344321\"" "foobar1234" - * * nil)) - (org-gcal-test--dynamic-let - ((org-gcal-managed-update-existing-mode "gcal") - (org-gcal-managed-post-at-point-update-existing 'always-push)) - (org-gcal-post-at-point))))) + (with-mock + (stub org-gcal--time-zone => '(0 "UTC")) + (stub org-generic-id-add-location => nil) + (stub org-gcal--get-access-token => "my_access_token") + (stub org-gcal--refresh-token => (deferred:succeed "test_access_token")) + (mock (org-gcal--post-event "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" + "My event summary" "Foobar's desk" + '((url . "https://google.com") (title . "Google")) + "My event description\n\nSecond paragraph" + "foo@foobar.com" + * "opaque" "\"12344321\"" "foobar1234" + * * nil)) + (org-gcal-test--dynamic-let + ((org-gcal-managed-update-existing-mode "gcal") + (org-gcal-managed-post-at-point-update-existing 'always-push)) + (org-gcal-post-at-point))))) (ert-deftest org-gcal-test--post-at-point-aio-managed-update-existing-gcal () "Verify ‘org-gcal-post-at-point’ with ‘org-gcal-managed-update-existing-mode’ set to \"gcal\"." (org-gcal-test--with-temp-buffer - "\ + "\ * My event summary :PROPERTIES: :ETag: \"12344321\" @@ -948,29 +948,29 @@ My event description Second paragraph :END: " - (org-gcal-test--with-mock-aio - (stub org-gcal--time-zone => '(0 "UTC")) - (stub org-generic-id-add-location => nil) - (stub org-gcal--get-access-token => "my_access_token") - (stub org-gcal--refresh-token-aio => (aio-iter2-lambda () "test_access_token")) - (mock (org-gcal--post-event-aio "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" - "My event summary" "Foobar's desk" - '((url . "https://google.com") (title . "Google")) - "My event description\n\nSecond paragraph" - "foo@foobar.com" - * "opaque" "\"12344321\"" "foobar1234" - * * nil) - => (aio-iter2-lambda () nil)) - (org-gcal-test--dynamic-let - ((org-gcal-managed-update-existing-mode "gcal") - (org-gcal-managed-post-at-point-update-existing 'always-push)) - (aio-await (org-gcal-post-at-point-aio-promise)))))) + (org-gcal-test--with-mock-aio + (stub org-gcal--time-zone => '(0 "UTC")) + (stub org-generic-id-add-location => nil) + (stub org-gcal--get-access-token => "my_access_token") + (stub org-gcal--refresh-token-aio => (aio-iter2-lambda () "test_access_token")) + (mock (org-gcal--post-event-aio "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" + "My event summary" "Foobar's desk" + '((url . "https://google.com") (title . "Google")) + "My event description\n\nSecond paragraph" + "foo@foobar.com" + * "opaque" "\"12344321\"" "foobar1234" + * * nil) + => (aio-iter2-lambda () nil)) + (org-gcal-test--dynamic-let + ((org-gcal-managed-update-existing-mode "gcal") + (org-gcal-managed-post-at-point-update-existing 'always-push)) + (aio-await (org-gcal-post-at-point-aio-promise)))))) (ert-deftest org-gcal-test--post-at-point-managed-update-existing-org () "Verify ‘org-gcal-post-at-point’ with ‘org-gcal-managed-update-existing-mode’ set to \"org\"." (org-gcal-test--with-temp-buffer - "\ + "\ * My event summary :PROPERTIES: :ETag: \"12344321\" @@ -988,28 +988,28 @@ My event description Second paragraph :END: " - (with-mock - (stub org-gcal--time-zone => '(0 "UTC")) - (stub org-generic-id-add-location => nil) - (stub org-gcal--get-access-token => "my_access_token") - (stub org-gcal--refresh-token => (deferred:succeed "test_access_token")) - (mock (org-gcal--post-event "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" - "My event summary" "Foobar's desk" - `((url . "https://google.com") (title . "Google")) - "My event description\n\nSecond paragraph" - "foo@foobar.com" - * "opaque" "\"12344321\"" "foobar1234" - * * nil)) - (org-gcal-test--dynamic-let - ((org-gcal-managed-update-existing-mode "org") - (org-gcal-managed-post-at-point-update-existing 'always-push)) - (org-gcal-post-at-point))))) + (with-mock + (stub org-gcal--time-zone => '(0 "UTC")) + (stub org-generic-id-add-location => nil) + (stub org-gcal--get-access-token => "my_access_token") + (stub org-gcal--refresh-token => (deferred:succeed "test_access_token")) + (mock (org-gcal--post-event "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" + "My event summary" "Foobar's desk" + `((url . "https://google.com") (title . "Google")) + "My event description\n\nSecond paragraph" + "foo@foobar.com" + * "opaque" "\"12344321\"" "foobar1234" + * * nil)) + (org-gcal-test--dynamic-let + ((org-gcal-managed-update-existing-mode "org") + (org-gcal-managed-post-at-point-update-existing 'always-push)) + (org-gcal-post-at-point))))) (ert-deftest org-gcal-test--post-at-point-aio-managed-update-existing-org () "Verify ‘org-gcal-post-at-point-aio-promise’ with ‘org-gcal-managed-update-existing-mode’ set to \"org\"." (org-gcal-test--with-temp-buffer - "\ + "\ * My event summary :PROPERTIES: :ETag: \"12344321\" @@ -1027,30 +1027,30 @@ My event description Second paragraph :END: " - (org-gcal-test--with-mock-aio - (stub org-gcal--time-zone => '(0 "UTC")) - (stub org-generic-id-add-location => nil) - (stub org-gcal--get-access-token => "my_access_token") - (stub org-gcal--refresh-token-aio => (aio-iter2-lambda () "test_access_token")) - (mock - (org-gcal--post-event-aio "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" - "My event summary" "Foobar's desk" - `((url . "https://google.com") (title . "Google")) - "My event description\n\nSecond paragraph" - "foo@foobar.com" - * "opaque" "\"12344321\"" "foobar1234" - * * nil) - => (aio-iter2-lambda () nil)) - (org-gcal-test--dynamic-let - ((org-gcal-managed-update-existing-mode "org") - (org-gcal-managed-post-at-point-update-existing 'always-push)) - (aio-await (org-gcal-post-at-point-aio-promise)))))) + (org-gcal-test--with-mock-aio + (stub org-gcal--time-zone => '(0 "UTC")) + (stub org-generic-id-add-location => nil) + (stub org-gcal--get-access-token => "my_access_token") + (stub org-gcal--refresh-token-aio => (aio-iter2-lambda () "test_access_token")) + (mock + (org-gcal--post-event-aio "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" + "My event summary" "Foobar's desk" + `((url . "https://google.com") (title . "Google")) + "My event description\n\nSecond paragraph" + "foo@foobar.com" + * "opaque" "\"12344321\"" "foobar1234" + * * nil) + => (aio-iter2-lambda () nil)) + (org-gcal-test--dynamic-let + ((org-gcal-managed-update-existing-mode "org") + (org-gcal-managed-post-at-point-update-existing 'always-push)) + (aio-await (org-gcal-post-at-point-aio-promise)))))) (ert-deftest org-gcal-test--post-at-point-managed-create-from-entry-gcal () "Verify ‘org-gcal-post-at-point’ with ‘org-gcal-managed-create-from-entry-mode’ set to \"gcal\"." (org-gcal-test--with-temp-buffer - "\ + "\ * My event summary :PROPERTIES: :ETag: \"12344321\" @@ -1066,29 +1066,29 @@ My event description Second paragraph :END: " - (with-mock - (stub org-gcal--time-zone => '(0 "UTC")) - (stub org-generic-id-add-location => nil) - (stub org-gcal--get-access-token => "my_access_token") - (stub org-gcal--refresh-token => (deferred:succeed "test_access_token")) - (mock (org-gcal--post-event "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" - "My event summary" "Foobar's desk" - nil - "My event description\n\nSecond paragraph" - "foo@foobar.com" - * "opaque" "\"12344321\"" nil - * * nil)) - (org-gcal-test--dynamic-let - ((org-gcal-managed-update-existing-mode "gcal") - (org-gcal-managed-create-from-entry-mode "gcal") - (org-gcal-managed-post-at-point-update-existing 'always-push)) - (org-gcal-post-at-point))))) + (with-mock + (stub org-gcal--time-zone => '(0 "UTC")) + (stub org-generic-id-add-location => nil) + (stub org-gcal--get-access-token => "my_access_token") + (stub org-gcal--refresh-token => (deferred:succeed "test_access_token")) + (mock (org-gcal--post-event "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" + "My event summary" "Foobar's desk" + nil + "My event description\n\nSecond paragraph" + "foo@foobar.com" + * "opaque" "\"12344321\"" nil + * * nil)) + (org-gcal-test--dynamic-let + ((org-gcal-managed-update-existing-mode "gcal") + (org-gcal-managed-create-from-entry-mode "gcal") + (org-gcal-managed-post-at-point-update-existing 'always-push)) + (org-gcal-post-at-point))))) (ert-deftest org-gcal-test--post-at-point-aio-managed-create-from-entry-gcal () "Verify ‘org-gcal-post-at-point-aio-promise’ with ‘org-gcal-managed-create-from-entry-mode’ set to \"gcal\"." (org-gcal-test--with-temp-buffer - "\ + "\ * My event summary :PROPERTIES: :ETag: \"12344321\" @@ -1104,30 +1104,30 @@ My event description Second paragraph :END: " - (org-gcal-test--with-mock-aio - (stub org-gcal--time-zone => '(0 "UTC")) - (stub org-generic-id-add-location => nil) - (stub org-gcal--get-access-token => "my_access_token") - (stub org-gcal--refresh-token-aio => (aio-iter2-lambda () "test_access_token")) - (mock (org-gcal--post-event-aio "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" - "My event summary" "Foobar's desk" - nil - "My event description\n\nSecond paragraph" - "foo@foobar.com" - * "opaque" "\"12344321\"" nil - * * nil) - => (aio-iter2-lambda () nil)) - (org-gcal-test--dynamic-let - ((org-gcal-managed-update-existing-mode "gcal") - (org-gcal-managed-create-from-entry-mode "gcal") - (org-gcal-managed-post-at-point-update-existing 'always-push)) - (aio-await (org-gcal-post-at-point-aio-promise)))))) + (org-gcal-test--with-mock-aio + (stub org-gcal--time-zone => '(0 "UTC")) + (stub org-generic-id-add-location => nil) + (stub org-gcal--get-access-token => "my_access_token") + (stub org-gcal--refresh-token-aio => (aio-iter2-lambda () "test_access_token")) + (mock (org-gcal--post-event-aio "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" + "My event summary" "Foobar's desk" + nil + "My event description\n\nSecond paragraph" + "foo@foobar.com" + * "opaque" "\"12344321\"" nil + * * nil) + => (aio-iter2-lambda () nil)) + (org-gcal-test--dynamic-let + ((org-gcal-managed-update-existing-mode "gcal") + (org-gcal-managed-create-from-entry-mode "gcal") + (org-gcal-managed-post-at-point-update-existing 'always-push)) + (aio-await (org-gcal-post-at-point-aio-promise)))))) (ert-deftest org-gcal-test--post-at-point-managed-create-from-entry-org () "Verify ‘org-gcal-post-at-point’ with ‘org-gcal-managed-create-from-entry-mode’ set to \"org\"." (org-gcal-test--with-temp-buffer - "\ + "\ * My event summary :PROPERTIES: :ETag: \"12344321\" @@ -1144,21 +1144,21 @@ My event description Second paragraph :END: " - (with-mock - (stub org-gcal--time-zone => '(0 "UTC")) - (stub org-generic-id-add-location => nil) - (stub org-gcal--get-access-token => "my_access_token") - (stub org-gcal--refresh-token => (deferred:succeed "test_access_token")) - (mock (org-gcal--post-event "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" - "My event summary" "Foobar's desk" - `((url . "https://google.com") (title . "Google")) - "My event description\n\nSecond paragraph" - "foo@foobar.com" - * "opaque" "\"12344321\"" nil - * * nil)) - (let ((org-gcal-managed-update-existing-mode "gcal") - (org-gcal-managed-create-from-entry-mode "org")) - (org-gcal-post-at-point))))) + (with-mock + (stub org-gcal--time-zone => '(0 "UTC")) + (stub org-generic-id-add-location => nil) + (stub org-gcal--get-access-token => "my_access_token") + (stub org-gcal--refresh-token => (deferred:succeed "test_access_token")) + (mock (org-gcal--post-event "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" + "My event summary" "Foobar's desk" + `((url . "https://google.com") (title . "Google")) + "My event description\n\nSecond paragraph" + "foo@foobar.com" + * "opaque" "\"12344321\"" nil + * * nil)) + (let ((org-gcal-managed-update-existing-mode "gcal") + (org-gcal-managed-create-from-entry-mode "org")) + (org-gcal-post-at-point))))) (ert-deftest org-gcal-test--post-at-point-old-id-property () "Verify that \":ID:\" property is read for event ID by \ @@ -1252,21 +1252,21 @@ My event description Second paragraph :END: " - (with-mock - (stub org-gcal--time-zone => '(0 "UTC")) - (stub org-generic-id-add-location => nil) - (stub org-gcal--get-access-token => "my_access_token") - (stub org-gcal--refresh-token => (deferred:succeed "test_access_token")) - (mock (org-gcal--post-event "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" - "My event summary" "Foobar's desk" - `((url . "https://google.com") (title . "Google")) - "My event description\n\nSecond paragraph" - "foo@foobar.com" - * "opaque" nil nil - * * *)) - (org-gcal-post-at-point))) + (with-mock + (stub org-gcal--time-zone => '(0 "UTC")) + (stub org-generic-id-add-location => nil) + (stub org-gcal--get-access-token => "my_access_token") + (stub org-gcal--refresh-token => (deferred:succeed "test_access_token")) + (mock (org-gcal--post-event "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" + "My event summary" "Foobar's desk" + `((url . "https://google.com") (title . "Google")) + "My event description\n\nSecond paragraph" + "foo@foobar.com" + * "opaque" nil nil + * * *)) + (org-gcal-post-at-point))) (org-gcal-test--with-temp-buffer - "\ + "\ * My event summary :PROPERTIES: :LOCATION: Foobar's desk @@ -1283,19 +1283,19 @@ My event description Second paragraph :END: " - (with-mock - (stub org-gcal--time-zone => '(0 "UTC")) - (stub org-generic-id-add-location => nil) - (stub org-gcal--get-access-token => "my_access_token") - (stub org-gcal--refresh-token => (deferred:succeed "test_access_token")) - (mock (org-gcal--post-event "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" - "My event summary" "Foobar's desk" - `((url . "https://google.com") (title . "Google")) - "My event description\n\nSecond paragraph" - "foo@foobar.com" - * "opaque" nil nil - * * *)) - (org-gcal-post-at-point)))) + (with-mock + (stub org-gcal--time-zone => '(0 "UTC")) + (stub org-generic-id-add-location => nil) + (stub org-gcal--get-access-token => "my_access_token") + (stub org-gcal--refresh-token => (deferred:succeed "test_access_token")) + (mock (org-gcal--post-event "2019-10-06T17:00:00Z" "2019-10-06T21:00:00Z" + "My event summary" "Foobar's desk" + `((url . "https://google.com") (title . "Google")) + "My event description\n\nSecond paragraph" + "foo@foobar.com" + * "opaque" nil nil + * * *)) + (org-gcal-post-at-point)))) (ert-deftest org-gcal-test--post-at-point-no-properties () "Verify that ‘org-gcal-post-to-point’ fills in entries with no relevant @@ -1448,13 +1448,13 @@ Second paragraph (stub alert => t) (stub request-deferred => (deferred:succeed - (make-request-response - :status-code 500 - :error-thrown '(error . nil)))) + (make-request-response + :status-code 500 + :error-thrown '(error . nil)))) (deferred:sync! - (deferred:$ - (org-gcal-delete-at-point) - (deferred:error it #'ignore))) + (deferred:$ + (org-gcal-delete-at-point) + (deferred:error it #'ignore))) (org-back-to-heading) (should (re-search-forward ":org-gcal:" nil 'noerror)))) @@ -1470,8 +1470,8 @@ Second paragraph (stub y-or-n-p => t) (stub request-deferred => (deferred:succeed - (make-request-response - :status-code 200))) + (make-request-response + :status-code 200))) (deferred:sync! (org-gcal-delete-at-point)) (org-back-to-heading) (should-not (re-search-forward ":org-gcal:" nil 'noerror))))) @@ -1488,26 +1488,26 @@ Second paragraph (stub y-or-n-p => t) (stub request-deferred => (deferred:succeed - (make-request-response - :status-code 200))) + (make-request-response + :status-code 200))) (deferred:sync! (org-gcal-delete-at-point)) (should (equal (buffer-string) ""))))))) (ert-deftest org-gcal-test--save-with-full-day-event () "Verify that a full day event will get set correctly." - (org-gcal-test--with-temp-buffer - "* " - (org-gcal--update-entry org-gcal-test-calendar-id - org-gcal-test-full-day-event) - (org-back-to-heading) + (org-gcal-test--with-temp-buffer + "* " + (org-gcal--update-entry org-gcal-test-calendar-id + org-gcal-test-full-day-event) + (org-back-to-heading) ;; Check contents of "org-gcal" drawer - (re-search-forward ":org-gcal:") - (let ((elem (org-element-at-point))) - (should (equal (buffer-substring-no-properties - (org-element-property :contents-begin elem) - (org-element-property :contents-end elem)) - "\ + (re-search-forward ":org-gcal:") + (let ((elem (org-element-at-point))) + (should (equal (buffer-substring-no-properties + (org-element-property :contents-begin elem) + (org-element-property :contents-end elem)) + "\ <2019-10-06 Sun> My event description @@ -1519,18 +1519,18 @@ Second paragraph "Verify that a full day event will get set correctly when local-timezone is set." (let ( (org-gcal-local-timezone "Europe/London")) - (org-gcal-test--with-temp-buffer - "* " - (org-gcal--update-entry org-gcal-test-calendar-id - org-gcal-test-full-day-event) - (org-back-to-heading) - ;; Check contents of "org-gcal" drawer - (re-search-forward ":org-gcal:") - (let ((elem (org-element-at-point))) - (should (equal (buffer-substring-no-properties - (org-element-property :contents-begin elem) - (org-element-property :contents-end elem)) - "\ + (org-gcal-test--with-temp-buffer + "* " + (org-gcal--update-entry org-gcal-test-calendar-id + org-gcal-test-full-day-event) + (org-back-to-heading) + ;; Check contents of "org-gcal" drawer + (re-search-forward ":org-gcal:") + (let ((elem (org-element-at-point))) + (should (equal (buffer-substring-no-properties + (org-element-property :contents-begin elem) + (org-element-property :contents-end elem)) + "\ <2019-10-06 Sun> My event description @@ -1542,16 +1542,16 @@ Second paragraph "Test handling of ERT failures in deferred code. Should fail." :expected-result :failed (with-mock - (stub request-deferred => - (deferred:$ - (deferred:succeed - (ert-fail "Failure")) - (deferred:nextc it - (lambda (_) - (deferred:succeed "Success"))))) - (should (equal - (deferred:sync! (request-deferred)) - "Success")))) + (stub request-deferred => + (deferred:$ + (deferred:succeed + (ert-fail "Failure")) + (deferred:nextc it + (lambda (_) + (deferred:succeed "Success"))))) + (should (equal + (deferred:sync! (request-deferred)) + "Success")))) (ert-deftest org-gcal-test--ert-fail-aio () "Test handling of ERT failures in aio code. Should fail." @@ -1559,11 +1559,11 @@ Second paragraph (should (equal "Success" (org-gcal-test--with-mock-aio - (stub org-gcal--aio-request => - (aio-iter2-lambda (&rest _args) - (ert-fail "Failure"))) - (let ((res (aio-await (org-gcal--aio-request)))) - res))))) + (stub org-gcal--aio-request => + (aio-iter2-lambda (&rest _args) + (ert-fail "Failure"))) + (let ((res (aio-await (org-gcal--aio-request)))) + res))))) (ert-deftest org-gcal-test--convert-time-to-local-timezone() (should (equal @@ -1578,19 +1578,19 @@ Second paragraph (should (equal (org-gcal--convert-time-to-local-timezone "2021-03-03T11:30:00-08:00" "Europe/London") "2021-03-03T19:30:00+0000"))) - ;; FIXME: Passed in local with Emacs 26.3 and 27.1, Failed in GitHub CI - ;; (should (equal - ;; (org-gcal--convert-time-to-local-timezone "2021-03-03T11:30:00-08:00" "Europe/Oslo") - ;; "2021-03-03T20:30:00+0100")) - ;; (should (equal - ;; (org-gcal--convert-time-to-local-timezone "2021-03-03T11:30:00-08:00" "America/New_York") - ;; "2021-03-03T14:30:00-0500")) - ;; (should (equal - ;; (org-gcal--convert-time-to-local-timezone "2021-03-03T11:30:00-08:00" "America/Los_Angeles") - ;; "2021-03-03T11:30:00-0800")) - ;; (should (equal - ;; (org-gcal--convert-time-to-local-timezone "2021-03-03T11:30:00-08:00" "Asia/Shanghai") - ;; "2021-03-04T03:30:00+0800")) +;; FIXME: Passed in local with Emacs 26.3 and 27.1, Failed in GitHub CI +;; (should (equal +;; (org-gcal--convert-time-to-local-timezone "2021-03-03T11:30:00-08:00" "Europe/Oslo") +;; "2021-03-03T20:30:00+0100")) +;; (should (equal +;; (org-gcal--convert-time-to-local-timezone "2021-03-03T11:30:00-08:00" "America/New_York") +;; "2021-03-03T14:30:00-0500")) +;; (should (equal +;; (org-gcal--convert-time-to-local-timezone "2021-03-03T11:30:00-08:00" "America/Los_Angeles") +;; "2021-03-03T11:30:00-0800")) +;; (should (equal +;; (org-gcal--convert-time-to-local-timezone "2021-03-03T11:30:00-08:00" "Asia/Shanghai") +;; "2021-03-04T03:30:00+0800")) (ert-deftest org-gcal-test--headline-archive-old-event () @@ -1601,10 +1601,10 @@ Also tests that the `org-gcal--archive-old-event' function does not loop over and over, archiving the same entry because it is under another heading in the same file." (with-mock - (stub org-gcal--time-zone => '(0 "UTC")) - (let ((org-archive-location "::* Archived") ; Make the archive this same buffer - (test-time "2022-01-30 Sun 01:23") - (buf "\ + (stub org-gcal--time-zone => '(0 "UTC")) + (let ((org-archive-location "::* Archived") ; Make the archive this same buffer + (test-time "2022-01-30 Sun 01:23") + (buf "\ #+CATEGORY: Test * Event Title @@ -1615,30 +1615,30 @@ under another heading in the same file." <2021-01-01 Fri 12:34-14:35> :END: ")) - (org-test-with-temp-text-in-file - buf - (org-test-at-time (format "<%s>" test-time) - ;; Ensure property drawer is not indented - (setq-local org-adapt-indentation nil) - (org-gcal--archive-old-event) - ;; Go to archived headline - (goto-char (point-min)) - (re-search-forward "^\\*\\* ") - ;; Examine individual properties to make the test less sensitive to - ;; formatting differences. - (should (equal (org-gcal--headline) - "Event Title")) - (should (equal (org-entry-get (point) "org-gcal-managed") - "something")) - (should (equal (org-entry-get (point) "ARCHIVE_TIME") - test-time)) - (should (equal (org-entry-get (point) "ARCHIVE_CATEGORY") - "Test")) - (let ((time-desc (org-gcal--get-time-and-desc))) - (should (equal time-desc - '(:start "2021-01-01T12:34:00Z" - :end "2021-01-01T14:35:00Z" - :desc ""))))))))) + (org-test-with-temp-text-in-file + buf + (org-test-at-time (format "<%s>" test-time) + ;; Ensure property drawer is not indented + (setq-local org-adapt-indentation nil) + (org-gcal--archive-old-event) + ;; Go to archived headline + (goto-char (point-min)) + (re-search-forward "^\\*\\* ") + ;; Examine individual properties to make the test less sensitive to + ;; formatting differences. + (should (equal (org-gcal--headline) + "Event Title")) + (should (equal (org-entry-get (point) "org-gcal-managed") + "something")) + (should (equal (org-entry-get (point) "ARCHIVE_TIME") + test-time)) + (should (equal (org-entry-get (point) "ARCHIVE_CATEGORY") + "Test")) + (let ((time-desc (org-gcal--get-time-and-desc))) + (should (equal time-desc + '(:start "2021-01-01T12:34:00Z" + :end "2021-01-01T14:35:00Z" + :desc ""))))))))) ;;; TODO: Figure out mocking for POST/PATCH followed by GET ;;; - ‘mock‘ might work for this - the argument list must be specified up