my-emacs-d/elpa/magithub-20161013.2332/magithub-core.el
Gergely Polonkai 5feea2e7f0 Update magithub
2016-10-14 12:22:53 +02:00

240 lines
7.8 KiB
EmacsLisp

;;; 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)
(require 'dash)
(defun magithub-github-repository-p ()
"Non-nil if \"origin\" points to GitHub or a whitelisted domain."
(-when-let (origin (magit-get "remote" "origin" "url"))
(-some? (lambda (domain) (s-contains? domain origin))
(cons "github.com" (magit-get-all "hub" "host")))))
(defun magithub-repo-id ()
"Returns an identifying value for this repository."
(magit-get "remote" "origin" "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-hub-version ()
"Return the `hub' version as a string."
(-> "--version"
magithub--command-output cadr
split-string cddr car
(split-string "-") car))
(defun magithub-hub-version-at-least (version-string)
"Return t if `hub's version is at least VERSION-STRING."
(version<= version-string (magithub-hub-version)))
(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 ()
"Open Magithub help."
(interactive)
(browse-url "https://gitter.im/vermiculus/magithub"))
(defun magithub-enable ()
"Enable Magithub for this repository."
(interactive)
(magit-set "yes" "magithub" "enabled")
(when (derived-mode-p 'magit-status-mode)
(magit-refresh)))
(defun magithub-disable ()
"Disable Magithub for this repository."
(interactive)
(magit-set "no" "magithub" "enabled")
(when (derived-mode-p 'magit-status-mode)
(magit-refresh)))
(defun magithub-enabled-p ()
"Returns non-nil when Magithub is enabled for this repository."
(when (member (magit-get "magithub" "enabled") '("yes" nil)) t))
(defun magithub-enabled-toggle ()
"Toggle Magithub"
(interactive)
(if (magithub-enabled-p)
(magithub-disable)
(magithub-enable)))
(defun magithub-usable-p ()
"Non-nil if Magithub should do its thing."
(and (executable-find magithub-hub-executable)
(magithub-enabled-p)
(magithub-github-repository-p)
(magithub--api-available-p)))
(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))
(defmacro magithub--deftoggle (name hook func s)
"Define a section-toggle command."
(declare (indent defun))
`(defun ,name ()
,(concat "Toggle the " s " section.")
(interactive)
(if (memq ,func ,hook)
(remove-hook ',hook ,func)
(if (executable-find magithub-hub-executable)
(add-hook ',hook ,func t)
(message ,(concat "`hub' isn't installed, so I can't insert " s))))
(when (derived-mode-p 'magit-status-mode)
(magit-refresh))
(memq ,func ,hook)))
(defun magithub--zip-case (p e)
"Get an appropriate value for element E given property/function P."
(cond
((symbolp p) (plist-get e p))
((functionp p) (funcall p e))
((null p) e)
(t nil)))
(defun magithub--zip (object-list prop1 prop2)
"Process OBJECT-LIST into an alist defined by PROP1 and PROP2.
If a prop is a symbol, that property will be used.
If a prop is a function, it will be called with the
currentelement of OBJECT-LIST.
If a prop is nil, the entire element is used."
(delq nil
(-zip-with
(lambda (e1 e2)
(let ((p1 (magithub--zip-case prop1 e1))
(p2 (magithub--zip-case prop2 e2)))
(unless (or (and prop1 (not p1))
(and prop2 (not p2)))
(cons (if prop1 p1 e1)
(if prop2 p2 e2)))))
object-list object-list)))
(provide 'magithub-core)
;;; magithub-core.el ends here