~ubuntu-branches/debian/experimental/magithub/experimental : revision 1

1

;;; magithub.el --- Magit interfaces for GitHub -*- lexical-binding: t; -*-

2

3

4

5

;; Author: Sean Allred <code@seanallred.com>

6

;; Keywords: git, tools, vc

7

;; Homepage: https://github.com/vermiculus/magithub

8

;; Package-Requires: ((emacs "25") (magit "2.8.0") (s "20170428.1026") (ghub+ "0.1.4"))

9

;; Package-Version: 0.1

10

11

;; This program is free software; you can redistribute it and/or modify

12

;; it under the terms of the GNU General Public License as published by

13

;; the Free Software Foundation, either version 3 of the License, or

14

;; (at your option) any later version.

15

16

;; This program is distributed in the hope that it will be useful,

17

;; but WITHOUT ANY WARRANTY; without even the implied warranty of

18

;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

19

;; GNU General Public License for more details.

20

21

;; You should have received a copy of the GNU General Public License

22

;; along with this program. If not, see <http://www.gnu.org/licenses/>.

23

24

;;; Commentary:

25

26

;; Magithub is an interface to GitHub.

27

;;

28

;; Integrated into Magit workflows, Magithub allows easy GitHub

29

;; repository management. Supported actions include:

30

;;

31

;; - pushing brand-new local repositories up to GitHub

32

;; - creating forks of existing repositories

33

;; - submitting pull requests upstream

34

;; - viewing and creating issues

35

;;

36

;; Press `H' in the status buffer to get started -- happy hacking!

37

;;

38

;; [1]: https://hub.github.com

39

40

;; Requires hub 2.2.8

41

42

;;; Code:

43

44

(require 'magit)

45

(require 'magit-process)

46

(require 'magit-popup)

47

(require 'cl-lib)

48

(require 's)

49

(require 'dash)

50

51

(require 'magithub-core)

52

(require 'magithub-issue)

53

(require 'magithub-cache)

54

(require 'magithub-ci)

55

(require 'magithub-proxy)

56

(require 'magithub-issue-status)

57

(require 'magithub-issue-post)

58

(require 'magithub-issue-tricks)

59

60

(magit-define-popup magithub-dispatch-popup

61

"Popup console for dispatching other Magithub popups."

62

'magithub-commands

63

:actions '("Actions"

64

(?H "Browse on GitHub" magithub-browse)

65

(?c "Create" magithub-create)

66

(?f "Fork" magithub-fork)

67

(?i "Issues" magithub-issue-new)

68

(?p "Submit a pull request" magithub-pull-request-new)

69

(?x "Use a proxy repository for issues/PRs" magithub-proxy-set)

70

(?O "Toggle online/offline" magithub-toggle-offline)

71

"Meta"

72

(?` "Toggle Magithub-Status integration" magithub-enabled-toggle)

73

(?g "Refresh all GitHub data" magithub-refresh)

74

(?& "Request a feature or report a bug" magithub--meta-new-issue)

75

(?h "Ask for help on Gitter" magithub--meta-help)))

76

77

(magit-define-popup-action 'magit-dispatch-popup

78

?H "Magithub" #'magithub-dispatch-popup ?!)

79

(define-key magit-status-mode-map

80

"H" #'magithub-dispatch-popup)

81

82

(defun magithub-browse ()

83

"Open the repository in your browser."

84

(interactive)

85

(unless (magithub-github-repository-p)

86

(user-error "Not a GitHub repository"))

87

(let-alist (magithub-source-repo)

88

(unless (stringp .html_url)

89

(user-error "No GitHub repository to visit"))

90

(browse-url .html_url)))

91

92

(defvar magithub-after-create-messages

93

'("Don't be shy!"

94

"Don't let your dreams be dreams!")

95

"One of these messages will be displayed after you create a

96

GitHub repository.")

97

98

(defvar magithub-preferred-remote-method 'ssh_url

99

"Preferred method when cloning or adding remotes.

100

One of the following:

101

102

`clone_url' (https://github.com/octocat/Hello-World.git)

103

`git_url' (git:github.com/octocat/Hello-World.git)

104

`ssh_url' (git@github.com:octocat/Hello-World.git)")

105

(defun magithub-create (repo)

106

"Create the current repository on GitHub."

107

(interactive (list (unless (or (magithub-github-repository-p) (not (magit-toplevel)))

108

`((name . ,(magithub--read-repo-name (ghub--username)))

109

(description . ,(read-string "Description (optional): "))))))

110

(when (magithub-github-repository-p)

111

(error "Already in a GitHub repository"))

112

(if (not (magit-toplevel))

113

(when (y-or-n-p "Not inside a Git repository; initialize one here? ")

114

(magit-init default-directory)

115

(call-interactively #'magithub-create))

116

(with-temp-message "Creating repository on GitHub..."

117

(setq repo (ghubp-post-user-repos repo)))

118

(magithub--random-message "Creating repository on GitHub...done!")

119

(magit-status-internal default-directory)

120

(magit-remote-add "origin" (alist-get magithub-preferred-remote-method repo))

121

(magit-refresh)

122

(when (magit-rev-verify "HEAD")

123

(magit-push-popup))))

124

125

(defun magithub--read-repo-name (for-user)

126

(let* ((prompt (format "Repository name: %s/" for-user))

127

(dirnam (file-name-nondirectory (substring default-directory 0 -1)))

128

(valid-regexp (rx bos (+ (any alnum "." "-" "_")) eos))

129

ret)

130

;; This is not very clever, but it gets the job done. I'd like to

131

;; either have instant feedback on what's valid or not allow users

132

;; to enter invalid names at all. Could code from Ivy be used?

133

(while (not (s-matches-p valid-regexp (setq ret (read-string prompt nil nil dirnam))))

134

(message "invalid name")

135

(sit-for 1))

136

ret))

137

138

(defun magithub--random-message (&optional prefix)

139

(let ((msg (nth (random (length magithub-after-create-messages))

140

magithub-after-create-messages)))

141

(if prefix (format "%s %s" prefix msg) msg)))

142

143

(defun magithub-fork ()

144

"Fork 'origin' on GitHub."

145

(interactive)

146

(unless (magithub-github-repository-p)

147

(user-error "Not a GitHub repository"))

148

(let* ((repo (magithub-source-repo))

149

(fork (with-temp-message "Forking repository on GitHub..."

150

(ghubp-post-repos-owner-repo-forks repo))))

151

(when (y-or-n-p "Create a spinoff branch? ")

152

(call-interactively #'magit-branch-spinoff))

153

(magithub--random-message

154

(let-alist repo (format "%s/%s forked!" .owner.login .name)))

155

(let-alist fork

156

(when (y-or-n-p (format "Add %s as a remote in this repository? " .owner.login))

157

(magit-remote-add .owner.login (alist-get magithub-preferred-remote-method fork))

158

(magit-set .owner.login "branch" (magit-get-current-branch) "pushRemote")))

159

(let-alist repo

160

(when (y-or-n-p (format "Set upstream to %s? " .owner.login))

161

(call-interactively #'magit-set-branch*merge/remote)))))

162

163

(defun magithub-clone--get-repo ()

164

"Prompt for a user and a repository.

165

Returns a sparse repository object."

166

(let ((user (ghub--username))

167

(repo-regexp (rx bos (group (+ (not (any " "))))

168

"/" (group (+ (not (any " ")))) eos))

169

repo)

170

(while (not (and repo (string-match repo-regexp repo)))

171

(setq repo (read-from-minibuffer

172

(concat

173

"Clone GitHub repository "

174

(if repo "(format is \"user/repo\"; C-g to quit)" "(user/repo)")

175

": ")

176

(when user (concat user "/")))))

177

`((owner (login . ,(match-string 1 repo)))

178

(name . ,(match-string 2 repo)))))

179

180

(defcustom magithub-clone-default-directory nil

181

"Default directory to clone to when using `magithub-clone'.

182

When nil, the current directory at invocation is used."

183

:type 'directory

184

:group 'magithub)

185

186

(defun magithub-clone (repo dir)

187

"Clone REPO.

188

Banned inside existing GitHub repositories if

189

`magithub-clone-default-directory' is nil."

190

(interactive (if (and (not magithub-clone-default-directory)

191

(magithub-github-repository-p))

192

(user-error "Already in a GitHub repo")

193

(let ((read-repo (magithub-clone--get-repo)))

194

(let-alist read-repo

195

(list read-repo (read-directory-name

196

"Destination: "

197

magithub-clone-default-directory

198

nil nil

199

.name))))))

200

(unless (file-writable-p dir)

201

(user-error "%s does not exist or is not writable" dir))

202

(when (y-or-n-p (let-alist repo (format "Clone %s/%s to %s? " .owner.login .name dir)))

203

(let ((repo (ghubp-get-repos-owner-repo repo)))

204

(magit-clone (thread-last repo

205

(ghubp-get-repos-owner-repo)

206

(alist-get magithub-preferred-remote-method))

207

dir))))

208

209

(defun magithub-clone--finished (user repo dir)

210

"After finishing the clone, allow the user to jump to their new repo."

211

(when (y-or-n-p (format "%s/%s has finished cloning to %s. Open? " user repo dir))

212

(magit-status-internal (s-chop-suffix "/" dir))))

213

214

(defun magithub-feature-autoinject (feature)

215

"Configure FEATURE to recommended settings.

216

If FEATURE is `all' ot t, all known features will be loaded."

217

(if (memq feature '(t all))

218

(mapc #'magithub-feature-autoinject magithub-feature-list)

219

(cl-case feature

220

221

(pull-request-merge

222

(magit-define-popup-action 'magit-am-popup

223

?P "Apply patches from pull request" #'magithub-pull-request-merge))

224

225

(pull-request-checkout

226

(magit-define-popup-action 'magit-branch-popup

227

?P "Checkout pull request" #'magithub-pull-request-checkout))

228

229

(t (user-error "unknown feature %S" feature)))

230

(add-to-list 'magithub-features (cons feature t))))

231

232

(defun magithub-visit-thing ()

233

(interactive)

234

(let-alist (magithub-thing-at-point 'all)

235

(cond (.label (magithub-label-browse .label))

236

(.issue (magithub-issue-browse .issue))

237

(.pull-request (magithub-pull-browse .pull-request))

238

(t (message "Nothing recognizable at point")))))

239

240

(provide 'magithub)

241

;;; magithub.el ends here