Move from magit-gh-pulls to magithub
This commit is contained in:
Gergely Polonkai
parent
0c2e649db0
commit
fbf952b215
@ -1,27 +0,0 @@
|
|||||||
;;; magit-gh-pulls-autoloads.el --- automatically extracted autoloads
|
|
||||||
;;
|
|
||||||
;;; Code:
|
|
||||||
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
|
|
||||||
|
|
||||||
;;;### (autoloads nil "magit-gh-pulls" "magit-gh-pulls.el" (22387
|
|
||||||
;;;;;; 29358 559405 127000))
|
|
||||||
;;; Generated autoloads from magit-gh-pulls.el
|
|
||||||
|
|
||||||
(autoload 'magit-gh-pulls-mode "magit-gh-pulls" "\
|
|
||||||
Pull requests support for Magit
|
|
||||||
|
|
||||||
\(fn &optional ARG)" t nil)
|
|
||||||
|
|
||||||
(autoload 'turn-on-magit-gh-pulls "magit-gh-pulls" "\
|
|
||||||
Unconditionally turn on `magit-pulls-mode'.
|
|
||||||
|
|
||||||
\(fn)" nil nil)
|
|
||||||
|
|
||||||
;;;***
|
|
||||||
|
|
||||||
;; Local Variables:
|
|
||||||
;; version-control: never
|
|
||||||
;; no-byte-compile: t
|
|
||||||
;; no-update-autoloads: t
|
|
||||||
;; End:
|
|
||||||
;;; magit-gh-pulls-autoloads.el ends here
|
|
||||||
@ -1 +0,0 @@
|
|||||||
(define-package "magit-gh-pulls" "20160513.310" "GitHub pull requests extension for Magit" '((emacs "24") (gh "0.9.1") (magit "2.1.0") (pcache "0.2.3") (s "1.6.1")) :url "https://github.com/sigma/magit-gh-pulls" :keywords '("git" "tools"))
|
|
||||||
@ -1,608 +0,0 @@
|
|||||||
;;; 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
|
|
||||||
;; Package-Version: 20160513.310
|
|
||||||
;; Version: 0.5.2
|
|
||||||
;; URL: https://github.com/sigma/magit-gh-pulls
|
|
||||||
;; Package-Requires: ((emacs "24") (gh "0.9.1") (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)
|
|
||||||
|
|
||||||
;; These are the bindings for pull requests, defined in magit-gh-pulls-mode-map:
|
|
||||||
;; # g --- refreshes the list of pull requests
|
|
||||||
;; # f --- fetches the commits associated with the pull request at point
|
|
||||||
;; # b --- helps you creating a topic branch from a review request
|
|
||||||
;; # m --- merges the PR on top of the current branch
|
|
||||||
;; # c --- creates a PR from the current branch
|
|
||||||
;; # o --- opens a pull request on GitHub in your default browser
|
|
||||||
|
|
||||||
;; Then, you can do whatever you want with the commit objects associated with
|
|
||||||
;; the pull request (merge, cherry-pick, diff, ...)
|
|
||||||
|
|
||||||
;; When you create a new pull request, you can enable -w option to automatically
|
|
||||||
;; open it on GitHub in your default browser.
|
|
||||||
|
|
||||||
;;; Code:
|
|
||||||
|
|
||||||
(require 'eieio)
|
|
||||||
|
|
||||||
(require 'magit)
|
|
||||||
(require 'git-commit)
|
|
||||||
(require 'gh)
|
|
||||||
(require 'gh-pulls)
|
|
||||||
(require 'pcache)
|
|
||||||
(require 's)
|
|
||||||
(require 'cl-lib)
|
|
||||||
|
|
||||||
(defgroup magit-gh-pulls nil
|
|
||||||
"Github.com pull-requests for Magit."
|
|
||||||
:group 'magit-extensions)
|
|
||||||
|
|
||||||
(defcustom magit-gh-pulls-open-new-pr-in-browser nil
|
|
||||||
"DEPRECATED: use magit switch instead."
|
|
||||||
:group 'magit-gh-pulls
|
|
||||||
:type 'boolean)
|
|
||||||
|
|
||||||
(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 t
|
|
||||||
"Collapse commits in pull requests listing.")
|
|
||||||
|
|
||||||
(defvar magit-gh-pulls-pull-detail-limit 10
|
|
||||||
"Pull in additional information for each pull request in the
|
|
||||||
status buffer only if the total number of open PRs is <=
|
|
||||||
this number. Additional information includes individual
|
|
||||||
commits in each PR and highlighting based on the merge
|
|
||||||
status of the PR. Increasing this number may adversely
|
|
||||||
affect performance on repos with many PRs.")
|
|
||||||
|
|
||||||
(defvar-local magit-gh-pulls-previous-winconf nil)
|
|
||||||
|
|
||||||
(defvar magit-gh-pulls-editor-mode-map
|
|
||||||
(let ((map (make-keymap)))
|
|
||||||
(define-key map (kbd "C-c C-c") 'magit-gh-pulls-pull-editor-finish)
|
|
||||||
(define-key map (kbd "C-c C-k") 'magit-gh-pulls-pull-editor-quit)
|
|
||||||
map))
|
|
||||||
|
|
||||||
(define-derived-mode magit-gh-pulls-editor-mode text-mode "Magit GitHub Pulls Editor"
|
|
||||||
(font-lock-add-keywords nil (git-commit-mode-font-lock-keywords) t))
|
|
||||||
|
|
||||||
(easy-menu-define magit-gh-pulls-editor-mode-menu magit-gh-pulls-editor-mode-map
|
|
||||||
"Magit GitHub Pulls Editor Menu"
|
|
||||||
'("Magit GitHub Pulls"
|
|
||||||
["Submit Pull Request" magit-gh-pulls-pull-editor-finish t]
|
|
||||||
["Cancel" magit-gh-pulls-pull-editor-quit t]))
|
|
||||||
|
|
||||||
(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 ()
|
|
||||||
"Return (user . project) pair read from magit.gh-pulls-repo
|
|
||||||
config option."
|
|
||||||
(let* ((cfg (magit-get "magit" "gh-pulls-repo")))
|
|
||||||
(when cfg
|
|
||||||
(let* ((split (split-string cfg "/")))
|
|
||||||
(cons (car split) (cadr split))))))
|
|
||||||
|
|
||||||
|
|
||||||
;;Find all the Hostname Lines until we hit the end of config-lines or the
|
|
||||||
;;next Host line. Return '(remaining-config-lines list-of-hostnames)
|
|
||||||
(defun magit-gh-pulls-collect-hostnames (config-lines)
|
|
||||||
(let ((cur-line (car config-lines))
|
|
||||||
(rest config-lines)
|
|
||||||
(result '()))
|
|
||||||
(while (and cur-line (not (string= (cadr cur-line) "Host")))
|
|
||||||
(setq result (cons (cadr (cdr cur-line)) result))
|
|
||||||
(setq rest (cdr rest))
|
|
||||||
(setq cur-line (car rest)))
|
|
||||||
(list rest result)))
|
|
||||||
|
|
||||||
|
|
||||||
(defun magit-gh-pulls-get-host-hostnames (config-lines)
|
|
||||||
(let (result-alist
|
|
||||||
(curline (car config-lines))
|
|
||||||
(rest-lines (cdr config-lines)))
|
|
||||||
(while rest-lines
|
|
||||||
(if (string= (cadr curline) "Host")
|
|
||||||
(let ((hosts (s-split "\\s*" (cadr (cdr curline)))) ;;List of the host aliases
|
|
||||||
(rest-result (magit-gh-pulls-collect-hostnames rest-lines)))
|
|
||||||
(dolist (host hosts)
|
|
||||||
;;Host must be lowercase because the url parser lowercases the string
|
|
||||||
(setq result-alist (cons (cons (downcase host) (cadr rest-result)) result-alist)))
|
|
||||||
(setq curline (caar rest-result))
|
|
||||||
(setq rest-lines (cdar rest-result)))
|
|
||||||
(progn
|
|
||||||
(setq curline (car rest-lines))
|
|
||||||
(setq rest-lines (cdr rest-lines)))))
|
|
||||||
result-alist))
|
|
||||||
|
|
||||||
(defun -magit-gh-pulls-filter-and-split-host-lines (lines)
|
|
||||||
(delq nil
|
|
||||||
(mapcar (lambda (line)
|
|
||||||
(s-match "^[ \t]*\\(Host\\|HostName\\|Hostname\\)[ \t]+\\(.+\\)$" line))
|
|
||||||
lines)))
|
|
||||||
|
|
||||||
|
|
||||||
;; Port of github/hub's SSHConfig
|
|
||||||
(defun magit-gh-pulls-get-ssh-config-hosts ()
|
|
||||||
(let* ((file-lines (mapcar (lambda (path)
|
|
||||||
(if (file-exists-p path)
|
|
||||||
(with-temp-buffer
|
|
||||||
(insert-file-contents path)
|
|
||||||
(split-string (buffer-string) "\n" t))
|
|
||||||
'()))
|
|
||||||
(list
|
|
||||||
(concat (file-name-as-directory (getenv "HOME")) ".ssh/config")
|
|
||||||
"/etc/ssh_config"
|
|
||||||
"/etc/ssh/ssh_config")))
|
|
||||||
(all-lines (apply #'append file-lines))
|
|
||||||
(matched-lines (-magit-gh-pulls-filter-and-split-host-lines all-lines)))
|
|
||||||
(magit-gh-pulls-get-host-hostnames matched-lines)))
|
|
||||||
|
|
||||||
|
|
||||||
;; Port of github/hub's ParseURL, with modifications to align with existing parse-url
|
|
||||||
(defun magit-gh-pulls-parse-url (url ssh-config-hosts)
|
|
||||||
(let* ((fixed-url (if (and (not (s-matches? "^[a-zA-Z_-]+://" url))
|
|
||||||
(s-matches? ":" url)
|
|
||||||
(not (s-matches? "\\\\\\\\" url))) ;;Two literal backlashes
|
|
||||||
(concat "ssh://" (s-replace ":" "/" url))
|
|
||||||
url))
|
|
||||||
(parsed-url (url-generic-parse-url fixed-url))
|
|
||||||
(ssh-host (when (string= (url-type parsed-url) "ssh")
|
|
||||||
(assoc (url-host parsed-url) ssh-config-hosts))))
|
|
||||||
(when (and ssh-host (cadr ssh-host))
|
|
||||||
(setf (url-host parsed-url) (cadr ssh-host)))
|
|
||||||
(when (and
|
|
||||||
(string= (url-host parsed-url) "github.com")
|
|
||||||
(s-matches? "\\(git\\|ssh\\|https?\\)" (url-type parsed-url)))
|
|
||||||
(let ((creds (s-match "/\\(.+\\)/\\([^/]+\\)/?$" (url-filename parsed-url))))
|
|
||||||
(when creds
|
|
||||||
(cons (cadr creds) (s-chop-suffix ".git" (cadr (cdr creds)))))))))
|
|
||||||
|
|
||||||
|
|
||||||
(defun magit-gh-pulls-guess-repo-from-origin ()
|
|
||||||
"Return (user . project) pair inferred from remotes in
|
|
||||||
.git/config."
|
|
||||||
(let ((creds nil)
|
|
||||||
(ssh-config-hosts (magit-gh-pulls-get-ssh-config-hosts)))
|
|
||||||
(dolist (remote (magit-git-lines "remote") creds)
|
|
||||||
(let ((parsed (magit-gh-pulls-parse-url
|
|
||||||
(magit-get "remote" remote "url")
|
|
||||||
ssh-config-hosts)))
|
|
||||||
(when parsed
|
|
||||||
(setq creds parsed))))))
|
|
||||||
|
|
||||||
(defun magit-gh-pulls-guess-repo ()
|
|
||||||
"Return (user . project) pair obtained either from explicit
|
|
||||||
option, or inferred from remotes."
|
|
||||||
(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)
|
|
||||||
"Returns T if the API request to the given USER and PROJ is cached."
|
|
||||||
(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-unless-debug 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))))
|
|
||||||
(num-total-stubs (length stubs))
|
|
||||||
(i 0)
|
|
||||||
(branch (magit-get-current-branch)))
|
|
||||||
(when (or (> (length stubs) 0) (not cached?))
|
|
||||||
(magit-insert-section (pulls)
|
|
||||||
(magit-insert-heading "Pull Requests:")
|
|
||||||
(dolist (stub stubs)
|
|
||||||
(cl-incf i)
|
|
||||||
(let* ((id (oref stub :number))
|
|
||||||
(base-sha (oref (oref stub :base) :sha))
|
|
||||||
(base-ref (oref (oref stub :base) :ref))
|
|
||||||
(head-sha (oref (oref stub :head) :sha))
|
|
||||||
;; branch has been deleted in the meantime...
|
|
||||||
(invalid (equal (oref (oref stub :head) :ref) head-sha))
|
|
||||||
(have-commits
|
|
||||||
(and (>= magit-gh-pulls-pull-detail-limit i)
|
|
||||||
(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
|
|
||||||
(magit-git-string "branch" branch
|
|
||||||
(format "--contains=%s" head-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 stub :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 magit-gh-pulls-collapse-commits)
|
|
||||||
(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)
|
|
||||||
(insert heading)))
|
|
||||||
(t
|
|
||||||
(magit-insert-section (unfetched-pull info)
|
|
||||||
(insert heading))))))
|
|
||||||
(when (not cached?)
|
|
||||||
(insert "Press `# 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-diff-pull-request ()
|
|
||||||
(interactive)
|
|
||||||
(magit-section-case
|
|
||||||
(pull
|
|
||||||
(let* ((req (magit-gh-section-req-data))
|
|
||||||
(inhibit-magit-refresh t))
|
|
||||||
(magit-diff (concat (oref (oref req :base) :sha) ".."
|
|
||||||
(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-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-and-checkout 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-and-checkout branch base)
|
|
||||||
(magit-merge (oref (oref req :head) :sha))
|
|
||||||
(magit-checkout base)
|
|
||||||
(magit-merge branch (when (member "--no-ff" (magit-gh-pulls-arguments))
|
|
||||||
'("--no-ff")))
|
|
||||||
(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) :ssh-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-get-remote-default (&optional remote-name-override)
|
|
||||||
(let ((remote-name (or remote-name-override "origin"))
|
|
||||||
(remote-branches (magit-git-lines "branch" "-r"))
|
|
||||||
remote-head)
|
|
||||||
(while (and remote-branches (not remote-head))
|
|
||||||
(let ((m (s-match (format "^\\s-*%s/HEAD -> %s/\\(\\w*\\)" remote-name remote-name) (car remote-branches))))
|
|
||||||
(if m
|
|
||||||
(setq remote-head (cadr m))
|
|
||||||
(setq remote-branches (cdr remote-branches)))))
|
|
||||||
remote-head))
|
|
||||||
|
|
||||||
(defun magit-gh-pulls-build-req (api user proj callback)
|
|
||||||
"Builds a request entity for a new pull request. Under
|
|
||||||
synchronous flow (editor disabled), fires CALLBACK with
|
|
||||||
API, USER, PROJ and the new REQUEST as args. Under
|
|
||||||
asynchronous flow, passes all ARGS through to the PR
|
|
||||||
editor which is responsible for continuing the flow."
|
|
||||||
(let* ((current (magit-get-current-branch))
|
|
||||||
(current-default (magit-gh-pulls-get-remote-default))
|
|
||||||
(base-branch (magit-read-branch-or-commit "Base" current-default))
|
|
||||||
(head-branch (magit-read-branch-or-commit "Head" current)))
|
|
||||||
(let* ((head-remote (concat (magit-get-remote base-branch) "/" head-branch))
|
|
||||||
(pushed-p (and (magit-branch-p head-remote)
|
|
||||||
(null (magit-git-lines "diff" (concat head-remote ".." head-branch))))))
|
|
||||||
(when (and (not pushed-p)
|
|
||||||
(yes-or-no-p "PR branch doesn't appear to be pushed. Push it?"))
|
|
||||||
(magit-push current (magit-get-remote base-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 base-branch))
|
|
||||||
(head
|
|
||||||
(make-instance 'gh-repos-ref :user (make-instance 'gh-users-user :name user)
|
|
||||||
:repo (make-instance 'gh-repos-repo :name proj)
|
|
||||||
:ref head-branch))
|
|
||||||
(default-title (magit-git-string "log"
|
|
||||||
(format "%s..%s" base-branch head-branch)
|
|
||||||
"--format=%s" "--reverse"))
|
|
||||||
(default-body (mapconcat 'identity (magit-git-items "log"
|
|
||||||
(format "%s..%s" base-branch head-branch)
|
|
||||||
"--reverse" "--format=**%s**%n%b") "\n")))
|
|
||||||
|
|
||||||
(if (member "--use-pr-editor" (magit-gh-pulls-arguments))
|
|
||||||
(magit-gh-pulls-init-pull-editor api user proj default-title default-body base head callback)
|
|
||||||
(let* ((title (read-string "Title: " default-title))
|
|
||||||
(body (read-string "Description: " default-body))
|
|
||||||
(req (make-instance 'gh-pulls-request :head head :base base :body body :title title)))
|
|
||||||
(funcall callback api user proj req))))))
|
|
||||||
|
|
||||||
(defun magit-gh-pulls-pr-template-file ()
|
|
||||||
"Returns the path to the PULL_REQUEST_TEMPLATE file in the
|
|
||||||
current repository. Returns nil if there is not a pull request
|
|
||||||
template file."
|
|
||||||
(car (directory-files (magit-toplevel) t "^PULL_REQUEST_TEMPLATE")))
|
|
||||||
|
|
||||||
(defun magit-gh-pulls-init-pull-editor (api user proj default-title default-body base head callback)
|
|
||||||
"Create a new buffer for editing this pull request and
|
|
||||||
switch to it. The context needed to finalize the
|
|
||||||
pull request is stored in a buffer-local var in the
|
|
||||||
newly created buffer."
|
|
||||||
(let ((winconf (current-window-configuration))
|
|
||||||
(buffer (get-buffer-create (format "*magit-gh-pulls: %s*" proj)))
|
|
||||||
(context (make-hash-table :test 'equal)))
|
|
||||||
(dolist (var '(api user proj base head callback))
|
|
||||||
(puthash (symbol-name var) (eval var) context))
|
|
||||||
(split-window-vertically)
|
|
||||||
(other-window 1)
|
|
||||||
(switch-to-buffer buffer)
|
|
||||||
(funcall 'magit-gh-pulls-editor-mode)
|
|
||||||
(if (magit-gh-pulls-pr-template-file)
|
|
||||||
(progn (insert (or default-title "") "\n\n")
|
|
||||||
(insert-file-contents (magit-gh-pulls-pr-template-file)))
|
|
||||||
(insert (or default-title "") "\n\n" default-body))
|
|
||||||
(goto-char (point-min))
|
|
||||||
(message "Opening pull request editor. C-c C-c to finish, C-c C-k to quit.")
|
|
||||||
(setq-local magit-gh-pulls-editor-context context)
|
|
||||||
(setq magit-gh-pulls-previous-winconf winconf)))
|
|
||||||
|
|
||||||
(defun magit-gh-pulls-pull-editor-finish ()
|
|
||||||
"Finish editing the current pull request and continue
|
|
||||||
to submit it. This should be called interactively
|
|
||||||
from within a pull request editor buffer."
|
|
||||||
(interactive)
|
|
||||||
(if (eq nil magit-gh-pulls-editor-context)
|
|
||||||
(message "This function can only be run in a pull editor buffer.")
|
|
||||||
(let* ((context magit-gh-pulls-editor-context)
|
|
||||||
(end-of-first-line (save-excursion
|
|
||||||
(beginning-of-buffer)
|
|
||||||
(line-end-position)))
|
|
||||||
(title (s-trim (buffer-substring-no-properties 1 end-of-first-line)))
|
|
||||||
(body (s-trim (buffer-substring-no-properties end-of-first-line (point-max))))
|
|
||||||
(req (make-instance 'gh-pulls-request
|
|
||||||
:head (gethash "head" context)
|
|
||||||
:base (gethash "base" context)
|
|
||||||
:body body :title title)))
|
|
||||||
(funcall (gethash "callback" context)
|
|
||||||
(gethash "api" context)
|
|
||||||
(gethash "user" context)
|
|
||||||
(gethash "proj" context)
|
|
||||||
req)
|
|
||||||
(magit-gh-pulls-pull-editor-quit))))
|
|
||||||
|
|
||||||
(defun magit-gh-pulls-pull-editor-quit ()
|
|
||||||
"Cleanup the current pull request editor and restore
|
|
||||||
the previous window config."
|
|
||||||
(interactive)
|
|
||||||
(if (eq nil magit-gh-pulls-editor-context)
|
|
||||||
(message "This function can only be run in a pull editor buffer.")
|
|
||||||
(let ((winconf magit-gh-pulls-previous-winconf))
|
|
||||||
(kill-buffer)
|
|
||||||
(kill-local-variable 'magit-gh-pulls-previous-winconf)
|
|
||||||
(when winconf
|
|
||||||
(set-window-configuration winconf)))))
|
|
||||||
|
|
||||||
(defun magit-gh-pulls-create-pull-request ()
|
|
||||||
"Entrypoint for creating a new 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)))
|
|
||||||
(magit-gh-pulls-build-req api user proj 'magit-gh-pulls-submit-pull-request)))))
|
|
||||||
|
|
||||||
(defun magit-gh-pulls-submit-pull-request (api user proj req)
|
|
||||||
"Endpoint for creating a new pull request. Sync and async
|
|
||||||
flows should both call this function to finish creating
|
|
||||||
a new pull request."
|
|
||||||
(interactive)
|
|
||||||
(let* ((a (gh-pulls-new api user proj req)))
|
|
||||||
(if (not (= (oref a :http-status) 201))
|
|
||||||
(message "Error creating pull-request: %s. Have you pushed the branch to github?" (cdr (assoc "Status" (oref a :headers))))
|
|
||||||
(let ((url (oref (oref a :data) :html-url)))
|
|
||||||
(message (concat "Created pull-request and copied URL to kill ring: " url))
|
|
||||||
(when (member "--open-new-in-browser" (magit-gh-pulls-arguments))
|
|
||||||
(browse-url url))
|
|
||||||
(kill-new 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)
|
|
||||||
|
|
||||||
(magit-define-section-jumper magit-jump-to-pulls "Pull Requests" pulls)
|
|
||||||
(define-key magit-status-mode-map (kbd "jq") 'magit-jump-to-pulls)
|
|
||||||
|
|
||||||
(defvar magit-gh-pulls-mode-map
|
|
||||||
(let ((map (make-sparse-keymap)))
|
|
||||||
(define-key map (kbd "#") 'magit-gh-pulls-popup)
|
|
||||||
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))
|
|
||||||
|
|
||||||
(magit-define-popup magit-gh-pulls-popup
|
|
||||||
"Show popup buffer featuring Github Pull Requests commands."
|
|
||||||
'magit-commands
|
|
||||||
:switches '((?c "Produce merge commit" "--no-ff")
|
|
||||||
(?w "Open new PR in browser" "--open-new-in-browser")
|
|
||||||
(?e "Edit PR in full buffer" "--use-pr-editor"))
|
|
||||||
:actions '((?g "Reload" magit-gh-pulls-reload)
|
|
||||||
(?f "Fetch" magit-gh-pulls-fetch-commits)
|
|
||||||
(?d "Diff" magit-gh-pulls-diff-pull-request)
|
|
||||||
(?b "Make branch" magit-gh-pulls-create-branch)
|
|
||||||
(?m "Merge" magit-gh-pulls-merge-pull-request)
|
|
||||||
(?c "Create new PR" magit-gh-pulls-create-pull-request)
|
|
||||||
(?o "Open in browser" magit-gh-pulls-open-in-browser))
|
|
||||||
:default-action 'magit-gh-pulls-reload)
|
|
||||||
|
|
||||||
(provide 'magit-gh-pulls)
|
|
||||||
;; Local Variables:
|
|
||||||
;; indent-tabs-mode: nil
|
|
||||||
;; End:
|
|
||||||
;;; magit-gh-pulls.el ends here
|
|
||||||
17
elpa/magithub-20160926.2044/magithub-autoloads.el
Normal file
17
elpa/magithub-20160926.2044/magithub-autoloads.el
Normal file
@ -0,0 +1,17 @@
|
|||||||
|
;;; magithub-autoloads.el --- automatically extracted autoloads
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||||
|
|
||||||
|
;;;### (autoloads nil nil ("magithub-cache.el" "magithub-ci.el" "magithub-core.el"
|
||||||
|
;;;;;; "magithub-issue.el" "magithub-pkg.el" "magithub.el") (22506
|
||||||
|
;;;;;; 26931 120335 726000))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; version-control: never
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; no-update-autoloads: t
|
||||||
|
;; End:
|
||||||
|
;;; magithub-autoloads.el ends here
|
||||||
67
elpa/magithub-20160926.2044/magithub-cache.el
Normal file
67
elpa/magithub-20160926.2044/magithub-cache.el
Normal file
@ -0,0 +1,67 @@
|
|||||||
|
;;; magithub-cache.el --- caching network data -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2016 Sean Allred
|
||||||
|
|
||||||
|
;; Author: Sean Allred <code@seanallred.com>
|
||||||
|
;; Keywords: data, tools
|
||||||
|
|
||||||
|
;; This program 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 3 of the License, or
|
||||||
|
;; (at your option) any later version.
|
||||||
|
|
||||||
|
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;;
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(defvar magithub-cache--cache (make-hash-table)
|
||||||
|
"A hash table to use as a cache.
|
||||||
|
Entries are of the form (time-entered . value).")
|
||||||
|
|
||||||
|
(defvar magithub-cache-refresh-seconds-plist
|
||||||
|
(list :issues 600 :ci-status 60)
|
||||||
|
"The number of seconds that have to pass for GitHub data to be
|
||||||
|
considered outdated.")
|
||||||
|
|
||||||
|
(defun magithub-cache (cache default)
|
||||||
|
"The cached value for CACHE (set to DEFAULT if necessary)."
|
||||||
|
(declare (indent defun))
|
||||||
|
(let ((cached-value (gethash cache magithub-cache--cache :no-value)))
|
||||||
|
(if (or (eq cached-value :no-value)
|
||||||
|
(< (plist-get magithub-cache-refresh-seconds-plist cache)
|
||||||
|
(time-to-seconds (time-since (car cached-value)))))
|
||||||
|
(cdr (puthash cache (cons (current-time) (eval default))
|
||||||
|
magithub-cache--cache))
|
||||||
|
(when magithub-debug-mode
|
||||||
|
(message "Using cached value for %S (retrieved %s)"
|
||||||
|
cache (format-time-string "%F %T" (car cached-value))))
|
||||||
|
(cdr cached-value))))
|
||||||
|
|
||||||
|
(defun magithub-cache-value (cache)
|
||||||
|
"The cached value for CACHE."
|
||||||
|
(let ((c (gethash cache magithub-cache--cache :no-value)))
|
||||||
|
(unless (eq c :no-value)
|
||||||
|
(cdr c))))
|
||||||
|
|
||||||
|
(defun magithub-cache-clear (cache)
|
||||||
|
"Clear the cache."
|
||||||
|
(remhash cache magithub-cache--cache))
|
||||||
|
|
||||||
|
(defun magithub-refresh ()
|
||||||
|
"Refresh all GitHub data."
|
||||||
|
(interactive)
|
||||||
|
(setq magithub-cache--cache (make-hash-table))
|
||||||
|
(magit-refresh))
|
||||||
|
|
||||||
|
(provide 'magithub-cache)
|
||||||
|
;;; magithub-cache.el ends here
|
||||||
197
elpa/magithub-20160926.2044/magithub-ci.el
Normal file
197
elpa/magithub-20160926.2044/magithub-ci.el
Normal file
@ -0,0 +1,197 @@
|
|||||||
|
;;; magithub-ci.el --- Show CI status as a magit-status header -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2016 Sean Allred
|
||||||
|
|
||||||
|
;; Author: Sean Allred <code@seanallred.com>
|
||||||
|
;; Keywords: tools
|
||||||
|
|
||||||
|
;; This program 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 3 of the License, or
|
||||||
|
;; (at your option) any later version.
|
||||||
|
|
||||||
|
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;; Provide the CI status of "origin" in the Magit status buffer.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'magit)
|
||||||
|
(require 'magit-section)
|
||||||
|
(require 'magit-popup)
|
||||||
|
|
||||||
|
(require 'magithub-core)
|
||||||
|
(require 'magithub-cache)
|
||||||
|
|
||||||
|
(defun magithub-maybe-insert-ci-status-header ()
|
||||||
|
"If this is a GitHub repository, insert the CI status header."
|
||||||
|
(when (and (magithub-github-repository-p)
|
||||||
|
(executable-find magithub-hub-executable))
|
||||||
|
(magithub-insert-ci-status-header)))
|
||||||
|
|
||||||
|
(defun magithub-ci-status ()
|
||||||
|
"One of 'success, 'error, 'failure, 'pending, or 'no-status."
|
||||||
|
(let ((same-commit
|
||||||
|
(string-equal (magit-rev-parse "HEAD")
|
||||||
|
(magithub-ci-status-current-commit))))
|
||||||
|
(unless same-commit
|
||||||
|
(magithub-cache-clear :ci-status))
|
||||||
|
(if (eq (magithub-cache-value :ci-status) 'success)
|
||||||
|
'success
|
||||||
|
(magithub-cache :ci-status
|
||||||
|
'(magithub-ci-status--internal)))))
|
||||||
|
|
||||||
|
(defun magithub-ci-status-current-commit (&optional new-value)
|
||||||
|
"The commit our cached value corresponds to."
|
||||||
|
(let ((keys (list "magithub" "ci" "lastCommit")))
|
||||||
|
(if new-value (apply #'magit-set new-value keys)
|
||||||
|
(apply #'magit-get keys))))
|
||||||
|
|
||||||
|
(defun magithub-ci-status--internal (&optional ignore-ci-skips)
|
||||||
|
"One of 'success, 'error, 'failure, 'pending, or 'no-status."
|
||||||
|
(with-temp-message "Updating CI status..."
|
||||||
|
(let* ((last-commit (when ignore-ci-skips (magithub-ci-status--last-commit)))
|
||||||
|
(output (car (magithub--command-output "ci-status" last-commit))))
|
||||||
|
(if output
|
||||||
|
(let* ((output (replace-regexp-in-string "\s" "-" output))
|
||||||
|
(status (intern output)))
|
||||||
|
(if (and (not ignore-ci-skips) (eq status 'no-status))
|
||||||
|
(magithub-ci-status--internal t)
|
||||||
|
(magithub-ci-status-current-commit (magit-rev-parse "HEAD"))
|
||||||
|
status))
|
||||||
|
(beep)
|
||||||
|
(setq magithub-hub-error
|
||||||
|
(message
|
||||||
|
(concat "Hub didn't have any output for \"ci-status\"!\n"
|
||||||
|
"Consider submitting an issue to github/hub.")))
|
||||||
|
'internal-error))))
|
||||||
|
|
||||||
|
(defun magithub-ci-status--last-commit ()
|
||||||
|
"Find the commit considered to have the current CI status.
|
||||||
|
Right now, this finds the most recent commit without
|
||||||
|
|
||||||
|
[ci skip]
|
||||||
|
|
||||||
|
or
|
||||||
|
|
||||||
|
[skip ci]
|
||||||
|
|
||||||
|
in the commit message.
|
||||||
|
|
||||||
|
See the following resources:
|
||||||
|
|
||||||
|
- https://docs.travis-ci.com/user/customizing-the-build#Skipping-a-build
|
||||||
|
- https://circleci.com/docs/skip-a-build/"
|
||||||
|
(let* ((args '("--invert-grep"
|
||||||
|
"--grep=\\[ci skip\\]"
|
||||||
|
"--grep=\\[skip ci\\]"
|
||||||
|
"--format=oneline"
|
||||||
|
"--max-count=1"))
|
||||||
|
(output (magit-git-lines "log" args)))
|
||||||
|
(car (split-string (car output)))))
|
||||||
|
|
||||||
|
(defvar magithub-ci-status-alist
|
||||||
|
'((no-status . "None")
|
||||||
|
(error . "Error")
|
||||||
|
(internal-error . magithub-ci--hub-error-string)
|
||||||
|
(failure . "Failure")
|
||||||
|
(pending . "Pending")
|
||||||
|
(success . "Success")))
|
||||||
|
|
||||||
|
(defun magithub-ci--hub-error-string ()
|
||||||
|
"Internal error string."
|
||||||
|
(format "Internal error!\n%s" magithub-hub-error))
|
||||||
|
|
||||||
|
(defface magithub-ci-no-status
|
||||||
|
'((((class color)) :inherit magit-dimmed))
|
||||||
|
"Face used when CI status is `no-status'."
|
||||||
|
:group 'magithub-faces)
|
||||||
|
|
||||||
|
(defface magithub-ci-error
|
||||||
|
'((((class color)) :inherit magit-signature-untrusted))
|
||||||
|
"Face used when CI status is `error'."
|
||||||
|
:group 'magithub-faces)
|
||||||
|
|
||||||
|
(defface magithub-ci-pending
|
||||||
|
'((((class color)) :inherit magit-signature-untrusted))
|
||||||
|
"Face used when CI status is `pending'."
|
||||||
|
:group 'magithub-faces)
|
||||||
|
|
||||||
|
(defface magithub-ci-success
|
||||||
|
'((((class color)) :inherit magit-signature-good))
|
||||||
|
"Face used when CI status is `success'."
|
||||||
|
:group 'magithub-faces)
|
||||||
|
|
||||||
|
(defface magithub-ci-failure
|
||||||
|
'((((class color)) :inherit magit-signature-bad))
|
||||||
|
"Face used when CI status is `'"
|
||||||
|
:group 'magithub-faces)
|
||||||
|
|
||||||
|
(defface magithub-ci-unknown
|
||||||
|
'((((class color)) :inherit magit-signature-untrusted))
|
||||||
|
"Face used when CI status is `unknown'."
|
||||||
|
:group 'magithub-faces)
|
||||||
|
|
||||||
|
(defun magithub-ci-visit ()
|
||||||
|
"Browse the CI.
|
||||||
|
Sets up magithub.ci.url if necessary."
|
||||||
|
(interactive)
|
||||||
|
(let ((var-value (magit-get "magithub" "ci" "url")))
|
||||||
|
(unless var-value
|
||||||
|
(magit-set
|
||||||
|
(setq var-value (read-from-minibuffer "I don't know the CI URL yet -- what is it? I'll remember: ")
|
||||||
|
var-value (if (string-equal "" var-value) nil var-value))
|
||||||
|
"magithub" "ci" "url"))
|
||||||
|
(browse-url var-value)))
|
||||||
|
|
||||||
|
(defvar magit-magithub-ci-status-section-map
|
||||||
|
(let ((map (make-sparse-keymap)))
|
||||||
|
(define-key map [remap magit-visit-thing] #'magithub-ci-visit)
|
||||||
|
(define-key map [remap magit-refresh] #'magithub-ci-refresh)
|
||||||
|
map)
|
||||||
|
"Keymap for `magithub-ci-status' header section.")
|
||||||
|
|
||||||
|
(defun magithub-ci-refresh ()
|
||||||
|
"Invalidate the CI cache and refresh the buffer."
|
||||||
|
(interactive)
|
||||||
|
(magithub-cache-clear :ci-status)
|
||||||
|
(when (derived-mode-p 'magit-status-mode)
|
||||||
|
(magit-refresh)))
|
||||||
|
|
||||||
|
(defun magithub-insert-ci-status-header ()
|
||||||
|
(let* ((status (magithub-ci-status))
|
||||||
|
(face (intern (format "magithub-ci-%s"
|
||||||
|
(symbol-name status))))
|
||||||
|
(status-val (cdr (assq status magithub-ci-status-alist))))
|
||||||
|
(magit-insert-section (magithub-ci-status)
|
||||||
|
(insert (format "%-10s" "CI: "))
|
||||||
|
(insert (propertize
|
||||||
|
(cond
|
||||||
|
((stringp status-val) status-val)
|
||||||
|
((functionp status-val) (funcall status-val))
|
||||||
|
(t (format "%S" status-val)))
|
||||||
|
'face (if (facep face) face 'magithub-ci-unknown)))
|
||||||
|
(insert ?\n))))
|
||||||
|
|
||||||
|
(defun magithub-toggle-ci-status-header ()
|
||||||
|
(interactive)
|
||||||
|
(if (memq #'magithub-maybe-insert-ci-status-header magit-status-headers-hook)
|
||||||
|
(remove-hook 'magit-status-headers-hook #'magithub-maybe-insert-ci-status-header)
|
||||||
|
(if (executable-find magithub-hub-executable)
|
||||||
|
(add-hook 'magit-status-headers-hook #'magithub-maybe-insert-ci-status-header t)
|
||||||
|
(message "Magithub: (magithub-toggle-ci-status-header) `hub' isn't installed, so I can't insert the CI header")))
|
||||||
|
(when (derived-mode-p 'magit-status-mode)
|
||||||
|
(magit-refresh)))
|
||||||
|
|
||||||
|
(magithub-toggle-ci-status-header)
|
||||||
|
|
||||||
|
(provide 'magithub-ci)
|
||||||
|
;;; magithub-ci.el ends here
|
||||||
149
elpa/magithub-20160926.2044/magithub-core.el
Normal file
149
elpa/magithub-20160926.2044/magithub-core.el
Normal file
@ -0,0 +1,149 @@
|
|||||||
|
;;; magithub-core.el --- core functions for magithub -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2016 Sean Allred
|
||||||
|
|
||||||
|
;; Author: Sean Allred <code@seanallred.com>
|
||||||
|
;; Keywords: tools
|
||||||
|
|
||||||
|
;; This program 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 3 of the License, or
|
||||||
|
;; (at your option) any later version.
|
||||||
|
|
||||||
|
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;;
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'magit)
|
||||||
|
|
||||||
|
(defun magithub-github-repository-p ()
|
||||||
|
"Non-nil if \"origin\" points to GitHub."
|
||||||
|
(let ((url (magit-get "remote" "origin" "url")))
|
||||||
|
(or (s-prefix? "git@github.com:" url)
|
||||||
|
(s-prefix? "https://github.com/" url)
|
||||||
|
(s-prefix? "git://github.com/" url))))
|
||||||
|
|
||||||
|
(defun magithub--api-available-p ()
|
||||||
|
"Non-nil if the API is available."
|
||||||
|
(let ((magit-git-executable "ping")
|
||||||
|
(magit-pre-call-git-hook nil)
|
||||||
|
(magit-git-global-arguments nil))
|
||||||
|
(= 0 (magit-git-exit-code "-c 1" "api.github.com"))))
|
||||||
|
|
||||||
|
(defun magithub--completing-read-multiple (prompt collection)
|
||||||
|
"Using PROMPT, get a list of elements in COLLECTION.
|
||||||
|
This function continues until all candidates have been entered or
|
||||||
|
until the user enters a value of \"\". Duplicate entries are not
|
||||||
|
allowed."
|
||||||
|
(let (label-list this-label done)
|
||||||
|
(while (not done)
|
||||||
|
(setq collection (remove this-label collection)
|
||||||
|
this-label "")
|
||||||
|
(when collection
|
||||||
|
;; @todo it would be nice to detect whether or not we are
|
||||||
|
;; allowed to create labels -- if not, we can require-match
|
||||||
|
(setq this-label (completing-read prompt collection)))
|
||||||
|
(unless (setq done (s-blank? this-label))
|
||||||
|
(push this-label label-list)))
|
||||||
|
label-list))
|
||||||
|
|
||||||
|
(defconst magithub-hash-regexp
|
||||||
|
(rx bow (= 40 (| digit (any (?A . ?F) (?a . ?f)))) eow)
|
||||||
|
"Regexp for matching commit hashes.")
|
||||||
|
|
||||||
|
(defcustom magithub-hub-executable "hub"
|
||||||
|
"The hub executable used by Magithub."
|
||||||
|
:group 'magithub
|
||||||
|
:package-version '(magithub . "0.1")
|
||||||
|
:type 'string)
|
||||||
|
|
||||||
|
(defvar magithub-debug-mode nil
|
||||||
|
"When non-nil, echo hub commands before they're executed.")
|
||||||
|
|
||||||
|
(defvar magithub-hub-error nil
|
||||||
|
"When non-nil, this is a message for when hub fails.")
|
||||||
|
|
||||||
|
(defmacro magithub-with-hub (&rest body)
|
||||||
|
`(let ((magit-git-executable magithub-hub-executable)
|
||||||
|
(magit-pre-call-git-hook nil)
|
||||||
|
(magit-git-global-arguments nil))
|
||||||
|
,@body))
|
||||||
|
|
||||||
|
(defun magithub--hub-command (magit-function command args)
|
||||||
|
(unless (executable-find magithub-hub-executable)
|
||||||
|
(user-error "Hub (hub.github.com) not installed; aborting"))
|
||||||
|
(unless (file-exists-p "~/.config/hub")
|
||||||
|
(user-error "Hub hasn't been initialized yet; aborting"))
|
||||||
|
(when magithub-debug-mode
|
||||||
|
(message "Calling hub with args: %S %S" command args))
|
||||||
|
(with-timeout (5 (error "Took too long! %s%S" command args))
|
||||||
|
(magithub-with-hub (funcall magit-function command args))))
|
||||||
|
|
||||||
|
(defun magithub--command (command &optional args)
|
||||||
|
"Run COMMAND synchronously using `magithub-hub-executable'."
|
||||||
|
(magithub--hub-command #'magit-run-git command args))
|
||||||
|
|
||||||
|
(defun magithub--command-with-editor (command &optional args)
|
||||||
|
"Run COMMAND asynchronously using `magithub-hub-executable'.
|
||||||
|
Ensure GIT_EDITOR is set up appropriately."
|
||||||
|
(magithub--hub-command #'magit-run-git-with-editor command args))
|
||||||
|
|
||||||
|
(defun magithub--command-output (command &optional args)
|
||||||
|
"Run COMMAND synchronously using `magithub-hub-executable'
|
||||||
|
and returns its output as a list of lines."
|
||||||
|
(magithub--hub-command #'magit-git-lines command args))
|
||||||
|
|
||||||
|
(defun magithub--command-quick (command &optional args)
|
||||||
|
"Quickly execute COMMAND with ARGS."
|
||||||
|
(ignore (magithub--command-output command args)))
|
||||||
|
|
||||||
|
(defun magithub--meta-new-issue ()
|
||||||
|
"Open a new Magithub issue.
|
||||||
|
See /.github/ISSUE_TEMPLATE.md in this repository."
|
||||||
|
(interactive)
|
||||||
|
(browse-url "https://github.com/vermiculus/magithub/issues/new"))
|
||||||
|
|
||||||
|
(defun magithub--meta-help ()
|
||||||
|
"Opens Magithub help."
|
||||||
|
(interactive)
|
||||||
|
(browse-url "https://gitter.im/vermiculus/magithub"))
|
||||||
|
|
||||||
|
(defun magithub-error (err-message tag &optional trace)
|
||||||
|
"Report a Magithub error."
|
||||||
|
(setq trace (or trace (with-output-to-string (backtrace))))
|
||||||
|
(when (y-or-n-p (concat tag " Report? (A bug report will be placed in your clipboard.)"))
|
||||||
|
(with-current-buffer-window
|
||||||
|
(get-buffer-create "*magithub issue*")
|
||||||
|
#'display-buffer-pop-up-window nil
|
||||||
|
(when (fboundp 'markdown-mode) (markdown-mode))
|
||||||
|
(insert
|
||||||
|
(kill-new
|
||||||
|
(format
|
||||||
|
"## Automated error report
|
||||||
|
|
||||||
|
### Description
|
||||||
|
|
||||||
|
%s
|
||||||
|
|
||||||
|
### Backtrace
|
||||||
|
|
||||||
|
```
|
||||||
|
%s```
|
||||||
|
"
|
||||||
|
(read-string "Briefly describe what you were doing: ")
|
||||||
|
trace))))
|
||||||
|
(magithub--meta-new-issue))
|
||||||
|
(error err-message))
|
||||||
|
|
||||||
|
(provide 'magithub-core)
|
||||||
|
;;; magithub-core.el ends here
|
||||||
179
elpa/magithub-20160926.2044/magithub-issue.el
Normal file
179
elpa/magithub-20160926.2044/magithub-issue.el
Normal file
@ -0,0 +1,179 @@
|
|||||||
|
;;; magithub-issue.el --- Browse issues with Magithub -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2016 Sean Allred
|
||||||
|
|
||||||
|
;; Author: Sean Allred <code@seanallred.com>
|
||||||
|
;; Keywords: tools
|
||||||
|
|
||||||
|
;; This program 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 3 of the License, or
|
||||||
|
;; (at your option) any later version.
|
||||||
|
|
||||||
|
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;; Jump to issues from `magit-status'!
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'magit)
|
||||||
|
(require 'magit-section)
|
||||||
|
|
||||||
|
(require 'magithub-core)
|
||||||
|
(require 'magithub-cache)
|
||||||
|
|
||||||
|
(magit-define-popup magithub-issues-popup
|
||||||
|
"Popup console for creating GitHub issues."
|
||||||
|
'magithub-commands
|
||||||
|
:man-page "hub"
|
||||||
|
:options '((?l "Add labels" "--label=" magithub-issue-read-labels))
|
||||||
|
:actions '((?c "Create new issue" magithub-issue-new)))
|
||||||
|
|
||||||
|
(defvar magithub-issue-format
|
||||||
|
(list :number " %3d "
|
||||||
|
:title " %s ")
|
||||||
|
"These properties will be inserted in the order in which their
|
||||||
|
found. See `magithub-issue--process-line'.")
|
||||||
|
|
||||||
|
(defun magithub-issue-new ()
|
||||||
|
"Create a new issue on GitHub."
|
||||||
|
(interactive)
|
||||||
|
(unless (magithub-github-repository-p)
|
||||||
|
(user-error "Not a GitHub repository"))
|
||||||
|
(magithub--command-with-editor
|
||||||
|
"issue" (cons "create" (magithub-issues-arguments))))
|
||||||
|
|
||||||
|
(defun magithub-issue-label-list ()
|
||||||
|
"Return a list of issue labels.
|
||||||
|
This is a hard-coded list right now."
|
||||||
|
(list "bug" "duplicate" "enhancement"
|
||||||
|
"help wanted" "invalid" "question" "wontfix"))
|
||||||
|
|
||||||
|
(defun magithub-issue-read-labels (prompt &optional default)
|
||||||
|
"Read some issue labels and return a comma-separated string.
|
||||||
|
Available issues are provided by `magithub-issue-label-list'.
|
||||||
|
|
||||||
|
DEFAULT is a comma-separated list of issues -- those issues that
|
||||||
|
are in DEFAULT are not prompted for again."
|
||||||
|
;; todo: probably need to add DEFAULT to the top here
|
||||||
|
(s-join
|
||||||
|
","
|
||||||
|
(magithub--completing-read-multiple
|
||||||
|
(format "%s... %s" prompt "Issue labels (or \"\" to quit): ")
|
||||||
|
(let* ((default-labels (when default (s-split "," default t))))
|
||||||
|
(cl-set-difference (magithub-issue-label-list) default-labels)))))
|
||||||
|
|
||||||
|
(defun magithub-issue--process-line (s)
|
||||||
|
"Process a line S into an issue.
|
||||||
|
|
||||||
|
Returns a plist with the following properties:
|
||||||
|
|
||||||
|
:number issue or pull request number
|
||||||
|
:type either 'pull-request or 'issue
|
||||||
|
:title the title of the issue or pull request
|
||||||
|
:url link to issue or pull request"
|
||||||
|
(let (number title url)
|
||||||
|
(if (ignore-errors
|
||||||
|
(with-temp-buffer
|
||||||
|
(insert s)
|
||||||
|
(goto-char 0)
|
||||||
|
(search-forward "]")
|
||||||
|
(setq number (string-to-number (substring s 0 (point))))
|
||||||
|
(setq title (substring s (point)
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-max))
|
||||||
|
(- (search-backward "(") 2))))
|
||||||
|
(goto-char (point-max))
|
||||||
|
(delete-char -2)
|
||||||
|
(search-backward "(")
|
||||||
|
(forward-char 2)
|
||||||
|
(setq url (buffer-substring-no-properties (point) (point-max)))
|
||||||
|
t))
|
||||||
|
(list :number number
|
||||||
|
:type (if (string-match-p (rx "/pull/" (+ digit) eos) url)
|
||||||
|
'pull-request 'issue)
|
||||||
|
:title title
|
||||||
|
:url url)
|
||||||
|
(magithub-error
|
||||||
|
"failed to parse issue"
|
||||||
|
"There was an error parsing issues."))))
|
||||||
|
|
||||||
|
(defun magithub-issue-list ()
|
||||||
|
"Return a list of issues for the current repository."
|
||||||
|
(magithub-cache :issues
|
||||||
|
'(with-temp-message "Retrieving issue list..."
|
||||||
|
(magithub-issue-list--internal))))
|
||||||
|
|
||||||
|
(defun magithub-issue-list--internal ()
|
||||||
|
(sort (mapcar #'magithub-issue--process-line
|
||||||
|
(magithub--command-output "issue"))
|
||||||
|
(lambda (a b) (< (plist-get a :number)
|
||||||
|
(plist-get b :number)))))
|
||||||
|
|
||||||
|
(defun magithub-issue--insert (issue)
|
||||||
|
"Insert an `issue' as a Magit section into the buffer."
|
||||||
|
(when issue
|
||||||
|
(magit-insert-section (magithub-issue issue)
|
||||||
|
(let ((formats (or magithub-issue-format
|
||||||
|
(list :number " %3d " :title " %s "))))
|
||||||
|
(while formats
|
||||||
|
(let ((key (car formats)) (fmt (cadr formats)))
|
||||||
|
(insert (format fmt (plist-get issue key))))
|
||||||
|
(setq formats (cddr formats))))
|
||||||
|
(insert ?\n))))
|
||||||
|
|
||||||
|
(defun magithub-issue-browse (issue)
|
||||||
|
"Visits `issue' in the browser.
|
||||||
|
Interactively, this finds the issue at point.
|
||||||
|
|
||||||
|
If `issue' is nil, open the repository's issues page."
|
||||||
|
(interactive (list (magit-section-value
|
||||||
|
(magit-current-section))))
|
||||||
|
(browse-url
|
||||||
|
(if (plist-member issue :url)
|
||||||
|
(plist-get issue :url)
|
||||||
|
(car (magithub--command-output "browse" '("--url-only" "--" "issues"))))))
|
||||||
|
|
||||||
|
(defun magithub-issue-refresh ()
|
||||||
|
(interactive)
|
||||||
|
(magithub-cache-clear :issues)
|
||||||
|
(when (derived-mode-p 'magit-status-mode)
|
||||||
|
(magit-refresh)))
|
||||||
|
|
||||||
|
(defvar magit-magithub-issue-section-map
|
||||||
|
(let ((map (make-sparse-keymap)))
|
||||||
|
(define-key map [remap magit-visit-thing] #'magithub-issue-browse)
|
||||||
|
(define-key map [remap magit-refresh] #'magithub-issue-refresh)
|
||||||
|
map)
|
||||||
|
"Keymap for `magithub-issue' sections.")
|
||||||
|
|
||||||
|
(defvar magit-magithub-issue-list-section-map
|
||||||
|
(let ((map (make-sparse-keymap)))
|
||||||
|
(define-key map [remap magit-visit-thing] #'magithub-issue-browse)
|
||||||
|
(define-key map [remap magit-refresh] #'magithub-issue-refresh)
|
||||||
|
map)
|
||||||
|
"Keymap for `magithub-issue-list' sections.")
|
||||||
|
|
||||||
|
(defun magithub-issue--insert-section ()
|
||||||
|
"Insert GitHub issues if appropriate."
|
||||||
|
(when (and (magithub-github-repository-p)
|
||||||
|
(executable-find magithub-hub-executable))
|
||||||
|
(let* ((issues (magithub-issue-list)))
|
||||||
|
(magit-insert-section (magithub-issue-list)
|
||||||
|
(magit-insert-heading "Issues and Pull Requests")
|
||||||
|
(if issues (mapc #'magithub-issue--insert issues)
|
||||||
|
(insert " No issues.\n"))))))
|
||||||
|
|
||||||
|
;;; Hook into the status buffer
|
||||||
|
(add-hook 'magit-status-sections-hook #'magithub-issue--insert-section t)
|
||||||
|
|
||||||
|
(provide 'magithub-issue)
|
||||||
|
;;; magithub-issue.el ends here
|
||||||
12
elpa/magithub-20160926.2044/magithub-pkg.el
Normal file
12
elpa/magithub-20160926.2044/magithub-pkg.el
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
(define-package "magithub" "20160926.2044" "Magit interfaces for GitHub"
|
||||||
|
'((emacs "24.3")
|
||||||
|
(magit "2.8.0")
|
||||||
|
(git-commit "20160821.1338")
|
||||||
|
(with-editor "20160828.1025")
|
||||||
|
(cl-lib "1.0")
|
||||||
|
(s "20160711.525"))
|
||||||
|
:url "https://github.com/vermiculus/magithub" :keywords
|
||||||
|
'("git" "tools" "vc"))
|
||||||
|
;; Local Variables:
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; End:
|
||||||
207
elpa/magithub-20160926.2044/magithub.el
Normal file
207
elpa/magithub-20160926.2044/magithub.el
Normal file
@ -0,0 +1,207 @@
|
|||||||
|
;;; magithub.el --- Magit interfaces for GitHub -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2016 Sean Allred
|
||||||
|
|
||||||
|
;; Author: Sean Allred <code@seanallred.com>
|
||||||
|
;; Keywords: git, tools, vc
|
||||||
|
;; Homepage: https://github.com/vermiculus/magithub
|
||||||
|
;; Package-Requires: ((emacs "24.3") (magit "2.8.0") (git-commit "20160821.1338") (with-editor "20160828.1025") (cl-lib "1.0") (s "20160711.525"))
|
||||||
|
;; Package-Version: 0.1
|
||||||
|
|
||||||
|
;; This program 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 3 of the License, or
|
||||||
|
;; (at your option) any later version.
|
||||||
|
|
||||||
|
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;; Magithub is an interface to GitHub using the `hub' utility [1].
|
||||||
|
;;
|
||||||
|
;; Integrated into Magit workflows, Magithub allows very easy, very
|
||||||
|
;; basic GitHub repository management. Supported actions include:
|
||||||
|
;;
|
||||||
|
;; - pushing brand-new local repositories up to GitHub
|
||||||
|
;; - creating forks of existing repositories
|
||||||
|
;; - submitting pull requests upstream
|
||||||
|
;; - viewing and creating issues
|
||||||
|
;;
|
||||||
|
;; Press `H' in the status buffer to get started -- happy hacking!
|
||||||
|
;;
|
||||||
|
;; [1]: https://hub.github.com
|
||||||
|
|
||||||
|
;; Requires hub 2.2.8
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'magit)
|
||||||
|
(require 'magit-process)
|
||||||
|
(require 'magit-popup)
|
||||||
|
(require 'git-commit)
|
||||||
|
(require 'with-editor)
|
||||||
|
(require 'cl-lib)
|
||||||
|
(require 's)
|
||||||
|
|
||||||
|
(require 'magithub-core)
|
||||||
|
(require 'magithub-issue)
|
||||||
|
(require 'magithub-cache)
|
||||||
|
(require 'magithub-ci)
|
||||||
|
|
||||||
|
(magit-define-popup magithub-dispatch-popup
|
||||||
|
"Popup console for dispatching other Magithub popups."
|
||||||
|
'magithub-commands
|
||||||
|
:man-page "hub"
|
||||||
|
:actions '("Actions"
|
||||||
|
(?H "Browse on GitHub" magithub-browse)
|
||||||
|
(?c "Create" magithub-create-popup)
|
||||||
|
(?f "Fork" magithub-fork-popup)
|
||||||
|
(?i "Issues" magithub-issues-popup)
|
||||||
|
(?p "Submit a pull request" magithub-pull-request-popup)
|
||||||
|
"Meta"
|
||||||
|
(?g "Refresh all GitHub data" magithub-refresh)
|
||||||
|
(?& "Request a feature or report a bug" magithub--meta-new-issue)
|
||||||
|
(?h "Ask for help on Gitter" magithub--meta-help)))
|
||||||
|
|
||||||
|
(magit-define-popup-action 'magit-dispatch-popup
|
||||||
|
?H "Magithub" #'magithub-dispatch-popup ?!)
|
||||||
|
(define-key magit-status-mode-map
|
||||||
|
"H" #'magithub-dispatch-popup)
|
||||||
|
|
||||||
|
(magit-define-popup magithub-create-popup
|
||||||
|
"Popup console for creating GitHub repositories."
|
||||||
|
'magithub-commands
|
||||||
|
:man-page "hub"
|
||||||
|
:switches '((?p "Mark as private" "-p"))
|
||||||
|
:actions '((?c "Create this repository" magithub-create))
|
||||||
|
:options '((?d "Description" "--description=")
|
||||||
|
(?h "Homepage" "--homepage=")))
|
||||||
|
|
||||||
|
(magit-define-popup magithub-fork-popup
|
||||||
|
"Popup console for forking GitHub repositories."
|
||||||
|
'magithub-commands
|
||||||
|
:man-page "hub"
|
||||||
|
:switches '((?r "Don't add my fork as a remote in this repository" "--no-remote"))
|
||||||
|
:actions '((?f "Fork the project at origin" magithub-fork)))
|
||||||
|
|
||||||
|
(magit-define-popup magithub-pull-request-popup
|
||||||
|
"Popup console for creating pull requests on GitHub repositories."
|
||||||
|
'magithub-commands
|
||||||
|
:man-page "hub"
|
||||||
|
:switches '((?f "Ignore unpushed commits" "-f")
|
||||||
|
(?o "Open in my browser" "-o"))
|
||||||
|
:options '((?b "Base branch" "--base=" magit-read-branch)
|
||||||
|
(?h "Head branch" "--head=" magit-read-branch))
|
||||||
|
:actions '((?P "Submit a pull request" magithub-pull-request))
|
||||||
|
:default-arguments '("-o"))
|
||||||
|
|
||||||
|
(defun magithub-browse ()
|
||||||
|
"Open the repository in your browser."
|
||||||
|
(interactive)
|
||||||
|
(unless (magithub-github-repository-p)
|
||||||
|
(user-error "Not a GitHub repository"))
|
||||||
|
(magithub--command-quick "browse"))
|
||||||
|
|
||||||
|
(defvar magithub-after-create-messages
|
||||||
|
'("Don't be shy!"
|
||||||
|
"Don't let your dreams be dreams!")
|
||||||
|
"One of these messages will be displayed after you create a
|
||||||
|
GitHub repository.")
|
||||||
|
|
||||||
|
(defun magithub-create ()
|
||||||
|
"Create the current repository on GitHub."
|
||||||
|
(interactive)
|
||||||
|
(message "Creating repository on GitHub...")
|
||||||
|
(magithub--command "create" (magithub-create-arguments))
|
||||||
|
(message "Creating repository on GitHub...done! %s"
|
||||||
|
(nth (random (length magithub-after-create-messages))
|
||||||
|
magithub-after-create-messages))
|
||||||
|
(magit-push-popup))
|
||||||
|
|
||||||
|
(defun magithub-fork ()
|
||||||
|
"Fork 'origin' on GitHub."
|
||||||
|
(interactive)
|
||||||
|
(unless (magithub-github-repository-p)
|
||||||
|
(user-error "Not a GitHub repository"))
|
||||||
|
(when (and (s-equals? "master" (magit-get-current-branch))
|
||||||
|
(y-or-n-p "Looks like master is checked out. Create a new branch? "))
|
||||||
|
(call-interactively #'magit-branch-spinoff))
|
||||||
|
(message "Forking repository on GitHub...")
|
||||||
|
(magithub--command "fork" (magithub-fork-arguments))
|
||||||
|
(message "Forking repository on GitHub...done"))
|
||||||
|
|
||||||
|
(defun magithub-pull-request ()
|
||||||
|
"Open a pull request to 'origin' on GitHub."
|
||||||
|
(interactive)
|
||||||
|
(unless (magithub-github-repository-p)
|
||||||
|
(user-error "Not a GitHub repository"))
|
||||||
|
(let (just-pushed)
|
||||||
|
(unless (magit-get-push-remote)
|
||||||
|
(when (y-or-n-p "No push remote defined; push now? ")
|
||||||
|
(call-interactively #'magit-push-current-to-pushremote)
|
||||||
|
(setq just-pushed t)))
|
||||||
|
(unless (magit-get-push-remote)
|
||||||
|
(user-error "No push remote defined; aborting pull request"))
|
||||||
|
(unless just-pushed
|
||||||
|
(when (y-or-n-p "Do you want to push any more commits? ")
|
||||||
|
(magit-push-popup)))
|
||||||
|
(magithub--command-with-editor "pull-request" (magithub-pull-request-arguments))))
|
||||||
|
|
||||||
|
(defface magithub-issue-warning-face
|
||||||
|
'((((class color)) :foreground "red"))
|
||||||
|
"Face used to call out warnings in the issue-create buffer."
|
||||||
|
:group 'magithub)
|
||||||
|
|
||||||
|
(defun magithub-setup-edit-buffer ()
|
||||||
|
"Perform setup on a hub edit buffer."
|
||||||
|
(with-editor-mode 1)
|
||||||
|
(git-commit-setup-font-lock)
|
||||||
|
(font-lock-add-keywords
|
||||||
|
nil `((,magithub-hash-regexp (0 'magit-hash t))) t)
|
||||||
|
(add-hook
|
||||||
|
(make-local-variable 'with-editor-pre-finish-hook)
|
||||||
|
(lambda ()
|
||||||
|
(let ((fill-column (point-max)))
|
||||||
|
(fill-region (point-min) (point-max))))))
|
||||||
|
|
||||||
|
(defun magithub-setup-new-issue-buffer ()
|
||||||
|
"Setup the buffer created for issue-posting."
|
||||||
|
(font-lock-add-keywords
|
||||||
|
nil '(("^# \\(Creating issue for .*\\)" (1 'magithub-issue-warning-face t))) t))
|
||||||
|
|
||||||
|
(defvar magithub--file-types
|
||||||
|
'(("ISSUE_EDITMSG" . issue)
|
||||||
|
("PULLREQ_EDITMSG" . pull-request))
|
||||||
|
"File types -- car is the basename of a file in /.git/, cdr is
|
||||||
|
one of `issue' or `pull-request'.")
|
||||||
|
|
||||||
|
(defun magithub--edit-file-type (path)
|
||||||
|
"Determine the type of buffer this is (if it was created by hub).
|
||||||
|
Returns `issue', `pull-request', or another non-nil value if
|
||||||
|
created by hub.
|
||||||
|
|
||||||
|
This function will return nil for matches to
|
||||||
|
`git-commit-filename-regexp'."
|
||||||
|
(let ((basename (file-name-base path)))
|
||||||
|
(and path
|
||||||
|
(s-suffix? "/.git/" (file-name-directory path))
|
||||||
|
(not (s-matches? git-commit-filename-regexp basename))
|
||||||
|
(cdr (assoc basename magithub--file-types)))))
|
||||||
|
|
||||||
|
(defun magithub-check-buffer ()
|
||||||
|
"If this is a buffer created by hub, perform setup."
|
||||||
|
(let ((type (magithub--edit-file-type buffer-file-name)))
|
||||||
|
(when type
|
||||||
|
(magithub-setup-edit-buffer)
|
||||||
|
(when (eq type 'issue)
|
||||||
|
(magithub-setup-new-issue-buffer)))))
|
||||||
|
(add-hook 'find-file-hook #'magithub-check-buffer)
|
||||||
|
|
||||||
|
(provide 'magithub)
|
||||||
|
;;; magithub.el ends here
|
||||||
Loading…
Reference in New Issue
Block a user