From 1acbd101afb180775302bc537b498d8d2b8d38e6 Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Sat, 27 Jul 2024 17:20:05 +0200 Subject: [PATCH] [wip] discussions --- default.mk | 1 + lisp/forge-commands.el | 44 ++++++- lisp/forge-db.el | 114 +++++++++++++++++ lisp/forge-discussion.el | 259 +++++++++++++++++++++++++++++++++++++++ lisp/forge-github.el | 143 ++++++++++++++++++--- lisp/forge-post.el | 8 +- lisp/forge-repo.el | 6 + lisp/forge-topic.el | 88 +++++++++++-- lisp/forge.el | 5 +- 9 files changed, 635 insertions(+), 33 deletions(-) create mode 100644 lisp/forge-discussion.el diff --git a/default.mk b/default.mk index de8a7bd2..767d2ae3 100644 --- a/default.mk +++ b/default.mk @@ -8,6 +8,7 @@ ELS += $(PKG).el ELS += $(PKG)-repo.el ELS += $(PKG)-post.el ELS += $(PKG)-topic.el +ELS += $(PKG)-discussion.el ELS += $(PKG)-issue.el ELS += $(PKG)-pullreq.el ELS += $(PKG)-revnote.el diff --git a/lisp/forge-commands.el b/lisp/forge-commands.el index a9ef4042..9524da5f 100644 --- a/lisp/forge-commands.el +++ b/lisp/forge-commands.el @@ -87,6 +87,7 @@ Takes the pull-request as only argument and must return a directory." ["Visit" :inapt-if-not forge--get-repository:tracked? ("v t" "topic" forge-visit-topic) + ("v d" "discussion" forge-visit-discussion) ("v i" "issue" forge-visit-issue) ("v p" "pull-request" forge-visit-pullreq)] ["Browse" @@ -219,6 +220,13 @@ repository cannot be determined, instead invoke `forge-add-repository'." ;;; Browse +;;;###autoload +(defun forge-browse-discussions () + "Visit the current repository's discussions using a browser." + (interactive) + (browse-url (forge--format (forge-get-repository 'stub) + 'discussions-url-format))) + ;;;###autoload (defun forge-browse-issues () "Visit the current repository's issues using a browser." @@ -241,6 +249,14 @@ also offer closed topics." (interactive (list (forge-read-topic "Browse topic"))) (forge--browse-topic topic)) +;;;###autoload +(defun forge-browse-discussion (discussion) + "Read an DISCUSSION and visit it using a browser. +By default only offer open discussions but with a prefix argument +also offer closed issues." + (interactive (list (forge-read-issue "Browse discussion" t))) + (forge--browse-topic discussion)) + ;;;###autoload (defun forge-browse-issue (issue) "Read an ISSUE and visit it using a browser. @@ -346,6 +362,9 @@ argument also offer closed pull-requests." (cl-defgeneric forge-get-url (obj) "Return the URL for a forge object.") +(cl-defmethod forge-get-url ((discussion forge-discussion)) + (forge--format discussion 'discussion-url-format)) + (cl-defmethod forge-get-url ((issue forge-issue)) (forge--format issue 'issue-url-format)) @@ -385,7 +404,9 @@ argument also offer closed pull-requests." (cl-defmethod forge-get-url ((post forge-post)) (forge--format post (let ((topic (forge-get-parent post))) - (cond ((forge--childp topic 'forge-issue) + (cond ((forge--childp topic 'forge-discussion) + 'discussion-post-url-format) + ((forge--childp topic 'forge-issue) 'issue-post-url-format) ((forge--childp topic 'forge-pullreq) 'pullreq-post-url-format))))) @@ -405,6 +426,14 @@ the limitation to active topics." (interactive (list (forge-read-topic "View topic"))) (forge-topic-setup-buffer (forge-get-topic topic))) +;;;###autoload +(defun forge-visit-discussion (discussion) + "Read a DISCUSSION and visit it. +By default only offer open topics for completion; +with a prefix argument also closed topics." + (interactive (list (forge-read-discussion "View discussion" t))) + (forge-topic-setup-buffer (forge-get-discussion discussion))) + ;;;###autoload (defun forge-visit-issue (issue) "Read an ISSUE and visit it. @@ -460,6 +489,19 @@ With prefix argument MENU, also show the topic menu." ;;; Create +(defun forge-create-discussion () + "Create a new discussion for the current repository." + (interactive) + (let* ((repo (forge-get-repository t)) + (buf (forge--prepare-post-buffer + "new-discussion" ;TODO + (forge--format repo "Create new discussion on %p")))) + (when buf + (with-current-buffer buf + (setq forge--buffer-post-object repo) + (setq forge--submit-post-function #'forge--submit-create-discussion)) + (forge--display-post-buffer buf)))) + (defun forge-create-issue () "Create a new issue for the current repository." (interactive) diff --git a/lisp/forge-db.el b/lisp/forge-db.el index 47d132d7..8b73e28a 100644 --- a/lisp/forge-db.el +++ b/lisp/forge-db.el @@ -122,6 +122,9 @@ (milestones :default eieio-unbound) issues-until pullreqs-until + (discussion-categories :default eieio-unbound) + (discussions :default eieio-unbound) + discussions-p ]) (assignee @@ -134,6 +137,103 @@ [repository] :references repository [id] :on-delete :cascade)) + (discussion + [(class :not-null) + (id :not-null :primary-key) + fid + number + repository + answer + state + state-reason + author + title + created + updated + closed + unread-p + done-p + locked-p + body + note + (edits :default eieio-unbound) + (labels :default eieio-unbound) + (posts :default eieio-unbound) + (reactions :default eieio-unbound) + (timeline :default eieio-unbound) + (marks :default eieio-unbound)] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (discussion-category + [(repository :not-null) + (id :not-null :primary-key) + name + emoji + answerable-p + description] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (discussion-label + [(discussion :not-null) + (id :not-null)] + (:foreign-key + [discussion] :references discussion [id] + :on-delete :cascade) + (:foreign-key + [id] :references label [id] + :on-delete :cascade)) + + (discussion-mark + [(discussion :not-null) + (id :not-null)] + (:foreign-key + [discussion] :references discussion [id] + :on-delete :cascade) + (:foreign-key + [id] :references mark [id] + :on-delete :cascade)) + + (discussion-post ; aka top-level answer + [(class :not-null) + (id :not-null :primary-key) + fid + number + discussion + author + created + updated + body + (edits :default eieio-unbound) + (reactions :default eieio-unbound) + (replies :default eieio-unbound)] + (:foreign-key + [discussion] :references discussion [id] + :on-delete :cascade)) + + (discussion-reply ; aka nested reply to top-level answer + [(class :not-null) + (id :not-null :primary-key) + fid + number + post + discussion + author + created + updated + body + (edits :default eieio-unbound) + (reactions :default eieio-unbound)] + (:foreign-key + [post] :references discussion-post [id] + :on-delete :cascade) + (:foreign-key + [discussion] :references discussion [id] + :on-delete :cascade)) + (fork [(parent :not-null) (id :not-null :primary-key) @@ -534,6 +634,20 @@ id)) (closql--db-set-version db (setq version 13)) (message "Upgrading Forge database from version 12 to 13...done")) + (when nil ; TODO (= version 13) + (message "Upgrading Forge database from version 13 to 14...") + (emacsql db [:create-table discussion $S1] + (cdr (assq 'discussion forge--db-table-schemata))) + (emacsql db [:create-table discussion-label $S1] + (cdr (assq 'discussion-label forge--db-table-schemata))) + (emacsql db [:create-table discussion-mark $S1] + (cdr (assq 'discussion-mark forge--db-table-schemata))) + (emacsql db [:create-table discussion-post $S1] + (cdr (assq 'discussion-post forge--db-table-schemata))) + (emacsql db [:create-table discussion-reply $S1] + (cdr (assq 'discussion-reply forge--db-table-schemata))) + (closql--db-set-version db (setq version 14)) + (message "Upgrading Forge database from version 13 to 14...done")) ) (cl-call-next-method))) diff --git a/lisp/forge-discussion.el b/lisp/forge-discussion.el new file mode 100644 index 00000000..00903522 --- /dev/null +++ b/lisp/forge-discussion.el @@ -0,0 +1,259 @@ +;;; forge-discussion.el --- Discussion support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file 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 file 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 file. If not, see . + +;;; Code: + +(require 'forge) +(require 'forge-post) +(require 'forge-topic) + +;;; Classes + +(defclass forge-discussion (forge-topic) + ((closql-table :initform 'discussion) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(desc number)]) + (closql-foreign-key :initform 'repository) + (closql-class-prefix :initform "forge-") + (id :initarg :id) + (fid :initarg :fid) + (number :initarg :number) + (repository :initarg :repository) + (answer :initarg :answer) + (state :initarg :state) + (state-reason :initarg :state-reason) + (author :initarg :author) + (title :initarg :title) + (created :initarg :created) + (updated :initarg :updated) + (closed :initarg :closed) + (unread-p :initarg :unread-p :initform nil) + (done-p :initarg :done-p :initform nil) + (locked-p :initarg :locked-p :initform nil) + (body :initarg :body) + (note :initarg :note :initform nil) + (edits) ; userContentEdits + (labels :closql-table (discussion-label label)) + (posts :closql-class forge-discussion-post) + (reactions) + (timeline) + (marks :closql-table (discussion-mark mark)) + )) + +(defclass forge-discussion-post (forge-post) + ((closql-table :initform 'discussion-post) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(asc number)]) + (closql-foreign-key :initform 'discussion) + (closql-class-prefix :initform "forge-discussion-") + (id :initarg :id) + (fid :initarg :fid) + (number :initarg :number) + (discussion :initarg :discussion) + (author :initarg :author) + (created :initarg :created) + (updated :initarg :updated) + (body :initarg :body) + (edits) + (reactions) + (replies :closql-class forge-discussion-reply) + )) + +(defclass forge-discussion-reply (forge-post) + ((closql-table :initform 'discussion-reply) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(asc number)]) + (closql-foreign-key :initform 'post) + (closql-class-prefix :initform "forge-discussion-") + (id :initarg :id) + (fid :initarg :fid) + (number :initarg :number) + (post :initarg :post) + (discussion :initarg :discussion) + (author :initarg :author) + (created :initarg :created) + (updated :initarg :updated) + (body :initarg :body) + (edits) + (reactions) + )) + +;;; Query +;;;; Get + +(cl-defmethod forge-get-repository ((post forge-discussion-post)) + (forge-get-repository (forge-get-discussion post))) + +(cl-defmethod forge-get-topic ((post forge-discussion-post)) + (forge-get-discussion post)) + +(cl-defmethod forge-get-discussion ((discussion forge-discussion)) + discussion) + +(cl-defmethod forge-get-discussion ((repo forge-repository) number) + (closql-get (forge-db) + (forge--object-id 'forge-discussion repo number) + 'forge-discussion)) + +(cl-defmethod forge-get-discussion ((number integer)) + (and-let* ((repo (forge-get-repository t))) + (forge-get-discussion repo number))) + +(cl-defmethod forge-get-discussion ((id string)) + (closql-get (forge-db) id 'forge-discussion)) + +(cl-defmethod forge-get-discussion ((post forge-discussion-post)) + (closql-get (forge-db) + (oref post discussion) + 'forge-discussion)) + +;; (cl-defmethod forge-get-discussion ((post forge-discussion-reply)) +;; (closql-get (forge-db) +;; (oref post discussion) +;; 'forge-discussion)) + +;; (cl-defmethod forge-get-discussion-post ((reply forge-discussion-reply)) +;; (closql-get (forge-db) +;; (oref reply post) +;; 'forge-discussion-post)) + +;;;; Current + +(defun forge-current-discussion (&optional demand) + "Return the discussion at point or being visited. +If there is no such discussion and DEMAND is non-nil, then signal +an error." + (or (forge-discussion-at-point) + (and (derived-mode-p 'forge-topic-mode) + (forge-discussion-p forge-buffer-topic) + forge-buffer-topic) + (and demand (user-error "No current discussion")))) + +(defun forge-discussion-at-point (&optional demand) + "Return the discussion at point. +If there is no such discussion and DEMAND is non-nil, then signal +an error." + (or (thing-at-point 'forge-discussion) + (magit-section-value-if 'discussion) + (and (derived-mode-p 'forge-topic-list-mode) + (let ((topic (forge-get-topic (tabulated-list-get-id)))) + (and (forge-discussion-p topic) + topic))) + (and demand (user-error "No discussion at point")))) + +(put 'forge-discussion 'thing-at-point #'forge-thingatpt--discussion) +(defun forge-thingatpt--discussion () + (and-let* ((repo (forge--repo-for-thingatpt))) + (and (thing-at-point-looking-at "#\\([0-9]+\\)\\_>") + (forge-get-discussion repo (string-to-number (match-string 1)))))) + +;;;; List + +(cl-defmethod forge-ls-discussions + ((repo forge-repository) &optional type select) + (forge-ls-topics repo 'forge-discussion type select)) + +(defun forge--ls-recent-discussions (repo) + (forge-ls-recent-topics repo 'dicussion)) + +(defun forge--ls-assigned-discussions (repo) + (mapcar (lambda (row) + (closql--remake-instance 'forge-discussion (forge-db) row)) + (forge-sql + [:select $i1 :from [discussion discussion_assignee assignee] + :where (and (= discussion_assignee:discussion discussion:id) + (= discussion_assignee:id assignee:id) + (= discussion:repository $s2) + (= assignee:login $s3) + (isnull discussion:closed)) + :order-by [(desc updated)]] + (vconcat (closql--table-columns (forge-db) 'discussion t)) + (oref repo id) + (ghub--username repo)))) + +(defun forge--ls-authored-discussions (repo) + (mapcar (lambda (row) + (closql--remake-instance 'forge-discussion (forge-db) row)) + (forge-sql + [:select $i1 :from [discussion] + :where (and (= discussion:repository $s2) + (= discussion:author $s3) + (isnull discussion:closed)) + :order-by [(desc updated)]] + (vconcat (closql--table-columns (forge-db) 'discussion t)) + (oref repo id) + (ghub--username repo)))) + +;;; Read + +(defun forge-read-discussion (prompt &optional type) + "Read an discussion with completion using PROMPT. +TYPE can be `open', `closed', or nil to select from all discussions. +TYPE can also be t to select from open discussions, or all discussions +if a prefix argument is in effect." + (when (eq type t) + (setq type (if current-prefix-arg nil 'open))) + (let* ((default (forge-current-discussion)) + (repo (forge-get-repository (or default t))) + (choices (mapcar #'forge--format-topic-choice + (forge-ls-discussions repo type)))) + (cdr (assoc (magit-completing-read + prompt choices nil nil nil nil + (and default + (setq default (forge--format-topic-choice default)) + (member default choices) + (car default))) + choices)))) + +;;; Insert + +(defvar-keymap forge-discussions-section-map + " " #'forge-browse-discussions + " " #'forge-list-discussions + "C-c C-n" #'forge-create-discussion) + +(defvar-keymap forge-discussion-section-map + " " #'forge-visit-this-topic) + +(defun forge-insert-discussions () + "Insert a list of mostly recent and/or open discussions. +Also see option `forge-topic-list-limit'." + (forge--insert-discussions "Discussions" + #'forge--ls-recent-discussions)) + +(defun forge-insert-assigned-discussions () + "Insert a list of open discussions that are assigned to you." + (forge--insert-discussions "Assigned discussions" + #'forge--ls-assigned-discussions)) + +(defun forge-insert-authored-discussions () + "Insert a list of open discussions that are authored to you." + (forge--insert-discussions "Authored discussions" + #'forge--ls-authored-discussions)) + +(defun forge--insert-discussions (heading getter) + (when-let ((repo (forge--assert-insert-topics-get-repository t))) + (forge--insert-topics 'discussions heading (funcall getter repo)))) + +;;; _ +(provide 'forge-discussion) +;;; forge-discussion.el ends here diff --git a/lisp/forge-github.el b/lisp/forge-github.el index 43709048..8f4b706e 100644 --- a/lisp/forge-github.el +++ b/lisp/forge-github.el @@ -25,24 +25,28 @@ (require 'ghub) (require 'forge) +(require 'forge-discussion) (require 'forge-issue) (require 'forge-pullreq) ;;; Class (defclass forge-github-repository (forge-repository) - ((issues-url-format :initform "https://%h/%o/%n/issues") - (issue-url-format :initform "https://%h/%o/%n/issues/%i") - (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#issuecomment-%I") - (pullreqs-url-format :initform "https://%h/%o/%n/pulls") - (pullreq-url-format :initform "https://%h/%o/%n/pull/%i") - (pullreq-post-url-format :initform "https://%h/%o/%n/pull/%i#issuecomment-%I") - (commit-url-format :initform "https://%h/%o/%n/commit/%r") - (branch-url-format :initform "https://%h/%o/%n/commits/%r") - (remote-url-format :initform "https://%h/%o/%n") - (create-issue-url-format :initform "https://%h/%o/%n/issues/new") - (create-pullreq-url-format :initform "https://%h/%o/%n/compare") - (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*"))) + ((discussions-url-format :initform "https://%h/%o/%n/discussions") + (discussion-url-format :initform "https://%h/%o/%n/discussions/%i") + (discussion-post-url-format :initform "https://%h/%o/%n/issues/%i#discussioncomment-%I") + (issues-url-format :initform "https://%h/%o/%n/issues") + (issue-url-format :initform "https://%h/%o/%n/issues/%i") + (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#issuecomment-%I") + (pullreqs-url-format :initform "https://%h/%o/%n/pulls") + (pullreq-url-format :initform "https://%h/%o/%n/pull/%i") + (pullreq-post-url-format :initform "https://%h/%o/%n/pull/%i#issuecomment-%I") + (commit-url-format :initform "https://%h/%o/%n/commit/%r") + (branch-url-format :initform "https://%h/%o/%n/commits/%r") + (remote-url-format :initform "https://%h/%o/%n") + (create-issue-url-format :initform "https://%h/%o/%n/issues/new") + (create-pullreq-url-format :initform "https://%h/%o/%n/compare") + (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*"))) ;;; Query @@ -66,14 +70,16 @@ (forge--msg repo t nil "Storing REPO") (closql-with-transaction (forge-db) (let-alist data - (forge--update-repository repo data) - (forge--update-assignees repo .assignableUsers) - (forge--update-forks repo .forks) - (forge--update-labels repo .labels) - (forge--update-milestones repo .milestones) - (forge--update-issues repo .issues t) - (forge--update-pullreqs repo .pullRequests t) - (forge--update-revnotes repo .commitComments)) + (forge--update-repository repo data) + (forge--update-assignees repo .assignableUsers) + (forge--update-forks repo .forks) + (forge--update-labels repo .labels) + (forge--update-milestones repo .milestones) + ;; (forge--update-discussion-categories repo .discussionCategories) + (forge--update-discussions repo .discussions t) + (forge--update-issues repo .issues t) + (forge--update-pullreqs repo .pullRequests t) + (forge--update-revnotes repo .commitComments)) (oset repo condition :tracked)) (forge--msg repo t t "Storing REPO") (cond @@ -101,6 +107,7 @@ (oset repo mirror-p .isMirror) (oset repo private-p .isPrivate) (oset repo issues-p .hasIssuesEnabled) + (oset repo discussions-p .hasDiscussionsEnabled) (oset repo wiki-p .hasWikiEnabled) (oset repo stars .stargazers.totalCount) (oset repo watchers .watchers.totalCount))) @@ -175,6 +182,18 @@ .description))) (delete-dups data))))) +(cl-defmethod forge--update-discussion-categories ((repo forge-github-repository) data) + (oset repo discussion-categories + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + (list (forge--object-id id .id) + .name + .emoji + .isAnswerable + .description))) + (delete-dups data))))) + ;;;; Topics (cl-defmethod forge--pull-topic ((repo forge-github-repository) @@ -372,6 +391,88 @@ (forge--set-id-slot repo pullreq 'labels .labels)))) pullreq)) +;;;; Discussions + +(cl-defmethod forge--update-discussions ((repo forge-github-repository) data bump) + (closql-with-transaction (forge-db) + (mapc (lambda (e) (forge--update-discussion repo e bump)) data))) + +(cl-defmethod forge--update-discussion ((repo forge-github-repository) data bump) + (closql-with-transaction (forge-db) + (let-alist data + (let* ((repository-id (oref repo id)) + (discussion-id (forge--object-id 'forge-discussion repo .number)) + (discussion + (or (forge-get-discussion repo .number) + (closql-insert + (forge-db) + (forge-discussion :id discussion-id + :fid .id + :number .number + :repository repository-id))))) + (oset discussion author .author.login) + (oset discussion title .title) + (oset discussion created .createdAt) + (oset discussion updated (cond (bump (or .updatedAt .createdAt)) + ((slot-boundp discussion 'updated) + (oref discussion updated)) + (t "0"))) + (oset discussion closed .closedAt) + (oset discussion locked-p .locked) + (oset discussion body (forge--sanitize-string .body)) + (oset discussion answer + (and .answer.id + (forge--object-id discussion-id .answer.id))) + (oset discussion state + (pcase-exhaustive .stateReason + ("DUPLICATE" 'closed) + ("OUTDATED" 'closed) + ("RESOLVED" 'closed) + ("REOPENED" 'open) + ('nil 'open))) + (oset discussion state-reason + (pcase-exhaustive .stateReason + ("DUPLICATE" 'duplicated) + ("OUTDATED" 'outdated) + ("RESOLVED" 'resolved) + ("REOPENED" 'reopened) + ('nil 'new))) + .databaseId ; Silence Emacs 25 byte-compiler. + (dolist (post-data .comments) + (let-alist post-data + (let ((post-id (forge--object-id discussion-id .databaseId))) + (closql-insert + (forge-db) + (forge-discussion-post + :id post-id + :fid .id + :number .databaseId + :discussion discussion-id + :author .author.login + :created .createdAt + :updated .updatedAt + :body (forge--sanitize-string .body)) + t) + (dolist (reply-data .replies) + (let-alist reply-data + (closql-insert + (forge-db) + (forge-discussion-reply + :id (forge--object-id discussion-id .databaseId) + :fid .id + :number .databaseId + :post post-id + :discussion discussion-id + :author .author.login + :created .createdAt + :updated .updatedAt + :body (forge--sanitize-string .body)) + t)))))) + (when bump + (unless (magit-get-boolean "forge.kludge-for-discussion-294") + (forge--set-id-slot repo discussion 'labels .labels))) + discussion)))) + ;;;; Notifications (cl-defmethod forge--pull-notifications @@ -569,6 +670,8 @@ ;;; Mutations +(cl-defmethod forge--submit-create-discussion ((_ forge-github-repository) _repo)) ; TODO + (cl-defmethod forge--submit-create-issue ((_ forge-github-repository) repo) (let-alist (forge--topic-parse-buffer) (forge--ghub-post repo "/repos/:owner/:repo/issues" diff --git a/lisp/forge-post.el b/lisp/forge-post.el index 23526ead..7d552d29 100644 --- a/lisp/forge-post.el +++ b/lisp/forge-post.el @@ -136,9 +136,15 @@ an error." (when (and (not resume) (string-prefix-p "new" filename)) (let-alist (forge--topic-template (forge-get-repository :tracked) - (if source 'forge-pullreq 'forge-issue)) + (pcase filename + ("newdiscussion" 'forge-discussion) + ("newissue" 'forge-issue) + ("newpullreq" 'forge-pullreq))) (cond (.url + ;; TODO If appropriate, instead switch from newissue to + ;; newdiscussion. But that conflicts with resume handling + ;; above. (browse-url .url) (forge-post-cancel) (setq buf nil) diff --git a/lisp/forge-repo.el b/lisp/forge-repo.el index 47791f55..05033916 100644 --- a/lisp/forge-repo.el +++ b/lisp/forge-repo.el @@ -32,6 +32,9 @@ (closql-class-suffix :initform "-repository") (closql-table :initform 'repository) (closql-primary-key :initform 'id) + (discussions-url-format :initform nil :allocation :class) + (discussion-url-format :initform nil :allocation :class) + (discussion-post-url-format :initform nil :allocation :class) (issues-url-format :initform nil :allocation :class) (issue-url-format :initform nil :allocation :class) (issue-post-url-format :initform nil :allocation :class) @@ -80,6 +83,9 @@ (milestones :closql-table milestone) (issues-until :initform nil) (pullreqs-until :initform nil)) + (discussion-categories :closql-table discussion-category) + (discussions :closql-class forge-discussion) + (discussions-p :initform nil)) :abstract t) (defclass forge-unusedapi-repository (forge-repository) () :abstract t) diff --git a/lisp/forge-topic.el b/lisp/forge-topic.el index 5f35a4e6..debb92dc 100644 --- a/lisp/forge-topic.el +++ b/lisp/forge-topic.el @@ -275,6 +275,8 @@ Likewise those faces should not set `:weight' or `:slant'." (cl-defmethod forge-get-topic ((topic forge-topic)) topic) +;; TODO forge-get-topic Support discussions + (cl-defmethod forge-get-topic ((repo forge-repository) number-or-id) (if (numberp number-or-id) (if (< number-or-id 0) @@ -291,7 +293,8 @@ Likewise those faces should not set `:weight' or `:slant'." (forge-get-pullreq number)))) (cl-defmethod forge-get-topic ((id string)) - (or (forge-get-issue id) + (or (forge-get-discussion id) + (forge-get-issue id) (forge-get-pullreq id))) ;;;; Current @@ -309,7 +312,7 @@ an error." If there is no such topic and DEMAND is non-nil, then signal an error." (or (thing-at-point 'forge-topic) - (magit-section-value-if '(issue pullreq)) + (magit-section-value-if '(discussion issue pullreq)) (forge-get-pullreq :branch) (and demand (user-error "No topic at point")))) @@ -326,7 +329,7 @@ an error." repo (string-to-number (match-string-no-properties 1)))))) (defun forge-region-topics () - (magit-region-values '(issue pullreq))) + (magit-region-values '(discussion issue pullreq))) ;;;; List @@ -685,12 +688,16 @@ can be selected from the start." 'pullreq) (oref repo id)) (forge-sql [:select [number title updated] - :from pullreq + :from discussion :where (= repository $s1) :union :select [number title updated] :from issue :where (= repository $s1) + :union + :select [number title updated] + :from pullreq + :where (= repository $s1) :order-by [(desc updated)]] (oref repo id)))) :annotation-function (lambda (c) (get-text-property 0 :title c)))))) @@ -1091,6 +1098,16 @@ This mode itself is never used directly." (setq-local markdown-translate-filename-function #'forge--markdown-translate-filename-function)) +(define-derived-mode forge-discussion-mode forge-topic-mode "Discussion" + "Mode for looking at a Forge discussion.") +(defalias 'forge-discussion-setup-buffer #'forge-topic-setup-buffer) +(defalias 'forge-discussion-refresh-buffer #'forge-topic-refresh-buffer) +(defvar forge-discussion-headers-hook + '(forge-insert-topic-title + forge-insert-topic-state + forge-insert-topic-labels + forge-insert-topic-marks)) + (define-derived-mode forge-issue-mode forge-topic-mode "Issue" "Major mode for looking at a Forge issue." :interactive nil) @@ -1128,7 +1145,10 @@ This mode itself is never used directly." (name (format "*forge: %s %s*" (oref repo slug) (oref topic slug))) (magit-generate-buffer-name-function (lambda (_mode _value) name))) (magit-setup-buffer-internal - (if (forge-issue-p topic) #'forge-issue-mode #'forge-pullreq-mode) + (pcase-exhaustive (eieio-object-class topic) + ('forge-discussion #'forge-discussion-mode) + ('forge-issue #'forge-issue-mode) + ('forge-pullreq #'forge-pullreq-mode)) t `((forge-buffer-topic ,topic)) name (or (forge-get-worktree repo) "/")) (forge-topic-mark-read topic))) @@ -1171,11 +1191,55 @@ This mode itself is never used directly." 'font-lock-face 'magit-diff-hunk-heading heading) (magit-insert-heading heading)) (insert (forge--fontify-markdown body) "\n\n")))) + (forge-insert-post topic nil) + (dolist (post (oref topic posts)) + (forge-insert-post post topic)) (when (and (display-images-p) (fboundp 'markdown-display-inline-images)) (let ((markdown-display-remote-images t)) (markdown-display-inline-images)))))) +(defun forge-insert-post (post topic) + (magit-insert-section (post post) + (forge-insert-post-heading post) + (forge-insert-post-content post) + (when (forge-discussion-p topic) + (dolist (reply (oref post replies)) + (magit-insert-section (post reply) ;TODO type 'reply? + (forge-insert-post-heading reply) + (forge-insert-post-content reply)))))) + +(defun forge-insert-post-heading (post) + (oset magit-insert-section--current + heading-highlight-face + 'magit-diff-hunk-heading-highlight) + (let* ((author (oref post author)) + (created (oref post created)) + (heading + (format-spec + forge-post-heading-format + `((?a . ,(propertize (concat (forge--format-avatar author) + (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)))))) + (when (forge-discussion-reply-p post) + (setq heading (concat " " heading))) + (font-lock-append-text-property + 0 (length heading) + 'font-lock-face (if (forge-discussion-reply-p post) + '(magit-dimmed magit-diff-hunk-heading) + 'magit-diff-hunk-heading) + heading) + (magit-insert-heading heading))) + +(defun forge-insert-post-content (post) + (insert (forge--fontify-markdown (oref post body)) "\n\n")) + (cl-defmethod magit-buffer-value (&context (major-mode forge-topic-mode)) (oref forge-buffer-topic slug)) @@ -1682,12 +1746,18 @@ alist, containing just `text' and `position'.") (cl-defmethod forge--topic-template ((repo forge-repository) (class (subclass forge-topic))) - (let ((choices (forge--topic-templates-data repo class))) + (let ((choices (if (eq class 'forge-discussion) + ;; TODO Format discussion types from api like it + ;; came from template files, or maybe handle this + ;; differently and elsewhere. + nil + (forge--topic-templates-data repo class)))) (if (cdr choices) (let ((c (magit-completing-read - (if (eq class 'forge-pullreq) - "Select pull-request template" - "Select issue template") + (pcase class + ('forge-discussion "Select discussion type") + ('forge-issue "Select issue template") + ('forge-pullreq "Select pull-request template")) (--map (alist-get 'prompt it) choices) nil t))) (--first (equal (alist-get 'prompt it) c) choices)) diff --git a/lisp/forge.el b/lisp/forge.el index 0444dac9..73623f1b 100644 --- a/lisp/forge.el +++ b/lisp/forge.el @@ -84,8 +84,9 @@ If you want to disable this, then you must set this to nil before `forge' is loaded.") (when forge-add-default-sections - (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-pullreqs nil t) - (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-issues nil t)) + (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-pullreqs nil t) + (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-issues nil t) + (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-discussions nil t)) ;;; Add Bindings