From dead5d45ba4436ded7b9ab8bc990233d84aa8439 Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Wed, 21 May 2025 14:40:15 +0200 Subject: [PATCH] update forge --- bba.org | 2 +- elpa/forge-20250516.1009/.dir-locals.el | 11 + .../dir | 0 .../forge-autoloads.el | 39 +- .../forge-bitbucket.el | 0 .../forge-commands.el | 278 ++++-- .../forge-core.el | 45 +- .../forge-db.el | 248 ++++-- elpa/forge-20250516.1009/forge-discussion.el | 278 ++++++ .../forge-forgejo.el | 0 .../forge-gitea.el | 0 .../forge-github.el | 667 ++++++++++---- .../forge-gitlab.el | 38 +- .../forge-gogs.el | 0 .../forge-issue.el | 5 + .../forge-notify.el | 25 +- .../forge-pkg.el | 24 +- .../forge-post.el | 27 +- .../forge-pullreq.el | 5 + .../forge-repo.el | 166 ++-- .../forge-repos.el | 7 +- .../forge-revnote.el | 5 + .../forge-semi.el | 0 .../forge-tablist.el | 5 + .../forge-topic.el | 831 ++++++++++++------ .../forge-topics.el | 152 +++- .../forge.el | 47 +- .../forge.info | 215 ++--- 28 files changed, 2233 insertions(+), 887 deletions(-) create mode 100644 elpa/forge-20250516.1009/.dir-locals.el rename elpa/{forge-20250108.2134 => forge-20250516.1009}/dir (100%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-autoloads.el (88%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-bitbucket.el (100%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-commands.el (84%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-core.el (92%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-db.el (74%) create mode 100644 elpa/forge-20250516.1009/forge-discussion.el rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-forgejo.el (100%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-gitea.el (100%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-github.el (55%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-gitlab.el (95%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-gogs.el (100%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-issue.el (98%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-notify.el (93%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-pkg.el (50%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-post.el (92%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-pullreq.el (98%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-repo.el (81%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-repos.el (96%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-revnote.el (91%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-semi.el (100%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-tablist.el (95%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-topic.el (68%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge-topics.el (82%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge.el (85%) rename elpa/{forge-20250108.2134 => forge-20250516.1009}/forge.info (94%) diff --git a/bba.org b/bba.org index ec2fcd86..82f9e26e 100644 --- a/bba.org +++ b/bba.org @@ -912,7 +912,7 @@ I still like ido-find-file. [2023-01-17 Tue 09:33] #+begin_src emacs-lisp - (add-to-list 'load-path "~/.emacs.d/elpa/forge-20241223.1032") + (add-to-list 'load-path "~/.emacs.d/elpa/forge-20250516.1009") (with-eval-after-load 'magit (require 'forge)) diff --git a/elpa/forge-20250516.1009/.dir-locals.el b/elpa/forge-20250516.1009/.dir-locals.el new file mode 100644 index 00000000..5925554f --- /dev/null +++ b/elpa/forge-20250516.1009/.dir-locals.el @@ -0,0 +1,11 @@ +((nil + (indent-tabs-mode . nil)) + (makefile-mode + (indent-tabs-mode . t)) + (git-commit-mode + (git-commit-major-mode . git-commit-elisp-text-mode)) + (".github/PULL_REQUEST_TEMPLATE" + (nil (truncate-lines . nil))) + ("CHANGELOG" + (nil (fill-column . 70) + (mode . display-fill-column-indicator)))) diff --git a/elpa/forge-20250108.2134/dir b/elpa/forge-20250516.1009/dir similarity index 100% rename from elpa/forge-20250108.2134/dir rename to elpa/forge-20250516.1009/dir diff --git a/elpa/forge-20250108.2134/forge-autoloads.el b/elpa/forge-20250516.1009/forge-autoloads.el similarity index 88% rename from elpa/forge-20250108.2134/forge-autoloads.el rename to elpa/forge-20250516.1009/forge-autoloads.el index e4d09334..15c11cb8 100644 --- a/elpa/forge-20250108.2134/forge-autoloads.el +++ b/elpa/forge-20250516.1009/forge-autoloads.el @@ -36,6 +36,8 @@ is loaded, then `magit-mode-map' ends up being modified anyway.") (autoload 'forge-pull-notifications "forge-commands" nil t) (autoload 'forge-pull-topic "forge-commands" nil t) (autoload 'forge-pull-this-topic "forge-commands" nil t) +(autoload 'forge-browse-discussions "forge-commands" "\ +Visit the current repository's discussions using a browser." t) (autoload 'forge-browse-issues "forge-commands" "\ Visit the current repository's issues using a browser." t) (autoload 'forge-browse-pullreqs "forge-commands" "\ @@ -46,6 +48,12 @@ By default only offer open topics but with a prefix argument also offer closed topics. (fn TOPIC)" t) +(autoload 'forge-browse-discussion "forge-commands" "\ +Read a DISCUSSION and visit it using a browser. +By default only offer open discussions but with a prefix argument +also offer closed issues. + +(fn DISCUSSION)" t) (autoload 'forge-browse-issue "forge-commands" "\ Read an ISSUE and visit it using a browser. By default only offer open issues but with a prefix argument @@ -104,6 +112,13 @@ argument offer all topics. While completion is in progress, \\\\[forge-read-topic-lift-limit] lifts +the limitation to active topics. + +(fn DISCUSSION)" t) (autoload 'forge-visit-issue "forge-commands" "\ Read an ISSUE and visit it. By default only offer active issues for completion. With a prefix @@ -139,7 +154,7 @@ Please see the manual for more information. (autoload 'forge-checkout-worktree "forge-commands" "\ Create, configure and checkout a new worktree from a pull-request. This is like `forge-checkout-pullreq', except that it also -creates a new worktree. Please see the manual for more +creates a new worktree. Please see the manual for more information. (fn PATH PULLREQ)" t) @@ -174,10 +189,18 @@ Remove a repository from the database. (fn REPOSITORY)" t) (autoload 'forge-remove-topic-locally "forge-commands" "\ Remove a topic from the local database only. -Due to how the supported APIs work, it would be too expensive to -automatically remove topics from the local database that were -removed from the forge. The purpose of this command is to allow -you to manually clean up the local database. + +When the region marks multiple topics, then offer to remove them all. + +The topic is not removed from the forge and, if it is later modified, +then it will be added to the database again when fetching all topics. + +This is useful for users who only fetch individual topics and want to +remove the topics they are no longer interested in. This can also be +used to remove topics locally, which have already been removed on the +forge (the service). Forge (the package) cannot automatically detect +when that happens, because given how the APIs work, this would be too +expensive. (fn TOPIC)" t) (autoload 'forge-reset-database "forge-commands" "\ @@ -197,6 +220,11 @@ heavy development." t) (register-definition-prefixes "forge-db" '("forge-")) + +;;; Generated autoloads from forge-discussion.el + +(register-definition-prefixes "forge-discussion" '("forge-")) + ;;; Generated autoloads from forge-forgejo.el @@ -284,6 +312,7 @@ heavy development." t) (autoload 'forge-topics-menu "forge-topics" nil t) (autoload 'forge-list-topics "forge-topics" nil t) +(autoload 'forge-list-discussions "forge-topics" nil t) (autoload 'forge-list-issues "forge-topics" nil t) (autoload 'forge-list-pullreqs "forge-topics" nil t) (autoload 'forge-list-global-topics "forge-topics" nil t) diff --git a/elpa/forge-20250108.2134/forge-bitbucket.el b/elpa/forge-20250516.1009/forge-bitbucket.el similarity index 100% rename from elpa/forge-20250108.2134/forge-bitbucket.el rename to elpa/forge-20250516.1009/forge-bitbucket.el diff --git a/elpa/forge-20250108.2134/forge-commands.el b/elpa/forge-20250516.1009/forge-commands.el similarity index 84% rename from elpa/forge-20250108.2134/forge-commands.el rename to elpa/forge-20250516.1009/forge-commands.el index 0e7391cc..02c2cbc6 100644 --- a/elpa/forge-20250108.2134/forge-commands.el +++ b/elpa/forge-20250516.1009/forge-commands.el @@ -65,14 +65,15 @@ Takes the pull-request as only argument and must return a directory." ("f t" "one topic" forge-pull-topic) ("f n" "notifications" forge-pull-notifications)] ["Create" - :if forge--get-repository:tracked? + :if (##forge-get-repository :tracked?) + ("c d" "discussion" forge-create-discussion) ("c i" "issue" forge-create-issue) ("c p" "pull-request" forge-create-pullreq) ("c u" "pr from issue" forge-create-pullreq-from-issue) ("c f" "fork or remote" forge-fork)] [:description (lambda () (cond - ((forge--get-repository:tracked?) "Actions") + ((forge-get-repository :tracked?) "Actions") ((or (magit-gitdir) (forge-repository-at-point)) "Forge does not yet track this repository") ("Not inside a Git repository"))) @@ -83,20 +84,22 @@ Takes the pull-request as only argument and must return a directory." "track some repo" "track this repository")))) ("/M" "merge with api" forge-merge - :if forge--get-repository:tracked? :level 7)]] + :if (##forge-get-repository :tracked?) + :level 7)]] [forge--lists-group ["Visit" - :inapt-if-not forge--get-repository:tracked? + :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" ("b t" "topic" forge-browse-topic - :inapt-if-not forge--get-repository:tracked?) + :inapt-if-not (##forge-get-repository :tracked?)) ("b i" "issue" forge-browse-issue - :inapt-if-not forge--get-repository:tracked?) + :inapt-if-not (##forge-get-repository :tracked?)) ("b p" "pull-request" forge-browse-pullreq - :inapt-if-not forge--get-repository:tracked?) + :inapt-if-not (##forge-get-repository :tracked?)) ("b r" "remote" forge-browse-remote) ("b I" "issues" forge-browse-issues) ("b P" "pull-requests" forge-browse-pullreqs) @@ -109,7 +112,7 @@ Takes the pull-request as only argument and must return a directory." (transient-augment-suffix forge-dispatch :transient #'transient--do-replace - :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-dispatch)) + :inapt-if (##eq (oref transient--prefix command) 'forge-dispatch) :inapt-face 'forge-suffix-active) ;;;###autoload(autoload 'forge-configure "forge-commands" nil t) @@ -127,7 +130,7 @@ Takes the pull-request as only argument and must return a directory." (transient-augment-suffix forge-configure :transient #'transient--do-replace - :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-configure)) + :inapt-if (##eq (oref transient--prefix command) 'forge-configure) :inapt-face 'forge-suffix-active) ;;; Pull @@ -198,7 +201,7 @@ repository cannot be determined, instead invoke `forge-add-repository'." ;;;###autoload(autoload 'forge-pull-topic "forge-commands" nil t) (transient-define-suffix forge-pull-topic (number) "Read a topic TYPE and NUMBER pull data about it from its forge." - :inapt-if-not (lambda () (and (forge--get-repository:tracked?) + :inapt-if-not (lambda () (and (forge-get-repository :tracked?) (forge--get-github-repository))) (interactive (list (read-number "Pull topic: " @@ -221,6 +224,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." @@ -243,6 +253,14 @@ also offer closed topics." (interactive (list (forge-read-topic "Browse topic"))) (forge--browse-topic topic)) +;;;###autoload +(defun forge-browse-discussion (discussion) + "Read a 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-discussion "Browse discussion"))) + (forge--browse-topic discussion)) + ;;;###autoload (defun forge-browse-issue (issue) "Read an ISSUE and visit it using a browser. @@ -386,6 +404,9 @@ commit, and for a file." (cl-defgeneric forge-get-url (obj) "Return the URL for a forge object.") +(cl-defmethod forge-get-url ((disc forge-discussion)) + (forge--format disc 'discussion-url-format)) + (cl-defmethod forge-get-url ((issue forge-issue)) (forge--format issue 'issue-url-format)) @@ -440,7 +461,9 @@ commit, and for a file." (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))))) @@ -448,6 +471,9 @@ commit, and for a file." (cl-defmethod forge-get-url ((notify forge-notification)) (oref notify url)) + ;; Transitional kludge for the infamous package.el defect. +(require 'forge-forgejo) + (cl-defmethod forge-format-blob-lines ((repo forge-repository) line end) (cl-etypecase repo ;Third-party classes require separate methods. ((or forge-github-repository @@ -481,6 +507,16 @@ 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 active topics for completion. With a prefix +argument offer all topics. While completion is in progress, \ +\\\\[forge-read-topic-lift-limit] lifts +the limitation to active topics." + (interactive (list (forge-read-discussion "View discussion"))) + (forge-topic-setup-buffer (forge-get-discussion discussion))) + ;;;###autoload (defun forge-visit-issue (issue) "Read an ISSUE and visit it. @@ -536,19 +572,40 @@ With prefix argument MENU, also show the topic menu." ;;; Create -(defun forge-create-issue () - "Create a new issue for the current repository." - (interactive) +(defun forge-create-discussion (category) + "Create a new discussion for the current repository." + (interactive + (list (forge-read-topic-category nil "Category for new discussion"))) (let* ((repo (forge-get-repository :tracked)) (buf (forge--prepare-post-buffer - "new-issue" - (forge--format repo "Create new issue on %p")))) + "new-discussion" + (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-issue)) + (setq forge--submit-post-function + (rpartial #'forge--submit-create-discussion category))) (forge--display-post-buffer buf)))) +(defun forge-create-issue () + "Create a new issue for the current repository." + (interactive) + (let* ((repo (forge-get-repository :tracked)) + (template (forge--topic-template repo 'forge-issue))) + (let-alist template + (pcase-exhaustive .type + ('redirect (browse-url .url)) + ('forge-discussion (forge-create-discussion .category)) + ('forge-issue + (when-let ((buf (forge--prepare-post-buffer + "new-issue" + (forge--format repo "Create new issue on %p") + nil nil template))) + (with-current-buffer buf + (setq forge--buffer-post-object repo) + (setq forge--submit-post-function #'forge--submit-create-issue)) + (forge--display-post-buffer buf))))))) + (defun forge-create-pullreq (source target) "Create a new pull-request for the current repository." (interactive (forge-create-pullreq--read-args)) @@ -556,7 +613,8 @@ With prefix argument MENU, also show the topic menu." (buf (forge--prepare-post-buffer "new-pullreq" (forge--format repo "Create new pull-request on %p") - source target))) + source target + (forge--topic-template repo 'forge-pullreq)))) (with-current-buffer buf (setq forge--buffer-base-branch target) (setq forge--buffer-head-branch source) @@ -619,22 +677,31 @@ point is currently on." (interactive (list current-prefix-arg)) (unless (derived-mode-p 'forge-topic-mode) (user-error "This command is only available from topic buffers")) - (let* ((topic forge-buffer-topic) - (buf (forge--prepare-post-buffer - (forge--format topic "%i;new-comment") - (forge--format topic "New comment on #%i of %p"))) - (quote (cond + (let* ((quote (cond ((not (magit-section-match 'post)) nil) ((use-region-p) - (buffer-substring-no-properties (region-beginning) - (region-end))) + (magit--buffer-string (region-beginning) (region-end))) (quote - (let ((section (magit-current-section))) - (string-trim-right - (buffer-substring-no-properties (oref section content) - (oref section end)))))))) + (with-slots (content end) (magit-current-section) + (magit--buffer-string content end t))))) + (obj (if (forge-discussion-p forge-buffer-topic) + (forge--select-discussion-reply-target) + forge-buffer-topic)) + (buf (cond + ((forge-discussion-post-p obj) + (forge--prepare-post-buffer + (forge--format obj "%i;%I;new-reply") + (forge--format obj "New comment on #%i;%I of %p"))) + ((forge-discussion-p obj) + (forge--prepare-post-buffer + (forge--format obj "%i;new-answer") + (forge--format obj "New comment on #%i of %p"))) + (t + (forge--prepare-post-buffer + (forge--format obj "%i;new-comment") + (forge--format obj "New comment on #%i of %p")))))) (with-current-buffer buf - (setq forge--buffer-post-object topic) + (setq forge--buffer-post-object obj) (setq forge--submit-post-function #'forge--submit-create-post) (when quote (goto-char (point-max)) @@ -643,6 +710,41 @@ point is currently on." (insert (replace-regexp-in-string "^" "> " quote) "\n\n"))) (forge--display-post-buffer buf))) +(transient-define-suffix forge-approve-pullreq () + "Approve the current pull-request." + :description "approve pull-request" + :inapt-if-not #'forge-current-pullreq + :transient nil + (interactive) + (let ((pullreq (forge-current-pullreq t))) + (unless (cl-typep (forge-get-repository pullreq) 'forge-github-repository) + (user-error "This command is only available for Github")) + (when-let ((buf (forge--prepare-post-buffer + (forge--format pullreq "%i;new-approval") + (forge--format pullreq "Approve pull-request #%i of %p")))) + (with-current-buffer buf + (setq forge--buffer-post-object pullreq) + (setq forge--submit-post-function #'forge--submit-approve-pullreq)) + (forge--display-post-buffer buf)))) + +(transient-define-suffix forge-request-changes () + "Request changes to the current pull-request." + :description "request changes" + :inapt-if-not #'forge-current-pullreq + :transient nil + (interactive) + (let ((pullreq (forge-current-pullreq t))) + (unless (cl-typep (forge-get-repository pullreq) 'forge-github-repository) + (user-error "This command is only available for Github")) + (when-let ((buf (forge--prepare-post-buffer + (forge--format pullreq "%i;new-request") + (forge--format + pullreq "Request changes for pull-request #%i of %p")))) + (with-current-buffer buf + (setq forge--buffer-post-object pullreq) + (setq forge--submit-post-function #'forge--submit-request-changes)) + (forge--display-post-buffer buf)))) + ;;; Edit (defun forge-edit-post () @@ -670,6 +772,7 @@ point is currently on." (transient-define-suffix forge-edit-topic-note () "Edit your private note about the current topic." :transient #'transient--do-quit-all + :inapt-if-not #'forge-current-topic :description (lambda () (if-let ((topic (forge-current-topic))) @@ -718,7 +821,7 @@ Please see the manual for more information." (if-let ((branch (forge--pullreq-branch-active pullreq))) (progn (message "Branch %S already exists and is configured" branch) branch) - (forge--branch-pullreq (forge-get-repository pullreq) pullreq) + (forge--branch-pullreq pullreq) (forge-refresh-buffer)))) (cl-defmethod forge--branch-pullreq ((pullreq forge-pullreq)) @@ -865,7 +968,7 @@ configure it first." (defun forge-checkout-worktree (path pullreq) "Create, configure and checkout a new worktree from a pull-request. This is like `forge-checkout-pullreq', except that it also -creates a new worktree. Please see the manual for more +creates a new worktree. Please see the manual for more information." (interactive (let ((id (forge-read-pullreq "Checkout pull request"))) @@ -975,24 +1078,26 @@ is configured to disallow that, you should instead merge locally and then push the target branch. Forges detect that you have done that and respond by automatically marking the pull-request as merged." - (interactive - (list (forge-read-pullreq "Merge pull-request") - (if (forge--childp (forge-get-repository :tracked) - 'forge-gitlab-repository) - (magit-read-char-case "Merge method " t - (?m "[m]erge" 'merge) - (?s "[s]quash" 'squash)) - (magit-read-char-case "Merge method " t - (?m "[m]erge" 'merge) - (?s "[s]quash" 'squash) - (?r "[r]ebase" 'rebase))))) + (declare (interactive-only nil)) + (interactive (list (forge-read-pullreq "Merge pull-request") + (forge-select-merge-method))) (let ((pullreq (forge-get-pullreq pullreq))) (forge--merge-pullreq (forge-get-repository pullreq) pullreq (magit-rev-hash (forge--pullreq-branch-internal pullreq)) - method)) - (forge-pull)) + method))) + +(defun forge-select-merge-method () + (if (forge--childp (forge-get-repository :tracked) + 'forge-gitlab-repository) + (magit-read-char-case "Merge method " t + (?m "[m]erge" 'merge) + (?s "[s]quash" 'squash)) + (magit-read-char-case "Merge method " t + (?m "[m]erge" 'merge) + (?s "[s]quash" 'squash) + (?r "[r]ebase" 'rebase)))) ;;;###autoload (defun forge-set-default-branch () @@ -1073,7 +1178,7 @@ Also update the upstream branches of local branches accordingly." :class 'magit--git-variable :variable "forge.graphqlItemLimit" :reader #'read-string - :default (lambda () (number-to-string ghub-graphql-items-per-request))) + :default (##number-to-string ghub-graphql-items-per-request)) (transient-define-suffix forge-toggle-display-in-status-buffer () "Toggle whether to display topics in the current status buffer." @@ -1130,7 +1235,7 @@ upstream remote." [:class transient-subgroups ;; Already tracked. - [:if (lambda () (forge--scope :tracked)) + [:if (##forge--scope :tracked) (:info* (lambda () (format @@ -1139,7 +1244,7 @@ upstream remote." :format "%d")] ;; Nothing to tracked. - [:if-not (lambda () (forge--scope 'topdir)) + [:if-not (##forge--scope 'topdir) (:info* (lambda () (format @@ -1148,7 +1253,7 @@ upstream remote." :format "%d")] ;; Cannot track. - [:if (lambda () (and (not (forge--scope 'repo)) (forge--scope 'topdir))) + [:if (##and (not (forge--scope 'repo)) (forge--scope 'topdir)) :description (lambda () (concat @@ -1171,7 +1276,7 @@ upstream remote." (lambda () (interactive) (info "(forge)Setup a Partially Supported Host")))] ;; Track it! - [:if (lambda () (forge--scope :untracked)) + [:if (##forge--scope :untracked) :description (lambda () (format @@ -1310,18 +1415,35 @@ This may take a while. Only Github is supported at the moment." ;;;###autoload (defun forge-remove-topic-locally (topic) "Remove a topic from the local database only. -Due to how the supported APIs work, it would be too expensive to -automatically remove topics from the local database that were -removed from the forge. The purpose of this command is to allow -you to manually clean up the local database." - (interactive (list (forge-read-topic "Delete topic LOCALLY only"))) - (setq topic (forge-get-topic topic)) - (closql-delete topic) - (if (and (derived-mode-p 'forge-topic-mode) - (eq (oref topic id) - (oref forge-buffer-topic id))) - (kill-buffer (current-buffer)) - (forge-refresh-buffer))) + +When the region marks multiple topics, then offer to remove them all. + +The topic is not removed from the forge and, if it is later modified, +then it will be added to the database again when fetching all topics. + +This is useful for users who only fetch individual topics and want to +remove the topics they are no longer interested in. This can also be +used to remove topics locally, which have already been removed on the +forge (the service). Forge (the package) cannot automatically detect +when that happens, because given how the APIs work, this would be too +expensive." + (interactive + (list (if-let* ((topics (magit-region-values '(issue pullreq) t)) + ((magit-confirm 'remove-topics-locally nil + "Delete %d topics locally" nil + (mapcar #'forge--format-topic-line topics)))) + topics + (forge-read-topic "Delete topic LOCALLY only")))) + (if (listp topic) + (progn (mapc #'closql-delete topic) + (forge-refresh-buffer)) + (setq topic (forge-get-topic topic)) + (closql-delete topic) + (if (and (derived-mode-p 'forge-topic-mode) + (equal (oref topic id) + (oref forge-buffer-topic id))) + (kill-buffer (current-buffer)) + (forge-refresh-buffer)))) ;;;###autoload (defun forge-reset-database () @@ -1339,9 +1461,41 @@ heavy development." ;;; Miscellaneous +(defun forge-mark-completed-topics-as-done () + "Mark completed topics of the current repository as done. +Change the private status to \"done\" for topics whose private status is +\"unread\" or \"pending\" and whose public state is \"completed\". +Whether this affects all such topics or only all such topics of a +certain type (discussion, issue or pull-request), depends on the +context." + (interactive) + (let* ((type (forge-current-topic-type)) + (desc (if (eq type 'pullreq) 'pull-request type)) + (topics (forge--list-topics + (forge--topics-spec :type type + :active nil + :state 'closed + :status 'inbox) + (forge-get-repository :tracked)))) + (cond ((not topics) + (message "No completed %s that could be marked as done" desc)) + ((magit-confirm t + "Mark \"%s\" as done" + (format "Mark %%d %ss as done" desc) + nil + (mapcar #'forge--format-topic-line topics)) + (dolist (topic topics) + (oset topic status 'done)) + (forge-refresh-buffer))))) + (magit-define-section-jumper forge-jump-to-pullreqs "Pull requests" pullreqs) (magit-define-section-jumper forge-jump-to-issues "Issues" issues) ;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("partial" . "llama--left-apply-partially") +;; ("rpartial" . "llama--right-apply-partially")) +;; End: (provide 'forge-commands) ;;; forge-commands.el ends here diff --git a/elpa/forge-20250108.2134/forge-core.el b/elpa/forge-20250516.1009/forge-core.el similarity index 92% rename from elpa/forge-20250108.2134/forge-core.el rename to elpa/forge-20250516.1009/forge-core.el index 3737289f..5086adaf 100644 --- a/elpa/forge-20250108.2134/forge-core.el +++ b/elpa/forge-20250516.1009/forge-core.el @@ -26,8 +26,8 @@ (require 'cl-lib) (require 'compat) -(require 'dash) (require 'eieio) +(require 'llama) (require 'seq) (require 'subr-x) @@ -36,10 +36,12 @@ (require 'forge-db) (eval-when-compile + (cl-pushnew 'forge-id eieio--known-slot-names) (cl-pushnew 'id eieio--known-slot-names) (cl-pushnew 'name eieio--known-slot-names) (cl-pushnew 'number eieio--known-slot-names) (cl-pushnew 'owner eieio--known-slot-names) + (cl-pushnew 'their-id eieio--known-slot-names) (cl-pushnew 'worktree eieio--known-slot-names)) ;;; Options @@ -289,22 +291,38 @@ is non-nil." &optional stub noerror) "Return the database and forge ids for the specified CLASS object.") +(defun forge--their-id (id/obj) + "Return the forge's id for the ID used in the local database." + (cond + ((stringp id/obj) + (car (last (split-string (base64-decode-string id/obj) ":")))) + ((slot-exists-p id/obj 'their-id) + (oref id/obj their-id)) + ((slot-exists-p id/obj 'forge-id) + (oref id/obj forge-id)) + ((forge--their-id (oref id/obj id))))) + (cl-defmethod magit-section-ident-value ((obj forge-object)) "Return the value ob OBJ's `id' slot. Using OBJ itself would not be appropriate because multiple non-equal objects may exist, representing the same thing." (oref obj id)) -(defun forge--set-id-slot (repo object slot rows) - "Set the value in OBJECT for SLOT to VALUE, actually storing foreign keys." - ;; TODO Should CloSQL advice `oset' to make this unnecessary? - (let ((repo-id (oref repo id))) - (closql-oset - object slot - (mapcar (lambda (val) - (forge--object-id repo-id - (if (atom val) val (alist-get 'id val)))) - rows)))) +(defun forge--set-connections (repo object slot list) + (closql-dset object slot + (let ((rid (oref repo id))) + (mapcar (lambda (value) + (forge--object-id + rid + (if (atom value) + ;; For Gitlab labels we unfortunately only + ;; get a string, the ambiguous name of the + ;; label. See also the comment in the + ;; Gitlab `forge--update-labels' method. + value + (alist-get 'id value)))) + list)) + t)) ;;; Format @@ -409,5 +427,10 @@ the mode requirement." (substring rnd 20 32)))) ;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("partial" . "llama--left-apply-partially") +;; ("rpartial" . "llama--right-apply-partially")) +;; End: (provide 'forge-core) ;;; forge-core.el ends here diff --git a/elpa/forge-20250108.2134/forge-db.el b/elpa/forge-20250516.1009/forge-db.el similarity index 74% rename from elpa/forge-20250108.2134/forge-db.el rename to elpa/forge-20250516.1009/forge-db.el index f4acb7f9..5767240e 100644 --- a/elpa/forge-20250108.2134/forge-db.el +++ b/elpa/forge-20250516.1009/forge-db.el @@ -34,8 +34,8 @@ (declare-function forge-get-repository "forge-core" (demand)) (eval-when-compile - (cl-pushnew 'number eieio--known-slot-names) - (cl-pushnew 'value eieio--known-slot-names)) + (cl-pushnew 'milestone eieio--known-slot-names) ; forge-{issue,pullreq} + (cl-pushnew 'number eieio--known-slot-names)) ; forge-{issue,pullreq,...} ;;; Options @@ -53,7 +53,7 @@ (object-class :initform 'forge-repository) (file :initform 'forge-database-file) (schemata :initform 'forge--db-table-schemata) - (version :initform 13))) + (version :initform 15))) (defvar forge--override-connection-class nil) @@ -65,6 +65,9 @@ (emacsql (forge-db) (apply #'format sql args)) (apply #'emacsql (forge-db) sql args))) +(defun forge-sql-car (sql &rest args) + (mapcar #'car (apply #'forge-sql sql args))) + (defun forge-sql-cdr (sql &rest args) (mapcar #'cdr (apply #'forge-sql sql args))) @@ -122,6 +125,11 @@ (milestones :default eieio-unbound) issues-until pullreqs-until + teams + (discussion-categories :default eieio-unbound) + (discussions :default eieio-unbound) + discussions-p + discussions-until ]) (assignee @@ -129,11 +137,112 @@ (id :not-null :primary-key) login name - forge-id] ; Needed for Gitlab. + forge-id] (:foreign-key [repository] :references repository [id] :on-delete :cascade)) + (discussion + [(class :not-null) + (id :not-null :primary-key) + repository + number + answer + state + author + title + created + updated + closed + status + locked-p + category + body + (cards :default eieio-unbound) + (edits :default eieio-unbound) + (labels :default eieio-unbound) + (participants :default eieio-unbound) + (posts :default eieio-unbound) + (reactions :default eieio-unbound) + (timeline :default eieio-unbound) + (marks :default eieio-unbound) + note + their-id + slug + saved-p] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (discussion-category + [(repository :not-null) + (id :not-null :primary-key) + their-id + 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) + their-id + 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) + their-id + 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) @@ -377,40 +486,40 @@ :on-delete :cascade)))) (cl-defmethod closql--db-update-schema ((db forge-database)) - (let ((code-version (oref-default 'forge-database version)) - (version (closql--db-get-version db))) - (when (< version code-version) - (forge--backup-database db)) - (closql-with-transaction db - (when (= version 2) - (message "Upgrading Forge database from version 2 to 3...") + (let ((version (closql--db-get-version db))) + (when (< version (oref-default 'forge-database version)) + (forge--backup-database db) + (closql-with-transaction db + (forge--db-update-schema db version))) + (cl-call-next-method))) + +(defun forge--db-update-schema (db version) + (cl-macrolet + ((up (to &rest body) + `(when (= (1+ version) ,to) + (message "Upgrading Forge database from version %s to %s..." + version ,to) + ,@body + (closql--db-set-version db ,to) + (message "Upgrading Forge database from version %s to %s...done" + version ,to) + (setq version ,to)))) + (up 3 (emacsql db [:create-table pullreq-review-request $S1] - (cdr (assq 'pullreq-review-request forge--db-table-schemata))) - (closql--db-set-version db (setq version 3)) - (message "Upgrading Forge database from version 2 to 3...done")) - (when (= version 3) - (message "Upgrading Forge database from version 3 to 4...") + (cdr (assq 'pullreq-review-request forge--db-table-schemata)))) + (up 4 (emacsql db [:drop-table notification]) (pcase-dolist (`(,table . ,schema) forge--db-table-schemata) (when (memq table '(notification mark issue-mark pullreq-mark)) (emacsql db [:create-table $i1 $S2] table schema))) (emacsql db [:alter-table issue :add-column marks :default $s1] 'eieio-unbound) - (emacsql db [:alter-table pullreq :add-column marks :default $s1] 'eieio-unbound) - (closql--db-set-version db (setq version 4)) - (message "Upgrading Forge database from version 3 to 4...done")) - (when (= version 4) - (message "Upgrading Forge database from version 4 to 5...") - (emacsql db [:alter-table repository :add-column selective-p :default nil]) - (closql--db-set-version db (setq version 5)) - (message "Upgrading Forge database from version 4 to 5...done")) - (when (= version 5) - (message "Upgrading Forge database from version 5 to 6...") - (emacsql db [:alter-table repository :add-column worktree :default nil]) - (closql--db-set-version db (setq version 6)) - (message "Upgrading Forge database from version 5 to 6...done")) - (when (= version 6) - (message "Upgrading Forge database from version 6 to 7...") + (emacsql db [:alter-table pullreq :add-column marks :default $s1] 'eieio-unbound)) + (up 5 + (emacsql db [:alter-table repository :add-column selective-p :default nil])) + (up 6 + (emacsql db [:alter-table repository :add-column worktree :default nil])) + (up 7 (emacsql db [:alter-table issue :add-column note :default nil]) (emacsql db [:alter-table pullreq :add-column note :default nil]) (emacsql db [:create-table milestone $S1] @@ -430,24 +539,15 @@ :where (notnull milestone)])) (unless (stringp milestone) (oset (forge-get-pullreq pullreq-id) milestone - (forge--object-id repo-id (cdar milestone))))) - (closql--db-set-version db (setq version 7)) - (message "Upgrading Forge database from version 6 to 7...done")) - (when (= version 7) - (message "Upgrading Forge database from version 7 to 8...") + (forge--object-id repo-id (cdar milestone)))))) + (up 8 (emacsql db [:alter-table pullreq :add-column base-rev :default nil]) (emacsql db [:alter-table pullreq :add-column head-rev :default nil]) - (emacsql db [:alter-table pullreq :add-column draft-p :default nil]) - (closql--db-set-version db (setq version 8)) - (message "Upgrading Forge database from version 7 to 8...done")) - (when (= version 8) - (message "Upgrading Forge database from version 8 to 9...") + (emacsql db [:alter-table pullreq :add-column draft-p :default nil])) + (up 9 (emacsql db [:alter-table pullreq :add-column their-id :default nil]) - (emacsql db [:alter-table issue :add-column their-id :default nil]) - (closql--db-set-version db (setq version 9)) - (message "Upgrading Forge database from version 8 to 9...done")) - (when (= version 9) - (message "Upgrading Forge database from version 9 to 10...") + (emacsql db [:alter-table issue :add-column their-id :default nil])) + (up 10 (emacsql db [:alter-table pullreq :add-column slug :default nil]) (emacsql db [:alter-table issue :add-column slug :default nil]) (pcase-dolist (`(,id ,number ,type) @@ -468,22 +568,16 @@ (emacsql db [:select [id number] :from issue])) (emacsql db [:update issue :set (= slug $s1) :where (= id $s2)] (format "#%s" number) - id)) - (closql--db-set-version db (setq version 10)) - (message "Upgrading Forge database from version 9 to 10...done")) - (when (= version 10) - (message "Upgrading Forge database from version 10 to 11...") + id))) + (up 11 (emacsql db [:drop-table notification]) (emacsql db [:create-table notification $S1] (cdr (assq 'notification forge--db-table-schemata))) (emacsql db [:alter-table pullreq :rename-column unread-p :to status]) (emacsql db [:alter-table issue :rename-column unread-p :to status]) (emacsql db [:alter-table pullreq :add-column saved-p :default nil]) - (emacsql db [:alter-table issue :add-column saved-p :default nil]) - (closql--db-set-version db (setq version 11)) - (message "Upgrading Forge database from version 10 to 11...done")) - (when (= version 11) - (message "Upgrading Forge database from version 11 to 12...") + (emacsql db [:alter-table issue :add-column saved-p :default nil])) + (up 12 (emacsql db [:drop-table notification]) (emacsql db [:create-table notification $S1] (cdr (assq 'notification forge--db-table-schemata))) @@ -500,11 +594,8 @@ (emacsql db [:update pullreq :set (= state 'done) :where (= id $s1)] id)) (emacsql db [:alter-table repository :add-column issues-until :default nil]) - (emacsql db [:alter-table repository :add-column pullreqs-until :default nil]) - (closql--db-set-version db (setq version 12)) - (message "Upgrading Forge database from version 11 to 12...done")) - (when (= version 12) - (message "Upgrading Forge database from version 12 to 13...") + (emacsql db [:alter-table repository :add-column pullreqs-until :default nil])) + (up 13 (dolist (id (emacsql db [:select id :from repository :where (isnull issues-until)])) (emacsql @@ -531,11 +622,31 @@ (emacsql db [:update repository :set (= condition $s1) :where (= id $s2)] (if not-tracked :known :tracked) - id)) - (closql--db-set-version db (setq version 13)) - (message "Upgrading Forge database from version 12 to 13...done")) - ) - (cl-call-next-method))) + id))) + (up 14 + (emacsql db [:alter-table repository :add-column teams :default nil])) + (up 15 + (emacsql db [:create-table discussion $S1] + (cdr (assq 'discussion forge--db-table-schemata))) + (emacsql db [:create-table discussion-category $S1] + (cdr (assq 'discussion-category 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)))) + (emacsql db [:alter-table repository :add-column discussion-categories + :default 'eieio-unbound]) + (emacsql db [:alter-table repository :add-column discussions + :default 'eieio-unbound]) + (emacsql db [:alter-table repository :add-column discussions-p + :default nil]) + (emacsql db [:alter-table repository :add-column discussions-until + :default nil]) + )) (defun forge--backup-database (db) (let ((dst (concat (file-name-sans-extension forge-database-file) @@ -548,5 +659,10 @@ (message "Copying Forge database to %s...done" dst))) ;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("partial" . "llama--left-apply-partially") +;; ("rpartial" . "llama--right-apply-partially")) +;; End: (provide 'forge-db) ;;; forge-db.el ends here diff --git a/elpa/forge-20250516.1009/forge-discussion.el b/elpa/forge-20250516.1009/forge-discussion.el new file mode 100644 index 00000000..25b4400c --- /dev/null +++ b/elpa/forge-20250516.1009/forge-discussion.el @@ -0,0 +1,278 @@ +;;; forge-discussion.el --- Discussion support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2025 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) + (repository :initarg :repository) + (number :initarg :number) + (answer :initarg :answer) + (state :initarg :state) + (author :initarg :author) + (title :initarg :title) + (created :initarg :created) + (updated :initarg :updated) + (closed :initarg :closed) + (status :initarg :status :initform nil) + (locked-p :initarg :locked-p :initform nil) + (category :initarg :category) + (body :initarg :body) + (project-cards) ; projectsCards + (edits) ; userContentEdits + (labels :closql-tables (discussion-label label)) + (participants) + (posts :closql-class forge-discussion-post) + (reactions) + (timeline) + (marks :closql-tables (discussion-mark mark)) + (note :initarg :note :initform nil) + (their-id :initarg :their-id) + (slug :initarg :slug) + (saved-p :initarg :saved-p :initform nil) + )) + +(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) + (their-id :initarg :their-id) + (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) + (their-id :initarg :their-id) + (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 ((disc forge-discussion)) + disc) + +(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 :tracked nil 'notatpt))) + (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-chatter (&optional demand) + "Return the discussion or issue at point or being visited. +If there is no such discussion or issue and DEMAND is non-nil, then +signal an error." + (or (forge-discussion-at-point) + (forge-issue-at-point) + (and (or (forge-discussion-p forge-buffer-topic) + (forge-issue-p forge-buffer-topic)) + forge-buffer-topic) + (and demand (user-error "No current discussion or issue")))) + +(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 (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 demand (user-error "No discussion at point")))) + +(put 'forge-discussion 'thing-at-point #'forge-thingatpt--discussion) +(defun forge-thingatpt--discussion () + (and-let* (((thing-at-point-looking-at "#\\([0-9]+\\)\\_>")) + (number (string-to-number (match-string 1))) + (repo (forge--repo-for-thingatpt))) + (forge-get-discussion repo number))) + +;;; Read + +(defun forge-read-discussion (prompt) + "Read an active discussion with completion using PROMPT. + +Open, unread and pending discussions are considered active. +Default to the current discussion, even if it isn't active. + +\\While completion is in \ +progress, \\[forge-read-topic-lift-limit] lifts the limit, extending +the completion candidates to include all discussions. + +If `forge-limit-topic-choices' is nil, then all candidates +can be selected from the start." + (forge--read-topic prompt + #'forge-current-discussion + (forge--topics-spec :type 'discussion :active t) + (forge--topics-spec :type 'discussion :active nil :state nil))) + +(defun forge-read-topic-category (&optional topic prompt) + (magit-completing-read + (or prompt "Category") + (mapcar #'caddr + (oref (forge-get-repository (or topic :tracked)) + discussion-categories)) + nil t + (and topic (forge--format-topic-category topic)))) + +(defun forge--select-discussion-answer (topic) + (if-let ((post (forge-post-at-point))) + (cond ((forge-discussion-p (forge-post-at-point)) + (user-error "Cannot pick the question as its own answer")) + ((and-let* ((answer (oref topic answer))) + (equal (oref post their-id) + (forge--their-id answer))) + nil) + (post)) + (user-error "Point must be on an reply to mark it as the answer"))) + +(defun forge--select-discussion-reply-target () + (if-let ((answers (oref forge-buffer-topic posts))) + (let* ((format-answer + (lambda (answer) + (let ((text (oref answer body))) + (save-match-data + (cons (format "Reply to answer %S" + (if (string-match "\n" text) + (substring text 0 (match-beginning 0)) + text)) + answer))))) + (post (forge-post-at-point)) + (answer (if (forge-discussion-reply-p post) + (magit-section-parent-value + (magit-current-section)) + post)) + (default (and answer (funcall format-answer answer))) + (choices `(("Add new top-level answer" . ,forge-buffer-topic) + ,@(mapcar format-answer answers)))) + (cdr (assoc (magit-completing-read "Reply to: " + choices nil t nil nil default) + choices))) + forge-buffer-topic)) + +;;; Insert + +(defvar-keymap forge-discussions-section-map + " " #'forge-browse-discussions + " " #'forge-list-discussions + " " #'forge-topics-menu + " " #'forge-topic-menu + "C-c C-n" #'forge-create-discussion) + +(defvar-keymap forge-discussion-section-map + :parent forge-common-map + " " #'forge-visit-this-topic + " " #'forge-topics-menu + " " #'forge-topic-menu) + +(cl-defun forge-insert-discussions (&optional (spec nil sspec) heading) + "Insert a list of discussions, according to `forge--buffer-topics-spec'. +Optional SPEC can be used to override that filtering specification, +and optional HEADING to change the section heading." + (when-let (((forge-db t)) + (repo (forge-get-repository :tracked?)) + ((oref repo discussions-p)) + (spec (if sspec spec (forge--clone-buffer-topics-spec))) + ((memq (oref spec type) '(topic discussion)))) + (oset spec type 'discussion) + (forge--insert-topics 'discussions + (or heading "Discussions") + (forge--list-topics spec repo)))) + +;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("partial" . "llama--left-apply-partially") +;; ("rpartial" . "llama--right-apply-partially")) +;; End: +(provide 'forge-discussion) +;;; forge-discussion.el ends here diff --git a/elpa/forge-20250108.2134/forge-forgejo.el b/elpa/forge-20250516.1009/forge-forgejo.el similarity index 100% rename from elpa/forge-20250108.2134/forge-forgejo.el rename to elpa/forge-20250516.1009/forge-forgejo.el diff --git a/elpa/forge-20250108.2134/forge-gitea.el b/elpa/forge-20250516.1009/forge-gitea.el similarity index 100% rename from elpa/forge-20250108.2134/forge-gitea.el rename to elpa/forge-20250516.1009/forge-gitea.el diff --git a/elpa/forge-20250108.2134/forge-github.el b/elpa/forge-20250516.1009/forge-github.el similarity index 55% rename from elpa/forge-20250108.2134/forge-github.el rename to elpa/forge-20250516.1009/forge-github.el index 9daf9587..a255baee 100644 --- a/elpa/forge-20250108.2134/forge-github.el +++ b/elpa/forge-20250516.1009/forge-github.el @@ -25,25 +25,29 @@ (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") - (blob-url-format :initform "https://%h/%o/%n/blob/%r/%f") - (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/discussions/%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") + (blob-url-format :initform "https://%h/%o/%n/blob/%r/%f") + (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 @@ -67,21 +71,26 @@ (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 ((oref repo selective-p)) (callback (funcall callback)) ((forge--maybe-git-fetch repo buf)))) - `((issues-until . ,(or since (oref repo issues-until))) + ;; Keys have the form `FIELD-until', where FIELD is the name of a + ;; field of Repository objects. See `ghub--graphql-walk-response'. + `((discussions-until . ,(or since (oref repo discussions-until))) + (issues-until . ,(or since (oref repo issues-until))) (pullRequests-until . ,(or since (oref repo pullreqs-until)))) :host (oref repo apihost) :auth 'forge @@ -102,13 +111,15 @@ (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))) + (oset repo watchers .watchers.totalCount) + (oset repo teams (mapcar #'cdar .owner.teams)))) (cl-defmethod forge--update-revnotes ((repo forge-github-repository) data) (closql-with-transaction (forge-db) - (mapc (apply-partially #'forge--update-revnote repo) data))) + (mapc (##forge--update-revnote repo %) data))) (cl-defmethod forge--update-revnote ((repo forge-github-repository) data) (closql-with-transaction (forge-db) @@ -176,6 +187,19 @@ .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) + .id + .name + .emoji + .isAnswerable + .description))) + (delete-dups data))))) + ;;;; Topics (cl-defmethod forge--pull-topic ((repo forge-github-repository) @@ -184,11 +208,35 @@ (forge--pull-topic repo (forge-issue :repository id :number number) - :errorback (lambda (err _headers _status _req) - (when (equal (cdr (assq 'type (cadr err))) "NOT_FOUND") - (forge--pull-topic - repo - (forge-pullreq :repository id :number number))))))) + :errorback + (lambda (err _headers _status _req) + (when (equal (cdr (assq 'type (cadr err))) "NOT_FOUND") + (forge--pull-topic + repo + (forge-pullreq :repository id :number number) + :errorback + (lambda (err _headers _status _req) + (when (equal (cdr (assq 'type (cadr err))) "NOT_FOUND") + (forge--pull-topic + repo + (forge-discussion :repository id :number number)))))))))) + +(cl-defmethod forge--pull-topic ((repo forge-github-repository) + (topic forge-discussion) + &key callback errorback) + (let ((buffer (current-buffer))) + (ghub-fetch-discussion + (oref repo owner) + (oref repo name) + (oref topic number) + (lambda (data) + (forge--update-discussion repo data) + (forge-refresh-buffer buffer) + (when callback (funcall callback))) + nil + :host (oref repo apihost) + :auth 'forge + :errorback errorback))) (cl-defmethod forge--pull-topic ((repo forge-github-repository) (topic forge-issue) @@ -229,32 +277,119 @@ (let-alist data (let ((updated (or .updatedAt .createdAt)) (current-status (oref topic status))) - (cond ((not .isReadByViewer) - (oset topic status 'unread)) - (initial-pull - (oset topic status 'done)) - ((null current-status) - (oset topic status 'pending)) - ((string> updated (oref topic updated)) - (oset topic status 'pending))) + (if (forge-discussion-p topic) + ;; Discussions lack `isReadByViewer'. + (cond (initial-pull + (oset topic status 'done)) + ((null current-status) + (oset topic status 'unread)) + ((string> updated (oref topic updated)) + (oset topic status 'unread))) + (cond ((not .isReadByViewer) + (oset topic status 'unread)) + (initial-pull + (oset topic status 'done)) + ((null current-status) + (oset topic status 'pending)) + ((string> updated (oref topic updated)) + (oset topic status 'pending)))) (oset topic updated updated) (when bump - (let* ((slot (if (forge-issue-p topic) 'issues-until 'pullreqs-until)) + (let* ((slot (cl-typecase topic + (forge-discussion 'discussions-until) + (forge-issue 'issues-until) + (forge-pullreq 'pullreqs-until))) (until (eieio-oref repo slot))) (when (or (not until) (string> updated until)) (eieio-oset repo slot updated))))))) +;;;; Discussions + +(cl-defmethod forge--update-discussions ((repo forge-github-repository) data bump) + (closql-with-transaction (forge-db) + (let ((initial-pull (not (oref repo discussions-until)))) + (dolist (elt data) + (forge--update-discussion repo elt bump initial-pull))))) + +(cl-defmethod forge--update-discussion ((repo forge-github-repository) data + &optional bump initial-pull) + (let ((repo-id (oref repo id)) + discussion-id discussion) + (let-alist data + (closql-with-transaction (forge-db) + (setq discussion-id (forge--object-id 'forge-discussion repo .number)) + (setq discussion (or (forge-get-discussion repo .number) + (closql-insert + (forge-db) + (forge-discussion :id discussion-id + :repository repo-id + :number .number)))) + (oset discussion their-id .id) + (oset discussion slug (format "#%s" .number)) + (oset discussion author .author.login) + (oset discussion title .title) + (oset discussion created .createdAt) + (oset discussion closed .closedAt) + (oset discussion locked-p .locked) + (oset discussion category (forge--object-id repo-id .category.id)) + (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 + ("RESOLVED" 'completed) ;sic + ("DUPLICATE" 'duplicate) + ("OUTDATED" 'outdated) + ("REOPENED" 'open) + ('nil 'open))) + (dolist (p .comments) + (let-alist p + (let ((post-id (forge--object-id discussion-id .databaseId))) + (closql-insert + (forge-db) + (forge-discussion-post + :id post-id + :their-id .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) + :their-id .id + :number .databaseId + :post post-id + :discussion discussion-id + :author .author.login + :created .createdAt + :updated .updatedAt + :body (forge--sanitize-string .body)) + t)))))) + (forge--update-status repo discussion data bump initial-pull)) + (forge--set-connections repo discussion 'labels .labels) + discussion))) + ;;;; Issues (cl-defmethod forge--update-issues ((repo forge-github-repository) data &optional bump) (closql-with-transaction (forge-db) (let ((initial-pull (not (oref repo issues-until)))) - (mapc (lambda (e) (forge--update-issue repo e bump initial-pull)) data)))) + (dolist (elt data) + (forge--update-issue repo elt bump initial-pull))))) (cl-defmethod forge--update-issue ((repo forge-github-repository) data &optional bump initial-pull) - (let (issue-id issue) + (let ((repo-id (oref repo id)) + issue-id issue) (let-alist data (closql-with-transaction (forge-db) (setq issue-id (forge--object-id 'forge-issue repo .number)) @@ -262,24 +397,23 @@ (closql-insert (forge-db) (forge-issue :id issue-id - :repository (oref repo id) + :repository repo-id :number .number)))) (oset issue their-id .id) (oset issue slug (format "#%s" .number)) (oset issue state (pcase-exhaustive (list .stateReason .state) - (`("COMPLETED" ,_) 'completed) - (`("NOT_PLANNED" ,_) 'unplanned) - (`(,_ "CLOSED") 'completed) - (`(,_ "OPEN") 'open))) + ('("COMPLETED" "CLOSED") 'completed) + ('("NOT_PLANNED" "CLOSED") 'unplanned) + ('("DUPLICATE" "CLOSED") 'duplicate) + ('("REOPENED" "OPEN") 'open) + ('(nil "OPEN") 'open))) (oset issue author .author.login) (oset issue title .title) (oset issue created .createdAt) (oset issue closed .closedAt) (oset issue locked-p .locked) - (oset issue milestone (and .milestone.id - (forge--object-id (oref repo id) - .milestone.id))) + (oset issue milestone (forge--object-id repo-id .milestone.id)) (oset issue body (forge--sanitize-string .body)) (dolist (c .comments) (let-alist c @@ -295,11 +429,8 @@ :body (forge--sanitize-string .body)) t))) (forge--update-status repo issue data bump initial-pull)) - (ignore-errors - (forge--set-id-slot repo issue 'assignees .assignees)) - (ignore-errors - (unless (magit-get-boolean "forge.kludge-for-issue-294") - (forge--set-id-slot repo issue 'labels .labels)))) + (forge--set-connections repo issue 'assignees .assignees) + (forge--set-connections repo issue 'labels .labels)) issue)) ;;;; Pullreqs @@ -308,11 +439,13 @@ &optional bump) (closql-with-transaction (forge-db) (let ((initial-pull (not (oref repo pullreqs-until)))) - (mapc (lambda (e) (forge--update-pullreq repo e bump initial-pull)) data)))) + (dolist (elt data) + (forge--update-pullreq repo elt bump initial-pull))))) (cl-defmethod forge--update-pullreq ((repo forge-github-repository) data &optional bump initial-pull) - (let (pullreq-id pullreq) + (let ((repo-id (oref repo id)) + pullreq-id pullreq) (let-alist data (closql-with-transaction (forge-db) (setq pullreq-id (forge--object-id 'forge-pullreq repo .number)) @@ -320,7 +453,7 @@ (closql-insert (forge-db) (forge-pullreq :id pullreq-id - :repository (oref repo id) + :repository repo-id :number .number)))) (oset pullreq their-id .id) (oset pullreq slug (format "#%s" .number)) @@ -344,9 +477,7 @@ (oset pullreq head-rev .headRefOid) (oset pullreq head-user .headRef.repository.owner.login) (oset pullreq head-repo .headRef.repository.nameWithOwner) - (oset pullreq milestone (and .milestone.id - (forge--object-id (oref repo id) - .milestone.id))) + (oset pullreq milestone (forge--object-id repo-id .milestone.id)) (oset pullreq body (forge--sanitize-string .body)) (dolist (p .comments) (let-alist p @@ -362,15 +493,11 @@ :body (forge--sanitize-string .body)) t))) (forge--update-status repo pullreq data bump initial-pull)) - (ignore-errors - (forge--set-id-slot repo pullreq 'assignees .assignees)) - (ignore-errors - (forge--set-id-slot repo pullreq 'review-requests - (--map (cdr (cadr (car it))) - .reviewRequests))) - (ignore-errors - (unless (magit-get-boolean "forge.kludge-for-issue-294") - (forge--set-id-slot repo pullreq 'labels .labels)))) + (forge--set-connections repo pullreq 'assignees .assignees) + (forge--set-connections repo pullreq 'review-requests + (mapcar (##alist-get 'requestedReviewer %) + .reviewRequests)) + (forge--set-connections repo pullreq 'labels .labels)) pullreq)) ;;;; Notifications @@ -379,7 +506,8 @@ ((_class (subclass forge-github-repository)) githost &optional callback) ;; The GraphQL API doesn't support notifications and support in the ;; REST API is abysmal -- forcing us to perform a major rain dance. - (let ((spec (forge--get-forge-host githost t))) + (let ((buffer (current-buffer)) + (spec (forge--get-forge-host githost t))) (forge--msg nil t nil "Pulling notifications") (pcase-let* ((`(,_ ,apihost ,forge ,_) spec) @@ -396,7 +524,7 @@ `((all . t) ,@(and since `((since . ,since)))) :host apihost :unpaginate t))) ;; Split into multiple requests to reduce risk of timeouts. - (groups (-partition-all 50 notifs)) + (groups (seq-partition notifs 50)) (pages (length groups)) (page 0) (topics nil)) @@ -430,9 +558,8 @@ (intern (cadr (assq 'path err))))) (cdr errors)))) (progn - (setq query (cl-delete-if - (lambda (e) (memq e notfound)) - query :key #'caar)) + (setq query (cl-delete-if (##memq % notfound) + query :key #'caar)) (funcall vacuum)) (ghub--signal-error errors))))) (cl-incf page) @@ -443,6 +570,7 @@ (forge--msg nil t nil "Storing notifications") (forge--ghub-update-notifications notifs topics (not since)) (forge--msg nil t t "Storing notifications") + (forge-refresh-buffer buffer) (when callback (funcall callback))))) (cb))))) @@ -458,43 +586,56 @@ (defun forge--ghub-massage-notification (data githost) (let-alist data (let* ((type (intern (downcase .subject.type))) - (type (if (eq type 'pullrequest) 'pullreq type))) - (and (memq type '(pullreq issue)) - (let* ((number (and (string-match "[0-9]*\\'" .subject.url) - (string-to-number (match-string 0 .subject.url)))) - (repo (forge-get-repository - (list githost - .repository.owner.login - .repository.name) - nil :insert!)) - (repoid (oref repo id)) - (owner (oref repo owner)) - (name (oref repo name)) - (id (forge--object-id repoid (string-to-number .id))) - (alias (intern (concat "_" (string-replace "=" "_" id))))) - (list alias id - `((,alias repository) - [(name ,name) - (owner ,owner)] - ,@(cddr - (caddr - (ghub--graphql-prepare-query - ghub-fetch-repository - (if (eq type 'issue) - `(repository issues (issue . ,number)) - `(repository pullRequest (pullRequest . ,number))) - )))) - repo type data)))))) + (type (if (eq type 'pullrequest) 'pullreq type)) + (_ (unless (memq type '( discussion issue pullreq + commit release)) + (error "BUG: New unsupported notification type: %s" type))) + (number-or-commit (and .subject.url + (string-match "[^/]*\\'" .subject.url) + (match-string 0 .subject.url))) + (number (and (memq type '(discussion issue pullreq)) + (string-to-number number-or-commit))) + (repo (forge-get-repository + (list githost + .repository.owner.login + .repository.name) + nil :insert!)) + (repoid (oref repo id)) + (owner (oref repo owner)) + (name (oref repo name)) + (id (forge--object-id repoid (string-to-number .id))) + (alias (intern (concat "_" (string-replace "=" "_" id))))) + (and number + (list alias id + `((,alias repository) + [(name ,name) + (owner ,owner)] + ,@(cddr + (caddr + (ghub--graphql-prepare-query + ghub-fetch-repository + (pcase type + ('discussion `(repository + discussions + (discussion . ,number))) + ('issue `(repository + issues + (issue . ,number))) + ('pullreq `(repository + pullRequest + (pullRequest . ,number)))))))) + repo type data))))) (defun forge--ghub-update-notifications (notifs topics initial-pull) (closql-with-transaction (forge-db) - (pcase-dolist (`(,alias ,id ,_ ,repo ,type ,data) notifs) + (pcase-dolist (`(,alias ,id ,_query ,repo ,type ,data) notifs) (let-alist data (and-let* ((topic-data (cdr (cadr (assq alias topics)))) - (topic (funcall (if (eq type 'issue) - #'forge--update-issue - #'forge--update-pullreq) + (topic (funcall (pcase-exhaustive type + ('discussion #'forge--update-discussion) + ('issue #'forge--update-issue) + ('pullreq #'forge--update-pullreq)) repo topic-data nil initial-pull)) (notif (or (forge-get-notification id) (closql-insert (forge-db) @@ -516,13 +657,13 @@ ((class (subclass forge-github-repository)) host user) (forge--fetch-user-repos class (forge--as-apihost host) user - (apply-partially #'forge--batch-add-callback (forge--as-githost host) user))) + (partial #'forge--batch-add-callback (forge--as-githost host) user))) (cl-defmethod forge--add-organization-repos ((class (subclass forge-github-repository)) host org) (forge--fetch-organization-repos class (forge--as-apihost host) org - (apply-partially #'forge--batch-add-callback (forge--as-githost host) org))) + (partial #'forge--batch-add-callback (forge--as-githost host) org))) (cl-defmethod forge--fetch-user-repos ((_ (subclass forge-github-repository)) host user callback) @@ -536,8 +677,8 @@ `((login . ,user)) (lambda (d) (funcall callback - (--map (alist-get 'name it) - (let-alist d .user.repositories)))) + (mapcar (##alist-get 'name %) + (let-alist d .user.repositories)))) nil :auth 'forge :host host)) (cl-defmethod forge--fetch-organization-repos @@ -549,8 +690,8 @@ `((login . ,org)) (lambda (d) (funcall callback - (--map (alist-get 'name it) - (let-alist d .organization.repositories)))) + (mapcar (##alist-get 'name %) + (let-alist d .organization.repositories)))) nil :auth 'forge :host host)) (defun forge--batch-add-callback (host owner names) @@ -569,13 +710,33 @@ ;;; Mutations +(cl-defmethod forge--submit-create-discussion ((_ forge-github-repository) + repo category) + (let-alist (forge--topic-parse-buffer) + (ghub--graphql + '(mutation (createDiscussion + [(input $input CreateDiscussionInput!)] + clientMutationId)) + `((input (repositoryId . ,(forge--their-id repo)) + (categoryId + . , (caar (forge-sql [:select [their-id] + :from discussion-category + :where (and (= repository $s1) + (= name $s2))] + (oref repo id) + category))) + (title . , .title) + (body . , .body))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback)))) + (cl-defmethod forge--submit-create-issue ((_ forge-github-repository) repo) (let-alist (forge--topic-parse-buffer) (forge--ghub-post repo "/repos/:owner/:repo/issues" `((title . , .title) (body . , .body) - ,@(and .labels (list (cons 'labels .labels))) - ,@(and .assignees (list (cons 'assignees .assignees)))) + ,@(and .labels `((labels . , .labels))) + ,@(and .assignees `((assignees . , .assignees)))) :callback (forge--post-submit-callback) :errorback (forge--post-submit-errorback)))) @@ -609,10 +770,7 @@ (magit-split-branch-name forge--buffer-base-branch)) (`(,head-remote . ,head-branch) (magit-split-branch-name forge--buffer-head-branch)) - (head-repo (forge-get-repository :stub head-remote)) - (url-mime-accept-string - ;; Support draft pull-requests. - "application/vnd.github.shadow-cat-preview+json")) + (head-repo (forge-get-repository :stub head-remote))) (forge--ghub-post repo "/repos/:owner/:repo/pulls" `((title . , .title) (body . , .body) @@ -628,11 +786,26 @@ :callback (forge--post-submit-callback) :errorback (forge--post-submit-errorback))))) -(cl-defmethod forge--submit-create-post ((_ forge-github-repository) topic) - (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/comments" - `((body . ,(string-trim (buffer-string)))) - :callback (forge--post-submit-callback) - :errorback (forge--post-submit-errorback))) +(cl-defmethod forge--submit-create-post ((_ forge-github-repository) post) + (cond + ((cl-typep post '(or forge-discussion forge-discussion-post)) + (ghub-graphql + `(mutation (addDiscussionComment + [(input $input AddDiscussionCommentInput!)] + clientMutationId)) + `((input + ,@(if (cl-typep post 'forge-discussion-post) + `((discussionId . ,(oref (forge-get-discussion post) their-id)) + (replyToId . ,(oref post their-id))) + `((discussionId . ,(oref post their-id)))) + (body . ,(string-trim (buffer-string))))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + (t + (forge--ghub-post post "/repos/:owner/:repo/issues/:number/comments" + `((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 @@ -648,6 +821,22 @@ :callback (forge--post-submit-callback) :errorback (forge--post-submit-errorback))) +(cl-defmethod forge--submit-approve-pullreq ((_ forge-github-repository) repo) + (let ((body (magit--buffer-string nil nil t))) + (forge--ghub-post repo "/repos/:owner/:repo/pulls/:number/reviews" + `((event . "APPROVE") + ,@(and (not (equal body "")) `((body . ,body)))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback)))) + +(cl-defmethod forge--submit-request-changes ((_ forge-github-repository) repo) + (let ((body (magit--buffer-string nil nil t))) + (forge--ghub-post repo "/repos/:owner/:repo/pulls/:number/reviews" + `((event . "REQUEST_CHANGES") + ,@(and (not (equal body "")) `((body . ,body)))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback)))) + (cl-defmethod forge--set-topic-title ((_repo forge-github-repository) topic title) (forge--ghub-patch topic @@ -661,12 +850,36 @@ "/repos/:owner/:repo/issues/:number" (pcase-exhaustive state ;; Merging isn't done through here. + ;; Marking as a duplicate isn't supported via API. ('completed '((state . "closed") (state_reason . "completed"))) ('unplanned '((state . "closed") (state_reason . "not_planned"))) ('rejected '((state . "closed"))) ('open '((state . "open")))) :callback (forge--set-field-callback topic))) +(cl-defmethod forge--set-topic-state + ((_repo forge-github-repository) + (topic forge-discussion) + state) + (with-slots (their-id) topic + (cond ((eq state 'open) + (ghub--graphql + '(mutation (reopenDiscussion + [(input $input ReopenDiscussionInput!)] + clientMutationId)) + `((input (discussionId . ,their-id))) + :callback (forge--set-field-callback topic t))) + ((ghub--graphql + '(mutation (closeDiscussion + [(input $input CloseDiscussionInput!)] + clientMutationId)) + `((input (discussionId . ,their-id) + (reason . ,(pcase-exhaustive state + ('completed "RESOLVED") + ('duplicate "DUPLICATE") + ('outdated "OUTDATED"))))) + :callback (forge--set-field-callback topic t)))))) + (cl-defmethod forge--set-topic-draft ((_repo forge-github-repository) topic value) (let ((buffer (current-buffer))) @@ -687,6 +900,43 @@ (oset topic draft-p value) (forge-refresh-buffer buffer)))))) +(cl-defmethod forge--set-topic-category + ((_repo forge-github-repository) + (topic forge-discussion) + category) + (ghub--graphql + '(mutation (updateDiscussion + [(input $input UpdateDiscussionInput!)] + clientMutationId)) + `((input (discussionId . ,(oref topic their-id)) + (categoryId + . , (caar (forge-sql [:select [their-id] + :from discussion-category + :where (and (= repository $s1) + (= name $s2))] + (oref (forge-get-repository :tracked) id) + category))))) + :callback (forge--set-field-callback topic t))) + +(cl-defmethod forge--set-topic-answer + ((_repo forge-github-repository) + (topic forge-discussion) + answer) + (let* ((old (oref topic answer)) + (old (and old (forge--their-id old))) + (new (and answer (oref answer their-id)))) + (ghub--graphql + `(mutation + ,@(and old '((unmarkDiscussionCommentAsAnswer + [(input $old UnmarkDiscussionCommentAsAnswerInput!)] + clientMutationId))) + ,@(and new '((markDiscussionCommentAsAnswer + [(input $new MarkDiscussionCommentAsAnswerInput!)] + clientMutationId)))) + `(,@(and old `((old (id . ,old)))) + ,@(and new `((new (id . ,new))))) + :callback (forge--set-field-callback topic t)))) + (cl-defmethod forge--set-topic-milestone ((repo forge-github-repository) topic milestone) (forge--ghub-patch topic @@ -702,39 +952,75 @@ :callback (forge--set-field-callback topic))) (cl-defmethod forge--set-topic-labels - ((_repo forge-github-repository) topic labels) - (funcall (if labels #'forge--ghub-put #'forge--ghub-delete) - topic "/repos/:owner/:repo/issues/:number/labels" nil - :payload labels - :callback (forge--set-field-callback topic))) + ((repo forge-github-repository) topic labels) + (let* ((topic-id (oref topic their-id)) + (old (mapcar (##forge--their-id (car %)) (oref topic labels))) + (new (mapcar (##forge--their-id (car %)) + (forge-sql [:select [id] :from label + :where (and (= repository $s1) + (in name $v2))] + (oref repo id) + (vconcat labels)))) + (add (cl-set-difference new old :test #'equal)) + (del (cl-set-difference old new :test #'equal))) + (when (or add del) + (ghub--graphql + `(mutation + ,@(and add '((addLabelsToLabelable + [(input $add AddLabelsToLabelableInput!)] + clientMutationId))) + ,@(and del '((removeLabelsFromLabelable + [(input $del RemoveLabelsFromLabelableInput!)] + clientMutationId)))) + `(,@(and add `((add (labelableId . ,topic-id) + (labelIds . ,(vconcat add))))) + ,@(and del `((del (labelableId . ,topic-id) + (labelIds . ,(vconcat del)))))) + :callback (forge--set-field-callback topic))))) (cl-defmethod forge--set-topic-assignees - ((_repo forge-github-repository) topic assignees) - (let ((value (mapcar #'cadr (oref topic assignees)))) - ;; FIXME Only refresh once. - (when-let ((add (cl-set-difference assignees value :test #'equal))) - (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/assignees" - `((assignees . ,add)) - :callback (forge--set-field-callback topic))) - (when-let ((remove (cl-set-difference value assignees :test #'equal))) - (forge--ghub-delete topic "/repos/:owner/:repo/issues/:number/assignees" - `((assignees . ,remove)) - :callback (forge--set-field-callback topic))))) + ((repo forge-github-repository) topic assignees) + (let* ((topic-id (oref topic their-id)) + (old (mapcar (##nth 3 %) (oref topic assignees))) + (new (forge-sql-car [:select [forge-id] :from assignee + :where (and (= repository $s1) + (in login $v2))] + (oref repo id) + (vconcat assignees))) + (add (cl-set-difference new old :test #'equal)) + (del (cl-set-difference old new :test #'equal))) + (when (or add del) + (ghub--graphql + `(mutation + ,@(and add '((addAssigneesToAssignable + [(input $add AddAssigneesToAssignableInput!)] + clientMutationId))) + ,@(and del '((removeAssigneesFromAssignable + [(input $del RemoveAssigneesFromAssignableInput!)] + clientMutationId)))) + `(,@(and add `((add (assignableId . ,topic-id) + (assigneeIds . ,(vconcat add))))) + ,@(and del `((del (assignableId . ,topic-id)) + (assigneeIds . ,(vconcat del))))) + :callback (forge--set-field-callback topic))))) (cl-defmethod forge--set-topic-review-requests - ((_repo forge-github-repository) topic reviewers) - (let ((value (mapcar #'cadr (oref topic review-requests)))) - ;; FIXME Only refresh once. - (when-let ((add (cl-set-difference reviewers value :test #'equal))) - (forge--ghub-post topic - "/repos/:owner/:repo/pulls/:number/requested_reviewers" - `((reviewers . ,add)) - :callback (forge--set-field-callback topic))) - (when-let ((remove (cl-set-difference value reviewers :test #'equal))) - (forge--ghub-delete topic - "/repos/:owner/:repo/pulls/:number/requested_reviewers" - `((reviewers . ,remove)) - :callback (forge--set-field-callback topic))))) + ((repo forge-github-repository) topic reviewers) + (let ((users (forge-sql-car + [:select [forge-id] :from assignee + :where (and (= repository $s1) + (in login $v2))] + (oref repo id) + (vconcat (seq-remove (##string-match "/" %) reviewers)))) + (teams nil)) ;TODO Investigate #742, track id, then use it here. + (ghub--graphql + `(mutation (requestReviews + [(input $input RequestReviewsInput!)] + clientMutationId)) + `((input (pullRequestId . ,(oref topic their-id)) + ,@(and users `((userIds . ,(vconcat users)))) + ,@(and teams `((teamIds . ,(vconcat teams)))))) + :callback (forge--set-field-callback topic)))) (cl-defmethod forge--delete-comment ((_repo forge-github-repository) post) @@ -744,36 +1030,36 @@ (cl-defmethod forge--topic-template-files ((repo forge-github-repository) (_ (subclass forge-issue))) - (and-let* ((files (magit-revision-files (oref repo default-branch)))) - (let ((case-fold-search t)) - (if-let ((file (--first (string-match-p "\ -\\`\\(\\|docs/\\|\\.github/\\)issue_template\\(\\.[a-zA-Z0-9]+\\)?\\'" it) - files))) - (list file) - (setq files - (--filter (string-match-p "\\`\\.github/ISSUE_TEMPLATE/[^/]*" it) - files)) - (if-let ((conf (cl-find-if - (lambda (f) - (equal (file-name-nondirectory f) "config.yml")) - files))) - (nconc (delete conf files) - (list conf)) - files))))) + ;; Upstream documentation is unclear but experimentation indicates that + ;; placing the template directory in ./ or docs/ does not work, a single + ;; template file is not supported, and silly names like IsSuE_tEmPlAtE + ;; are supported (but we don't support that here anyway). We do not + ;; support experimental issue *forms* for now. Make sure the config + ;; file comes last. + (or (nconc (forge--topic-template-files-1 + repo "md" ".github/issue_template") + (forge--topic-template-files-1 + repo nil ".github/issue_template/config.yml")) + (nconc (forge--topic-template-files-1 + repo "md" ".github/ISSUE_TEMPLATE") + (forge--topic-template-files-1 + repo nil ".github/ISSUE_TEMPLATE/config.yml")))) (cl-defmethod forge--topic-template-files ((repo forge-github-repository) (_ (subclass forge-pullreq))) - (and-let* ((files (magit-revision-files (oref repo default-branch)))) - (let ((case-fold-search t)) - (if-let ((file (--first (string-match-p "\ -\\`\\(\\|docs/\\|\\.github/\\)pull_request_template\\(\\.[a-zA-Z0-9]+\\)?\\'" it) - files))) - (list file) - ;; Unlike for issues, the web interface does not support - ;; multiple pull-request templates. The API does though, - ;; but due to this limitation I doubt many people use them, - ;; so Forge doesn't support them either. - )))) + ;; The web interface does not support multiple pull-request templates, + ;; and while the API theoretically does, we don't support that here. + ;; When there are multiple conflicting "default" templates, the rules + ;; used by Github are more complex than just sorting alphabetically and + ;; then taking the first found file. Too bad; that's what we do. + (let ((branch (oref repo default-branch)) + (case-fold-search t)) + (seq-some (lambda (file) + (and (string-match-p "\ +\\`\\(.github/\\|docs/\\)?pull_request_template\\(\\.[a-zA-Z0-9]+\\)?\\'" file) + (list (concat branch ":" file)))) + (magit-git-items "ls-tree" "-z" "--full-tree" "--name-only" + "-r" branch)))) (cl-defmethod forge--set-default-branch ((repo forge-github-repository) branch) (forge--ghub-patch repo @@ -804,12 +1090,26 @@ `((organization . ,fork)))) (ghub-wait (format "/repos/%s/%s" fork name) nil :auth 'forge))) -(cl-defmethod forge--merge-pullreq ((_repo forge-github-repository) - topic hash method) - (forge--ghub-put topic +(cl-defmethod forge--merge-pullreq ((repo forge-github-repository) + pullreq hash method) + (forge--ghub-put pullreq "/repos/:owner/:repo/pulls/:number/merge" `((merge_method . ,(symbol-name method)) - ,@(and hash `((sha . ,hash)))))) + ,@(and hash `((sha . ,hash)))) + :errorback t + :callback + (lambda (&rest _) + (forge--pull + repo + (lambda () + (when-let* ((branch (or (forge--pullreq-branch-active pullreq) + (forge--branch-pullreq pullreq))) + (upstream (magit-get-local-upstream-branch branch)) + (remote (oref repo remote))) + (magit-call-git "checkout" upstream) + (magit-call-git "pull" "--ff-only" remote (magit-pull-arguments)) + (magit-call-git "branch" "-d" branch) + (forge-refresh-buffer))))))) ;;; Wrappers @@ -891,5 +1191,10 @@ :callback callback :errorback errorback)) ;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("partial" . "llama--left-apply-partially") +;; ("rpartial" . "llama--right-apply-partially")) +;; End: (provide 'forge-github) ;;; forge-github.el ends here diff --git a/elpa/forge-20250108.2134/forge-gitlab.el b/elpa/forge-20250516.1009/forge-gitlab.el similarity index 95% rename from elpa/forge-20250108.2134/forge-gitlab.el rename to elpa/forge-20250516.1009/forge-gitlab.el index c87df872..1343f5d9 100644 --- a/elpa/forge-20250108.2134/forge-gitlab.el +++ b/elpa/forge-20250516.1009/forge-gitlab.el @@ -199,8 +199,8 @@ :body (forge--sanitize-string .description)))) (closql-insert (forge-db) issue t) (unless (magit-get-boolean "forge.omitExpensive") - (forge--set-id-slot repo issue 'assignees .assignees) - (forge--set-id-slot repo issue 'labels .labels)) + (forge--set-connections repo issue 'assignees .assignees) + (forge--set-connections repo issue 'labels .labels)) (dolist (c .notes) (let-alist c (let ((post @@ -337,9 +337,9 @@ :body (forge--sanitize-string .description)))) (closql-insert (forge-db) pullreq t) (unless (magit-get-boolean "forge.omitExpensive") - (forge--set-id-slot repo pullreq 'assignees .assignees) - (forge--set-id-slot repo pullreq 'review-requests .reviewers) - (forge--set-id-slot repo pullreq 'labels .labels)) + (forge--set-connections repo pullreq 'assignees .assignees) + (forge--set-connections repo pullreq 'review-requests .reviewers) + (forge--set-connections repo pullreq 'labels .labels)) (dolist (c .notes) (let-alist c (let ((post @@ -427,14 +427,15 @@ ;; tagged with the old label name until it itself ;; is modified somehow. Additionally it leads to ;; name conflicts between group and project - ;; labels. See #160. + ;; labels. See #160. Also see the comment in + ;; `forge--set-connections'. (list (forge--object-id id .name) .name (downcase .color) .description))) ;; For now simply remove one of the duplicates. (cl-delete-duplicates data - :key (apply-partially #'alist-get 'name) + :key (##alist-get 'name %) :test #'equal))))) ;;;; Notifications @@ -491,9 +492,9 @@ (cl-defmethod forge--submit-edit-post ((_ forge-gitlab-repository) post) (forge--glab-put post (cl-etypecase post - (forge-pullreq "/projects/:project/merge_requests/:number") - (forge-issue "/projects/:project/issues/:number") - (forge-issue-post "/projects/:project/issues/:topic/notes/:number") + (forge-pullreq "/projects/:project/merge_requests/:number") + (forge-issue "/projects/:project/issues/:number") + (forge-issue-post "/projects/:project/issues/:topic/notes/:number") (forge-pullreq-post "/projects/:project/merge_requests/:topic/notes/:number")) (if (cl-typep post 'forge-topic) (let-alist (forge--topic-parse-buffer) @@ -515,7 +516,7 @@ (cl-typecase topic (forge-pullreq "/projects/:project/merge_requests/:number") (forge-issue "/projects/:project/issues/:number")) - `((,field . ,value)) + `((,field . ,(if (and value (listp value)) (vconcat value) value))) :callback (forge--set-field-callback topic))) (cl-defmethod forge--set-topic-title @@ -565,14 +566,14 @@ 0))) (forge-issue (forge--set-topic-field repo topic 'assignee_ids - (or (--map (caddr (assoc it users)) assignees) + (or (mapcar (##caddr (assoc % users)) assignees) 0)))))) (cl-defmethod forge--set-topic-review-requests ((repo forge-gitlab-repository) topic reviewers) (let ((users (mapcar #'cdr (oref repo assignees)))) (forge--set-topic-field repo topic 'reviewer_ids - (or (--map (caddr (assoc it users)) reviewers) + (or (mapcar (##caddr (assoc % users)) reviewers) 0)))) (cl-defmethod forge--delete-comment @@ -588,13 +589,11 @@ (cl-defmethod forge--topic-template-files ((repo forge-gitlab-repository) (_ (subclass forge-issue))) - (--filter (string-match-p "\\`\\.gitlab/issue_templates/.+\\.md\\'" it) - (magit-revision-files (oref repo default-branch)))) + (forge--topic-template-files-1 repo "md" ".gitlab/issue_templates")) (cl-defmethod forge--topic-template-files ((repo forge-gitlab-repository) (_ (subclass forge-pullreq))) - (--filter (string-match-p "\\`\\.gitlab/merge_request_templates/.+\\.md\\'" it) - (magit-revision-files (oref repo default-branch)))) + (forge--topic-template-files-1 repo "md" ".gitlab/merge_request_templates")) (cl-defmethod forge--fork-repository ((repo forge-gitlab-repository) fork) (with-slots (owner name) repo @@ -679,5 +678,10 @@ :errorback (or errorback (and callback t)))) ;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("partial" . "llama--left-apply-partially") +;; ("rpartial" . "llama--right-apply-partially")) +;; End: (provide 'forge-gitlab) ;;; forge-gitlab.el ends here diff --git a/elpa/forge-20250108.2134/forge-gogs.el b/elpa/forge-20250516.1009/forge-gogs.el similarity index 100% rename from elpa/forge-20250108.2134/forge-gogs.el rename to elpa/forge-20250516.1009/forge-gogs.el diff --git a/elpa/forge-20250108.2134/forge-issue.el b/elpa/forge-20250516.1009/forge-issue.el similarity index 98% rename from elpa/forge-20250108.2134/forge-issue.el rename to elpa/forge-20250516.1009/forge-issue.el index 561199f6..0fefc981 100644 --- a/elpa/forge-20250108.2134/forge-issue.el +++ b/elpa/forge-20250516.1009/forge-issue.el @@ -221,5 +221,10 @@ and optional HEADING to change the section heading." (forge--list-topics spec repo)))) ;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("partial" . "llama--left-apply-partially") +;; ("rpartial" . "llama--right-apply-partially")) +;; End: (provide 'forge-issue) ;;; forge-issue.el ends here diff --git a/elpa/forge-20250108.2134/forge-notify.el b/elpa/forge-20250516.1009/forge-notify.el similarity index 93% rename from elpa/forge-20250108.2134/forge-notify.el rename to elpa/forge-20250516.1009/forge-notify.el index 07135dcb..8956013a 100644 --- a/elpa/forge-20250108.2134/forge-notify.el +++ b/elpa/forge-20250516.1009/forge-notify.el @@ -93,7 +93,7 @@ signal an error." (savedp (memq 'saved status)) (status (remq 'saved status))) (mapcar - (lambda (row) (closql--remake-instance 'forge-notification (forge-db) row)) + (partial #'closql--remake-instance 'forge-notification (forge-db)) (if (seq-set-equal-p status '(unread pending done) #'eq) (forge-sql [:select * :from notification :order-by [(desc updated)]]) (forge-sql @@ -177,7 +177,7 @@ signal an error." (transient-augment-suffix forge-notifications-menu :transient #'transient--do-replace :if-mode 'forge-notifications-mode - :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-notifications-menu)) + :inapt-if (##eq (oref transient--prefix command) 'forge-notifications-menu) :inapt-face 'forge-suffix-active) ;;;###autoload(autoload 'forge-list-notifications "forge-notify" nil t) @@ -193,7 +193,7 @@ signal an error." (transient-define-suffix forge-notifications-display-inbox () "List unread and pending notifications." :description "inbox" - :inapt-if (lambda () (equal forge-notifications-selection '(unread pending))) + :inapt-if (##equal forge-notifications-selection '(unread pending)) :inapt-face 'forge-suffix-active (interactive) (unless (derived-mode-p 'forge-notifications-mode) @@ -204,7 +204,7 @@ signal an error." (transient-define-suffix forge-notifications-display-saved () "List saved notifications." :description "saved" - :inapt-if (lambda () (eq forge-notifications-selection 'saved)) + :inapt-if (##eq forge-notifications-selection 'saved) :inapt-face 'forge-suffix-active (interactive) (unless (derived-mode-p 'forge-notifications-mode) @@ -215,7 +215,7 @@ signal an error." (transient-define-suffix forge-notifications-display-done () "List done notifications." :description "done" - :inapt-if (lambda () (eq forge-notifications-selection 'done)) + :inapt-if (##eq forge-notifications-selection 'done) :inapt-face 'forge-suffix-active (interactive) (unless (derived-mode-p 'forge-notifications-mode) @@ -226,7 +226,7 @@ signal an error." (transient-define-suffix forge-notifications-display-all () "List all notifications." :description "all" - :inapt-if (lambda () (equal forge-notifications-selection '(unread pending done))) + :inapt-if (##equal forge-notifications-selection '(unread pending done)) :inapt-face 'forge-suffix-active (interactive) (unless (derived-mode-p 'forge-notifications-mode) @@ -237,7 +237,7 @@ signal an error." (transient-define-suffix forge-notifications-style-flat () "Show a flat notification list." :description "single list" - :inapt-if (lambda () (eq forge-notifications-display-style 'flat)) + :inapt-if (##eq forge-notifications-display-style 'flat) :inapt-face 'forge-suffix-active (interactive) (unless (derived-mode-p 'forge-notifications-mode) @@ -248,7 +248,7 @@ signal an error." (transient-define-suffix forge-notifications-style-nested () "Group notifications by repository." :description "group by repo" - :inapt-if (lambda () (eq forge-notifications-display-style 'nested)) + :inapt-if (##eq forge-notifications-display-style 'nested) :inapt-face 'forge-suffix-active (interactive) (unless (derived-mode-p 'forge-notifications-mode) @@ -281,7 +281,7 @@ signal an error." (forge-insert-notification notif)) (insert ?\n))) ((pcase-dolist (`(,_ . ,notifs) - (--group-by (oref it repository) notifs)) + (seq-group-by (##oref % repository) notifs)) (let ((repo (forge-get-repository (car notifs)))) (magit-insert-section (forge-repo repo) (magit-insert-heading @@ -295,7 +295,7 @@ signal an error." (defun forge-insert-notification (notif) (with-slots (type title url) notif (pcase type - ((or 'issue 'pullreq) + ((or 'discussion 'issue 'pullreq) (forge--insert-topic (forge-get-topic notif))) ('commit (magit-insert-section (ncommit nil) ; !commit @@ -320,5 +320,10 @@ signal an error." 'font-lock-face 'error))))))) ;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("partial" . "llama--left-apply-partially") +;; ("rpartial" . "llama--right-apply-partially")) +;; End: (provide 'forge-notify) ;;; forge-notify.el ends here diff --git a/elpa/forge-20250108.2134/forge-pkg.el b/elpa/forge-20250516.1009/forge-pkg.el similarity index 50% rename from elpa/forge-20250108.2134/forge-pkg.el rename to elpa/forge-20250516.1009/forge-pkg.el index 8f14057f..4a50c38b 100644 --- a/elpa/forge-20250108.2134/forge-pkg.el +++ b/elpa/forge-20250516.1009/forge-pkg.el @@ -1,21 +1,21 @@ ;; -*- no-byte-compile: t; lexical-binding: nil -*- -(define-package "forge" "20250108.2134" +(define-package "forge" "20250516.1009" "Access Git forges from Magit." '((emacs "29.1") - (compat "30.0.1.0") - (closql "2.1.0") - (dash "2.19.1") - (emacsql "4.1.0") - (ghub "4.2.0") + (compat "30.0.2.0") + (closql "2.2.1") + (emacsql "4.3.0") + (ghub "4.3.0") (let-alist "1.0.6") - (magit "4.2.1") - (markdown-mode "2.6") + (llama "0.6.2") + (magit "4.3.2") + (markdown-mode "2.7") (seq "2.24") - (transient "0.8.2") - (yaml "0.5.5")) + (transient "0.8.7") + (yaml "1.2.0")) :url "https://github.com/magit/forge" - :commit "96fe98120c492f698088126b5340edc1976e7508" - :revdesc "96fe98120c49" + :commit "8e4dd7ed05212abb3f5318d1f2de5ef880d0d848" + :revdesc "8e4dd7ed0521" :keywords '("git" "tools" "vc") :authors '(("Jonas Bernoulli" . "emacs.forge@jonas.bernoulli.dev")) :maintainers '(("Jonas Bernoulli" . "emacs.forge@jonas.bernoulli.dev"))) diff --git a/elpa/forge-20250108.2134/forge-post.el b/elpa/forge-20250516.1009/forge-post.el similarity index 92% rename from elpa/forge-20250108.2134/forge-post.el rename to elpa/forge-20250516.1009/forge-post.el index f65892d8..488ec213 100644 --- a/elpa/forge-20250108.2134/forge-post.el +++ b/elpa/forge-20250516.1009/forge-post.el @@ -121,7 +121,7 @@ an error." (defvar-local forge--pre-post-buffer nil) (make-variable-buffer-local 'forge-buffer-draft-p) -(defun forge--prepare-post-buffer (filename &optional header source target) +(defun forge--prepare-post-buffer (filename &optional header source target template) (let* ((repo (forge-get-repository :tracked)) (tree (oref repo worktree)) (file (convert-standard-filename @@ -151,17 +151,9 @@ an error." (?d "[d]iscard draft and start over" t)) (erase-buffer) (setq resume nil))) - (when (and (not resume) (string-prefix-p "new" filename)) - (let-alist (forge--topic-template - (forge-get-repository :tracked) - (if source 'forge-pullreq 'forge-issue)) + (when (and (not resume) template) + (let-alist template (cond - (.url - (browse-url .url) - (forge-post-cancel) - (setq buf nil) - (message "Using browser to visit %s instead of opening an issue" - .url)) (.name ;; A Github issue with yaml frontmatter. (save-excursion (insert .text)) @@ -213,7 +205,7 @@ an error." (prevbuf forge--pre-post-buffer) (topic (ignore-errors (forge-get-topic forge--buffer-post-object))) (repo (forge-get-repository topic))) - (lambda (value headers status req) + (lambda (value &optional headers status req) (run-hook-with-args 'forge-post-submit-callback-hook value headers status req) (delete-file file t) @@ -248,7 +240,7 @@ an error." :class 'transient-lisp-variable :variable 'forge-buffer-draft-p :reader (lambda (&rest _) (not forge-buffer-draft-p)) - :if (lambda () (equal (file-name-nondirectory buffer-file-name) "new-pullreq"))) + :if (##equal (file-name-nondirectory buffer-file-name) "new-pullreq")) ;;; Notes @@ -258,9 +250,7 @@ an error." " " #'forge-edit-topic-note) (defun forge--save-note (_repo topic) - (let ((value (string-trim (buffer-substring-no-properties - (point-min) - (point-max))))) + (let ((value (string-trim (magit--buffer-string)))) (oset topic note (if (equal value "") nil value))) (delete-file buffer-file-name t) (let ((dir (file-name-directory buffer-file-name))) @@ -271,5 +261,10 @@ an error." (forge-refresh-buffer prevbuf))) ;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("partial" . "llama--left-apply-partially") +;; ("rpartial" . "llama--right-apply-partially")) +;; End: (provide 'forge-post) ;;; forge-post.el ends here diff --git a/elpa/forge-20250108.2134/forge-pullreq.el b/elpa/forge-20250516.1009/forge-pullreq.el similarity index 98% rename from elpa/forge-20250108.2134/forge-pullreq.el rename to elpa/forge-20250516.1009/forge-pullreq.el index 405130fe..eb8bad02 100644 --- a/elpa/forge-20250108.2134/forge-pullreq.el +++ b/elpa/forge-20250516.1009/forge-pullreq.el @@ -293,5 +293,10 @@ and optional HEADING to change the section heading." (magit-make-margin-overlay nil t)))))) ;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("partial" . "llama--left-apply-partially") +;; ("rpartial" . "llama--right-apply-partially")) +;; End: (provide 'forge-pullreq) ;;; forge-pullreq.el ends here diff --git a/elpa/forge-20250108.2134/forge-repo.el b/elpa/forge-20250516.1009/forge-repo.el similarity index 81% rename from elpa/forge-20250108.2134/forge-repo.el rename to elpa/forge-20250516.1009/forge-repo.el index 278b0c3b..0612809e 100644 --- a/elpa/forge-20250108.2134/forge-repo.el +++ b/elpa/forge-20250516.1009/forge-repo.el @@ -28,59 +28,67 @@ ;;; Classes (defclass forge-repository (forge-object) - ((closql-class-prefix :initform "forge-") - (closql-class-suffix :initform "-repository") - (closql-table :initform 'repository) - (closql-primary-key :initform 'id) - (issues-url-format :initform nil :allocation :class) - (issue-url-format :initform nil :allocation :class) - (issue-post-url-format :initform nil :allocation :class) - (pullreqs-url-format :initform nil :allocation :class) - (pullreq-url-format :initform nil :allocation :class) - (pullreq-post-url-format :initform nil :allocation :class) - (commit-url-format :initform nil :allocation :class) - (branch-url-format :initform nil :allocation :class) - (remote-url-format :initform nil :allocation :class) - (blob-url-format :initform nil :allocation :class) - (create-issue-url-format :initform nil :allocation :class) - (create-pullreq-url-format :initform nil :allocation :class) - (pullreq-refspec :initform nil :allocation :class) - (id :initform nil :initarg :id) - (forge-id :initform nil :initarg :forge-id) - (forge :initform nil :initarg :forge) - (owner :initform nil :initarg :owner) - (name :initform nil :initarg :name) - (apihost :initform nil :initarg :apihost) - (githost :initform nil :initarg :githost) - (remote :initform nil :initarg :remote) - (condition :initform :stub) - (created :initform nil) - (updated :initform nil) - (pushed :initform nil) - (parent :initform nil) - (description :initform nil) - (homepage :initform nil) - (default-branch :initform nil) - (archived-p :initform nil) - (fork-p :initform nil) - (locked-p :initform nil) - (mirror-p :initform nil) - (private-p :initform nil) - (issues-p :initform t) - (wiki-p :initform nil) - (stars :initform nil) - (watchers :initform nil) - (assignees :closql-table assignee) - (forks :closql-table fork) - (issues :closql-class forge-issue) - (labels :closql-table label) - (pullreqs :closql-class forge-pullreq) - (revnotes :closql-class forge-revnote) - (selective-p :initform nil) - (worktree :initform nil) - (milestones :closql-table milestone) - (issues-until :initform nil) - (pullreqs-until :initform nil)) + ((closql-class-prefix :initform "forge-") + (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) + (pullreqs-url-format :initform nil :allocation :class) + (pullreq-url-format :initform nil :allocation :class) + (pullreq-post-url-format :initform nil :allocation :class) + (commit-url-format :initform nil :allocation :class) + (branch-url-format :initform nil :allocation :class) + (remote-url-format :initform nil :allocation :class) + (blob-url-format :initform nil :allocation :class) + (create-issue-url-format :initform nil :allocation :class) + (create-pullreq-url-format :initform nil :allocation :class) + (pullreq-refspec :initform nil :allocation :class) + (id :initform nil :initarg :id) + (forge-id :initform nil :initarg :forge-id) + (forge :initform nil :initarg :forge) + (owner :initform nil :initarg :owner) + (name :initform nil :initarg :name) + (apihost :initform nil :initarg :apihost) + (githost :initform nil :initarg :githost) + (remote :initform nil :initarg :remote) + (condition :initform :stub) + (created :initform nil) + (updated :initform nil) + (pushed :initform nil) + (parent :initform nil) + (description :initform nil) + (homepage :initform nil) + (default-branch :initform nil) + (archived-p :initform nil) + (fork-p :initform nil) + (locked-p :initform nil) + (mirror-p :initform nil) + (private-p :initform nil) + (issues-p :initform t) + (wiki-p :initform nil) + (stars :initform nil) + (watchers :initform nil) + (assignees :closql-table assignee) + (forks :closql-table fork) + (issues :closql-class forge-issue) + (labels :closql-table label) + (pullreqs :closql-class forge-pullreq) + (revnotes :closql-class forge-revnote) + (selective-p :initform nil) + (worktree :initform nil) + (milestones :closql-table milestone) + (issues-until :initform nil) + (pullreqs-until :initform nil) + (teams :initform nil) + (discussion-categories :closql-table discussion-category) + (discussions :closql-class forge-discussion) + (discussions-p :initform nil) + (discussions-until :initform nil)) :abstract t) (defclass forge-unusedapi-repository (forge-repository) () :abstract t) @@ -291,9 +299,6 @@ See `forge-alist' for valid Git hosts." (error "(Maybe repository) is nil; `%s' not satisfied" demand) nil)) -(defun forge--get-repository:tracked? () - (forge-get-repository :tracked?)) - (defun forge-repository-at-point (&optional demand) "Return the repository at point. If there is no such repository and DEMAND is non-nil, then signal @@ -349,16 +354,12 @@ REPO, return it, else set the slot to nil and return nil." ;;;; List (defun forge--ls-repos () - (mapcar (let ((db (forge-db))) - (lambda (row) - (closql--remake-instance 'forge-repository db row))) + (mapcar (partial #'closql--remake-instance 'forge-repository (forge-db)) (forge-sql [:select * :from repository :order-by [(asc owner) (asc name)]]))) (defun forge--ls-owned-repos () - (mapcar (let ((db (forge-db))) - (lambda (row) - (closql--remake-instance 'forge-repository db row))) + (mapcar (partial #'closql--remake-instance 'forge-repository (forge-db)) (forge-sql [:select * :from repository :where (and (in owner $v1) (not (in name $v2))) @@ -485,18 +486,30 @@ forges and hosts." (?p . ,path) (?P . ,(string-replace "/" "%2F" path)))))) -(defun forge--set-field-callback (topic) - (lambda (&rest _) - (forge--pull-topic - (forge-get-repository topic) - topic - :callback (lambda () - (forge-refresh-buffer) - (when (transient-active-prefix - '(forge-topic-menu - forge-topics-menu - forge-notifications-menu)) - (transient--refresh-transient)))))) +(defun forge--set-field-callback (topic &optional preserve-status) + (let ((status (oref topic status))) + (lambda (&rest _) + (forge--pull-topic + (forge-get-repository topic) + topic + :callback (lambda () + ;; Necessary when setting a discussion field because + ;; the API provides even less information about the + ;; status of discussions compared to other topics and + ;; as a result we would otherwise always switch the + ;; status to `unread'. This is not needed for every + ;; modification of a discussion because some of them + ;; (e.g., setting labels) do not cause `updated_at' to + ;; be bumped; this second defect cancels out the first + ;; when it comes to this function. + (when preserve-status + (oset topic status status)) + (forge-refresh-buffer) + (when (transient-active-prefix + '(forge-topic-menu + forge-topics-menu + forge-notifications-menu)) + (transient--refresh-transient))))))) (defvar forge--mode-line-buffer nil) @@ -544,5 +557,10 @@ forges and hosts." ('forge-bitbucket-repository 'bitbucket))) ;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("partial" . "llama--left-apply-partially") +;; ("rpartial" . "llama--right-apply-partially")) +;; End: (provide 'forge-repo) ;;; forge-repo.el ends here diff --git a/elpa/forge-20250108.2134/forge-repos.el b/elpa/forge-20250516.1009/forge-repos.el similarity index 96% rename from elpa/forge-20250108.2134/forge-repos.el rename to elpa/forge-20250516.1009/forge-repos.el index 8ae0922f..141440af 100644 --- a/elpa/forge-20250108.2134/forge-repos.el +++ b/elpa/forge-20250516.1009/forge-repos.el @@ -152,7 +152,7 @@ Must be set before `forge-list' is loaded.") (transient-augment-suffix forge-repositories-menu :transient #'transient--do-replace :if-mode 'forge-repository-list-mode - :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-repositories-menu)) + :inapt-if (##eq (oref transient--prefix command) 'forge-repositories-menu) :inapt-face 'forge-suffix-active) ;;;; List @@ -187,5 +187,10 @@ Only Github is supported for now." (transient-setup 'forge-repositories-menu)) ;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("partial" . "llama--left-apply-partially") +;; ("rpartial" . "llama--right-apply-partially")) +;; End: (provide 'forge-repos) ;;; forge-repos.el ends here diff --git a/elpa/forge-20250108.2134/forge-revnote.el b/elpa/forge-20250516.1009/forge-revnote.el similarity index 91% rename from elpa/forge-20250108.2134/forge-revnote.el rename to elpa/forge-20250516.1009/forge-revnote.el index 60832f74..cf7ba848 100644 --- a/elpa/forge-20250108.2134/forge-revnote.el +++ b/elpa/forge-20250516.1009/forge-revnote.el @@ -43,5 +43,10 @@ (body :initarg :body))) ;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("partial" . "llama--left-apply-partially") +;; ("rpartial" . "llama--right-apply-partially")) +;; End: (provide 'forge-revnote) ;;; forge-revnote.el ends here diff --git a/elpa/forge-20250108.2134/forge-semi.el b/elpa/forge-20250516.1009/forge-semi.el similarity index 100% rename from elpa/forge-20250108.2134/forge-semi.el rename to elpa/forge-20250516.1009/forge-semi.el diff --git a/elpa/forge-20250108.2134/forge-tablist.el b/elpa/forge-20250516.1009/forge-tablist.el similarity index 95% rename from elpa/forge-20250108.2134/forge-tablist.el rename to elpa/forge-20250516.1009/forge-tablist.el index 6a7c5344..0b4ab813 100644 --- a/elpa/forge-20250108.2134/forge-tablist.el +++ b/elpa/forge-20250516.1009/forge-tablist.el @@ -77,5 +77,10 @@ (funcall forge--tabulated-list-query)))) ;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("partial" . "llama--left-apply-partially") +;; ("rpartial" . "llama--right-apply-partially")) +;; End: (provide 'forge-tablist) ;;; forge-tablist.el ends here diff --git a/elpa/forge-20250108.2134/forge-topic.el b/elpa/forge-20250516.1009/forge-topic.el similarity index 68% rename from elpa/forge-20250108.2134/forge-topic.el rename to elpa/forge-20250516.1009/forge-topic.el index f5772a8f..f835c8ee 100644 --- a/elpa/forge-20250108.2134/forge-topic.el +++ b/elpa/forge-20250516.1009/forge-topic.el @@ -33,6 +33,15 @@ (defvar bug-reference-auto-setup-functions) +(define-obsolete-face-alias 'forge-topic-slug-completed + 'forge-topic-slug-realized "Forge 0.5.0") + +(define-obsolete-face-alias 'forge-topic-slug-unplanned + 'forge-topic-slug-expunged "Forge 0.5.0") + +(define-obsolete-face-alias 'forge-issue-unplanned + 'forge-issue-expunged "Forge 0.5.0") + ;;; Options (defcustom forge-limit-topic-choices t @@ -115,6 +124,11 @@ does not inherit from `magit-dimmed'." "Face for the `header-line' in `forge-topic-mode' buffers." :group 'forge-faces) +(defface forge-discussion-answer-heading + '((t :inherit magit-diff-added)) + "Face for headings of discussion replies marked as the answer." + :group 'magit-faces) + ;;;; Topic and Notification Slugs (defface forge-topic-slug-open @@ -122,16 +136,21 @@ does not inherit from `magit-dimmed'." "Face uses for slugs of open topics." :group 'forge-faces) -(defface forge-topic-slug-completed +(defface forge-topic-slug-realized '((t :inherit forge-dimmed)) - "Face used for slugs of completed topics." + "Face used for slugs of realized topics. +Realized topics include: +- completed issues and +- merged pull-requests." :group 'forge-faces) -(defface forge-topic-slug-unplanned +(defface forge-topic-slug-expunged '((t :inherit forge-dimmed :strike-through t)) - "Face used for slugs of unplanned topics. -E.g., for issues closes as \"unplanned\" and pull-requests that -were closed without being merged." + "Face used for slugs of expunged topics. +Expunged topics include: +- issues closes as unplanned, +- issues closed as duplicates, and +- pull-requests closed without merging." :group 'forge-faces) (defface forge-topic-slug-saved @@ -175,6 +194,26 @@ attribute that is specified by any of those faces. Likewise those faces should not set `:weight' or `:slant'." :group 'forge-faces) +;;;;; Discussions + +(defface forge-discussion-open + '((t :slant italic)) + "Face used for summaries of open discussions." + :group 'forge-faces) + +(defface forge-discussion-completed + '((t :inherit forge-dimmed :slant italic)) + "Face used for summaries of discussions closed as completed." + :group 'forge-faces) + +(defface forge-discussion-expunged + '((t :inherit forge-dimmed :slant italic :strike-through t)) + "Face used for summaries of expunged discussions. +Expunged discussions include: +- discussions closes as unplanned, and +- discussions closed as duplicates." + :group 'forge-faces) + ;;;;; Issues (defface forge-issue-open @@ -187,9 +226,12 @@ faces should not set `:weight' or `:slant'." "Face used for summaries of issues closed as completed." :group 'forge-faces) -(defface forge-issue-unplanned +(defface forge-issue-expunged '((t :inherit forge-dimmed :strike-through t)) - "Face used for summaries of issues closed as unplanned." + "Face used for summaries of expunged issues. +Expunged issues include: +- issues closes as unplanned, and +- issues closed as duplicates." :group 'forge-faces) ;;;;; Pull-Requests @@ -210,7 +252,7 @@ faces should not set `:weight' or `:slant'." :group 'forge-faces) (defface forge-pullreq-draft - '((t :slant italic)) + '((t :inherit highlight)) "Face used for summaries of draft pull-requests. A face attribute should be used that is not already used by any `forge-topic-STATUS' or `forge-{issue,pullreq}-STATE' face." @@ -253,20 +295,21 @@ A face attribute should be used that is not already used by any t)) (cl-defmethod forge--object-id ((prefix string) number-or-id) - (base64-encode-string - (encode-coding-string - (format "%s:%s" - (base64-decode-string prefix) - (if (numberp number-or-id) - number-or-id - ;; Currently every ID is base64 encoded. Unfortunately - ;; we cannot use the IDs of Gitlab labels (see comment - ;; in the respective `forge--update-labels' method), - ;; and have to use their names, which are not encoded. - (or (ignore-errors (base64-decode-string number-or-id)) - number-or-id))) - 'utf-8) - t)) + (and number-or-id + (base64-encode-string + (encode-coding-string + (format "%s:%s" + (base64-decode-string prefix) + (if (numberp number-or-id) + number-or-id + ;; Currently every ID is base64 encoded. Unfortunately + ;; we cannot use the IDs of Gitlab labels (see comment + ;; in the respective `forge--update-labels' method), + ;; and have to use their names, which are not encoded. + (or (ignore-errors (base64-decode-string number-or-id)) + number-or-id))) + 'utf-8) + t))) (cl-defmethod forge-topic-mark-read ((topic forge-topic)) (when (eq (oref topic status) 'unread) @@ -274,8 +317,8 @@ A face attribute should be used that is not already used by any (cl-defmethod forge--set-topic-marks ((_repo forge-repository) topic marks) (oset topic marks - (mapcar #'car (forge-sql [:select id :from mark :where (in name $v1)] - (vconcat marks)))) + (forge-sql-car [:select id :from mark :where (in name $v1)] + (vconcat marks))) (forge-refresh-buffer)) ;;; Query @@ -293,22 +336,23 @@ A face attribute should be used that is not already used by any topic) (cl-defmethod forge-get-topic ((repo forge-repository) number-or-id) - (if (numberp number-or-id) - (if (< number-or-id 0) - (forge-get-pullreq repo (abs number-or-id)) - (or (forge-get-issue repo number-or-id) - (forge-get-pullreq repo number-or-id))) - (or (forge-get-issue number-or-id) + (if (and (numberp number-or-id) + (< number-or-id 0)) + (forge-get-pullreq repo (abs number-or-id)) + (or (forge-get-discussion number-or-id) + (forge-get-issue number-or-id) (forge-get-pullreq number-or-id)))) (cl-defmethod forge-get-topic ((number integer)) (if (< number 0) (forge-get-pullreq (abs number)) - (or (forge-get-issue number) + (or (forge-get-discussion number) + (forge-get-issue number) (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 @@ -326,7 +370,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")))) @@ -342,7 +386,16 @@ an error." (forge-get-pullreq repo number))))) (defun forge-region-topics () - (magit-region-values '(issue pullreq))) + (magit-region-values '(discussion issue pullreq))) + +(defun forge-current-topic-type () + (magit-section-case + ([* discussions] 'discussion) + ([* issues] 'issue) + ([* pullreqs] 'pullreq) + (t (or (and forge--buffer-topics-spec + (oref forge--buffer-topics-spec type)) + 'topic)))) ;;;; List @@ -364,9 +417,10 @@ an error." Limit list based on topic type." :initarg :type :initform 'topic - :type (member topic issue pullreq nil) + :type (member topic discussion issue pullreq nil) :custom (choice (const topic) + (const discussion) (const issue) (const pullreq) (const :tag "disable topic sections (nil)" nil))) @@ -388,15 +442,30 @@ Limit list based on topic (public) state. State is the \"public condition\". I.e., is the topic still open?" :initarg :state :initform 'open - :type (satisfies (lambda (val) - (member val '(open - (completed merged) - (unplanned rejected) - nil)))) + :type (satisfies + (lambda (val) + (member val '(open + closed + (completed merged) + completed + merged + (unplanned duplicate outdated rejected) + unplanned + duplicate + outdated + rejected + nil)))) :custom (choice (const open) + (const closed) (const (completed merged)) - (const (unplanned rejected)) + (const completed) + (const merged) + (const (unplanned duplicate outdated rejected)) + (const unplanned) + (const duplicate) + (const outdated) + (const rejected) (const :tag "all (nil)" nil))) (status :documentation "\ Limit list based on topic (private) status. @@ -420,12 +489,24 @@ Date when topic was last updated." :initarg :updated :initform nil :type (or string null)) + (category :documentation "\ +Limit list to discussions of given category. +Issues and pull-requests are unaffected." + :initarg :category + :initform nil + :type (or string null) + :custom (choice + (string :tag "name") + (const :tag "all (nil)" nil))) (milestone :documentation "\ -Limit list to topics assigned to given milestone." +Limit list to issues and pull-requests assigned to given milestone. +Discussions are unaffected." :initarg :milestone :initform nil :type (or string null) - :custom string) + :custom (choice + (string :tag "name") + (const :tag "all (nil)" nil))) (labels :documentation "\ Limit list to topics with at least one of the given labels." :initarg :labels @@ -449,23 +530,29 @@ current Forge database." Limit list to topics created by given user." :initarg :author :initform nil - :label "Author (username)" + :label "Author" :type (or string null) - :custom string) + :custom (choice + (string :tag "username") + (const :tag "no filter (nil)" nil))) (assignee :documentation "\ Limit list to topics assigned to given user." :initarg :assignee :initform nil - :label "Assignee (username)" + :label "Assignee" :type (or string null) - :custom string) + :custom (choice + (string :tag "username") + (const :tag "no filter (nil)" nil))) (reviewer :documentation "\ Limit list to topics for which a review by the given user was requested." :initarg :reviewer :initform nil - :label "Reviewer (username)" + :label "Reviewer" :type (or string null) - :custom string) + :custom (choice + (string :tag "username") + (const :tag "no filter (nil)" nil))) (global :documentation "Whether to list topics for all repositories." :initarg :global :initform nil @@ -481,14 +568,30 @@ Limit list to topics for which a review by the given user was requested." (limit :documentation "Number of topics to list at most." :initarg :limit :initform 200 - :type integer - :custom natnum) + :type (or integer null) + :custom (choice natnum (const :tag "no limit" nil))) (grouped :documentation "Whether to group topics by repository." :initarg :grouped :initform nil :type boolean :custom boolean))) +(defun forge--cast-topics-spec-state (spec) + (when-let ((cast (pcase (list (oref spec type) (oref spec state)) + (`(topic ,(or 'unplanned 'duplicate 'rejected)) + '(unplanned duplicate rejected)) + ('(issue rejected) + '(unplanned duplicate rejected)) + (`(pullreq ,(or 'unplanned 'duplicate)) + '(unplanned duplicate rejected)) + (`(topic ,(or 'completed 'merged)) + '(completed merged)) + ('(issue merged) + '(completed merged)) + ('(pullreq completed) + '(completed merged))))) + (oset spec state cast))) + (cl-defun forge--list-topics (&optional (spec forge--buffer-topics-spec) (repo (forge-get-repository :tracked?)) @@ -499,21 +602,25 @@ Limit list to topics for which a review by the given user was requested." (pcase-let ((`(,pred ,slot) (pcase (oref spec order) ('newest '(> number)) ('oldest '(< number)) - ('recently-updated '(> updated)) - ('anciently-updated '(< updated))))) - (cl-sort (nconc (forge--list-topics-1 spec repo 'issue) + ('recently-updated '(string> updated)) + ('anciently-updated '(string< updated))))) + (cl-sort (nconc (forge--list-topics-1 spec repo 'discussion) + (forge--list-topics-1 spec repo 'issue) (forge--list-topics-1 spec repo 'pullreq)) - pred :key (lambda (obj) (eieio-oref obj slot)))) + pred :key (##eieio-oref % slot))) (forge--list-topics-1 spec repo type))) (defun forge--list-topics-1 (spec repo type) - (mapcar (apply-partially #'closql--remake-instance - (if (eq type 'issue) 'forge-issue 'forge-pullreq) - (forge-db)) + (mapcar (partial #'closql--remake-instance + (pcase type + ('discussion 'forge-discussion) + ('issue 'forge-issue) + ('pullreq 'forge-pullreq)) + (forge-db)) (forge-sql (forge--list-topics-2 spec repo type)))) (defun forge--list-topics-2 (spec repo type) - (pcase-let (((eieio active state status milestone labels marks + (pcase-let (((eieio active state status category milestone labels marks saved author assignee reviewer global order limit) spec)) (cond (active @@ -521,36 +628,45 @@ Limit list to topics for which a review by the given user was requested." (setq status '(unread pending))) ((eq status 'inbox) (setq status '(unread pending)))) + (when (eq state 'closed) + (setq state '( completed merged unplanned duplicate outdated rejected))) `[:select :distinct topic:* :from [(as ,type topic)] - ,@(cond - (milestone - `[:join milestone :on (= milestone:title ,milestone)])) - ,@(cond - ((not labels) nil) - ((eq type 'issue) - [:join issue-label :on (= issue-label:issue topic:id) - :join label :on (= label:id issue-label:id)]) - ([:join pullreq-label :on (= pullreq-label:pullreq topic:id) - :join label :on (= label:id pullreq-label:id)])) - ,@(cond - ((not marks) nil) - ((eq type 'issue) - [:join issue-mark :on (= issue-mark:issue topic:id) - :join mark :on (= mark:id issue-mark:id)]) - ([:join pullreq-mark :on (= pullreq-mark:pullreq topic:id) - :join mark :on (= mark:id pullreq-mark:id)])) - ,@(cond - ((not assignee) nil) - ((eq type 'issue) - [:join issue-assignee :on (= issue-assignee:issue topic:id) - :join assignee :on (= assignee:id issue-assignee:id)]) - ([:join pullreq-assignee :on (= pullreq-assignee:pullreq topic:id) - :join assignee :on (= assignee:id pullreq-assignee:id)])) - ,@(cond - (reviewer - [:join (as pullreq-review-request r) :on (= r:pullreq topic:id) - :join assignee :on (= assignee:id r:id)])) + ,@(pcase type + ((and 'discussion (guard category)) + `[:join discussion-category :on (= discussion-category:name ,category)]) + ((and (or 'issue 'pullreq) (guard milestone)) + `[:join milestone :on (= milestone:title ,milestone)])) + ,@(pcase (and labels type) + ('discussion + [:join discussion-label :on (= discussion-label:discussion topic:id) + :join label :on (= label:id discussion-label:id)]) + ('issue + [:join issue-label :on (= issue-label:issue topic:id) + :join label :on (= label:id issue-label:id)]) + ('pullreq + [:join pullreq-label :on (= pullreq-label:pullreq topic:id) + :join label :on (= label:id pullreq-label:id)])) + ,@(pcase (and marks type) + ('discussion + [:join discussion-mark :on (= discussion-mark:discussion topic:id) + :join mark :on (= mark:id discussion-mark:id)]) + ('issue + [:join issue-mark :on (= issue-mark:issue topic:id) + :join mark :on (= mark:id issue-mark:id)]) + ('pullreq + [:join pullreq-mark :on (= pullreq-mark:pullreq topic:id) + :join mark :on (= mark:id pullreq-mark:id)])) + ,@(pcase (and assignee type) + ('issue + [:join issue-assignee :on (= issue-assignee:issue topic:id) + :join assignee :on (= assignee:id issue-assignee:id)]) + ('pullreq + [:join pullreq-assignee :on (= pullreq-assignee:pullreq topic:id) + :join assignee :on (= assignee:id pullreq-assignee:id)])) + ,@(and reviewer + [:join (as pullreq-review-request r) :on (= r:pullreq topic:id) + :join assignee :on (= assignee:id r:id)]) :where (and ,@(and (not global) repo `((= topic:repository ,(oref repo id)))) @@ -560,13 +676,19 @@ Limit list to topics for which a review by the given user was requested." (in topic:status ,(vconcat (ensure-list status)))))) (`(,@(and state `((in topic:state ,(vconcat (ensure-list state))))) ,@(and status `((in topic:status ,(vconcat (ensure-list status)))))))) - ,@(and milestone '((= topic:milestone milestone:id))) - ,@(and labels `((or ,@(mapcar (lambda (l) `(= label:name ,l)) labels)))) - ,@(and marks `((or ,@(mapcar (lambda (m) `(= mark:name ,m)) marks)))) + ,@(pcase type + ((and 'discussion (guard category)) + '((= topic:category discussion-category:id))) + ((and (or 'issue 'pullreq) (guard milestone)) + '((= topic:milestone milestone:id)))) + ,@(and labels `((or ,@(mapcar (##`(= label:name ,%)) labels)))) + ,@(and marks `((or ,@(mapcar (##`(= mark:name ,%)) marks)))) ,@(and saved '((= topic:saved-p 't))) ,@(and author `((= topic:author ,author))) - ,@(and assignee `((= assignee:login ,assignee))) - ,@(and reviewer `((= assignee:login ,reviewer)))) + ,@(and assignee (memq type '(issue pullreq)) + `((= assignee:login ,assignee))) + ,@(and reviewer (eq type 'pullreq) + `((= assignee:login ,reviewer)))) :order-by [,(pcase order ('newest '(desc topic:number)) ('oldest '(asc topic:number)) @@ -635,9 +757,8 @@ can be selected from the start." (cdr (assoc choice alist)))) (defun forge--topic-collection (topics) - (mapcar (lambda (topic) - (cons (forge--format-topic-line topic) - (oref topic id))) + (mapcar (##cons (forge--format-topic-line %) + (oref % id)) topics)) (defvar-keymap forge-read-topic-minibuffer-map @@ -701,23 +822,29 @@ 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)))))) + :annotation-function (##get-text-property 0 :title %))))) (defun forge-read-topic-title (topic) (read-string "Title: " (oref topic title))) (defun forge-read-topic-milestone (&optional topic) - (forge--completing-read + (magit-completing-read "Milestone" - (mapcar #'caddr (oref (forge-get-repository (or topic :tracked)) milestones)) + (cons "" + (mapcar #'caddr + (oref (forge-get-repository (or topic :tracked)) milestones))) nil t (and topic (forge--format-topic-milestone topic)))) @@ -752,31 +879,14 @@ can be selected from the start." (defun forge-read-topic-review-requests (&optional topic) (let* ((repo (forge-get-repository (or topic :tracked))) (value (and topic (oref topic review-requests))) - (choices (mapcar #'cadr (oref repo assignees))) + (choices (nconc (mapcar #'cadr (oref repo assignees)) + (oref repo teams))) (crm-separator ",")) (magit-completing-read-multiple "Request review from: " choices nil 'confirm (mapconcat #'cadr value ",")))) -(defun forge--completing-read ( prompt collection &optional - predicate require-match initial-input - hist def) - ;; NOTE Only required until `magit-completing-read' has been - ;; updated to allow empty input if require-match is t. - (let ((reply (funcall magit-completing-read-function - (concat prompt ": ") - (if (and def (not (member def collection))) - (cons def collection) - collection) - predicate - require-match initial-input hist def))) - (if (equal reply "") - (if (and require-match (not (eq require-match t))) - (user-error "Nothing selected") - nil) - reply))) - ;;; Format (cl-defmethod forge--format ((topic forge-topic) slot &optional spec) @@ -795,11 +905,6 @@ can be selected from the start." forge-topic-repository-slug-width nil ?\s t) " ")) - ;; MAYBE bring this back once we support discussions. - ;; (cond (no-indicator nil) - ;; ((forge-issue-p topic) (magit--propertize-face "I " 'magit-dimmed)) - ;; ((forge-pullreq-p topic) (magit--propertize-face "P " 'magit-dimmed)) - ;; (t (magit--propertize-face "* " 'error))) (string-pad (forge--format-topic-slug topic) (or width 5)) " " (forge--format-topic-title topic))) @@ -811,9 +916,10 @@ can be selected from the start." `(,@(and saved-p '(forge-topic-slug-saved)) ,@(and (eq status 'unread) '(forge-topic-slug-unread)) ,(pcase state - ('open 'forge-topic-slug-open) - ((or 'completed 'merged) 'forge-topic-slug-completed) - ((or 'unplanned 'rejected) 'forge-topic-slug-unplanned)))))) + ('open 'forge-topic-slug-open) + ((or 'completed 'merged) 'forge-topic-slug-completed) + ((or 'unplanned 'duplicate 'rejected) + 'forge-topic-slug-unplanned)))))) (defun forge--format-topic-refs (topic) (pcase-let @@ -855,16 +961,29 @@ can be selected from the start." ('pending 'forge-topic-pending) ('done 'forge-topic-done)) ,(pcase (list (eieio-object-class topic) state) - (`(forge-issue open) 'forge-issue-open) - (`(forge-issue completed) 'forge-issue-completed) - (`(forge-issue unplanned) 'forge-issue-unplanned) - (`(forge-pullreq open) 'forge-pullreq-open) - (`(forge-pullreq merged) 'forge-pullreq-merged) - (`(forge-pullreq rejected) 'forge-pullreq-rejected))))))) + (`(forge-discussion open) 'forge-discussion-open) + (`(forge-discussion completed) 'forge-discussion-completed) + (`(forge-discussion unplanned) 'forge-discussion-expunged) + (`(forge-discussion duplicate) 'forge-discussion-expunged) + (`(forge-issue open) 'forge-issue-open) + (`(forge-issue completed) 'forge-issue-completed) + (`(forge-issue unplanned) 'forge-issue-expunged) + (`(forge-issue duplicate) 'forge-issue-expunged) + (`(forge-pullreq open) 'forge-pullreq-open) + (`(forge-pullreq merged) 'forge-pullreq-merged) + (`(forge-pullreq rejected) 'forge-pullreq-rejected))))))) (run-hook-wrapped 'forge-topic-wash-title-hook - (lambda (fn) (prog1 nil (save-excursion (funcall fn))))) + (##prog1 nil (save-excursion (funcall %)))) (buffer-string))) +(defun forge--format-topic-category (topic) + (and-let* ((id (oref topic category)) + (str (caar (forge-sql [:select [name] + :from discussion-category + :where (= id $s1)] + id)))) + (magit--propertize-face str 'forge-topic-label))) + (defun forge--format-topic-milestone (topic) (and-let* ((id (oref topic milestone)) (str (caar (forge-sql [:select [title] @@ -929,13 +1048,17 @@ can be selected from the start." (magit--propertize-face (symbol-name state) (pcase (list (if (forge-issue-p topic) 'issue 'pullreq) state) - ('(issue open) 'forge-issue-open) - ('(issue closed) 'forge-issue-completed) - ('(issue completed) 'forge-issue-completed) - ('(issue unplanned) 'forge-issue-unplanned) - ('(pullreq open) 'forge-pullreq-open) - ('(pullreq merged) 'forge-pullreq-merged) - ('(pullreq closed) 'forge-pullreq-rejected))))) + ('(discussion open) 'forge-discussion-open) + ('(discussion completed) 'forge-discussion-completed) + ('(discussion unplanned) 'forge-discussion-expunged) + ('(discussion duplicate) 'forge-discussion-expunged) + ('(issue open) 'forge-issue-open) + ('(issue completed) 'forge-issue-completed) + ('(issue unplanned) 'forge-issue-expunged) + ('(issue duplicate) 'forge-issue-expunged) + ('(pullreq open) 'forge-pullreq-open) + ('(pullreq merged) 'forge-pullreq-merged) + ('(pullreq closed) 'forge-pullreq-rejected))))) (defun forge--format-topic-status (topic) (with-slots (status) topic @@ -1009,7 +1132,7 @@ what subset of KIND is being listed." (defun forge--insert-topics (type heading topics) (when topics - (let ((width (apply #'max (--map (length (oref it slug)) topics)))) + (let ((width (apply #'max (mapcar (##length (oref % slug)) topics)))) (magit-insert-section ((eval type) heading t) (magit-insert-heading (concat (magit--propertize-face (concat heading " ") @@ -1030,8 +1153,7 @@ what subset of KIND is being listed." (insert "\n") (magit-log-format-author-margin (oref topic author) - (format-time-string "%s" (parse-iso8601-time-string (oref topic created))) - t) + (format-time-string "%s" (parse-iso8601-time-string (oref topic created)))) (when (and (slot-exists-p topic 'merged) (not (oref topic merged))) (magit-insert-heading) @@ -1114,6 +1236,18 @@ This mode itself is never used directly." (setq-local markdown-translate-filename-function #'forge--markdown-translate-filename-function)) +(defvar-keymap forge-discussion-mode-map :parent forge-topic-mode-map) +(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-state + forge-insert-topic-status + forge-insert-topic-category + forge-insert-topic-labels + forge-insert-topic-marks)) + (defvar-keymap forge-issue-mode-map :parent forge-topic-mode-map) (define-derived-mode forge-issue-mode forge-topic-mode "Issue" "Major mode for looking at a Forge issue." @@ -1153,7 +1287,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))) @@ -1174,33 +1311,64 @@ This mode itself is never used directly." (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 - ( post post nil - :heading-highlight-face 'magit-diff-hunk-heading-highlight) - (let ((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)))))) - (font-lock-append-text-property - 0 (length heading) - '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 topic) + (forge-insert-post-content post) + (when (forge-discussion-p topic) + (dolist (reply (oref post replies)) + (magit-insert-section (post reply) + (forge-insert-post-heading reply topic) + (forge-insert-post-content reply)))))) + +(defun forge-insert-post-heading (post topic) + (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 (cond + ((and (forge-discussion-p topic) + (and-let* ((answer (oref topic answer))) + (equal (oref post their-id) + (forge--their-id answer)))) + 'forge-discussion-answer-heading) + ((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) + (and (forge-discussion-reply-p post) 4))) + (insert "\n\n")) + (cl-defmethod magit-buffer-value (&context (major-mode forge-topic-mode)) (oref forge-buffer-topic slug)) @@ -1227,8 +1395,8 @@ This mode itself is never used directly." ,@(and (if command? command t) `((defvar-keymap ,map " " ,(or command `(function ,cmd))) - (put ',fun 'definition-name ',name))) - (put ',map 'definition-name ',name)))) + (put ',map 'definition-name ',name))) + (put ',fun 'definition-name ',name)))) (forge--define-topic-header refs :command nil @@ -1250,6 +1418,9 @@ This mode itself is never used directly." :command #'forge-topic-status-menu :format #'forge--format-topic-status) +(forge--define-topic-header category + :format #'forge--format-topic-category) + (forge--define-topic-header milestone :format #'forge--format-topic-milestone) @@ -1268,7 +1439,7 @@ This mode itself is never used directly." ;;; Commands ;;;; Groups -(defconst forge--lists-group +(transient-define-group forge--lists-group ["List" ("l r" "repositories" forge-list-repositories) ("l n" "notifications" forge-list-notifications) @@ -1276,7 +1447,7 @@ This mode itself is never used directly." ("l t" "topics" forge-list-topics) ""]) -(defconst forge--topic-menus-group +(transient-define-group forge--topic-menus-group ["Menu" ("m s" "edit" forge-topic-menu) ("m f" "filter" forge-topics-menu) @@ -1284,45 +1455,49 @@ This mode itself is never used directly." ("m f" "filter" forge-repositories-menu) ("m d" "dispatch" forge-dispatch) ("m c" "configure" forge-configure) - ""]) + """"]) -(defconst forge--topic-set-state-group - [:description - (lambda () (if forge--show-topic-legend "Set public state" "Set state")) +(transient-define-group forge--topic-set-state-group + [:description (##if forge--show-topic-legend "Set public state" "Set state") ("o" forge-topic-state-set-open) - ("c" forge-issue-state-set-completed) - ("x" forge-issue-state-set-unplanned) - ("c" forge-pullreq-state-set-merged) - ("x" forge-pullreq-state-set-rejected)]) - -(defconst forge--topic-set-status-group - [:description - (lambda () (if forge--show-topic-legend "Set private status" "Set status")) + ("c" forge-chatter-state-set-completed) + ("U" forge-issue-state-set-unplanned) + ("O" forge-discussion-state-set-outdated) + ("D" forge-chatter-state-set-duplicate) + ("M" forge-pullreq-state-set-merged) + ("R" forge-pullreq-state-set-rejected)]) + +(transient-define-group forge--topic-set-status-group + [:description (##if forge--show-topic-legend "Set private status" "Set status") ("u" forge-topic-status-set-unread) ("p" forge-topic-status-set-pending) ("d" forge-topic-status-set-done)]) -(defconst forge--topic-legend-group - '(["Legend" :if-non-nil forge--show-topic-legend - (:info* (lambda () (propertize "open issue" 'face 'forge-issue-open))) - (:info* (lambda () (propertize "completed issue" 'face 'forge-issue-completed))) - (:info* (lambda () (propertize "unplanned issue" 'face 'forge-issue-unplanned)))] - ["" :if-non-nil forge--show-topic-legend - (:info* (lambda () (propertize "open pullreq" 'face 'forge-pullreq-open))) - (:info* (lambda () (propertize "merged pullreq" 'face 'forge-pullreq-merged))) - (:info* (lambda () (propertize "rejected pullreq" 'face 'forge-pullreq-rejected)))] - ["" :if-non-nil forge--show-topic-legend - (:info* (lambda () (propertize "unread" 'face 'forge-topic-unread))) - (:info* (lambda () (propertize "pending" 'face 'forge-topic-pending))) - (:info* (lambda () (propertize "done" 'face 'forge-topic-done)))] - ["" :if-non-nil forge--show-topic-legend - (:info* (lambda () (propertize "draft" 'face 'forge-pullreq-draft)))])) +(transient-define-group forge--topic-legend-group + ["Legend" :if-non-nil forge--show-topic-legend + (:info* (##propertize "open discussion" 'face 'forge-discussion-open)) + (:info* (##propertize "completed discussion" 'face 'forge-discussion-completed)) + (:info* (##propertize "expunged discussion" 'face 'forge-discussion-expunged))] + ["" :if-non-nil forge--show-topic-legend + (:info* (##propertize "open issue" 'face 'forge-issue-open)) + (:info* (##propertize "completed issue" 'face 'forge-issue-completed)) + (:info* (##propertize "expunged issue" 'face 'forge-issue-expunged))] + ["" :if-non-nil forge--show-topic-legend + (:info* (##propertize "open pullreq" 'face 'forge-pullreq-open)) + (:info* (##propertize "merged pullreq" 'face 'forge-pullreq-merged)) + (:info* (##propertize "rejected pullreq" 'face 'forge-pullreq-rejected))] + ["" :if-non-nil forge--show-topic-legend + (:info* (##propertize "unread" 'face 'forge-topic-unread)) + (:info* (##propertize "pending" 'face 'forge-topic-pending)) + (:info* (##propertize "done" 'face 'forge-topic-done))] + ["" :if-non-nil forge--show-topic-legend + (:info* (##propertize "draft" 'face 'forge-pullreq-draft))]) (defvar forge--show-topic-legend t) (transient-define-suffix forge-toggle-topic-legend () "Toggle whether to show legend for faces used in topic menus and lists." - :description (lambda () (if forge--show-topic-legend "hide legend" "show legend")) + :description (##if forge--show-topic-legend "hide legend" "show legend") :transient t (interactive) (customize-set-variable 'forge--show-topic-legend @@ -1348,9 +1523,13 @@ This mode itself is never used directly." ["Actions" ("/f" forge-pull-this-topic) ("/b" forge-browse-this-topic) - ("/c" forge-checkout-this-pullreq)]] + ("/r" "respond" forge-create-post) + ("/c" forge-checkout-this-pullreq) + ("/A" forge-approve-pullreq) + ("/R" forge-request-changes)]] [forge--lists-group ["Set " + ("-c" forge-topic-set-category) ("-m" forge-topic-set-milestone) ("-l" forge-topic-set-labels) ("-x" forge-topic-set-marks) @@ -1361,6 +1540,7 @@ This mode itself is never used directly." ["Set" ("-s" forge-topic-toggle-saved) ("-d" forge-topic-toggle-draft) + ("-A" forge-discussion-set-answer) """Display" ("-H" forge-toggle-topic-legend)]] [forge--topic-legend-group]) @@ -1428,31 +1608,76 @@ This mode itself is never used directly." :state 'open :getter #'forge-current-topic) -(transient-define-suffix forge-issue-state-set-completed () - "Set the state of the current issue to `completed'." +(transient-define-suffix forge-chatter-state-set-completed () + "Set the state of the current discussion or issue to `completed'." :class 'forge--topic-set-state-command :state 'completed - :getter #'forge-current-issue) + :getter #'forge-current-chatter + :if #'forge-current-chatter) (transient-define-suffix forge-issue-state-set-unplanned () "Set the state of the current issue to `unplanned'." :class 'forge--topic-set-state-command :state 'unplanned - :getter #'forge-current-issue) + :getter #'forge-current-issue + :if #'forge-current-issue) + +(transient-define-suffix forge-chatter-state-set-duplicate () + "Set the state of the current discussion or issue to `duplicate'." + :class 'forge--topic-set-state-command + :state 'duplicate + :getter #'forge-current-chatter + :if #'forge-current-chatter + (interactive) + (with-slots (getter state) (transient-suffix-object) + (let ((topic (funcall getter t))) + (if (forge-issue-p topic) + (message + "The API does not yet support closing an issue as a duplicate") + (forge--set-topic-state (forge-get-repository topic) + topic state))))) + +(transient-define-suffix forge-discussion-state-set-outdated () + "Set the state of the current discussion to `outdated'." + :class 'forge--topic-set-state-command + :state 'outdated + :getter #'forge-current-discussion + :if #'forge-current-discussion) (transient-define-suffix forge-pullreq-state-set-merged () - "If the current pull-request is merged, then visualize that." + "Merge the current pull-request into its target. +Prompt the user to either use the API to perform the merge or use Git. +I recommend you only use the API if your organization enforces that +inferior process." :class 'forge--topic-set-state-command :state 'merged :getter #'forge-current-pullreq + :if #'forge-current-pullreq + :transient nil (interactive) - (message "Please use a merge command for this")) + (let ((pullreq (forge-current-pullreq))) + (if (magit-read-char-case (format "Merge #%s " (oref pullreq number)) t + (?g "using [g]it (recommended)" t) + (?a "using [a]pi" nil)) + (if-let ((branch (or (forge--pullreq-branch-active pullreq) + (forge--branch-pullreq pullreq))) + (upstream (magit-get-local-upstream-branch branch))) + (if (zerop (magit-call-git "checkout" upstream)) + (magit--merge-absorb + branch (magit-merge-arguments) + ;; Users might be surprised that we + ;; aren't done yet, so drop a hint. + "Inspect the result, and if satisfied push") + (user-error "Could not checkout %S" upstream)) + (user-error "No upstream configured for %S" branch)) + (forge-merge pullreq (forge-select-merge-method))))) (transient-define-suffix forge-pullreq-state-set-rejected () "Set the state of the current pull-request to `rejected'." :class 'forge--topic-set-state-command :state 'rejected - :getter #'forge-current-pullreq) + :getter #'forge-current-pullreq + :if #'forge-current-pullreq) ;;;; Status @@ -1500,7 +1725,7 @@ This mode itself is never used directly." (defclass forge--topic-set-slot-command (transient-suffix) ((slot :initarg :slot) (setter) - (reader) + (reader :initarg :reader) (formatter :initarg :formatter) (definition :initform (lambda (value) @@ -1525,9 +1750,10 @@ This mode itself is never used directly." ((obj forge--topic-set-slot-command) &optional _slots) (with-slots (slot) obj (let ((name (symbol-name slot))) - (cond ((string-suffix-p "-p" name) + (cond ((slot-boundp obj 'reader)) + ((string-suffix-p "-p" name) (setq name (substring name 0 -2)) - (oset obj reader (lambda (topic) (not (eieio-oref topic slot))))) + (oset obj reader (##not (eieio-oref % slot)))) ((oset obj reader (intern (format "forge-read-topic-%s" name))))) (oset obj setter (intern (format "forge--set-topic-%s" name))) (unless (slot-boundp obj 'formatter) @@ -1536,28 +1762,38 @@ This mode itself is never used directly." (transient-define-suffix forge-topic-set-title (title) "Edit the TITLE of the current topic." :class 'forge--topic-set-slot-command :slot 'title + :inapt-if-not #'forge-current-topic :formatter (lambda (topic) (propertize (truncate-string-to-width (forge--format-topic-title topic) 34 nil ?\s t) 'face 'font-lock-string-face))) +(transient-define-suffix forge-topic-set-category (category) + "Edit the CATEGORY of the current discussion." + :class 'forge--topic-set-slot-command :slot 'category + :inapt-if-not #'forge-current-discussion) + (transient-define-suffix forge-topic-set-milestone (milestone) "Edit what MILESTONE the current topic belongs to." - :class 'forge--topic-set-slot-command :slot 'milestone) + :class 'forge--topic-set-slot-command :slot 'milestone + :inapt-if-not (##or (forge-current-issue) (forge-current-pullreq))) (transient-define-suffix forge-topic-set-labels (labels) "Edit the LABELS of the current topic." :class 'forge--topic-set-slot-command :slot 'labels - :formatter (lambda (topic) (forge--format-labels topic t))) + :inapt-if-not #'forge-current-topic + :formatter (##forge--format-labels % t)) (transient-define-suffix forge-topic-set-marks (marks) "Edit the MARKS of the current topic." :class 'forge--topic-set-slot-command :slot 'marks - :formatter (lambda (topic) (forge--format-marks topic t))) + :inapt-if-not #'forge-current-topic + :formatter (##forge--format-marks % t)) (transient-define-suffix forge-topic-set-assignees (assignees) "Edit the ASSIGNEES of the current topic." - :class 'forge--topic-set-slot-command :slot 'assignees) + :class 'forge--topic-set-slot-command :slot 'assignees + :inapt-if-not (##or (forge-current-issue) (forge-current-pullreq))) (transient-define-suffix forge-topic-set-review-requests (review-requests) "Edit the REVIEW-REQUESTS of the current pull-request." @@ -1568,18 +1804,27 @@ This mode itself is never used directly." "Toggle whether the current pull-request is a draft." :class 'forge--topic-set-slot-command :slot 'draft-p :inapt-if-not #'forge-current-pullreq - :description (lambda () (forge--format-boolean 'draft-p "draft"))) + :description (##forge--format-boolean 'draft-p "draft")) (transient-define-suffix forge-topic-toggle-saved () "Toggle whether this topic is marked as saved." :class 'forge--topic-set-slot-command :slot 'saved-p - :description (lambda () (forge--format-boolean 'saved-p "saved")) + :inapt-if-not #'forge-current-topic + :description (##forge--format-boolean 'saved-p "saved") ;; Set only locally because Github's API does not support this. (interactive) (let ((topic (forge-current-topic t))) (oset topic saved-p (not (oref topic saved-p)))) (forge-refresh-buffer)) +(transient-define-suffix forge-discussion-set-answer (post) + "Mark the post at point as the answer to the current question. +When point is on the answer, then unmark it and mark no other." + :class 'forge--topic-set-slot-command :slot 'answer + :inapt-if-not #'forge-current-discussion + :description (##forge--format-boolean 'answer "answered") + :reader #'forge--select-discussion-answer) + ;;; Color Utilities (defun forge--sanitize-color (color) @@ -1591,14 +1836,18 @@ This mode itself is never used directly." ;;; Markdown Utilities -(defun forge--fontify-markdown (text) +(defun forge--fontify-markdown (text &optional indent) (with-temp-buffer (delay-mode-hooks (gfm-mode)) (insert text) (font-lock-ensure) (when forge-post-fill-region + (when indent + (setq fill-column (- fill-column indent))) (fill-region (point-min) (point-max))) + (when indent + (indent-rigidly (point-min) (point-max) indent)) (buffer-string))) (defun forge--markdown-translate-filename-function (file) @@ -1612,6 +1861,86 @@ This mode itself is never used directly." ;;; Templates +(defun forge--topic-template (repo class) + (let* ((templates (forge--topic-templates repo class)) + (template + (if (cdr templates) + (let ((c (magit-completing-read + (pcase class + ('forge-issue "Select issue template") + ('forge-pullreq "Select pull-request template")) + (mapcar (##alist-get 'prompt %) templates) + nil t))) + (seq-find (##equal (alist-get 'prompt %) c) templates)) + (car templates)))) + (if-let ((url (alist-get 'url template))) + (if (string-match (forge--format repo "\ +\\`https://%h/[^/]+/[^/]+/discussions\\(?:/categories/\\(.+\\)\\)?") + url) + `((type . forge-discussion) + (category . ,(or (match-string 1 url) + (forge-read-topic-category + nil "Category for new discussion")))) + `((type . redirect) ,@template)) + `((type . ,class) ,@template)))) + +(defun forge--topic-templates (repo class) + (mapcan (lambda (file) + (with-temp-buffer + (magit-git-insert "cat-file" "-p" file) + (if (equal (file-name-nondirectory file) "config.yml") + (forge--topic-parse-template-config) + (list (forge--topic-parse-template))))) + (forge--topic-template-files repo class))) + +(cl-defgeneric forge--topic-template-files (repo class)) + +(defun forge--topic-template-files-1 (repo suffix &rest paths) + (setq suffix (ensure-list suffix)) + (let ((branch (oref repo default-branch))) + (seq-keep (if suffix + (##and (member (file-name-extension %) suffix) + (concat branch ":" %)) + (##concat branch ":" %)) + (magit-git-items "ls-tree" "-z" + "--full-tree" "--name-only" + (and suffix "-r") + branch "--" paths)))) + +(defun forge--topic-parse-template-config () + (let-alist (yaml-parse-string (magit--buffer-string) + :object-type 'alist + :sequence-type 'list) + (nconc + (and (not (eq .blank_issues_enabled :false)) ;unset means true + `(((prompt . ,(concat (propertize "Blank issue" 'face 'bold) + " — Create a new issue from scratch"))))) + (mapcar (lambda (link) + `(,@link + (prompt . ,(let-alist link + (concat (propertize .name 'face 'bold) + " — " .about))))) + .contact_links)))) + +(defun forge--topic-parse-template () + (goto-char (point-min)) + (skip-chars-forward "\s\t\n\r") + (if-let ((beg (and (looking-at "^---[\s\t]*$") + (point))) + (end (and (zerop (forward-line)) + (re-search-forward "^---[\s\t]*$" nil t) + (match-beginning 0)))) + (let-alist (yaml-parse-string (magit--buffer-string beg end) + :object-type 'alist + :sequence-type 'list + :null-object nil) + `((prompt . ,(format "%s — %s" (propertize .name 'face 'bold) .about)) + (title . ,(and .title (string-trim .title))) + (text . ,(magit--buffer-string (point) nil ?\n)) + (labels . ,(ensure-list .labels)) + (assignees . ,(ensure-list .assignees)))) + `((text . ,(magit--buffer-string))))) + (defun forge--topic-parse-buffer (&optional file) (save-match-data (save-excursion @@ -1640,17 +1969,14 @@ This mode itself is never used directly." (setq beg (point)) (when (re-search-forward "^---[\s\t]*$" nil t) (setq end (match-beginning 0)) - (setq alist (yaml-parse-string - (buffer-substring-no-properties beg end) - :object-type 'alist - :sequence-type 'list - ;; FIXME Does not work because of - ;; https://github.com/zkry/yaml.el/pull/28. - :false-object nil)) + (setq alist (yaml-parse-string (magit--buffer-string beg end) + :object-type 'alist + :sequence-type 'list + :false-object nil)) (let-alist alist (when (and .name .about) (setf (alist-get 'prompt alist) - (format "[%s] %s" .name .about))) + (format "%s -- %s" .name .about))) (when (and .labels (atom .labels)) (setf (alist-get 'labels alist) (list .labels))) (when (and .assignees (atom .assignees)) @@ -1677,56 +2003,6 @@ This mode itself is never used directly." `((title . ,(string-trim title)) (body . ,(string-trim body))))) -(defun forge--topic-parse-link-buffer () - (save-match-data - (save-excursion - (goto-char (point-min)) - (mapcar (lambda (alist) - (cons (cons 'prompt (concat (alist-get 'name alist) " -- " - (alist-get 'about alist))) - alist)) - (forge--topic-parse-yaml-links))))) - -(defun forge--topic-parse-yaml-links () - (alist-get 'contact_links - (yaml-parse-string (buffer-substring-no-properties - (point-min) - (point-max)) - :object-type 'alist - :sequence-type 'list))) - -(cl-defgeneric forge--topic-template-files (repo class) - "Return a list of topic template files for REPO and a topic of CLASS.") - -(cl-defgeneric forge--topic-template (repo class) - "Return a topic template alist for REPO and a topic of CLASS. -If there are multiple templates, then the user is asked to select -one of them. It there are no templates, then return a very basic -alist, containing just `text' and `position'.") - -(defun forge--topic-templates-data (repo class) - (let ((branch (oref repo default-branch))) - (mapcan (lambda (f) - (with-temp-buffer - (magit-git-insert "cat-file" "-p" (concat branch ":" f)) - (if (equal (file-name-nondirectory f) "config.yml") - (forge--topic-parse-link-buffer) - (list (forge--topic-parse-buffer f))))) - (forge--topic-template-files repo class)))) - -(cl-defmethod forge--topic-template ((repo forge-repository) - (class (subclass forge-topic))) - (let ((choices (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") - (--map (alist-get 'prompt it) choices) - nil t))) - (--first (equal (alist-get 'prompt it) c) choices)) - (car choices)))) - ;;; Bug-Reference (defvar forge-bug-reference-remote-files t @@ -1772,5 +2048,10 @@ modify `bug-reference-bug-regexp' if appropriate." (add-hook hook #'forge-bug-reference-setup))) ;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("partial" . "llama--left-apply-partially") +;; ("rpartial" . "llama--right-apply-partially")) +;; End: (provide 'forge-topic) ;;; forge-topic.el ends here diff --git a/elpa/forge-20250108.2134/forge-topics.el b/elpa/forge-20250516.1009/forge-topics.el similarity index 82% rename from elpa/forge-20250108.2134/forge-topics.el rename to elpa/forge-20250516.1009/forge-topics.el index 3a03ec66..35d1f334 100644 --- a/elpa/forge-20250108.2134/forge-topics.el +++ b/elpa/forge-20250516.1009/forge-topics.el @@ -133,6 +133,7 @@ Must be set before `forge-topics' is loaded.") (eieio-oset spec key (pop params))) (unless (oref spec type) (oset spec type 'topic)) + (forge--cast-topics-spec-state spec) (unless (or repo global) (error "Cannot determine repository")) (magit-setup-buffer-internal #'forge-topics-mode nil @@ -156,7 +157,7 @@ Must be set before `forge-topics' is loaded.") (dolist (topic topics) (forge--insert-topic topic 5))) ((pcase-dolist (`(,_ . ,topics) - (--group-by (oref it repository) topics)) + (seq-group-by (##oref % repository) topics)) (let ((repo (forge-get-repository (car topics)))) (magit-insert-section (forge-repo repo) (magit-insert-heading @@ -193,8 +194,11 @@ Must be set before `forge-topics' is loaded.") ["State" ("a" forge-topics-filter-active) ("o" forge-topics-filter-state-open) - ("c" forge-topics-filter-state-completed) - ("x" forge-topics-filter-state-unplanned)] + ("r" forge-topics-filter-state-realized) + ("e" forge-topics-filter-state-expunged) + ("U" forge-topics-filter-state-unplanned) + ("O" forge-topics-filter-state-outdated) + ("D" forge-topics-filter-state-duplicate)] ["Status" ("i" forge-topics-filter-status-inbox) ("u" forge-topics-filter-status-unread) @@ -202,14 +206,16 @@ Must be set before `forge-topics' is loaded.") ("d" forge-topics-filter-status-done)] ["Type" ("t t" forge-topics-all-types) + ("t d" forge-topics-filter-discussions) ("t i" forge-topics-filter-issues) ("t p" forge-topics-filter-pullreqs)]] [forge--lists-group ["Filter " + ("-c" forge-topics-filter-category) ("-m" forge-topics-filter-milestone) ("-l" forge-topics-filter-labels) ("-x" forge-topics-filter-marks) - ("-c" forge-topics-filter-author) + ("-A" forge-topics-filter-author) ("-a" forge-topics-filter-assignee) ("-r" forge-topics-filter-reviewer) ("-s" forge-topics-filter-saved)] @@ -232,7 +238,7 @@ Must be set before `forge-topics' is loaded.") (transient-augment-suffix forge-topics-menu :transient #'transient--do-replace :if-not-derived '(forge-notifications-mode forge-repository-list-mode) - :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-topics-menu)) + :inapt-if (##eq (oref transient--prefix command) 'forge-topics-menu) :inapt-face 'forge-suffix-active) (defvar-local forge--quit-keep-topic-menu nil) @@ -275,10 +281,10 @@ then display the respective menu, otherwise display no menu." (transient-define-suffix forge-list-topics (&optional repo) "List topics of the current repository." :description "topics" - :inapt-if (lambda () (or (not (forge--get-repository:tracked?)) + :inapt-if (lambda () (or (not (forge-get-repository :tracked?)) (and (eq major-mode 'forge-topics-mode) (not (oref forge--buffer-topics-spec global))))) - :inapt-face (lambda () (if (not (forge--get-repository:tracked?)) + :inapt-face (lambda () (if (not (forge-get-repository :tracked?)) 'transient-inapt-suffix 'forge-suffix-active)) (declare (interactive-only nil)) @@ -286,6 +292,15 @@ then display the respective menu, otherwise display no menu." (forge-topics-setup-buffer repo) (transient-setup 'forge-topics-menu)) +;;;###autoload(autoload 'forge-list-discussions "forge-topics" nil t) +(transient-define-suffix forge-list-discussions (&optional repo) + "List discussions of the current repository." + :description "discussions" + (declare (interactive-only nil)) + (interactive) + (forge-topics-setup-buffer repo nil :type 'discussion) + (transient-setup 'forge-topics-menu)) + ;;;###autoload(autoload 'forge-list-issues "forge-topics" nil t) (transient-define-suffix forge-list-issues (&optional repo) "List issues of the current repository." @@ -343,6 +358,7 @@ then display the respective menu, otherwise display no menu." (interactive) (oset forge--buffer-topics-spec type (oref (transient-suffix-object) type)) + (forge--cast-topics-spec-state forge--buffer-topics-spec) (forge-refresh-buffer))) (inapt-face :initform 'forge-suffix-active) (inapt-if @@ -354,6 +370,11 @@ then display the respective menu, otherwise display no menu." :class 'forge--topics-filter-type-command :type 'topic :description "topics") +(transient-define-suffix forge-topics-filter-discussions () + "List discussions of the current repository." + :class 'forge--topics-filter-type-command :type 'discussion + :description "discussions") + (transient-define-suffix forge-topics-filter-issues () "List issues of the current repository." :class 'forge--topics-filter-type-command :type 'issue @@ -369,9 +390,7 @@ then display the respective menu, otherwise display no menu." (transient-define-suffix forge-topics-filter-active () "Limit topic list to active topics." :description "active" - :face (lambda () - (and (oref forge--buffer-topics-spec active) - 'forge-suffix-active)) + :face (##and (oref forge--buffer-topics-spec active) 'forge-suffix-active) (interactive) (oset forge--buffer-topics-spec active (not (oref forge--buffer-topics-spec active))) @@ -398,14 +417,7 @@ then display the respective menu, otherwise display no menu." (forge-refresh-buffer))) (description :initform (lambda (suffix) - (let ((want (oref suffix state)) - (type (oref forge--buffer-topics-spec type))) - (pcase type - ((guard (atom want)) - (symbol-name want)) - ('topic (apply #'format "%s/%s" want)) - ('issue (symbol-name (car want))) - ('pullreq (symbol-name (cadr want))))))) + (symbol-name (oref suffix state)))) (face :initform (lambda (suffix) (let ((want (oref suffix state)) @@ -419,19 +431,70 @@ then display the respective menu, otherwise display no menu." (eq want 'open)) (if (eq have want) 'forge-suffix-active-and-implied - 'forge-suffix-implied)))))))) + 'forge-suffix-implied)) + ((and (memq want '(unplanned duplicate outdated)) + (equal have + '(unplanned duplicate outdated rejected)) + (not active)) + 'forge-suffix-implied))))))) (transient-define-suffix forge-topics-filter-state-open () "Limit topic list to open topics." - :class 'forge--topics-filter-state-command :state 'open) - -(transient-define-suffix forge-topics-filter-state-completed () - "Limit topic list to completed and merged topics." - :class 'forge--topics-filter-state-command :state '(completed merged)) + :class 'forge--topics-filter-state-command + :state 'open) + +(transient-define-suffix forge-topics-filter-state-realized () + "Limit topic list to realized topics. +Realized topics include: +- completed discussions, +- completed issues, and +- merged pull-requests." + :class 'forge--topics-filter-state-command + :state '(completed merged) + :description (lambda () + (pcase (oref forge--buffer-topics-spec type) + ('discussion "completed") + ('issue "completed") + ('pullreq "merged") + ('topic "realized")))) + +(transient-define-suffix forge-topics-filter-state-expunged () + "Limit topic list to expunged topics. +Expunged topics include: +- discussions closed as outdated, +- discussions closed as duplicates, +- issues closed as unplanned, +- issues closed as duplicates, and +- pull-requests closed without merging." + :class 'forge--topics-filter-state-command + :state '(unplanned duplicate outdated rejected) + :description (lambda () + (pcase (oref forge--buffer-topics-spec type) + ('discussion "expunged") + ('issue "expunged") + ('pullreq "rejected") + ('topic "expunged")))) (transient-define-suffix forge-topics-filter-state-unplanned () - "Limit topic list to unplanned and rejected topics." - :class 'forge--topics-filter-state-command :state '(unplanned rejected)) + "Limit topic list to issues closed as unplanned." + :class 'forge--topics-filter-state-command + :state 'unplanned + :description " unplanned" + :if (##eq (oref forge--buffer-topics-spec type) 'issue)) + +(transient-define-suffix forge-topics-filter-state-outdated () + "Limit topic list to discussions closed as outdated." + :class 'forge--topics-filter-state-command + :state 'outdated + :description " outdated" + :if (##eq (oref forge--buffer-topics-spec type) 'discussion)) + +(transient-define-suffix forge-topics-filter-state-duplicate () + "Limit topic list to discussions and issues closed as duplicates." + :class 'forge--topics-filter-state-command + :state 'duplicate + :description " duplicate" + :if (##memq (oref forge--buffer-topics-spec type) '(discussion issue))) ;;;; Status @@ -516,23 +579,29 @@ then display the respective menu, otherwise display no menu." (unless (slot-boundp obj 'reader) (oset obj reader (intern (format "forge-read-topic-%s" (oref obj slot)))))) +(transient-define-suffix forge-topics-filter-category () + "Read a category and limit discussions to that category." + :class 'forge--topics-filter-command + :slot 'category + :formatter (##propertize % 'face 'forge-topic-label)) + (transient-define-suffix forge-topics-filter-milestone () "Read a milestone and limit topic list to topics with that milestone." :class 'forge--topics-filter-command :slot 'milestone - :formatter (lambda (m) (propertize m 'face 'forge-topic-label))) + :formatter (##propertize % 'face 'forge-topic-label)) (transient-define-suffix forge-topics-filter-labels () "Read labels and limit topic list to topics with one of these labels." :class 'forge--topics-filter-command :slot 'labels - :formatter (lambda (labels) (and labels (forge--format-labels labels " ")))) + :formatter (##and % (forge--format-labels % " "))) (transient-define-suffix forge-topics-filter-marks () "Read marks and limit topic list to topics with one of these marks." :class 'forge--topics-filter-command :slot 'marks - :formatter (lambda (marks) (and marks (forge--format-marks marks " ")))) + :formatter (##and % (forge--format-marks % " "))) (transient-define-suffix forge-topics-filter-saved () "Toggle whether to limit topic list to saved topics." @@ -540,25 +609,25 @@ then display the respective menu, otherwise display no menu." :slot 'saved :reader #'always :description - (lambda () (forge--format-boolean 'saved "saved" forge--buffer-topics-spec))) + (##forge--format-boolean 'saved "saved" forge--buffer-topics-spec)) (transient-define-suffix forge-topics-filter-author () "Read an author and limit topic list to topics created by that author." :class 'forge--topics-filter-command :slot 'author - :reader (lambda () (forge--read-filter-by-user "Author"))) + :reader (##forge--read-filter-by-user "Author")) (transient-define-suffix forge-topics-filter-assignee () "Read an assignee and limit topic list to topics assignee to that person." :class 'forge--topics-filter-command :slot 'assignee - :reader (lambda () (forge--read-filter-by-user "Assignee"))) + :reader (##forge--read-filter-by-user "Assignee")) (transient-define-suffix forge-topics-filter-reviewer () "Read a reviewer and limit topic list to reviews requested from that person." :class 'forge--topics-filter-command :slot 'reviewer - :reader (lambda () (forge--read-filter-by-user "Reviewer"))) + :reader (##forge--read-filter-by-user "Reviewer")) (defun forge--read-filter-by-user (prompt) (let* ((repo (forge-get-repository :tracked)) @@ -578,8 +647,8 @@ then display the respective menu, otherwise display no menu." (list (magit-read-char-case "Order by: " t (?n "[n]ewest" 'newest) (?o "[o]ldest" 'oldest) - (?u "[r]ecently updated" 'recently-updated) - (?U "[a]nciently updated" 'anciently-updated)))) + (?r "[r]ecently updated" 'recently-updated) + (?a "[a]nciently updated" 'anciently-updated)))) (oset forge--buffer-topics-spec order order) (forge-refresh-buffer)) @@ -597,8 +666,8 @@ then display the respective menu, otherwise display no menu." (transient-define-suffix forge-topics-group () "Group topics by repository." :description "group by repo" - :if (lambda () (oref forge--buffer-topics-spec global)) - :inapt-if (lambda () (oref forge--buffer-topics-spec grouped)) + :if (##oref forge--buffer-topics-spec global) + :inapt-if (##oref forge--buffer-topics-spec grouped) :inapt-face 'forge-suffix-active (interactive) (oset forge--buffer-topics-spec grouped t) @@ -607,13 +676,18 @@ then display the respective menu, otherwise display no menu." (transient-define-suffix forge-topics-ungroup () "Show a flat topic list." :description "single list" - :if (lambda () (oref forge--buffer-topics-spec global)) - :inapt-if-not (lambda () (oref forge--buffer-topics-spec grouped)) + :if (##oref forge--buffer-topics-spec global) + :inapt-if-not (##oref forge--buffer-topics-spec grouped) :inapt-face 'forge-suffix-active (interactive) (oset forge--buffer-topics-spec grouped nil) (forge-refresh-buffer)) ;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("partial" . "llama--left-apply-partially") +;; ("rpartial" . "llama--right-apply-partially")) +;; End: (provide 'forge-topics) ;;; forge-topics.el ends here diff --git a/elpa/forge-20250108.2134/forge.el b/elpa/forge-20250516.1009/forge.el similarity index 85% rename from elpa/forge-20250108.2134/forge.el rename to elpa/forge-20250516.1009/forge.el index 0ceb4741..758413b0 100644 --- a/elpa/forge-20250108.2134/forge.el +++ b/elpa/forge-20250516.1009/forge.el @@ -7,21 +7,21 @@ ;; Homepage: https://github.com/magit/forge ;; Keywords: git tools vc -;; Package-Version: 20250108.2134 -;; Package-Revision: 96fe98120c49 +;; Package-Version: 20250516.1009 +;; Package-Revision: 8e4dd7ed0521 ;; Package-Requires: ( ;; (emacs "29.1") -;; (compat "30.0.1.0") -;; (closql "2.1.0") -;; (dash "2.19.1") -;; (emacsql "4.1.0") -;; (ghub "4.2.0") +;; (compat "30.0.2.0") +;; (closql "2.2.1") +;; (emacsql "4.3.0") +;; (ghub "4.3.0") ;; (let-alist "1.0.6") -;; (magit "4.2.1") -;; (markdown-mode "2.6") +;; (llama "0.6.2") +;; (magit "4.3.2") +;; (markdown-mode "2.7") ;; (seq "2.24") -;; (transient "0.8.2") -;; (yaml "0.5.5")) +;; (transient "0.8.7") +;; (yaml "1.2.0")) ;; SPDX-License-Identifier: GPL-3.0-or-later @@ -60,6 +60,7 @@ (require 'forge-repo) (require 'forge-post) (require 'forge-topic) +(require 'forge-discussion) (require 'forge-issue) (require 'forge-pullreq) (require 'forge-revnote) @@ -86,8 +87,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 @@ -137,11 +139,12 @@ is loaded, then `magit-mode-map' ends up being modified anyway.") (transient-append-suffix 'magit-branch "W" '("F" "from pull-request" forge-branch-pullreq)) - (transient-suffix-put 'magit-remote 'magit-update-default-branch :key "b u") - (transient-append-suffix 'magit-remote "b u" - '("b r" "Rename default branch" forge-rename-default-branch)) - (transient-append-suffix 'magit-remote "b u" - '("b s" "Set default branch" forge-set-default-branch)) + (transient-append-suffix 'magit-remote "a" + '("f" "Fork" forge-fork)) + (transient-insert-suffix 'magit-remote "d u" + '("d s" "Set default branch" forge-set-default-branch)) + (transient-append-suffix 'magit-remote "d u" + '("d r" "Rename default branch" forge-rename-default-branch)) (transient-append-suffix 'magit-worktree "c" '("n" "pull-request worktree" forge-checkout-worktree)) @@ -156,7 +159,7 @@ is loaded, then `magit-mode-map' ends up being modified anyway.") ;;; Startup Asserts -(defconst forge--minimal-git "2.7.0") +(defconst forge--minimal-git "2.25.0") (defun forge-startup-asserts () (let ((version (magit-git-version))) @@ -181,4 +184,10 @@ too.\n" forge--minimal-git version) :error)))) (forge-startup-asserts) (add-hook 'after-init-hook #'forge-startup-asserts t)) +;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("partial" . "llama--left-apply-partially") +;; ("rpartial" . "llama--right-apply-partially")) +;; End: ;;; forge.el ends here diff --git a/elpa/forge-20250108.2134/forge.info b/elpa/forge-20250516.1009/forge.info similarity index 94% rename from elpa/forge-20250108.2134/forge.info rename to elpa/forge-20250516.1009/forge.info index 11c158ff..fd0ac97c 100644 --- a/elpa/forge-20250108.2134/forge.info +++ b/elpa/forge-20250516.1009/forge.info @@ -27,7 +27,7 @@ Forge User and Developer Manual Forge allows you to work with Git forges, currently Github and Gitlab, from the comfort of Magit and Emacs. -This manual is for Forge version 0.4.6. +This manual is for Forge version 0.5.0. Copyright (C) 2018-2025 Jonas Bernoulli @@ -360,10 +360,13 @@ after the final closing parenthesis and typing ‘C-x C-e’ Next add a line like the following to the chosen file: - machine gitlab.com/api/v4 login USERNAME^forge password TOKEN + machine gitlab.com login USERNAME^forge password TOKEN - • The value of ‘machine’ must be ‘gitlab.com/api/v4’. Variations of - this won’t work. + • The value of ‘machine’ should be ‘gitlab.com’. For historic + reasons ‘gitlab.com’ is also supported. + + • Note that if you instead use the ‘auth-source-pass’ backend, then + you *must* use ‘gitlab.com’ as ‘host’. • USERNAME must be the same as the value used for the ‘gitlab.user’ Git variable above. You *must* append ‘^forge’ to that, without @@ -465,10 +468,21 @@ after the final closing parenthesis and typing ‘C-x C-e’ machine APIHOST login USERNAME^forge password TOKEN - • APIHOST must be the same as the second element of the entry we - added to ‘forge-alist’. In the above example that would be - ‘example.com/api/v4’. Do *not* instead use GITHOST or INSTANCE-ID - (aka WEBHOST). + • APIHOST must be either the same as the second element of the entry + we added to ‘forge-alist’, or that element with the path suffix + removed. For example, if the APIHOST, specified in an + ‘forge-alist’ entry, is ‘example.com/api/v4’, then you can use + ‘example.com/api/v4’ or ‘example.com’. + + Historically only the former was supported, but that was a design + mistake, which we are now stuck with, and using just ‘example.com’ + as APIHOST in ‘~/.authsource’ is now recommended. For the time + being, in ‘forge-alist’ you must still always use + ‘example.com/api/v4’ as APIHOST. + + If you instead use the ‘auth-source-pass’ backend, then you *must* + use ‘example.com’ as the value of ‘host’. Using + ‘example.com/api/v4’ does not work with that backend. • USERNAME must be the same username you used above as the value of the Git variable. You *must* append ‘^forge’ to that, without any @@ -696,7 +710,7 @@ Topic menu and list commands This command lists the current repository’s issues in a separate buffer. If the list buffer already exists, this command only ensures that all types of topics are listed. If any other filters - are in effect, they are left intact. TODO fix preserving type + are in effect, they are left intact. ‘ [on "Issues" status section]’ (‘forge-list-issues’) This command lists the current repository’s issues in a separate @@ -729,7 +743,7 @@ Notification menu and list commands =================================== ‘N m n’ (‘forge-notifications-menu’) -‘C-c C-c’ +‘C-c C-c [in notifications list buffer]’ This command displays a menu used to control the list of notifications displayed in the current buffer. @@ -741,7 +755,7 @@ Repository menu and list commands ================================= ‘N m r’ (‘forge-repositories-menu’) -‘C-c C-c’ +‘C-c C-c [in repositories list buffer]’ This command displays a menu used to control the list of repositories displayed in the current buffer. @@ -796,7 +810,7 @@ may also remain active. Default topic filters ===================== - -- User Option: forge-status-buffer-default-topic-filters + -- User Option: forge-list-buffer-default-topic-filters This option specifies the filters initially used to limit topics listed in topic list buffers. @@ -1243,13 +1257,19 @@ File: forge.info, Node: Miscellaneous Commands, Next: Miscellaneous Options, -- Command: forge-remove-topic-locally This command reads a topic and removes it from the local database. + When the region marks multiple topics, then offer to remove them + all. + The topic is not removed from the forge and, if it is later - modified, then it will be added to the database again. + modified, then it will be added to the database again when fetching + all topics. - Due to how the supported APIs work, it would be too expensive to - automatically remove topics from the local database that were - removed from the forge. The only purpose of this command is to - allow you to manually clean up the local database. + This is useful for users who only fetch individual topics and want + to remove the topics they are no longer interested in. This can + also be used to remove topics locally, which have already been + removed on the forge (the service). Forge (the package) cannot + automatically detect when that happens, because given how the APIs + work, this would be too expensive. -- Command: forge-reset-database This command moves the current database file to the trash and @@ -1534,8 +1554,8 @@ File: forge.info, Node: Partially Supported Forges, Next: Supported Semi-Forge B.2 Partially Supported Forges ============================== -B.2.1 Forgejo ------------------------------------ +B.2.1 Forgejo https://forgejo.org +--------------------------------- This is the next forge whose API will be supported. @@ -1544,22 +1564,22 @@ B.2.1.1 Forgejo Hosts • -B.2.2 Gitea ------------------------------- +B.2.2 Gitea https://gitea.io +---------------------------- Once Forgejo is supported it might be fairly simple to support Gitea too, because the former is a fork of the latter, and their APIs might still be similar enough. -B.2.3 Gogs ----------------------------- +B.2.3 Gogs https://gogs.io +-------------------------- Once Forgejo is supported it might be fairly simple to support Gogs too, because the Forgejo is a fork of Gitea, which is a fork of Gogs, and their APIs might still be similar enough. -B.2.4 Bitbucket ---------------------------------------- +B.2.4 Bitbucket https://bitbucket.org +------------------------------------- I don’t plan to support Bitbucket’s API any time soon, and it gets less likely that I will every do it every time I look at it. @@ -1594,8 +1614,8 @@ File: forge.info, Node: Supported Semi-Forges, Prev: Partially Supported Forge B.3 Supported Semi-Forges ========================= -B.3.1 Gitweb ----------------------------------------------- +B.3.1 Gitweb https://git-scm.com/docs/gitweb +-------------------------------------------- B.3.1.1 Gitweb Caveats ...................... @@ -1605,8 +1625,8 @@ B.3.1.1 Gitweb Caveats between Gitweb and Cgit. The latter seems more popular (not just on this site). -B.3.2 Cgit ---------------------------------------------- +B.3.2 Cgit https://git.zx2c4.com/cgit/about +------------------------------------------- B.3.2.1 Cgit Caveats .................... @@ -1624,8 +1644,8 @@ B.3.2.2 Cgit Hosts • • -B.3.3 Stgit ------------------------------------------------------------------ +B.3.3 Stgit https://codemadness.org/git/stagit/file/README.html +--------------------------------------------------------------- B.3.3.1 Stgit Caveats ..................... @@ -1640,8 +1660,8 @@ B.3.3.2 Stgit Hosts • -B.3.4 Srht -------------------------------- +B.3.4 Srht https://meta.sr.ht +----------------------------- B.3.4.1 Srht Caveats .................... @@ -1716,10 +1736,10 @@ Appendix D Keystroke Index * b F: Branching. (line 13) * b f: Branching. (line 102) * C- [on a topic section]: Editing Topics. (line 26) -* C-c C-c: Lists and Menus. (line 97) -* C-c C-c <1>: Lists and Menus. (line 109) -* C-c C-c <2>: Creating Topics and Posts. +* C-c C-c: Creating Topics and Posts. (line 37) +* C-c C-c [in notifications list buffer]: Lists and Menus. (line 97) +* C-c C-c [in repositories list buffer]: Lists and Menus. (line 109) * C-c C-c [in topics list buffer/section]: Lists and Menus. (line 53) * C-c C-e: Creating Topics and Posts. (line 45) @@ -1878,7 +1898,7 @@ Appendix E Function and Command Index (line 45) * forge-repositories-menu: Lists and Menus. (line 109) * forge-reset-database: Miscellaneous Commands. - (line 85) + (line 91) * forge-toggle-display-in-status-buffer: Miscellaneous Commands. (line 33) * forge-toggle-topic-legend: Miscellaneous Commands. @@ -1911,6 +1931,7 @@ Appendix F Variable Index (line 6) * forge-limit-topic-choices: Miscellaneous Options. (line 41) +* forge-list-buffer-default-topic-filters: Lists and Menus. (line 163) * forge-owned-accounts: Lists and Menus. (line 127) * forge-owned-ignored: Lists and Menus. (line 140) * forge-post-fill-region: Miscellaneous Options. @@ -1919,9 +1940,7 @@ Appendix F Variable Index (line 45) * forge-repository-list-columns: Miscellaneous Options. (line 28) -* forge-status-buffer-default-topic-filters: Lists and Menus. (line 163) -* forge-status-buffer-default-topic-filters <1>: Lists and Menus. - (line 167) +* forge-status-buffer-default-topic-filters: Lists and Menus. (line 167) * forge-topic-repository-slug-width: Miscellaneous Options. (line 17) * forge-topic-wash-title-hook: Miscellaneous Options. @@ -1946,64 +1965,64 @@ Ref: Create and Store an Access Token (1)8988 Node: Setup for Gitlabcom11089 Ref: Set your Username (2)11292 Ref: Create and Store an Access Token (2)11622 -Node: Setup for Another Gitlab Instance13513 -Ref: Tell Forge about the Instance (1)14074 -Ref: Set your Username (3)15415 -Ref: Create and Store an Access Token (3)15723 -Node: Setup a Partially Supported Host17775 -Ref: Tell Forge about the Instance (2)18460 -Ref: Add Support for Additional Forge Types19956 -Node: Initial Pull21127 -Node: Getting Started22334 -Node: Lists and Menus24620 -Ref: Dispatch and configuration menus26444 -Ref: Topic menu and list commands26903 -Ref: Notification menu and list commands28840 -Ref: Repository menu and list commands29217 -Ref: Exiting menus and lists30984 -Ref: Default topic filters31679 -Ref: Topic sections in Magit status buffers32119 -Node: Visiting Topics33350 -Node: Creating Topics and Posts36241 -Node: Editing Topics38323 -Node: Pulling39948 -Node: Branching42110 -Node: Miscellaneous Commands48503 -Node: Miscellaneous Options52227 -Node: How Forge Detection Works54691 -Node: Supported Forges and Hosts60228 -Node: Supported Forges61537 -Ref: Github61693 -Ref: Github Caveats61848 -Ref: Github Hosts62510 -Ref: Gitlab62582 -Ref: Gitlab Caveats62609 -Ref: Gitlab Hosts62750 -Node: Partially Supported Forges62886 -Ref: Forgejo https//forgejoorg63092 -Ref: Forgejo Hosts63218 -Ref: Gitea https//giteaio63294 -Ref: Gogs https//gogsio63522 -Ref: Bitbucket https//bitbucketorg63766 -Ref: Bitbucket Caveats63980 -Ref: Bitbucket Hosts64893 -Node: Supported Semi-Forges64974 -Ref: Gitweb https//git-scmcom/docs/gitweb65145 -Ref: Gitweb Caveats65240 -Ref: Cgit https//gitzx2c4com/cgit/about65496 -Ref: Cgit Caveats65589 -Ref: Cgit Hosts65954 -Ref: Stgit https//codemadnessorg/git/stagit/file/READMEhtml66097 -Ref: Stgit Caveats66230 -Ref: Stgit Hosts66532 -Ref: Srht https//metasrht66608 -Ref: Srht Caveats66673 -Ref: Srht Hosts66972 -Node: FAQ67039 -Node: error in process filter HTTP Error 502 "Bad gateway"67449 -Node: Keystroke Index68930 -Node: Function and Command Index74910 -Node: Variable Index81263 +Node: Setup for Another Gitlab Instance13655 +Ref: Tell Forge about the Instance (1)14216 +Ref: Set your Username (3)15557 +Ref: Create and Store an Access Token (3)15865 +Node: Setup a Partially Supported Host18541 +Ref: Tell Forge about the Instance (2)19226 +Ref: Add Support for Additional Forge Types20722 +Node: Initial Pull21893 +Node: Getting Started23100 +Node: Lists and Menus25386 +Ref: Dispatch and configuration menus27210 +Ref: Topic menu and list commands27669 +Ref: Notification menu and list commands29580 +Ref: Repository menu and list commands29988 +Ref: Exiting menus and lists31785 +Ref: Default topic filters32480 +Ref: Topic sections in Magit status buffers32918 +Node: Visiting Topics34149 +Node: Creating Topics and Posts37040 +Node: Editing Topics39122 +Node: Pulling40747 +Node: Branching42909 +Node: Miscellaneous Commands49302 +Node: Miscellaneous Options53266 +Node: How Forge Detection Works55730 +Node: Supported Forges and Hosts61267 +Node: Supported Forges62576 +Ref: Github62732 +Ref: Github Caveats62887 +Ref: Github Hosts63549 +Ref: Gitlab63621 +Ref: Gitlab Caveats63648 +Ref: Gitlab Hosts63789 +Node: Partially Supported Forges63925 +Ref: Forgejo https//forgejoorg64131 +Ref: Forgejo Hosts64253 +Ref: Gitea https//giteaio64329 +Ref: Gogs https//gogsio64553 +Ref: Bitbucket https//bitbucketorg64793 +Ref: Bitbucket Caveats65003 +Ref: Bitbucket Hosts65916 +Node: Supported Semi-Forges65997 +Ref: Gitweb https//git-scmcom/docs/gitweb66168 +Ref: Gitweb Caveats66259 +Ref: Cgit https//gitzx2c4com/cgit/about66515 +Ref: Cgit Caveats66604 +Ref: Cgit Hosts66969 +Ref: Stgit https//codemadnessorg/git/stagit/file/READMEhtml67112 +Ref: Stgit Caveats67241 +Ref: Stgit Hosts67543 +Ref: Srht https//metasrht67619 +Ref: Srht Caveats67680 +Ref: Srht Hosts67979 +Node: FAQ68046 +Node: error in process filter HTTP Error 502 "Bad gateway"68456 +Node: Keystroke Index69937 +Node: Function and Command Index75917 +Node: Variable Index82270  End Tag Table -- 2.47.3