File: magithub-comment.el

package info (click to toggle)
magithub 0.1.7-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 1,920 kB
  • sloc: lisp: 3,684; makefile: 82
file content (261 lines) | stat: -rw-r--r-- 10,354 bytes parent folder | download | duplicates (2)
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
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
;;; magithub-comment.el --- tools for comments   -*- lexical-binding: t; -*-

;; Copyright (C) 2017-2018  Sean Allred

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

;; 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:

;; Tools for working with issue comments.

;;; Code:

(require 'magit)
(require 'markdown-mode)
(require 'thingatpt)

(require 'magithub-core)
(require 'magithub-repo)
(require 'magithub-issue)
(require 'magithub-edit-mode)

(declare-function magithub-issue-view "magithub-issue-view.el" (issue))

(defvar magit-magithub-comment-section-map
  (let ((m (make-sparse-keymap)))
    (set-keymap-parent m magithub-map)
    (define-key m [remap magithub-browse-thing] #'magithub-comment-browse)
    (define-key m [remap magit-delete-thing] #'magithub-comment-delete)
    (define-key m (kbd "SPC") #'magithub-comment-view)
    (define-key m [remap magithub-reply-thing] #'magithub-comment-reply)
    (define-key m [remap magithub-edit-thing] #'magithub-comment-edit)
    m))

(defun magithub-comment-browse (comment)
  (interactive (list (thing-at-point 'github-comment)))
  (unless comment
    (user-error "No comment found"))
  (let-alist comment
    (browse-url .html_url)))

(declare-function face-remap-remove-relative "face-remap.el" (cookie))
(defun magithub-comment-delete (comment)
  (interactive (list (thing-at-point 'github-comment)))
  (unless comment
    (user-error "No comment found"))
  (let ((repo (magithub-comment-source-repo comment))
        (author (let-alist comment .user.login))
        (me (let-alist (magithub-user-me) .login)))
    (unless (or (string= author me)
                (magithub-repo-admin-p repo))
      (user-error "You don't have permission to delete this comment"))
    (let ((cookie (face-remap-add-relative 'magit-section-highlight
                                           ;;'magit-diff-removed-highlight
                                           ;;:strike-through t
                                           ;;:background "red4"
                                           ;;
                                           'magithub-deleted-thing
                                           )))
      (unwind-protect (magithub-confirm 'comment-delete)
        (face-remap-remove-relative cookie)))
    (magithub-request
     (ghubp-delete-repos-owner-repo-issues-comments-id repo comment))
    (magithub-cache-without-cache :issues
      (magit-refresh-buffer))
    (message "Comment deleted")))

(defun magithub-comment-source-issue (comment)
  (magithub-cache :comment
    `(magithub-request
      (ghubp-follow-get ,(alist-get 'issue_url comment)))))

(defun magithub-comment-source-repo (comment)
  (magithub-issue-repo (magithub-comment-source-issue comment)))

(defun magithub-comment-insert (comment)
  "Insert a single issue COMMENT."
  (let-alist comment
    (magit-insert-section (magithub-comment comment)
      (magit-insert-heading (propertize .user.login 'face 'magithub-user))
      (save-excursion
        (let ((created-at (magithub--format-time .created_at)))
          (backward-char 1)
          (insert (make-string (- (current-fill-column)
                                  (current-column)
                                  (length created-at))
                               ? ))
          (insert (propertize created-at 'face 'magit-dimmed))))
      (insert (magithub-fill-gfm (magithub-wash-gfm (s-trim .body)))
              "\n\n"))))

(defvar magithub-gfm-view-mode-map
  (let ((m (make-sparse-keymap)))
    (define-key m [remap kill-this-buffer] #'magithub-comment-view-close)
    m)
  "Keymap for `magithub-gfm-view-mode'.")

(declare-function gfm-view-mode "ext:markdown-mode.el")
(define-derived-mode magithub-gfm-view-mode gfm-view-mode "M:GFM-View"
  "Major mode for viewing GitHub markdown content.")

(defvar-local magithub-comment-view--parent-buffer nil
  "The 'parent' buffer of the current comment-view.
This variable is used to jump back to the issue that contained
the comment; see `magithub-comment-view' and
`magithub-comment-view-close'.")

(defun magithub-comment-view (comment)
  "View COMMENT in a new buffer."
  (interactive (list (thing-at-point 'github-comment)))
  (let ((prev (current-buffer)))
    (with-current-buffer (get-buffer-create "*comment*")
      (magithub-gfm-view-mode)
      (setq-local magithub-comment-view--parent-buffer prev)
      (let ((inhibit-read-only t))
        (erase-buffer)
        (insert (magithub-wash-gfm (alist-get 'body comment))))
      (goto-char 0)
      (magit-display-buffer (current-buffer)))))

(defun magithub-comment-view-close ()
  "Close the current buffer."
  (interactive)
  (let ((oldbuf magithub-comment-view--parent-buffer))
    (kill-this-buffer)
    (magit-display-buffer oldbuf)))

;;;###autoload
(defun magithub-comment-new (issue &optional discard-draft initial-content)
  "Comment on ISSUE in a new buffer.
If prefix argument DISCARD-DRAFT is specified, the draft will not
be considered.

If INITIAL-CONTENT is specified, it will be inserted as the
initial contents of the reply if there is no draft."
  (interactive (let ((issue (magithub-interactive-issue)))
                 (prog1 (list issue current-prefix-arg)
                   (unless (derived-mode-p 'magithub-issue-view-mode)
                     (magithub-issue-view issue)))))
  (let* ((issueref (magithub-issue-reference issue))
         (repo (magithub-issue-repo issue)))
    (with-current-buffer
        (magithub-edit-new (concat "reply to " issueref)
          :header (concat "replying to " issueref)
          :submit #'magithub-issue-comment-submit
          :content initial-content
          :prompt-discard-draft discard-draft
          :file (magithub-comment--draft-file issue repo))
      (setq-local magithub-issue issue)
      (setq-local magithub-repo repo)
      (magit-display-buffer (current-buffer)))))

(defun magithub-comment--draft-file (issue repo)
  "Get an appropriate draft file for ISSUE in REPO."
  (let-alist issue
    (expand-file-name (format "%s-comment" .number)
                      (magithub-repo-data-dir repo))))

(defun magithub-comment--submit-edit (comment repo new-body)
  (interactive (list (thing-at-point 'github-comment)
                     (thing-at-point 'github-repository)
                     (buffer-string)))
  (when (string= new-body "")
    (user-error "Can't post an empty comment; try deleting it instead"))
  (magithub-confirm 'comment-edit)
  (magithub-request
   (ghubp-patch-repos-owner-repo-issues-comments-id
       repo comment
       `((body . ,new-body)))))

(defun magithub-comment-edit (comment issue repo)
  "Edit COMMENT."
  (interactive (list (thing-at-point 'github-comment)
                     (or (thing-at-point 'github-issue)
                         (thing-at-point 'github-pull-request))
                     (thing-at-point 'github-repository)))
  (let ((updated (magithub-request (ghubp-follow-get (alist-get 'url comment)))))
    (with-current-buffer
        (magithub-edit-new (format "*%s: editing comment by %s (%s)*"
                                   (magithub-issue-reference issue)
                                   (let-alist comment .user.login)
                                   (alist-get 'id comment))
          :submit #'magithub-comment--submit-edit
          :content (alist-get 'body updated)
          :file (magithub-comment--draft-file issue repo))
      (setq-local magithub-issue issue)
      (setq-local magithub-repo repo)
      (setq-local magithub-comment updated)
      (magit-display-buffer (current-buffer)))

    (unless (string= (alist-get 'body comment)
                     (alist-get 'body updated))
      (message "Comment has changed since information was cached; \
updated content pulled in for edit"))))

(defun magithub-comment-reply (comment &optional discard-draft issue)
  "Reply to COMMENT on ISSUE.
If prefix argument DISCARD-DRAFT is provided, the current draft
will deleted.

If ISSUE is not provided, it will be determined from context or
from COMMENT."
  (interactive (list (thing-at-point 'github-comment)
                     current-prefix-arg
                     (thing-at-point 'github-issue)))
  (let-alist comment
    (magithub-comment-new
     (or issue (magithub-request (ghubp-follow-get .issue_url)))
     discard-draft
     (let ((reply-body (if (use-region-p)
                           (buffer-substring (region-beginning) (region-end))
                           .body)))
      (with-temp-buffer
        (insert (string-trim (magithub-wash-gfm reply-body)))
        (markdown-blockquote-region (point-min) (point-max))
        (goto-char (point-max))
        (insert "\n\n")
        (buffer-string))))))

(defun magithub-issue-comment-submit (issue comment &optional repo)
  "On ISSUE, submit a new COMMENT.

COMMENT is the text of the new comment.

REPO is an optional repo object; it will be deduced from ISSUE if
not provided."
  (interactive (list (thing-at-point 'github-issue)
                     (save-restriction
                       (widen)
                       (buffer-substring-no-properties (point-min) (point-max)))
                     (thing-at-point 'github-repository)))
  (unless issue
    (user-error "No issue provided"))
  (setq repo (or repo
                 (magithub-issue-repo issue)
                 (thing-at-point 'github-repository)))
  (unless repo
    (user-error "No repo detected"))
  ;; all required args provided
  (magithub-confirm 'comment (magithub-issue-reference issue))
  (magithub-request
   (ghubp-post-repos-owner-repo-issues-number-comments
       repo issue `((body . ,comment))))
  (magithub-edit-delete-draft)
  (message "Success"))

(provide 'magithub-comment)
;;; magithub-comment.el ends here