diff --git a/lisp/forge-commands.el b/lisp/forge-commands.el index 9362a472..301d31c7 100644 --- a/lisp/forge-commands.el +++ b/lisp/forge-commands.el @@ -420,6 +420,44 @@ point is currently on." (insert (replace-regexp-in-string "^" "> " quote) "\n\n"))) (forge--display-post-buffer buf))) +(defun forge-create-diff-post () + "Create a new diff post in the current `magit-diff' buffer." + (interactive) + (unless (derived-mode-p 'magit-diff-mode) + (user-error "This command is only available from magit-diff buffers")) + (let* ((file (magit-file-at-point)) + (line (forge--pullreq-diff-current-line)) + (topic forge-buffer-topic) + (version forge--pullreq-version) + (commit forge--pullreq-commit) + (header (format "New comment on %s, line %s - #%%i of %%p" + file line)) + (buf (forge--prepare-post-buffer + (forge--format topic "%i:new-comment") + (forge--format topic header)))) + (with-current-buffer buf + (setq forge--buffer-post-object topic) + (setq forge--buffer-post-args (list version commit file line)) + (setq forge--submit-post-function 'forge--submit-create-diff-post)) + (forge--display-post-buffer buf))) + +;;; Reply + +(defun forge-reply-post () + "Reply to the current post." + (interactive) + (let* ((post (or (forge-post-at-point) + (user-error "There is no current post"))) + (topic forge-buffer-topic) + (buf (forge--prepare-post-buffer + (forge--format post "%i:reply-comment") + (forge--format post "Reply comment on #%i of %p")))) + (with-current-buffer buf + (setq forge--buffer-post-object topic) + (setq forge--buffer-post-args (list post)) + (setq forge--submit-post-function 'forge--submit-reply-post)) + (forge--display-post-buffer buf))) + ;;; Edit (defun forge-edit-post () @@ -572,12 +610,12 @@ topic N and modify that instead." ;;; Delete -(defun forge-delete-comment (comment) - "Delete the comment at point." - (interactive (list (or (forge-comment-at-point) - (user-error "There is no comment at point")))) - (when (yes-or-no-p "Do you really want to delete the selected comment? ") - (forge--delete-comment (forge-get-repository t) comment))) +(defun forge-delete-post (post) + "Delete the post at point." + (interactive (list (or (forge-post-at-point) + (user-error "There is no post at point")))) + (when (yes-or-no-p "Do you really want to delete the selected post ? ") + (forge--delete-post (forge-get-repository t) post))) ;;; Branch diff --git a/lisp/forge-db.el b/lisp/forge-db.el index c29ed6e5..419e104c 100644 --- a/lisp/forge-db.el +++ b/lisp/forge-db.el @@ -46,7 +46,7 @@ (defclass forge-database (closql-database) ((object-class :initform forge-repository))) -(defconst forge--db-version 7) +(defconst forge--db-version 8) (defconst forge--sqlite-available-p (with-demoted-errors "Forge initialization: %S" (emacsql-sqlite-ensure-binary) @@ -207,7 +207,9 @@ updated body (edits :default eieio-unbound) - (reactions :default eieio-unbound)] + (reactions :default eieio-unbound) + thread-id + reply-to] (:foreign-key [issue] :references issue [id] :on-delete :cascade)) @@ -300,7 +302,8 @@ (reviews :default eieio-unbound) (timeline :default eieio-unbound) (marks :default eieio-unbound) - note] + note + (versions :default eieio-unbound)] (:foreign-key [repository] :references repository [id] :on-delete :cascade)) @@ -342,7 +345,28 @@ updated body (edits :default eieio-unbound) - (reactions :default eieio-unbound)] + (reactions :default eieio-unbound) + thread-id + diff-p + resolved-by + reply-to + head-ref + commit-ref + base-ref + path + old-line + new-line] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade)) + + (pullreq-version + [(class :not-null) + (id :not-null :primary-key) + pullreq + number + head-ref + base-ref] (:foreign-key [pullreq] :references pullreq [id] :on-delete :cascade)) @@ -429,6 +453,19 @@ ;; Going forward create a backup before upgrading: ;; (message "Upgrading Forge database from version 7 to 8...") ;; (copy-file forge-database-file (concat forge-database-file "-v7")) + (when (= version 7) + (message "Upgrading Forge database from version 7 to 8...") + (copy-file forge-database-file (concat forge-database-file "-v7")) + (pcase-let ((`(,table . ,schema) (assq 'pullreq-version forge--db-table-schemata))) + (emacsql db [:create-table $i1 $S2] table schema)) + (emacsql db [:alter-table pullreq :add-column versions :default $i1] eieio-unbound) + (dolist (c (list 'thread-id 'reply-to)) + (emacsql db `[:alter-table issue-post :add-column ,c :default nil])) + (dolist (c (list 'thread-id 'diff-p 'resolved-by 'reply-to 'head-ref 'commit-ref + 'base-ref 'path 'old-line 'new-line)) + (emacsql db `[:alter-table pullreq-post :add-column ,c :default nil])) + (closql--db-set-version db (setq version 8)) + (message "Upgrading Forge database from version 7 to 8...done")) version)) ;;; _ diff --git a/lisp/forge-github.el b/lisp/forge-github.el index d274aa89..6ed93697 100644 --- a/lisp/forge-github.el +++ b/lisp/forge-github.el @@ -26,6 +26,12 @@ (require 'forge-issue) (require 'forge-pullreq) +;;; Variables + +(defvar forge-github-headers + '(("Accept" . "application/vnd.github.comfort-fade-preview+json")) + "Custom Github Headers.") + ;;; Class (defclass forge-github-repository (forge-repository) @@ -77,6 +83,7 @@ `((issues-until . ,(forge--topics-until repo until 'issue)) (pullRequests-until . ,(forge--topics-until repo until 'pullreq))) :host (oref repo apihost) + :headers forge-github-headers :auth 'forge))) (cl-defmethod forge--pull-topic ((repo forge-github-repository) n @@ -90,11 +97,17 @@ (oref repo name) n (lambda (data) - (funcall (if pullreqp #'forge--update-pullreq #'forge--update-issue) - repo data nil) - (with-current-buffer - (if (buffer-live-p buffer) buffer (current-buffer)) - (magit-refresh))) + (let ((refresh-buffer + (lambda () + (with-current-buffer + (if (buffer-live-p buffer) buffer (current-buffer)) + (magit-refresh))))) + (if pullreqp + (progn + (forge--update-pullreq repo data nil) + (forge--ghub-fetch-review-threads repo n refresh-buffer)) + (forge--update-issue repo data nil) + (funcall refresh-buffer)))) nil :errorback (and (not pullreqp) @@ -102,6 +115,7 @@ (when (equal (cdr (assq 'type (cadr err))) "NOT_FOUND") (forge--pull-topic repo n t)))) :host (oref repo apihost) + :headers forge-github-headers :auth 'forge))) (cl-defmethod forge--update-repository ((repo forge-github-repository) data) @@ -165,7 +179,8 @@ :author .author.login :created .createdAt :updated .updatedAt - :body (forge--sanitize-string .body)) + :body (forge--sanitize-string .body) + :reply-to nil) ; cannot reply on these comments with github api t))) (when bump (forge--set-id-slot repo issue 'assignees .assignees) @@ -175,7 +190,8 @@ (cl-defmethod forge--update-pullreqs ((repo forge-github-repository) data bump) (emacsql-with-transaction (forge-db) - (mapc (lambda (e) (forge--update-pullreq repo e bump)) data))) + (mapc (lambda (e) (forge--update-pullreq repo e bump)) data)) + (forge--ghub-fetch-all-review-threads repo)) (cl-defmethod forge--update-pullreq ((repo forge-github-repository) data bump) (emacsql-with-transaction (forge-db) @@ -186,7 +202,9 @@ (forge-db) (forge-pullreq :id pullreq-id :repository (oref repo id) - :number .number))))) + :number .number)))) + (head-ref .headRefOid) + (base-ref .baseRefOid)) (oset pullreq state (pcase-exhaustive .state ("MERGED" 'merged) ("CLOSED" 'closed) @@ -213,19 +231,31 @@ .milestone.id))) (oset pullreq body (forge--sanitize-string .body)) .databaseId ; Silence Emacs 25 byte-compiler. - (dolist (p .comments) - (let-alist p + ;; Github API doesn't support pullreq versioning + ;; Thus only add the latest version of the pullreq + (let* ((version-id (forge--object-id pullreq-id 1)) + (version (forge-pullreq-version :id version-id + :pullreq pullreq-id + :number 1 + :head-ref head-ref + :base-ref base-ref))) + (closql-insert (forge-db) version t)) + ;; add posts + (dolist (c .comments) + (let-alist c (closql-insert (forge-db) (forge-pullreq-post - :id (forge--object-id pullreq-id .databaseId) - :pullreq pullreq-id - :number .databaseId - :author .author.login - :created .createdAt - :updated .updatedAt - :body (forge--sanitize-string .body)) - t))) + :id (forge--object-id pullreq-id .databaseId) + :pullreq pullreq-id + :number .databaseId + :author .author.login + :created .createdAt + :updated .updatedAt + :body (forge--sanitize-string .body) + :diff-p nil + :reply-to nil) ;; cannot reply on these comments with github api + t))) (when bump (forge--set-id-slot repo pullreq 'assignees .assignees) (forge--set-id-slot repo pullreq 'review-requests @@ -473,6 +503,65 @@ (forge--pull repo nil cb)))) (funcall cb))) +(cl-defmethod forge--ghub-update-review-threads ((repo forge-github-repository) data) + (emacsql-with-transaction (forge-db) + (let-alist data + (let* ((pullreq-id (forge--object-id 'forge-pullreq repo .number)) + (pullreq (forge-get-pullreq repo .number)) + (head-ref .headRefOid) + (base-ref .baseRefOid)) + ;; add diff posts + (dolist (thread .reviewThreads) + (let-alist thread + (let ((new-line .line) + (old-line .originalLine) + (new (string= .diffSide "RIGHT"))) + (dolist (c .comments) + (let-alist c + (closql-insert + (forge-db) + (forge-pullreq-post + :id (forge--object-id pullreq-id .databaseId) + :pullreq pullreq-id + :number .databaseId + :author .author.login + :created .createdAt + :updated .updatedAt + :body (forge--sanitize-string .body) + :diff-p t + :reply-to (when .replyTo .replyTo.databaseId) + :head-ref head-ref + :commit-ref (when .originalCommit .originalCommit.oid) + :base-ref base-ref + :path .path + :old-line (unless new old-line) + :new-line (when new (if old-line old-line new-line))) + t)))))) + pullreq)))) + +(cl-defmethod forge--ghub-fetch-review-threads ((repo forge-github-repository) number + &optional callback) + (ghub-fetch-review-threads (oref repo owner) + (oref repo name) + number + (lambda (data) + (forge--ghub-update-review-threads repo data) + (when callback (funcall callback))) + nil + :host (oref repo apihost) + :headers forge-github-headers + :auth 'forge)) + +(cl-defmethod forge--ghub-fetch-all-review-threads ((repo forge-github-repository)) + (when-let* ((pullreqs (oref repo pullreqs)) + (pullreq (pop pullreqs)) + (cb (lambda (pullreqs cb) + (when-let ((pullreq (pop pullreqs))) + (forge--ghub-fetch-review-threads repo (oref pullreq number) + (lambda () (funcall cb pullreqs cb))))))) + (forge--ghub-fetch-review-threads repo (oref pullreq number) + (lambda () (funcall cb pullreqs cb))))) + ;;; Mutations (cl-defmethod forge--create-pullreq-from-issue ((repo forge-github-repository) @@ -536,12 +625,42 @@ :callback (forge--post-submit-callback) :errorback (forge--post-submit-errorback))) +(cl-defmethod forge--submit-create-diff-post ((_ forge-github-repository) topic + &rest args) + (pcase-let ((`(,version ,commit ,file ,line) args)) + (let* ((commit_id (if commit commit (oref version head-ref))) + (old-line (assoc-default 'old line)) + (new-line (assoc-default 'new line)) + (side (if new-line "RIGHT" "LEFT"))) + (forge--ghub-post topic "/repos/:owner/:repo/pulls/:number/comments" + `((body . ,(string-trim (buffer-string))) + (commit_id . ,commit_id) + (path . ,file) + (line . ,(if new-line new-line old-line)) + (side . ,side)) + :headers forge-github-headers + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))))) + +(cl-defmethod forge--submit-reply-post ((_ forge-github-repository) topic + &rest args) + (let* ((reply-to (oref (car args) reply-to)) + (id (if reply-to reply-to (oref (car args) number)))) + (forge--ghub-post + topic + (format "/repos/:owner/:repo/pulls/:number/comments/%d/replies" id) + `((body . ,(string-trim (buffer-string)))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback)))) + (cl-defmethod forge--submit-edit-post ((_ forge-github-repository) post) (forge--ghub-patch post - (cl-typecase post - (forge-pullreq "/repos/:owner/:repo/pulls/:number") - (forge-issue "/repos/:owner/:repo/issues/:number") - (forge-post "/repos/:owner/:repo/issues/comments/:number")) + (if (and (forge-pullreq-post-p post) (oref post diff-p)) + "/repos/:owner/:repo/pulls/comments/:number" + (cl-typecase post + (forge-pullreq "/repos/:owner/:repo/pulls/:number") + (forge-issue "/repos/:owner/:repo/issues/:number") + (forge-post "/repos/:owner/:repo/issues/comments/:number"))) (if (cl-typep post 'forge-topic) (let-alist (forge--topic-parse-buffer) `((title . , .title) @@ -585,9 +704,12 @@ :payload labels :callback (forge--set-field-callback))) -(cl-defmethod forge--delete-comment +(cl-defmethod forge--delete-post ((_repo forge-github-repository) post) - (forge--ghub-delete post "/repos/:owner/:repo/issues/comments/:number") + (forge--ghub-delete post + (if (and (forge-pullreq-post-p post) (oref post diff-p)) + "/repos/:owner/:repo/pulls/comments/:number" + "/repos/:owner/:repo/issues/comments/:number")) (closql-delete post) (magit-refresh)) diff --git a/lisp/forge-gitlab.el b/lisp/forge-gitlab.el index c086f134..74aefb9f 100644 --- a/lisp/forge-gitlab.el +++ b/lisp/forge-gitlab.el @@ -84,6 +84,21 @@ (forge--git-fetch buf dir repo)))))))) (funcall cb cb))) +(cl-defmethod forge--pull-topic ((repo forge-gitlab-repository) n) + (let ((orig-buffer (current-buffer))) + (cl-macrolet ((cb (func orig-buffer) + `(lambda (repo data) + (funcall ,func repo data) + (when (buffer-live-p ,orig-buffer) + (with-current-buffer ,orig-buffer + (magit-refresh)))))) + (if (forge-issue-p forge-buffer-topic) + ;; FIXME forge--fetch-issue does not exist. + (forge--fetch-issue repo (forge-get-issue n) + (cb #'forge--update-issue orig-buffer)) + (forge--fetch-pullreq repo (forge-get-pullreq repo n) + (cb #'forge--update-pullreq orig-buffer)))))) + (cl-defmethod forge--fetch-repository ((repo forge-gitlab-repository) callback) (forge--glab-get repo "/projects/:project" nil :callback (lambda (value _headers _status _req) @@ -149,7 +164,7 @@ (cl-defmethod forge--fetch-issue-posts ((repo forge-gitlab-repository) cur cb) (let-alist (car cur) (forge--glab-get repo - (format "/projects/%s/issues/%s/notes" .project_id .iid) + (format "/projects/%s/issues/%s/discussions" .project_id .iid) '((per_page . 100)) :unpaginate t :callback (lambda (value _headers _status _req) @@ -184,18 +199,25 @@ (forge--set-id-slot repo issue 'assignees .assignees) (forge--set-id-slot repo issue 'labels .labels)) .body .id ; Silence Emacs 25 byte-compiler. - (dolist (c .notes) - (let-alist c - (let ((post - (forge-issue-post - :id (forge--object-id issue-id .id) - :issue issue-id - :number .id - :author .author.username - :created .created_at - :updated .updated_at - :body (forge--sanitize-string .body)))) - (closql-insert (forge-db) post t)))))))) + (dolist (d .posts) + (let* ((notes (cdr (assq 'notes d))) + (reply-to (cdr (assq 'id (car notes)))) + (thread-id (cdr (assq 'id d)))) + (dolist (c notes) + (let-alist c + (let ((post + (forge-issue-post + :id (forge--object-id issue-id .id) + :issue issue-id + :number .id + :author .author.username + :created .created_at + :updated .updated_at + :body (forge--sanitize-string .body) + :thread-id thread-id + :reply-to (and (not (zerop (cl-position c notes))) + reply-to)))) + (closql-insert (forge-db) post t)))))))))) ;;;; Pullreqs @@ -216,6 +238,10 @@ (forge--fetch-pullreq-source-repo repo cur cb)) ((not (assq 'target_project (car cur))) (forge--fetch-pullreq-target-repo repo cur cb)) + ((not (assq 'posts (car cur))) + (forge--fetch-pullreq-posts repo cur cb)) + ((not (assq 'versions (car cur))) + (forge--fetch-pullreq-versions repo cur cb)) (t (if (setq cur (cdr cur)) (progn @@ -233,15 +259,51 @@ :callback (lambda (value _headers _status _req) (funcall cb cb value))))) +(cl-defmethod forge--fetch-pullreq ((repo forge-gitlab-repository) pullreq callback) + (let ((cb (let (cur done) + (lambda (cb &optional v) + (unless cur + (setq cur (list v))) + (if done + (funcall callback repo (car cur)) + (cond + ((not (assq 'source_project (car cur))) + (forge--fetch-pullreq-source-repo repo cur cb)) + ((not (assq 'target_project (car cur))) + (forge--fetch-pullreq-target-repo repo cur cb)) + ((not (assq 'posts (car cur))) + (forge--fetch-pullreq-posts repo cur cb)) + ((not (assq 'versions (car cur))) + (forge--fetch-pullreq-versions repo cur cb)) + (t (setq done t) + (funcall cb cb cur)))))))) + (forge--glab-get repo (format "/projects/:project/merge_requests/%d" + (oref pullreq number)) + `((per_page . 100)) + :unpaginate t + :callback (lambda (value _headers _status _req) + (funcall cb cb value))))) + (cl-defmethod forge--fetch-pullreq-posts ((repo forge-gitlab-repository) cur cb) (let-alist (car cur) (forge--glab-get repo - (format "/projects/%s/merge_requests/%s/notes" .target_project_id .iid) + (format "/projects/%s/merge_requests/%s/discussions" .target_project_id .iid) '((per_page . 100)) :unpaginate t :callback (lambda (value _headers _status _req) - (setf (alist-get 'notes (car cur)) value) + (setf (alist-get 'posts (car cur)) value) + (funcall cb cb))))) + +(cl-defmethod forge--fetch-pullreq-versions + ((repo forge-gitlab-repository) cur cb) + (let-alist (car cur) + (forge--glab-get repo + (format "/projects/%s/merge_requests/%s/versions" .target_project_id .iid) + '((per_page . 100)) + :unpaginate t + :callback (lambda (value _headers _status _req) + (setf (alist-get 'versions (car cur)) value) (funcall cb cb))))) (cl-defmethod forge--fetch-pullreq-source-repo @@ -313,18 +375,42 @@ (forge--set-id-slot repo pullreq 'assignees (list .assignee)) (forge--set-id-slot repo pullreq 'labels .labels)) .body .id ; Silence Emacs 25 byte-compiler. - (dolist (c .notes) - (let-alist c - (let ((post - (forge-pullreq-post - :id (forge--object-id pullreq-id .id) - :pullreq pullreq-id - :number .id - :author .author.username - :created .created_at - :updated .updated_at - :body (forge--sanitize-string .body)))) - (closql-insert (forge-db) post t)))))))) + (dolist (v .versions) + (let-alist v + (let* ((version-id (forge--object-id pullreq-id .id)) + (version (forge-pullreq-version + :id version-id + :pullreq pullreq-id + :number .id + :head-ref .head_commit_sha + :base-ref .base_commit_sha))) + (closql-insert (forge-db) version t)))) + (dolist (d .posts) + (let* ((notes (cdr (assq 'notes d))) + (reply-to (cdr (assq 'id (car notes)))) + (thread-id (cdr (assq 'id d)))) + (dolist (c notes) + (let-alist c + (let ((post + (forge-pullreq-post + :id (forge--object-id pullreq-id .id) + :pullreq pullreq-id + :number .id + :author .author.username + :created .created_at + :updated .updated_at + :body (forge--sanitize-string .body) + :thread-id thread-id + :diff-p (string= "DiffNote" .type) + :reply-to (and (not (zerop (cl-position c notes))) + reply-to) + :head-ref (and .position .position.head_sha) + :commit-ref (and .position .position.start_sha) + :base-ref (and .position .position.base_sha) + :path (and .position .position.new_path) + :old-line (and .position .position.old_line) + :new-line (and .position .position.new_line)))) + (closql-insert (forge-db) post t)))))))))) ;;;; Other @@ -453,6 +539,36 @@ :callback (forge--post-submit-callback) :errorback (forge--post-submit-errorback))) +(cl-defmethod forge--submit-create-diff-post ((_ forge-gitlab-repository) topic + &rest args) + (pcase-let ((`(,version ,commit ,file ,line) args)) + (with-slots (head-ref base-ref) version + (forge--glab-post topic "/projects/:project/merge_requests/:number/discussions" + `((body . ,(string-trim (buffer-string))) + (position (base_sha . ,(oref version base-ref)) + (start_sha . ,(if commit commit base-ref)) + (head_sha . ,(oref version head-ref)) + (position_type . "text") + (old_line . ,(assoc-default 'old line)) + (new_line . ,(assoc-default 'new line)) + (old_path . ,file) + (new_path . ,file))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))))) + +(cl-defmethod forge--submit-reply-post ((_ forge-gitlab-repository) topic + &rest args) + (when-let ((thread-id (oref (car args) thread-id))) + (forge--glab-post topic + (cl-etypecase topic + (forge-pullreq (concat "/projects/:project/merge_requests/:number/discussions/" + thread-id "/notes")) + (forge-issue (concat "/projects/:project/issues/:number/discussions/" + thread-id "/notes"))) + `((body . ,(string-trim (buffer-string)))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback)))) + (cl-defmethod forge--submit-edit-post ((_ forge-gitlab-repository) post) (forge--glab-put post (cl-etypecase post @@ -510,7 +626,7 @@ (forge--set-topic-field repo topic 'assignee_ids (--map (caddr (assoc it users)) assignees)))))) -(cl-defmethod forge--delete-comment +(cl-defmethod forge--delete-post ((_repo forge-gitlab-repository) post) (forge--glab-delete post (cl-etypecase post diff --git a/lisp/forge-issue.el b/lisp/forge-issue.el index a432c44b..bf0f3414 100644 --- a/lisp/forge-issue.el +++ b/lisp/forge-issue.el @@ -72,6 +72,8 @@ (body :initarg :body) (edits) (reactions) + (thread-id :initarg :thread-id) + (reply-to :initarg :reply-to) )) ;;; Query diff --git a/lisp/forge-post.el b/lisp/forge-post.el index 0441e699..8c6e8697 100644 --- a/lisp/forge-post.el +++ b/lisp/forge-post.el @@ -65,13 +65,6 @@ (defun forge-post-at-point () (magit-section-value-if '(issue pullreq post))) -(defun forge-comment-at-point () - (and (magit-section-value-if '(post)) - (let ((post (oref (magit-current-section) value))) - (and (or (forge-pullreq-post-p post) - (forge-issue-post-p post)) - post)))) - (defun forge-topic-at-point () (or (magit-section-value-if '(issue pullreq)) (when-let ((branch (magit-branch-at-point))) @@ -120,6 +113,7 @@ (defvar-local forge--buffer-base-branch nil) (defvar-local forge--buffer-head-branch nil) (defvar-local forge--buffer-post-object nil) +(defvar-local forge--buffer-post-args nil) (defvar-local forge--buffer-issue nil) (defvar-local forge--submit-post-function nil) (defvar-local forge--cancel-post-function nil) @@ -185,9 +179,8 @@ (interactive) (save-buffer) (if-let ((fn forge--submit-post-function)) - (funcall fn - (forge-get-repository forge--buffer-post-object) - forge--buffer-post-object) + (apply fn (forge-get-repository forge--buffer-post-object) + forge--buffer-post-object forge--buffer-post-args) (error "forge--submit-post-function is nil"))) (defun forge--post-submit-callback () @@ -208,11 +201,7 @@ (magit-mode-bury-buffer 'kill))) (with-current-buffer (if (buffer-live-p prevbuf) prevbuf (current-buffer)) - (if (and topic - (forge--childp repo 'forge-github-repository) - (or (and (fboundp 'forge-pullreq-p) - (forge-pullreq-p topic)) - (oref repo selective-p))) + (if topic (forge--pull-topic repo (oref topic number)) (forge-pull)))))) diff --git a/lisp/forge-pullreq.el b/lisp/forge-pullreq.el index 3e21c471..bbbf93e1 100644 --- a/lisp/forge-pullreq.el +++ b/lisp/forge-pullreq.el @@ -24,6 +24,31 @@ (require 'forge-post) (require 'forge-topic) +;;; Faces + +(defface forge-pullreq-diff-post-heading + `((((class color) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "LightSalmon3") + (((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "salmon4")) + "Face used for diff post heading." + :group 'magit-faces) + +(defface forge-pullreq-diff-post-reply-heading + `((((class color) (background light)) + :background "LightSkyBlue1") + (((class color) (background dark)) + :background "SkyBlue4")) + "Face used for diff reply post heading." + :group 'magit-faces) + +(defface forge-pullreq-diff-delimitation + '((t :underline "salmon4" :extend t)) + "Face used for diff delimitation." + :group 'magit-faces) + ;;; Classes (defclass forge-pullreq (forge-topic) @@ -66,6 +91,7 @@ (timeline) (marks :closql-table (pullreq-mark mark)) (note :initarg :note :initform nil) + (versions :closql-class forge-pullreq-version) ;; We don't use these fields: ;; includesCreatedEdit (huh?), ;; lastEditedAt (same as updatedAt?), @@ -93,6 +119,16 @@ (body :initarg :body) (edits) (reactions) + (thread-id :initarg :thread-id) + (diff-p :initarg :diff-p) + (resolved-by :initarg :resolved-by) + (reply-to :initarg :reply-to) + (head-ref :initarg :head-ref) + (commit-ref :initarg :commit-ref) + (base-ref :initarg :base-ref) + (path :initarg :path) + (old-line :initarg :old-line) + (new-line :initarg :new-line) ;; We don't use these fields: ;; includesCreatedEdit (huh?), ;; lastEditedAt (same as updatedAt?), @@ -103,6 +139,18 @@ ;; editor, id, reactionGroups, resourcePath, url, viewer{*} )) +(defclass forge-pullreq-version (forge-object) + ((closql-table :initform pullreq-version) + (closql-primary-key :initform id) + (closql-order-by :initform [(desc id)]) + (closql-foreign-key :initform pullreq) + (closql-class-prefix :initform "forge-pullreq-") + (id :initarg :id) + (pullreq :initarg :pullreq) + (number :initarg :number) + (head-ref :initarg :head-ref) + (base-ref :initarg :base-ref))) + ;;; Query (cl-defmethod forge-get-repository ((post forge-pullreq-post)) @@ -252,6 +300,16 @@ yourself, in which case you probably should not reset either. (define-key map [remap magit-visit-thing] 'forge-visit-pullreq) map)) +(defvar forge-pullreq-diff-section-map + (let ((map (make-sparse-keymap))) + (define-key map [remap magit-browse-thing] 'forge-browse-pullreq) + (define-key map [remap magit-visit-thing] 'forge-show-pullreq-diff) + map)) + +(defvar-local forge--pullreq-version nil) +(defvar-local forge--pullreq-commit nil) +(defvar-local forge--pullreq-buffer nil) + (defun forge-insert-pullreqs () "Insert a list of mostly recent and/or open pull-requests. Also see option `forge-topic-list-limit'." @@ -269,6 +327,184 @@ Also see option `forge-topic-list-limit'." (magit-insert-log range magit-buffer-log-args) (magit-make-margin-overlay nil t))))) +(defun forge--filter-diff-posts-by-commit (posts commit) + (cl-remove-if-not (lambda (post) + (with-slots (diff-p commit-ref) post + (and diff-p (string= commit-ref commit)))) + posts)) + +(defun forge--filter-diff-posts-by-version (posts version) + (let ((head (oref version head-ref)) + (base (oref version base-ref))) + (cl-remove-if-not (lambda (post) + (with-slots (diff-p head-ref base-ref) post + (and diff-p + (string= head-ref head) + (string= base-ref base)))) + posts))) + +;;; Diff + +(defun forge-diff-visit-file (file) + (interactive (list (magit-file-at-point t t))) + (if forge--pullreq-buffer + (when-let* ((line (forge--pullreq-diff-current-line)) + (column (- (current-column) 1)) + (prefix (buffer-substring (line-beginning-position) + (+ (line-beginning-position) 1))) + (file-line (if (string-match-p "-" prefix) + (assoc-default 'old line) + (assoc-default 'new line)))) + (with-current-buffer (magit-diff-visit-file--internal + file nil #'switch-to-buffer-other-window) + (goto-char (point-min)) + (forward-line (1- file-line)) + (move-to-column column))) + (magit-diff-visit-file file))) + +(defun forge--pullreq-diff-get-line (file line goto-from) + (when-let* ((hunk (magit-diff--locate-hunk file line)) + (hunk-section (car hunk))) + (when (and (slot-exists-p hunk-section 'from-range) + (slot-exists-p hunk-section 'to-range)) + (with-slots (content from-range to-range) hunk-section + (let* ((range (if goto-from from-range to-range)) + (start (car range)) + (cur-line start)) + (save-excursion + (goto-char content) + (while (not (or (= cur-line line) + (eobp))) + (unless (or (magit-section-value-if 'post) + (string-match-p + (if goto-from "\\+" "-") + (buffer-substring (point) (1+ (point))))) + (cl-incf cur-line)) + (forward-line)) + (and (not (= (point) (point-max))) + (line-number-at-pos (point))))))))) + +(defun forge--pullreq-diff-current-line () + (when-let ((hunk-section (magit-diff-visit--hunk))) + (with-slots (content from-range to-range) hunk-section + (cl-flet ((get-line (range content skip-prefix) + (let ((line (car range)) + (target (line-number-at-pos (point)))) + (save-excursion + (goto-char content) + (while (not (eq target (line-number-at-pos (point)))) + (forward-line) + (unless (or (magit-section-value-if 'post) + (string-match-p skip-prefix + (buffer-substring + (point) (+ (point) 1)))) + (cl-incf line)))) + line))) + (save-excursion + (move-beginning-of-line nil) + (let ((prefix (buffer-substring (point) (+ (point) 1)))) + (cond ((string-match-p "-" prefix) + (list (cons 'old (get-line from-range content "\\+")))) + ((string-match-p "\\+" prefix) + (list (cons 'new (get-line to-range content "-")))) + (t (list (cons 'old (get-line from-range content "\\+")) + (cons 'new (get-line to-range content "-"))))))))))) + +(defun forge--insert-pullreq-diff-posts (diff-posts) + (let* ((inhibit-read-only t) + (root-section magit-root-section)) + (dolist (post diff-posts) + (with-slots (reply-to path old-line new-line number author created body) + post + (unless reply-to + (save-excursion + (when-let ((line (forge--pullreq-diff-get-line + path old-line new-line))) + (goto-char (point-min)) + (forward-line line) + (while (magit-section-value-if 'post) (forward-line)) + (magit-insert-section section (post post) + (oset section heading-highlight-face + 'forge-pullreq-diff-post-heading) + (forge--insert-section author created body + 'forge-pullreq-diff-post-heading) + (forge--insert-replies diff-posts number + 'forge-pullreq-diff-post-reply-heading) + (overlay-put (make-overlay (- (point) 1) (point)) + 'face 'forge-pullreq-diff-delimitation))) + (setq magit-root-section root-section))))))) + +(defun forge--pullreq-diff-refresh () + (let* ((posts (oref forge-buffer-topic posts)) + (diff-posts (if forge--pullreq-commit + (forge--filter-diff-posts-by-commit + posts forge--pullreq-commit) + (forge--filter-diff-posts-by-version + posts forge--pullreq-version)))) + (forge--insert-pullreq-diff-posts diff-posts) + (when (buffer-live-p forge--pullreq-buffer) + (with-current-buffer forge--pullreq-buffer + (magit-refresh))))) + +(defun forge-show-pullreq-diff () + (interactive) + (pcase-let ((`(,version ,commit) (magit-section-value-if 'pullreq-diff))) + (let ((topic forge-buffer-topic) + (pullreq-buffer (current-buffer)) + (buf (if commit + (magit-revision-setup-buffer + commit (magit-show-commit--arguments) nil) + (with-slots (base-ref head-ref) version + (magit-diff-setup-buffer + (format "%s..%s" base-ref head-ref) + nil (magit-diff-arguments) nil))))) + (with-current-buffer buf + (setq forge--pullreq-version version) + (setq forge--pullreq-commit commit) + (setq forge--pullreq-buffer pullreq-buffer) + (setq forge-buffer-topic topic) + (add-hook 'magit-unwind-refresh-hook + 'forge--pullreq-diff-refresh nil t) + (magit-refresh))))) + +(defun forge--insert-pullreq-diff-commits (version diff-commits diff-posts) + (dolist (commit diff-commits) + (pcase-let ((`(,id ,abbrev-id ,subject) commit)) + (magit-insert-section (pullreq-diff (list version id)) + (let ((posts (forge--filter-diff-posts-by-commit diff-posts id))) + (insert (concat (propertize abbrev-id 'face 'magit-hash) + (format " %-50s " subject) + (and posts + (propertize + (format "(%d comments)" (length posts)) + 'face 'magit-section-heading)) + "\n")))))) + (insert "\n")) + +(defun forge--insert-pullreq-versions (pullreq) + (let ((posts (oref pullreq posts)) + (versions (reverse (oref pullreq versions))) + (count 0)) + (dolist (version versions) + (with-slots (base-ref head-ref) version + (cl-incf count) + (let* ((diff-commits (magit-git-lines + "log" "--format=(\"%H\" \"%h\" \"%s\")" + (format "%s..%s" base-ref head-ref))) + (diff-posts (forge--filter-diff-posts-by-version posts version)) + (comments-nbr (format "(%d comments) " (length diff-posts))) + (hide (not (eq count (length versions))))) + ;; All the version section are collapsed except for the + ;; latest version. + (magit-insert-section (pullreq-diff (list version) hide) + (magit-insert-heading (concat (if (= count (length versions)) + "Latest Version: " + (format "Version %d: " count)) + (and diff-posts comments-nbr))) + (forge--insert-pullreq-diff-commits version + (mapcar #'read diff-commits) + diff-posts))))))) + (cl-defmethod forge--insert-topic-contents :after ((pullreq forge-pullreq) _width _prefix) (unless (oref pullreq merged) diff --git a/lisp/forge-topic.el b/lisp/forge-topic.el index c6eb2f23..62efb227 100644 --- a/lisp/forge-topic.el +++ b/lisp/forge-topic.el @@ -133,6 +133,21 @@ This variable has to be customized before `forge' is loaded." "Face used for post date in topic view." :group 'forge-faces) +(defface forge-post-heading + '((t :inherit magit-diff-hunk-heading)) + "Face used for post heading in topic view." + :group 'forge-faces) + +(defface forge-post-heading-highlight + '((t :inherit magit-diff-hunk-heading-highlight)) + "Face used for current post heading in topic view." + :group 'forge-faces) + +(defface forge-post-reply-heading + '((t :inherit magit-diff-hunk-heading :extend nil)) + "Face used for reply post heading in topic view." + :group 'forge-faces) + ;;; Class (defclass forge-topic (forge-post) () :abstract t) @@ -200,8 +215,7 @@ This variable has to be customized before `forge' is loaded." (defun forge--topic-string-to-number (s) (save-match-data (if (string-match "\\`\\([!#]\\)?\\([0-9]+\\)" s) - (* (if (equal (match-string 1 s) "!") -1 1) - (string-to-number (match-string 2 s))) + (string-to-number (match-string 2 s)) (error "forge--topic-string-to-number: Invalid argument %S" s)))) (cl-defmethod forge-ls-recent-topics ((repo forge-repository) table) @@ -374,7 +388,8 @@ identifier." (let ((map (make-sparse-keymap))) (define-key map [remap magit-browse-thing] 'forge-browse-post) (define-key map [remap magit-edit-thing] 'forge-edit-post) - (define-key map (kbd "C-c C-k") 'forge-delete-comment) + (define-key map (kbd "C-c C-k") 'forge-delete-post) + (define-key map (kbd "C-c C-r") 'forge-reply-post) map)) (defvar-local forge-buffer-topic nil) @@ -400,42 +415,75 @@ identifier." (forge-buffer-topic topic) (forge-buffer-topic-ident ident)))) +(defun forge--section-heading (author created) + (let* ((age (magit--age (float-time (date-to-time created)))) + (relative-created (apply #'format "%s %s ago" age))) + (format-spec forge-post-heading-format + `((?a . ,(propertize (or author "(ghost)") + 'font-lock-face 'forge-post-author)) + (?c . ,(propertize created 'font-lock-face 'forge-post-date)) + (?C . ,(propertize relative-created 'font-lock-face + 'forge-post-date)))))) + +(defun forge--insert-section (author created body face) + (let ((heading (forge--section-heading author created))) + (add-face-text-property 0 (length heading) face t heading) + (magit-insert-heading heading) + (insert "\n" (forge--fontify-markdown body) "\n\n"))) + +(defun forge--filter-reply-posts (posts id) + (cl-remove-if-not (lambda (post) + (and (oref post reply-to) + (= (oref post reply-to) id))) + posts)) + +(defun forge--insert-replies (posts id face) + (when-let ((replies (forge--filter-reply-posts posts id)) + (indent-column 4)) + (dolist (reply replies) + (with-slots (author created body) reply + (magit-insert-section (post reply) + (let ((heading (forge--section-heading + (concat (make-string indent-column + (string-to-char " ")) + author) + created))) + (add-face-text-property indent-column (length heading) + face t heading) + (magit-insert-heading heading) + (let ((beg (point))) + (insert "\n" (forge--fontify-markdown body) "\n\n") + (indent-region beg (point) indent-column)))))))) + (defun forge-topic-refresh-buffer () - (let ((topic (closql-reload forge-buffer-topic))) + (let* ((topic (closql-reload forge-buffer-topic)) + (posts (oref topic posts))) (setq forge-buffer-topic topic) (magit-set-header-line-format (format "%s: %s" forge-buffer-topic-ident (oref topic title))) (magit-insert-section (topicbuf) (magit-insert-headers 'forge-topic-headers-hook) - (when (and (forge-pullreq-p topic) - (not (oref topic merged))) - (magit-insert-section (pullreq topic) - (magit-insert-heading "Commits") - (forge--insert-pullreq-commits topic))) + (when (forge-pullreq-p topic) + (forge--insert-pullreq-versions topic)) (when-let ((note (oref topic note))) (magit-insert-section (note) (magit-insert-heading "Note") (insert (forge--fontify-markdown note) "\n\n"))) - (dolist (post (cons topic (oref topic posts))) - (with-slots (author created body) post - (magit-insert-section section (post post) - (oset section heading-highlight-face - 'magit-diff-hunk-heading-highlight) - (let ((heading - (format-spec - forge-post-heading-format - `((?a . ,(propertize (or author "(ghost)") - 'font-lock-face 'forge-post-author)) - (?c . ,(propertize created 'font-lock-face 'forge-post-date)) - (?C . ,(propertize (apply #'format "%s %s ago" - (magit--age - (float-time - (date-to-time created)))) - 'font-lock-face 'forge-post-date)))))) - (add-face-text-property 0 (length heading) - 'magit-diff-hunk-heading t heading) - (magit-insert-heading heading)) - (insert (forge--fontify-markdown body) "\n\n")))) + ;; insert topic description + (with-slots (author created body) topic + (magit-insert-section section (post topic) + (oset section heading-highlight-face 'forge-post-heading-highlight) + (forge--insert-section author created body 'forge-post-heading))) + ;; insert posts related to the topic + (dolist (post posts) + (unless (or (and (forge-pullreq-p topic) (oref post diff-p)) + (oref post reply-to)) + (with-slots (author created body number) post + (magit-insert-section section (post post) + (oset section heading-highlight-face 'forge-post-heading-highlight) + (forge--insert-section author created body 'forge-post-heading) + ;; insert replies to this post + (forge--insert-replies posts number 'forge-post-reply-heading))))) (when (and (display-images-p) (fboundp 'markdown-display-inline-images)) (let ((markdown-display-remote-images t)) diff --git a/lisp/forge.el b/lisp/forge.el index c2987cb3..5d28e181 100644 --- a/lisp/forge.el +++ b/lisp/forge.el @@ -76,6 +76,9 @@ (define-key magit-commit-section-map (kbd "C-c C-v") 'forge-visit-topic) (define-key magit-branch-section-map (kbd "C-c C-v") 'forge-visit-topic) +(define-key magit-hunk-section-map (kbd "C-c C-n") 'forge-create-diff-post) +(define-key magit-hunk-section-map [remap magit-visit-thing] 'forge-diff-visit-file) + (transient-append-suffix 'magit-dispatch "%" '("'" "Forge" forge-dispatch ?%))