| commit | author | age | ||
| 5cb5f7 | 1 | ;;; magit-collab.el --- collaboration tools -*- lexical-binding: t -*- |
| C | 2 | |
| 3 | ;; Copyright (C) 2010-2018 The Magit Project Contributors | |
| 4 | ;; | |
| 5 | ;; You should have received a copy of the AUTHORS.md file which | |
| 6 | ;; lists all contributors. If not, see http://magit.vc/authors. | |
| 7 | ||
| 8 | ;; Author: Jonas Bernoulli <jonas@bernoul.li> | |
| 9 | ;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> | |
| 10 | ||
| 11 | ;; Magit 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 | ;; Magit 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 Magit. If not, see http://www.gnu.org/licenses. | |
| 23 | ||
| 24 | ;;; Commentary: | |
| 25 | ||
| 26 | ;; This library implements various collaboration tools. These tools | |
| 27 | ;; are only early incarnation -- implementing collaboration tools is | |
| 28 | ;; a top priority for future development. | |
| 29 | ||
| 30 | ;; Currently these tools (including `magit-branch-pull-request', which | |
| 31 | ;; is defined elsewhere) only support Github, but support for other | |
| 32 | ;; Git forges as well as mailing list based collaboration is in | |
| 33 | ;; planning. | |
| 34 | ||
| 35 | ;;; Code: | |
| 36 | ||
| 37 | (require 'magit) | |
| 38 | (require 'ghub) | |
| 39 | ||
| 40 | ;;; Variables | |
| 41 | ||
| 42 | (defvar magit-github-token-scopes '(repo) | |
| 43 | "The Github API scopes needed by Magit. | |
| 44 | ||
| 45 | `repo' is the only required scope. Without this scope none of | |
| 46 | Magit's features that use the API work. Instead of this scope | |
| 47 | you could use `public_repo' if you are only interested in public | |
| 48 | repositories. | |
| 49 | ||
| 50 | `repo' Grants read/write access to code, commit statuses, | |
| 51 | invitations, collaborators, adding team memberships, and | |
| 52 | deployment statuses for public and private repositories | |
| 53 | and organizations. | |
| 54 | ||
| 55 | `public_repo' Grants read/write access to code, commit statuses, | |
| 56 | collaborators, and deployment statuses for public repositories | |
| 57 | and organizations. Also required for starring public | |
| 58 | repositories.") | |
| 59 | ||
| 60 | ;;; Commands | |
| 61 | ||
| 62 | ;;;###autoload | |
| 63 | (defun magit-browse-pull-request (pr) | |
| 64 | "Visit pull-request PR using `browse-url'. | |
| 65 | ||
| 66 | Currently this only supports Github, but that restriction will | |
| 67 | be lifted eventually to support other Git forges." | |
| 68 | (interactive (list (magit-read-pull-request "Visit pull request"))) | |
| 69 | (browse-url (format "https://github.com/%s/pull/%s" | |
| 70 | (--> pr | |
| 71 | (cdr (assq 'base it)) | |
| 72 | (cdr (assq 'repo it)) | |
| 73 | (cdr (assq 'full_name it))) | |
| 74 | (cdr (assq 'number pr))))) | |
| 75 | ||
| 76 | ;;; Utilities | |
| 77 | ||
| 78 | (defun magit-read-pull-request (prompt) | |
| 79 | "Read a pull request from the user, prompting with PROMPT. | |
| 80 | Return the Git forge's API response. Currently this function | |
| 81 | only supports Github, but that will change eventually." | |
| 82 | (let* ((origin (magit-upstream-repository)) | |
| 83 | (id (magit--forge-id origin)) | |
| 84 | (fmtfun (lambda (pull-request) | |
| 85 | (format "%s %s" | |
| 86 | (cdr (assq 'number pull-request)) | |
| 87 | (cdr (assq 'title pull-request))))) | |
| 88 | (prs (ghub-get (format "/repos/%s/pulls" id) nil :auth 'magit)) | |
| 89 | (choice (magit-completing-read | |
| 90 | prompt (mapcar fmtfun prs) nil nil nil nil | |
| 91 | (let ((default (thing-at-point 'github-pull-request))) | |
| 92 | (and default (funcall fmtfun default))))) | |
| 93 | (number (and (string-match "\\([0-9]+\\)" choice) | |
| 94 | (string-to-number (match-string 1 choice))))) | |
| 95 | (and number | |
| 96 | ;; Don't reuse the pr from the list, it lacks some information | |
| 97 | ;; that is only returned when requesting a single pr. #3371 | |
| 98 | (ghub-get (format "/repos/%s/pulls/%s" id number) | |
| 99 | nil :auth 'magit)))) | |
| 100 | ||
| 101 | (defun magit-upstream-repository () | |
| 102 | "Return the remote name of the upstream repository. | |
| 103 | ||
| 104 | If the Git variable `magit.upstream' is set, then return its | |
| 105 | value. Otherwise return \"origin\". If the remote does not | |
| 106 | exist, then raise an error." | |
| 107 | (let ((remote (or (magit-get "magit.upstream") "origin"))) | |
| 108 | (unless (magit-remote-p remote) | |
| 109 | (error "No remote named `%s' exists (consider setting `magit.upstream')" | |
| 110 | remote)) | |
| 111 | (unless (magit--github-remote-p remote) | |
| 112 | (error "Currently only Github is supported")) | |
| 113 | remote)) | |
| 114 | ||
| 115 | (defun magit--forge-id (remote) | |
| 116 | (let ((url (magit-get "remote" remote "url"))) | |
| 117 | (and (string-match "\\([^:/]+/[^/]+?\\)\\(?:\\.git\\)?\\'" url) | |
| 118 | (match-string 1 url)))) | |
| 119 | ||
| 120 | (defconst magit--github-url-regexp "\ | |
| 121 | \\`\\(?:git://\\|git@\\|ssh://git@\\|https://\\)\ | |
| 122 | \\(.*?\\)[/:]\ | |
| 123 | \\(\\([^:/]+\\)/\\([^/]+?\\)\\)\ | |
| 124 | \\(?:\\.git\\)?\\'") | |
| 125 | ||
| 126 | (defun magit--github-url-p (url) | |
| 127 | (save-match-data | |
| 128 | (and url | |
| 129 | (string-match magit--github-url-regexp url) | |
| 130 | (let ((host (match-string 1 url))) | |
| 131 | ;; Match values like "github.com-as-someone", which are | |
| 132 | ;; translated to just "github.com" according to settings | |
| 133 | ;; in "~/.ssh/config". Theoretically this could result | |
| 134 | ;; in false-positives, but that's rather unlikely. #3392 | |
| 135 | (and (or (string-match-p (regexp-quote "github.com") host) | |
| 136 | (string-match-p | |
| 137 | (regexp-quote (car (split-string (ghub--host) "/"))) | |
| 138 | host)) | |
| 139 | host))))) | |
| 140 | ||
| 141 | (defun magit--github-remote-p (remote) | |
| 142 | (or (--when-let (magit-git-string "remote" "get-url" "--push" remote) | |
| 143 | (magit--github-url-p it)) | |
| 144 | (--when-let (magit-git-string "remote" "get-url" "--all" remote) | |
| 145 | (magit--github-url-p it)))) | |
| 146 | ||
| 147 | (defun magit--github-url-equal (r1 r2) | |
| 148 | (or (equal r1 r2) | |
| 149 | (save-match-data | |
| 150 | (let ((n1 (and (string-match magit--github-url-regexp r1) | |
| 151 | (match-string 2 r1))) | |
| 152 | (n2 (and (string-match magit--github-url-regexp r2) | |
| 153 | (match-string 2 r2)))) | |
| 154 | (and n1 n2 (equal n1 n2)))))) | |
| 155 | ||
| 156 | (defun magit--pullreq-from-upstream-p (pr) | |
| 157 | (let-alist pr | |
| 158 | (equal .head.repo.full_name | |
| 159 | .base.repo.full_name))) | |
| 160 | ||
| 161 | (defun magit--pullreq-branch (pr &optional assert-new) | |
| 162 | (let-alist pr | |
| 163 | (let ((branch .head.ref)) | |
| 164 | (when (and (not (magit--pullreq-from-upstream-p pr)) | |
| 165 | (or (not .maintainer_can_modify) | |
| 166 | (magit-branch-p branch))) | |
| 167 | (setq branch (format "pr-%s" .number))) | |
| 168 | (when (and assert-new (magit-branch-p branch)) | |
| 169 | (user-error "Branch `%s' already exists" branch)) | |
| 170 | branch))) | |
| 171 | ||
| 172 | ;;; _ | |
| 173 | (provide 'magit-collab) | |
| 174 | ;;; magit-collab.el ends here | |
