1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
|
;;; magithub-labels.el --- -*- lexical-binding: t; -*-
;; Copyright (C) 2017-2018 Sean Allred
;; Author: Sean Allred <code@seanallred.com>
;; 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 'thingatpt)
(require 'ghub+)
(require 'magithub-core)
(defvar magit-magithub-label-section-map
(let ((m (make-sparse-keymap)))
(set-keymap-parent m magithub-map)
(define-key m [remap magit-visit-thing] #'magithub-label-visit)
(define-key m [remap magit-delete-thing] #'magithub-label-remove)
(define-key m [remap magit-section-toggle] (lambda () (interactive)))
(define-key m [remap magithub-browse-thing] #'magithub-label-browse)
(define-key m [remap magithub-add-thing] #'magithub-label-add)
m)
"Keymap for label sections.")
(defun magithub-label-list ()
"Return a list of issue and pull-request labels."
(magithub-cache :label
`(magithub-request
(ghubp-unpaginate
(ghubp-get-repos-owner-repo-labels
',(magithub-repo))))
:message
"Loading labels..."))
(defun magithub-label-read-labels (prompt &optional default)
"Read some issue labels and return a list of strings.
Available issues are provided by `magithub-label-list'.
DEFAULT is a list of pre-selected labels. These labels are not
prompted for again."
(let ((remaining-labels
(cl-set-difference (magithub-label-list) default
:test (lambda (a b)
(= (alist-get 'name a)
(alist-get 'name b))))))
(magithub--completing-read-multiple
prompt remaining-labels
(lambda (l) (alist-get 'name l)))))
(defalias 'magithub-label-visit #'magithub-label-browse)
(defun magithub-label-browse (label)
"Visit LABEL with `browse-url'.
In the future, this will likely be replaced with a search on
issues and pull requests with the label LABEL."
(interactive (list (thing-at-point 'github-label)))
(unless label
(user-error "No label found at point to browse"))
(unless (string= (ghubp-host) ghub-default-host)
(user-error "Label browsing not yet supported on GitHub Enterprise; pull requests welcome!"))
(let-alist (magithub-repo)
(browse-url (format "%s/%s/%s/labels/%s"
(ghubp-base-html-url)
.owner.login .name (alist-get 'name label)))))
(defcustom magithub-label-color-replacement-alist nil
"Make certain label colors easier to see.
In your theme, you may find that certain colors are very
difficult to see. Customize this list to map GitHub's label
colors to their Emacs replacements."
:group 'magithub
:type '(alist :key-type color :value-type color))
(defun magithub-label--get-display-color (label)
"Gets the display color for LABEL.
Respects `magithub-label-color-replacement-alist'."
(let ((original (concat "#" (alist-get 'color label))))
(if-let ((color (assoc-string original magithub-label-color-replacement-alist t)))
(cdr color)
original)))
(defun magithub-label-propertize (label)
"Propertize LABEL according to its color.
The face used is dynamically calculated, but it always inherits
from `magithub-label'. Customize that to affect all labels."
(propertize (alist-get 'name label)
'face (list :foreground (magithub-label--get-display-color label)
:inherit 'magithub-label)))
(defun magithub-label-color-replace (label new-color)
"For LABEL, define a NEW-COLOR to use in the buffer."
(interactive
(list (thing-at-point 'github-label)
(magithub-core-color-completing-read "Replace label color: ")))
(let ((label-color (concat "#" (alist-get 'color label))))
(if-let ((cell (assoc-string label-color magithub-label-color-replacement-alist)))
(setcdr cell new-color)
(push (cons label-color new-color)
magithub-label-color-replacement-alist)))
(when (magithub-confirm-no-error 'label-save-customized-colors)
(customize-save-variable 'magithub-label-color-replacement-alist
magithub-label-color-replacement-alist
"Auto-saved by `magithub-label-color-replace'"))
(when (derived-mode-p 'magit-status-mode)
(magit-refresh)))
(defun magithub-label--verify-manage ()
(or (magithub-repo-push-p)
(user-error "You don't have permission to manage labels in this repository")))
(defun magithub-label-remove (issue label)
"From ISSUE, remove LABEL."
(interactive (and (magithub-label--verify-manage)
(list (thing-at-point 'github-issue)
(thing-at-point 'github-label))))
(unless issue
(user-error "No issue here"))
(unless label
(user-error "No label here"))
(let-alist label
(magithub-confirm 'remove-label .name)
(prog1 (magithub-request
(ghubp-delete-repos-owner-repo-issues-number-labels-name
(magithub-issue-repo issue) issue label))
(magithub-cache-without-cache :issues
(magit-refresh-buffer)))))
(defun magithub-label-add (issue labels)
"To ISSUE, add LABELS."
(interactive (list (thing-at-point 'github-issue)
(magithub-label-read-labels "Add labels: ")))
(if (not (and issue labels))
(user-error "No issue/labels")
(magithub-confirm 'add-label
(s-join "," (ghubp-get-in-all '(name) labels))
(magithub-repo-name (magithub-issue-repo issue))
(alist-get 'number issue))
(prog1 (magithub-request
(ghubp-post-repos-owner-repo-issues-number-labels
(magithub-issue-repo issue) issue labels))
(magithub-cache-without-cache :issues
(magit-refresh)))))
(defun magithub-label-insert (label)
"Insert LABEL into the buffer.
If you need to insert many labels, use
`magithub-label-insert-list'."
(magit-insert-section (magithub-label label)
(insert (magithub-label-propertize label))))
(defun magithub-label-insert-list (label-list)
"Insert LABEL-LIST intro the buffer."
(if (null label-list)
(magit-insert-section (magithub-label)
(insert (propertize "none" 'face 'magit-dimmed)))
(while label-list
(magithub-label-insert (pop label-list))
(when label-list
(insert " ")))))
(provide 'magithub-label)
;;; magithub-labels.el ends here
|
