Function: forge--pull-notifications

forge--pull-notifications is a byte-compiled function defined in forge-github.el.

Signature

(forge--pull-notifications ARG &rest ARGS)

Implementations

(forge--pull-notifications (CLASS (subclass forge-github-repository)) GITHOST &optional CALLBACK) in `forge-github.el'.

Undocumented

Source Code

;; Defined in ~/.emacs.d/elpa/forge-20260408.1922/forge-github.el
;;;; Notifications

(cl-defmethod forge--pull-notifications
  ((_class (subclass forge-github-repository)) githost &optional callback)
  ;; The GraphQL API doesn't support notifications and support in the
  ;; REST API is abysmal -- forcing us to perform a major rain dance.
  (let ((buffer (current-buffer))
        (spec (forge--get-forge-host githost t)))
    (forge--msg nil t nil "Pulling notifications")
    (pcase-let*
        ((`(,_ ,apihost ,forge ,_) spec)
         (since (forge--ghub-notifications-since forge))
         (notifs
          (seq-keep (lambda (data)
                      ;; Github returns notifications for repositories the
                      ;; user no longer has access to.  Trying to retrieve
                      ;; information for such repositories leads to errors,
                      ;; which we suppress.  See #164.
                      (with-demoted-errors "forge--pull-notifications: %S"
                        (forge--ghub-massage-notification data githost)))
                    (forge-rest apihost "GET" "/notifications"
                      ((all t)
                       (and since (since since)))
                      :unpaginate t)))
         ;; Split into multiple requests to reduce risk of timeouts.
         (groups (seq-partition notifs 50))
         (pages  (length groups))
         (page   0)
         (topics nil))
      (cl-labels
          ((cb (&optional data _headers _status _req)
             (when data
               (setq topics (nconc topics (cdr data))))
             (if groups
                 (let* ((query (cons 'query (seq-keep #'caddr (pop groups))))
                        (tries 3)
                        (errorback nil)
                        (vacuum (lambda ()
                                  (forge--query apihost query nil
                                    :callback #'cb
                                    :errorback errorback))))
                   ;; Github also returns notifications for issues
                   ;; belonging to repositories for which issues
                   ;; have been disabled.  Drop them and try again.
                   (setq errorback
                         (lambda (errors _headers _status _req)
                           (if (zerop tries)
                               (ghub--signal-error errors)
                             (cl-decf tries)
                             (cond-let
                               ([notfound
                                 (seq-keep
                                  (lambda (err)
                                    (and (equal (cdr (assq 'type err))
                                                "NOT_FOUND")
                                         (cadr (assq 'path err))
                                         (intern (cadr (assq 'path err)))))
                                  (cdr errors))]
                                (setq query (cl-delete-if (##memq % notfound)
                                                          query :key #'caar))
                                (funcall vacuum))
                               ((ghub--signal-error errors))))))
                   (cl-incf page)
                   (forge--msg nil t nil
                               "Pulling notifications (page %s/%s)" page pages)
                   (funcall vacuum))
               (forge--msg nil t t   "Pulling notifications")
               (forge--msg nil t nil "Storing notifications")
               (forge--ghub-update-notifications notifs topics (not since))
               (forge--msg nil t t "Storing notifications")
               (forge-refresh-buffer buffer)
               (when callback
                 (funcall callback)))))
        (cb)))))