340 lines
13 KiB
EmacsLisp
340 lines
13 KiB
EmacsLisp
|
;;; forge-notify.el --- Notify support -*- lexical-binding:t -*-
|
||
|
|
|
||
|
|
;; Copyright (C) 2018-2026 Jonas Bernoulli
|
||
|
|
|
||
|
|
;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
|
||
|
|
;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
|
||
|
|
|
||
|
|
;; SPDX-License-Identifier: GPL-3.0-or-later
|
||
|
|
|
||
|
|
;; This file is free software: you can redistribute it and/or modify
|
||
|
|
;; it under the terms of the GNU General Public License as published
|
||
|
|
;; by the Free Software Foundation, either version 3 of the License,
|
||
|
|
;; or (at your option) any later version.
|
||
|
|
;;
|
||
|
|
;; This file is distributed in the hope that it will be useful,
|
||
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
|
|
;; GNU General Public License for more details.
|
||
|
|
;;
|
||
|
|
;; You should have received a copy of the GNU General Public License
|
||
|
|
;; along with this file. If not, see <https://www.gnu.org/licenses/>.
|
||
|
|
|
||
|
|
;;; Code:
|
||
|
|
|
||
|
|
(require 'forge)
|
||
|
|
(require 'forge-topic)
|
||
|
|
|
||
|
|
;;; Class
|
||
|
|
|
||
|
|
(defclass forge-notification (forge-object)
|
||
|
|
((closql-class-prefix :initform "forge-")
|
||
|
|
(closql-table :initform 'notification)
|
||
|
|
(closql-primary-key :initform 'id)
|
||
|
|
(closql-order-by :initform [(desc id)])
|
||
|
|
(id :initarg :id)
|
||
|
|
(thread-id :initarg :thread-id)
|
||
|
|
(repository :initarg :repository)
|
||
|
|
(type :initarg :type)
|
||
|
|
(topic :initarg :topic)
|
||
|
|
(url :initarg :url)
|
||
|
|
(title :initarg :title)
|
||
|
|
(reason :initarg :reason)
|
||
|
|
(last-read :initarg :last-read)
|
||
|
|
(updated :initarg :updated)))
|
||
|
|
|
||
|
|
;;; Query
|
||
|
|
;;;; Get
|
||
|
|
|
||
|
|
(cl-defmethod forge-get-repository ((notify forge-notification))
|
||
|
|
"Return the object for the repository that NOTIFY belongs to."
|
||
|
|
(and-let ((id (oref notify repository)))
|
||
|
|
(closql-get (forge-db) id 'forge-repository)))
|
||
|
|
|
||
|
|
(cl-defmethod forge-get-topic ((notify forge-notification))
|
||
|
|
(and-let ((repo (forge-get-repository notify)))
|
||
|
|
(forge-get-topic repo (oref notify topic))))
|
||
|
|
|
||
|
|
(cl-defmethod forge-get-notification ((id string))
|
||
|
|
(closql-get (forge-db) id 'forge-notification))
|
||
|
|
|
||
|
|
(cl-defmethod forge-get-notification ((topic forge-topic))
|
||
|
|
(and-let ((row (car (forge-sql [:select * :from notification
|
||
|
|
:where (and (= repository $s1)
|
||
|
|
(= topic $s2))]
|
||
|
|
(oref topic repository)
|
||
|
|
(oref topic number)))))
|
||
|
|
(closql--remake-instance 'forge-notification (forge-db) row)))
|
||
|
|
|
||
|
|
;;;; Current
|
||
|
|
|
||
|
|
(defun forge-current-notification (&optional demand)
|
||
|
|
"Return the current notification, casting a topic if necessary.
|
||
|
|
If there is no such notification and DEMAND is non-nil, then
|
||
|
|
signal an error."
|
||
|
|
(or (magit-section-value-if 'notification)
|
||
|
|
(and$ (forge-current-topic)
|
||
|
|
(forge-get-notification $))
|
||
|
|
(and demand (user-error "No current notification"))))
|
||
|
|
|
||
|
|
(defun forge-notification-at-point (&optional demand)
|
||
|
|
"Return the notification at point, casting a topic if necessary.
|
||
|
|
If there is no such notification and DEMAND is non-nil, then
|
||
|
|
signal an error."
|
||
|
|
(or (magit-section-value-if 'notification)
|
||
|
|
(and$ (forge-topic-at-point)
|
||
|
|
(forge-get-notification $))
|
||
|
|
(and demand (user-error "No notification at point"))))
|
||
|
|
|
||
|
|
;;;; List
|
||
|
|
|
||
|
|
(defun forge--ls-notifications (status)
|
||
|
|
(let* ((status (ensure-list status))
|
||
|
|
(savedp (memq 'saved status))
|
||
|
|
(status (remq 'saved status)))
|
||
|
|
(mapcar
|
||
|
|
(partial #'closql--remake-instance 'forge-notification (forge-db))
|
||
|
|
(if (seq-set-equal-p status '(unread pending done) #'eq)
|
||
|
|
(forge-sql [:select * :from notification :order-by [(desc updated)]])
|
||
|
|
(forge-sql
|
||
|
|
`[:select :distinct notification:*
|
||
|
|
:from [notification (as issue topic)]
|
||
|
|
:where (and (= notification:topic topic:id)
|
||
|
|
,@(and status '((in topic:status $v1)))
|
||
|
|
,@(and savedp '((= topic:saved-p 't))))
|
||
|
|
:union
|
||
|
|
:select :distinct notification:*
|
||
|
|
:from [notification (as pullreq topic)]
|
||
|
|
:where (and (= notification:topic topic:id)
|
||
|
|
,@(and status '((in topic:status $v1)))
|
||
|
|
,@(and savedp '((= topic:saved-p 't))))
|
||
|
|
:order-by [(desc notification:updated)]]
|
||
|
|
(vconcat status))))))
|
||
|
|
|
||
|
|
;;; Mode
|
||
|
|
|
||
|
|
(defvar-keymap forge-notifications-mode-map
|
||
|
|
:doc "Keymap for `forge-notifications-mode'."
|
||
|
|
:parent (make-composed-keymap forge-common-map magit-mode-map)
|
||
|
|
"<remap> <magit-refresh>" #'magit-refresh-buffer
|
||
|
|
"<remap> <forge--list-menu>" #'forge-notifications-menu)
|
||
|
|
|
||
|
|
(define-derived-mode forge-notifications-mode magit-mode "Forge Notifications"
|
||
|
|
"Major mode for looking at forge notifications."
|
||
|
|
:interactive nil
|
||
|
|
(magit-hack-dir-local-variables))
|
||
|
|
|
||
|
|
(defun forge-notifications-setup-buffer ()
|
||
|
|
(magit-setup-buffer #'forge-notifications-mode nil
|
||
|
|
:buffer (get-buffer-create "*forge-notifications*")
|
||
|
|
(default-directory "/")
|
||
|
|
(forge-buffer-unassociated-p t)))
|
||
|
|
|
||
|
|
(defun forge-notifications-refresh-buffer ()
|
||
|
|
(magit-set-header-line-format (forge-notifications-buffer-desc))
|
||
|
|
(forge-insert-notifications))
|
||
|
|
|
||
|
|
(defun forge-notifications-buffer-desc ()
|
||
|
|
(let ((status forge-notifications-selection))
|
||
|
|
(cond
|
||
|
|
((not (listp status))
|
||
|
|
(format "%s notifications" (capitalize (symbol-name status))))
|
||
|
|
((seq-set-equal-p status '(unread pending)) "Inbox")
|
||
|
|
((seq-set-equal-p status '(unread pending done)) "All notifications")
|
||
|
|
((format "Notifications %s" status)))))
|
||
|
|
|
||
|
|
(defvar forge-notifications-display-style 'flat)
|
||
|
|
(defvar forge-notifications-selection '(unread pending))
|
||
|
|
|
||
|
|
;;; Commands
|
||
|
|
|
||
|
|
(transient-define-prefix forge-notifications-menu ()
|
||
|
|
"Control list of notifications and notification at point."
|
||
|
|
:transient-suffix t
|
||
|
|
:transient-non-suffix #'transient--do-call
|
||
|
|
:transient-switch-frame nil
|
||
|
|
:refresh-suffixes t
|
||
|
|
:environment #'forge--menu-environment
|
||
|
|
:column-widths forge--topic-menus-column-widths
|
||
|
|
[:hide always ("q" forge-menu-quit-list)]
|
||
|
|
[forge--topic-menus-group
|
||
|
|
["Selection"
|
||
|
|
("I" forge-notifications-display-inbox)
|
||
|
|
("S" forge-notifications-display-saved)
|
||
|
|
("D" forge-notifications-display-done)
|
||
|
|
("A" forge-notifications-display-all)]]
|
||
|
|
[forge--lists-group
|
||
|
|
["Display"
|
||
|
|
("-F" forge-notifications-style-flat)
|
||
|
|
("-G" forge-notifications-style-nested)
|
||
|
|
("-H" forge-toggle-topic-legend)]]
|
||
|
|
[forge--topic-legend-group]
|
||
|
|
(interactive)
|
||
|
|
(unless (derived-mode-p 'forge-notifications-mode)
|
||
|
|
(forge-list-notifications))
|
||
|
|
(transient-setup 'forge-notifications-menu))
|
||
|
|
|
||
|
|
(transient-augment-suffix forge-notifications-menu
|
||
|
|
:transient #'transient--do-replace
|
||
|
|
:if-mode 'forge-notifications-mode
|
||
|
|
:inapt-if (##eq (oref transient--prefix command) 'forge-notifications-menu)
|
||
|
|
:inapt-face 'forge-suffix-active)
|
||
|
|
|
||
|
|
;;;###autoload(autoload 'forge-list-notifications "forge-notify" nil t)
|
||
|
|
(transient-define-suffix forge-list-notifications ()
|
||
|
|
"List notifications."
|
||
|
|
:inapt-if-mode 'forge-notifications-mode
|
||
|
|
:inapt-face 'forge-suffix-active
|
||
|
|
(declare (interactive-only nil))
|
||
|
|
(interactive)
|
||
|
|
(forge-notifications-setup-buffer)
|
||
|
|
(transient-setup 'forge-notifications-menu))
|
||
|
|
|
||
|
|
(transient-define-suffix forge-notifications-display-inbox ()
|
||
|
|
"List unread and pending notifications."
|
||
|
|
:description "inbox"
|
||
|
|
:inapt-if (##equal forge-notifications-selection '(unread pending))
|
||
|
|
:inapt-face 'forge-suffix-active
|
||
|
|
(interactive)
|
||
|
|
(unless (derived-mode-p 'forge-notifications-mode)
|
||
|
|
(user-error "Not in notification buffer"))
|
||
|
|
(setq forge-notifications-selection '(unread pending))
|
||
|
|
(forge-refresh-buffer))
|
||
|
|
|
||
|
|
(transient-define-suffix forge-notifications-display-saved ()
|
||
|
|
"List saved notifications."
|
||
|
|
:description "saved"
|
||
|
|
:inapt-if (##eq forge-notifications-selection 'saved)
|
||
|
|
:inapt-face 'forge-suffix-active
|
||
|
|
(interactive)
|
||
|
|
(unless (derived-mode-p 'forge-notifications-mode)
|
||
|
|
(user-error "Not in notification buffer"))
|
||
|
|
(setq forge-notifications-selection 'saved)
|
||
|
|
(forge-refresh-buffer))
|
||
|
|
|
||
|
|
(transient-define-suffix forge-notifications-display-done ()
|
||
|
|
"List done notifications."
|
||
|
|
:description "done"
|
||
|
|
:inapt-if (##eq forge-notifications-selection 'done)
|
||
|
|
:inapt-face 'forge-suffix-active
|
||
|
|
(interactive)
|
||
|
|
(unless (derived-mode-p 'forge-notifications-mode)
|
||
|
|
(user-error "Not in notification buffer"))
|
||
|
|
(setq forge-notifications-selection 'done)
|
||
|
|
(forge-refresh-buffer))
|
||
|
|
|
||
|
|
(transient-define-suffix forge-notifications-display-all ()
|
||
|
|
"List all notifications."
|
||
|
|
:description "all"
|
||
|
|
:inapt-if (##equal forge-notifications-selection '(unread pending done))
|
||
|
|
:inapt-face 'forge-suffix-active
|
||
|
|
(interactive)
|
||
|
|
(unless (derived-mode-p 'forge-notifications-mode)
|
||
|
|
(user-error "Not in notification buffer"))
|
||
|
|
(setq forge-notifications-selection '(unread pending done))
|
||
|
|
(forge-refresh-buffer))
|
||
|
|
|
||
|
|
(transient-define-suffix forge-notifications-style-flat ()
|
||
|
|
"Show a flat notification list."
|
||
|
|
:description "single list"
|
||
|
|
:inapt-if (##eq forge-notifications-display-style 'flat)
|
||
|
|
:inapt-face 'forge-suffix-active
|
||
|
|
(interactive)
|
||
|
|
(unless (derived-mode-p 'forge-notifications-mode)
|
||
|
|
(user-error "Not in notification buffer"))
|
||
|
|
(setq forge-notifications-display-style 'flat)
|
||
|
|
(forge-refresh-buffer))
|
||
|
|
|
||
|
|
(transient-define-suffix forge-notifications-style-nested ()
|
||
|
|
"Group notifications by repository."
|
||
|
|
:description "group by repo"
|
||
|
|
:inapt-if (##eq forge-notifications-display-style 'nested)
|
||
|
|
:inapt-face 'forge-suffix-active
|
||
|
|
(interactive)
|
||
|
|
(unless (derived-mode-p 'forge-notifications-mode)
|
||
|
|
(user-error "Not in notification buffer"))
|
||
|
|
(setq forge-notifications-display-style 'nested)
|
||
|
|
(forge-refresh-buffer))
|
||
|
|
|
||
|
|
;;; Sections
|
||
|
|
|
||
|
|
(defclass forge-repository-section (magit-section)
|
||
|
|
((type :initform 'forge-repo)
|
||
|
|
(keymap :initform 'forge-repository-section-map)))
|
||
|
|
|
||
|
|
(define-obsolete-variable-alias 'forge-forge-repo-section-map
|
||
|
|
'forge-repository-section-map "Forge 0.4.0")
|
||
|
|
|
||
|
|
(defvar-keymap forge-repository-section-map
|
||
|
|
"<remap> <magit-browse-thing>" #'forge-browse-this-repository
|
||
|
|
"<remap> <magit-visit-thing>" #'forge-visit-this-repository)
|
||
|
|
|
||
|
|
(defun forge-insert-notifications ()
|
||
|
|
(let ((notifs (forge--ls-notifications forge-notifications-selection)))
|
||
|
|
(magit-insert-section (notifications)
|
||
|
|
(cond
|
||
|
|
((not notifs)
|
||
|
|
(insert "(empty)\n"))
|
||
|
|
((eq forge-notifications-display-style 'flat)
|
||
|
|
(magit-insert-section-body
|
||
|
|
(dolist (notif notifs)
|
||
|
|
(forge-insert-notification notif))
|
||
|
|
(insert ?\n)))
|
||
|
|
((pcase-dolist (`(,_ . ,notifs)
|
||
|
|
(seq-group-by (##oref % repository) notifs))
|
||
|
|
(let ((repo (forge-get-repository (car notifs))))
|
||
|
|
(magit-insert-section (forge-repo repo)
|
||
|
|
(magit-insert-heading
|
||
|
|
(concat (propertize (oref repo slug) 'font-lock-face 'bold)
|
||
|
|
(format " (%s)" (length notifs))))
|
||
|
|
(magit-insert-section-body
|
||
|
|
(dolist (notif notifs)
|
||
|
|
(forge-insert-notification notif))
|
||
|
|
(insert ?\n))))))))))
|
||
|
|
|
||
|
|
(defun forge-insert-notification (notif)
|
||
|
|
(with-slots (type title url) notif
|
||
|
|
(pcase type
|
||
|
|
((or 'discussion 'issue 'pullreq)
|
||
|
|
(forge--insert-topic (forge-get-topic notif)))
|
||
|
|
('commit
|
||
|
|
(magit-insert-section (ncommit nil) ; !commit
|
||
|
|
(string-match "[^/]*\\'" url)
|
||
|
|
(insert
|
||
|
|
(format "%s %s\n"
|
||
|
|
(propertize (substring (match-string 0 url)
|
||
|
|
0 (magit-abbrev-length))
|
||
|
|
'font-lock-face 'magit-hash)
|
||
|
|
(magit-log--wash-summary
|
||
|
|
(propertize title 'font-lock-face
|
||
|
|
(if-let* ((topic (oref notif topic))
|
||
|
|
(_(eq (oref topic status) 'unread)))
|
||
|
|
'forge-topic-unread
|
||
|
|
'forge-topic-open)))))))
|
||
|
|
(_
|
||
|
|
;; The documentation does not mention what "types"
|
||
|
|
;; exist. Make it obvious that this is something
|
||
|
|
;; we do not know how to handle properly yet.
|
||
|
|
(magit-insert-section (notification notif)
|
||
|
|
(insert (propertize (format "(%s) %s\n" type title)
|
||
|
|
'font-lock-face 'error)))))))
|
||
|
|
|
||
|
|
;;; _
|
||
|
|
;; Local Variables:
|
||
|
|
;; read-symbol-shorthands: (
|
||
|
|
;; ("and$" . "cond-let--and$")
|
||
|
|
;; ("thread$" . "cond-let--thread$")
|
||
|
|
;; ("when$" . "cond-let--when$")
|
||
|
|
;; ("and-let*" . "cond-let--and-let*")
|
||
|
|
;; ("and-let" . "cond-let--and-let")
|
||
|
|
;; ("if-let*" . "cond-let--if-let*")
|
||
|
|
;; ("if-let" . "cond-let--if-let")
|
||
|
|
;; ("when-let*" . "cond-let--when-let*")
|
||
|
|
;; ("when-let" . "cond-let--when-let")
|
||
|
|
;; ("while-let*" . "cond-let--while-let*")
|
||
|
|
;; ("while-let" . "cond-let--while-let")
|
||
|
|
;; ("partial" . "llama--left-apply-partially"))
|
||
|
|
;; End:
|
||
|
|
(provide 'forge-notify)
|
||
|
|
;;; forge-notify.el ends here
|