forge-issue.el (8330B)
1 ;;; forge-issue.el --- Issue 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 (require 'forge-post) 28 (require 'forge-topic) 29 30 ;;; Classes 31 32 (defclass forge-issue (forge-topic) 33 ((closql-table :initform 'issue) 34 (closql-primary-key :initform 'id) 35 (closql-order-by :initform [(desc number)]) 36 (closql-foreign-key :initform 'repository) 37 (closql-class-prefix :initform "forge-") 38 (id :initarg :id) 39 (repository :initarg :repository) 40 (number :initarg :number) 41 (state :initarg :state) 42 (author :initarg :author) 43 (title :initarg :title) 44 (created :initarg :created) 45 (updated :initarg :updated) 46 (closed :initarg :closed) 47 (unread-p :initarg :unread-p :initform nil) 48 (locked-p :initarg :locked-p) 49 (milestone :initarg :milestone) 50 (body :initarg :body) 51 (assignees :closql-table (issue-assignee assignee)) 52 (project-cards) ; projectsCards 53 (edits) ; userContentEdits 54 (labels :closql-table (issue-label label)) 55 (participants) 56 (posts :closql-class forge-issue-post) 57 (reactions) 58 (timeline) 59 (marks :closql-table (issue-mark mark)) 60 (note :initarg :note :initform nil) 61 )) 62 63 (defclass forge-issue-post (forge-post) 64 ((closql-table :initform 'issue-post) 65 (closql-primary-key :initform 'id) 66 (closql-order-by :initform [(asc number)]) 67 (closql-foreign-key :initform 'issue) 68 (closql-class-prefix :initform "forge-issue-") 69 (id :initarg :id) 70 (issue :initarg :issue) 71 (number :initarg :number) 72 (author :initarg :author) 73 (created :initarg :created) 74 (updated :initarg :updated) 75 (body :initarg :body) 76 (edits) 77 (reactions) 78 )) 79 80 ;;; Query 81 82 (cl-defmethod forge-get-repository ((post forge-issue-post)) 83 (forge-get-repository (forge-get-issue post))) 84 85 (cl-defmethod forge-get-topic ((post forge-issue-post)) 86 (forge-get-issue post)) 87 88 (cl-defmethod forge-get-issue ((issue forge-issue)) 89 issue) 90 91 (cl-defmethod forge-get-issue ((repo forge-repository) number) 92 (closql-get (forge-db) 93 (forge--object-id 'forge-issue repo number) 94 'forge-issue)) 95 96 (cl-defmethod forge-get-issue ((number integer)) 97 (when-let ((repo (forge-get-repository t))) 98 (forge-get-issue repo number))) 99 100 (cl-defmethod forge-get-issue ((id string)) 101 (closql-get (forge-db) id 'forge-issue)) 102 103 (cl-defmethod forge-get-issue ((post forge-issue-post)) 104 (closql-get (forge-db) 105 (oref post issue) 106 'forge-issue)) 107 108 (cl-defmethod forge-ls-issues ((repo forge-repository) &optional type select) 109 (forge-ls-topics repo 'forge-issue type select)) 110 111 ;;; Utilities 112 113 (defun forge-read-issue (prompt &optional type) 114 (when (eq type t) 115 (setq type (if current-prefix-arg nil 'open))) 116 (let* ((default (forge-current-issue)) 117 (repo (forge-get-repository (or default t))) 118 (choices (mapcar 119 (apply-partially #'forge--topic-format-choice repo) 120 (forge-ls-issues repo type [number title id class])))) 121 (cdr (assoc (magit-completing-read 122 prompt choices nil nil nil nil 123 (and default 124 (setq default (forge--topic-format-choice default)) 125 (member default choices) 126 (car default))) 127 choices)))) 128 129 (cl-defmethod forge-get-url ((issue forge-issue)) 130 (forge--format issue 'issue-url-format)) 131 132 ;;; Sections 133 134 (defun forge-current-issue () 135 (or (forge-issue-at-point) 136 (and (derived-mode-p 'forge-topic-mode) 137 (forge-issue-p forge-buffer-topic) 138 forge-buffer-topic) 139 (and (derived-mode-p 'forge-topic-list-mode) 140 (let ((topic (forge-get-topic (tabulated-list-get-id)))) 141 (and (forge-issue-p topic) 142 topic))))) 143 144 (defun forge-issue-at-point () 145 (or (magit-section-value-if 'issue) 146 (when-let ((post (magit-section-value-if 'post))) 147 (cond ((forge-issue-p post) 148 post) 149 ((forge-issue-post-p post) 150 (forge-get-issue post)))))) 151 152 (defvar forge-issues-section-map 153 (let ((map (make-sparse-keymap))) 154 (define-key map [remap magit-browse-thing] 'forge-browse-issues) 155 (define-key map [remap magit-visit-thing] 'forge-list-issues) 156 (define-key map (kbd "C-c C-n") 'forge-create-issue) 157 map)) 158 159 (defvar forge-issue-section-map 160 (let ((map (make-sparse-keymap))) 161 (define-key map [remap magit-browse-thing] 'forge-browse-issue) 162 (define-key map [remap magit-visit-thing] 'forge-visit-issue) 163 map)) 164 165 (defun forge-insert-issues () 166 "Insert a list of mostly recent and/or open issues. 167 Also see option `forge-topic-list-limit'." 168 (when forge-display-in-status-buffer 169 (when-let ((repo (forge-get-repository nil))) 170 (when (and (not (oref repo sparse-p)) 171 (or (not (slot-boundp repo 'issues-p)) ; temporary KLUDGE 172 (oref repo issues-p))) 173 (forge-insert-topics "Issues" 174 (forge-ls-recent-topics repo 'issue) 175 (forge--topic-type-prefix repo 'issue)))))) 176 177 (defun forge-insert-assigned-issues () 178 "Insert a list of open issues that are assigned to you." 179 (when forge-display-in-status-buffer 180 (when-let ((repo (forge-get-repository nil))) 181 (unless (oref repo sparse-p) 182 (forge-insert-topics "Assigned issues" 183 (forge--ls-assigned-issues repo) 184 (forge--topic-type-prefix repo 'issue)))))) 185 186 (defun forge--ls-assigned-issues (repo) 187 (mapcar (lambda (row) 188 (closql--remake-instance 'forge-issue (forge-db) row)) 189 (forge-sql 190 [:select $i1 :from [issue issue_assignee assignee] 191 :where (and (= issue_assignee:issue issue:id) 192 (= issue_assignee:id assignee:id) 193 (= issue:repository $s2) 194 (= assignee:login $s3) 195 (isnull issue:closed)) 196 :order-by [(desc updated)]] 197 (vconcat (closql--table-columns (forge-db) 'issue t)) 198 (oref repo id) 199 (ghub--username repo)))) 200 201 (defun forge-insert-authored-issues () 202 "Insert a list of open issues that are authored to you." 203 (when forge-display-in-status-buffer 204 (when-let ((repo (forge-get-repository nil))) 205 (unless (oref repo sparse-p) 206 (forge-insert-topics "Authored issues" 207 (forge--ls-authored-issues repo) 208 (forge--topic-type-prefix repo 'issue)))))) 209 210 (defun forge--ls-authored-issues (repo) 211 (mapcar (lambda (row) 212 (closql--remake-instance 'forge-issue (forge-db) row)) 213 (forge-sql 214 [:select $i1 :from [issue] 215 :where (and (= issue:repository $s2) 216 (= issue:author $s3) 217 (isnull issue:closed)) 218 :order-by [(desc updated)]] 219 (vconcat (closql--table-columns (forge-db) 'issue t)) 220 (oref repo id) 221 (ghub--username repo)))) 222 223 ;;; _ 224 (provide 'forge-issue) 225 ;;; forge-issue.el ends here