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
|