mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-18 76bbd07de7add0f9d13c6914f158d19630fe2f62
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