forge-notify.el (6372B)
1 ;;; forge-notify.el --- Notify support -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2018-2022 Jonas Bernoulli 4 5 ;; Author: Jonas Bernoulli <jonas@bernoul.li> 6 ;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> 7 ;; SPDX-License-Identifier: GPL-3.0-or-later 8 9 ;; This file is not part of GNU Emacs. 10 11 ;; Forge is free software; you can redistribute it and/or modify it 12 ;; under the terms of the GNU General Public License as published by 13 ;; the Free Software Foundation; either version 3, or (at your option) 14 ;; any later version. 15 ;; 16 ;; Forge is distributed in the hope that it will be useful, but WITHOUT 17 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 18 ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public 19 ;; License for more details. 20 ;; 21 ;; You should have received a copy of the GNU General Public License 22 ;; along with Forge. If not, see http://www.gnu.org/licenses. 23 24 ;;; Code: 25 26 (require 'forge) 27 28 ;;; Class 29 30 (defclass forge-notification (forge-object) 31 ((closql-class-prefix :initform "forge-") 32 (closql-table :initform 'notification) 33 (closql-primary-key :initform 'id) 34 (closql-order-by :initform [(desc id)]) 35 (id :initarg :id) 36 (thread-id :initarg :thread-id) 37 (repository :initarg :repository) 38 (forge :initarg :forge) 39 (reason :initarg :reason) 40 (unread-p :initarg :unread-p) 41 (last-read :initarg :last-read) 42 (updated :initarg :updated) 43 (title :initarg :title) 44 (type :initarg :type) 45 (topic :initarg :topic) 46 (url :initarg :url))) 47 48 ;;; Core 49 50 (cl-defmethod forge-get-repository ((notify forge-notification)) 51 "Return the object for the repository that NOTIFY belongs to." 52 (when-let ((id (oref notify repository))) 53 (closql-get (forge-db) id 'forge-repository))) 54 55 (cl-defmethod forge-get-notification ((topic forge-topic)) 56 (when-let ((row (car (forge-sql [:select * :from notification 57 :where (and (= repository $s1) 58 (= topic $s2))] 59 (oref topic repository) 60 (oref topic number))))) 61 (closql--remake-instance 'forge-notification (forge-db) row))) 62 63 ;;; Utilities 64 65 (cl-defmethod forge-get-url ((notify forge-notification)) 66 (oref notify url)) 67 68 ;;; Mode 69 70 (defvar forge-notifications-mode-map 71 (let ((map (make-sparse-keymap))) 72 (set-keymap-parent map magit-mode-map) 73 map) 74 "Keymap for `forge-notifications-mode'.") 75 76 (define-derived-mode forge-notifications-mode magit-mode "Forge Notifications" 77 "Mode for looking at forge notifications." 78 (hack-dir-local-variables-non-file-buffer)) 79 80 (defun forge-notifications-setup-buffer () 81 ;; There should only ever be one such buffer. 82 (cl-letf (((symbol-function 'magit-get-mode-buffer) 83 (lambda (&rest _) 84 (get-buffer-create "*forge-notifications*")))) 85 (magit-setup-buffer #'forge-notifications-mode))) 86 87 (defun forge-notifications-refresh-buffer () 88 (forge-insert-notifications)) 89 90 ;;; Utilities 91 92 (defun forge--list-notifications-all () 93 (closql-query (forge-db) nil nil 'forge-notification)) 94 95 (defun forge--list-notifications-unread () 96 (mapcar (lambda (row) 97 (closql--remake-instance 'forge-notification (forge-db) row)) 98 (forge-sql [:select * :from notification 99 :where (notnull unread-p) 100 :order-by [(desc id)]]))) 101 102 ;;; Sections 103 104 ;; The double-prefix is necessary due to a limitation of magit-insert-section. 105 (defvar forge-forge-repo-section-map 106 (let ((map (make-sparse-keymap))) 107 (define-key map [remap magit-browse-thing] 'forge-browse-repository) 108 (define-key map [remap magit-visit-thing] 'forge-visit-repository) 109 map)) 110 111 (defun forge-insert-notifications () 112 (when-let ((ns (forge--list-notifications-all))) 113 (magit-insert-section (notifications) 114 (magit-insert-heading "Notifications:") 115 (pcase-dolist (`(,_ . ,ns) (--group-by (oref it repository) ns)) 116 (let ((repo (forge-get-repository (car ns)))) 117 (magit-insert-section (forge-repo repo t) 118 (magit-insert-heading 119 (concat (propertize (format "%s/%s" 120 (oref repo owner) 121 (oref repo name)) 122 'font-lock-face 'bold) 123 (format " (%s)" (length ns)))) 124 (magit-insert-section-body 125 (dolist (notify ns) 126 (with-slots (type topic title url unread-p) notify 127 (pcase type 128 ('issue 129 (forge-insert-topic (forge-get-issue repo topic))) 130 ('pullreq 131 (forge-insert-topic (forge-get-pullreq repo topic))) 132 ('commit 133 (magit-insert-section (ncommit nil) ; !commit 134 (string-match "[^/]*\\'" url) 135 (insert 136 (format "%s %s\n" 137 (propertize (substring (match-string 0 url) 138 0 (magit-abbrev-length)) 139 'font-lock-face 'magit-hash) 140 (magit-log-propertize-keywords 141 nil (propertize title 'font-lock-face 142 (if unread-p 143 'forge-topic-unread 144 'forge-topic-open))))))) 145 (_ 146 ;; The documentation does not mention what "types" 147 ;; exist. Make it obvious that this is something 148 ;; we do not know how to handle properly yet. 149 (magit-insert-section (notification notify) 150 (insert (propertize (format "(%s) %s\n" type title) 151 'font-lock-face 'error))))))) 152 (insert ?\n)))))))) 153 154 ;;; _ 155 (provide 'forge-notify) 156 ;;; forge-notify.el ends here