375 lines
15 KiB
EmacsLisp
375 lines
15 KiB
EmacsLisp
;;; magit-gh-pulls.el --- GitHub pull requests extension for Magit
|
|
|
|
;; Copyright (C) 2011-2015 Yann Hodique, Alexander Yakushev
|
|
|
|
;; Author: Yann Hodique <yann.hodique@gmail.com>
|
|
;; Keywords: git tools
|
|
;; Version: 0.5
|
|
;; URL: https://github.com/sigma/magit-gh-pulls
|
|
;; Package-Requires: ((emacs "24") (gh "0.4.3") (magit "2.1.0") (pcache "0.2.3") (s "1.6.1"))
|
|
|
|
;; This file is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 2, or (at your option)
|
|
;; any later version.
|
|
|
|
;; This file is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
;; Boston, MA 02111-1307, USA.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This is a Magit extension for manipulating GitHub pull requests
|
|
|
|
;; No configuration is needed in the repository if any of your remotes contain a
|
|
;; URL to Github's remote repository. If for some reason you don't have any
|
|
;; Github remotes in your config, you can specify username and repository
|
|
;; explicitly:
|
|
|
|
;; $ git config magit.gh-pulls-repo <user>/<repo> # your github repository
|
|
|
|
;; Add these lines to your init.el:
|
|
|
|
;; (require 'magit-gh-pulls)
|
|
;; (add-hook 'magit-mode-hook 'turn-on-magit-gh-pulls)
|
|
|
|
;; There are currently 4 bindings for pull requests:
|
|
;; # g g --- refreshes the list of pull requests
|
|
;; # g f --- fetches the commits associated with the pull request at point
|
|
;; # g b --- helps you creating a topic branch from a review request
|
|
;; # g m --- merges the PR on top of the current branch
|
|
;; # g c --- creates a PR from the current branch
|
|
|
|
;; Then, you can do whatever you want with the commit objects associated with
|
|
;; the pull request (merge, cherry-pick, diff, ...)
|
|
|
|
;;; Code:
|
|
|
|
(require 'eieio)
|
|
|
|
(require 'magit)
|
|
(require 'gh-pulls)
|
|
(require 'pcache)
|
|
(require 'gh)
|
|
(require 's)
|
|
|
|
(defvar magit-gh-pulls-maybe-filter-pulls 'identity
|
|
"Filter function which should validate pulls you want to be
|
|
viewed in magit. It receives a list of pull requests and should
|
|
return a list of pull requests.")
|
|
|
|
(defvar magit-gh-pulls-collapse-commits nil
|
|
"Collapse commits in pull requests listing.")
|
|
|
|
(defun magit-gh-pulls-get-api ()
|
|
(gh-pulls-api "api" :sync t :num-retries 1 :cache (gh-cache "cache")))
|
|
|
|
(defun magit-gh-pulls-get-repo-from-config ()
|
|
(let* ((cfg (magit-get "magit" "gh-pulls-repo")))
|
|
(when cfg
|
|
(let* ((split (split-string cfg "/")))
|
|
(cons (car split) (cadr split))))))
|
|
|
|
(defun magit-gh-pulls-parse-url (url)
|
|
(let ((creds (s-match "github.com[:/]\\([^/]+\\)/\\([^/]+\\)/?$" url)))
|
|
(when creds
|
|
(cons (cadr creds) (s-chop-suffix ".git" (caddr creds))))))
|
|
|
|
(defun magit-gh-pulls-guess-repo-from-origin ()
|
|
(let ((creds nil))
|
|
(dolist (remote (magit-git-lines "remote") creds)
|
|
(let ((parsed (magit-gh-pulls-parse-url
|
|
(magit-get "remote" remote "url"))))
|
|
(when parsed
|
|
(setq creds parsed))))))
|
|
|
|
(defun magit-gh-pulls-guess-repo ()
|
|
(or (magit-gh-pulls-get-repo-from-config)
|
|
(magit-gh-pulls-guess-repo-from-origin)))
|
|
|
|
(defun magit-gh-pulls-requests-cached-p (api user proj)
|
|
(let ((cache-repo (format "/repos/%s/%s/pulls" user proj))
|
|
(cached? nil))
|
|
(pcache-map (oref api :cache)
|
|
(lambda (key _) (when (equal (car key) cache-repo)
|
|
(setq cached? t))))
|
|
cached?))
|
|
|
|
(defun magit-gh-pulls-insert-gh-pulls ()
|
|
(condition-case print-section
|
|
(progn
|
|
(let* ((repo (magit-gh-pulls-guess-repo)))
|
|
(when repo
|
|
(let* ((api (magit-gh-pulls-get-api))
|
|
(user (car repo))
|
|
(proj (cdr repo))
|
|
(cached? (magit-gh-pulls-requests-cached-p api user proj))
|
|
(stubs (when cached?
|
|
(funcall magit-gh-pulls-maybe-filter-pulls
|
|
(oref (gh-pulls-list api user proj) :data))))
|
|
(branch (magit-get-current-branch)))
|
|
(when (or (> (length stubs) 0) (not cached?))
|
|
(magit-insert-section (pulls)
|
|
(magit-insert-heading "Pull Requests:")
|
|
(dolist (stub stubs)
|
|
(let* ((id (oref stub :number))
|
|
(req (oref (gh-pulls-get api user proj id) :data))
|
|
(base-sha (oref (oref req :base) :sha))
|
|
(base-ref (oref (oref req :base) :ref))
|
|
(head-sha (oref (oref req :head) :sha))
|
|
;; branch has been deleted in the meantime...
|
|
(invalid (equal (oref (oref req :head) :ref) head-sha))
|
|
(have-commits
|
|
(and (eql 0 (magit-git-exit-code "cat-file" "-e" base-sha))
|
|
(eql 0 (magit-git-exit-code "cat-file" "-e" head-sha))))
|
|
(applied (and have-commits
|
|
(not (magit-git-string
|
|
"rev-list"
|
|
"--cherry-pick" "--right-only"
|
|
(format "HEAD...%s" head-sha)
|
|
"--not"
|
|
(format "%s" base-sha)))))
|
|
(heading
|
|
(format "[%s@%s] %s\n"
|
|
(propertize (number-to-string id)
|
|
'face 'magit-tag)
|
|
(if (string= base-ref branch)
|
|
(propertize base-ref
|
|
'face 'magit-branch-local)
|
|
base-ref)
|
|
(propertize
|
|
(oref req :title) 'face
|
|
(cond (applied 'magit-cherry-equivalent)
|
|
(have-commits nil)
|
|
(invalid 'error)
|
|
(t 'italic)))))
|
|
(info (list user proj id)))
|
|
(cond
|
|
(have-commits
|
|
(magit-insert-section
|
|
(pull info (not magit-gh-pulls-collapse-commits))
|
|
(magit-insert heading)
|
|
(magit-insert-heading)
|
|
(when (and have-commits (not applied))
|
|
(magit-git-wash
|
|
(apply-partially 'magit-log-wash-log 'cherry)
|
|
"cherry" "-v" (magit-abbrev-arg)
|
|
base-sha head-sha))))
|
|
(invalid
|
|
(magit-insert-section (invalid-pull info)
|
|
(magit-insert heading)))
|
|
(t
|
|
(magit-insert-section (unfetched-pull info)
|
|
(magit-insert heading))))))
|
|
(when (not cached?)
|
|
(insert "Press `# g g` to update the pull request list.\n\n"))
|
|
(when (> (length stubs) 0)
|
|
(insert "\n"))))))))
|
|
(error nil)))
|
|
|
|
(defun magit-gh-pulls-guess-topic-name (req)
|
|
(let ((user (oref (oref req :user) :login))
|
|
(topic (oref (oref req :head) :ref)))
|
|
(format "%s/%s" user topic)))
|
|
|
|
(defun magit-gh-section-req-data (&optional section)
|
|
(oref (apply #'gh-pulls-get
|
|
(magit-gh-pulls-get-api)
|
|
(magit-section-value (or section (magit-current-section))))
|
|
:data))
|
|
|
|
(defun magit-gh-pulls-create-branch ()
|
|
(interactive)
|
|
(magit-section-case
|
|
(pull
|
|
(let* ((req (magit-gh-section-req-data))
|
|
(branch (read-from-minibuffer
|
|
"Branch name: " (magit-gh-pulls-guess-topic-name req)))
|
|
(base (magit-read-branch-or-commit
|
|
"Branch base: "
|
|
(oref (oref req :base) :ref)))
|
|
(inhibit-magit-refresh t))
|
|
(magit-branch branch base)
|
|
(magit-merge (oref (oref req :head) :sha)))
|
|
(magit-refresh))
|
|
(unfetched-pull
|
|
(error "Please fetch pull request commits first"))
|
|
(invalid-pull
|
|
(error "This pull request refers to invalid reference"))))
|
|
|
|
(defun magit-gh-pulls-merge-pull-request ()
|
|
(interactive)
|
|
(magit-section-case
|
|
(pull
|
|
(let* ((req (magit-gh-section-req-data))
|
|
(branch (magit-gh-pulls-guess-topic-name req))
|
|
(base (oref (oref req :base) :ref))
|
|
(inhibit-magit-refresh t))
|
|
(magit-branch branch base)
|
|
(magit-merge (oref (oref req :head) :sha))
|
|
(magit-checkout base)
|
|
(magit-merge branch)
|
|
(magit-call-git "branch" "-D" branch))
|
|
(magit-refresh))
|
|
(unfetched-pull
|
|
(error "Please fetch pull request commits first"))
|
|
(invalid-pull
|
|
(error "This pull request refers to invalid reference"))))
|
|
|
|
(defun magit-gh-pulls-fetch-commits ()
|
|
(interactive)
|
|
(magit-section-case
|
|
(unfetched-pull
|
|
(let* ((req (magit-gh-section-req-data))
|
|
(head (oref req :head)))
|
|
(magit-run-git "fetch" (oref (oref head :repo) :git-url)
|
|
(oref head :ref))))
|
|
(pull nil)
|
|
(invalid-pull
|
|
(error "This pull request refers to invalid reference"))))
|
|
|
|
(defun magit-gh-pulls-url-for-pull (info)
|
|
"Return github url for a pull request using INFO."
|
|
(let ((url "https://github.com/%s/%s/pull/%s"))
|
|
(apply 'format url info)))
|
|
|
|
(defun magit-gh-pulls-open-in-browser ()
|
|
(interactive)
|
|
(let ((info (magit-section-value (magit-current-section))))
|
|
(magit-section-case
|
|
(pull (browse-url (magit-gh-pulls-url-for-pull info)))
|
|
(unfetched-pull (browse-url (magit-gh-pulls-url-for-pull info))))))
|
|
|
|
(defun magit-gh-pulls-purge-cache ()
|
|
(let* ((api (magit-gh-pulls-get-api))
|
|
(cache (oref api :cache))
|
|
(repo (magit-gh-pulls-guess-repo)))
|
|
(pcache-map cache (lambda (k v)
|
|
(when (string-match
|
|
(format "/repos/%s/%s/" (car repo) (cdr repo))
|
|
(car k))
|
|
(pcache-invalidate cache k))))))
|
|
|
|
|
|
(defun magit-gh-pulls-build-req (user proj)
|
|
(let ((current (or (cdr (magit-get-remote-branch))
|
|
(magit-get-current-branch))))
|
|
(let* ((base
|
|
(make-instance 'gh-repos-ref :user (make-instance 'gh-users-user :name user)
|
|
:repo (make-instance 'gh-repos-repo :name proj)
|
|
:ref (completing-read "Base (master):" '() nil nil nil nil "master")))
|
|
(head
|
|
(make-instance 'gh-repos-ref :user (make-instance 'gh-users-user :name user)
|
|
:repo (make-instance 'gh-repos-repo :name proj)
|
|
:ref (completing-read (format "Head (%s):" current) '() nil nil nil nil current)))
|
|
(title (read-string "Title: "))
|
|
(body (read-string "Description: "))
|
|
(req (make-instance 'gh-pulls-request :head head :base base :body body :title title)))
|
|
req)))
|
|
|
|
(defun magit-gh-pulls-create-pull-request ()
|
|
(interactive)
|
|
(let ((repo (magit-gh-pulls-guess-repo)))
|
|
(when repo
|
|
(let* ((current-branch (magit-get-current-branch))
|
|
(api (magit-gh-pulls-get-api))
|
|
(user (car repo))
|
|
(proj (cdr repo))
|
|
(req (magit-gh-pulls-build-req user proj))
|
|
(a (gh-pulls-new api user proj req)))
|
|
(kill-new (oref (oref a :data) :html-url))))))
|
|
|
|
(defun magit-gh-pulls-reload ()
|
|
(interactive)
|
|
(let ((creds (magit-gh-pulls-guess-repo)))
|
|
(if (not (and creds (car creds) (cdr creds)))
|
|
(message "Remote repository is not configured or incorrect.")
|
|
(magit-gh-pulls-purge-cache)
|
|
(gh-pulls-list (magit-gh-pulls-get-api) (car creds) (cdr creds))
|
|
(magit-refresh))))
|
|
|
|
(easy-menu-define magit-gh-pulls-extension-menu
|
|
nil
|
|
"GitHub Pull Requests extension menu"
|
|
'("GitHub Pull Requests"
|
|
:visible magit-gh-pulls-mode
|
|
["Reload pull request" magit-gh-pulls-reload]
|
|
["Create pull request branch" magit-gh-pulls-create-branch]
|
|
["Fetch pull request commits" magit-gh-pulls-fetch-commits]
|
|
["Open pull request in browser" magit-gh-pulls-open-in-browser]
|
|
))
|
|
|
|
(easy-menu-add-item 'magit-mode-menu
|
|
'("Extensions")
|
|
magit-gh-pulls-extension-menu)
|
|
|
|
(defvar magit-gh-pulls-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map (kbd "# g b") 'magit-gh-pulls-create-branch)
|
|
(define-key map (kbd "# g f") 'magit-gh-pulls-fetch-commits)
|
|
(define-key map (kbd "# g g") 'magit-gh-pulls-reload)
|
|
(define-key map (kbd "# g m") 'magit-gh-pulls-merge-pull-request)
|
|
(define-key map (kbd "# g c") 'magit-gh-pulls-create-pull-request)
|
|
(define-key map (kbd "# g o") 'magit-gh-pulls-open-in-browser)
|
|
map))
|
|
|
|
(defvar magit-gh-pulls-mode-lighter " Pulls")
|
|
|
|
;;;###autoload
|
|
(define-minor-mode magit-gh-pulls-mode "Pull requests support for Magit"
|
|
:lighter magit-gh-pulls-mode-lighter
|
|
:require 'magit-gh-pulls
|
|
:keymap 'magit-gh-pulls-mode-map
|
|
(or (derived-mode-p 'magit-mode)
|
|
(error "This mode only makes sense with magit"))
|
|
(if magit-gh-pulls-mode
|
|
(magit-add-section-hook
|
|
'magit-status-sections-hook
|
|
'magit-gh-pulls-insert-gh-pulls
|
|
'magit-insert-stashes)
|
|
(remove-hook 'magit-status-sections-hook 'magit-gh-pulls-insert-gh-pulls))
|
|
(when (called-interactively-p 'any)
|
|
(magit-refresh)))
|
|
|
|
;;;###autoload
|
|
(defun turn-on-magit-gh-pulls ()
|
|
"Unconditionally turn on `magit-pulls-mode'."
|
|
(magit-gh-pulls-mode 1))
|
|
|
|
(ert-deftest test-magit-gh-pulls-parse-url-git-at ()
|
|
(should (equal '("sigma" . "magit-gh-pulls")
|
|
(magit-gh-pulls-parse-url "git@github.com:sigma/magit-gh-pulls.git"))))
|
|
|
|
(ert-deftest test-magit-gh-pulls-parse-url-https ()
|
|
(should (equal '("sigma" . "magit-gh-pulls")
|
|
(magit-gh-pulls-parse-url "https://github.com/sigma/magit-gh-pulls.git"))))
|
|
|
|
(ert-deftest test-magit-gh-pulls-parse-url-https ()
|
|
(should (equal '("sigma" . "magit-gh-pulls")
|
|
(magit-gh-pulls-parse-url "https://github.com/sigma/magit-gh-pulls/"))))
|
|
|
|
(ert-deftest test-magit-gh-pulls-parse-url-http ()
|
|
(should (equal '("sigma" . "magit-gh-pulls")
|
|
(magit-gh-pulls-parse-url "http://github.com/sigma/magit-gh-pulls.git"))))
|
|
|
|
(ert-deftest test-magit-gh-pulls-parse-url-git ()
|
|
(should (equal '("sigma" . "magit-gh-pulls")
|
|
(magit-gh-pulls-parse-url "git://github.com/sigma/magit-gh-pulls.git"))))
|
|
|
|
(ert-deftest test-magic-gh-pulls-parse-url-invalid ()
|
|
(should (eq nil (magit-gh-pulls-parse-url "http://google.com"))))
|
|
|
|
(ert-deftest test-magic-gh-pulls-parse-url-garbage ()
|
|
(should (eq nil (magit-gh-pulls-parse-url "08h3fiuandiu"))))
|
|
|
|
(provide 'magit-gh-pulls)
|
|
;; Local Variables:
|
|
;; indent-tabs-mode: nil
|
|
;; End:
|
|
;;; magit-gh-pulls.el ends here
|