org-agenda-to-appt with async.el

my-agenda-to-appt-async.el

(when (autoload-if-found
       '(appt my-org-agenda-to-appt ad:appt-display-message
              ad:appt-disp-window)
       "appt" nil t)

  (with-eval-after-load "postpone"
    (global-set-key (kbd "C-c f 3") #'my-org-agenda-to-appt))

  (with-eval-after-load "appt"
    ;; window を フレーム内に表示する
    (setq appt-display-format 'echo)

    ;; window を継続表示する時間[s]
    (setq appt-display-duration 5)

    ;; ビープ音の有無
    (setq appt-audible nil)

    ;; 何分前から警告表示を開始するか[m]
    (setq appt-message-warning-time 20)

    ;; 警告表示開始から何分ごとにリマインドするか[m]
    (setq appt-display-interval 1)

    ;; appt-display-format が 'echo でも appt-disp-window-function を呼ぶ
    (defun ad:appt-display-message (string mins)
      "Display a reminder about an appointment.
The string STRING describes the appointment, due in integer MINS minutes.
The arguments may also be lists, where each element relates to a
separate appointment.  The variable `appt-display-format' controls
the format of the visible reminder.  If `appt-audible' is non-nil,
also calls `beep' for an audible reminder."
      (if appt-audible (beep 1))
      ;; Backwards compatibility: avoid passing lists to a-d-w-f if not necessary.
      (and (listp mins)
           (= (length mins) 1)
           (setq mins (car mins)
                 string (car string)))
      (when (memq appt-display-format '(window echo))
        (let ((time (format-time-string "%a %b %e "))
              err)
          (condition-case err
              (funcall appt-disp-window-function
                       (if (listp mins)
                           (mapcar 'number-to-string mins)
                         (number-to-string mins))
                       time string)
            (wrong-type-argument
             (if (not (listp mins))
                 (signal (car err) (cdr err))
               (message "Argtype error in `appt-disp-window-function' - \
update it for multiple appts?")
               ;; Fallback to just displaying the first appt, as we used to.
               (funcall appt-disp-window-function
                        (number-to-string (car mins)) time
                        (car string)))))
          err))
      (cond ((eq appt-display-format 'window)
             ;; TODO use calendar-month-abbrev-array rather than %b?
             (run-at-time (format "%d sec" appt-display-duration)
                          nil
                          appt-delete-window-function))
            ((eq appt-display-format 'echo)
             (message "%s" (if (listp string)
                               (mapconcat 'identity string "\n")
                             string)))))
    (advice-add 'appt-display-message :override #'ad:appt-display-message)

    (defun ad:appt-disp-window (min-to-app _new-time appt-msg)
      "Extension to support appt-disp-window."
      (if (string= min-to-app "0")
          (my-desktop-notification "### Expired! ###" appt-msg t "Glass")
        (my-desktop-notification
         (concat "in " min-to-app " min.") appt-msg nil "Tink")))
    (cond
     ((eq appt-display-format 'echo)
      (setq appt-disp-window-function 'ad:appt-disp-window))
     ((eq appt-display-format 'window)
      (advice-add 'appt-disp-window :before #'ad:appt-disp-window))))

  (with-eval-after-load "org"
    ;; アジェンダを開いたらアラームリストを更新して有効化する
    (unless noninteractive
      (add-hook 'org-agenda-mode-hook #'my-org-agenda-to-appt) ;; init
      (appt-activate 1))
    ;; 重複実行の抑制用フラグ
    (defvar my-org-agenda-to-appt-ready t)
    ;; org-agenda の内容をアラームに登録する
    (defun my-org-agenda-to-appt ()
      "Update `appt-time-mag-list'.  Use `async' if possible."
      (interactive)
      (if (not (require 'async nil t))
          (org-agenda-to-appt t '((headline "TODO")))
        (when my-org-agenda-to-appt-ready
          (setq my-org-agenda-to-appt-ready nil)
          (async-start
           `(lambda ()
              (setq org-agenda-files ',org-agenda-files)
              (org-agenda-to-appt t '((headline "TODO")))
              appt-time-msg-list)
           (lambda (result)
             (setq appt-time-msg-list result)
             (let ((cnt (length appt-time-msg-list)))
               (if (eq cnt 0)
                   (message "No event to add")
                 (message "Added %d event%s for today"
                          cnt (if (> cnt 1) "s" ""))))
             (setq my-org-agenda-to-appt-ready t))))))
    ;; 定期的に更新する
    (run-with-idle-timer 500 t 'my-org-agenda-to-appt)
    ;; キャプチャ直後に更新
    (add-hook 'org-capture-before-finalize-hook #'my-org-agenda-to-appt))