forge-post.el (9354B)
1 ;;; forge-post.el --- Post support -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2018-2022 Jonas Bernoulli 4 5 ;; Author: Jonas Bernoulli <jonas@bernoul.li> 6 ;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> 7 ;; SPDX-License-Identifier: GPL-3.0-or-later 8 9 ;; This file is not part of GNU Emacs. 10 11 ;; Forge is free software; you can redistribute it and/or modify it 12 ;; under the terms of the GNU General Public License as published by 13 ;; the Free Software Foundation; either version 3, or (at your option) 14 ;; any later version. 15 ;; 16 ;; Forge is distributed in the hope that it will be useful, but WITHOUT 17 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 18 ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public 19 ;; License for more details. 20 ;; 21 ;; You should have received a copy of the GNU General Public License 22 ;; along with Forge. If not, see http://www.gnu.org/licenses. 23 24 ;;; Code: 25 26 (require 'markdown-mode) 27 28 (require 'forge) 29 30 ;;; Options 31 32 (defcustom forge-post-mode-hook 33 '(visual-line-mode 34 turn-on-flyspell) 35 "Hook run after entering Forge-Post mode." 36 :package-version '(forge . "0.2.0") 37 :group 'forge 38 :type 'hook 39 :options '(visual-line-mode 40 turn-on-flyspell)) 41 42 ;;; Class 43 44 (defclass forge-post (forge-object) () :abstract t) 45 46 ;;; Query 47 48 (cl-defmethod forge-get-parent ((post forge-post)) 49 (forge-get-topic post)) 50 51 (cl-defmethod forge-get-repository ((post forge-post)) 52 (forge-get-repository (forge-get-topic post))) 53 54 ;;; Utilities 55 56 (cl-defmethod forge-get-url ((post forge-post)) 57 (forge--format post (let ((topic (forge-get-parent post))) 58 (cond ((forge--childp topic 'forge-issue) 59 'issue-post-url-format) 60 ((forge--childp topic 'forge-pullreq) 61 'pullreq-post-url-format))))) 62 63 (cl-defmethod forge-browse :after ((post forge-post)) 64 (oset (forge-get-topic post) unread-p nil)) 65 66 ;;; Sections 67 68 (defun forge-post-at-point () 69 (magit-section-value-if '(issue pullreq post))) 70 71 (defun forge-comment-at-point () 72 (and (magit-section-value-if '(post)) 73 (let ((post (oref (magit-current-section) value))) 74 (and (or (forge-pullreq-post-p post) 75 (forge-issue-post-p post)) 76 post)))) 77 78 (defun forge-topic-at-point () 79 (or (magit-section-value-if '(issue pullreq)) 80 (when-let ((branch (magit-branch-at-point))) 81 (when-let ((n (magit-get "branch" branch "pullRequest"))) 82 (forge-get-pullreq (string-to-number n)))) 83 (when-let ((rev (magit-commit-at-point))) 84 (forge--pullreq-from-rev rev)))) 85 86 (defun forge-current-topic () 87 (or (forge-topic-at-point) 88 (and (derived-mode-p 'forge-topic-mode) 89 forge-buffer-topic) 90 (and (derived-mode-p 'forge-topic-list-mode) 91 (forge-get-topic (tabulated-list-get-id))))) 92 93 (defun forge--pullreq-from-rev (rev) 94 (when-let ((repo (forge-get-repository nil)) 95 (refspec (oref repo pullreq-refspec)) 96 (name (magit-rev-name rev (cadr (split-string refspec ":"))))) 97 (save-match-data 98 (when (string-match "\\([0-9]*\\)\\([~^][0-9]*\\)?\\'" name) 99 (forge-get-pullreq (string-to-number (match-string 0 name))))))) 100 101 ;;; Utilities 102 103 (cl-defmethod forge--format ((post forge-post) slot &optional spec) 104 (forge--format (forge-get-topic post) slot 105 `(,@spec (?I . ,(oref post number))))) 106 107 ;;; Mode 108 109 (defvar forge-post-mode-map 110 (let ((map (make-sparse-keymap))) 111 (define-key map (kbd "C-c C-c") 'forge-post-submit) 112 (define-key map [remap evil-save-and-close] 'forge-post-submit) 113 (define-key map [remap evil-save-modified-and-close] 'forge-post-submit) 114 (define-key map (kbd "C-c C-k") 'forge-post-cancel) 115 (define-key map [remap kill-buffer] 'forge-post-cancel) 116 (define-key map [remap ido-kill-buffer] 'forge-post-cancel) 117 (define-key map [remap iswitchb-kill-buffer] 'forge-post-cancel) 118 (define-key map [remap evil-quit] 'forge-post-cancel) 119 map)) 120 121 (define-derived-mode forge-post-mode gfm-mode "Forge-Post" "") 122 123 (defvar-local forge--buffer-base-branch nil) 124 (defvar-local forge--buffer-head-branch nil) 125 (defvar-local forge--buffer-post-object nil) 126 (defvar-local forge--buffer-issue nil) 127 (defvar-local forge--submit-post-function nil) 128 (defvar-local forge--cancel-post-function nil) 129 (defvar-local forge--pre-post-buffer nil) 130 131 (defun forge--prepare-post-buffer (filename &optional header source target) 132 (let ((file (magit-git-dir 133 (convert-standard-filename 134 (concat "magit/posts/" filename))))) 135 (make-directory (file-name-directory file) t) 136 (let ((prevbuf (current-buffer)) 137 (resume (and (file-exists-p file) 138 (> (file-attribute-size (file-attributes file)) 0))) 139 (buf (find-file-noselect file))) 140 (with-current-buffer buf 141 (forge-post-mode) 142 (when header 143 (magit-set-header-line-format header)) 144 (setq forge--pre-post-buffer prevbuf) 145 (when resume 146 (forge--display-post-buffer buf) 147 (when (magit-read-char-case "A draft already exists. " nil 148 (?r "[r]esume editing existing draft") 149 (?d "[d]iscard draft and start over" t)) 150 (erase-buffer) 151 (setq resume nil))) 152 (when (and (not resume) (string-prefix-p "new" filename)) 153 (let-alist (forge--topic-template 154 (forge-get-repository t) 155 (if source 'forge-pullreq 'forge-issue)) 156 (cond 157 (.url 158 (browse-url .url) 159 (forge-post-cancel) 160 (setq buf nil) 161 (message "Using browser to visit %s instead of opening an issue" 162 .url)) 163 (.name 164 ;; A Github issue with yaml frontmatter. 165 (save-excursion (insert .text)) 166 (re-search-forward "^title: ")) 167 (t 168 (insert "# ") 169 (let ((single 170 (and source 171 (= (car (magit-rev-diff-count source target)) 1)))) 172 (save-excursion 173 (when single 174 ;; A pull-request. 175 (magit-rev-insert-format "%B" source)) 176 (when .text 177 (if single 178 (insert "-------\n") 179 (insert "\n")) 180 (insert "\n" .text))))))))) 181 buf))) 182 183 (defun forge--display-post-buffer (buf) 184 (magit-display-buffer buf #'display-buffer)) 185 186 (defun forge-post-cancel () 187 "Cancel the post that is being edited in the current buffer." 188 (interactive) 189 (save-buffer) 190 (if-let ((fn forge--cancel-post-function)) 191 (funcall fn forge--buffer-post-object) 192 (magit-mode-bury-buffer 'kill))) 193 194 (defun forge-post-submit () 195 "Submit the post that is being edited in the current buffer." 196 (interactive) 197 (save-buffer) 198 (if-let ((fn forge--submit-post-function)) 199 (funcall fn 200 (forge-get-repository forge--buffer-post-object) 201 forge--buffer-post-object) 202 (error "forge--submit-post-function is nil"))) 203 204 (defun forge--post-submit-callback () 205 (let* ((file buffer-file-name) 206 (editbuf (current-buffer)) 207 (prevbuf forge--pre-post-buffer) 208 (topic (ignore-errors (forge-get-topic forge--buffer-post-object))) 209 (repo (forge-get-repository topic))) 210 (lambda (value headers status req) 211 (run-hook-with-args 'forge-post-submit-callback-hook 212 value headers status req) 213 (delete-file file t) 214 (let ((dir (file-name-directory file))) 215 (unless (cddr (directory-files dir nil nil t)) 216 (delete-directory dir nil t))) 217 (when (buffer-live-p editbuf) 218 (with-current-buffer editbuf 219 (magit-mode-bury-buffer 'kill))) 220 (with-current-buffer 221 (if (buffer-live-p prevbuf) prevbuf (current-buffer)) 222 (if (and topic 223 (forge--childp repo 'forge-github-repository) 224 (or (and (fboundp 'forge-pullreq-p) 225 (forge-pullreq-p topic)) 226 (oref repo selective-p))) 227 (forge--pull-topic repo topic) 228 (forge-pull)))))) 229 230 (defun forge--post-submit-errorback () 231 (lambda (error &rest _) 232 (error "Failed to submit post: %S" error))) 233 234 ;;; Notes 235 236 (defclass forge-note (forge-post) ()) 237 238 (defvar forge-note-section-map 239 (let ((map (make-sparse-keymap))) 240 (define-key map [remap magit-edit-thing] 'forge-edit-topic-note) 241 map)) 242 243 (defun forge--save-note (_repo topic) 244 (let ((value (string-trim (buffer-substring-no-properties 245 (point-min) 246 (point-max))))) 247 (oset topic note (if (equal value "") nil value))) 248 (delete-file buffer-file-name t) 249 (let ((dir (file-name-directory buffer-file-name))) 250 (unless (cddr (directory-files dir nil nil t)) 251 (delete-directory dir))) 252 (let ((prevbuf forge--pre-post-buffer)) 253 (magit-mode-bury-buffer 'kill) 254 (when (buffer-live-p prevbuf) 255 (magit-refresh)))) 256 257 ;;; _ 258 (provide 'forge-post) 259 ;;; forge-post.el ends here