forge-list.el (18962B)
1 ;;; forge-list.el --- Tabulated-list interface -*- 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 (defvar x-stretch-cursor) 29 30 ;;; Options 31 32 (defcustom forge-topic-list-mode-hook '(hl-line-mode) 33 "Hook run after entering Forge-Topic-List mode." 34 :package-version '(forge . "0.1.0") 35 :group 'forge 36 :type 'hook 37 :options '(hl-line-mode)) 38 39 (defvar forge-topic-list-columns 40 '(("#" 5 forge-topic-list-sort-by-number (:right-align t) number nil) 41 ("Title" 35 t nil title nil) 42 )) 43 44 (defvar forge-global-topic-list-columns 45 '(("Owner" 15 t nil repository:owner nil) 46 ("Name" 20 t nil repository:name nil) 47 ("#" 5 forge-topic-list-sort-by-number (:right-align t) number nil) 48 ("Title" 35 t nil title nil) 49 )) 50 51 (defvar forge-repository-list-columns 52 '(("Owner" 20 t nil owner nil) 53 ("Name" 20 t nil name nil) 54 ("N" 1 t nil sparse-p nil) 55 ("S" 1 t nil selective-p nil) 56 ("Worktree" 99 t nil worktree nil) 57 )) 58 59 (defcustom forge-owned-accounts nil 60 "An alist of accounts that are owned by you. 61 This should include your username as well as any organization 62 that you own. Used by the commands `forge-list-owned-issues', 63 `forge-list-owned-pullreqs' and `forge-fork'. 64 65 Each element has the form (ACCOUNT . PLIST). The following 66 properties are currently being used: 67 68 `remote-name' The default name suggested by `forge-fork' for a 69 fork created within this account. If unspecified, then the 70 name of the account is used." 71 :package-version '(forge . "0.2.0") 72 :group 'forge 73 :type '(repeat (cons (string :tag "Account") plist))) 74 75 (define-obsolete-variable-alias 'forge-owned-blacklist 76 'forge-owned-ignored "Forge 3.0.0") 77 78 (defcustom forge-owned-ignored nil 79 "A list of repositories that are ignored when listing those owned by you. 80 This is a list of package names. Used by the commands 81 `forge-list-owned-issues' and `forge-list-owned-pullreqs'." 82 :package-version '(forge . "0.2.0") 83 :group 'forge 84 :type '(repeat (string :tag "Name"))) 85 86 ;;; Variables 87 88 (defvar-local forge--tabulated-list-columns nil) 89 (put 'forge--tabulated-list-columns 'permanent-local t) 90 91 (defvar-local forge--tabulated-list-query nil) 92 (put 'forge--tabulated-list-query 'permanent-local t) 93 94 ;;; Modes 95 ;;;; Topics 96 97 (defvar forge-topic-list-mode-map 98 (let ((map (make-sparse-keymap))) 99 (set-keymap-parent map tabulated-list-mode-map) 100 (define-key map (kbd "RET") 'forge-visit-topic) 101 (define-key map [return] 'forge-visit-topic) 102 (define-key map (kbd "o") 'forge-browse-topic) 103 (define-key map (kbd "'") 'forge-dispatch) 104 (define-key map (kbd "?") 'magit-dispatch) 105 map) 106 "Local keymap for Forge-Topic-List mode buffers.") 107 108 (define-derived-mode forge-topic-list-mode tabulated-list-mode 109 "Issues" 110 "Major mode for browsing a list of topics." 111 (setq-local x-stretch-cursor nil) 112 (setq tabulated-list-padding 0) 113 (setq tabulated-list-sort-key (cons "#" nil))) 114 115 (define-derived-mode forge-issue-list-mode forge-topic-list-mode 116 "Issues" 117 "Major mode for browsing a list of issues.") 118 119 (define-derived-mode forge-pullreq-list-mode forge-topic-list-mode 120 "Pull-Requests" 121 "Major mode for browsing a list of pull-requests.") 122 123 (defun forge-topic-list-setup (mode id buffer-name columns fn) 124 (declare (indent 4)) 125 (let* ((repo (forge-get-repository (list :id id))) 126 (topdir (magit-toplevel))) 127 (with-current-buffer 128 (get-buffer-create 129 (or buffer-name 130 (format "*%s: %s/%s*" 131 (substring (symbol-name mode) 0 -5) 132 (oref repo owner) 133 (oref repo name)))) 134 (setq forge--tabulated-list-columns (or columns forge-topic-list-columns)) 135 (setq forge--tabulated-list-query fn) 136 (setq forge-buffer-repository repo) 137 (when topdir 138 (setq default-directory topdir)) 139 (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229 140 (funcall mode)) 141 (forge-topic-list-refresh) 142 (add-hook 'tabulated-list-revert-hook 143 'forge-topic-list-refresh nil t) 144 (tabulated-list-init-header) 145 (tabulated-list-print) 146 (switch-to-buffer (current-buffer))))) 147 148 (defun forge-topic-list-refresh () 149 (setq tabulated-list-format 150 (vconcat (--map `(,@(-take 3 it) 151 ,@(-flatten (nth 3 it))) 152 forge--tabulated-list-columns))) 153 (tabulated-list-init-header) 154 (setq tabulated-list-entries 155 (mapcar #'forge--tablist-format-entry 156 (funcall forge--tabulated-list-query)))) 157 158 ;;;; Repository 159 160 (defvar forge-repository-list-mode-map 161 (let ((map (make-sparse-keymap))) 162 (set-keymap-parent map tabulated-list-mode-map) 163 (define-key map (kbd "RET") 'forge-visit-repository) 164 (define-key map [return] 'forge-visit-repository) 165 (define-key map (kbd "o") 'forge-browse-repository) 166 (define-key map (kbd "'") 'forge-dispatch) 167 (define-key map (kbd "?") 'magit-dispatch) 168 map) 169 "Local keymap for Forge-Repository-List mode buffers.") 170 171 (define-derived-mode forge-repository-list-mode tabulated-list-mode 172 "Repositories" 173 "Major mode for browsing a list of repositories." 174 (setq-local x-stretch-cursor nil) 175 (setq forge--tabulated-list-columns forge-repository-list-columns) 176 (setq tabulated-list-padding 0) 177 (setq tabulated-list-sort-key (cons "Owner" nil)) 178 (setq tabulated-list-format 179 (vconcat (--map `(,@(-take 3 it) 180 ,@(-flatten (nth 3 it))) 181 forge-repository-list-columns))) 182 (tabulated-list-init-header)) 183 184 (defun forge-repository-list-setup (fn buf) 185 (with-current-buffer (get-buffer-create buf) 186 (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229 187 (forge-repository-list-mode)) 188 (funcall fn) 189 (add-hook 'tabulated-list-revert-hook fn nil t) 190 (tabulated-list-print) 191 (switch-to-buffer (current-buffer)))) 192 193 (defun forge-repository-list-refresh () 194 (setq tabulated-list-entries 195 (mapcar #'forge--tablist-format-entry 196 (forge-sql [:select $i1 :from repository 197 :order-by [(asc owner) (asc name)]] 198 (forge--tablist-columns-vector))))) 199 200 (defun forge-repository-list-owned-refresh () 201 (setq tabulated-list-entries 202 (mapcar #'forge--tablist-format-entry 203 (forge-sql [:select $i1 :from repository 204 :where (and (in owner $v2) 205 (not (in name $v3))) 206 :order-by [(asc owner) (asc name)]] 207 (forge--tablist-columns-vector) 208 (vconcat (mapcar #'car forge-owned-accounts)) 209 (vconcat forge-owned-ignored))))) 210 211 ;;; Commands 212 ;;;; Topic 213 214 ;;;###autoload 215 (defun forge-list-topics (id) 216 "List topics of the current repository in a separate buffer." 217 (interactive (list (oref (forge-get-repository t) id))) 218 (forge-topic-list-setup #'forge-topic-list-mode id nil nil 219 (lambda () 220 (forge-sql [:select $i1 :from issue :where (= repository $s2) :union 221 :select $i1 :from pullreq :where (= repository $s2)] 222 (forge--tablist-columns-vector) 223 id)))) 224 225 ;;;; Issue 226 227 ;;;###autoload 228 (defun forge-list-issues (id) 229 "List issues of the current repository in a separate buffer." 230 (interactive (list (oref (forge-get-repository t) id))) 231 (forge-topic-list-setup #'forge-issue-list-mode id nil nil 232 (lambda () 233 (forge-sql [:select $i1 :from issue :where (= repository $s2)] 234 (forge--tablist-columns-vector) 235 id)))) 236 237 ;;;###autoload 238 (defun forge-list-labeled-issues (id label) 239 "List issues of the current repository that have LABEL. 240 List them in a separate buffer." 241 (interactive (list (oref (forge-get-repository t) id) 242 (magit-completing-read 243 "Label" 244 (mapcar #'cadr (oref (forge-get-repository t) labels)) 245 nil t))) 246 (forge-topic-list-setup #'forge-issue-list-mode id nil nil 247 (lambda () 248 (forge-sql [:select $i1 :from [issue issue_label label] 249 :where (and (= issue_label:issue issue:id) 250 (= issue_label:id label:id) 251 (= issue:repository $s2) 252 (= label:name $s3) 253 (isnull issue:closed)) 254 :order-by [(desc updated)]] 255 (forge--tablist-columns-vector 'issue) 256 id label)))) 257 258 ;;;###autoload 259 (defun forge-list-assigned-issues (id) 260 "List issues of the current repository that are assigned to you. 261 List them in a separate buffer." 262 (interactive (list (oref (forge-get-repository t) id))) 263 (forge-topic-list-setup #'forge-issue-list-mode id nil nil 264 (lambda () 265 (forge-sql [:select $i1 :from [issue issue_assignee assignee] 266 :where (and (= issue_assignee:issue issue:id) 267 (= issue_assignee:id assignee:id) 268 (= issue:repository $s2) 269 (= assignee:login $s3) 270 (isnull issue:closed)) 271 :order-by [(desc updated)]] 272 (forge--tablist-columns-vector 'issue) 273 id (ghub--username (forge-get-repository (list :id id))))))) 274 275 ;;;###autoload 276 (defun forge-list-owned-issues () 277 "List open issues from all your Github repositories. 278 Options `forge-owned-accounts' and `forge-owned-ignored' 279 controls which repositories are considered to be owned by you. 280 Only Github is supported for now." 281 (interactive) 282 (forge-topic-list-setup #'forge-issue-list-mode nil "My issues" 283 forge-global-topic-list-columns 284 (lambda () 285 (forge-sql [:select $i1 :from [issue repository] 286 :where (and (= issue:repository repository:id) 287 (in repository:owner $v2) 288 (not (in repository:name $v3)) 289 (isnull issue:closed)) 290 :order-by [(asc repository:owner) 291 (asc repository:name) 292 (desc issue:number)]] 293 (forge--tablist-columns-vector 'issue) 294 (vconcat (mapcar #'car forge-owned-accounts)) 295 (vconcat forge-owned-ignored))))) 296 297 ;;;; Pullreq 298 299 ;;;###autoload 300 (defun forge-list-pullreqs (id) 301 "List pull-requests of the current repository in a separate buffer." 302 (interactive (list (oref (forge-get-repository t) id))) 303 (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil 304 (lambda () 305 (forge-sql [:select $i1 :from pullreq :where (= repository $s2)] 306 (forge--tablist-columns-vector) 307 id)))) 308 309 ;;;###autoload 310 (defun forge-list-labeled-pullreqs (id label) 311 "List pull-requests of the current repository that have LABEL. 312 List them in a separate buffer." 313 (interactive (list (oref (forge-get-repository t) id) 314 (magit-completing-read 315 "Label" 316 (mapcar #'cadr (oref (forge-get-repository t) labels)) 317 nil t))) 318 (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil 319 (lambda () 320 (forge-sql [:select $i1 :from [pullreq pullreq_label label] 321 :where (and (= pullreq_label:pullreq pullreq:id) 322 (= pullreq_label:id label:id) 323 (= pullreq:repository $s2) 324 (= label:name $s3) 325 (isnull pullreq:closed)) 326 :order-by [(desc updated)]] 327 (forge--tablist-columns-vector 'pullreq) 328 id label)))) 329 330 ;;;###autoload 331 (defun forge-list-assigned-pullreqs (id) 332 "List pull-requests of the current repository that are assigned to you. 333 List them in a separate buffer." 334 (interactive (list (oref (forge-get-repository t) id))) 335 (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil 336 (lambda () 337 (forge-sql [:select $i1 :from [pullreq pullreq_assignee assignee] 338 :where (and (= pullreq_assignee:pullreq pullreq:id) 339 (= pullreq_assignee:id assignee:id) 340 (= pullreq:repository $s2) 341 (= assignee:login $s3) 342 (isnull pullreq:closed)) 343 :order-by [(desc updated)]] 344 (forge--tablist-columns-vector 'pullreq) 345 id (ghub--username (forge-get-repository (list :id id))))))) 346 347 ;;;###autoload 348 (defun forge-list-requested-reviews (id) 349 "List pull-requests of the current repository that are awaiting your review. 350 List them in a separate buffer." 351 (interactive (list (oref (forge-get-repository t) id))) 352 (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil 353 (lambda () 354 (forge-sql [:select $i1 :from [pullreq pullreq_review_request assignee] 355 :where (and (= pullreq_review_request:pullreq pullreq:id) 356 (= pullreq_review_request:id assignee:id) 357 (= pullreq:repository $s2) 358 (= assignee:login $s3) 359 (isnull pullreq:closed)) 360 :order-by [(desc updated)]] 361 (forge--tablist-columns-vector 'pullreq) 362 id (ghub--username (forge-get-repository (list :id id))))))) 363 364 ;;;###autoload 365 (defun forge-list-owned-pullreqs () 366 "List open pull-requests from all your Github repositories. 367 Options `forge-owned-accounts' and `forge-owned-ignored' 368 controls which repositories are considered to be owned by you. 369 Only Github is supported for now." 370 (interactive) 371 (forge-topic-list-setup #'forge-pullreq-list-mode nil "My pullreqs" 372 forge-global-topic-list-columns 373 (lambda () 374 (forge-sql [:select $i1 :from [pullreq repository] 375 :where (and (= pullreq:repository repository:id) 376 (in repository:owner $v2) 377 (not (in repository:name $v3)) 378 (isnull pullreq:closed)) 379 :order-by [(asc repository:owner) 380 (asc repository:name) 381 (desc pullreq:number)]] 382 (forge--tablist-columns-vector 'pullreq) 383 (vconcat (mapcar #'car forge-owned-accounts)) 384 (vconcat forge-owned-ignored))))) 385 386 ;;;###autoload 387 (defun forge-list-authored-pullreqs (id) 388 "List open pull-requests of the current repository that are authored by you. 389 List them in a separate buffer." 390 (interactive (list (oref (forge-get-repository t) id))) 391 (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil 392 (lambda () 393 (forge-sql [:select $i1 :from [pullreq] 394 :where (and (= pullreq:repository $s2) 395 (= pullreq:author $s3) 396 (isnull pullreq:closed)) 397 :order-by [(desc updated)]] 398 (forge--tablist-columns-vector 'pullreq) 399 id (ghub--username (forge-get-repository (list :id id))))))) 400 401 ;;;###autoload 402 (defun forge-list-authored-issues (id) 403 "List open issues from the current repository that are authored by you. 404 List them in a separate buffer." 405 (interactive (list (oref (forge-get-repository t) id))) 406 (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil 407 (lambda () 408 (forge-sql [:select $i1 :from [issue] 409 :where (and (= issue:repository $s2) 410 (= issue:author $s3) 411 (isnull issue:closed)) 412 :order-by [(desc updated)]] 413 (forge--tablist-columns-vector 'issue) 414 id (ghub--username (forge-get-repository (list :id id))))))) 415 416 ;;;; Repository 417 418 ;;;###autoload 419 (defun forge-list-repositories () 420 "List known repositories in a separate buffer. 421 Here \"known\" means that an entry exists in the local database." 422 (interactive) 423 (forge-repository-list-setup #'forge-repository-list-refresh 424 "*Forge Repositories*")) 425 426 ;;;###autoload 427 (defun forge-list-owned-repositories () 428 "List your own known repositories in a separate buffer. 429 Here \"known\" means that an entry exists in the local database 430 and options `forge-owned-accounts' and `forge-owned-ignored' 431 controls which repositories are considered to be owned by you. 432 Only Github is supported for now." 433 (interactive) 434 (forge-repository-list-setup #'forge-repository-list-owned-refresh 435 "*Forge Owned Repositories*")) 436 437 ;;; Internal 438 439 (defun forge-topic-list-sort-by-number (a b) 440 "Sort the `tabulated-list-entries' by topic number. 441 This assumes that `number' is the first column, otherwise 442 it silently fails." 443 (ignore-errors 444 (> (read (aref (cadr a) 0)) 445 (read (aref (cadr b) 0))))) 446 447 (defun forge--tablist-columns-vector (&optional table) 448 (let ((columns (cons 'id (--map (nth 4 it) forge--tabulated-list-columns)))) 449 (vconcat (if table 450 (let ((table (symbol-name table))) 451 (--map (let ((col (symbol-name it))) 452 (if (string-match-p ":" col) 453 it 454 (intern (concat table ":" col)))) 455 columns)) 456 columns)))) 457 458 (defun forge--tablist-format-entry (row) 459 (list (car row) 460 (vconcat 461 (cl-mapcar (lambda (val col) 462 (if-let ((pp (nth 5 col))) 463 (funcall pp val) 464 (if val (format "%s" val) ""))) 465 (cdr row) 466 forge--tabulated-list-columns)))) 467 468 ;;; _ 469 (provide 'forge-list) 470 ;;; forge-list.el ends here