--- /dev/null
+This is the file .../info/dir, which contains the
+topmost node of the Info hierarchy, called (dir)Top.
+The first time you invoke Info you start off looking at this node.
+\1f
+File: dir, Node: Top This is the top of the INFO tree
+
+ This (the Directory node) gives a menu of major topics.
+ Typing "q" exits, "H" lists all Info commands, "d" returns here,
+ "h" gives a primer for first-timers,
+ "mEmacs<Return>" visits the Emacs manual, etc.
+
+ In Emacs, you can click mouse button 2 on a menu item or cross reference
+ to select it.
+
+* Menu:
+
+Emacs
+* Forge: (forge). Access Git Forges from Magit.
--- /dev/null
+;;; forge-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
+;; Generated by the `loaddefs-generate' function.
+
+;; This file is part of GNU Emacs.
+
+;;; Code:
+
+(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
+
+
+\f
+;;; Generated autoloads from forge.el
+
+(defvar forge-add-default-bindings t "\
+Whether to add Forge's bindings to various Magit keymaps.
+
+If you want to disable this, then you must set this to nil before
+`magit' is loaded. If you do it before `forge' but after `magit'
+is loaded, then `magit-mode-map' ends up being modified anyway.")
+(with-eval-after-load 'magit-mode (when forge-add-default-bindings (keymap-set magit-mode-map "'" #'forge-dispatch) (keymap-set magit-mode-map "N" #'forge-dispatch) (keymap-set magit-mode-map "<remap> <magit-browse-thing>" #'forge-browse) (keymap-set magit-mode-map "<remap> <magit-copy-thing>" #'forge-copy-url-at-point-as-kill)))
+(with-eval-after-load 'git-commit (when forge-add-default-bindings (keymap-set git-commit-mode-map "C-c C-v" #'forge-visit-topic)))
+(register-definition-prefixes "forge" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-bitbucket.el
+
+(register-definition-prefixes "forge-bitbucket" '("forge-bitbucket-repository"))
+
+\f
+;;; Generated autoloads from forge-commands.el
+
+ (autoload 'forge-dispatch "forge-commands" nil t)
+ (autoload 'forge-configure "forge-commands" nil t)
+(autoload 'forge-pull "forge-commands" "\
+Pull forge topics for the current repository if it is already tracked.
+If the current repository is still untracked locally, or the current
+repository cannot be determined, instead invoke `forge-add-repository'." t)
+(autoload 'forge-pull-notifications "forge-commands" "\
+Fetch notifications for all repositories from the current forge." t)
+ (autoload 'forge-pull-topic "forge-commands" nil t)
+ (autoload 'forge-pull-this-topic "forge-commands" nil t)
+(autoload 'forge-browse-issues "forge-commands" "\
+Visit the current repository's issues using a browser." t)
+(autoload 'forge-browse-pullreqs "forge-commands" "\
+Visit the current repository's pull-requests using a browser." t)
+(autoload 'forge-browse-topic "forge-commands" "\
+Read a TOPIC and visit it using a browser.
+By default only offer open topics but with a prefix argument
+also offer closed topics.
+
+(fn TOPIC)" 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
+also offer closed issues.
+
+(fn ISSUE)" t)
+(autoload 'forge-browse-pullreq "forge-commands" "\
+Read a PULL-REQUEST and visit it using a browser.
+By default only offer open pull-requests but with a prefix
+argument also offer closed pull-requests.
+
+(fn PULL-REQUEST)" t)
+(autoload 'forge-browse-commit "forge-commands" "\
+Read a COMMIT and visit it using a browser.
+
+(fn COMMIT)" t)
+(autoload 'forge-browse-branch "forge-commands" "\
+Read a BRANCH and visit it using a browser.
+
+(fn BRANCH)" t)
+(autoload 'forge-browse-remote "forge-commands" "\
+Read a REMOTE and visit it using a browser.
+
+(fn REMOTE)" t)
+(autoload 'forge-browse-repository "forge-commands" "\
+Read a REPOSITORY and visit it using a browser.
+
+(fn REPOSITORY)" t)
+ (autoload 'forge-browse-this-topic "forge-commands" nil t)
+(autoload 'forge-browse-this-repository "forge-commands" "\
+Visit the repository at point using a browser." t)
+(autoload 'forge-copy-url-at-point-as-kill "forge-commands" "\
+Copy the url of the thing at point." t)
+(autoload 'forge-browse "forge-commands" "\
+Visit the thing at point using a browser." t)
+(autoload 'forge-visit-topic "forge-commands" "\
+Read a TOPIC and visit it.
+By default only offer open topics for completion;
+with a prefix argument also closed topics.
+
+(fn TOPIC)" t)
+(autoload 'forge-visit-issue "forge-commands" "\
+Read an ISSUE and visit it.
+By default only offer open topics for completion;
+with a prefix argument also closed topics.
+
+(fn ISSUE)" t)
+(autoload 'forge-visit-pullreq "forge-commands" "\
+Read a PULL-REQUEST and visit it.
+By default only offer open topics for completion;
+with a prefix argument also closed topics.
+
+(fn PULL-REQUEST)" t)
+(autoload 'forge-visit-this-topic "forge-commands" "\
+Visit the topic at point." t)
+(autoload 'forge-visit-this-repository "forge-commands" "\
+Visit the repository at point." t)
+(autoload 'forge-branch-pullreq "forge-commands" "\
+Create and configure a new branch from a pull-request.
+Please see the manual for more information.
+
+(fn PULLREQ)" t)
+(autoload 'forge-checkout-pullreq "forge-commands" "\
+Create, configure and checkout a new branch from a pull-request.
+Please see the manual for more information.
+
+(fn PULLREQ)" t)
+(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
+information.
+
+(fn PATH PULLREQ)" t)
+(autoload 'forge-fork "forge-commands" "\
+Fork the current repository to FORK and add it as a REMOTE.
+If the fork already exists, then that isn't an error; the remote
+is added anyway. Currently this only supports Github and Gitlab.
+
+(fn FORK REMOTE)" t)
+(autoload 'forge-merge "forge-commands" "\
+Merge the current pull-request using METHOD using the forge's API.
+
+If there is no current pull-request or with a prefix argument,
+then read pull-request PULLREQ to visit instead.
+
+Use of this command is discouraged. Unless the remote repository
+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.
+
+(fn PULLREQ METHOD)" t)
+(autoload 'forge-rename-default-branch "forge-commands" "\
+Rename the default branch to NEWNAME.
+Change the name on the upstream remote and locally, and update
+the upstream remotes of local branches accordingly." t)
+ (autoload 'forge-add-pullreq-refspec "forge-commands" nil t)
+ (autoload 'forge-add-repository "forge-commands" nil t)
+(autoload 'forge-add-user-repositories "forge-commands" "\
+Add all of USER's repositories from HOST to the database.
+This may take a while. Only Github is supported at the moment.
+
+(fn HOST USER)" t)
+(autoload 'forge-add-organization-repositories "forge-commands" "\
+Add all of ORGANIZATION's repositories from HOST to the database.
+This may take a while. Only Github is supported at the moment.
+
+(fn HOST ORGANIZATION)" t)
+(autoload 'forge-remove-repository "forge-commands" "\
+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.
+
+(fn TOPIC)" t)
+(autoload 'forge-reset-database "forge-commands" "\
+Move the current database file to the trash.
+This is useful after the database scheme has changed, which will
+happen a few times while the forge functionality is still under
+heavy development." t)
+(register-definition-prefixes "forge-commands" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-core.el
+
+(register-definition-prefixes "forge-core" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-db.el
+
+(register-definition-prefixes "forge-db" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-gitea.el
+
+(register-definition-prefixes "forge-gitea" '("forge-gitea-repository"))
+
+\f
+;;; Generated autoloads from forge-github.el
+
+(register-definition-prefixes "forge-github" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-gitlab.el
+
+(register-definition-prefixes "forge-gitlab" '("forge-gitlab-repository"))
+
+\f
+;;; Generated autoloads from forge-gogs.el
+
+(register-definition-prefixes "forge-gogs" '("forge-gogs-repository"))
+
+\f
+;;; Generated autoloads from forge-issue.el
+
+(register-definition-prefixes "forge-issue" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-notify.el
+
+(autoload 'forge-list-notifications "forge-notify" "\
+List notifications." t)
+(register-definition-prefixes "forge-notify" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-post.el
+
+(register-definition-prefixes "forge-post" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-pullreq.el
+
+(register-definition-prefixes "forge-pullreq" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-repo.el
+
+(register-definition-prefixes "forge-repo" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-repos.el
+
+ (autoload 'forge-repositories-menu "forge-repos" nil t)
+ (autoload 'forge-list-repositories "forge-repos" nil t)
+ (autoload 'forge-list-owned-repositories "forge-repos" nil t)
+(register-definition-prefixes "forge-repos" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-revnote.el
+
+(register-definition-prefixes "forge-revnote" '("forge-revnote"))
+
+\f
+;;; Generated autoloads from forge-semi.el
+
+(register-definition-prefixes "forge-semi" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-tablist.el
+
+(register-definition-prefixes "forge-tablist" '("forge--"))
+
+\f
+;;; Generated autoloads from forge-topic.el
+
+ (autoload 'forge-topic-menu "forge-topic" nil t)
+ (autoload 'forge-topic-state-menu "forge-topic" nil t)
+ (autoload 'forge-topic-status-menu "forge-topic" nil t)
+(register-definition-prefixes "forge-topic" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-topics.el
+
+ (autoload 'forge-topics-menu "forge-topics" nil t)
+ (autoload 'forge-list-topics "forge-topics" nil t)
+ (autoload 'forge-list-labeled-topics "forge-topics" nil t)
+ (autoload 'forge-list-assigned-topics "forge-topics" nil t)
+ (autoload 'forge-list-authored-topics "forge-topics" nil t)
+ (autoload 'forge-list-owned-topics "forge-topics" nil t)
+ (autoload 'forge-list-issues "forge-topics" nil t)
+ (autoload 'forge-list-labeled-issues "forge-topics" nil t)
+ (autoload 'forge-list-assigned-issues "forge-topics" nil t)
+ (autoload 'forge-list-authored-issues "forge-topics" nil t)
+ (autoload 'forge-list-owned-issues "forge-topics" nil t)
+ (autoload 'forge-list-pullreqs "forge-topics" nil t)
+ (autoload 'forge-list-labeled-pullreqs "forge-topics" nil t)
+ (autoload 'forge-list-assigned-pullreqs "forge-topics" nil t)
+ (autoload 'forge-list-requested-reviews "forge-topics" nil t)
+ (autoload 'forge-list-authored-pullreqs "forge-topics" nil t)
+ (autoload 'forge-list-owned-pullreqs "forge-topics" nil t)
+(register-definition-prefixes "forge-topics" '("forge-"))
+\f
+;;; End of scraped data
+
+(provide 'forge-autoloads)
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; no-native-compile: t
+;; coding: utf-8-emacs-unix
+;; End:
+
+;;; forge-autoloads.el ends here
--- /dev/null
+;;; forge-bitbucket.el --- Bitbucket support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'buck)
+(require 'forge)
+
+;;; Class
+
+(defclass forge-bitbucket-repository (forge-noapi-repository)
+ ((issues-url-format :initform "https://%h/%o/%n/issues")
+ (issue-url-format :initform "https://%h/%o/%n/issues/%i")
+ ;; The anchor for the issue itself is .../%i#issue-%i
+ (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#comment-%I")
+ (pullreqs-url-format :initform "https://%h/%o/%n/pull-requests")
+ (pullreq-url-format :initform "https://%h/%o/%n/pull-requests/%i")
+ (pullreq-post-url-format :initform "https://%h/%o/%n/pull-requests/%i#comment-%I")
+ (commit-url-format :initform "https://%h/%o/%n/commits/%r")
+ (branch-url-format :initform "https://%h/%o/%n/branch/%r")
+ (remote-url-format :initform "https://%h/%o/%n/src")
+ (create-issue-url-format :initform "https://%h/%o/%n/issues/new")
+ (create-pullreq-url-format :initform "https://%h/%o/%n/pull-requests/new")))
+
+;;; _
+(provide 'forge-bitbucket)
+;;; forge-bitbucket.el ends here
--- /dev/null
+;;; forge-commands.el --- Commands -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'forge)
+
+;;; Options
+
+(defcustom forge-add-pullreq-refspec t
+ "Whether the pull-request refspec is added when setting up a repository.
+
+This controls whether running `forge-pull' for the first time in
+a repository also adds a refspec that fetches all pull-requests.
+In repositories with huge numbers of pull-requests you might want
+to not do so, in which case you should set this option to `ask'.
+
+You can also set this to nil and later add the refspec explicitly
+for a repository using the command `forge-add-pullreq-refspec'."
+ :package-version '(forge . "0.2.0")
+ :group 'forge
+ :type '(choice (const :tag "Always add refspec" t)
+ (const :tag "Ask every time" ask)
+ (const :tag "Never add refspec" nil)))
+
+(defcustom forge-checkout-worktree-read-directory-function
+ 'forge-checkout-worktree-default-read-directory-function
+ "Function used by `forge-checkout-worktree' to read worktree directory.
+Takes the pull-request as only argument and must return a directory."
+ :package-version '(forge . "0.4.0")
+ :group 'forge
+ :type 'function)
+
+;;; Dispatch
+
+;;;###autoload (autoload 'forge-dispatch "forge-commands" nil t)
+(transient-define-prefix forge-dispatch ()
+ "Dispatch a forge command."
+ [:if forge--get-repository:tracked?
+ ["Create"
+ ("c i" "issue" forge-create-issue)
+ ("c p" "pull-request" forge-create-pullreq)
+ ("c u" "pull-request from issue"
+ forge-create-pullreq-from-issue
+ :if forge--get-github-repository)
+ ("c f" "fork or remote" forge-fork)]]
+ [:if forge--get-repository:tracked?
+ ["List"
+ ("t" "topics... " forge-topics-menu :transient replace)
+ ("n" "notifications... " forge-notifications-menu :transient replace)
+ ("r" "repositories... " forge-repositories-menu :transient replace)]
+ ["Fetch"
+ ("f f" "all topics " forge-pull)
+ ("f t" "one topic " forge-pull-topic)
+ ("f n" "notifications " forge-pull-notifications)]
+ ["Do"
+ :if forge--get-repository:tracked?
+ ("C" "configure" forge-configure)
+ ("M" "merge w/api" forge-merge :level 7)]]
+ [:if forge--get-repository:tracked?
+ ["Visit"
+ ("v t" "topic" forge-visit-topic)
+ ("v i" "issue" forge-visit-issue)
+ ("v p" "pull-request" forge-visit-pullreq)]
+ ["Browse"
+ ("b t" "topic" forge-browse-topic)
+ ("b i" "issue" forge-browse-issue)
+ ("b p" "pull-request" forge-browse-pullreq)]
+ ["Browse"
+ ("b r" "remote" forge-browse-remote)
+ ("b I" "issues" forge-browse-issues)
+ ("b P" "pull-requests" forge-browse-pullreqs)]]
+ [[:description (lambda ()
+ (if (magit-gitdir)
+ "Forge doesn't know about this Git repository yet"
+ "Not inside a Git repository"))
+ :if-not forge--get-repository:tracked?
+ ("a" "add repository to database" forge-add-repository)
+ ("f" "fetch notifications" forge-pull-notifications)
+ ("l" "list notifications" forge-list-notifications)]])
+
+;;;###autoload (autoload 'forge-configure "forge-commands" nil t)
+(transient-define-prefix forge-configure ()
+ "Configure current repository and global settings."
+ [["Configure"
+ :if forge--get-repository:tracked?
+ ("a " "add another repository to database" forge-add-some-repository)
+ ("R " forge-add-pullreq-refspec)
+ ("s r" forge-forge.remote)
+ ("s l" forge-forge.graphqlItemLimit)
+ ("s s" forge-toggle-display-in-status-buffer)
+ ("s c" forge-toggle-closed-visibility)]])
+
+;;; Pull
+
+;;;###autoload
+(defun forge-pull ()
+ "Pull forge topics for the current repository if it is already tracked.
+If the current repository is still untracked locally, or the current
+repository cannot be determined, instead invoke `forge-add-repository'."
+ (interactive)
+ (if-let ((repo (forge-get-repository :tracked?)))
+ (forge--pull repo)
+ (transient-setup 'forge-add-repository nil nil
+ :scope (forge-get-repository :stub))))
+
+(defun forge-read-date (prompt)
+ (require (quote org) nil)
+ (if (fboundp 'org-read-date)
+ (org-read-date nil nil nil prompt)
+ (cl-block nil
+ (while t
+ (let ((str (read-from-minibuffer prompt)))
+ (cond ((string-equal str "")
+ (cl-return nil))
+ ((string-match-p
+ "\\`[0-9]\\{4\\}[-/][0-9]\\{2\\}[-/][0-9]\\{2\\}\\'" str)
+ (cl-return str))))
+ (message "Please enter a date in the format YYYY-MM-DD.")
+ (sit-for 1)))))
+
+(cl-defmethod forge--pull ((repo forge-noapi-repository) &rest _)
+ (forge--msg repo t t "Pulling from REPO is not supported"))
+
+(cl-defmethod forge--pull ((repo forge-unusedapi-repository) &rest _)
+ (magit-git-fetch (oref repo remote) (magit-fetch-arguments)))
+
+(defun forge--maybe-git-fetch (repo &optional buffer)
+ (if (and (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (and (derived-mode-p 'magit-mode)
+ (forge-repository-equal (forge-get-repository :stub?) repo))))
+ (with-current-buffer buffer
+ (magit-git-fetch (oref repo remote) (magit-fetch-arguments)))
+ (when-let ((worktree (forge-get-worktree repo)))
+ (let ((default-directory worktree)
+ (magit-inhibit-refresh t))
+ (magit-git-fetch (oref repo remote) (magit-fetch-arguments))))))
+
+;;;###autoload
+(defun forge-pull-notifications ()
+ "Fetch notifications for all repositories from the current forge."
+ (interactive)
+ (if-let ((repo (forge-get-repository :stub?)))
+ (let ((class (eieio-object-class repo)))
+ (if (eq class 'forge-github-repository)
+ (forge--pull-notifications class (oref repo githost))
+ (user-error "Fetching notifications not supported for forge %S"
+ (oref repo forge))))
+ (forge--pull-notifications 'forge-github-repository "github.com")))
+
+;;;###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 #'forge--get-github-repository
+ (interactive
+ (list (read-number "Pull topic: "
+ (and-let* ((topic (forge-current-topic)))
+ (oref topic number)))))
+ (forge--pull-topic (forge-get-repository :tracked) number))
+
+;;;###autoload (autoload 'forge-pull-this-topic "forge-commands" nil t)
+(transient-define-suffix forge-pull-this-topic ()
+ "Pull data about the topic at point from its forge."
+ :inapt-if-not #'forge--get-github-repository
+ :description "fetch"
+ (interactive)
+ (let ((topic (forge-current-topic t)))
+ (forge--pull-topic (forge-get-repository topic) topic)))
+
+(cl-defmethod forge--pull-topic ((repo forge-repository) _topic)
+ (error "Fetching an individual topic not implemented for %s"
+ (eieio-object-class repo)))
+
+;;; Browse
+
+;;;###autoload
+(defun forge-browse-issues ()
+ "Visit the current repository's issues using a browser."
+ (interactive)
+ (browse-url (forge--format (forge-get-repository :stub)
+ 'issues-url-format)))
+
+;;;###autoload
+(defun forge-browse-pullreqs ()
+ "Visit the current repository's pull-requests using a browser."
+ (interactive)
+ (browse-url (forge--format (forge-get-repository :stub)
+ 'pullreqs-url-format)))
+
+;;;###autoload
+(defun forge-browse-topic (topic)
+ "Read a TOPIC and visit it using a browser.
+By default only offer open topics but with a prefix argument
+also offer closed topics."
+ (interactive (list (forge-read-topic "Browse topic")))
+ (forge--browse-topic topic))
+
+;;;###autoload
+(defun forge-browse-issue (issue)
+ "Read an ISSUE and visit it using a browser.
+By default only offer open issues but with a prefix argument
+also offer closed issues."
+ (interactive (list (forge-read-issue "Browse issue")))
+ (forge--browse-topic issue))
+
+;;;###autoload
+(defun forge-browse-pullreq (pull-request)
+ "Read a PULL-REQUEST and visit it using a browser.
+By default only offer open pull-requests but with a prefix
+argument also offer closed pull-requests."
+ (interactive (list (forge-read-pullreq "Browse pull-request")))
+ (forge--browse-topic pull-request))
+
+(defun forge--browse-topic (topic)
+ (let ((obj (forge-get-topic topic)))
+ (browse-url (forge-get-url obj))
+ (forge-topic-mark-read obj)))
+
+;;;###autoload
+(defun forge-browse-commit (commit)
+ "Read a COMMIT and visit it using a browser."
+ (interactive
+ (list (or (magit-completing-read "Browse commit"
+ (magit-list-branch-names)
+ nil nil nil 'magit-revision-history
+ (magit-branch-or-commit-at-point))
+ (user-error "Nothing selected"))))
+ (browse-url (forge-get-url :commit commit)))
+
+;;;###autoload
+(defun forge-browse-branch (branch)
+ "Read a BRANCH and visit it using a browser."
+ (interactive (list (magit-read-branch "Browse branch")))
+ (browse-url (forge-get-url :branch branch)))
+
+;;;###autoload
+(defun forge-browse-remote (remote)
+ "Read a REMOTE and visit it using a browser."
+ (interactive (list (magit-read-remote "Browse remote" nil t)))
+ (browse-url (forge-get-url :remote remote)))
+
+;;;###autoload
+(defun forge-browse-repository (repository)
+ "Read a REPOSITORY and visit it using a browser."
+ (interactive (list (forge-read-repository "Browse repository")))
+ (browse-url (forge-get-url repository)))
+
+;;;###autoload (autoload 'forge-browse-this-topic "forge-commands" nil t)
+(transient-define-suffix forge-browse-this-topic ()
+ "Visit the topic at point using a browser."
+ :description "browse"
+ (interactive)
+ (forge-browse-topic (forge-current-topic t)))
+
+;;;###autoload
+(defun forge-browse-this-repository ()
+ "Visit the repository at point using a browser."
+ (interactive)
+ (forge-browse-repository (forge-repository-at-point t)))
+
+;;;###autoload
+(defun forge-copy-url-at-point-as-kill ()
+ "Copy the url of the thing at point."
+ (interactive)
+ (if-let ((target (forge--browse-target)))
+ (let ((url (if (stringp target) target (forge-get-url target))))
+ (kill-new url)
+ (message "Copied \"%s\"" url))
+ (user-error "Nothing at point with a URL")))
+
+;;;###autoload
+(defun forge-browse ()
+ "Visit the thing at point using a browser."
+ (interactive)
+ (if-let ((target (forge--browse-target)))
+ (if (stringp target)
+ (browse-url target)
+ (browse-url (forge-get-url target))
+ (when (cl-typep target 'forge-topic)
+ (forge-topic-mark-read target)))
+ (user-error "Nothing to browse here")))
+
+(defun forge--browse-target ()
+ (or (and-let* ((branch (magit--painted-branch-at-point)))
+ (forge-get-url :branch branch))
+ (and-let* ((commit (magit-commit-at-point)))
+ (forge-get-url :commit commit))
+ (and-let* ((branch (magit-branch-at-point)))
+ (forge-get-url :branch branch))
+ (and-let* ((remote (magit-remote-at-point)))
+ (forge-get-url :remote remote))
+ (forge-post-at-point)
+ (forge-current-topic)
+ (and magit-buffer-revision
+ (forge-get-url :commit magit-buffer-revision))
+ (forge-current-repository)))
+
+;;;; Urls
+
+(cl-defgeneric forge-get-url (obj)
+ "Return the URL for a forge object.")
+
+(cl-defmethod forge-get-url ((issue forge-issue))
+ (forge--format issue 'issue-url-format))
+
+(cl-defmethod forge-get-url ((pullreq forge-pullreq))
+ (forge--format pullreq 'pullreq-url-format))
+
+(cl-defmethod forge-get-url ((repo forge-repository))
+ (forge--format repo 'remote-url-format))
+
+(cl-defmethod forge-get-url ((_(eql :commit)) commit)
+ (let ((repo (forge-get-repository :stub)))
+ (unless (magit-list-containing-branches
+ commit "-r" (concat (oref repo remote) "/*"))
+ (if-let* ((branch (car (magit-list-containing-branches commit "-r")))
+ (remote (cdr (magit-split-branch-name branch))))
+ (setq repo (forge-get-repository :stub remote))
+ (message "%s does not appear to be available on any remote. %s"
+ commit "You might have to push it first.")))
+ (forge--format repo 'commit-url-format
+ `((?r . ,(magit-commit-p commit))))))
+
+(cl-defmethod forge-get-url ((_(eql :branch)) branch)
+ (let (remote)
+ (if (magit-remote-branch-p branch)
+ (let ((cons (magit-split-branch-name branch)))
+ (setq remote (car cons))
+ (setq branch (cdr cons)))
+ (unless (setq remote (or (magit-get-push-remote branch)
+ (magit-get-upstream-remote branch)))
+ (user-error "Cannot determine remote for %s" branch)))
+ (forge--format (forge-get-repository :stub remote)
+ 'branch-url-format
+ `((?r . ,branch)))))
+
+(cl-defmethod forge-get-url ((_(eql :remote)) remote)
+ (forge--format (forge-get-repository :stub remote) 'remote-url-format))
+
+(cl-defmethod forge-get-url ((post forge-post))
+ (forge--format post (let ((topic (forge-get-parent post)))
+ (cond ((forge--childp topic 'forge-issue)
+ 'issue-post-url-format)
+ ((forge--childp topic 'forge-pullreq)
+ 'pullreq-post-url-format)))))
+
+(cl-defmethod forge-get-url ((notify forge-notification))
+ (oref notify url))
+
+;;; Visit
+
+;;;###autoload
+(defun forge-visit-topic (topic)
+ "Read a TOPIC and visit it.
+By default only offer open topics for completion;
+with a prefix argument also closed topics."
+ (interactive (list (forge-read-topic "View topic")))
+ (forge-topic-setup-buffer (forge-get-topic topic)))
+
+;;;###autoload
+(defun forge-visit-issue (issue)
+ "Read an ISSUE and visit it.
+By default only offer open topics for completion;
+with a prefix argument also closed topics."
+ (interactive (list (forge-read-issue "View issue")))
+ (forge-topic-setup-buffer (forge-get-issue issue)))
+
+;;;###autoload
+(defun forge-visit-pullreq (pull-request)
+ "Read a PULL-REQUEST and visit it.
+By default only offer open topics for completion;
+with a prefix argument also closed topics."
+ (interactive (list (forge-read-pullreq "View pull-request")))
+ (forge-topic-setup-buffer (forge-get-pullreq pull-request)))
+
+;;;###autoload
+(defun forge-visit-this-topic ()
+ "Visit the topic at point."
+ (interactive)
+ (forge-topic-setup-buffer (forge-topic-at-point)))
+
+;;;###autoload
+(defun forge-visit-this-repository ()
+ "Visit the repository at point."
+ (interactive)
+ (let* ((repo (forge-repository-at-point))
+ (worktree (forge-get-worktree repo)))
+ (cond
+ ((eq transient-current-command 'forge-repositories-menu)
+ (if-let ((buffer (forge-topic-get-buffer repo)))
+ (switch-to-buffer buffer)
+ (forge-list-topics repo))
+ (transient-setup 'forge-topics-menu))
+ (worktree
+ (magit-status-setup-buffer worktree))
+ ((forge-list-topics repo)))))
+
+;;; Create
+
+(defun forge-create-issue ()
+ "Create a new issue for the current repository."
+ (interactive)
+ (let* ((repo (forge-get-repository :tracked))
+ (buf (forge--prepare-post-buffer
+ "new-issue"
+ (forge--format repo "Create new issue on %p"))))
+ (when buf
+ (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))
+ (let* ((repo (forge-get-repository :tracked))
+ (buf (forge--prepare-post-buffer
+ "new-pullreq"
+ (forge--format repo "Create new pull-request on %p")
+ source target)))
+ (with-current-buffer buf
+ (setq forge--buffer-base-branch target)
+ (setq forge--buffer-head-branch source)
+ (setq forge--buffer-post-object repo)
+ (setq forge--submit-post-function #'forge--submit-create-pullreq)
+ (run-hooks 'forge-create-pullreq-hook))
+ (forge--display-post-buffer buf)))
+
+(transient-define-suffix forge-create-pullreq-from-issue (issue source target)
+ "Convert an existing ISSUE into a pull-request."
+ :description "convert to pull-request"
+ :if (lambda ()
+ (let ((issue (forge-current-issue)))
+ (and issue (eq (oref issue state) 'open)
+ issue)))
+ (interactive (cons (forge-read-open-issue "Convert issue")
+ (forge-create-pullreq--read-args)))
+ (setq issue (forge-get-issue issue))
+ (forge--create-pullreq-from-issue (forge-get-repository issue)
+ issue source target))
+
+(defun forge-create-pullreq--read-args ()
+ (let* ((source (magit-completing-read
+ "Source branch"
+ (magit-list-remote-branch-names)
+ nil t nil 'magit-revision-history
+ (or (and-let* ((d (magit-branch-at-point)))
+ (if (magit-remote-branch-p d)
+ d
+ (magit-get-push-branch d t)))
+ (and-let* ((d (magit-get-current-branch)))
+ (if (magit-remote-branch-p d)
+ d
+ (magit-get-push-branch d t))))))
+ (repo (forge-get-repository :tracked))
+ (remote (oref repo remote))
+ (targets (delete source (magit-list-remote-branch-names remote)))
+ (target (magit-completing-read
+ "Target branch" targets nil t nil 'magit-revision-history
+ (let* ((d (cdr (magit-split-branch-name source)))
+ (d (and (magit-branch-p d) d))
+ (d (and d (magit-get-upstream-branch d)))
+ (d (and d (if (magit-remote-branch-p d)
+ d
+ (magit-get-upstream-branch d))))
+ (d (or d (concat remote "/"
+ (or (oref repo default-branch)
+ "master")))))
+ (car (member d targets))))))
+ (list source target)))
+
+(defun forge-create-post (&optional quote)
+ "Create a new post on an existing topic.
+If the region is active, then quote that part of the post.
+Otherwise and with a prefix argument quote the post that
+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
+ ((not (magit-section-match 'post)) nil)
+ ((use-region-p)
+ (buffer-substring-no-properties (region-beginning)
+ (region-end)))
+ (quote
+ (let ((section (magit-current-section)))
+ (string-trim-right
+ (buffer-substring-no-properties (oref section content)
+ (oref section end))))))))
+ (with-current-buffer buf
+ (setq forge--buffer-post-object topic)
+ (setq forge--submit-post-function #'forge--submit-create-post)
+ (when quote
+ (goto-char (point-max))
+ (unless (bobp)
+ (insert "\n"))
+ (insert (replace-regexp-in-string "^" "> " quote) "\n\n")))
+ (forge--display-post-buffer buf)))
+
+;;; Edit
+
+(defun forge-edit-post ()
+ "Edit the current post."
+ (interactive)
+ (let* ((post (forge-post-at-point t))
+ (buf (cl-typecase post
+ (forge-topic
+ (forge--prepare-post-buffer
+ (forge--format post "%i")
+ (forge--format post "Edit #%i of %p")))
+ (forge-post
+ (forge--prepare-post-buffer
+ (forge--format post "%i;%I")
+ (forge--format post "Edit comment on #%i of %p"))))))
+ (with-current-buffer buf
+ (setq forge--buffer-post-object post)
+ (setq forge--submit-post-function #'forge--submit-edit-post)
+ (erase-buffer)
+ (when (cl-typep post 'forge-topic)
+ (insert "# " (oref post title) "\n\n"))
+ (insert (oref post body)))
+ (forge--display-post-buffer buf)))
+
+(transient-define-suffix forge-edit-topic-note ()
+ "Edit your private note about the current topic."
+ :transient #'transient--do-quit-all
+ :description
+ (lambda ()
+ (if-let ((topic (forge-current-topic)))
+ (concat "note "
+ (if-let ((note (oref topic note)))
+ (propertize (substring note 0 (string-match-p "$" note))
+ 'face 'font-lock-string-face)
+ (propertize "none" 'face 'magit-dimmed)))
+ "note"))
+ (interactive)
+ (let* ((topic (forge-current-topic t))
+ (buf (forge--prepare-post-buffer
+ (forge--format topic "%i;note")
+ (forge--format topic "New note on #%i of %p"))))
+ (with-current-buffer buf
+ (setq forge--buffer-post-object topic)
+ (setq forge--submit-post-function #'forge--save-note)
+ (erase-buffer)
+ (when-let ((note (oref topic note)))
+ (save-excursion (insert note ?\n))))
+ (forge--display-post-buffer buf)))
+
+;;; Delete
+
+(transient-define-suffix forge-delete-comment ()
+ "Delete the comment at point."
+ :description "delete comment"
+ :inapt-if-not #'forge-comment-at-point
+ (interactive)
+ (let ((comment (forge-comment-at-point t)))
+ (when (yes-or-no-p "Really delete the current comment? ")
+ (forge--delete-comment (forge-get-repository :tracked) comment))))
+
+;;; Branch
+
+;;;###autoload
+(defun forge-branch-pullreq (pullreq)
+ "Create and configure a new branch from a pull-request.
+Please see the manual for more information."
+ (interactive (list (forge-read-pullreq "Branch pull request")))
+ (let ((pullreq (forge-get-pullreq pullreq)))
+ (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-refresh-buffer))))
+
+(cl-defmethod forge--branch-pullreq ((pullreq forge-pullreq))
+ (forge--branch-pullreq (forge-get-repository pullreq) pullreq))
+
+(cl-defmethod forge--branch-pullreq ((_repo forge-unusedapi-repository) pullreq)
+ ;; We don't know enough to do a good job.
+ (let* ((number (oref pullreq number))
+ (branch (format "pr-%s" number)))
+ (when (magit-branch-p branch)
+ (user-error "Branch `%s' already exists" branch))
+ (magit-git "branch" branch (forge--pullreq-ref pullreq))
+ ;; More often than not this is the correct target branch.
+ (magit-call-git "branch" branch "--set-upstream-to=master")
+ (magit-set (number-to-string number) "branch" branch "pullRequest")
+ branch))
+
+(cl-defmethod forge--branch-pullreq ((repo forge-repository) pullreq)
+ (let* ((number (oref pullreq number))
+ (branch-n (format "pr-%s" number))
+ (branch (or (forge--pullreq-branch-internal pullreq) branch-n))
+ (pullreq-ref (format "refs/pullreqs/%s" number)))
+ (cond ((and-let* ((pr-branch (oref pullreq head-ref)))
+ (string-search ":" pr-branch))
+ ;; Such a branch name would be invalid. If we encounter
+ ;; it anyway, then that means that the source branch and
+ ;; the merge-request ref are missing. Luckily Gitlab no
+ ;; longer does this, but we nevertheless have to deal
+ ;; with merge-requests that have been lost in time.
+ (error "Cannot check out this merge-request because %s"
+ "on old Gitlab version discarded the source branch"))
+ ((not (eq (oref pullreq state) 'open))
+ (magit-git "branch" "--force" branch pullreq-ref))
+ (t
+ (let ((upstream (oref repo remote))
+ (pr-remote (oref pullreq head-user))
+ (pr-branch (oref pullreq head-ref)))
+ (cond ((not (oref pullreq cross-repo-p))
+ (let ((tracking (concat upstream "/" pr-branch)))
+ (unless (magit-branch-p tracking)
+ (magit-call-git "fetch" upstream))
+ (forge--setup-pullreq-branch branch tracking)
+ (magit-branch-maybe-adjust-upstream branch tracking)
+ (magit-set upstream "branch" branch "pushRemote")
+ (magit-set upstream "branch" branch "pullRequestRemote")))
+ ((not pr-branch)
+ ;; The pullreq branch (on Github) has been deleted.
+ (setq pr-remote nil)
+ (setq branch branch-n)
+ (forge--setup-pullreq-branch branch pullreq-ref)
+ (magit-set upstream "branch" branch "pushRemote"))
+ (t
+ ;; For prs within the upstream we are more permissive,
+ ;; but any request to merge a branch with a well known
+ ;; name from fork, is highly suspicious and likely the
+ ;; result of a contributor not bothering to name their
+ ;; feature branch.
+ (when (and (member branch magit-main-branch-names)
+ (magit-branch-p branch))
+ (setq branch branch-n))
+ (forge--setup-pullreq-remote pullreq)
+ (forge--setup-pullreq-branch
+ branch (concat pr-remote "/" pr-branch))
+ (if (and (oref pullreq editable-p)
+ (equal branch pr-branch))
+ (magit-set pr-remote "branch" branch "pushRemote")
+ (magit-set upstream "branch" branch "pushRemote"))))
+ (when pr-remote
+ (magit-set pr-remote "branch" branch "pullRequestRemote"))
+ (magit-set "true" "branch" branch "rebase")
+ (magit-git "branch" branch
+ (let ((base-ref (oref pullreq base-ref)))
+ (concat "--set-upstream-to="
+ (if (or magit-branch-prefer-remote-upstream
+ (not (magit-branch-p base-ref)))
+ (concat upstream "/" base-ref)
+ base-ref)))))))
+ (magit-set (number-to-string number) "branch" branch "pullRequest")
+ (magit-set (oref pullreq title) "branch" branch "description")
+ branch))
+
+(defun forge--setup-pullreq-branch (branch tracking)
+ (if (magit-branch-p branch)
+ (unless (magit-rev-equal branch tracking)
+ (message "Existing branch %s diverged from %s" branch tracking))
+ (magit-git "branch" branch tracking)))
+
+(defun forge--setup-pullreq-remote (pullreq)
+ (let* ((pr-remote (oref pullreq head-user))
+ (pr-branch (oref pullreq head-ref))
+ (repo (forge-get-repository pullreq))
+ (host (oref repo githost))
+ (user (oref pullreq head-user))
+ (fork (oref pullreq head-repo)))
+ (if (magit-remote-p pr-remote)
+ (let ((url (magit-git-string "remote" "get-url" pr-remote))
+ (fetch (magit-get-all "remote" pr-remote "fetch")))
+ (unless (equal (forge--split-forge-url url)
+ (list host user (substring fork (1+ (length user)))))
+ (user-error "Remote `%s' already exists but does not point to %s"
+ pr-remote url))
+ (unless (or (member (format "+refs/heads/*:refs/remotes/%s/*"
+ pr-remote)
+ fetch)
+ (member (format "+refs/heads/%s:refs/remotes/%s/%s"
+ pr-branch pr-remote pr-branch)
+ fetch))
+ (magit-git "remote" "set-branches" "--add" pr-remote pr-branch)
+ (magit-git "fetch" pr-remote)))
+ (let ((url (magit-git-string "remote" "get-url" (oref repo remote))))
+ (magit-git
+ "remote" "add" "-f" "--no-tags"
+ "-t" pr-branch pr-remote
+ (cond ((or (string-prefix-p "git@" url)
+ (string-prefix-p "ssh://git@" url))
+ (format "git@%s:%s.git" host fork))
+ ((string-prefix-p "https://" url)
+ (format "https://%s/%s.git" host fork))
+ ((string-prefix-p "git://" url)
+ (format "git://%s/%s.git" host fork))
+ ((string-prefix-p "http://" url)
+ (format "http://%s/%s.git" host fork))
+ ((error "%s has an unexpected format" url))))))))
+
+;;;###autoload
+(defun forge-checkout-pullreq (pullreq)
+ "Create, configure and checkout a new branch from a pull-request.
+Please see the manual for more information."
+ (interactive (list (forge-read-pullreq "Checkout pull request")))
+ (magit--checkout (forge--branch-pullreq (forge-get-pullreq pullreq)))
+ (forge-refresh-buffer))
+
+;;;###autoload
+(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
+information."
+ (interactive
+ (let ((id (forge-read-pullreq "Checkout pull request")))
+ (list (funcall forge-checkout-worktree-read-directory-function
+ (forge-get-pullreq id))
+ id)))
+ (when (and (file-exists-p path)
+ (not (and (file-directory-p path)
+ (length= (directory-files path) 2))))
+ (user-error "%s already exists and isn't empty" path))
+ (magit-worktree-checkout path
+ (forge--branch-pullreq (forge-get-pullreq pullreq))))
+
+(defun forge-checkout-worktree-default-read-directory-function (pullreq)
+ (pcase-let* (((eieio number head-ref) pullreq)
+ (path (read-directory-name
+ (format "Checkout #%s in new worktree: " number)
+ (file-name-directory
+ (directory-file-name default-directory))
+ nil nil
+ (let ((branch (forge--pullreq-branch-internal pullreq)))
+ (if (string-match-p "\\`pr-[0-9]+\\'" branch)
+ (number-to-string number)
+ (format "%s-%s" number
+ (string-replace "/" "-" head-ref)))))))
+ (when (equal path "")
+ (user-error "The empty string isn't a valid path"))
+ path))
+
+;;; Marks
+
+(defun forge-create-mark (name face description)
+ "Define a new mark that topics can be marked with."
+ (interactive
+ (list (read-string "Name: ")
+ (magit-read-char-case "Set appearance using " nil
+ (?n "a face [n]ame"
+ (read-face-name "Face name: "))
+ (?s "face [s]exp"
+ (read-from-minibuffer
+ "Face sexp: "
+ "(:background \"\" :foreground \"\" :box t)"
+ read-expression-map t)))
+ (let ((str (read-string "Description: ")))
+ (and (not (equal str "")) str))))
+ (forge-sql [:insert-into mark :values $v1]
+ (vector nil (forge--uuid) name face description)))
+
+(defun forge-edit-mark (id name face description)
+ "Define a new mark that topics can be marked with."
+ (interactive
+ (pcase-let*
+ ((marks (forge-sql [:select [name id face description] :from mark]))
+ (`(,name ,id ,face ,description)
+ (assoc (completing-read "Edit mark" (mapcar #'car marks) nil t)
+ marks)))
+ (list id
+ (read-string "Name: " name)
+ (magit-read-char-case "Set appearance using " nil
+ (?n "a face [n]ame"
+ (read-face-name "Face name: " (and (symbolp face) face)))
+ (?s "face [s]exp"
+ (read-from-minibuffer
+ "Face sexp: "
+ (if (listp face)
+ (format "%S" face)
+ "(:background \"\" :foreground \"\" :box t)")
+ read-expression-map t)))
+ (let ((str (read-string "Description: " nil nil description)))
+ (and (not (equal str "")) str)))))
+ (forge-sql [:update mark
+ :set (= [name face description] $v1)
+ :where (= id $s2)]
+ (vector name face description) id))
+
+;;; Remotely
+
+;;;###autoload
+(defun forge-fork (fork remote)
+ "Fork the current repository to FORK and add it as a REMOTE.
+If the fork already exists, then that isn't an error; the remote
+is added anyway. Currently this only supports Github and Gitlab."
+ (interactive
+ (let ((fork (magit-completing-read "Fork to"
+ (mapcar #'car forge-owned-accounts))))
+ (list fork
+ (read-string "Remote name: "
+ (or (plist-get (cdr (assoc fork forge-owned-accounts))
+ 'remote-name)
+ fork)))))
+ (let ((repo (forge-get-repository :stub)))
+ (forge--fork-repository repo fork)
+ (magit-remote-add remote
+ (magit-clone--format-url (oref repo githost) fork
+ (oref repo name))
+ (list "--fetch"))))
+
+;;;###autoload
+(defun forge-merge (pullreq method)
+ "Merge the current pull-request using METHOD using the forge's API.
+
+If there is no current pull-request or with a prefix argument,
+then read pull-request PULLREQ to visit instead.
+
+Use of this command is discouraged. Unless the remote repository
+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)))))
+ (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))
+
+;;;###autoload
+(defun forge-rename-default-branch ()
+ "Rename the default branch to NEWNAME.
+Change the name on the upstream remote and locally, and update
+the upstream remotes of local branches accordingly."
+ (interactive)
+ (let* ((repo (forge-get-repository :tracked?))
+ (_ (unless (forge-github-repository-p repo)
+ (user-error "Updating default branch not supported for forge `%s'"
+ (oref repo forge))))
+ (remote (or (and (fboundp 'forge--get-remote)
+ (forge--get-remote))
+ (magit-get-some-remote)
+ (user-error "No remote configured")))
+ (symref (format "refs/remotes/%s/HEAD" remote))
+ (oldhead (progn
+ (message "Determining old default branch...")
+ (magit-git "fetch" "--prune")
+ (magit-git "remote" "set-head" "--auto" remote)
+ (message "Determining old default branch...done")
+ (magit-git-string "symbolic-ref" "--short" symref)))
+ (oldname (if oldhead
+ (cdr (magit-split-branch-name oldhead))
+ (error "Cannot determine old default branch")))
+ (default (and (not (equal oldname "main")) "main"))
+ (newname (read-string
+ (format "Rename default branch `%s' to%s: "
+ oldname
+ (if default (format " (default: %s)" default) ""))
+ nil nil default)))
+ (message "Renaming default branch...")
+ (forge--set-default-branch repo newname oldname)
+ (forge-refresh-buffer)
+ (message "Renaming default branch...done")))
+
+;;; Configuration
+
+(transient-define-infix forge-forge.remote ()
+ "Change the local value of the `forge.remote' Git variable."
+ :class 'magit--git-variable:choices
+ :variable "forge.remote"
+ :choices #'magit-list-remotes
+ :default (lambda (_) (forge--get-remote t)))
+
+(transient-define-infix forge-forge.graphqlItemLimit ()
+ "Change the maximum number of GraphQL entities to pull at once."
+ :if #'forge--get-github-repository
+ :class 'magit--git-variable
+ :variable "forge.graphqlItemLimit"
+ :reader #'read-string
+ :default (lambda () (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."
+ :inapt-if-not (lambda ()
+ (and (eq major-mode 'magit-status-mode)
+ (forge-get-repository :known?)))
+ :description (lambda ()
+ (if forge-display-in-status-buffer
+ "hide all topics"
+ "display topics"))
+ :transient t
+ (interactive)
+ (setq forge-display-in-status-buffer (not forge-display-in-status-buffer))
+ (forge-refresh-buffer))
+
+(transient-define-suffix forge-toggle-closed-visibility ()
+ "Toggle whether to display recently closed topics.
+This only affect the current status buffer."
+ :inapt-if-not (lambda ()
+ (and forge-display-in-status-buffer
+ (eq major-mode 'magit-status-mode)
+ (forge-get-repository :known?)))
+ :description (lambda ()
+ (if (or (atom forge-topic-list-limit)
+ (> (cdr forge-topic-list-limit) 0))
+ "hide closed topics"
+ "display recently closed topics"))
+ :transient t
+ (interactive)
+ (make-local-variable 'forge-topic-list-limit)
+ (if (atom forge-topic-list-limit)
+ (setq forge-topic-list-limit (cons forge-topic-list-limit 5))
+ (setcdr forge-topic-list-limit (* -1 (cdr forge-topic-list-limit))))
+ (forge-refresh-buffer))
+
+;;;###autoload (autoload 'forge-add-pullreq-refspec "forge-commands" nil t)
+(transient-define-suffix forge-add-pullreq-refspec ()
+ "Configure Git to fetch all pull-requests.
+This is done by adding \"+refs/pull/*/head:refs/pullreqs/*\"
+to the value of `remote.REMOTE.fetch', where REMOTE is the
+upstream remote. Also fetch from REMOTE."
+ :if-not 'forge--pullreq-refspec
+ :description "add pull-request refspec"
+ (interactive)
+ (let* ((repo (forge-get-repository :stub))
+ (remote (oref repo remote))
+ (fetch (magit-get-all "remote" remote "fetch"))
+ (refspec (oref repo pullreq-refspec)))
+ (if (member refspec fetch)
+ (message "Pull-request refspec is already active")
+ (magit-call-git "config" "--add"
+ (format "remote.%s.fetch" remote)
+ refspec)
+ (magit-git-fetch remote (magit-fetch-arguments)))))
+
+(defun forge--pullreq-refspec ()
+ (let* ((repo (forge-get-repository :stub))
+ (remote (oref repo remote))
+ (fetch (magit-get-all "remote" remote "fetch"))
+ (refspec (oref repo pullreq-refspec)))
+ (car (member refspec fetch))))
+
+;;; Add repositories
+
+;;;###autoload (autoload 'forge-add-repository "forge-commands" nil t)
+(transient-define-prefix forge-add-repository (&optional repo limit)
+ "Add a repository to the database."
+ [:class transient-subgroups
+ [:if (lambda () (forge-get-repository (transient-scope) nil :tracked?))
+ (:info
+ (lambda ()
+ (format
+ (propertize "%s is already being tracked" 'face 'transient-heading)
+ (propertize (forge-get-url (transient-scope)) 'face 'bold)))
+ :format "%d")]
+ [:if-not (lambda () (forge-get-repository (transient-scope) nil :tracked?))
+ :description
+ (lambda ()
+ (format
+ (propertize "Adding %s to database," 'face 'transient-heading)
+ (propertize (forge-get-url (transient-scope)) 'face 'bold)))
+ ("a" "pulling all topics"
+ (lambda (repo)
+ (interactive (list (transient-scope)))
+ (forge-add-repository repo)))
+ ("s" "pulling only topics since <date>"
+ (lambda (repo date)
+ (interactive
+ (list (transient-scope)
+ (forge-read-date "Limit pulling to topics updated since: ")))
+ (forge-add-repository repo date)))
+ ("i" "to allow pulling of individual topics"
+ (lambda (repo)
+ (interactive (list (transient-scope)))
+ (forge-add-repository repo :selective)))]
+ [("o" "Add another repository" forge-add-some-repository)
+ (7 "U" "Add all source repositories belonging to a user"
+ forge-add-user-repositories)
+ (7 "O" "Add all source repositories belonging to an organization"
+ forge-add-organization-repositories)]]
+ (declare (interactive-only nil))
+ (interactive)
+ (cond
+ ((not repo)
+ (transient-setup 'forge-add-repository nil nil
+ :scope (forge-get-repository :stub?)))
+ ((stringp repo)
+ (transient-setup 'forge-add-repository nil nil
+ :scope (forge-get-repository repo nil :stub?)))
+ (t
+ (when-let*
+ (((not (eq limit :selective)))
+ ((magit-git-config-p "forge.autoPull" t))
+ (remote (oref repo remote))
+ (refspec (oref repo pullreq-refspec))
+ ((and (not (member refspec (magit-get-all "remote" remote "fetch")))
+ (or (eq forge-add-pullreq-refspec t)
+ (and (eq forge-add-pullreq-refspec 'ask)
+ (y-or-n-p (format "Also add %S refspec? " refspec)))))))
+ (magit-call-git "config" "--add"
+ (format "remote.%s.fetch" remote)
+ refspec))
+ (setq repo (forge-get-repository repo nil :insert!))
+ (when (eq limit :selective)
+ (oset repo selective-p t)
+ (setq limit nil))
+ (forge--pull repo nil limit))))
+
+(defun forge-add-some-repository (url)
+ "Read a repository and add it to the database."
+ (interactive
+ (let (ret url)
+ (while (not ret)
+ (setq url (magit-read-string-ns
+ "Add repository to database (url, owner/name, or name)" url))
+ (unless (string-match-p "\\(://\\|@\\)" url)
+ (setq url (magit-clone--name-to-url url)))
+ (cond ((forge-get-repository url nil :tracked?)
+ (message "%s is already being tracked locally"
+ (propertize url 'face 'bold))
+ (sit-for 3))
+ ((not (forge-get-repository url nil :valid?))
+ (message "%s does not exist or is inaccessible"
+ (propertize url 'face 'bold))
+ (sit-for 3))
+ ((setq ret url))))
+ (list ret)))
+ (forge-add-repository url))
+
+;;;###autoload
+(defun forge-add-user-repositories (host user)
+ "Add all of USER's repositories from HOST to the database.
+This may take a while. Only Github is supported at the moment."
+ (interactive
+ (list (forge-read-host "Add repositories from Github host"
+ 'forge-github-repository)
+ (read-string "User: ")))
+ (forge--add-user-repos 'forge-github-repository host user))
+
+;;;###autoload
+(defun forge-add-organization-repositories (host organization)
+ "Add all of ORGANIZATION's repositories from HOST to the database.
+This may take a while. Only Github is supported at the moment."
+ (interactive
+ (list (forge-read-host "Add repositories from Github host"
+ 'forge-github-repository)
+ (read-string "Organization: ")))
+ (forge--add-organization-repos 'forge-github-repository host organization))
+
+;;; Cleanup
+
+;;;###autoload
+(defun forge-remove-repository (repository)
+ "Remove a repository from the database."
+ (interactive
+ (pcase-let* ((repo (forge-read-repository "Remove repository from db"))
+ ((eieio githost owner name) repo))
+ (if (yes-or-no-p (format "Do you really want to remove \"%s/%s @%s\" %s? "
+ owner name githost "from the database"))
+ (list repo)
+ (user-error "Abort"))))
+ (closql-delete repository)
+ (forge-refresh-buffer))
+
+;;;###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)))
+
+;;;###autoload
+(defun forge-reset-database ()
+ "Move the current database file to the trash.
+This is useful after the database scheme has changed, which will
+happen a few times while the forge functionality is still under
+heavy development."
+ (interactive)
+ (when (and (file-exists-p forge-database-file)
+ (yes-or-no-p "Really trash Forge's database file? "))
+ (when-let ((db (forge-db t)))
+ (emacsql-close db))
+ (delete-file forge-database-file t)
+ (forge-refresh-buffer)))
+
+;;; Miscellaneous
+
+(magit-define-section-jumper forge-jump-to-pullreqs "Pull requests" pullreqs)
+(magit-define-section-jumper forge-jump-to-issues "Issues" issues)
+
+;;; _
+(provide 'forge-commands)
+;;; forge-commands.el ends here
--- /dev/null
+;;; forge-core.el --- Core functionality -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'magit)
+
+(require 'cl-lib)
+(require 'compat)
+(require 'dash)
+(require 'eieio)
+(require 'seq)
+(require 'subr-x)
+
+(require 'transient)
+
+(require 'forge-db)
+
+(eval-when-compile
+ (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 'worktree eieio--known-slot-names))
+
+;;; Options
+
+(defgroup forge nil
+ "Options concerning Git forges."
+ :group 'magit)
+
+(defgroup forge-faces nil
+ "Faces concerning Git forges."
+ :group 'forge
+ :group 'magit-faces)
+
+(defcustom forge-alist
+ '(;; Forges
+ ("github.com" "api.github.com"
+ "github.com" forge-github-repository)
+ ("gitlab.com" "gitlab.com/api/v4"
+ "gitlab.com" forge-gitlab-repository)
+ ("salsa.debian.org" "salsa.debian.org/api/v4"
+ "salsa.debian.org" forge-gitlab-repository)
+ ("framagit.org" "framagit.org/api/v4"
+ "framagit.org" forge-gitlab-repository)
+ ("gitlab.gnome.org" "gitlab.gnome.org/api/v4"
+ "gitlab.gnome.org" forge-gitlab-repository)
+ ;; Forges (API unsupported)
+ ("codeberg.org" "codeberg.org/api/v1"
+ "codeberg.org" forge-gitea-repository)
+ ("bitbucket.org" "api.bitbucket.org/2.0"
+ "bitbucket.org" forge-bitbucket-repository)
+ ;; Semi-Forges
+ ("git.savannah.gnu.org" nil
+ "git.savannah.gnu.org" forge-cgit**-repository)
+ ("git.kernel.org" nil
+ "git.kernel.org" forge-cgit-repository)
+ ("repo.or.cz" nil
+ "repo.or.cz" forge-repoorcz-repository)
+ ("git.suckless.org" nil
+ "git.suckless.org" forge-stagit-repository)
+ ("git.sr.ht" nil
+ "git.sr.ht" forge-srht-repository))
+ "List of Git forges.
+
+Each entry has the form (GITHOST APIHOST WEBHOST CLASS).
+
+- GITHOST is the host used to access repositories on the forge using
+ Git.
+
+- APIHOST is the host used to access the forge's API. For some forges
+ the isn't just a host, but a host followed by the path to the API's
+ endpoint.
+
+- WEBHOST is the host used to access repositories on this forge using
+ a browser. The IDs used to identify repositories from the forge in
+ the local database also derives from this value.
+
+- CLASS is the class to be used for repositories from the forge.
+
+Complications:
+
+- When connecting to a Github Enterprise edition whose REST API's
+ end point is \"<host>/v3\" and whose GraphQL API's end point is
+ \"<host>/graphql\", then use \"<host>/v3\" as APIHOST. This is a
+ historic accident. See issue #174.
+
+- WEBHOST and CLASS cannot be changed once you have added one or
+ more repositories from a forge. Changing GITHOST and/or APIHOST
+ may be possible, but should seldom be necessary."
+ :package-version '(forge . "0.1.0")
+ :group 'forge
+ :type '(repeat (list (string :tag "Git host")
+ (choice (string :tag "API endpoint")
+ (const :tag "No API" nil))
+ (string :tag "ID")
+ (symbol :tag "Repository class"))))
+
+;;; Class
+
+(defclass forge-object (closql-object) () :abstract t)
+
+(defmacro forge--childp (obj type)
+ "Somewhat similar to `cl-typep' but only for (possibly unknown) classes.
+TYPE is evaluated at macro-expansion time but unlike with
+`cl-typep' the respective class does not have to be defined
+at that time."
+ (let ((fn (intern (concat (symbol-name (eval type)) "--eieio-childp"))))
+ `(and (fboundp ',fn) (,fn ,obj))))
+
+;;; Query
+
+(cl-defgeneric forge-get-parent (object)
+ "Return the parent object of OBJECT.
+The hierarchy is repository > topic > post.
+For other objects return nil.")
+
+(cl-defgeneric forge-get-repository (demand)
+ "Return a forge repository object or nil, or signal an error.
+
+A forge repository is a repository hosted on a forge. The local clone
+is also a \"repository\", but it is a \"Git\" repository, not a \"Forge\"
+repository. (Forge repositories are also Git repositories, but not the
+other way around.)
+
+A `:known' repository has an entry in the local database. All other
+repositories are unknown. `:known' repositories are devided into two
+subgroups: `:tracked' and \"untracked\" repositories.
+
+A `:tracked' repository was previously explicitly added to the database
+by the user.
+
+When Forge encounters a repository, without being instructed by the user
+to track it, it may nevertheless add limited information about it to the
+database. Such a repository is `:known' but it is not `:tracked'.
+
+Other repositories are \"unknown\". Most commands can only deal with
+repositories that are stored in the database. Of these, some can deal
+with any `:known' repositories, others require that they are `:tracked'.
+
+Some other commands exist — such as the browse commands — that have no
+such requirement. While such commands also require a repository object,
+they do not care whether that is stored in the database. Instead they
+are happy to use a `:stub' repository; a repository that is not stored
+in the database.
+
+The DEMAND argument specifies what kind of repository object the caller
+requires, at least. `:tracked' is greater than `:known', which is
+greater than `:stub'. For example, if the caller requests a `:known'
+repository, a `:tracked' repository will do, while a `:stub' repository
+will not.
+
+The valid values for DEMAND are:
+
+- `:tracked' and `:tracked?' request a repository that the user added
+ to the database. If there is no such repository, the former causes
+ an error to be signaled, while for the latter nil is returned.
+
+- `:known?' and `:insert!' request a repository from the database.
+ Whether the user explicitly added it does not matter. If there is no
+ such repository, nil is returned for the former, while for the latter
+ a new repository is inserted into the repository and then returned.
+
+- `:stub' and `:stub?' request the Forge repository corresponding to
+ the current Git repository. It does not matter whether it is known.
+ This fails if `default-directory' is not inside a Git repository, if
+ there is no matching entry in `forge-alist', or if it is unclear which
+ remote to use. If the repository cannot be determined, the former
+ causes an error to be signaled, while for the latter nil is returned.
+
+ Stub repository objects are created without making an API request, so
+ we lack access to the upstream ID, which the IDs used in out database,
+ derive from. Stub repositories are \"unknown\" in the sense that their
+ IDs are not `:known'. This is done to allow offline operations.
+
+- `:valid?' requests the Forge repository corresponding to the current
+ Git repository. It does not matter whether it is known. If it is
+ unknown, an API request is made to verify that the repository exists
+ on the forge. If it does, an object with a valid upstream ID is
+ returned, but that isn't inserted into the database. If not, nil is
+ returned.
+
+Given a repository object, you can query its `condition' slot to learn
+whether it is `:tracked', `:known' (i.e., has a valid ID and is stored
+in the database), or merely a `:stub'.
+
+You can also use (forge-get repository OBJECT nil DEMAND) to check the
+condition of a repository object, or even to ensure a repository object
+has a valid upstream ID (using `:valid?'), or that it is tracked in the
+database (using `:insert!').
+
+Use `forge-repository-equal' to check if two objects refer to the same
+repository.
+
+Also see info node `(forge) Repository Detection'.")
+
+(cl-defgeneric forge-get-topic ()
+ "Return a forge issue or pullreq object.")
+
+(cl-defgeneric forge-get-issue ()
+ "Return a forge issue object.")
+
+(cl-defgeneric forge-get-pullreq ()
+ "Return a forge pullreq object.")
+
+(defun forge--get-forge-host (host &optional demand)
+ "Return `forge-alist' entry matching HOST.
+
+Entries have the form (GITHOST APIHOST WEBHOST CLASS).
+
+- If HOST matches a GITHOST, return the corresponding entry.
+- Else, if HOST is an ssh alias and the canonical hostname matches a
+ GITHOST, return the corresponding entry.
+- Finally, if HOST matches a WEBHOST, return the corresponding entry
+
+If no entry matches, return nil, or signal an error if optional DEMAND
+is non-nil."
+ (or (assoc host forge-alist)
+ (assoc (seq-some (lambda (line)
+ (and (string-prefix-p "hostname" line)
+ (substring line 9)))
+ (ignore-errors
+ (process-lines-ignore-status "ssh" "-G" host)))
+ forge-alist)
+ (car (cl-member host forge-alist :test #'equal :key #'caddr))
+ (and demand
+ (error "No entry for \"%s\" in `forge-alist'" host))))
+
+(defun forge--split-forge-url (url)
+ (save-match-data
+ (and (string-match
+ (concat "\\`"
+ "\\(?:git://\\|"
+ "[^/@]+@\\|"
+ "\\(?:ssh\\|ssh\\+git\\|git\\+ssh\\)://\\(?:[^/@]+@\\)?\\|"
+ "https?://\\(?:[^/@]+@\\)?\\)?"
+ (regexp-opt (mapcar #'car forge-alist) t)
+ "\\(?::[0-9]+\\)?"
+ "\\(?:/\\|:/?\\)"
+ "~?\\(.+?\\)/"
+ "\\([^/]+?\\)"
+ "\\(?:\\.git\\|/\\)?"
+ "\\'")
+ url)
+ (list (caddr (forge--get-forge-host (match-string 1 url) t))
+ (match-string 2 url)
+ (match-string 3 url)))))
+
+;;; Identity
+
+(cl-defgeneric forge--object-id (class &rest args)
+ "Return the database id for the CLASS object specified by ARGS.")
+
+(cl-defgeneric forge--repository-ids ( class host owner name
+ &optional stub noerror)
+ "Return the database and forge ids for the specified CLASS object.")
+
+(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))))
+
+;;; Format
+
+(cl-defgeneric forge--format (object slot &optional spec)
+ "Return a string based on SPEC and the format-string in OBJECT's SLOT.
+The available `format'-like specs depend on the type of OBJECT.
+SPEC can be used to add additional specs, as for `format-spec'.
+The latter override the former. SLOT is expected to be class-
+allocated. Some methods also accept a format string in place
+of SLOT.")
+
+(cl-defmethod forge--format-resource ((object forge-object) resource)
+ "Return an API resource based on RESOURCE and slots of OBJECT.
+For use in `forge--FORGE-METHOD' such as `forge--ghub-get'.
+RESOURCE is a string separated by slashes. Each part that begins
+with a colon is replaced with a value from OBJECT. `:repo' is a
+synonym for `:name'. `:project' is a like `:owner/:name', but the
+slash is quoted on Gitlab. `:topic' is a synonym for `:number'
+but only if OBJECT is a topic. Any other `:SLOT' means to use
+the value of that slot in OBJECT, or if that doesn't exist in its
+parent object (determined using `forge-get-parent')."
+ (save-match-data
+ (setq resource
+ (replace-regexp-in-string
+ ":\\([^/]+\\)"
+ (lambda (str)
+ (let ((slot (intern (substring str 1))))
+ (or (and-let*
+ ((v (ignore-errors
+ (pcase slot
+ ('repo (oref object name))
+ ('project (concat (string-replace
+ "/" "%2F" (oref object owner))
+ "%2F"
+ (oref object name)))
+ ('topic (and (forge--childp object 'forge-topic)
+ (oref object number)))
+ (_ (eieio-oref object slot))))))
+ (format "%s" v))
+ str)))
+ resource t t))
+ (if (string-match ":[^/]*" resource)
+ (if-let ((parent (ignore-errors (forge-get-parent object))))
+ (forge--format-resource parent resource)
+ (error "Cannot resolve %s for a %s"
+ (match-string 0 resource)
+ (eieio-object-class object)))
+ resource)))
+
+;;; Miscellaneous
+
+(defun forge-refresh-buffer (&optional buffer)
+ "Refresh the current buffer, if it is a Magit or Forge buffer.
+Refresh the buffer if its major-mode derives from `magit-mode',
+`forge-topic-list-mode' or `forge-repository-list-mode'. If
+optional BUFFER is non-nil, then refresh that buffer, provided
+it is alive and satisfies the mode requirement."
+ (cond (buffer
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (forge-refresh-buffer))))
+ ((derived-mode-p 'forge-topic-mode)
+ (magit-refresh-buffer))
+ ((derived-mode-p 'magit-mode)
+ (magit-refresh-buffer))
+ ((derived-mode-p 'forge-topic-list-mode
+ 'forge-repository-list-mode)
+ (revert-buffer))))
+
+(defun forge--sanitize-string (string)
+ ;; For Gitlab this may also be nil.
+ (if string (string-replace "\r\n" "\n" string) ""))
+
+(defun forge--uuid ()
+ "Return string with random (version 4) UUID."
+ ;; This is a copy of `org-id-uuid'.
+ ;; Only used in `forge-create-mark'.
+ (let ((rnd (md5 (format "%s%s%s%s%s%s%s"
+ (random)
+ (current-time)
+ (user-uid)
+ (emacs-pid)
+ (user-full-name)
+ user-mail-address
+ (recent-keys)))))
+ (format "%s-%s-4%s-%s%s-%s"
+ (substring rnd 0 8)
+ (substring rnd 8 12)
+ (substring rnd 13 16)
+ (format "%x"
+ (logior
+ #b10000000
+ (logand
+ #b10111111
+ (string-to-number
+ (substring rnd 16 18) 16))))
+ (substring rnd 18 20)
+ (substring rnd 20 32))))
+
+;;; _
+(provide 'forge-core)
+;;; forge-core.el ends here
--- /dev/null
+;;; forge-db.el --- Database implementation -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'closql)
+(require 'compat)
+(require 'eieio)
+(require 'emacsql)
+
+;; For `closql--db-update-schema':
+(declare-function forge--object-id "forge-core")
+(declare-function forge-get-issue "forge-core")
+(declare-function forge-get-pullreq "forge-core")
+(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))
+
+;;; Options
+
+(defcustom forge-database-file
+ (expand-file-name "forge-database.sqlite" user-emacs-directory)
+ "The file used to store the forge database."
+ :package-version '(forge . "0.1.0")
+ :group 'forge
+ :type 'file)
+
+;;; Core
+
+(defclass forge-database (closql-database)
+ ((name :initform "Forge")
+ (object-class :initform 'forge-repository)
+ (file :initform 'forge-database-file)
+ (schemata :initform 'forge--db-table-schemata)
+ (version :initform 13)))
+
+(defvar forge--override-connection-class nil)
+
+(defun forge-db (&optional livep)
+ (closql-db 'forge-database livep forge--override-connection-class))
+
+(defun forge-sql (sql &rest args)
+ (if (stringp sql)
+ (emacsql (forge-db) (apply #'format sql args))
+ (apply #'emacsql (forge-db) sql args)))
+
+(defun forge-connect-database-once ()
+ "Try to connect Forge database on first use of `magit-status' only."
+ (remove-hook 'magit-status-mode-hook #'forge-connect-database-once)
+ (forge-db))
+(add-hook 'magit-status-mode-hook #'forge-connect-database-once)
+
+(defun forge-enable-sql-logging ()
+ "Enable logging Forge's SQL queries."
+ (interactive)
+ (let ((conn (oref (forge-db) connection)))
+ (emacsql-enable-debugging conn)
+ (switch-to-buffer-other-window (oref conn log-buffer))))
+
+;;; Schemata
+
+(defconst forge--db-table-schemata
+ '((repository
+ [(class :not-null)
+ (id :not-null :primary-key)
+ forge-id
+ forge
+ owner
+ name
+ apihost
+ githost
+ remote
+ condition
+ created
+ updated
+ pushed
+ parent
+ description
+ homepage
+ default-branch
+ archived-p
+ fork-p
+ locked-p
+ mirror-p
+ private-p
+ issues-p
+ wiki-p
+ stars
+ watchers
+ (assignees :default eieio-unbound)
+ (forks :default eieio-unbound)
+ (issues :default eieio-unbound)
+ (labels :default eieio-unbound)
+ (revnotes :default eieio-unbound)
+ (pullreqs :default eieio-unbound)
+ selective-p
+ worktree
+ (milestones :default eieio-unbound)
+ issues-until
+ pullreqs-until
+ ])
+
+ (assignee
+ [(repository :not-null)
+ (id :not-null :primary-key)
+ login
+ name
+ forge-id] ; Needed for Gitlab.
+ (:foreign-key
+ [repository] :references repository [id]
+ :on-delete :cascade))
+
+ (fork
+ [(parent :not-null)
+ (id :not-null :primary-key)
+ owner
+ name]
+ (:foreign-key
+ [parent] :references repository [id]
+ :on-delete :cascade))
+
+ (issue
+ [(class :not-null)
+ (id :not-null :primary-key)
+ repository
+ number
+ state
+ author
+ title
+ created
+ updated
+ closed
+ status
+ locked-p
+ milestone
+ body
+ (assignees :default eieio-unbound)
+ (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))
+
+ (issue-assignee
+ [(issue :not-null)
+ (id :not-null)]
+ (:foreign-key
+ [issue] :references issue [id]
+ :on-delete :cascade))
+
+ (issue-label
+ [(issue :not-null)
+ (id :not-null)]
+ (:foreign-key
+ [issue] :references issue [id]
+ :on-delete :cascade)
+ (:foreign-key
+ [id] :references label [id]
+ :on-delete :cascade))
+
+ (issue-mark
+ [(issue :not-null)
+ (id :not-null)]
+ (:foreign-key
+ [issue] :references issue [id]
+ :on-delete :cascade)
+ (:foreign-key
+ [id] :references mark [id]
+ :on-delete :cascade))
+
+ (issue-post
+ [(class :not-null)
+ (id :not-null :primary-key)
+ issue
+ number
+ author
+ created
+ updated
+ body
+ (edits :default eieio-unbound)
+ (reactions :default eieio-unbound)]
+ (:foreign-key
+ [issue] :references issue [id]
+ :on-delete :cascade))
+
+ (label
+ [(repository :not-null)
+ (id :not-null :primary-key)
+ name
+ color
+ description]
+ (:foreign-key
+ [repository] :references repository [id]
+ :on-delete :cascade))
+
+ (mark
+ [;; For now this is always nil because it seems more useful to
+ ;; share marks between repositories. We cannot omit this slot
+ ;; though because `closql--iref' expects `id' to be the second
+ ;; slot.
+ repository
+ (id :not-null :primary-key)
+ name
+ face
+ description])
+
+ (milestone
+ [(repository :not-null)
+ (id :not-null :primary-key)
+ number
+ title
+ created
+ updated
+ due
+ closed
+ description]
+ (:foreign-key
+ [repository] :references repository [id]
+ :on-delete :cascade))
+
+ (notification
+ [(class :not-null)
+ (id :not-null :primary-key)
+ thread-id
+ repository
+ type
+ topic
+ url
+ title
+ reason
+ last-read
+ updated]
+ (:foreign-key
+ [repository] :references repository [id]
+ :on-delete :cascade))
+
+ (pullreq
+ [(class :not-null)
+ (id :not-null :primary-key)
+ repository
+ number
+ state
+ author
+ title
+ created
+ updated
+ closed
+ merged
+ status
+ locked-p
+ editable-p
+ cross-repo-p
+ base-ref
+ base-repo
+ head-ref
+ head-user
+ head-repo
+ milestone
+ body
+ (assignees :default eieio-unbound)
+ (cards :default eieio-unbound)
+ (commits :default eieio-unbound)
+ (edits :default eieio-unbound)
+ (labels :default eieio-unbound)
+ (participants :default eieio-unbound)
+ (posts :default eieio-unbound)
+ (reactions :default eieio-unbound)
+ (review-requests :default eieio-unbound)
+ (reviews :default eieio-unbound)
+ (timeline :default eieio-unbound)
+ (marks :default eieio-unbound)
+ note
+ base-rev
+ head-rev
+ draft-p
+ their-id
+ slug
+ saved-p]
+ (:foreign-key
+ [repository] :references repository [id]
+ :on-delete :cascade))
+
+ (pullreq-assignee
+ [(pullreq :not-null)
+ (id :not-null)]
+ (:foreign-key
+ [pullreq] :references pullreq [id]
+ :on-delete :cascade))
+
+ (pullreq-label
+ [(pullreq :not-null)
+ (id :not-null)]
+ (:foreign-key
+ [pullreq] :references pullreq [id]
+ :on-delete :cascade)
+ (:foreign-key
+ [id] :references label [id]
+ :on-delete :cascade))
+
+ (pullreq-mark
+ [(pullreq :not-null)
+ (id :not-null)]
+ (:foreign-key
+ [pullreq] :references pullreq [id]
+ :on-delete :cascade)
+ (:foreign-key
+ [id] :references mark [id]
+ :on-delete :cascade))
+
+ (pullreq-post
+ [(class :not-null)
+ (id :not-null :primary-key)
+ pullreq
+ number
+ author
+ created
+ updated
+ body
+ (edits :default eieio-unbound)
+ (reactions :default eieio-unbound)]
+ (:foreign-key
+ [pullreq] :references pullreq [id]
+ :on-delete :cascade))
+
+ (pullreq-review-request
+ [(pullreq :not-null)
+ (id :not-null)]
+ (:foreign-key
+ [pullreq] :references pullreq [id]
+ :on-delete :cascade))
+
+ (revnote
+ [(class :not-null)
+ (id :not-null :primary-key)
+ repository
+ commit
+ file
+ line
+ author
+ body]
+ (:foreign-key
+ [repository] :references repository [id]
+ :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...")
+ (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...")
+ (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 issue :add-column note :default nil])
+ (emacsql db [:alter-table pullreq :add-column note :default nil])
+ (emacsql db [:create-table milestone $S1]
+ (cdr (assq 'milestone forge--db-table-schemata)))
+ (emacsql db [:alter-table repository :add-column milestones :default $s1]
+ 'eieio-unbound)
+ (pcase-dolist (`(,repo-id ,issue-id ,milestone)
+ (emacsql db [:select [repository id milestone]
+ :from issue
+ :where (notnull milestone)]))
+ (unless (stringp milestone)
+ (oset (forge-get-issue issue-id) milestone
+ (forge--object-id repo-id (cdar milestone)))))
+ (pcase-dolist (`(,repo-id ,pullreq-id ,milestone)
+ (emacsql db [:select [repository id milestone]
+ :from pullreq
+ :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...")
+ (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 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 pullreq :add-column slug :default nil])
+ (emacsql db [:alter-table issue :add-column slug :default nil])
+ (pcase-dolist (`(,id ,number ,type)
+ (emacsql
+ db
+ [:select [pullreq:id pullreq:number repository:class]
+ :from pullreq
+ :join repository
+ :on (= pullreq:repository repository:id)]))
+ (let ((gitlabp (memq type
+ (append (closql-where-class-in
+ 'forge-gitlab-repository--eieio-childp)
+ nil))))
+ (emacsql db [:update pullreq :set (= slug $s1) :where (= id $s2)]
+ (format "%s%s" (if gitlabp "!" "#") number)
+ id)))
+ (pcase-dolist (`(,id ,number)
+ (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...")
+ (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 [:drop-table notification])
+ (emacsql db [:create-table notification $S1]
+ (cdr (assq 'notification forge--db-table-schemata)))
+ (dolist (id (emacsql db [:select id :from issue :where (= state 'closed)]))
+ (emacsql db [:update issue :set (= state 'completed) :where (= id $s1)]
+ id))
+ (dolist (id (emacsql db [:select id :from issue :where (isnull status)]))
+ (emacsql db [:update issue :set (= state 'done) :where (= id $s1)]
+ id))
+ (dolist (id (emacsql db [:select id :from pullreq :where (= state 'closed)]))
+ (emacsql db [:update pullreq :set (= state 'rejected) :where (= id $s1)]
+ id))
+ (dolist (id (emacsql db [:select id :from pullreq :where (isnull status)]))
+ (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...")
+ (dolist (id (emacsql db [:select id :from repository
+ :where (isnull issues-until)]))
+ (emacsql
+ db [:update repository :set (= issues-until $s1) :where (= id $s2)]
+ (caar (forge-sql [:select [updated] :from issue
+ :where (= repository $s1)
+ :order-by [(desc updated)]
+ :limit 1]
+ id))
+ id))
+ (dolist (id (emacsql db [:select id :from repository
+ :where (isnull pullreqs-until)]))
+ (emacsql
+ db [:update repository :set (= pullreqs-until $s1) :where (= id $s2)]
+ (caar (forge-sql [:select [updated] :from pullreq
+ :where (= repository $s1)
+ :order-by [(desc updated)]
+ :limit 1]
+ id))
+ id))
+ (emacsql db [:alter-table repository :rename-column sparse-p :to condition])
+ (pcase-dolist (`(,id ,not-tracked)
+ (emacsql db [:select [id condition] :from repository]))
+ (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)))
+
+(defun forge--backup-database (db)
+ (let ((dst (concat (file-name-sans-extension forge-database-file)
+ (format "-v%s" (caar (emacsql (oref db connection)
+ [:pragma user-version])))
+ (format-time-string "-%Y%m%d-%H%M")
+ ".sqlite")))
+ (message "Copying Forge database to %s..." dst)
+ (copy-file forge-database-file dst)
+ (message "Copying Forge database to %s...done" dst)))
+
+;;; _
+(provide 'forge-db)
+;;; forge-db.el ends here
--- /dev/null
+;;; forge-gitea.el --- Gitea support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'gtea)
+(require 'forge)
+
+;;; Class
+
+(defclass forge-gitea-repository (forge-unusedapi-repository)
+ ((issues-url-format :initform "https://%h/%o/%n/issues")
+ (issue-url-format :initform "https://%h/%o/%n/issues/%i")
+ ;; The anchor for the issue itself is .../%i#issue-%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/pulls/%i")
+ (pullreq-post-url-format :initform "https://%h/%o/%n/pulls/%i#issuecomment-%I")
+ (commit-url-format :initform "https://%h/%o/%n/commit/%r")
+ (branch-url-format :initform "https://%h/%o/%n/commits/branch/%r")
+ (remote-url-format :initform "https://%h/%o/%n")
+ (create-issue-url-format :initform "https://%h/%o/%n/issues/new")
+ (create-pullreq-url-format :initform "https://%h/%o/%n/pulls") ; sic
+ (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*")))
+
+;;; _
+(provide 'forge-gitea)
+;;; forge-gitea.el ends here
--- /dev/null
+;;; forge-github.el --- Github support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ghub)
+
+(require 'forge)
+(require 'forge-issue)
+(require 'forge-pullreq)
+
+;;; Class
+
+(defclass forge-github-repository (forge-repository)
+ ((issues-url-format :initform "https://%h/%o/%n/issues")
+ (issue-url-format :initform "https://%h/%o/%n/issues/%i")
+ (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#issuecomment-%I")
+ (pullreqs-url-format :initform "https://%h/%o/%n/pulls")
+ (pullreq-url-format :initform "https://%h/%o/%n/pull/%i")
+ (pullreq-post-url-format :initform "https://%h/%o/%n/pull/%i#issuecomment-%I")
+ (commit-url-format :initform "https://%h/%o/%n/commit/%r")
+ (branch-url-format :initform "https://%h/%o/%n/commits/%r")
+ (remote-url-format :initform "https://%h/%o/%n")
+ (create-issue-url-format :initform "https://%h/%o/%n/issues/new")
+ (create-pullreq-url-format :initform "https://%h/%o/%n/compare")
+ (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*")))
+
+;;; Query
+
+(defun forge--get-github-repository ()
+ (forge-github-repository-p (forge-get-repository :stub?)))
+
+;;; Pull
+;;;; Repository
+
+(cl-defmethod forge--pull ((repo forge-github-repository)
+ &optional callback since)
+ (cl-assert (not (and since (forge-get-repository repo nil :tracked?))))
+ (setq forge--mode-line-buffer (current-buffer))
+ (forge--msg repo t nil "Pulling REPO")
+ (let ((buf (current-buffer)))
+ (ghub-fetch-repository
+ (oref repo owner)
+ (oref repo name)
+ (lambda (data)
+ (forge--msg repo t t "Pulling REPO")
+ (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))
+ (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)))
+ (pullRequests-until . ,(or since (oref repo pullreqs-until))))
+ :host (oref repo apihost)
+ :auth 'forge
+ :sparse (oref repo selective-p))))
+
+(cl-defmethod forge--update-repository ((repo forge-github-repository) data)
+ (let-alist data
+ (oset repo created .createdAt)
+ (oset repo updated .updatedAt)
+ (oset repo pushed .pushedAt)
+ (oset repo parent .parent.nameWithOwner)
+ (oset repo description .description)
+ (oset repo homepage (and (not (equal .homepageUrl "")) .homepageUrl))
+ (oset repo default-branch .defaultBranchRef.name)
+ (oset repo archived-p .isArchived)
+ (oset repo fork-p .isFork)
+ (oset repo locked-p .isLocked)
+ (oset repo mirror-p .isMirror)
+ (oset repo private-p .isPrivate)
+ (oset repo issues-p .hasIssuesEnabled)
+ (oset repo wiki-p .hasWikiEnabled)
+ (oset repo stars .stargazers.totalCount)
+ (oset repo watchers .watchers.totalCount)))
+
+(cl-defmethod forge--update-revnotes ((repo forge-github-repository) data)
+ (closql-with-transaction (forge-db)
+ (mapc (apply-partially #'forge--update-revnote repo) data)))
+
+(cl-defmethod forge--update-revnote ((repo forge-github-repository) data)
+ (closql-with-transaction (forge-db)
+ (let-alist data
+ (closql-insert
+ (forge-db)
+ (forge-revnote
+ :id (forge--object-id 'forge-revnote repo .id)
+ :repository (oref repo id)
+ :commit .commit.oid
+ :file .path
+ :line .position
+ :author .author.login
+ :body .body)
+ t))))
+
+(cl-defmethod forge--update-assignees ((repo forge-github-repository) data)
+ (oset repo assignees
+ (with-slots (id) repo
+ (mapcar (lambda (row)
+ (let-alist row
+ (list (forge--object-id id .id)
+ .login
+ .name
+ .id)))
+ (delete-dups data)))))
+
+(cl-defmethod forge--update-forks ((repo forge-github-repository) data)
+ (oset repo forks
+ (with-slots (id) repo
+ (mapcar (lambda (row)
+ (let-alist row
+ (nconc (forge--repository-ids
+ (eieio-object-class repo)
+ (oref repo githost)
+ .owner.login
+ .name)
+ (list .owner.login
+ .name))))
+ (delete-dups data)))))
+
+(cl-defmethod forge--update-labels ((repo forge-github-repository) data)
+ (oset repo labels
+ (with-slots (id) repo
+ (mapcar (lambda (row)
+ (let-alist row
+ (list (forge--object-id id .id)
+ .name
+ (concat "#" (downcase .color))
+ .description)))
+ (delete-dups data)))))
+
+(cl-defmethod forge--update-milestones ((repo forge-github-repository) data)
+ (oset repo milestones
+ (with-slots (id) repo
+ (mapcar (lambda (row)
+ (let-alist row
+ (list (forge--object-id id .id)
+ .number
+ .title
+ .createdAt
+ .updatedAt
+ .dueOn
+ .closedAt
+ .description)))
+ (delete-dups data)))))
+
+;;;; Topics
+
+(cl-defmethod forge--pull-topic ((repo forge-github-repository)
+ (number number))
+ (let ((id (oref repo id)))
+ (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)))))))
+
+(cl-defmethod forge--pull-topic ((repo forge-github-repository)
+ (topic forge-issue)
+ &key callback errorback)
+ (let ((buffer (current-buffer)))
+ (ghub-fetch-issue
+ (oref repo owner)
+ (oref repo name)
+ (oref topic number)
+ (lambda (data)
+ (forge--update-issue 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-pullreq)
+ &key callback errorback)
+ (let ((buffer (current-buffer)))
+ (ghub-fetch-pullreq
+ (oref repo owner)
+ (oref repo name)
+ (oref topic number)
+ (lambda (data)
+ (forge--update-pullreq repo data)
+ (forge-refresh-buffer buffer)
+ (when callback (funcall callback)))
+ nil
+ :host (oref repo apihost)
+ :auth 'forge
+ :errorback errorback)))
+
+(cl-defmethod forge--update-status ((repo forge-github-repository)
+ topic data bump initial-pull)
+ (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)))
+ (oset topic updated updated)
+ (when bump
+ (let* ((slot (if (forge-issue-p topic) 'issues-until 'pullreqs-until))
+ (until (eieio-oref repo slot)))
+ (when (or (not until) (string> updated until))
+ (eieio-oset repo slot updated)))))))
+
+;;;; 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))))
+
+(cl-defmethod forge--update-issue ((repo forge-github-repository) data
+ &optional bump initial-pull)
+ (let (issue-id issue)
+ (let-alist data
+ (closql-with-transaction (forge-db)
+ (setq issue-id (forge--object-id 'forge-issue repo .number))
+ (setq issue (or (forge-get-issue repo .number)
+ (closql-insert
+ (forge-db)
+ (forge-issue :id issue-id
+ :repository (oref 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)))
+ (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 body (forge--sanitize-string .body))
+ (dolist (c .comments)
+ (let-alist c
+ (closql-insert
+ (forge-db)
+ (forge-issue-post
+ :id (forge--object-id issue-id .databaseId)
+ :issue issue-id
+ :number .databaseId
+ :author .author.login
+ :created .createdAt
+ :updated .updatedAt
+ :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))))
+ issue))
+
+;;;; Pullreqs
+
+(cl-defmethod forge--update-pullreqs ((repo forge-github-repository) data
+ &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))))
+
+(cl-defmethod forge--update-pullreq ((repo forge-github-repository) data
+ &optional bump initial-pull)
+ (let (pullreq-id pullreq)
+ (let-alist data
+ (closql-with-transaction (forge-db)
+ (setq pullreq-id (forge--object-id 'forge-pullreq repo .number))
+ (setq pullreq (or (forge-get-pullreq repo .number)
+ (closql-insert
+ (forge-db)
+ (forge-pullreq :id pullreq-id
+ :repository (oref repo id)
+ :number .number))))
+ (oset pullreq their-id .id)
+ (oset pullreq slug (format "#%s" .number))
+ (oset pullreq state (pcase-exhaustive .state
+ ("MERGED" 'merged)
+ ("CLOSED" 'rejected)
+ ("OPEN" 'open)))
+ (oset pullreq author .author.login)
+ (oset pullreq title .title)
+ (oset pullreq created .createdAt)
+ (oset pullreq closed .closedAt)
+ (oset pullreq merged .mergedAt)
+ (oset pullreq draft-p .isDraft)
+ (oset pullreq locked-p .locked)
+ (oset pullreq editable-p .maintainerCanModify)
+ (oset pullreq cross-repo-p .isCrossRepository)
+ (oset pullreq base-ref .baseRef.name)
+ (oset pullreq base-rev .baseRefOid)
+ (oset pullreq base-repo .baseRef.repository.nameWithOwner)
+ (oset pullreq head-ref .headRef.name)
+ (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 body (forge--sanitize-string .body))
+ (dolist (p .comments)
+ (let-alist p
+ (closql-insert
+ (forge-db)
+ (forge-pullreq-post
+ :id (forge--object-id pullreq-id .databaseId)
+ :pullreq pullreq-id
+ :number .databaseId
+ :author .author.login
+ :created .createdAt
+ :updated .updatedAt
+ :body (forge--sanitize-string .body))
+ t)))
+ (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))))
+ pullreq))
+
+;;;; Notifications
+
+(cl-defmethod forge--pull-notifications
+ ((_class (subclass forge-github-repository)) githost &optional callback)
+ ;; The GraphQL API doesn't support notifications and also likes to
+ ;; timeout for handcrafted requests, forcing us to perform a major
+ ;; rain dance.
+ (let ((spec (forge--get-forge-host githost t)))
+ (forge--msg nil t nil "Pulling notifications")
+ (pcase-let*
+ ((`(,_ ,apihost ,forge ,_) spec)
+ (since (forge--ghub-notifications-since forge))
+ (notifs
+ (seq-keep (lambda (data)
+ ;; Github returns notifications for repositories the
+ ;; user no longer has access to. Trying to retrieve
+ ;; information for such repositories leads to errors,
+ ;; which we suppress. See #164.
+ (with-demoted-errors "forge--pull-notifications: %S"
+ (forge--ghub-massage-notification data githost)))
+ (forge--ghub-get nil "/notifications"
+ `((all . t) ,@(and since `((since . ,since))))
+ :host apihost :unpaginate t)))
+ (groups (-partition-all 50 notifs))
+ (pages (length groups))
+ (page 0)
+ (topics nil))
+ (cl-labels
+ ((cb (&optional data _headers _status _req)
+ (when data
+ (setq topics (nconc topics (cdr data))))
+ (if groups
+ (progn (cl-incf page)
+ (forge--msg nil t nil
+ "Pulling notifications (page %s/%s)"
+ page pages)
+ (ghub--graphql-vacuum
+ (cons 'query (seq-keep #'caddr (pop groups)))
+ nil #'cb nil :auth 'forge :host apihost))
+ (forge--msg nil t t "Pulling notifications")
+ (forge--msg nil t nil "Storing notifications")
+ (forge--ghub-update-notifications notifs topics (not since))
+ (forge--msg nil t t "Storing notifications")
+ (when callback
+ (funcall callback)))))
+ (cb)))))
+
+(defun forge--ghub-notifications-since (forge)
+ (caar (forge-sql [:select :distinct [notification:updated]
+ :from [notification repository]
+ :where (and (= repository:forge $s1)
+ (= repository:id notification:repository))
+ :order-by [(desc notification:updated)]]
+ forge)))
+
+(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))))))
+
+(defun forge--ghub-update-notifications (notifs topics initial-pull)
+ (closql-with-transaction (forge-db)
+ (pcase-dolist (`(,alias ,id ,_ ,repo ,type ,data) notifs)
+ (let-alist data
+ (let* ((topic (funcall (if (eq type 'issue)
+ #'forge--update-issue
+ #'forge--update-pullreq)
+ repo
+ (cdr (cadr (assq alias topics)))
+ nil initial-pull))
+ (notif (or (forge-get-notification id)
+ (closql-insert (forge-db)
+ (forge-notification
+ :id id
+ :thread-id .id
+ :repository (oref repo id)
+ :type type
+ :topic (oref topic id)
+ :url .subject.url)))))
+ (oset notif title .subject.title)
+ (oset notif reason (intern (downcase .reason)))
+ (oset notif last-read .last_read_at)
+ (oset notif updated .updated_at))))))
+
+;;;; Miscellaneous
+
+(cl-defmethod forge--add-user-repos
+ ((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)))
+
+(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)))
+
+(cl-defmethod forge--fetch-user-repos
+ ((_ (subclass forge-github-repository)) host user callback)
+ (ghub--graphql-vacuum
+ '(query (user
+ [(login $login String!)]
+ (repositories
+ [(:edges t)
+ (ownerAffiliations . (OWNER))]
+ name)))
+ `((login . ,user))
+ (lambda (d)
+ (funcall callback
+ (--map (alist-get 'name it)
+ (let-alist d .user.repositories))))
+ nil :auth 'forge :host host))
+
+(cl-defmethod forge--fetch-organization-repos
+ ((_ (subclass forge-github-repository)) host org callback)
+ (ghub--graphql-vacuum
+ '(query (organization
+ [(login $login String!)]
+ (repositories [(:edges t)] name)))
+ `((login . ,org))
+ (lambda (d)
+ (funcall callback
+ (--map (alist-get 'name it)
+ (let-alist d .organization.repositories))))
+ nil :auth 'forge :host host))
+
+(defun forge--batch-add-callback (host owner names)
+ (let ((repos (cl-mapcan
+ (lambda (name)
+ (let ((repo (forge-get-repository
+ (list host owner name)
+ nil :insert!)))
+ (and (not (forge-get-repository repo nil :tracked?))
+ (list repo))))
+ names))
+ (cb nil))
+ (setq cb (lambda ()
+ (when-let ((repo (pop repos)))
+ (forge--pull repo cb))))
+ (funcall cb)))
+
+;;; Mutations
+
+(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))))
+ :callback (forge--post-submit-callback)
+ :errorback (forge--post-submit-errorback))))
+
+(cl-defmethod forge--create-pullreq-from-issue ((repo forge-github-repository)
+ (issue forge-issue)
+ source target)
+ (pcase-let* ((`(,base-remote . ,base-branch)
+ (magit-split-branch-name target))
+ (`(,head-remote . ,head-branch)
+ (magit-split-branch-name source))
+ (head-repo (forge-get-repository :stub head-remote)))
+ (forge--ghub-post repo "/repos/:owner/:repo/pulls"
+ `((issue . ,(oref issue number))
+ (base . ,base-branch)
+ (head . ,(if (equal head-remote base-remote)
+ head-branch
+ (concat (oref head-repo owner) ":"
+ head-branch)))
+ (maintainer_can_modify . t))
+ :callback (lambda (&rest _)
+ (closql-delete issue)
+ (forge-pull))
+ :errorback (lambda (&rest _) (forge-pull)))))
+
+(cl-defmethod forge--submit-create-pullreq ((_ forge-github-repository) repo)
+ (let-alist (forge--topic-parse-buffer)
+ (when (and .yaml (local-variable-p 'forge-buffer-draft-p))
+ (user-error "Cannot use yaml frontmatter and set `%s' at the same time"
+ 'forge-buffer-draft-p))
+ (pcase-let* ((`(,base-remote . ,base-branch)
+ (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"))
+ (forge--ghub-post repo "/repos/:owner/:repo/pulls"
+ `((title . , .title)
+ (body . , .body)
+ (base . ,base-branch)
+ (head . ,(if (equal head-remote base-remote)
+ head-branch
+ (concat (oref head-repo owner) ":"
+ head-branch)))
+ (draft . ,(if (local-variable-p 'forge-buffer-draft-p)
+ forge-buffer-draft-p
+ .draft))
+ (maintainer_can_modify . t))
+ :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-edit-post ((_ forge-github-repository) post)
+ (forge--ghub-patch post
+ (cl-typecase post
+ (forge-pullreq "/repos/:owner/:repo/pulls/:number")
+ (forge-issue "/repos/:owner/:repo/issues/:number")
+ (forge-post "/repos/:owner/:repo/issues/comments/:number"))
+ (if (cl-typep post 'forge-topic)
+ (let-alist (forge--topic-parse-buffer)
+ `((title . , .title)
+ (body . , .body)))
+ `((body . ,(string-trim (buffer-string)))))
+ :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
+ "/repos/:owner/:repo/issues/:number"
+ `((title . ,title))
+ :callback (forge--set-field-callback topic)))
+
+(cl-defmethod forge--set-topic-state
+ ((_repo forge-github-repository) topic state)
+ (forge--ghub-patch topic
+ "/repos/:owner/:repo/issues/:number"
+ (pcase-exhaustive state
+ ;; Merging isn't done through here.
+ ('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-draft
+ ((_repo forge-github-repository) topic value)
+ (let ((buffer (current-buffer)))
+ (ghub-graphql
+ `(mutation (,(if value
+ 'convertPullRequestToDraft
+ 'markPullRequestReadyForReview)
+ [(input $input ,(if value
+ 'ConvertPullRequestToDraftInput!
+ 'MarkPullRequestReadyForReviewInput!))]
+ (pullRequest isDraft)))
+ `((input (pullRequestId . ,(oref topic their-id))))
+ :host (oref (forge-get-repository topic) apihost)
+ :auth 'forge
+ :callback (lambda (data &rest _)
+ (if (assq 'error data)
+ (ghub--graphql-pp-response data)
+ (oset topic draft-p value)
+ (forge-refresh-buffer buffer))))))
+
+(cl-defmethod forge--set-topic-milestone
+ ((repo forge-github-repository) topic milestone)
+ (forge--ghub-patch topic
+ "/repos/:owner/:repo/issues/:number"
+ (if milestone
+ `((milestone . ,(caar (forge-sql [:select [number]
+ :from milestone
+ :where (and (= repository $s1)
+ (= title $s2))]
+ (oref repo id)
+ milestone))))
+ `((milestone . :null)))
+ :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)))
+
+(cl-defmethod forge--set-topic-assignees
+ ((_repo forge-github-repository) topic assignees)
+ (let ((value (mapcar #'car (closql--iref 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)))))
+
+(cl-defmethod forge--set-topic-review-requests
+ ((_repo forge-github-repository) topic reviewers)
+ (let ((value (mapcar #'car (closql--iref 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)))))
+
+(cl-defmethod forge--delete-comment
+ ((_repo forge-github-repository) post)
+ (forge--ghub-delete post "/repos/:owner/:repo/issues/comments/:number")
+ (closql-delete post)
+ (forge-refresh-buffer))
+
+(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)))))
+
+(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.
+ ))))
+
+(cl-defmethod forge--set-default-branch ((repo forge-github-repository)
+ newname oldname)
+ (forge--ghub-post repo
+ (format "/repos/:owner/:name/branches/%s/rename" oldname)
+ `((new_name . ,newname)))
+ (message "Waiting 5 seconds for GitHub to complete rename...")
+ (sleep-for 5)
+ (message "Waiting 5 seconds for GitHub to complete rename...done")
+ (magit-call-git "fetch" "--prune" (oref repo remote))
+ (magit--set-default-branch newname oldname))
+
+(cl-defmethod forge--fork-repository ((repo forge-github-repository) fork)
+ (with-slots (owner name) repo
+ (forge--ghub-post repo
+ (format "/repos/%s/%s/forks" owner name)
+ (and (not (equal fork (ghub--username (ghub--host nil))))
+ `((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
+ "/repos/:owner/:repo/pulls/:number/merge"
+ `((merge_method . ,(symbol-name method))
+ ,@(and hash `((sha . ,hash))))))
+
+;;; Wrappers
+
+(cl-defun forge--ghub-get (obj resource
+ &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ host
+ callback errorback)
+ (declare (indent defun))
+ (ghub-get (if obj (forge--format-resource obj resource) resource)
+ params
+ :host (or host (oref (forge-get-repository obj) apihost))
+ :auth 'forge
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :callback callback :errorback errorback))
+
+(cl-defun forge--ghub-put (obj resource
+ &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ host
+ callback errorback)
+ (declare (indent defun))
+ (ghub-put (if obj (forge--format-resource obj resource) resource)
+ params
+ :host (or host (oref (forge-get-repository obj) apihost))
+ :auth 'forge
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :callback callback :errorback errorback))
+
+(cl-defun forge--ghub-post (obj resource
+ &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ host callback errorback)
+ (declare (indent defun))
+ (ghub-post (forge--format-resource obj resource)
+ params
+ :host (or host (oref (forge-get-repository obj) apihost))
+ :auth 'forge
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :callback callback :errorback errorback))
+
+(cl-defun forge--ghub-patch (obj resource
+ &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ host callback errorback)
+ (declare (indent defun))
+ (ghub-patch (forge--format-resource obj resource)
+ params
+ :host (or host (oref (forge-get-repository obj) apihost))
+ :auth 'forge
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :callback callback :errorback errorback))
+
+(cl-defun forge--ghub-delete (obj resource
+ &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ host callback errorback)
+ (declare (indent defun))
+ (ghub-delete (forge--format-resource obj resource)
+ params
+ :host (or host (oref (forge-get-repository obj) apihost))
+ :auth 'forge
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :callback callback :errorback errorback))
+
+;;; _
+(provide 'forge-github)
+;;; forge-github.el ends here
--- /dev/null
+;;; forge-gitlab.el --- Gitlab support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'glab)
+
+(require 'forge)
+(require 'forge-issue)
+(require 'forge-pullreq)
+
+;;; Class
+
+(defclass forge-gitlab-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#note_%I")
+ (pullreqs-url-format :initform "https://%h/%o/%n/merge_requests")
+ (pullreq-url-format :initform "https://%h/%o/%n/merge_requests/%i")
+ (pullreq-post-url-format :initform "https://%h/%o/%n/merge_requests/%i#note_%I")
+ (commit-url-format :initform "https://%h/%o/%n/commit/%r")
+ (branch-url-format :initform "https://%h/%o/%n/commits/%r")
+ (remote-url-format :initform "https://%h/%o/%n")
+ (create-issue-url-format :initform "https://%h/%o/%n/issues/new")
+ (create-pullreq-url-format :initform "https://%h/%o/%n/merge_requests/new")
+ (pullreq-refspec :initform "+refs/merge-requests/*/head:refs/pullreqs/*")))
+
+;;; Pull
+;;;; Repository
+
+(cl-defmethod forge--pull ((repo forge-gitlab-repository)
+ &optional callback since)
+ (cl-assert (not (and since (forge-get-repository repo nil :tracked?))))
+ (setq forge--mode-line-buffer (current-buffer))
+ (forge--msg repo t nil "Pulling REPO")
+ (let ((cb (let ((buf (current-buffer))
+ (val nil))
+ (lambda (cb &optional v)
+ (when v (if val (push v val) (setq val v)))
+ (let-alist val
+ (cond
+ ((not val)
+ (forge--fetch-repository repo cb))
+ ((not (assq 'assignees val))
+ (forge--fetch-assignees repo cb))
+ ((not (assq 'forks val))
+ (forge--fetch-forks repo cb))
+ ((not (assq 'labels val))
+ (forge--fetch-labels repo cb))
+ ((and .issues_enabled
+ (not (assq 'issues val)))
+ (forge--fetch-issues repo cb since))
+ ((and .merge_requests_enabled
+ (not (assq 'pullreqs val)))
+ (forge--fetch-pullreqs repo cb since))
+ (t
+ (forge--msg repo t t "Pulling REPO")
+ (forge--msg repo t nil "Storing REPO")
+ (closql-with-transaction (forge-db)
+ (forge--update-repository repo val)
+ (forge--update-assignees repo .assignees)
+ (forge--update-labels repo .labels)
+ (dolist (v .issues) (forge--update-issue repo v))
+ (dolist (v .pullreqs) (forge--update-pullreq repo v))
+ (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))))))))))
+ (funcall cb cb)))
+
+(cl-defmethod forge--fetch-repository ((repo forge-gitlab-repository) callback)
+ (forge--glab-get repo "/projects/:project" nil
+ :callback (lambda (value _headers _status _req)
+ (cond ((oref repo selective-p)
+ (setq value (append '((assignees) (forks) (labels)
+ (issues) (pullreqs))
+ value)))
+ ((magit-get-boolean "forge.omitExpensive")
+ (setq value (append '((assignees) (forks) (labels))
+ value))))
+ (funcall callback callback value))))
+
+(cl-defmethod forge--update-repository ((repo forge-gitlab-repository) data)
+ (let-alist data
+ (oset repo created .created_at)
+ (oset repo updated .last_activity_at)
+ (oset repo pushed nil)
+ (oset repo parent .forked_from_project.path_with_namespace)
+ (oset repo description .description)
+ (oset repo homepage nil)
+ (oset repo default-branch .default_branch)
+ (oset repo archived-p .archived)
+ (oset repo fork-p (and .forked_from_project.path_with_namespace t))
+ (oset repo locked-p nil)
+ (oset repo mirror-p .mirror)
+ (oset repo private-p (equal .visibility "private"))
+ (oset repo issues-p .issues_enabled)
+ (oset repo wiki-p .wiki_enabled)
+ (oset repo stars .star_count)
+ (oset repo watchers .star_count)))
+
+;;;; Topics
+
+(cl-defmethod forge--pull-topic ((repo forge-gitlab-repository) _topic
+ &key callback _errorback)
+ (forge--pull repo callback)) ; TODO Pull only the one topic.
+
+;;;; Issues
+
+(cl-defmethod forge--fetch-issues ((repo forge-gitlab-repository) callback since)
+ (let ((cb (let (val cur cnt pos)
+ (lambda (cb &optional v)
+ (cond
+ ((not pos)
+ (if (setq cur (setq val v))
+ (progn
+ (setq pos 1)
+ (setq cnt (length val))
+ (forge--msg nil nil nil "Pulling issue %s/%s" pos cnt)
+ (forge--fetch-issue-posts repo cur cb))
+ (forge--msg repo t t "Pulling REPO issues")
+ (funcall callback callback (cons 'issues val))))
+ (t
+ (if (setq cur (cdr cur))
+ (progn
+ (cl-incf pos)
+ (forge--msg nil nil nil "Pulling issue %s/%s" pos cnt)
+ (forge--fetch-issue-posts repo cur cb))
+ (forge--msg repo t t "Pulling REPO issues")
+ (funcall callback callback (cons 'issues val)))))))))
+ (forge--msg repo t nil "Pulling REPO issues")
+ (forge--glab-get repo "/projects/:project/issues"
+ `((per_page . 100)
+ (order_by . "updated_at")
+ ,@(and-let* ((after (or since (oref repo issues-until))))
+ `((updated_after . ,after))))
+ :unpaginate t
+ :callback (lambda (value _headers _status _req)
+ (funcall cb cb value)))))
+
+(cl-defmethod forge--fetch-issue-posts ((repo forge-gitlab-repository) cur cb)
+ (let-alist (car cur)
+ (forge--glab-get repo
+ (format "/projects/%s/issues/%s/notes" .project_id .iid)
+ '((per_page . 100))
+ :unpaginate t
+ :callback (lambda (value _headers _status _req)
+ (setf (alist-get 'notes (car cur)) value)
+ (funcall cb cb)))))
+
+(cl-defmethod forge--update-issue ((repo forge-gitlab-repository) data)
+ (closql-with-transaction (forge-db)
+ (let-alist data
+ (let* ((issue-id (forge--object-id 'forge-issue repo .iid))
+ (issue
+ (forge-issue
+ :id issue-id
+ :their-id .iid
+ :number .iid
+ :slug (format "#%s" .iid)
+ :repository (oref repo id)
+ ;; Gitlab doesn't make a distinction between completed
+ ;; and unplanned issues. Treat them all as completed.
+ :state (pcase-exhaustive .state
+ ("closed" 'completed)
+ ("opened" 'open))
+ :author .author.username
+ :title .title
+ :created .created_at
+ :updated .updated_at
+ ;; `.closed_at' may be nil even though the issues is
+ ;; closed. In such cases use 1, so that this slot
+ ;; at least can serve as a boolean.
+ :closed (or .closed_at (and (equal .state "closed") 1))
+ :locked-p .discussion_locked
+ :milestone .milestone.iid
+ :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))
+ (dolist (c .notes)
+ (let-alist c
+ (let ((post
+ (forge-issue-post
+ :id (forge--object-id issue-id .id)
+ :issue issue-id
+ :number .id
+ :author .author.username
+ :created .created_at
+ :updated .updated_at
+ :body (forge--sanitize-string .body))))
+ (closql-insert (forge-db) post t))))
+ (let ((until (oref repo issues-until)))
+ (when (or (not until) (string> .updated_at until))
+ (oset repo issues-until .updated_at)))
+ issue))))
+
+;;;; Pullreqs
+
+(cl-defmethod forge--fetch-pullreqs ((repo forge-gitlab-repository) callback since)
+ (let ((cb (let (val cur cnt pos)
+ (lambda (cb &optional v)
+ (cond
+ ((not pos)
+ (if (setq cur (setq val v))
+ (progn
+ (setq pos 1)
+ (setq cnt (length val))
+ (forge--msg nil nil nil "Pulling pullreq %s/%s" pos cnt)
+ (forge--fetch-pullreq-posts repo cur cb))
+ (forge--msg repo t t "Pulling REPO pullreqs")
+ (funcall callback callback (cons 'pullreqs val))))
+ ((not (assq 'source_project (car cur)))
+ (forge--fetch-pullreq-source-repo repo cur cb))
+ ((not (assq 'target_project (car cur)))
+ (forge--fetch-pullreq-target-repo repo cur cb))
+ (t
+ (if (setq cur (cdr cur))
+ (progn
+ (cl-incf pos)
+ (forge--msg nil nil nil "Pulling pullreq %s/%s" pos cnt)
+ (forge--fetch-pullreq-posts repo cur cb))
+ (forge--msg repo t t "Pulling REPO pullreqs")
+ (funcall callback callback (cons 'pullreqs val)))))))))
+ (forge--msg repo t nil "Pulling REPO pullreqs")
+ (forge--glab-get repo "/projects/:project/merge_requests"
+ `((per_page . 100)
+ (order_by . "updated_at")
+ ,@(and-let* ((after (or since (oref repo pullreqs-until))))
+ `((updated_after . ,after))))
+ :unpaginate t
+ :callback (lambda (value _headers _status _req)
+ (funcall cb cb value)))))
+
+(cl-defmethod forge--fetch-pullreq-posts
+ ((repo forge-gitlab-repository) cur cb)
+ (let-alist (car cur)
+ (forge--glab-get repo
+ (format "/projects/%s/merge_requests/%s/notes" .target_project_id .iid)
+ '((per_page . 100))
+ :unpaginate t
+ :callback (lambda (value _headers _status _req)
+ (setf (alist-get 'notes (car cur)) value)
+ (funcall cb cb)))))
+
+(cl-defmethod forge--fetch-pullreq-source-repo
+ ((repo forge-gitlab-repository) cur cb)
+ ;; If the fork no longer exists, then `.source_project_id' is nil.
+ ;; This will lead to difficulties later on but there is nothing we
+ ;; can do about it.
+ (let-alist (car cur)
+ (if .source_project_id
+ (forge--glab-get repo (format "/projects/%s" .source_project_id) nil
+ :errorback (lambda (_err _headers _status _req)
+ (setf (alist-get 'source_project (car cur)) nil)
+ (funcall cb cb))
+ :callback (lambda (value _headers _status _req)
+ (setf (alist-get 'source_project (car cur)) value)
+ (funcall cb cb)))
+ (setf (alist-get 'source_project (car cur)) nil)
+ (funcall cb cb))))
+
+(cl-defmethod forge--fetch-pullreq-target-repo
+ ((repo forge-gitlab-repository) cur cb)
+ (let-alist (car cur)
+ (forge--glab-get repo (format "/projects/%s" .target_project_id) nil
+ :errorback (lambda (_err _headers _status _req)
+ (setf (alist-get 'target_project (car cur)) nil)
+ (funcall cb cb))
+ :callback (lambda (value _headers _status _req)
+ (setf (alist-get 'target_project (car cur)) value)
+ (funcall cb cb)))))
+
+(cl-defmethod forge--update-pullreq ((repo forge-gitlab-repository) data)
+ (closql-with-transaction (forge-db)
+ (let-alist data
+ (let* ((pullreq-id (forge--object-id 'forge-pullreq repo .iid))
+ (pullreq
+ (forge-pullreq
+ :id pullreq-id
+ :their-id .iid
+ :number .iid
+ :slug (format "!%s" .iid)
+ :repository (oref repo id)
+ :state (pcase-exhaustive .state
+ ("merged" 'merged)
+ ("closed" 'rejected)
+ ("opened" 'open))
+ :author .author.username
+ :title .title
+ :created .created_at
+ :updated .updated_at
+ ;; `.merged_at' and `.closed_at' may both be nil even
+ ;; though the pullreq is merged or otherwise closed.
+ ;; In such cases use 1, so that these slots at least
+ ;; can serve as booleans.
+ :closed (or .closed_at
+ (and (member .state '("closed" "merged")) 1))
+ :merged (or .merged_at
+ (and (equal .state "merged") 1))
+ :draft-p .draft
+ :locked-p .discussion_locked
+ :editable-p .allow_maintainer_to_push
+ :cross-repo-p (not (equal .source_project_id
+ .target_project_id))
+ :base-ref .target_branch
+ :base-rev .diff_refs.start_sha
+ :base-repo .target_project.path_with_namespace
+ :head-ref .source_branch
+ :head-rev .diff_refs.head_sha
+ :head-user .source_project.owner.username
+ :head-repo .source_project.path_with_namespace
+ :milestone .milestone.iid
+ :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))
+ (dolist (c .notes)
+ (let-alist c
+ (let ((post
+ (forge-pullreq-post
+ :id (forge--object-id pullreq-id .id)
+ :pullreq pullreq-id
+ :number .id
+ :author .author.username
+ :created .created_at
+ :updated .updated_at
+ :body (forge--sanitize-string .body))))
+ (closql-insert (forge-db) post t))))
+ (let ((until (oref repo pullreqs-until)))
+ (when (or (not until) (string> .updated_at until))
+ (oset repo pullreqs-until .updated_at)))
+ pullreq))))
+
+;;;; Other
+
+;; The extend of the documentation for "GET /projects/:id/users" is
+;; "Get the users list of a project." I don't know what that means,
+;; but it stands to reason that this must at least overlap with the
+;; set of users that can be assigned to topics.
+
+(cl-defmethod forge--fetch-assignees ((repo forge-gitlab-repository) callback)
+ (forge--glab-get repo "/projects/:project/users"
+ '((per_page . 100))
+ :unpaginate t
+ :callback (lambda (value _headers _status _req)
+ (funcall callback callback (cons 'assignees value)))))
+
+(cl-defmethod forge--update-assignees ((repo forge-gitlab-repository) data)
+ (oset repo assignees
+ (with-slots (id) repo
+ (mapcar (lambda (row)
+ (let-alist row
+ ;; For other forges we don't need to store `id'
+ ;; but here we do because that's what has to be
+ ;; used when assigning issues.
+ (list (forge--object-id id .id)
+ .username
+ .name
+ .id)))
+ data))))
+
+(cl-defmethod forge--fetch-forks ((repo forge-gitlab-repository) callback)
+ (forge--glab-get repo "/projects/:project/forks"
+ '((per_page . 100)
+ (simple . t))
+ :unpaginate t
+ :callback (lambda (value _headers _status _req)
+ (funcall callback callback (cons 'forks value)))))
+
+(cl-defmethod forge--update-forks ((repo forge-gitlab-repository) data)
+ (oset repo forks
+ (with-slots (id) repo
+ (mapcar (lambda (row)
+ (let-alist row
+ (nconc (forge--repository-ids
+ (eieio-object-class repo)
+ (oref repo githost)
+ .namespace.path
+ .path)
+ (list .namespace.path
+ .path))))
+ data))))
+
+(cl-defmethod forge--fetch-labels ((repo forge-gitlab-repository) callback)
+ (forge--glab-get repo "/projects/:project/labels"
+ '((per_page . 100))
+ :unpaginate t
+ :callback (lambda (value _headers _status _req)
+ (funcall callback callback (cons 'labels value)))))
+
+(cl-defmethod forge--update-labels ((repo forge-gitlab-repository) data)
+ (oset repo labels
+ (with-slots (id) repo
+ (mapcar (lambda (row)
+ (let-alist row
+ ;; We should use the label's `id' instead of its
+ ;; `name' but a topic's `labels' field is a list
+ ;; of names instead of a list of ids or an alist.
+ ;; As a result of this we cannot recognize when
+ ;; a label is renamed and a topic continues to be
+ ;; 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.
+ (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)
+ :test #'equal)))))
+
+;;;; Notifications
+
+;; The closest to notifications that Gitlab provides are "events" as
+;; described at https://docs.gitlab.com/ee/api/events.html. This
+;; allows us to see the last events that took place, but that is not
+;; good enough because we are mostly interested in events we haven't
+;; looked at yet. Gitlab doesn't make a distinction between unread
+;; and read events, so this is rather useless and we don't use it for
+;; the time being.
+
+;;; Mutations
+
+(cl-defmethod forge--submit-create-issue ((_ forge-gitlab-repository) repo)
+ (let-alist (forge--topic-parse-buffer)
+ (forge--glab-post repo "/projects/:project/issues"
+ `((title . , .title)
+ (description . , .body))
+ :callback (forge--post-submit-callback)
+ :errorback (forge--post-submit-errorback))))
+
+(cl-defmethod forge--submit-create-pullreq ((_ forge-gitlab-repository) base-repo)
+ (let-alist (forge--topic-parse-buffer)
+ (pcase-let* ((`(,base-remote . ,base-branch)
+ (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)))
+ (forge--glab-post head-repo "/projects/:project/merge_requests"
+ `((title . ,(if (if (local-variable-p 'forge-buffer-draft-p)
+ forge-buffer-draft-p
+ .draft)
+ (concat "Draft: " .title)
+ .title))
+ (description . , .body)
+ ,@(and (not (equal head-remote base-remote))
+ `((target_project_id . ,(oref base-repo forge-id))))
+ (target_branch . ,base-branch)
+ (source_branch . ,head-branch)
+ (allow_collaboration . t))
+ :callback (forge--post-submit-callback)
+ :errorback (forge--post-submit-errorback)))))
+
+(cl-defmethod forge--submit-create-post ((_ forge-gitlab-repository) topic)
+ (forge--glab-post topic
+ (if (forge-issue-p topic)
+ "/projects/:project/issues/:number/notes"
+ "/projects/:project/merge_requests/:number/notes")
+ `((body . ,(string-trim (buffer-string))))
+ :callback (forge--post-submit-callback)
+ :errorback (forge--post-submit-errorback)))
+
+(cl-defmethod forge--submit-edit-post ((_ forge-gitlab-repository) post)
+ (forge--glab-put post
+ (cl-etypecase post
+ (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)
+ ;; Keep Gitlab from claiming that the user
+ ;; changed the description when that isn't
+ ;; true. The same isn't necessary for the
+ ;; title; in that case Gitlab performs the
+ ;; necessary check itself.
+ `((title . , .title)
+ ,@(and (not (equal .body (oref post body)))
+ `((description . , .body)))))
+ `((body . ,(string-trim (buffer-string)))))
+ :callback (forge--post-submit-callback)
+ :errorback (forge--post-submit-errorback)))
+
+(cl-defmethod forge--set-topic-field
+ ((_repo forge-gitlab-repository) topic field value)
+ (forge--glab-put topic
+ (cl-typecase topic
+ (forge-pullreq "/projects/:project/merge_requests/:number")
+ (forge-issue "/projects/:project/issues/:number"))
+ `((,field . ,value))
+ :callback (forge--set-field-callback topic)))
+
+(cl-defmethod forge--set-topic-title
+ ((repo forge-gitlab-repository) topic title)
+ (forge--set-topic-field repo topic 'title title))
+
+(cl-defmethod forge--set-topic-state
+ ((repo forge-gitlab-repository) topic state)
+ (forge--set-topic-field repo topic 'state_event
+ (pcase-exhaustive state
+ ;; Merging isn't done through here.
+ ('completed "close")
+ ('unplanned "close")
+ ('rejected "close")
+ ('open "reopen"))))
+
+(cl-defmethod forge--set-topic-draft
+ ((repo forge-gitlab-repository) topic value)
+ (let ((buffer (current-buffer)))
+ (glab-graphql
+ `(mutation (mergeRequestSetDraft
+ [(input $input MergeRequestSetDraftInput!)]
+ (mergeRequest iid draft)))
+ `((input (projectPath . ,(format "%s/%s"
+ (oref repo owner)
+ (oref repo name)))
+ (iid . ,(number-to-string (oref topic number)))
+ (draft . ,value)))
+ :host (oref (forge-get-repository topic) apihost)
+ :auth 'forge
+ :callback (lambda (data &rest _)
+ (if (assq 'error data)
+ (ghub--graphql-pp-response data)
+ (oset topic draft-p value)
+ (forge-refresh-buffer buffer))))))
+
+(cl-defmethod forge--set-topic-labels
+ ((repo forge-gitlab-repository) topic labels)
+ (forge--set-topic-field repo topic 'labels
+ (mapconcat #'identity labels ",")))
+
+(cl-defmethod forge--set-topic-assignees
+ ((repo forge-gitlab-repository) topic assignees)
+ (let ((users (mapcar #'cdr (oref repo assignees))))
+ (cl-typecase topic
+ (forge-pullreq ; Can only be assigned to a single user.
+ (forge--set-topic-field repo topic 'assignee_id
+ (or (caddr (assoc (car assignees) users))
+ 0)))
+ (forge-issue
+ (forge--set-topic-field repo topic 'assignee_ids
+ (or (--map (caddr (assoc it 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)
+ 0))))
+
+(cl-defmethod forge--delete-comment
+ ((_repo forge-gitlab-repository) post)
+ (forge--glab-delete post
+ (cl-etypecase post
+ (forge-pullreq-post
+ "/projects/:project/merge_requests/:topic/notes/:number")
+ (forge-issue-post
+ "/projects/:project/issues/:topic/notes/:number")))
+ (closql-delete post)
+ (forge-refresh-buffer))
+
+(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))))
+
+(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))))
+
+(cl-defmethod forge--fork-repository ((repo forge-gitlab-repository) fork)
+ (with-slots (owner name) repo
+ (forge--glab-post repo (format "/projects/%s%%2F%s/fork" owner name)
+ (and (not (equal fork (ghub--username (ghub--host nil))))
+ `((namespace . ,fork)))
+ :noerror t)
+ (ghub-wait (format "/projects/%s%%2F%s" fork name)
+ nil :auth 'forge :forge 'gitlab)))
+
+(cl-defmethod forge--merge-pullreq ((_repo forge-gitlab-repository)
+ topic hash method)
+ (forge--glab-put topic
+ "/projects/:project/merge_requests/:number/merge"
+ `((squash . ,(eq method 'squash))
+ ,@(and hash `((sha . ,hash))))))
+
+;;; Wrappers
+
+(cl-defun forge--glab-get (obj resource
+ &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ host callback errorback)
+ (declare (indent defun))
+ (glab-get (if obj (forge--format-resource obj resource) resource)
+ params
+ :host (or host (oref (forge-get-repository obj) apihost))
+ :auth 'forge
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :callback callback
+ :errorback (or errorback (and callback t))))
+
+(cl-defun forge--glab-put (obj resource
+ &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ host callback errorback)
+ (declare (indent defun))
+ (glab-put (if obj (forge--format-resource obj resource) resource)
+ params
+ :host (or host (oref (forge-get-repository obj) apihost))
+ :auth 'forge
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :callback callback
+ :errorback (or errorback (and callback t))))
+
+(cl-defun forge--glab-post (obj resource
+ &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ host callback errorback)
+ (declare (indent defun))
+ (glab-post (forge--format-resource obj resource)
+ params
+ :host (or host (oref (forge-get-repository obj) apihost))
+ :auth 'forge
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :callback callback
+ :errorback (or errorback (and callback t))))
+
+(cl-defun forge--glab-delete (obj resource
+ &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ host callback errorback)
+ (declare (indent defun))
+ (glab-delete (forge--format-resource obj resource)
+ params
+ :host (or host (oref (forge-get-repository obj) apihost))
+ :auth 'forge
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :callback callback
+ :errorback (or errorback (and callback t))))
+
+;;; _
+(provide 'forge-gitlab)
+;;; forge-gitlab.el ends here
--- /dev/null
+;;; forge-gogs.el --- Gogs support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'gogs)
+(require 'forge)
+
+;;; Class
+
+(defclass forge-gogs-repository (forge-unusedapi-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/pulls/%i")
+ (pullreq-post-url-format :initform "https://%h/%o/%n/pulls/%i#issuecomment-%I")
+ (commit-url-format :initform "https://%h/%o/%n/commit/%r")
+ (branch-url-format :initform "https://%h/%o/%n/commits/%r")
+ (remote-url-format :initform "https://%h/%o/%n")
+ (create-issue-url-format :initform "https://%h/%o/%n/issues/new")
+ (create-pullreq-url-format :initform "https://%h/%o/%n/pulls") ; sic
+ (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*")))
+
+;;; _
+(provide 'forge-gogs)
+;;; forge-gogs.el ends here
--- /dev/null
+;;; forge-issue.el --- Issue support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'forge)
+(require 'forge-post)
+(require 'forge-topic)
+
+;;; Classes
+
+(defclass forge-issue (forge-topic)
+ ((closql-table :initform 'issue)
+ (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)
+ (state :initarg :state)
+ (author :initarg :author)
+ (title :initarg :title)
+ (created :initarg :created)
+ (updated :initarg :updated :initform nil)
+ (closed :initarg :closed)
+ (status :initarg :status :initform nil)
+ (locked-p :initarg :locked-p)
+ (milestone :initarg :milestone)
+ (body :initarg :body)
+ (assignees :closql-table (issue-assignee assignee))
+ (project-cards) ; projectsCards
+ (edits) ; userContentEdits
+ (labels :closql-table (issue-label label))
+ (participants)
+ (posts :closql-class forge-issue-post)
+ (reactions)
+ (timeline)
+ (marks :closql-table (issue-mark mark))
+ (note :initarg :note :initform nil)
+ (their-id :initarg :their-id)
+ (slug :initarg :slug)
+ (saved-p :initarg :saved-p :initform nil)
+ ))
+
+(defclass forge-issue-post (forge-post)
+ ((closql-table :initform 'issue-post)
+ (closql-primary-key :initform 'id)
+ (closql-order-by :initform [(asc number)])
+ (closql-foreign-key :initform 'issue)
+ (closql-class-prefix :initform "forge-issue-")
+ (id :initarg :id)
+ (issue :initarg :issue)
+ (number :initarg :number)
+ (author :initarg :author)
+ (created :initarg :created)
+ (updated :initarg :updated)
+ (body :initarg :body)
+ (edits)
+ (reactions)
+ ))
+
+;;; Query
+;;;; Get
+
+(cl-defmethod forge-get-repository ((post forge-issue-post))
+ (forge-get-repository (forge-get-issue post)))
+
+(cl-defmethod forge-get-topic ((post forge-issue-post))
+ (forge-get-issue post))
+
+(cl-defmethod forge-get-issue ((issue forge-issue))
+ issue)
+
+(cl-defmethod forge-get-issue ((repo forge-repository) number)
+ (closql-get (forge-db)
+ (forge--object-id 'forge-issue repo number)
+ 'forge-issue))
+
+(cl-defmethod forge-get-issue ((number integer))
+ (and-let* ((repo (forge-get-repository :tracked)))
+ (forge-get-issue repo number)))
+
+(cl-defmethod forge-get-issue ((id string))
+ (closql-get (forge-db) id 'forge-issue))
+
+(cl-defmethod forge-get-issue ((post forge-issue-post))
+ (closql-get (forge-db)
+ (oref post issue)
+ 'forge-issue))
+
+;;;; Current
+
+(defun forge-current-issue (&optional demand)
+ "Return the issue at point or being visited.
+If there is no such issue and DEMAND is non-nil, then signal
+an error."
+ (or (forge-issue-at-point)
+ (and (forge-issue-p forge-buffer-topic)
+ forge-buffer-topic)
+ (and demand (user-error "No current issue"))))
+
+(defun forge-issue-at-point (&optional demand)
+ "Return the issue at point.
+If there is no such issue and DEMAND is non-nil, then signal
+an error."
+ (or (thing-at-point 'forge-issue)
+ (magit-section-value-if 'issue)
+ (and (derived-mode-p 'forge-topic-list-mode)
+ (and-let* ((id (tabulated-list-get-id))
+ (topic (forge-get-topic id)))
+ (and (forge-issue-p topic)
+ topic)))
+ (and demand (user-error "No issue at point"))))
+
+(put 'forge-issue 'thing-at-point #'forge-thingatpt--issue)
+(defun forge-thingatpt--issue ()
+ (and-let* ((repo (forge--repo-for-thingatpt)))
+ (and (thing-at-point-looking-at "#\\([0-9]+\\)\\_>")
+ (forge-get-issue repo (string-to-number (match-string 1))))))
+
+;;;; List
+
+(defun forge--ls-recent-issues (repo)
+ (forge-ls-recent-topics repo 'issue))
+
+(defun forge--ls-issues (repo)
+ (forge--select-issues repo
+ [:from issue :where (= issue:repository $s1)]))
+
+(defun forge--ls-open-issues (repo)
+ (forge--select-issues repo
+ [:from issue
+ :where (and (= issue:repository $s1)
+ (= issue:state 'open))]))
+
+(defun forge--ls-active-issues (repo)
+ (forge--select-issues repo
+ [:from issue
+ :where (and (= issue:repository $s1)
+ (or (= issue:state 'open)
+ (in issue:status [pending unread])))]))
+
+(defun forge--ls-assigned-issues (repo)
+ (forge--select-issues repo
+ [:from issue
+ :join issue_assignee :on (= issue_assignee:issue issue:id)
+ :join assignee :on (= issue_assignee:id assignee:id)
+ :where (and (= issue:repository $s1)
+ (= assignee:login $s2)
+ (isnull issue:closed))]
+ (ghub--username repo)))
+
+(defun forge--ls-authored-issues (repo)
+ (forge--select-issues repo
+ [:from [issue]
+ :where (and (= issue:repository $s1)
+ (= issue:author $s2)
+ (isnull issue:closed))]
+ (ghub--username repo)))
+
+(defun forge--ls-labeled-issues (repo label)
+ (forge--select-issues repo
+ [:from issue
+ :join issue_label :on (= issue_label:issue issue:id)
+ :join label :on (= issue_label:id label:id)
+ :where (and (= issue:repository $s1)
+ (= label:name $s2)
+ (isnull issue:closed))]
+ label))
+
+(defun forge--ls-owned-issues ()
+ (forge--select-issues nil
+ [:from [issue repository]
+ :where (and (= issue:repository repository:id)
+ (in repository:owner $v1)
+ (not (in repository:name $v2))
+ (isnull issue:closed))
+ :order-by [(asc repository:owner)
+ (asc repository:name)
+ (desc issue:number)]]
+ (vconcat (mapcar #'car forge-owned-accounts))
+ (vconcat forge-owned-ignored)))
+
+(defun forge--select-issues (repo query &rest args)
+ (declare (indent 1))
+ (mapcar (let ((db (forge-db)))
+ (lambda (row)
+ (closql--remake-instance 'forge-issue db row)))
+ (apply #'forge-sql
+ (vconcat [:select *]
+ query
+ (and (not (cl-find :order-by query))
+ [:order-by [(desc updated)]]))
+ (if repo
+ (cons (oref repo id) args)
+ args))))
+
+;;; Read
+
+(defun forge-read-issue (prompt)
+ "Read an active issue with completion using PROMPT.
+
+Open, unread and pending issues are considered active.
+Default to the current issue even if it isn't active.
+
+\\<forge-read-topic-minibuffer-map>While completion is in \
+progress, \\[forge-read-topic-lift-limit] lifts the limit, extending
+the completion candidates to include all issues.
+
+If `forge-limit-topic-choices' is nil, then all candidates
+can be selected from the start."
+ (forge--read-topic prompt
+ #'forge-current-issue
+ #'forge--ls-active-issues
+ #'forge--ls-issues))
+
+(defun forge-read-open-issue (prompt)
+ "Read an open issue with completion using PROMPT."
+ (let* ((current (forge-current-issue))
+ (repo (forge-get-repository (or current :tracked)))
+ (default (and current (forge--format-topic-line current)))
+ (alist (forge--topic-collection (forge--ls-open-issues repo)))
+ (choices (mapcar #'car alist))
+ (choice (magit-completing-read prompt choices nil t nil nil default)))
+ (cdr (assoc choice alist))))
+
+;;; Insert
+
+(defvar-keymap forge-issues-section-map
+ "<remap> <magit-browse-thing>" #'forge-browse-issues
+ "<remap> <magit-visit-thing>" #'forge-list-issues
+ "C-c C-m" #'forge-topics-menu
+ "C-c C-n" #'forge-create-issue)
+
+(defvar-keymap forge-issue-section-map
+ "<remap> <magit-visit-thing>" #'forge-visit-this-topic
+ "C-c C-m" #'forge-topic-menu)
+
+(defun forge-insert-issues ()
+ "Insert a list of mostly recent and/or open issues.
+Also see option `forge-topic-list-limit'."
+ (forge--insert-issues "Issues" #'forge--ls-recent-issues))
+
+(defun forge-insert-assigned-issues ()
+ "Insert a list of open issues that are assigned to you."
+ (forge--insert-issues "Assigned issues" #'forge--ls-assigned-issues))
+
+(defun forge-insert-authored-issues ()
+ "Insert a list of open issues that are authored by you."
+ (forge--insert-issues "Authored issues" #'forge--ls-authored-issues))
+
+(defun forge--insert-issues (heading getter)
+ (when-let ((repo (forge--assert-insert-topics-get-repository t)))
+ (forge--insert-topics 'issues heading (funcall getter repo))))
+
+;;; _
+(provide 'forge-issue)
+;;; forge-issue.el ends here
--- /dev/null
+;;; forge-notify.el --- Notify support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'forge)
+(require 'forge-topic)
+
+;;; Options
+
+(defcustom forge-notifications-repo-slug-width 28
+ "Width of repository slugs in `forge-notifications-mode' buffers."
+ :package-version '(forge . "0.4.0")
+ :group 'forge
+ :type (if (>= emacs-major-version 28) 'natnum 'number))
+
+;;; Class
+
+(defclass forge-notification (forge-object)
+ ((closql-class-prefix :initform "forge-")
+ (closql-table :initform 'notification)
+ (closql-primary-key :initform 'id)
+ (closql-order-by :initform [(desc id)])
+ (id :initarg :id)
+ (thread-id :initarg :thread-id)
+ (repository :initarg :repository)
+ (type :initarg :type)
+ (topic :initarg :topic)
+ (url :initarg :url)
+ (title :initarg :title)
+ (reason :initarg :reason)
+ (last-read :initarg :last-read)
+ (updated :initarg :updated)))
+
+;;; Query
+;;;; Get
+
+(cl-defmethod forge-get-repository ((notify forge-notification))
+ "Return the object for the repository that NOTIFY belongs to."
+ (and-let* ((id (oref notify repository)))
+ (closql-get (forge-db) id 'forge-repository)))
+
+(cl-defmethod forge-get-topic ((notify forge-notification))
+ (and-let* ((repo (forge-get-repository notify)))
+ (forge-get-topic repo (oref notify topic))))
+
+(cl-defmethod forge-get-notification ((id string))
+ (closql-get (forge-db) id 'forge-notification))
+
+(cl-defmethod forge-get-notification ((topic forge-topic))
+ (and-let* ((row (car (forge-sql [:select * :from notification
+ :where (and (= repository $s1)
+ (= topic $s2))]
+ (oref topic repository)
+ (oref topic number)))))
+ (closql--remake-instance 'forge-notification (forge-db) row)))
+
+;;;; Current
+
+(defun forge-current-notification (&optional demand)
+ "Return the current notification, casting a topic if necessary.
+If there is no such notification and DEMAND is non-nil, then
+signal an error."
+ (or (magit-section-value-if 'notification)
+ (and-let* ((topic (forge-current-topic)))
+ (forge-get-notification topic))
+ (and demand (user-error "No current notification"))))
+
+(defun forge-notification-at-point (&optional demand)
+ "Return the notification at point, casting a topic if necessary.
+If there is no such notification and DEMAND is non-nil, then
+signal an error."
+ (or (magit-section-value-if 'notification)
+ (and-let* ((topic (forge-topic-at-point)))
+ (forge-get-notification topic))
+ (and demand (user-error "No notification at point"))))
+
+;;;; List
+
+(defun forge--ls-notifications (status)
+ (let* ((status (ensure-list status))
+ (savedp (memq 'saved status))
+ (status (remq 'saved status)))
+ (mapcar
+ (lambda (row) (closql--remake-instance 'forge-notification (forge-db) row))
+ (if (seq-set-equal-p status '(unread pending done) #'eq)
+ (forge-sql [:select * :from notification :order-by [(desc updated)]])
+ (forge-sql
+ `[:select :distinct notification:*
+ :from [notification (as issue topic)]
+ :where (and (= notification:topic topic:id)
+ ,@(and status '((in topic:status $v1)))
+ ,@(and savedp '((= topic:saved-p 't))))
+ :union
+ :select :distinct notification:*
+ :from [notification (as pullreq topic)]
+ :where (and (= notification:topic topic:id)
+ ,@(and status '((in topic:status $v1)))
+ ,@(and savedp '((= topic:saved-p 't))))
+ :order-by [(desc notification:updated)]]
+ (vconcat status))))))
+
+;;; Mode
+
+(defvar-keymap forge-notifications-mode-map
+ :doc "Keymap for `forge-notifications-mode'."
+ :parent magit-mode-map
+ "<remap> <magit-refresh>" #'magit-refresh-buffer
+ "C-c C-m" #'forge-notifications-menu)
+
+(define-derived-mode forge-notifications-mode magit-mode "Forge Notifications"
+ "Mode for looking at forge notifications."
+ (hack-dir-local-variables-non-file-buffer))
+
+(defun forge-notifications-setup-buffer ()
+ (magit-setup-buffer-internal #'forge-notifications-mode nil
+ '((default-directory "/")
+ (forge-buffer-unassociated-p t))
+ (get-buffer-create "*forge-notifications*")))
+
+(defun forge-notifications-refresh-buffer ()
+ (forge-insert-notifications))
+
+(defvar forge-notifications-display-style 'flat)
+(defvar forge-notifications-selection '(unread pending))
+
+;;; Commands
+
+(transient-define-prefix forge-notifications-menu ()
+ "Control list of notifications and notification at point."
+ :transient-suffix t
+ :transient-non-suffix t
+ :transient-switch-frame nil
+ :refresh-suffixes t
+ :column-widths forge--topic-menus-column-widths
+ [:hide always
+ ("q" forge-menu-quit-list)
+ ("RET" forge-topic-menu)
+ ("<return>" forge-topic-menu)]
+ [["Type"
+ ("t" "topics..." forge-topics-menu :transient replace)
+ (:info "notifications" :face forge-suffix-active)
+ ("r" "repositories..." forge-repositories-menu :transient replace)
+ ""]
+ ["Selection"
+ ("I" forge-notifications-display-inbox)
+ ("S" forge-notifications-display-saved)
+ ("D" forge-notifications-display-done)
+ ("A" forge-notifications-display-all)]]
+ [forge--topic-set-state-group
+ ["Group"
+ ("f" forge-notifications-style-flat)
+ ("g" forge-notifications-style-nested)]]
+ [forge--topic-set-status-group]
+ (interactive)
+ (unless (derived-mode-p 'forge-notifications-mode)
+ (forge-list-notifications))
+ (transient-setup 'forge-notifications-menu))
+
+;;;###autoload
+(defun forge-list-notifications ()
+ "List notifications."
+ (interactive)
+ (forge-notifications-setup-buffer))
+
+(transient-define-suffix forge-notifications-display-inbox ()
+ "List unread and pending notifications."
+ :description "inbox"
+ :inapt-if (lambda () (equal forge-notifications-selection '(unread pending)))
+ :inapt-face 'forge-suffix-active
+ (interactive)
+ (unless (derived-mode-p 'forge-notifications-mode)
+ (user-error "Not in notification buffer"))
+ (setq forge-notifications-selection '(unread pending))
+ (forge-refresh-buffer))
+
+(transient-define-suffix forge-notifications-display-saved ()
+ "List saved notifications."
+ :description "saved"
+ :inapt-if (lambda () (eq forge-notifications-selection 'saved))
+ :inapt-face 'forge-suffix-active
+ (interactive)
+ (unless (derived-mode-p 'forge-notifications-mode)
+ (user-error "Not in notification buffer"))
+ (setq forge-notifications-selection 'saved)
+ (forge-refresh-buffer))
+
+(transient-define-suffix forge-notifications-display-done ()
+ "List done notifications."
+ :description "done"
+ :inapt-if (lambda () (eq forge-notifications-selection 'done))
+ :inapt-face 'forge-suffix-active
+ (interactive)
+ (unless (derived-mode-p 'forge-notifications-mode)
+ (user-error "Not in notification buffer"))
+ (setq forge-notifications-selection 'done)
+ (forge-refresh-buffer))
+
+(transient-define-suffix forge-notifications-display-all ()
+ "List all notifications."
+ :description "all"
+ :inapt-if (lambda () (equal forge-notifications-selection '(unread pending done)))
+ :inapt-face 'forge-suffix-active
+ (interactive)
+ (unless (derived-mode-p 'forge-notifications-mode)
+ (user-error "Not in notification buffer"))
+ (setq forge-notifications-selection '(unread pending done))
+ (forge-refresh-buffer))
+
+(transient-define-suffix forge-notifications-style-flat ()
+ "Show a flat notification list."
+ :description "flat list"
+ :inapt-if (lambda () (eq forge-notifications-display-style 'flat))
+ :inapt-face 'forge-suffix-active
+ (interactive)
+ (unless (derived-mode-p 'forge-notifications-mode)
+ (user-error "Not in notification buffer"))
+ (setq forge-notifications-display-style 'flat)
+ (forge-refresh-buffer))
+
+(transient-define-suffix forge-notifications-style-nested ()
+ "Group notifications by repository."
+ :description "by repository"
+ :inapt-if (lambda () (eq forge-notifications-display-style 'nested))
+ :inapt-face 'forge-suffix-active
+ (interactive)
+ (unless (derived-mode-p 'forge-notifications-mode)
+ (user-error "Not in notification buffer"))
+ (setq forge-notifications-display-style 'nested)
+ (forge-refresh-buffer))
+
+;;; Sections
+
+(defclass forge-repository-section (magit-section)
+ ((type :initform 'forge-repo)
+ (keymap :initform 'forge-repository-section-map)))
+
+(define-obsolete-variable-alias 'forge-forge-repo-section-map
+ 'forge-repository-section-map "Forge 0.4.0")
+
+(defvar-keymap forge-repository-section-map
+ "<remap> <magit-browse-thing>" #'forge-browse-this-repository
+ "<remap> <magit-visit-thing>" #'forge-visit-this-repository)
+
+(defun forge-insert-notifications ()
+ (let* ((status forge-notifications-selection)
+ (notifs (forge--ls-notifications status)))
+ (magit-insert-section (notifications)
+ (magit-insert-heading
+ (cond
+ ((not (listp status))
+ (format "%s notifications" (capitalize (symbol-name status))))
+ ((seq-set-equal-p status '(unread pending)) "Inbox")
+ ((seq-set-equal-p status '(unread pending done)) "All notifications")
+ ((format "Notifications %s" status))))
+ (if (eq forge-notifications-display-style 'flat)
+ (magit-insert-section-body
+ (if (not notifs)
+ (insert "(empty)\n")
+ (dolist (notif notifs)
+ (forge-insert-notification notif))
+ (insert ?\n)))
+ (pcase-dolist (`(,_ . ,notifs)
+ (--group-by (oref it repository) notifs))
+ (let ((repo (forge-get-repository (car notifs))))
+ (magit-insert-section (forge-repo repo)
+ (magit-insert-heading
+ (concat (propertize (format "%s/%s"
+ (oref repo owner)
+ (oref repo name))
+ 'font-lock-face 'bold)
+ (format " (%s)" (length notifs))))
+ (magit-insert-section-body
+ (dolist (notif notifs)
+ (forge-insert-notification notif))
+ (insert ?\n)))))))))
+
+(defun forge-insert-notification (notif)
+ (with-slots (type title url) notif
+ (pcase type
+ ((or 'issue 'pullreq)
+ (forge--insert-topic (forge-get-topic notif)))
+ ('commit
+ (magit-insert-section (ncommit nil) ; !commit
+ (string-match "[^/]*\\'" url)
+ (insert
+ (format "%s %s\n"
+ (propertize (substring (match-string 0 url)
+ 0 (magit-abbrev-length))
+ 'font-lock-face 'magit-hash)
+ (magit-log-propertize-keywords
+ nil
+ (propertize title 'font-lock-face
+ (if-let ((topic (oref notif topic))
+ ((eq (oref topic status) 'unread)))
+ 'forge-topic-unread
+ 'forge-topic-open)))))))
+ (_
+ ;; The documentation does not mention what "types"
+ ;; exist. Make it obvious that this is something
+ ;; we do not know how to handle properly yet.
+ (magit-insert-section (notification notif)
+ (insert (propertize (format "(%s) %s\n" type title)
+ 'font-lock-face 'error)))))))
+
+;;; _
+(provide 'forge-notify)
+;;; forge-notify.el ends here
--- /dev/null
+(define-package "forge" "20240523.1103" "Access Git forges from Magit."
+ '((emacs "26.3")
+ (compat "29.1.4.5")
+ (closql "20240405")
+ (dash "2.19.1")
+ (emacsql "20240124")
+ (ghub "20240507")
+ (let-alist "1.0.6")
+ (magit "20240428")
+ (markdown-mode "2.6")
+ (seq "2.24")
+ (transient "20240421")
+ (yaml "0.5.5"))
+ :commit "ceb6f5b8d257fe5e79532793cdd055c3dddd8806" :authors
+ '(("Jonas Bernoulli" . "emacs.forgeNOSPAMjonas.bernoulli.dev"))
+ :maintainer
+ '("Jonas Bernoulli" . "emacs.forgeNOSPAMjonas.bernoulli.dev")
+ :keywords
+ '("git" "tools" "vc")
+ :url "https://github.com/magit/forge")
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /dev/null
+;;; forge-post.el --- Post support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'markdown-mode)
+
+(require 'forge)
+
+;;; Options
+
+(defcustom forge-post-mode-hook
+ '(visual-line-mode
+ turn-on-flyspell)
+ "Hook run after entering Forge-Post mode."
+ :package-version '(forge . "0.2.0")
+ :group 'forge
+ :type 'hook
+ :options '(visual-line-mode
+ turn-on-flyspell))
+
+(defcustom forge-buffer-draft-p nil
+ "Whether new pull-requests start out as drafts by default.
+
+The buffer-local value is use to keep track of the draft status
+of the current pull-request."
+ :package-version '(forge . "0.4.0")
+ :group 'forge
+ :type 'boolean)
+
+;;; Class
+
+(defclass forge-post (forge-object) () :abstract t)
+
+;;; Query
+;;;; Get
+
+(cl-defmethod forge-get-parent ((post forge-post))
+ (forge-get-topic post))
+
+(cl-defmethod forge-get-repository ((post forge-post))
+ (forge-get-repository (forge-get-topic post)))
+
+;;;; Current
+
+(defun forge-post-at-point (&optional assert)
+ "Return the post at point.
+If there is no such post and DEMAND is non-nil, then signal
+an error."
+ (or (magit-section-value-if '(issue pullreq post))
+ (and assert (user-error "There is no post at point"))))
+
+(defun forge-comment-at-point (&optional assert)
+ "Return the comment at point.
+If there is no such comment and DEMAND is non-nil, then signal
+an error."
+ (or (and (magit-section-value-if '(post))
+ (let ((post (oref (magit-current-section) value)))
+ (and (or (forge-pullreq-post-p post)
+ (forge-issue-post-p post))
+ post)))
+ (and assert (user-error "There is no comment at point"))))
+
+;;; Utilities
+
+(cl-defmethod forge--format ((post forge-post) slot &optional spec)
+ (forge--format (forge-get-topic post) slot
+ `(,@spec (?I . ,(oref post number)))))
+
+;;; Mode
+
+(defvar-keymap forge-post-mode-map
+ "C-c C-e" #'forge-post-dispatch
+ "C-c C-c" #'forge-post-submit
+ "<remap> <evil-save-and-close>" #'forge-post-submit
+ "<remap> <evil-save-modified-and-close>" #'forge-post-submit
+ "C-c C-k" #'forge-post-cancel
+ "<remap> <kill-buffer>" #'forge-post-cancel
+ "<remap> <ido-kill-buffer>" #'forge-post-cancel
+ "<remap> <iswitchb-kill-buffer>" #'forge-post-cancel
+ "<remap> <evil-quit>" #'forge-post-cancel)
+
+(define-derived-mode forge-post-mode gfm-mode "Forge-Post" "")
+
+(defvar-local forge--buffer-base-branch nil)
+(defvar-local forge--buffer-head-branch nil)
+(defvar-local forge--buffer-post-object nil)
+(defvar-local forge--buffer-issue nil)
+(defvar-local forge--submit-post-function nil)
+(defvar-local forge--cancel-post-function nil)
+(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)
+ (let ((file (convert-standard-filename
+ (expand-file-name (concat "magit/posts/" filename)
+ (magit-gitdir)))))
+ (make-directory (file-name-directory file) t)
+ (let ((prevbuf (current-buffer))
+ (resume (and (file-exists-p file)
+ (> (file-attribute-size (file-attributes file)) 0)))
+ (buf (find-file-noselect file)))
+ (with-current-buffer buf
+ (forge-post-mode)
+ (when header
+ (magit-set-header-line-format header))
+ (setq forge--pre-post-buffer prevbuf)
+ (when resume
+ (forge--display-post-buffer buf)
+ (when (magit-read-char-case "A draft already exists. " nil
+ (?r "[r]esume editing existing draft")
+ (?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))
+ (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))
+ (unless (re-search-forward "^title: " nil t)
+ (when (re-search-forward "^---" nil t 2)
+ (beginning-of-line)
+ (insert "title: \n")
+ (backward-char))))
+ (t
+ (insert "# ")
+ (let ((single
+ (and source
+ (= (car (magit-rev-diff-count source target)) 1))))
+ (save-excursion
+ (when single
+ ;; A pull-request.
+ (magit-rev-insert-format "%B" source))
+ (when .text
+ (if single
+ (insert "-------\n")
+ (insert "\n"))
+ (insert "\n" .text)))))))))
+ buf)))
+
+(defun forge--display-post-buffer (buf)
+ (magit-display-buffer buf #'display-buffer))
+
+(defun forge-post-cancel ()
+ "Cancel the post that is being edited in the current buffer."
+ (interactive)
+ (save-buffer)
+ (if-let ((fn forge--cancel-post-function))
+ (funcall fn forge--buffer-post-object)
+ (magit-mode-bury-buffer 'kill)))
+
+(defun forge-post-submit ()
+ "Submit the post that is being edited in the current buffer."
+ (interactive)
+ (save-buffer)
+ (if-let ((fn forge--submit-post-function))
+ (funcall fn
+ (forge-get-repository forge--buffer-post-object)
+ forge--buffer-post-object)
+ (error "forge--submit-post-function is nil")))
+
+(defun forge--post-submit-callback ()
+ (let* ((file buffer-file-name)
+ (editbuf (current-buffer))
+ (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)
+ (run-hook-with-args 'forge-post-submit-callback-hook
+ value headers status req)
+ (delete-file file t)
+ (let ((dir (file-name-directory file)))
+ (unless (cddr (directory-files dir nil nil t))
+ (delete-directory dir nil t)))
+ (when (buffer-live-p editbuf)
+ (with-current-buffer editbuf
+ (magit-mode-bury-buffer 'kill)))
+ (with-current-buffer
+ (if (buffer-live-p prevbuf) prevbuf (current-buffer))
+ (if (and topic
+ (forge--childp repo 'forge-github-repository)
+ (oref repo selective-p))
+ (forge--pull-topic repo topic)
+ (forge-pull))))))
+
+(defun forge--post-submit-errorback ()
+ (lambda (error &rest _)
+ (error "Failed to submit post: %S" error)))
+
+(transient-define-prefix forge-post-dispatch ()
+ "Dispatch a post creation command."
+ ["Variables"
+ ("d" "Create draft" forge-post-toggle-draft)]
+ ["Act"
+ ("C-c" "Submit" forge-post-submit)
+ ("C-k" "Cancel" forge-post-cancel)])
+
+(transient-define-infix forge-post-toggle-draft ()
+ "Toggle whether the pull-request being created is a draft."
+ :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")))
+
+;;; Notes
+
+(defclass forge-note (forge-post) ())
+
+(defvar-keymap forge-note-section-map
+ "<remap> <magit-edit-thing>" #'forge-edit-topic-note)
+
+(defun forge--save-note (_repo topic)
+ (let ((value (string-trim (buffer-substring-no-properties
+ (point-min)
+ (point-max)))))
+ (oset topic note (if (equal value "") nil value)))
+ (delete-file buffer-file-name t)
+ (let ((dir (file-name-directory buffer-file-name)))
+ (unless (cddr (directory-files dir nil nil t))
+ (delete-directory dir)))
+ (let ((prevbuf forge--pre-post-buffer))
+ (magit-mode-bury-buffer 'kill)
+ (forge-refresh-buffer prevbuf)))
+
+;;; _
+(provide 'forge-post)
+;;; forge-post.el ends here
--- /dev/null
+;;; forge-pullreq.el --- Pullreq support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'forge)
+(require 'forge-post)
+(require 'forge-topic)
+
+;;; Classes
+
+(defclass forge-pullreq (forge-topic)
+ ((closql-table :initform 'pullreq)
+ (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)
+ (state :initarg :state)
+ (author :initarg :author)
+ (title :initarg :title)
+ (created :initarg :created)
+ (updated :initarg :updated :initform nil)
+ (closed :initarg :closed)
+ (merged :initarg :merged)
+ (status :initarg :status :initform nil)
+ (locked-p :initarg :locked-p)
+ (editable-p :initarg :editable-p)
+ (cross-repo-p :initarg :cross-repo-p)
+ (base-ref :initarg :base-ref)
+ (base-repo :initarg :base-repo)
+ (head-ref :initarg :head-ref)
+ (head-user :initarg :head-user)
+ (head-repo :initarg :head-repo)
+ (milestone :initarg :milestone)
+ (body :initarg :body)
+ (assignees :closql-table (pullreq-assignee assignee))
+ (project-cards) ; projectsCards
+ (commits)
+ (edits) ; userContentEdits
+ (labels :closql-table (pullreq-label label))
+ (participants)
+ (posts :closql-class forge-pullreq-post)
+ (reactions)
+ (review-requests :closql-table (pullreq-review-request assignee))
+ (reviews)
+ (timeline)
+ (marks :closql-table (pullreq-mark mark))
+ (note :initarg :note :initform nil)
+ (base-rev :initarg :base-rev)
+ (head-rev :initarg :head-rev)
+ (draft-p :initarg :draft-p)
+ (their-id :initarg :their-id)
+ (slug :initarg :slug)
+ (saved-p :initarg :saved-p :initform nil)
+ ))
+
+(defclass forge-pullreq-post (forge-post)
+ ((closql-table :initform 'pullreq-post)
+ (closql-primary-key :initform 'id)
+ (closql-order-by :initform [(asc number)])
+ (closql-foreign-key :initform 'pullreq)
+ (closql-class-prefix :initform "forge-pullreq-")
+ (id :initarg :id)
+ (pullreq :initarg :pullreq)
+ (number :initarg :number)
+ (author :initarg :author)
+ (created :initarg :created)
+ (updated :initarg :updated)
+ (body :initarg :body)
+ (edits)
+ (reactions)
+ ))
+
+;;; Query
+;;;; Get
+
+(cl-defmethod forge-get-repository ((post forge-pullreq-post))
+ (forge-get-repository (forge-get-pullreq post)))
+
+(cl-defmethod forge-get-topic ((post forge-pullreq-post))
+ (forge-get-pullreq post))
+
+(cl-defmethod forge-get-pullreq ((pullreq forge-pullreq))
+ pullreq)
+
+(cl-defmethod forge-get-pullreq ((repo forge-repository) number)
+ (closql-get (forge-db)
+ (forge--object-id 'forge-pullreq repo number)
+ 'forge-pullreq))
+
+(cl-defmethod forge-get-pullreq ((number integer))
+ (and-let* ((repo (forge-get-repository :tracked)))
+ (forge-get-pullreq repo number)))
+
+(cl-defmethod forge-get-pullreq ((id string))
+ (closql-get (forge-db) id 'forge-pullreq))
+
+(cl-defmethod forge-get-pullreq ((post forge-pullreq-post))
+ (closql-get (forge-db)
+ (oref post pullreq)
+ 'forge-pullreq))
+
+(cl-defmethod forge-get-pullreq ((_(eql :branch)) &optional branch)
+ (and-let* ((branch (or branch
+ (magit-section-case
+ (branch (oref it value))
+ (commit (magit--painted-branch-at-point)))))
+ (branch (cdr (magit-split-branch-name branch)))
+ (number (magit-get "branch" branch "pullRequest")))
+ (forge-get-pullreq (string-to-number number))))
+
+;;;; Current
+
+(defun forge-current-pullreq (&optional demand)
+ "Return the pull-request at point or being visited.
+If there is no such pull-request and DEMAND is non-nil, then signal
+an error."
+ (or (forge-pullreq-at-point)
+ (and (forge-pullreq-p forge-buffer-topic)
+ forge-buffer-topic)
+ (and demand (user-error "No current pull-request"))))
+
+(defun forge-pullreq-at-point (&optional demand)
+ "Return the pull-request at point.
+If there is no such pull-request and DEMAND is non-nil, then signal
+an error."
+ (or (thing-at-point 'forge-pullreq)
+ (magit-section-value-if 'pullreq)
+ (forge-get-pullreq :branch)
+ (and (derived-mode-p 'forge-topic-list-mode)
+ (and-let* ((id (tabulated-list-get-id))
+ (topic (forge-get-topic id)))
+ (and (forge-pullreq-p topic)
+ topic)))
+ (and demand (user-error "No pull-request at point"))))
+
+(put 'forge-pullreq 'thing-at-point #'forge-thingatpt--pullreq)
+(defun forge-thingatpt--pullreq ()
+ (and-let* ((repo (forge--repo-for-thingatpt)))
+ (and (thing-at-point-looking-at
+ (if (forge-gitlab-repository--eieio-childp repo)
+ "[#!]\\([0-9]+\\)\\_>"
+ "#\\([0-9]+\\)\\_>"))
+ (forge-get-pullreq repo (string-to-number (match-string 1))))))
+
+;;;; List
+
+(defun forge--ls-recent-pullreqs (repo)
+ (forge-ls-recent-topics repo 'pullreq))
+
+(defun forge--ls-pullreqs (repo)
+ (forge--select-pullreqs repo
+ [:from pullreq :where (= pullreq:repository $s1)]))
+
+(defun forge--ls-active-pullreqs (repo)
+ (forge--select-pullreqs repo
+ [:from pullreq
+ :where (and (= pullreq:repository $s1)
+ (or (= pullreq:state 'open)
+ (in pullreq:status [pending unread])))]))
+
+(defun forge--ls-assigned-pullreqs (repo)
+ (forge--select-pullreqs repo
+ [:from pullreq
+ :join pullreq_assignee :on (= pullreq_assignee:pullreq pullreq:id)
+ :join assignee :on (= pullreq_assignee:id assignee:id)
+ :where (and (= pullreq:repository $s1)
+ (= assignee:login $s2)
+ (isnull pullreq:closed))]
+ (ghub--username repo)))
+
+(defun forge--ls-requested-reviews (repo)
+ (forge--select-pullreqs repo
+ [:from pullreq
+ :join pullreq_review_request :on (= pullreq_review_request:pullreq pullreq:id)
+ :join assignee :on (= pullreq_review_request:id assignee:id)
+ :where (and (= pullreq:repository $s1)
+ (= assignee:login $s2)
+ (isnull pullreq:closed))]
+ (ghub--username repo)))
+
+(defun forge--ls-authored-pullreqs (repo)
+ (forge--select-pullreqs repo
+ [:from [pullreq]
+ :where (and (= pullreq:repository $s1)
+ (= pullreq:author $s2)
+ (isnull pullreq:closed))]
+ (ghub--username repo)))
+
+(defun forge--ls-labeled-pullreqs (repo label)
+ (forge--select-pullreqs repo
+ [:from pullreq
+ :join pullreq_label :on (= pullreq_label:pullreq pullreq:id)
+ :join label :on (= pullreq_label:id label:id)
+ :where (and (= pullreq:repository $s1)
+ (= label:name $s2)
+ (isnull pullreq:closed))]
+ label))
+
+(defun forge--ls-owned-pullreqs ()
+ (forge--select-pullreqs nil
+ [:from [pullreq repository]
+ :where (and (= pullreq:repository repository:id)
+ (in repository:owner $v1)
+ (not (in repository:name $v2))
+ (isnull pullreq:closed))
+ :order-by [(asc repository:owner)
+ (asc repository:name)
+ (desc pullreq:number)]]
+ (vconcat (mapcar #'car forge-owned-accounts))
+ (vconcat forge-owned-ignored)))
+
+(defun forge--select-pullreqs (repo query &rest args)
+ (declare (indent 1))
+ (mapcar (let ((db (forge-db)))
+ (lambda (row)
+ (closql--remake-instance 'forge-pullreq db row)))
+ (apply #'forge-sql
+ (vconcat [:select *]
+ query
+ (and (not (cl-find :order-by query))
+ [:order-by [(desc updated)]]))
+ (if repo
+ (cons (oref repo id) args)
+ args))))
+
+;;; Read
+
+(defun forge-read-pullreq (prompt)
+ "Read an active pull-request with completion using PROMPT.
+
+Open, unread and pending pull-requests are considered active.
+Default to the current pull-request even if it isn't active.
+
+\\<forge-read-topic-minibuffer-map>While completion is in \
+progress, \\[forge-read-topic-lift-limit] lifts the limit, extending
+the completion candidates to include all pull-requests.
+
+If `forge-limit-topic-choices' is nil, then all candidates
+can be selected from the start."
+ (forge--read-topic prompt
+ #'forge-current-pullreq
+ #'forge--ls-active-pullreqs
+ #'forge--ls-pullreqs))
+
+;;; Utilities
+
+(defun forge--pullreq-branch-internal (pullreq)
+ (let ((branch (oref pullreq head-ref)))
+ ;; It is invalid for a branch name to begin with a colon, yet
+ ;; that is what Gitlab uses when a pull-request's source branch
+ ;; has been deleted. On Github this is simply nil in the same
+ ;; situation.
+ (and branch (not (string-prefix-p ":" branch)) branch)))
+
+(defun forge--pullreq-branch-active (pullreq)
+ (let* ((number (number-to-string (oref pullreq number)))
+ (branch-n (format "pr-%s" number))
+ (branch (forge--pullreq-branch-internal pullreq)))
+ (or (and (magit-branch-p branch)
+ (equal (magit-get "branch" branch "pullRequest") number)
+ branch)
+ (and (magit-branch-p branch-n)
+ (equal (magit-get "branch" branch-n "pullRequest") number)
+ branch-n))))
+
+(defun forge--pullreq-ref (pullreq)
+ (let ((ref (format "refs/pullreqs/%s" (oref pullreq number))))
+ (and (magit-rev-verify ref) ref)))
+
+(defun forge--pullreq-range (pullreq &optional endpoints)
+ (and-let* ((head (forge--pullreq-ref pullreq)))
+ (concat (forge--get-remote) "/" (oref pullreq base-ref)
+ (if endpoints "..." "..")
+ head)))
+
+;;; Insert
+
+(defvar-keymap forge-pullreqs-section-map
+ "<remap> <magit-browse-thing>" #'forge-browse-pullreqs
+ "<remap> <magit-visit-thing>" #'forge-list-pullreqs
+ "C-c C-m" #'forge-topics-menu
+ "C-c C-n" #'forge-create-pullreq)
+
+(defvar-keymap forge-pullreq-section-map
+ "<remap> <magit-visit-thing>" #'forge-visit-this-topic
+ "C-c C-m" #'forge-topic-menu)
+
+(defun forge-insert-pullreqs ()
+ "Insert a list of mostly recent and/or open pull-requests.
+Also see option `forge-topic-list-limit'."
+ (forge--insert-pullreqs "Pull requests"
+ #'forge--ls-recent-pullreqs))
+
+(defun forge-insert-assigned-pullreqs ()
+ "Insert a list of open pull-requests that are assigned to you."
+ (forge--insert-pullreqs "Assigned pull requests"
+ #'forge--ls-assigned-pullreqs))
+
+(defun forge-insert-requested-reviews ()
+ "Insert a list of pull-requests that are awaiting your review."
+ (forge--insert-pullreqs "Pull requests awaiting review"
+ #'forge--ls-requested-reviews))
+
+(defun forge-insert-authored-pullreqs ()
+ "Insert a list of open pullreqs that are authored by you."
+ (forge--insert-pullreqs "Authored pullreqs"
+ #'forge--ls-authored-pullreqs))
+
+(defun forge--insert-pullreqs (heading getter)
+ (when-let ((repo (forge--assert-insert-topics-get-repository)))
+ (forge--insert-topics 'pullreqs heading (funcall getter repo))))
+
+(defun forge--insert-pullreq-commits (pullreq &optional all)
+ (cl-letf (((symbol-function #'magit-cancel-section) (lambda ())))
+ (if all
+ ;; Numeric pr ref, pr branch (if it exists) and api
+ ;; pr range may be out of sync. Just show them all.
+ (magit-insert-section-body
+ (magit--insert-log nil
+ (delq nil (list (concat "^" (or (oref pullreq base-rev)
+ (concat (forge--get-remote) "/"
+ (oref pullreq base-ref))))
+ (forge--pullreq-ref pullreq)
+ (forge--pullreq-branch-active pullreq)
+ (and-let* ((branch (oref pullreq head-ref)))
+ (and (magit-local-branch-p branch) branch))))
+ (seq-uniq (cons "--graph" magit-buffer-log-args))))
+ (when-let ((range (forge--pullreq-range pullreq)))
+ (magit-insert-section-body
+ (magit--insert-log nil range magit-buffer-log-args)
+ (magit-make-margin-overlay nil t))))))
+
+;;; _
+(provide 'forge-pullreq)
+;;; forge-pullreq.el ends here
--- /dev/null
+;;; forge-repo.el --- Repository support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'forge)
+(require 'eieio)
+
+;;; 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)
+ (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))
+ :abstract t)
+
+(defclass forge-unusedapi-repository (forge-repository) () :abstract t)
+
+(defclass forge-noapi-repository (forge-repository) () :abstract t)
+
+(cl-defmethod slot-missing ((object forge-repository)
+ slot-name operation &optional _new-value)
+ (if (and (eq operation 'oref)
+ (eq slot-name 'slug))
+ (concat (oref object owner) "/"
+ (oref object name))
+ (cl-call-next-method)))
+
+;;; Query
+;;;; Get
+
+(defvar-local forge-buffer-repository nil)
+(put 'forge-buffer-repository 'permanent-local t)
+
+(defvar-local forge-buffer-unassociated-p nil)
+
+(defconst forge--signal-no-entry '(:tracked :stub :insert!))
+
+(defun forge--get-remote (&optional warn)
+ (let* ((remotes (magit-list-remotes))
+ (config (magit-get "forge.remote"))
+ (remote (if (cdr remotes)
+ (or (car (member config remotes))
+ (car (member "upstream" remotes))
+ (car (member "origin" remotes)))
+ (car remotes))))
+ (when (and warn config remote (not (equal config remote)))
+ (message "Ignored forge.remote=%s; no such remote.\nSee %s." config
+ "https://magit.vc/manual/forge/Repository-Detection.html"))
+ remote))
+
+(cl-defmethod forge-get-repository ((_(eql :id)) id)
+ (closql-get (forge-db) (substring-no-properties id) 'forge-repository))
+
+(cl-defmethod forge-get-repository ((demand symbol) &optional remote)
+ "Return the current forge repository.
+
+First check if `forge-buffer-repository', or if that is nil, then
+the repository for `forge-buffer-topic', satisfies DEMAND. If so,
+then return that repository.
+
+Otherwise return the repository for `default-directory', if that
+exists and satisfies DEMAND. If that fails too, then return nil
+or signal an error, depending on DEMAND."
+ (or (and-let* ((repo (or (forge-buffer-repository)
+ (and forge-buffer-topic
+ (forge-get-repository forge-buffer-topic)))))
+ (forge-get-repository repo 'noerror demand))
+ (magit--with-refresh-cache
+ (list default-directory 'forge-get-repository demand)
+ (if (not (magit-gitdir))
+ (when (memq demand forge--signal-no-entry)
+ (error
+ "Cannot determine Forge repository outside of Git repository"))
+ (unless remote
+ (setq remote (forge--get-remote 'warn)))
+ (if-let ((url (and remote
+ (magit-git-string "remote" "get-url" remote))))
+ (and-let* ((repo (forge-get-repository url remote demand)))
+ (progn ; work around debbugs#31840
+ (oset repo worktree (magit-toplevel))
+ repo))
+ (when (memq demand forge--signal-no-entry)
+ (error
+ "Cannot determine forge repository. %s\nSee %s."
+ (cond (remote (format "No url configured for %S." remote))
+ ((and-let* ((config (magit-get "forge.remote")))
+ (format "Value of `forge.remote' is %S but %s"
+ config "that remote does not exist.")))
+ ((magit-list-remotes) "Cannot decide on remote to use.")
+ (t "No remote configured."))
+ "https://magit.vc/manual/forge/Repository-Detection.html")))))))
+
+(cl-defmethod forge-get-repository ((url string) &optional remote demand)
+ "Return the repository at URL."
+ (if-let ((parts (forge--split-forge-url url)))
+ (forge-get-repository parts remote (or demand :known?))
+ (when (memq demand forge--signal-no-entry)
+ (error "Cannot determine forge repository. %s isn't a forge URL. %s"
+ url "You might have to customize `forge-alist'."))))
+
+(cl-defmethod forge-get-repository (((host owner name) list)
+ &optional remote demand)
+ "((HOST OWNER NAME) &optional REMOTE DEMAND)
+
+Return the repository identified by HOST, OWNER and NAME.
+See `forge-alist' for valid Git hosts."
+ (setq host (substring-no-properties host))
+ (setq owner (substring-no-properties owner))
+ (setq name (substring-no-properties name))
+ (unless (memq demand '( :tracked :tracked?
+ :known? :insert! :valid?
+ :stub :stub?))
+ (if-let ((new (pcase demand
+ ('t :tracked)
+ ('full :tracked?)
+ ('nil :known?)
+ ('create :insert!)
+ ('stub :stub)
+ ('maybe :stub?))))
+ (progn
+ (message "Obsolete value for `%s's DEMAND: `%s'; use `%s' instead"
+ 'forge-get-repository demand new)
+ (setq demand new))
+ (error "Unknown value for `%s's DEMAND: `%s'"
+ 'forge-get-repository demand)))
+ (if-let ((spec (forge--get-forge-host host t)))
+ (pcase-let ((`(,githost ,apihost ,webhost ,class) spec))
+ ;; The `webhost' is used to identify the corresponding forge.
+ ;; For that reason it is stored in the `forge' slot. The id
+ ;; stored in the `id' slot also derives from that value.
+ (let* ((row (car (forge-sql [:select * :from repository
+ :where (and (= forge $s1)
+ (= owner $s2)
+ (= name $s3))]
+ webhost owner name)))
+ (obj (and row (closql--remake-instance class (forge-db) row))))
+ ;; Synchronize the object with the entry from `forge-alist'.
+ ;; This only has an effect if the entry was modified, which
+ ;; should rarely, if ever, happen. Avoid confusion, by not
+ ;; mentioning this detail in any docstring.
+ (when obj
+ (oset obj apihost apihost)
+ (oset obj githost githost)
+ (oset obj remote remote))
+ (pcase (list demand (and obj (eq (oref obj condition) :tracked)))
+ (`(:tracked? nil) (setq obj nil))
+ (`(:tracked nil)
+ (error "Cannot use `%s' in %S yet.\n%s"
+ this-command (magit-toplevel)
+ "Use `M-x forge-add-repository' before trying again.")))
+ (when (and (memq demand '(:insert! :valid? :stub :stub?))
+ (not obj))
+ (pcase-let ((`(,id . ,forge-id)
+ (forge--repository-ids
+ class webhost owner name
+ (memq demand '(:stub :stub?))
+ (eq demand :valid?))))
+ (if (not id)
+ ;; `:valid?' was used and it turned out it is not.
+ (setq obj nil)
+ ;; The repo might have been renamed on the forge. #188
+ (unless (setq obj (forge-get-repository :id id))
+ (setq obj (funcall class
+ :id id
+ :forge-id forge-id
+ :forge webhost
+ :owner owner
+ :name name
+ :apihost apihost
+ :githost githost
+ :remote remote))
+ (when (eq demand :insert!)
+ (closql-insert (forge-db) obj)
+ (oset obj condition :known))))))
+ obj))
+ (when (memq demand forge--signal-no-entry)
+ (error "Cannot determine forge repository. No entry for %S in %s"
+ host 'forge-alist))))
+
+(cl-defmethod forge-get-repository ((repo forge-repository)
+ &optional noerror demand)
+ (setq noerror (and noerror t))
+ (with-slots (condition slug) repo
+ (cl-symbol-macrolet
+ ((err (error "Requested %s for %s, but is %s" demand slug condition))
+ (key (list (oref repo forge)
+ (oref repo owner)
+ (oref repo name)))
+ (ins (forge-get-repository key nil :insert!))
+ (set (forge-get-repository key nil :valid?)))
+ (pcase-exhaustive (list demand condition noerror)
+ (`(nil ,_ ,_) repo)
+ (`(:tracked? :tracked ,_) repo)
+ (`(:tracked? ,_ ,_) nil)
+ (`(:tracked :tracked ,_) repo)
+ (`(:tracked ,_ t) nil)
+ (`(:tracked ,_ nil) err)
+ (`(:known? ,(or :tracked :known) ,_) repo)
+ (`(:known? ,_ ,_) nil)
+ (`(:insert! ,(or :tracked :known) ,_) repo)
+ (`(:insert! ,_ ,_) ins)
+ (`(:valid? ,(or :tracked :known) ,_) repo)
+ (`(:valid? ,_ ,_) set)
+ (`(:stub? ,_ ,_) repo)
+ (`(:stub ,_ ,_) repo)))))
+
+(cl-defmethod forge-get-repository ((_ null) &optional noerror demand)
+ (if (and (memq demand '(:insert! :tracked :stub))
+ (not noerror))
+ (error "(Maybe repository) is nil; `%s' not satisfied" demand)
+ nil))
+
+(defun forge--get-repository:tracked? ()
+ (forge-get-repository :tracked?))
+
+(defun forge-get-worktree (repo)
+ "Validate and return the worktree recorded for REPO.
+If no worktree is recorded, return nil. If a worktree is recorded but
+that doesn't exist anymore, then discard the recorded value and return
+nil."
+ (and-let* ((worktree (oref repo worktree)))
+ (if (file-directory-p worktree)
+ worktree
+ (oset repo worktree nil)
+ nil)))
+
+;;;; Current
+
+(defun forge-current-repository (&optional demand)
+ "Return the repository at point or being visited.
+If there is no such repository and DEMAND is non-nil, then signal
+an error."
+ (or (forge-repository-at-point)
+ (forge-buffer-repository)
+ (forge-get-repository :known?)
+ (and demand (user-error "No current repository"))))
+
+(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
+an error."
+ (or (magit-section-value-if 'forge-repo)
+ (and-let* ((topic (forge-topic-at-point)))
+ (forge-get-repository topic))
+ (and (derived-mode-p 'forge-repository-list-mode)
+ (and-let* ((id (tabulated-list-get-id)))
+ (forge-get-repository :id id)))
+ (and demand (user-error "No repository at point"))))
+
+(defun forge--repo-for-thingatpt ()
+ (or (magit-section-value-if 'forge-repo)
+ (and-let* ((topic (magit-section-value-if '(issue pullreq))))
+ (forge-get-repository topic))
+ (and (not forge-buffer-unassociated-p)
+ (or (forge-buffer-repository)
+ (forge-get-repository :known?)))))
+
+(defun forge-buffer-repository ()
+ (and-let* ((id forge-buffer-repository))
+ (forge-get-repository :id id)))
+
+;;;; List
+
+(defun forge--ls-repos ()
+ (mapcar (let ((db (forge-db)))
+ (lambda (row)
+ (closql--remake-instance 'forge-repository db row)))
+ (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)))
+ (forge-sql [:select * :from repository
+ :where (and (in owner $v1)
+ (not (in name $v2)))
+ :order-by [(asc owner) (asc name)]]
+ (vconcat (mapcar #'car forge-owned-accounts))
+ (vconcat forge-owned-ignored))))
+
+;;; Identity
+
+(defun forge-repository-equal (repo1 repo2)
+ "Return t if REPO1 and REPO2 are the same repository.
+REPO1 and/or REPO2 may also be nil, in which case return nil."
+ (and repo1 repo2
+ (or (equal (oref repo1 id) (oref repo2 id))
+ (and (equal (oref repo1 githost) (oref repo2 githost))
+ (equal (oref repo1 owner) (oref repo2 owner))
+ (equal (oref repo1 name) (oref repo2 name))))))
+
+(cl-defmethod forge--repository-ids ((class (subclass forge-repository))
+ host owner name &optional stub noerror)
+ "Return (OUR-ID . THEIR-ID) of the specified repository.
+If optional STUB is non-nil, then the IDs are not guaranteed to
+be unique. Otherwise this method has to make an API request to
+retrieve THEIR-ID, the repository's ID on the forge. In that
+case OUR-ID derives from THEIR-ID and is unique across all
+forges and hosts."
+ (pcase-let* ((`(,_githost ,apihost ,id ,_class)
+ (forge--get-forge-host host t))
+ (path (format "%s/%s" owner name))
+ (their-id (and (not stub)
+ (ghub-repository-id
+ owner name
+ :host apihost
+ :auth 'forge
+ :forge (forge--ghub-type-symbol class)
+ :noerror noerror))))
+ (and (or stub their-id (not noerror))
+ (cons (base64-encode-string
+ (format "%s:%s" id
+ (cond (stub path)
+ ((eq class 'forge-github-repository)
+ ;; This is base64 encoded, according to
+ ;; https://docs.github.com/en/graphql/
+ ;; reference/scalars#id. Unfortunately
+ ;; that is not always true. E.g.,
+ ;; https://github.com/dit7ya/roamex.
+ (condition-case nil
+ (base64-decode-string their-id)
+ (error their-id)))
+ (t their-id)))
+ t)
+ (or their-id path)))))
+
+(cl-defmethod forge--repository-ids ((_class (subclass forge-noapi-repository))
+ host owner name &optional _stub _noerror)
+ (let ((their-id (if owner (concat owner "/" name) name)))
+ (cons (base64-encode-string
+ (format "%s:%s"
+ (nth 3 (forge--get-forge-host host t))
+ their-id)
+ t)
+ their-id)))
+
+;;; Read
+
+(defun forge-read-repository (prompt)
+ (let ((choice (magit-completing-read
+ prompt
+ (mapcar (pcase-lambda (`(,host ,owner ,name))
+ (format "%s/%s @%s" owner name host))
+ (forge-sql [:select [githost owner name]
+ :from repository]))
+ nil t nil nil
+ (and-let* ((default (forge-current-repository)))
+ (format "%s/%s @%s"
+ (oref default owner)
+ (oref default name)
+ (oref default githost))))))
+ (save-match-data
+ (if (string-match "\\`\\(.+\\)/\\([^/]+\\) @\\(.+\\)\\'" choice)
+ (forge-get-repository (list (match-string 3 choice)
+ (match-string 1 choice)
+ (match-string 2 choice)))
+ (error "BUG")))))
+
+(defun forge-read-host (prompt &optional class)
+ (magit-completing-read
+ prompt
+ (if class
+ (seq-keep (pcase-lambda (`(,githost ,_apihost ,_webhost ,c))
+ (and (child-of-class-p c class) githost))
+ forge-alist)
+ (mapcar #'car forge-alist))
+ nil t))
+
+;;; Miscellaneous
+
+(defun forge--as-githost (host)
+ (or (car (car (cl-member host forge-alist :test #'equal :key #'car)))
+ (car (car (cl-member host forge-alist :test #'equal :key #'cadr)))
+ (car (car (cl-member host forge-alist :test #'equal :key #'caddr)))
+ (user-error "Cannot determine githost for %S" host)))
+
+(defun forge--as-apihost (host)
+ (or (cadr (car (cl-member host forge-alist :test #'equal :key #'cadr)))
+ (cadr (car (cl-member host forge-alist :test #'equal :key #'car)))
+ (cadr (car (cl-member host forge-alist :test #'equal :key #'caddr)))
+ (user-error "Cannot determine apihost for %S" host)))
+
+(cl-defmethod forge--format ((repo forge-repository) format-or-slot &optional spec)
+ (pcase-let* (((eieio (forge webhost) owner name) repo)
+ (path (if owner (concat owner "/" name) name)))
+ (format-spec
+ (let ((format (if (symbolp format-or-slot)
+ (eieio-oref repo format-or-slot)
+ format-or-slot)))
+ (if (member webhost ghub-insecure-hosts)
+ (replace-regexp-in-string "\\`https://" "http://" format t t)
+ format))
+ `(,@spec
+ (?h . ,webhost)
+ (?o . ,owner)
+ (?n . ,name)
+ (?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 (and transient--showp
+ (memq transient-current-command
+ '(forge-topic-menu
+ forge-topics-menu
+ forge-notifications-menu)))
+ (transient--refresh-transient))))))
+
+(defvar forge--mode-line-buffer nil)
+
+(defun forge--msg (repo echo done format &rest args)
+ (let ((msg (apply #'format format args)))
+ (when repo
+ (setq msg (string-replace
+ "REPO"
+ (concat (oref repo owner) "/" (oref repo name))
+ msg)))
+ (when (and echo msg)
+ (message "%s%s" msg (if done "...done" "...")))
+ (when (buffer-live-p forge--mode-line-buffer)
+ (with-current-buffer forge--mode-line-buffer
+ (setq mode-line-process
+ (if done
+ nil
+ (concat " " (propertize msg 'font-lock-face
+ 'magit-mode-line-process)))))
+ (force-mode-line-update t))))
+
+(cl-defmethod ghub--host ((repo forge-repository))
+ (cl-call-next-method (forge--ghub-type-symbol (eieio-object-class repo))))
+
+(cl-defmethod ghub--username ((repo forge-repository))
+ (let ((default-directory default-directory))
+ (unless (forge-repository-equal (forge-get-repository :stub?) repo)
+ (when-let ((worktree (forge-get-worktree repo)))
+ (setq default-directory worktree)))
+ (cl-call-next-method (oref repo apihost)
+ (forge--ghub-type-symbol (eieio-object-class repo)))))
+
+(defun forge--ghub-type-symbol (class)
+ (pcase-exhaustive class
+ ;; This package does not define a `forge-gitlab-http-repository'
+ ;; class, but we used to suggest at #9 that users define such a class
+ ;; if they must connect to a Gitlab instance that uses http instead
+ ;; of https. Doing that isn't necessary anymore, but we have to keep
+ ;; supporting it here. It is now sufficient to add an entry to
+ ;; `ghub-insecure-hosts'.
+ ((or 'forge-gitlab-repository 'forge-gitlab-http-repository) 'gitlab)
+ ('forge-github-repository 'github)
+ ('forge-gitea-repository 'gitea)
+ ('forge-gogs-repository 'gogs)
+ ('forge-bitbucket-repository 'bitbucket)))
+
+;;; _
+(provide 'forge-repo)
+;;; forge-repo.el ends here
--- /dev/null
+;;; forge-repos.el --- List repositories -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'hl-line)
+
+(require 'forge-repo)
+(require 'forge-tablist)
+
+(defvar x-stretch-cursor)
+
+;;; Options
+
+(defcustom forge-repository-list-mode-hook '(hl-line-mode)
+ "Hook run after entering Forge-Repository-List mode."
+ :package-version '(forge . "0.4.0")
+ :group 'forge
+ :type 'hook
+ :options '(hl-line-mode))
+
+(defcustom forge-repository-list-columns
+ '(("Owner" owner 20 t nil)
+ ("Name" name 20 t nil)
+ ("T" forge-format-repo-condition 1 t nil)
+ ("S" forge-format-repo-selective 1 t nil)
+ ("Worktree" worktree 99 t nil))
+ "List of columns displayed when listing repositories.
+
+Each element has the form (HEADER SOURCE WIDTH SORT PROPS).
+
+HEADER is the string displayed in the header. WIDTH is the width
+of the column. SOURCE is used to get the value, it has to be the
+name of a slot of `forge-repository' or a function that takes
+such an object as argument. SORT is a boolean or a function used
+to sort by this column. Supported PROPS include `:right-align'
+and `:pad-right'."
+ :package-version '(forge . "0.4.0")
+ :group 'forge
+ :type forge--tablist-columns-type)
+
+;;; Mode
+
+(defvar-keymap forge-repository-list-mode-map
+ :doc "Local keymap for Forge-Repository-List mode buffers."
+ :parent tabulated-list-mode-map
+ "RET" #'forge-visit-this-repository
+ "<return>" #'forge-visit-this-repository
+ "o" #'forge-browse-this-repository
+ "C-c C-m" #'forge-repositories-menu
+ "'" #'forge-dispatch
+ "?" #'magit-dispatch)
+
+(defvar forge-repository-list-buffer-name "*forge-repositories*"
+ "Buffer name to use for displaying lists of repositories.")
+
+(defvar forge-repository-list-mode-name
+ '((:eval (capitalize
+ (concat (if forge--buffer-list-filter
+ (format "%s " forge--buffer-list-filter)
+ "")
+ "repositories"))))
+ "Information shown in the mode-line for `forge-repository-list-mode'.
+Must be set before `forge-list' is loaded.")
+
+(define-derived-mode forge-repository-list-mode tabulated-list-mode
+ forge-repository-list-mode-name
+ "Major mode for browsing a list of repositories."
+ (setq-local x-stretch-cursor nil)
+ (setq tabulated-list-padding 0)
+ (setq tabulated-list-sort-key (cons "Owner" nil)))
+
+(defun forge-repository-list-setup (filter fn)
+ (let ((buffer (get-buffer-create forge-repository-list-buffer-name)))
+ (with-current-buffer buffer
+ (setq default-directory "/")
+ (setq forge--tabulated-list-columns forge-repository-list-columns)
+ (setq forge--tabulated-list-query fn)
+ (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229
+ (forge-repository-list-mode))
+ (setq forge--buffer-list-type 'repo)
+ (setq forge--buffer-list-filter filter)
+ (setq forge--buffer-list-global t)
+ (forge--tablist-refresh)
+ (add-hook 'tabulated-list-revert-hook #'forge--tablist-refresh nil t)
+ (tabulated-list-print)
+ (when hl-line-mode
+ (hl-line-highlight)))
+ (switch-to-buffer buffer)))
+
+(defun forge-format-repo-condition (repo)
+ "Return a character representing the value of REPO's `condition' slot."
+ (pcase-exhaustive (oref repo condition)
+ (:tracked "*")
+ (:known " ")
+ (:stub (propertize "s" 'face 'warning))))
+
+(defun forge-format-repo-selective (repo)
+ "Return a character representing the value of REPO's `selective-p' slot."
+ (pcase-exhaustive (oref repo selective-p)
+ ('t "*")
+ ('nil " ")))
+
+;;; Menu
+
+;;;###autoload (autoload 'forge-repositories-menu "forge-repos" nil t)
+(transient-define-prefix forge-repositories-menu ()
+ "Control list of repositories and repository at point."
+ :transient-suffix t
+ :transient-non-suffix 'call
+ :transient-switch-frame nil
+ :refresh-suffixes t
+ [:hide always ("q" forge-menu-quit-list)]
+ [["Type"
+ ("t" "topics..." forge-topics-menu :transient replace)
+ ("n" "notifications..." forge-notifications-menu :transient replace)
+ ("r" "repositories" forge-list-repositories)]
+ ["Filter"
+ ("o" "owned" forge-list-owned-repositories)]]
+ (interactive)
+ (unless (derived-mode-p 'forge-repository-list-mode)
+ (if-let ((buffer (get-buffer forge-repository-list-buffer-name)))
+ (switch-to-buffer buffer)
+ (with-no-warnings ; "interactive use only"
+ (forge-list-repositories))))
+ (transient-setup 'forge-repositories-menu))
+
+;;; Class
+
+(defclass forge--repo-list-command (transient-suffix)
+ ((type :initarg :type :initform nil)
+ (filter :initarg :filter :initform nil)
+ (global :initarg :global :initform nil)
+ (inapt-if :initform 'forge--topic-list-inapt)
+ (inapt-face :initform nil)))
+
+(defun forge--topic-list-inapt ()
+ (with-slots (type filter global) transient--pending-suffix
+ (and (eq type forge--buffer-list-type)
+ (eq filter forge--buffer-list-filter)
+ (eq global forge--buffer-list-global))))
+
+(cl-defmethod transient-format-description ((obj forge--repo-list-command))
+ (with-slots (description type filter global) obj
+ (if (and (eq type forge--buffer-list-type)
+ (memq filter (list nil forge--buffer-list-filter))
+ (eq global forge--buffer-list-global))
+ (propertize description 'face 'forge-active-suffix)
+ description)))
+
+;;; Commands
+
+;;;###autoload (autoload 'forge-list-repositories "forge-repos" nil t)
+(transient-define-suffix forge-list-repositories ()
+ "List known repositories in a separate buffer.
+Here \"known\" means that an entry exists in the local database."
+ :class 'forge--repo-list-command :type 'repo :global t
+ (interactive)
+ (forge-repository-list-setup nil #'forge--ls-repos))
+
+;;;###autoload (autoload 'forge-list-owned-repositories "forge-repos" nil t)
+(transient-define-suffix forge-list-owned-repositories ()
+ "List your own known repositories in a separate buffer.
+Here \"known\" means that an entry exists in the local database
+and options `forge-owned-accounts' and `forge-owned-ignored'
+controls which repositories are considered to be owned by you.
+Only Github is supported for now."
+ :class 'forge--repo-list-command :type 'repo :filter 'owned :global t
+ (interactive)
+ (forge-repository-list-setup 'owned #'forge--ls-owned-repos))
+
+;;; _
+(provide 'forge-repos)
+;;; forge-repos.el ends here
--- /dev/null
+;;; forge-revnote.el --- Revnote support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'forge)
+(require 'forge-post)
+(require 'forge-topic)
+
+;;; Class
+
+(defclass forge-revnote (forge-topic)
+ ((closql-table :initform 'revnote)
+ (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)
+ (commit :initarg :commit)
+ (file :initarg :file)
+ (line :initarg :line)
+ (author :initarg :author)
+ (body :initarg :body)))
+
+;;; _
+(provide 'forge-revnote)
+;;; forge-revnote.el ends here
--- /dev/null
+;;; forge-semi.el --- Support for semi-forges -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'forge)
+
+;;; Classes
+
+(defclass forge-gitweb-repository (forge-noapi-repository)
+ ((commit-url-format :initform "https://%h/gitweb/?p=%P.git;a=commitdiff;h=%r")
+ (branch-url-format :initform "https://%h/gitweb/?p=%P.git;a=log;h=refs/heads/%r")
+ (remote-url-format :initform "https://%h/gitweb/?p=%P.git;a=summary"))
+ "Gitweb from https://git-scm.com/docs/gitweb.")
+
+(defclass forge-cgit-repository (forge-noapi-repository)
+ ((commit-url-format :initform "https://%h/%p.git/commit/?id=%r")
+ (branch-url-format :initform "https://%h/%p.git/log/?h=%r")
+ (remote-url-format :initform "https://%h/%p.git/about"))
+ "Cgit from https://git.zx2c4.com/cgit/about.
+Different hosts use different url schemata, so we need multiple
+classes. See their definitions in \"forge-semi.el\".")
+
+(defclass forge-cgit*-repository (forge-cgit-repository)
+ ((commit-url-format :initform "https://%h/cgit/%p.git/commit/?id=%r")
+ (branch-url-format :initform "https://%h/cgit/%p.git/log/?h=%r")
+ (remote-url-format :initform "https://%h/cgit/%p.git/about"))
+ "Cgit from https://git.zx2c4.com/cgit/about.
+Different hosts use different url schemata, so we need multiple
+classes. See their definitions in \"forge-semi.el\".")
+
+(defclass forge-cgit**-repository (forge-cgit-repository)
+ ((commit-url-format :initform "https://%h/cgit/%n.git/commit/?id=%r")
+ (branch-url-format :initform "https://%h/cgit/%n.git/log/?h=%r")
+ (remote-url-format :initform "https://%h/cgit/%n.git/about"))
+ "Cgit from https://git.zx2c4.com/cgit/about.
+Different hosts use different url schemata, so we need multiple
+classes. See their definitions in \"forge-semi.el\".")
+
+(defclass forge-repoorcz-repository (forge-cgit-repository)
+ ((commit-url-format :initform "https://%h/%p.git/commit/%r")
+ (branch-url-format :initform "https://%h/%p.git/log/%r")
+ (remote-url-format :initform "https://%h/%p.git"))
+ "Cgit fork used on https://repo.or.cz/cgit.git.
+Different hosts use different url schemata, so we need multiple
+classes. See their definitions in \"forge-semi.el\".")
+
+(defclass forge-stagit-repository (forge-noapi-repository)
+ ((commit-url-format :initform "https://%h/%n/commit/%r.html")
+ (branch-url-format :initform "https://%h/%n/refs.html")
+ (remote-url-format :initform "https://%h/%n/file/README.html"))
+ "Stagit from https://codemadness.org/git/stagit/file/README.html.
+Only the history of \"master\" can be shown, so this links to the
+list of refs instead of the log of the specified branch.")
+
+(defclass forge-srht-repository (forge-noapi-repository)
+ ((commit-url-format :initform "https://%h/~%o/%n/commit/%r")
+ (branch-url-format :initform "https://%h/~%o/%n/log/%r")
+ (remote-url-format :initform "https://%h/~%o/%n"))
+ "See https://meta.sr.ht.")
+
+;;; _
+(provide 'forge-semi)
+;;; forge-semi.el ends here
--- /dev/null
+;;; forge-tablist.el --- Tabulated-list interface -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'tabulated-list)
+
+(require 'forge)
+
+(defvar-local forge--buffer-list-type nil)
+(defvar-local forge--buffer-list-filter nil)
+(defvar-local forge--buffer-list-global nil)
+
+(defconst forge--tablist-columns-type
+ '(repeat
+ (list :tag "Column"
+ (string :tag "Header Label")
+ (choice :tag "Value source"
+ function
+ (symbol :tag "Object slot"))
+ (integer :tag "Column Width")
+ (choice :tag "Sort predicate"
+ (const :tag "Don't sort" nil)
+ (const :tag "Default" t)
+ function)
+ (plist :tag "Properties"
+ :key-type (choice :tag "Property"
+ (const :right-align)
+ (const :pad-right)
+ symbol)
+ :value-type (sexp :tag "Value")))))
+
+(defvar-local forge--tabulated-list-columns nil)
+(put 'forge--tabulated-list-columns 'permanent-local t)
+
+(defvar-local forge--tabulated-list-query nil)
+(put 'forge--tabulated-list-query 'permanent-local t)
+
+(defun forge--tablist-refresh ()
+ (setq tabulated-list-format
+ (vconcat (mapcar (pcase-lambda (`(,name ,_get ,width ,sort ,props))
+ `(,name ,width ,sort . ,props))
+ forge--tabulated-list-columns)))
+ (tabulated-list-init-header)
+ (setq tabulated-list-entries
+ (mapcar
+ (lambda (obj)
+ (list (oref obj id)
+ (vconcat
+ (mapcar (pcase-lambda (`(,_name ,get ,_width ,_sort ,_props))
+ (let ((val (cond
+ ((functionp get)
+ (funcall get obj))
+ ((eq (car-safe get) 'repository)
+ (eieio-oref (forge-get-repository obj)
+ (cadr get)))
+ ((eieio-oref obj get)))))
+ (cond ((stringp val) val)
+ ((null val) "")
+ ((format "%s" val)))))
+ forge--tabulated-list-columns))))
+ (funcall forge--tabulated-list-query))))
+
+;;; _
+(provide 'forge-tablist)
+;;; forge-tablist.el ends here
--- /dev/null
+;;; forge-topic.el --- Topics support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'bug-reference)
+(require 'markdown-mode)
+(require 'parse-time)
+(require 'yaml)
+
+(require 'forge)
+(require 'forge-post)
+
+(defvar bug-reference-auto-setup-functions)
+
+;;; Options
+
+(defcustom forge-topic-list-order '(updated . string>)
+ "Order of topics listed in the status buffer.
+
+The value has the form (SLOT . PREDICATE), where SLOT is a
+slot of issue or pullreq objects, and PREDICATE is a function
+used to order the topics by that slot. Reasonable values
+include (number . >) and (updated . string>)."
+ :package-version '(forge . "0.1.0")
+ :group 'forge
+ :type '(cons (symbol :tag "Slot")
+ (function :tag "Predicate")))
+
+(defcustom forge-topic-list-limit '(60 . 5)
+ "Limit the number of topics listed in the status buffer.
+
+All unread topics are always shown. If the value of this option
+has the form (OPEN . CLOSED), then the integer OPEN specifies the
+maximal number of topics and CLOSED specifies the maximal number
+of closed topics. IF CLOSED is negative then show no closed
+topics until the command `forge-toggle-closed-visibility' changes
+the sign.
+
+The value can also be an integer, in which case it limits the
+number of closed topics only."
+ :package-version '(forge . "0.1.0")
+ :group 'forge
+ :type '(choice (number :tag "Maximal number of closed topics")
+ (cons (number :tag "Maximal number of open topics")
+ (number :tag "Maximal number of closed topics"))))
+
+(defcustom forge-limit-topic-choices t
+ "Whether to initially limit completion candidates to active topics."
+ :package-version '(forge . "0.4.0")
+ :group 'forge
+ :type 'boolean)
+
+(defcustom forge-post-heading-format "%a %C\n"
+ "Format for post headings in topic view.
+
+The following %-sequences are supported:
+
+`%a' The forge nickname of the author.
+`%c' The absolute creation date.
+`%C' The relative creation date."
+ :package-version '(forge . "0.1.0")
+ :group 'forge
+ :type 'string)
+
+(defcustom forge-post-fill-region t
+ "Whether to call `fill-region' before displaying forge posts."
+ :package-version '(forge . "0.1.0")
+ :group 'forge
+ :type 'boolean)
+
+(defcustom forge-bug-reference-hooks
+ '(find-file-hook
+ forge-post-mode-hook
+ git-commit-setup-hook
+ magit-mode-hook)
+ "Hooks to which `forge-bug-reference-setup' is added.
+This variable has to be customized before `forge' is loaded."
+ :package-version '(forge . "0.2.0")
+ :group 'forge
+ :options '(find-file-hook
+ forge-post-mode-hook
+ git-commit-setup-hook
+ magit-mode-hook)
+ :type '(list :convert-widget custom-hook-convert-widget))
+
+(defvar-local forge-display-in-status-buffer t
+ "Whether to display topics in the current Magit status buffer.")
+(put 'forge-display-in-status-buffer 'permanent-local t)
+
+(defvar forge-format-avatar-function nil
+ "Function used to insert avatars in certain locations.
+This is experimental and intended for users who wish to
+implement such a function themselves. See #447.")
+
+;;; Faces
+;;;; Common
+
+(defface forge-dimmed '((t :foreground "#93a1a1"))
+ "Parent face or faces used for text that shouldn't stand out.
+
+This face is not directly, instead several faces inherit from it
+either directly or via an intermediate face. This face should
+only specify the `:foreground' attribute, which is why this face
+does not inherit from `magit-dimmed'."
+ :group 'forge-faces)
+
+(defface forge-topic-header-line
+ `((t :inherit magit-header-line
+ ,@(and (>= emacs-major-version 29) '(:foreground reset))))
+ "Face for the `header-line' in `forge-topic-mode' buffers."
+ :group 'forge-faces)
+
+;;;; Topic and Notification Slugs
+
+(defface forge-topic-slug-open
+ '((t :inherit forge-dimmed))
+ "Face uses for slugs of open topics."
+ :group 'forge-faces)
+
+(defface forge-topic-slug-completed
+ '((t :inherit forge-dimmed))
+ "Face used for slugs of completed topics."
+ :group 'forge-faces)
+
+(defface forge-topic-slug-unplanned
+ '((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."
+ :group 'forge-faces)
+
+(defface forge-topic-slug-saved
+ '((t :foreground "orange"))
+ "Face used for slugs of topics with saved notifications."
+ :group 'forge-faces)
+
+(defface forge-topic-slug-unread
+ '((t :weight bold))
+ "Face used for slugs of topics with unread notifications."
+ :group 'forge-faces)
+
+;;;; Topic and Notification Summaries
+;;;;; Notifications
+
+(defface forge-topic-unread
+ `((t :weight bold
+ :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1)
+ :style nil)))
+ "Face used for summaries of entities with unread notifications.
+This face is always used together with, and takes preference
+over, a `forge[-fancy]-{issue,pullreq}-STATE' face and should not
+specify any attribute that is specified by any of those faces.
+Likewise those faces should not set `:weight' or `:slant'."
+ :group 'forge-faces)
+
+(defface forge-topic-pending
+ '((t :weight bold))
+ "Face used for summaries of entities with open notifications.
+This face is always used together with, and takes preference
+over, a `forge[-fancy]-{issue,pullreq}-STATE' face and should not
+specify any attribute that is specified by any of those faces.
+Likewise those faces should not set `:weight' or `:slant'."
+ :group 'forge-faces)
+
+(defface forge-topic-done
+ '((t :slant italic))
+ "Face used for summaries of entities with no unread or open notification.
+This face is always used together with, and takes preference
+over, a `forge[-fancy]-{issue,pullreq}-STATE' face and should not
+specify any attribute that is specified by any of those faces.
+Likewise those faces should not set `:weight' or `:slant'."
+ :group 'forge-faces)
+
+;;;;; Issues
+
+(defface forge-issue-open
+ '((t))
+ "Face used for summaries of open issues."
+ :group 'forge-faces)
+
+(defface forge-issue-completed
+ '((t :inherit forge-dimmed))
+ "Face used for summaries of issues closed as completed."
+ :group 'forge-faces)
+
+(defface forge-issue-unplanned
+ '((t :inherit forge-dimmed :strike-through t))
+ "Face used for summaries of issues closed as unplanned."
+ :group 'forge-faces)
+
+;;;;; Pull-Requests
+
+(defface forge-pullreq-open
+ '((t :foreground "LimeGreen"))
+ "Face used for summaries of open pull-requests."
+ :group 'forge-faces)
+
+(defface forge-pullreq-merged
+ '((t :foreground "MediumPurple"))
+ "Face used for summaries of merged pull-requests."
+ :group 'forge-faces)
+
+(defface forge-pullreq-rejected
+ '((t :foreground "MediumPurple" :strike-through t))
+ "Face used for summaries of closed pull-requests, that weren't merged."
+ :group 'forge-faces)
+
+;;;; Labels
+
+(defface forge-topic-label
+ `((t :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1)
+ :style released-button)))
+ "Face used for topic labels."
+ :group 'forge-faces)
+
+;;;; Post Details
+
+(defface forge-post-author
+ '((t :inherit bold))
+ "Face used for post author in topic view."
+ :group 'forge-faces)
+
+(defface forge-post-date
+ '((t :inherit italic))
+ "Face used for post date in topic view."
+ :group 'forge-faces)
+
+;;; Class
+
+(defclass forge-topic (forge-post) () :abstract t)
+
+(cl-defmethod forge--object-id ((class (subclass forge-topic)) repo number)
+ "Return the id for a CLASS object in REPO identified by id NUMBER."
+ (base64-encode-string
+ (encode-coding-string
+ (format "%s:%s%s"
+ (base64-decode-string (oref repo id))
+ (substring (symbol-name class)
+ (length (oref-default class closql-class-prefix)))
+ number)
+ 'utf-8)
+ 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))
+
+(cl-defmethod forge-topic-mark-read ((topic forge-topic))
+ (when (eq (oref topic status) 'unread)
+ (oset topic status 'pending)))
+
+(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-refresh-buffer))
+
+;;; Query
+;;;; Get
+
+(cl-defmethod forge-get-parent ((topic forge-topic))
+ (forge-get-repository topic))
+
+(cl-defmethod forge-get-repository ((topic forge-topic))
+ (closql-get (forge-db)
+ (oref topic repository)
+ 'forge-repository))
+
+(cl-defmethod forge-get-topic ((topic forge-topic))
+ 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)
+ (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)
+ (forge-get-pullreq number))))
+
+(cl-defmethod forge-get-topic ((id string))
+ (or (forge-get-issue id)
+ (forge-get-pullreq id)))
+
+;;;; Current
+
+(defun forge-current-topic (&optional demand)
+ "Return the topic at point or being visited.
+If there is no such topic and DEMAND is non-nil, then signal
+an error."
+ (or (forge-topic-at-point)
+ forge-buffer-topic
+ (and demand (user-error "No current topic"))))
+
+(defun forge-topic-at-point (&optional demand)
+ "Return the topic at point.
+If there is no such topic and DEMAND is non-nil, then signal
+an error. If NOT-THINGATPT is non-nil, then don't use
+`thing-at-point'."
+ (or (thing-at-point 'forge-topic)
+ (magit-section-value-if '(issue pullreq))
+ (forge-get-pullreq :branch)
+ (and (derived-mode-p 'forge-topic-list-mode)
+ (and-let* ((id (tabulated-list-get-id)))
+ (forge-get-topic id)))
+ (and demand (user-error "No topic at point"))))
+
+(put 'forge-topic 'thing-at-point #'forge-thingatpt--topic)
+(defun forge-thingatpt--topic ()
+ (and-let* ((repo (forge--repo-for-thingatpt)))
+ (and (thing-at-point-looking-at
+ (if (forge-gitlab-repository--eieio-childp repo)
+ "\\(?2:[#!]\\)\\(?1:[0-9]+\\)\\_>"
+ "#\\([0-9]+\\)\\_>"))
+ (funcall (if (equal (match-string 2) "!")
+ #'forge-get-pullreq
+ #'forge-get-topic)
+ repo (string-to-number (match-string-no-properties 1))))))
+
+(defun forge-region-topics ()
+ (cond
+ ((derived-mode-p 'forge-notifications-mode)
+ (magit-region-values '(issue pullreq)))
+ ((and (derived-mode-p 'forge-topic-list-mode)
+ (region-active-p))
+ (let ((beg (region-beginning))
+ (end (region-end))
+ (topics nil))
+ (save-excursion
+ (goto-char beg)
+ (while (< (point) end)
+ (when-let* ((id (tabulated-list-get-id)))
+ (push (forge-get-topic id) topics))
+ (forward-line 1))
+ (nreverse topics))))))
+
+;;;; List
+
+(defun forge-ls-recent-topics (repo table)
+ (let* ((id (oref repo id))
+ (limit forge-topic-list-limit)
+ (open-limit (if (consp limit) (car limit) limit))
+ (closed-limit (if (consp limit) (cdr limit) limit))
+ (topics (forge-sql [:select * :from $i1
+ :where (and (= repository $s2)
+ (= status 'unread))]
+ table id)))
+ (mapc (lambda (row)
+ (cl-pushnew row topics :test #'equal))
+ (if (consp limit)
+ (forge-sql [:select * :from $i1
+ :where (and (= repository $s2)
+ (isnull closed))
+ :order-by [(desc updated)]
+ :limit $s3]
+ table id open-limit)
+ (forge-sql [:select * :from $i1
+ :where (and (= repository $s2)
+ (isnull closed))]
+ table id)))
+ (when (> closed-limit 0)
+ (mapc (lambda (row)
+ (cl-pushnew row topics :test #'equal))
+ (forge-sql [:select * :from $i1
+ :where (and (= repository $s2)
+ (notnull closed))
+ :order-by [(desc updated)]
+ :limit $s3]
+ table id closed-limit)))
+ (cl-sort (mapcar (let ((class (if (eq table 'pullreq)
+ 'forge-pullreq
+ 'forge-issue)))
+ (lambda (row)
+ (closql--remake-instance class (forge-db) row)))
+ topics)
+ (cdr forge-topic-list-order)
+ :key (lambda (it) (eieio-oref it (car forge-topic-list-order))))))
+
+(defun forge--ls-topics (repo)
+ (cl-sort (nconc (forge--ls-issues repo)
+ (forge--ls-pullreqs repo))
+ #'> :key (-cut oref <> number)))
+
+(defun forge--ls-active-topics (repo)
+ (cl-sort (nconc (forge--ls-active-issues repo)
+ (forge--ls-active-pullreqs repo))
+ #'> :key (-cut oref <> number)))
+
+;;; Read
+
+(defun forge-read-topic (prompt)
+ "Read an active topic with completion using PROMPT.
+
+Open, unread and pending topics are considered active.
+Default to the current topic even if it isn't active.
+
+\\<forge-read-topic-minibuffer-map>While completion is in \
+progress, \\[forge-read-topic-lift-limit] lifts the limit, extending
+the completion candidates to include all topics.
+
+If `forge-limit-topic-choices' is nil, then all candidates
+can be selected from the start."
+ (forge--read-topic prompt
+ #'forge-current-topic
+ #'forge--ls-active-topics
+ #'forge--ls-topics))
+
+(defun forge--read-topic (prompt current active all)
+ (let* ((current (funcall current))
+ (repo (forge-get-repository (or current :tracked)))
+ (default (and current (forge--format-topic-line current)))
+ (alist (forge--topic-collection
+ (funcall (if forge-limit-topic-choices active all)
+ repo)))
+ (choices (mapcar #'car alist))
+ (choices (cond ((and forge-limit-topic-choices
+ default
+ (not (member default choices)))
+ (push (cons default (oref current id)) alist)
+ (cons default choices))
+ (choices)))
+ (choice
+ (if forge-limit-topic-choices
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (use-local-map (make-composed-keymap
+ forge-read-topic-minibuffer-map
+ (current-local-map))))
+ (magit-completing-read
+ (substitute-command-keys
+ (format "%s \\<%s> (\\[%s] for all)" prompt
+ 'forge-read-topic-minibuffer-map
+ 'forge-read-topic-lift-limit))
+ (completion-table-dynamic
+ (let (all-choices)
+ (lambda (_string)
+ (cond
+ (all-choices)
+ (forge-limit-topic-choices choices)
+ (t
+ (forge--replace-minibuffer-prompt (concat prompt ": "))
+ (setq alist (forge--topic-collection (funcall all repo)))
+ (setq all-choices (mapcar #'car alist)))))))
+ nil t nil nil default))
+ (magit-completing-read prompt choices nil t nil nil default))))
+ (cdr (assoc choice alist))))
+
+(defun forge--topic-collection (topics)
+ (mapcar (lambda (topic)
+ (cons (forge--format-topic-line topic)
+ (oref topic id)))
+ topics))
+
+(defvar-keymap forge-read-topic-minibuffer-map
+ "+" #'forge-read-topic-lift-limit)
+
+(defun forge-read-topic-lift-limit ()
+ "No longer limit completion candidates to active topics."
+ (interactive)
+ (when (and (minibufferp)
+ forge-limit-topic-choices)
+ (setq-local forge-limit-topic-choices nil)
+ (when (and (bound-and-true-p vertico-mode)
+ (boundp 'vertico--input)
+ (fboundp 'vertico--exhibit))
+ (setq vertico--input t)
+ (vertico--exhibit))))
+
+(defun forge--replace-minibuffer-prompt (prompt)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((inhibit-read-only t)
+ (end (length prompt)))
+ ;; (insert-and-inherit prompt) would discard all faces already
+ ;; present in PROMPT, so instead we do it like `read_minibuf'.
+ (put-text-property 0 end 'front-sticky t prompt)
+ (put-text-property 0 end 'rear-nonsticky t prompt)
+ (put-text-property 0 end 'field t prompt)
+ (let ((props minibuffer-prompt-properties))
+ (while props
+ (let ((key (pop props))
+ (val (pop props)))
+ (if (eq key 'face)
+ (add-face-text-property 0 end val t prompt)
+ (put-text-property 0 end key val prompt)))))
+ (insert prompt)
+ (delete-region (point) (minibuffer-prompt-end)))))
+
+(defun forge-topic-completion-at-point ()
+ (let ((bol (line-beginning-position))
+ repo)
+ (and (looking-back "[!#][0-9]*" bol)
+ (or (not bug-reference-prog-mode)
+ (nth 8 (syntax-ppss))) ; inside comment or string
+ (setq repo (forge-get-repository :tracked))
+ (looking-back (if (forge--childp repo 'forge-gitlab-repository)
+ "\\(?3:[!#]\\)\\(?2:[0-9]*\\)"
+ "#\\(?2:[0-9]*\\)")
+ bol)
+ (list (match-beginning 2)
+ (match-end 0)
+ (mapcar (lambda (row)
+ (propertize (number-to-string (car row))
+ :title (format " %s" (cadr row))))
+ (if (forge--childp repo 'forge-gitlab-repository)
+ (forge-sql [:select [number title]
+ :from $i1
+ :where (= repository $s2)
+ :order-by [(desc updated)]]
+ (if (equal (match-string 3) "#")
+ 'issue
+ 'pullreq)
+ (oref repo id))
+ (forge-sql [:select [number title updated]
+ :from pullreq
+ :where (= repository $s1)
+ :union
+ :select [number title updated]
+ :from issue
+ :where (= repository $s1)
+ :order-by [(desc updated)]]
+ (oref repo id))))
+ :annotation-function (lambda (c) (get-text-property 0 :title c))))))
+
+(defun forge-read-topic-title (topic)
+ (read-string "Title: " (oref topic title)))
+
+(defun forge-read-topic-milestone (&optional topic)
+ (forge--completing-read
+ "Milestone"
+ (mapcar #'caddr (oref (forge-get-repository (or topic :tracked)) milestones))
+ nil t
+ (and topic (forge--format-topic-milestone topic))))
+
+(defun forge-read-topic-label (&optional prompt repository)
+ (magit-completing-read (or prompt "Label")
+ (forge--format-topic-label-choices
+ (or repository (forge-get-repository :tracked)))
+ nil t))
+
+(defun forge-read-topic-labels (&optional topic)
+ (let* ((repo (forge-get-repository (or topic :tracked)))
+ (crm-separator ","))
+ (magit-completing-read-multiple
+ "Labels: "
+ (mapcar #'cadr (oref repo labels))
+ nil t
+ (and topic (mapconcat #'car (closql--iref topic 'labels) ",")))))
+
+(defun forge-read-topic-marks (&optional topic)
+ (let ((marks (mapcar #'car (forge-sql [:select name :from mark])))
+ (crm-separator ","))
+ (magit-completing-read-multiple
+ "Marks: " marks nil t
+ (and topic (mapconcat #'car (closql--iref topic 'marks) ",")))))
+
+(defun forge-read-topic-assignees (&optional topic)
+ (let* ((repo (forge-get-repository (or topic :tracked)))
+ (value (and topic (closql--iref topic 'assignees)))
+ (choices (mapcar #'cadr (oref repo assignees)))
+ (crm-separator ","))
+ (magit-completing-read-multiple
+ "Assignees: " choices nil
+ (if (forge--childp repo 'forge-gitlab-repository)
+ t ; Selecting something else would fail later on.
+ 'confirm)
+ (mapconcat #'car value ","))))
+
+(defun forge-read-topic-review-requests (&optional topic)
+ (let* ((repo (forge-get-repository (or topic :tracked)))
+ (value (and topic (closql--iref topic 'review-requests)))
+ (choices (mapcar #'cadr (oref repo assignees)))
+ (crm-separator ","))
+ (magit-completing-read-multiple
+ "Request review from: " choices nil
+ 'confirm
+ (mapconcat #'car 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)
+ (forge--format (forge-get-repository topic) slot
+ `(,@spec (?i . ,(oref topic number)))))
+
+(defun forge--format-topic-line (topic &optional width)
+ (concat
+ (and (derived-mode-p 'forge-notifications-mode)
+ (eq forge-notifications-display-style 'flat)
+ (concat (truncate-string-to-width
+ (oref (forge-get-repository topic) slug)
+ forge-notifications-repo-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)))
+
+(defun forge--format-topic-slug (topic)
+ (with-slots (slug state status saved-p) topic
+ (magit--propertize-face
+ slug
+ `(,@(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))))))
+
+(defun forge--format-topic-refs (topic)
+ (pcase-let
+ (((eieio cross-repo-p base-repo base-ref head-repo head-ref) topic)
+ (separator (magit--propertize-face ":" 'magit-dimmed))
+ (deleted (magit--propertize-face "(deleted)" 'magit-dimmed)))
+ (concat (if cross-repo-p
+ (concat base-repo separator base-ref)
+ base-ref)
+ (magit--propertize-face "..." 'magit-dimmed)
+ (if cross-repo-p
+ (if (and head-repo head-ref)
+ (concat head-repo separator head-ref)
+ deleted)
+ (or head-ref deleted)))))
+
+(defun forge--format-topic-draft (topic)
+ (if (oref topic draft-p)
+ (magit--propertize-face "yes" 'bold)
+ (magit--propertize-face "no" 'magit-dimmed)))
+
+(defun forge--format-topic-saved (topic)
+ (if (oref topic saved-p)
+ (magit--propertize-face "yes" 'bold)
+ (magit--propertize-face "no" 'magit-dimmed)))
+
+(defun forge--format-topic-title (topic)
+ (with-slots (title status state) topic
+ (magit-log-propertize-keywords
+ nil
+ (magit--propertize-face
+ title
+ `(,(pcase status
+ ('unread 'forge-topic-unread)
+ ('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)))))))
+
+(defun forge--format-topic-title+labels (topic)
+ (concat (forge--format-topic-title topic) " "
+ (forge--format-topic-labels topic)))
+
+(defun forge--format-topic-milestone (topic)
+ (and-let* ((id (oref topic milestone)))
+ (caar (forge-sql [:select [title] :from milestone :where (= id $s1)] id))))
+
+(defun forge--format-topic-labels (topic)
+ (and-let* ((labels (closql--iref topic 'labels)))
+ (mapconcat (pcase-lambda (`(,name ,color ,_description))
+ (let* ((background (forge--sanitize-color color))
+ (foreground (forge--contrast-color background)))
+ (magit--propertize-face
+ name `(( :background ,background
+ :foreground ,foreground)
+ forge-tablist-topic-label))))
+ labels " ")))
+
+(defun forge--format-topic-label-choices (repo)
+ (mapcar (pcase-lambda (`(,_id ,name ,color ,_description))
+ (let* ((background (forge--sanitize-color color))
+ (foreground (forge--contrast-color background)))
+ (magit--propertize-face
+ name `( :background ,background
+ :foreground ,foreground))))
+ (oref repo labels)))
+
+(defun forge--format-topic-marks (topic)
+ (and-let* ((marks (closql--iref topic 'marks)))
+ (mapconcat (pcase-lambda (`(,name ,face ,_description))
+ (magit--propertize-face
+ name (list 'forge-tablist-topic-label face)))
+ marks " ")))
+
+(defun forge--format-topic-state (topic)
+ (with-slots (state) topic
+ (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)))))
+
+(defun forge--format-topic-status (topic)
+ (with-slots (status) topic
+ (magit--propertize-face
+ (symbol-name status)
+ (pcase status
+ ('unread 'forge-topic-unread)
+ ('pending 'forge-topic-pending)
+ ('done 'forge-topic-done)))))
+
+(defun forge--format-topic-assignees (topic)
+ (and-let* ((assignees (closql--iref topic 'assignees)))
+ (mapconcat #'forge--format-person assignees ", ")))
+
+(defun forge--format-topic-review-requests (topic)
+ (and-let* ((review-requests (closql--iref topic 'review-requests)))
+ (mapconcat #'forge--format-person review-requests ", ")))
+
+(defun forge--format-person (person)
+ (pcase-let ((`(,login ,name) person))
+ (format "%s%s (@%s)"
+ (forge--format-avatar login)
+ name login)))
+
+(defun forge--format-avatar (person)
+ (if forge-format-avatar-function
+ (funcall forge-format-avatar-function person)
+ ""))
+
+(defun forge--format-boolean (slot name)
+ ;; Booleans are formatted differently in transients and headers.
+ ;; Use this to format the (complete) description of suffix commands.
+ (let ((topic (forge-current-topic)))
+ (if (and topic (slot-exists-p topic slot))
+ (format (propertize "[%s]" 'face 'transient-delimiter)
+ (propertize name 'face
+ (if (eieio-oref topic slot)
+ 'transient-value
+ 'transient-inactive-value)))
+ (format "[%s]" name))))
+
+;;; Insert
+
+(defun forge--insert-topics (type heading topics)
+ (when topics
+ (let ((width (apply #'max (--map (length (oref it slug)) topics))))
+ (magit-insert-section ((eval type) nil t)
+ (magit-insert-heading
+ (concat (magit--propertize-face (concat heading " ")
+ 'magit-section-heading)
+ (magit--propertize-face (format "(%s)" (length topics))
+ 'magit-section-child-count)))
+ (magit-insert-section-body
+ (dolist (topic topics)
+ (forge--insert-topic topic width))
+ (insert ?\n)
+ (magit-make-margin-overlay nil t))))))
+
+(defun forge--insert-topic (topic &optional width)
+ (magit-insert-section ((eval (oref topic closql-table)) topic t)
+ (insert (forge--format-topic-line topic (or width 5)))
+ (forge--insert-topic-marks topic t)
+ (forge--insert-topic-labels topic t)
+ (insert "\n")
+ (magit-log-format-author-margin
+ (oref topic author)
+ (format-time-string "%s" (parse-iso8601-time-string (oref topic created)))
+ t)
+ (when (and (slot-exists-p topic 'merged)
+ (not (oref topic merged)))
+ (magit-insert-heading)
+ (magit-insert-section-body
+ (forge--insert-pullreq-commits topic)))))
+
+(defun forge--insert-topic-labels (topic &optional separate)
+ (and-let* ((labels (closql--iref topic 'labels)))
+ (prog1 t
+ (pcase-dolist (`(,name ,color ,description) labels)
+ (let* ((background (forge--sanitize-color color))
+ (foreground (forge--contrast-color background)))
+ (if separate (insert " ") (setq separate t))
+ (insert name)
+ (let ((o (make-overlay (- (point) (length name)) (point))))
+ (overlay-put o 'priority 2)
+ (overlay-put o 'evaporate t)
+ (overlay-put o 'font-lock-face
+ `(( :background ,background
+ :foreground ,foreground)
+ forge-topic-label))
+ (when description
+ (overlay-put o 'help-echo description))))))))
+
+(defun forge--insert-topic-marks (topic &optional separate)
+ (and-let* ((marks (closql--iref topic 'marks)))
+ (prog1 t
+ (pcase-dolist (`(,name ,face ,description) marks)
+ (if separate (insert " ") (setq separate t))
+ (insert name)
+ (let ((o (make-overlay (- (point) (length name)) (point))))
+ (overlay-put o 'priority 2)
+ (overlay-put o 'evaporate t)
+ (overlay-put o 'font-lock-face (list face 'forge-topic-label))
+ (when description
+ (overlay-put o 'help-echo description)))))))
+
+(defun forge--assert-insert-topics-get-repository (&optional issues-p)
+ (and (forge-db t)
+ (or forge-display-in-status-buffer
+ (not (eq major-mode 'magit-status-mode)))
+ (and-let* ((repo (forge-get-repository :tracked?)))
+ (and (or (not issues-p)
+ (oref repo issues-p))
+ repo))))
+
+;;; Modes
+
+(defvar-keymap forge-post-section-map
+ "<remap> <magit-edit-thing>" #'forge-edit-post
+ "C-c C-k" #'forge-delete-comment)
+
+(defvar-keymap forge-topic-mode-map
+ "<remap> <magit-visit-thing>" #'markdown-follow-link-at-point
+ "<mouse-2>" #'markdown-follow-link-at-point
+ "C-c C-m" #'forge-topic-menu
+ "C-c C-n" #'forge-create-post
+ "C-c C-r" #'forge-create-post)
+
+(define-derived-mode forge-topic-mode magit-mode "Topic"
+ "Parent mode of `forge-{issue,pullreq}-mode'.
+This mode itself is never used directly."
+ (face-remap-add-relative 'header-line 'forge-topic-header-line)
+ (setq-local markdown-translate-filename-function
+ #'forge--markdown-translate-filename-function))
+
+(define-derived-mode forge-issue-mode forge-topic-mode "Issue"
+ "Mode for looking at a Forge issue.")
+(defalias 'forge-issue-setup-buffer #'forge-topic-setup-buffer)
+(defalias 'forge-issue-refresh-buffer #'forge-topic-refresh-buffer)
+(defvar forge-issue-headers-hook
+ '(forge-insert-topic-state
+ forge-insert-topic-status
+ forge-insert-topic-milestone
+ forge-insert-topic-labels
+ forge-insert-topic-marks
+ forge-insert-topic-assignees))
+
+(define-derived-mode forge-pullreq-mode forge-topic-mode "Pull-request"
+ "Mode for looking at a Forge pull-request.")
+(defalias 'forge-pullreq-setup-buffer #'forge-topic-setup-buffer)
+(defalias 'forge-pullreq-refresh-buffer #'forge-topic-refresh-buffer)
+(defvar forge-pullreq-headers-hook
+ '(forge-insert-topic-state
+ forge-insert-topic-draft
+ forge-insert-topic-status
+ forge-insert-topic-saved
+ forge-insert-topic-refs
+ forge-insert-topic-milestone
+ forge-insert-topic-labels
+ forge-insert-topic-marks
+ forge-insert-topic-assignees
+ forge-insert-topic-review-requests))
+
+(defvar-local forge-buffer-topic nil)
+
+(defun forge-topic-setup-buffer (topic)
+ (let* ((repo (forge-get-repository topic))
+ (name (format "*forge: %s %s*" (oref repo slug) (oref topic slug)))
+ (magit-generate-buffer-name-function (lambda (_mode _value) name))
+ (current-repo (forge-get-repository :known?))
+ (default-directory (if (forge-repository-equal current-repo repo)
+ default-directory
+ (or (forge-get-worktree repo)
+ default-directory))))
+ (magit-setup-buffer-internal
+ (if (forge-issue-p topic) #'forge-issue-mode #'forge-pullreq-mode)
+ t `((forge-buffer-topic ,topic)) name)
+ (forge-topic-mark-read topic)))
+
+(defun forge-topic-refresh-buffer ()
+ (let ((topic (closql-reload forge-buffer-topic)))
+ (setq forge-buffer-topic topic)
+ (magit-set-header-line-format (forge--format-topic-line topic))
+ (magit-insert-section (topicbuf)
+ (magit-insert-headers
+ (intern (format "%s-headers-hook"
+ (substring (symbol-name major-mode) 0 -5))))
+ (when (forge-pullreq-p topic)
+ (magit-insert-section (pullreq topic)
+ (magit-insert-heading "Commits")
+ (forge--insert-pullreq-commits topic t)))
+ (when-let ((note (oref topic note)))
+ (magit-insert-section (note)
+ (magit-insert-heading "Note")
+ (insert (forge--fontify-markdown note) "\n\n")))
+ (dolist (post (cons topic (oref topic posts)))
+ (with-slots (author created body) post
+ (magit-insert-section section (post post)
+ (oset section heading-highlight-face
+ 'magit-diff-hunk-heading-highlight)
+ (let ((heading
+ (format-spec
+ forge-post-heading-format
+ `((?a . ,(propertize (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"))))
+ (when (and (display-images-p)
+ (fboundp 'markdown-display-inline-images))
+ (let ((markdown-display-remote-images t))
+ (markdown-display-inline-images))))))
+
+(cl-defmethod magit-buffer-value (&context (major-mode forge-topic-mode))
+ (oref forge-buffer-topic slug))
+
+;;; Headers
+
+(cl-defmacro forge--define-topic-header
+ (name &key insert format (command nil command?))
+ (declare (indent defun))
+ (let ((fun (intern (format "forge-insert-topic-%s" name)))
+ (map (intern (format "forge-topic-%s-section-map" name)))
+ (cmd (intern (format "forge-topic-set-%s" name))))
+ `(progn
+ (cl-defun ,fun (&optional (topic forge-buffer-topic))
+ (magit-insert-section (,(intern (format "topic-%s" name)))
+ (insert ,(capitalize (string-pad (format "%s: " name) 11)))
+ ,(cond
+ (insert
+ `(unless (funcall ,insert topic)
+ (insert (magit--propertize-face "none" 'magit-dimmed))))
+ (format
+ `(insert (or (funcall ,format topic)
+ (magit--propertize-face "none" 'magit-dimmed)))))
+ (insert ?\n)))
+ ,@(and (if command? command t)
+ `((defvar-keymap ,map "<remap> <magit-edit-thing>"
+ ,(or command `(function ,cmd)))
+ (put ',fun 'definition-name ',name)))
+ (put ',map 'definition-name ',name))))
+
+(forge--define-topic-header refs
+ :command nil
+ :format #'forge--format-topic-refs)
+
+(forge--define-topic-header draft
+ :command #'forge-topic-toggle-draft
+ :format #'forge--format-topic-draft)
+
+(forge--define-topic-header saved
+ :command #'forge-topic-toggle-saved
+ :format #'forge--format-topic-saved)
+
+(forge--define-topic-header state
+ :command #'forge-topic-state-menu
+ :format #'forge--format-topic-state)
+
+(forge--define-topic-header status
+ :command #'forge-topic-status-menu
+ :format #'forge--format-topic-status)
+
+(forge--define-topic-header milestone
+ :format #'forge--format-topic-milestone)
+
+(forge--define-topic-header labels
+ :insert #'forge--insert-topic-labels)
+
+(forge--define-topic-header marks
+ :insert #'forge--insert-topic-marks)
+
+(forge--define-topic-header assignees
+ :format #'forge--format-topic-assignees)
+
+(forge--define-topic-header review-requests
+ :format #'forge--format-topic-review-requests)
+
+;;; Commands
+;;;; Groups
+
+(defconst forge--topic-set-state-group
+ ["Set state"
+ ("s o" forge-topic-state-set-open)
+ ("s c" forge-issue-state-set-completed)
+ ("s u" forge-issue-state-set-unplanned)
+ ("s m" forge-pullreq-state-set-merged)
+ ("s r" forge-pullreq-state-set-rejected)
+ ""])
+
+(defconst forge--topic-set-status-group
+ ["Set status"
+ ("s i" forge-topic-status-set-unread)
+ ("s p" forge-topic-status-set-pending)
+ ("s d" forge-topic-status-set-done)])
+
+(defconst forge--topic-set-slots-group
+ ["Set"
+ ("e t" forge-topic-set-title)
+ ("e m" forge-topic-set-milestone)
+ ("e l" forge-topic-set-labels)
+ ("e a" forge-topic-set-assignees)
+ ("e r" forge-topic-set-review-requests)
+ ("e d" forge-topic-toggle-draft)])
+
+(defconst forge--topic-set-local-group
+ ["Set local"
+ ("l s" forge-topic-toggle-saved)
+ ("l m" forge-topic-set-marks)
+ ("l n" forge-edit-topic-note)])
+
+;;;; Menus
+
+(defconst forge--topic-menus-column-widths '(19))
+
+;;;###autoload (autoload 'forge-topic-menu "forge-topic" nil t)
+(transient-define-prefix forge-topic-menu ()
+ "Edit the topic at point."
+ :transient-suffix t
+ :transient-non-suffix t
+ :transient-switch-frame nil
+ :refresh-suffixes t
+ :column-widths forge--topic-menus-column-widths
+ [:hide always
+ ("q" forge-menu-quit-list)]
+ [["Actions"
+ ("f" forge-pull-this-topic)
+ ("b" forge-browse-this-topic)
+ ("k" forge-delete-comment)
+ ("p" forge-create-pullreq-from-issue)
+ ("m" "show more actions" forge-dispatch)]]
+ [forge--topic-set-state-group
+ forge--topic-set-slots-group]
+ [forge--topic-set-status-group
+ forge--topic-set-local-group]
+ (interactive)
+ (unless (derived-mode-p 'forge-topic-mode)
+ (if-let ((topic (forge-topic-at-point)))
+ (forge-topic-setup-buffer topic)
+ (user-error "No current topic")))
+ (transient-setup 'forge-topic-menu))
+
+;;;###autoload (autoload 'forge-topic-state-menu "forge-topic" nil t)
+(transient-define-prefix forge-topic-state-menu ()
+ "Set state of the current topic."
+ [("o" forge-topic-state-set-open)
+ ("c" forge-issue-state-set-completed)
+ ("u" forge-issue-state-set-unplanned)
+ ("m" forge-pullreq-state-set-merged)
+ ("r" forge-pullreq-state-set-rejected)])
+
+;;;###autoload (autoload 'forge-topic-status-menu "forge-topic" nil t)
+(transient-define-prefix forge-topic-status-menu ()
+ "Set status of the current topic."
+ [("i" forge-topic-status-set-unread)
+ ("p" forge-topic-status-set-pending)
+ ("d" forge-topic-status-set-done)])
+
+;;;; State
+
+(defclass forge--topic-set-state-command (transient-suffix)
+ ((state :initarg :state)
+ (getter :initarg :getter)
+ (definition
+ :initform (lambda ()
+ (interactive)
+ (with-slots (getter state) (transient-suffix-object)
+ (let ((topic (funcall getter t)))
+ (forge--set-topic-state (forge-get-repository topic)
+ topic state)))))
+ (description
+ :initform (lambda (obj)
+ (symbol-name (oref obj state))))
+ (inapt-if
+ :initform (lambda ()
+ (or (forge-region-topics)
+ (with-slots (getter state) (transient-suffix-object)
+ (if-let ((topic (funcall getter)))
+ ;; Once a pull-request is merged,
+ ;; its state cannot be changed anymore.
+ (memq (oref topic state) (list state 'merged))
+ t)))))
+ (inapt-face
+ :initform (lambda (obj)
+ (with-slots (getter state) (transient-suffix-object)
+ (if (and (not (forge-region-topics))
+ (and-let* ((topic (funcall getter)))
+ (eq (oref topic state) state)))
+ 'forge-suffix-active
+ 'transient-inapt-suffix))))))
+
+(transient-define-suffix forge-topic-state-set-open ()
+ "Set the state of the current topic to `open'."
+ :class 'forge--topic-set-state-command
+ :state 'open
+ :getter #'forge-current-topic)
+
+(transient-define-suffix forge-issue-state-set-completed ()
+ "Set the state of the current issue to `completed'."
+ :class 'forge--topic-set-state-command
+ :state 'completed
+ :getter #'forge-current-issue)
+
+(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)
+
+(transient-define-suffix forge-pullreq-state-set-merged ()
+ "If the current pull-request is merged, then visualize that."
+ :class 'forge--topic-set-state-command
+ :state 'merged
+ :getter #'forge-current-pullreq
+ (interactive)
+ (message "Please use a merge command for this"))
+
+(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)
+
+;;;; Status
+
+(defclass forge--topic-set-status-command (transient-suffix)
+ ((status :initarg :status)
+ (definition
+ :initform (lambda ()
+ (interactive)
+ (with-slots (status) (transient-suffix-object)
+ (if-let ((topics (forge-region-topics)))
+ (dolist (topic topics)
+ (oset topic status status))
+ (oset (forge-current-topic t) status status)))
+ (forge-refresh-buffer)))
+ (description
+ :initform (lambda (obj)
+ (symbol-name (oref obj status))))
+ (inapt-if
+ :initform (lambda ()
+ (and (not (forge-region-topics))
+ (if-let ((topic (forge-current-topic)))
+ (eq (oref topic status)
+ (oref (transient-suffix-object) status))
+ t))))
+ (inapt-face
+ :initform (lambda ()
+ (if (forge-current-topic)
+ 'forge-suffix-active
+ 'transient-inapt-suffix)))))
+
+(transient-define-suffix forge-topic-status-set-unread ()
+ "Set the notification status of the current topic to `unread'."
+ :class 'forge--topic-set-status-command :status 'unread)
+
+(transient-define-suffix forge-topic-status-set-pending ()
+ "Set the notification status of the current topic to `pending'."
+ :class 'forge--topic-set-status-command :status 'pending)
+
+(transient-define-suffix forge-topic-status-set-done ()
+ "Set the notification status of the current topic to `done'."
+ :class 'forge--topic-set-status-command :status 'done)
+
+;;;; Set
+
+(defclass forge--topic-set-slot-command (transient-suffix)
+ ((slot :initarg :slot)
+ (setter)
+ (reader)
+ (formatter :initarg :formatter)
+ (definition
+ :initform (lambda (value)
+ (interactive
+ (list (funcall (oref (transient-suffix-object) reader)
+ (forge-current-topic t))))
+ (let ((topic (forge-current-topic t)))
+ (funcall (oref (transient-suffix-object) setter)
+ (forge-get-repository topic)
+ topic value))))
+ (description
+ :initform (lambda (obj)
+ (with-slots (slot inapt-if-not) obj
+ (if-let* ((topic (if inapt-if-not
+ (funcall inapt-if-not)
+ (forge-current-topic)))
+ (value (funcall (oref obj formatter) topic)))
+ (format "%s %s" slot value)
+ (format "%s" slot)))))))
+
+(cl-defmethod initialize-instance :after
+ ((obj forge--topic-set-slot-command) &optional _slots)
+ (with-slots (slot) obj
+ (let ((name (symbol-name slot)))
+ (cond ((string-suffix-p "-p" name)
+ (setq name (substring name 0 -2))
+ (oset obj reader (lambda (topic) (not (eieio-oref topic 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)
+ (oset obj formatter (intern (format "forge--format-topic-%s" name)))))))
+
+(transient-define-suffix forge-topic-set-title (title)
+ "Edit the TITLE of the current topic."
+ :class 'forge--topic-set-slot-command :slot 'title
+ :formatter (lambda (topic)
+ (propertize (forge--format-topic-title topic)
+ 'face 'font-lock-string-face)))
+
+(transient-define-suffix forge-topic-set-milestone (milestone)
+ "Edit what MILESTONE the current topic belongs to."
+ :class 'forge--topic-set-slot-command :slot 'milestone)
+
+(transient-define-suffix forge-topic-set-labels (labels)
+ "Edit the LABELS of the current topic."
+ :class 'forge--topic-set-slot-command :slot 'labels)
+
+(transient-define-suffix forge-topic-set-marks (marks)
+ "Edit the MARKS of the current topic."
+ :class 'forge--topic-set-slot-command :slot 'marks)
+
+(transient-define-suffix forge-topic-set-assignees (assignees)
+ "Edit the ASSIGNEES of the current topic."
+ :class 'forge--topic-set-slot-command :slot 'assignees)
+
+(transient-define-suffix forge-topic-set-review-requests (review-requests)
+ "Edit the REVIEW-REQUESTS of the current pull-request."
+ :class 'forge--topic-set-slot-command :slot 'review-requests
+ :inapt-if-not #'forge-current-pullreq)
+
+(transient-define-suffix forge-topic-toggle-draft (draft)
+ "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")))
+
+(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"))
+ ;; 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))
+
+;;; Color Utilities
+
+(defun forge--sanitize-color (color)
+ (cond ((color-values color) color)
+ ;; Discard alpha information.
+ ((string-match-p "\\`#.\\{4\\}\\'" color) (substring color 0 3))
+ ((string-match-p "\\`#.\\{8\\}\\'" color) (substring color 0 6))
+ (t "#000000"))) ; Use fallback instead of invalid color.
+
+(defun forge--contrast-color (color)
+ "Return black or white depending on the luminance of COLOR."
+ (if (> (forge--x-color-luminance color) 0.5) "black" "white"))
+
+;; Copy of `rainbow-x-color-luminance'.
+(defun forge--x-color-luminance (color)
+ "Calculate the luminance of a color string (e.g., \"#ffaa00\", \"blue\").
+Return a value between 0 and 1."
+ (let ((values (color-values color)))
+ (forge--color-luminance (/ (nth 0 values) 256.0)
+ (/ (nth 1 values) 256.0)
+ (/ (nth 2 values) 256.0))))
+
+;; Copy of `rainbow-color-luminance'.
+;; Also see https://en.wikipedia.org/wiki/Relative_luminance.
+(defun forge--color-luminance (red green blue)
+ "Calculate the luminance of color composed of RED, GREEN and BLUE.
+Return a value between 0 and 1."
+ (/ (+ (* .2126 red) (* .7152 green) (* .0722 blue)) 256))
+
+;;; Markdown Utilities
+
+(defun forge--fontify-markdown (text)
+ (with-temp-buffer
+ (delay-mode-hooks
+ (gfm-mode))
+ (insert text)
+ (font-lock-ensure)
+ (when forge-post-fill-region
+ (fill-region (point-min) (point-max)))
+ (buffer-string)))
+
+(defun forge--markdown-translate-filename-function (file)
+ (if (string-match-p "\\`https?://" file)
+ file
+ (let ((host (oref (forge-get-repository :tracked) forge))) ;aka webhost
+ (concat (if (member host ghub-insecure-hosts) "http://" "https://")
+ host
+ (and (not (string-prefix-p "/" file)) "/")
+ file))))
+
+;;; Templates
+
+(defun forge--topic-parse-buffer (&optional file)
+ (save-match-data
+ (save-excursion
+ (goto-char (point-min))
+ (let ((alist (save-excursion (forge--topic-parse-yaml))))
+ (if alist
+ (setf (alist-get 'yaml alist) t)
+ (setq alist (save-excursion (forge--topic-parse-plain))))
+ (setf (alist-get 'file alist) file)
+ (setf (alist-get 'text alist) (magit--buffer-string nil nil ?\n))
+ (when (and file (not (alist-get 'prompt alist)))
+ (setf (alist-get 'prompt alist)
+ (file-name-sans-extension (file-name-nondirectory file))))
+ ;; If there is a yaml front-matter, then it is supposed
+ ;; to have a `title' field, but this may not be the case.
+ (when (and (not file)
+ (not (alist-get 'title alist)))
+ (setf (alist-get 'title alist)
+ (read-string "Title: ")))
+ alist))))
+
+(defun forge--topic-parse-yaml ()
+ (let (alist beg end)
+ (when (looking-at "^---[\s\t]*$")
+ (forward-line)
+ (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))
+ (let-alist alist
+ (when (and .name .about)
+ (setf (alist-get 'prompt alist)
+ (format "[%s] %s" .name .about)))
+ (when (and .labels (atom .labels))
+ (setf (alist-get 'labels alist) (list .labels)))
+ (when (and .assignees (atom .assignees))
+ (setf (alist-get 'assignees alist) (list .assignees))))
+ (forward-line)
+ (when (and (not (alist-get 'title alist))
+ (looking-at "^\n?#*"))
+ (goto-char (match-end 0))
+ (setf (alist-get 'title alist)
+ (string-trim
+ (magit--buffer-string (point) (line-end-position) t)))
+ (forward-line))
+ (setf (alist-get 'body alist)
+ (string-trim (magit--buffer-string (point) nil ?\n)))))
+ alist))
+
+(defun forge--topic-parse-plain ()
+ (let (title body)
+ (when (looking-at "\\`#*")
+ (goto-char (match-end 0)))
+ (setq title (magit--buffer-string (point) (line-end-position) t))
+ (forward-line)
+ (setq body (magit--buffer-string (point) nil ?\n))
+ `((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
+
+(when (< emacs-major-version 28)
+ (defun bug-reference-fontify (start end)
+ "Apply bug reference overlays to region."
+ (save-excursion
+ (let ((beg-line (progn (goto-char start) (line-beginning-position)))
+ (end-line (progn (goto-char end) (line-end-position))))
+ ;; Remove old overlays.
+ (bug-reference-unfontify beg-line end-line)
+ (goto-char beg-line)
+ (while (and (< (point) end-line)
+ (re-search-forward bug-reference-bug-regexp end-line 'move))
+ (when (and (or (not bug-reference-prog-mode)
+ ;; This tests for both comment and string syntax.
+ (nth 8 (syntax-ppss)))
+ ;; This is the part where this redefinition differs
+ ;; from the original defined in "bug-reference.el".
+ (not (and (derived-mode-p 'magit-status-mode
+ 'forge-notifications-mode)
+ (= (match-beginning 0)
+ (line-beginning-position))))
+ ;; End of additions.
+ )
+ (let ((overlay (make-overlay (match-beginning 0) (match-end 0)
+ nil t nil)))
+ (overlay-put overlay 'category 'bug-reference)
+ ;; Don't put a link if format is undefined
+ (when bug-reference-url-format
+ (overlay-put overlay 'bug-reference-url
+ (if (stringp bug-reference-url-format)
+ (format bug-reference-url-format
+ (match-string-no-properties 2))
+ (funcall bug-reference-url-format)))))))))))
+
+(defun forge-bug-reference-setup ()
+ "Setup `bug-reference' in the current buffer.
+If forge data has been fetched for the current repository, then
+enable `bug-reference-mode' or `bug-reference-prog-mode' and
+modify `bug-reference-bug-regexp' if appropriate."
+ (unless (or bug-reference-url-format
+ (not (forge-db t))
+ ;; TODO Allow use in this mode again.
+ (derived-mode-p 'forge-notifications-mode))
+ (magit--with-safe-default-directory nil
+ (when-let ((repo (forge-get-repository :tracked?)))
+ (if (>= emacs-major-version 28)
+ (when (derived-mode-p 'magit-status-mode
+ 'forge-notifications-mode)
+ (setq-local
+ bug-reference-auto-setup-functions
+ (let ((hook bug-reference-auto-setup-functions))
+ (list (lambda ()
+ ;; HOOK is not allowed to be a lexical var:
+ ;; (run-hook-with-args-until-success 'hook)
+ (catch 'success
+ (dolist (f hook)
+ (when (funcall f)
+ (setq bug-reference-bug-regexp
+ (concat "." bug-reference-bug-regexp))
+ (throw 'success t)))))))))
+ (setq-local bug-reference-url-format
+ (if (forge--childp repo 'forge-gitlab-repository)
+ (lambda ()
+ (forge--format repo
+ (if (equal (match-string 3) "#")
+ 'issue-url-format
+ 'pullreq-url-format)
+ `((?i . ,(match-string 2)))))
+ (forge--format repo 'issue-url-format '((?i . "%s")))))
+ (setq-local bug-reference-bug-regexp
+ (if (forge--childp repo 'forge-gitlab-repository)
+ "\\(?3:[!#]\\)\\(?2:[0-9]+\\)"
+ "#\\(?2:[0-9]+\\)")))
+ (if (derived-mode-p 'prog-mode)
+ (bug-reference-prog-mode 1)
+ (bug-reference-mode 1))
+ (add-hook 'completion-at-point-functions
+ #'forge-topic-completion-at-point nil t)))))
+
+(unless noninteractive
+ (dolist (hook forge-bug-reference-hooks)
+ (add-hook hook #'forge-bug-reference-setup)))
+
+;;; _
+(provide 'forge-topic)
+;;; forge-topic.el ends here
--- /dev/null
+;;; forge-topics.el --- List topics -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'hl-line)
+
+(require 'forge-topic)
+(require 'forge-tablist)
+
+(defvar x-stretch-cursor)
+
+;;; Options
+
+(defcustom forge-topic-list-mode-hook '(hl-line-mode)
+ "Hook run after entering Forge-Topic-List mode."
+ :package-version '(forge . "0.1.0")
+ :group 'forge
+ :type 'hook
+ :options '(hl-line-mode))
+
+(defcustom forge-topic-list-columns
+ '(("#" forge--format-topic-slug 5 nil nil)
+ ("Title" forge--format-topic-title+labels 35 nil nil))
+ "List of columns displayed when listing topics for a single repository.
+
+Each element has the form (HEADER SOURCE WIDTH SORT PROPS).
+
+HEADER is the string displayed in the header. WIDTH is the width
+of the column. SOURCE is used to get the value, it has to be the
+name of a slot of `forge-topic' or a function that takes such an
+object as argument. SORT is a boolean or a function used to sort
+by this column. Supported PROPS include `:right-align' and
+`:pad-right'."
+ :package-version '(forge . "0.4.0")
+ :group 'forge
+ :type forge--tablist-columns-type)
+
+(defcustom forge-global-topic-list-columns
+ '(("Owner" (repository owner) 15 nil nil)
+ ("Name" (repository name) 20 nil nil)
+ ("#" forge--format-topic-slug 5 nil nil)
+ ("Title" forge--format-topic-title+labels 35 nil nil))
+ "List of columns displayed when listing topics for all repositories.
+
+Each element has the form (HEADER SOURCE WIDTH SORT PROPS).
+
+HEADER is the string displayed in the header. WIDTH is the width
+of the column. SOURCE is used to get the value, it has to be the
+name of a slot of `forge-topic' or a function that takes such an
+object as argument. SORT is a boolean or a function used to sort
+by this column. Supported PROPS include `:right-align' and
+`:pad-right'."
+ :package-version '(forge . "0.4.0")
+ :group 'forge
+ :type forge--tablist-columns-type)
+
+(defcustom forge-owned-accounts nil
+ "An alist of accounts that are owned by you.
+This should include your username as well as any organization
+that you own. Used by the commands `forge-list-owned-issues',
+`forge-list-owned-pullreqs' and `forge-fork'.
+
+Each element has the form (ACCOUNT . PLIST). The following
+properties are currently being used:
+
+`remote-name' The default name suggested by `forge-fork' for a
+ fork created within this account. If unspecified, then the
+ name of the account is used."
+ :package-version '(forge . "0.2.0")
+ :group 'forge
+ :type '(repeat (cons (string :tag "Account") plist)))
+
+(defcustom forge-owned-ignored nil
+ "A list of repositories that are ignored when listing those owned by you.
+This is a list of package names. Used by the commands
+`forge-list-owned-issues' and `forge-list-owned-pullreqs'."
+ :package-version '(forge . "0.2.0")
+ :group 'forge
+ :type '(repeat (string :tag "Name")))
+
+;;; Faces
+
+(defface forge-suffix-active '((t :inherit transient-value))
+ "Face used for suffixes whose effects is currently active."
+ :group 'forge-faces)
+
+(defface forge-tablist-hl-line
+ `((((class color) (background light))
+ ,@(and (>= emacs-major-version 27) '(:extend t))
+ :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1)
+ :color "grey25"
+ :style nil))
+ (((class color) (background dark))
+ ,@(and (>= emacs-major-version 27) '(:extend t))
+ :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1)
+ :color "grey75"
+ :style nil)))
+ "Face uses instead of `hl-line' in Forge's `tabulated-list-mode' buffers.
+It is recommended that you stick to using a box for this purpose,
+as using the background color would shadow the background colors
+used for labels."
+ :group 'forge-faces)
+
+(defface forge-tablist-topic-label
+ `((t :inherit forge-topic-label))
+ "Face used for topic labels in Forge's `tabulated-list-mode' buffers.
+This face can be used to control whether a box is added to labels
+and how that is styled. The background colors used for any given
+label, cannot be changed independently of the color used in the
+forges web interface."
+ :group 'forge-faces)
+
+;;; Mode
+
+(defvar-keymap forge-topic-list-mode-map
+ :doc "Local keymap for Forge-Topic-List mode buffers."
+ :parent tabulated-list-mode-map
+ "RET" #'forge-visit-this-topic
+ "<return>" #'forge-visit-this-topic
+ "o" #'forge-browse-this-topic
+ "C-c C-m" #'forge-topics-menu
+ "'" #'forge-dispatch
+ "?" #'magit-dispatch)
+
+(defvar forge-topic-list-mode-name
+ '((:eval (capitalize
+ (concat (if forge--buffer-list-filter
+ (format "%s " forge--buffer-list-filter)
+ "")
+ (if forge--buffer-list-type
+ (format "%ss" forge--buffer-list-type)
+ "topics")))))
+ "Information shown in the mode-line for `forge-topic-list-mode'.
+Must be set before `forge-list' is loaded.")
+
+(define-derived-mode forge-topic-list-mode tabulated-list-mode
+ forge-topic-list-mode-name
+ "Major mode for browsing a list of topics."
+ (setq-local hl-line-face 'forge-tablist-hl-line)
+ (setq-local x-stretch-cursor nil)
+ (setq tabulated-list-padding 0)
+ (setq tabulated-list-sort-key (cons "#" nil)))
+
+(defun forge-topic-get-buffer (&optional repo create)
+ (let ((name (if repo
+ (format "*forge-topics: %s*" (oref repo slug))
+ "*forge-topics*")))
+ (if create
+ (get-buffer-create name)
+ (get-buffer name))))
+
+(defun forge-topic-list-setup (type filter fn &optional repo global columns)
+ (let* ((repo (or repo
+ (and (not global)
+ (if-let* ((topic (forge-topic-at-point))
+ (repo (forge-get-repository topic)))
+ repo
+ (forge-get-repository :tracked?)))))
+ (dir (or (and repo (forge-get-worktree repo)) "/"))
+ (buffer nil))
+ (unless (or repo global)
+ (error "Cannot determine repository"))
+ (with-current-buffer (setq buffer (forge-topic-get-buffer repo t))
+ (setq default-directory dir)
+ (setq forge-buffer-repository (and repo (oref repo id)))
+ (setq forge--tabulated-list-columns (or columns forge-topic-list-columns))
+ (setq forge--tabulated-list-query
+ (cond ((not (functionp fn))
+ (lambda ()
+ (cl-sort (mapcan (-cut funcall <> repo) fn)
+ #'> :key (-cut oref <> number))))
+ (repo (apply-partially fn repo))
+ (fn)))
+ (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229
+ (forge-topic-list-mode))
+ (setq forge--buffer-list-type type)
+ (setq forge--buffer-list-filter filter)
+ (setq forge--buffer-list-global global)
+ (forge--tablist-refresh)
+ (add-hook 'tabulated-list-revert-hook #'forge--tablist-refresh nil t)
+ (tabulated-list-print)
+ (when hl-line-mode
+ (hl-line-highlight)))
+ (switch-to-buffer buffer)))
+
+;;; Commands
+;;;; Menu
+
+;;;###autoload (autoload 'forge-topics-menu "forge-topics" nil t)
+(transient-define-prefix forge-topics-menu ()
+ "Control list of topics and the topic at point."
+ :transient-suffix t
+ :transient-non-suffix t
+ :transient-switch-frame nil
+ :refresh-suffixes t
+ :column-widths forge--topic-menus-column-widths
+ [:hide always
+ ("q" forge-menu-quit-list)
+ ("RET" forge-topic-menu)
+ ("<return>" forge-topic-menu)]
+ [["Type"
+ (:info "topics" :face forge-suffix-active)
+ ("n" "notifications..." forge-notifications-menu :transient replace)
+ ("r" "repositories..." forge-repositories-menu :transient replace)]
+ [:description (lambda ()
+ (if forge--buffer-list-global
+ "Per-repository lists"
+ "Subtype"))
+ ("t" "topics" forge-list-topics)
+ ("i" "issues" forge-list-issues)
+ ("p" "pull-requests" forge-list-pullreqs)
+ ""]
+ ["Filter"
+ :if (lambda () (and (not forge--buffer-list-global)
+ (eq forge--buffer-list-type 'topic)))
+ ("l" "labeled" forge-list-labeled-topics)
+ ("c" "created" forge-list-authored-topics)
+ ("a" "assigned" forge-list-assigned-topics)]
+ ["Filter"
+ :if (lambda () (and (not forge--buffer-list-global)
+ (eq forge--buffer-list-type 'issue)))
+ ("l" "labeled" forge-list-labeled-issues)
+ ("c" "created" forge-list-authored-issues)
+ ("a" "assigned" forge-list-assigned-issues)]
+ ["Filter"
+ :if (lambda () (and (not forge--buffer-list-global)
+ (eq forge--buffer-list-type 'pullreq)))
+ ("l" "labeled" forge-list-labeled-pullreqs)
+ ("c" "created" forge-list-authored-pullreqs)
+ ("a" "assigned" forge-list-assigned-pullreqs)
+ ("w" "awaiting review" forge-list-requested-reviews)]]
+ [forge--topic-set-state-group
+ ["Global lists"
+ ("o t" "owned topics" forge-list-owned-topics)
+ ("o i" "owned issues" forge-list-owned-issues)
+ ("o p" "owned pull-requests" forge-list-owned-pullreqs)]
+ ["Actions"
+ ("f" "fetch all topics" forge-pull)
+ ("m" "show more actions" forge-dispatch)]]
+ [forge--topic-set-status-group]
+ (interactive)
+ (catch 'add-instead
+ (unless (derived-mode-p 'forge-topic-list-mode)
+ (let ((repo (forge-current-repository)))
+ (cond
+ ((or (not repo)
+ (forge-get-repository repo nil :tracked?)))
+ ((y-or-n-p (format "Add %s to database, so its topics can be listed?"
+ (oref repo slug)))
+ (forge-add-repository (forge-get-url repo))
+ (throw 'add-instead t))
+ ((setq repo nil)))
+ (if-let ((buffer (forge-topic-get-buffer repo)))
+ (switch-to-buffer buffer)
+ (if repo
+ (forge-list-topics repo)
+ (forge-list-owned-topics)))))
+ (transient-setup 'forge-topics-menu)))
+
+(defun forge-menu-quit-list ()
+ "From a transient menu, quit the list buffer and the menu.
+
+If quitting the list buffer causes another topic, repository or
+notification list buffer to become current in the selected window,
+then display the respective menu, otherwise display no menu."
+ (interactive)
+ (when (derived-mode-p 'forge-topic-mode
+ 'forge-topic-list-mode
+ 'forge-repository-list-mode
+ 'forge-notifications-mode)
+ (quit-window))
+ (cond ((derived-mode-p 'forge-topic-mode)
+ (setq transient--exitp 'replace)
+ (transient-setup (setq this-command 'forge-topic-menu)))
+ ((derived-mode-p 'forge-topic-list-mode)
+ (setq transient--exitp 'replace)
+ (transient-setup (setq this-command 'forge-topics-menu)))
+ ((derived-mode-p 'forge-repository-list-mode)
+ (setq transient--exitp 'replace)
+ (transient-setup (setq this-command 'forge-repositories-menu)))
+ ((derived-mode-p 'forge-notifications-mode)
+ (setq transient--exitp 'replace)
+ (transient-setup (setq this-command 'forge-notifications-menu)))
+ (t
+ (setq transient--exitp t)
+ (transient--pre-exit)
+ (transient--stack-zap))))
+
+;;;; Suffix Class
+
+(defclass forge--topic-list-command (transient-suffix)
+ ((type :initarg :type :initform nil)
+ (filter :initarg :filter :initform nil)
+ (global :initarg :global :initform nil)
+ (inapt-if :initform 'forge--topic-list-inapt)
+ (inapt-face :initform nil)))
+
+(defun forge--topic-list-inapt ()
+ (with-slots (type filter global) transient--pending-suffix
+ (and (eq type forge--buffer-list-type)
+ (eq filter forge--buffer-list-filter)
+ (eq global forge--buffer-list-global))))
+
+(cl-defmethod transient-format-description ((obj forge--topic-list-command))
+ (with-slots (description type filter global) obj
+ (if (and (eq type forge--buffer-list-type)
+ (memq filter (list nil forge--buffer-list-filter))
+ (eq global forge--buffer-list-global))
+ (propertize description 'face 'forge-suffix-active)
+ description)))
+
+;;;; Topic
+
+(defun forge--topic-list-setup (filter fn &optional repo global columns)
+ (forge-topic-list-setup 'topic filter fn repo global columns))
+
+;;;###autoload (autoload 'forge-list-topics "forge-topics" nil t)
+(transient-define-suffix forge-list-topics (&optional repository)
+ "List topics of the current repository.
+Non-interactively if optional REPOSITORY is non-nil, then list
+topics for that instead."
+ :class 'forge--topic-list-command :type 'topic
+ (interactive)
+ (forge--topic-list-setup nil
+ (list #'forge--ls-issues
+ #'forge--ls-pullreqs)
+ repository))
+(put 'forge-list-topics 'interactive-only nil)
+
+;;;###autoload (autoload 'forge-list-labeled-topics "forge-topics" nil t)
+(transient-define-suffix forge-list-labeled-topics (label)
+ "List topics of the current repository that have LABEL."
+ :class 'forge--topic-list-command :type 'topic :filter 'labeled
+ (interactive (list (forge-read-topic-label)))
+ (forge--topic-list-setup 'labeled
+ (list (-cut forge--ls-labeled-issues <> label)
+ (-cut forge--ls-labeled-pullreqs <> label))))
+
+;;;###autoload (autoload 'forge-list-assigned-topics "forge-topics" nil t)
+(transient-define-suffix forge-list-assigned-topics ()
+ "List topics of the current repository that are assigned to you."
+ :class 'forge--topic-list-command :type 'topic :filter 'assigned
+ (interactive)
+ (forge--topic-list-setup 'assigned
+ (list #'forge--ls-assigned-issues
+ #'forge--ls-assigned-pullreqs)))
+
+;;;###autoload (autoload 'forge-list-authored-topics "forge-topics" nil t)
+(transient-define-suffix forge-list-authored-topics ()
+ "List open topics from the current repository that are authored by you."
+ :class 'forge--topic-list-command :type 'topic :filter 'authored
+ (interactive)
+ (forge--topic-list-setup 'authored
+ (list #'forge--ls-authored-issues
+ #'forge--ls-authored-pullreqs)))
+
+;;;###autoload (autoload 'forge-list-owned-topics "forge-topics" nil t)
+(transient-define-suffix forge-list-owned-topics ()
+ "List open pull-requests from all your Github repositories.
+Options `forge-owned-accounts' and `forge-owned-ignored'
+controls which repositories are considered to be owned by you.
+Only Github is supported for now."
+ :class 'forge--topic-list-command :type 'topic :filter 'owned :global t
+ (interactive)
+ (forge--topic-list-setup 'owned
+ (list (lambda (_) (forge--ls-owned-issues))
+ (lambda (_) (forge--ls-owned-pullreqs)))
+ nil t forge-global-topic-list-columns))
+(put 'forge-list-owned-topics 'interactive-only nil)
+
+;;;; Issue
+
+(defun forge--issue-list-setup (filter fn &optional repo global columns)
+ (forge-topic-list-setup 'issue filter fn repo global columns))
+
+;;;###autoload (autoload 'forge-list-issues "forge-topics" nil t)
+(transient-define-suffix forge-list-issues ()
+ "List issues of the current repository."
+ :class 'forge--topic-list-command :type 'issue
+ (interactive)
+ (forge--issue-list-setup nil #'forge--ls-issues))
+
+;;;###autoload (autoload 'forge-list-labeled-issues "forge-topics" nil t)
+(transient-define-suffix forge-list-labeled-issues (label)
+ "List issues of the current repository that have LABEL."
+ :class 'forge--topic-list-command :type 'issue :filter 'labeled
+ (interactive (list (forge-read-topic-label)))
+ (forge--issue-list-setup 'labeled (-cut forge--ls-labeled-issues <> label)))
+
+;;;###autoload (autoload 'forge-list-assigned-issues "forge-topics" nil t)
+(transient-define-suffix forge-list-assigned-issues ()
+ "List issues of the current repository that are assigned to you."
+ :class 'forge--topic-list-command :type 'issue :filter 'assigned
+ (interactive)
+ (forge--issue-list-setup 'assigned #'forge--ls-assigned-issues))
+
+;;;###autoload (autoload 'forge-list-authored-issues "forge-topics" nil t)
+(transient-define-suffix forge-list-authored-issues ()
+ "List open issues from the current repository that are authored by you."
+ :class 'forge--topic-list-command :type 'issue :filter 'authored
+ (interactive)
+ (forge--issue-list-setup 'authored #'forge--ls-authored-issues))
+
+;;;###autoload (autoload 'forge-list-owned-issues "forge-topics" nil t)
+(transient-define-suffix forge-list-owned-issues ()
+ "List open issues from all your Github repositories.
+Options `forge-owned-accounts' and `forge-owned-ignored'
+controls which repositories are considered to be owned by you.
+Only Github is supported for now."
+ :class 'forge--topic-list-command :type 'issue :filter 'owned :global t
+ (interactive)
+ (forge--issue-list-setup 'owned #'forge--ls-owned-issues
+ nil t forge-global-topic-list-columns))
+
+;;;; Pullreq
+
+(defun forge--pullreq-list-setup (filter fn &optional repo global columns)
+ (forge-topic-list-setup 'pullreq filter fn repo global columns))
+
+;;;###autoload (autoload 'forge-list-pullreqs "forge-topics" nil t)
+(transient-define-suffix forge-list-pullreqs ()
+ "List pull-requests of the current repository."
+ :class 'forge--topic-list-command :type 'pullreq
+ (interactive)
+ (forge--pullreq-list-setup nil #'forge--ls-pullreqs))
+
+;;;###autoload (autoload 'forge-list-labeled-pullreqs "forge-topics" nil t)
+(transient-define-suffix forge-list-labeled-pullreqs (label)
+ "List pull-requests of the current repository that have LABEL."
+ :class 'forge--topic-list-command :type 'pullreq :filter 'labeled
+ (interactive (list (forge-read-topic-label)))
+ (forge--pullreq-list-setup 'labeled (-cut forge--ls-labeled-pullreqs <> label)))
+
+;;;###autoload (autoload 'forge-list-assigned-pullreqs "forge-topics" nil t)
+(transient-define-suffix forge-list-assigned-pullreqs ()
+ "List pull-requests of the current repository that are assigned to you."
+ :class 'forge--topic-list-command :type 'pullreq :filter 'assigned
+ (interactive)
+ (forge--pullreq-list-setup 'assigned #'forge--ls-assigned-pullreqs))
+
+;;;###autoload (autoload 'forge-list-requested-reviews "forge-topics" nil t)
+(transient-define-suffix forge-list-requested-reviews ()
+ "List pull-requests of the current repository that are awaiting your review."
+ :class 'forge--topic-list-command :type 'pullreq :filter 'review
+ (interactive)
+ (forge--pullreq-list-setup 'review #'forge--ls-requested-reviews))
+
+;;;###autoload (autoload 'forge-list-authored-pullreqs "forge-topics" nil t)
+(transient-define-suffix forge-list-authored-pullreqs ()
+ "List open pull-requests from the current repository that are authored by you."
+ :class 'forge--topic-list-command :type 'pullreq :filter 'authored
+ (interactive)
+ (forge--pullreq-list-setup 'authored #'forge--ls-authored-pullreqs))
+
+;;;###autoload (autoload 'forge-list-owned-pullreqs "forge-topics" nil t)
+(transient-define-suffix forge-list-owned-pullreqs ()
+ "List open pull-requests from all your Github repositories.
+Options `forge-owned-accounts' and `forge-owned-ignored'
+controls which repositories are considered to be owned by you.
+Only Github is supported for now."
+ :class 'forge--topic-list-command :type 'pullreq :filter 'owned :global t
+ (interactive)
+ (forge--pullreq-list-setup 'owned #'forge--ls-owned-pullreqs
+ nil t forge-global-topic-list-columns))
+
+;;; _
+(provide 'forge-topics)
+;;; forge-topics.el ends here
--- /dev/null
+;;; forge.el --- Access Git forges from Magit -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Homepage: https://github.com/magit/forge
+;; Keywords: git tools vc
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Work with Git forges, such as Github and Gitlab, from the comfort
+;; of Magit and the rest of Emacs.
+
+;; The schema of the database has not been finalized yet. Until that
+;; has happened it will occasionally have to be discarded. For now
+;; the database does not contain any information that cannot simply
+;; be fetched again.
+
+;;; Code:
+
+(require 'magit)
+
+(require 'forge-db)
+(require 'forge-core)
+
+(provide 'forge)
+
+(require 'forge-repo)
+(require 'forge-post)
+(require 'forge-topic)
+(require 'forge-issue)
+(require 'forge-pullreq)
+(require 'forge-revnote)
+(require 'forge-notify)
+
+(require 'forge-github)
+(require 'forge-gitlab)
+(require 'forge-gitea)
+(require 'forge-gogs)
+(require 'forge-bitbucket)
+(require 'forge-semi)
+
+(require 'forge-commands)
+(require 'forge-topics)
+(require 'forge-repos)
+
+;;; Add Sections
+
+(defvar forge-add-default-sections t
+ "Whether to add Forge's sections to `magit-status-sections-hook'.
+
+If you want to disable this, then you must set this to nil before
+`forge' is loaded.
+
+If this is nil, then `forge-toggle-display-in-status-buffer' can
+no longer do its job. It might be better to set the global value
+of `forge-display-in-status-buffer' to nil instead. That way you
+can still display topics on demand in the status buffer.")
+
+(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))
+
+;;; Add Bindings
+
+;;;###autoload
+(defvar forge-add-default-bindings t
+ "Whether to add Forge's bindings to various Magit keymaps.
+
+If you want to disable this, then you must set this to nil before
+`magit' is loaded. If you do it before `forge' but after `magit'
+is loaded, then `magit-mode-map' ends up being modified anyway.")
+
+;;;###autoload
+(with-eval-after-load 'magit-mode
+ (when forge-add-default-bindings
+ (keymap-set magit-mode-map "'" #'forge-dispatch)
+ (keymap-set magit-mode-map "N" #'forge-dispatch)
+ (keymap-set magit-mode-map "<remap> <magit-browse-thing>"
+ #'forge-browse)
+ (keymap-set magit-mode-map "<remap> <magit-copy-thing>"
+ #'forge-copy-url-at-point-as-kill)))
+
+;;;###autoload
+(with-eval-after-load 'git-commit
+ (when forge-add-default-bindings
+ (keymap-set git-commit-mode-map "C-c C-v" #'forge-visit-topic)))
+
+(when forge-add-default-bindings
+ (keymap-set magit-commit-section-map "C-c C-v" #'forge-visit-topic)
+ (keymap-set magit-branch-section-map "C-c C-v" #'forge-visit-topic)
+
+ (transient-insert-suffix 'magit-dispatch "o"
+ '("N" "Forge" forge-dispatch))
+
+ (transient-append-suffix 'magit-fetch "m"
+ '("n" "forge topics" forge-pull))
+ (transient-append-suffix 'magit-fetch "n"
+ '("N" "forge notifications" forge-pull-notifications))
+
+ (transient-append-suffix 'magit-pull "m"
+ '("n" "forge topics" forge-pull))
+ (transient-append-suffix 'magit-pull "n"
+ '("N" "forge notifications" forge-pull-notifications))
+
+ (transient-append-suffix 'magit-branch "w"
+ '("f" "pull-request" forge-checkout-pullreq))
+ (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-worktree "c"
+ '("n" "pull-request worktree" forge-checkout-worktree))
+
+ (transient-append-suffix 'magit-status-jump "w"
+ '("Np" "Pull requests" forge-jump-to-pullreqs))
+ (transient-append-suffix 'magit-status-jump "Np"
+ '("Ni" "Issues" forge-jump-to-issues))
+
+ (transient-append-suffix 'magit-merge "a"
+ '(7 "M" "Merge using API" forge-merge)))
+
+;;; Startup Asserts
+
+(defconst forge--minimal-git "2.7.0")
+
+(defun forge-startup-asserts ()
+ (let ((version (magit-git-version)))
+ (when (and version (version< version forge--minimal-git))
+ (display-warning 'magit (format "\
+Forge requires Git >= %s, you are using %s.
+
+If this comes as a surprise to you, because you do actually have
+a newer version installed, then that probably means that the
+older version happens to appear earlier on the `$PATH'. If you
+always start Emacs from a shell, then that can be fixed in the
+shell's init file. If you start Emacs by clicking on an icon,
+or using some sort of application launcher, then you probably
+have to adjust the environment as seen by graphical interface.
+For X11 something like ~/.xinitrc should work.
+
+If you use Tramp to work inside remote Git repositories, then you
+have to make sure a suitable Git is used on the remote machines
+too.\n" forge--minimal-git version) :error))))
+
+(if after-init-time
+ (forge-startup-asserts)
+ (add-hook 'after-init-hook #'forge-startup-asserts t))
+
+;;; forge.el ends here
--- /dev/null
+This is forge.info, produced by makeinfo version 6.7 from forge.texi.
+
+ Copyright (C) 2018-2024 Jonas Bernoulli
+ <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+ You can redistribute this document 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 document 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.
+
+INFO-DIR-SECTION Emacs
+START-INFO-DIR-ENTRY
+* Forge: (forge). Access Git Forges from Magit.
+END-INFO-DIR-ENTRY
+
+\1f
+File: forge.info, Node: Top, Next: Introduction, Up: (dir)
+
+Forge User and Developer Manual
+*******************************
+
+Forge allows you to work with Git forges, such as Github and Gitlab,
+from the comfort of Magit and the rest of Emacs.
+
+This manual is for Forge version 0.3.2.50-git.
+
+ Copyright (C) 2018-2024 Jonas Bernoulli
+ <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+ You can redistribute this document 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 document 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.
+
+* Menu:
+
+* Introduction::
+* Supported Forges and Hosts::
+* Getting Started::
+* Usage::
+* FAQ::
+* Keystroke Index::
+* Function and Command Index::
+* Variable Index::
+
+— The Detailed Node Listing —
+
+Supported Forges and Hosts
+
+* Supported Forges::
+* Partially Supported Forges::
+* Supported Semi-Forges::
+
+Getting Started
+
+* Loading Forge::
+* Token Creation::
+* Initial Pull::
+* Repository Detection::
+* Caveats::
+
+Usage
+
+* Pulling::
+* Branching::
+* Working with Topics::
+* Miscellaneous::
+
+Working with Topics
+
+* Visiting Topics::
+* Listing Topics and Notifications::
+* Creating Topics::
+* Editing Topics and Posts::
+
+
+FAQ
+
+* Is it possible to create a single pull-request without pulling everything?::
+* ‘error in process filter HTTP Error 502, "Bad gateway"’: error in process filter HTTP Error 502 "Bad gateway".
+
+
+\1f
+File: forge.info, Node: Introduction, Next: Supported Forges and Hosts, Prev: Top, Up: Top
+
+1 Introduction
+**************
+
+Forge allows you to work with Git forges, such as Github and Gitlab,
+from the comfort of Magit and the rest of Emacs.
+
+ Forge fetches issues, pull-requests and other data using the forge’s
+API and stores that in a local database. Additionally it fetches the
+pull-request references using Git. Forge implements various features
+that use this data but the database and pull-request refs can also be
+used by third-party packages.
+
+\1f
+File: forge.info, Node: Supported Forges and Hosts, Next: Getting Started, Prev: Introduction, Up: Top
+
+2 Supported Forges and Hosts
+****************************
+
+Currently Forge supports two forges and three more forges partially.
+Additionally it supports four semi-forges. Support for more forges and
+semi-forges can and will be added.
+
+ Both forges and semi-forges provide web interfaces for Git
+repositories. Forges additionally support pull-requests and issues and
+make those and other information available using an API.
+
+ When a forge is only partially supported, then that means that only
+the functionality that does not require the API is implemented, or in
+other words, that the forge is only supported as a semi-forge.
+
+ A host is a particular instance of a forge. For example the hosts
+<https://gitlab.com> and <https://salsa.debian.org> are both instances
+of the Gitlab forge. Forge supports some well known hosts out of the
+box and additional hosts can easily be supported by adding entries to
+the option ‘forge-alist’ (see *note Repository Detection::).
+
+ For more details about the caveats mentioned below (and some others)
+also see *note Getting Started::.
+
+* Menu:
+
+* Supported Forges::
+* Partially Supported Forges::
+* Supported Semi-Forges::
+
+\1f
+File: forge.info, Node: Supported Forges, Next: Partially Supported Forges, Up: Supported Forges and Hosts
+
+2.1 Supported Forges
+====================
+
+Github
+------
+
+Forge’s support for Github can be considered the "reference
+implementation". Support for other forges can lag behind a bit.
+
+Github Caveats
+..............
+
+ • Forge uses the Github GraphQL API when possible but has to fall
+ back to use the REST API in many cases because the former is still
+ rather incomplete.
+
+ • The Github GraphQL API has a hard-coded timeout on queries. The
+ only solution is to reduce the number of entities we query at once,
+ which can be done by adjusting either the ‘forge.graphqlItemLimit’
+ git variable or the field "GQL entity limit" in a status buffer.
+
+ • Forge depends on the ‘updated_at’ field being updated when
+ appropriate. For Github pull-requests at least, that is not always
+ done.
+
+Github Hosts
+............
+
+ • <https://github.com>
+
+Gitlab
+------
+
+Gitlab Caveats
+..............
+
+ • Forge cannot provide notifications because the Gitlab API does not
+ expose those.
+
+Gitlab Hosts
+............
+
+ • <https://gitlab.com>
+ • <https://salsa.debian.org>
+ • <https://framagit.org>
+
+\1f
+File: forge.info, Node: Partially Supported Forges, Next: Supported Semi-Forges, Prev: Supported Forges, Up: Supported Forges and Hosts
+
+2.2 Partially Supported Forges
+==============================
+
+Gitea https://gitea.io
+----------------------
+
+This is the next forge whose API will be supported.
+
+Gitea Hosts
+...........
+
+ • <https://codeberg.org>
+
+Gogs https://gogs.io
+--------------------
+
+Once Gitea is supported it should be fairly simple to support Gogs too,
+because the former is a fork of the latter and the APIs seem to still be
+very similar.
+
+Gogs Hosts
+..........
+
+ • <https://code.orgmode.org>
+
+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.
+
+Bitbucket Caveats
+.................
+
+ • The API documentation is poor and initial tests indicated that the
+ implementation is buggy.
+
+ • Atlassian’s offering contains two very distinct implementations
+ that are both called "Bitbucket". Forge only supports the
+ implementation whose only instance is available at
+ <https://bitbucket.org>, because I only have access to that.
+
+ • Unlike all other forges, Bitbucket does not expose pull-requests as
+ references in the upstream repository. For that reason Forge
+ actually treats it as a semi-forge, not as forge whose API is not
+ supported yet. This means that you cannot checkout pull-requests
+ locally. There is little hope that this will ever get fixed; the
+ respective issue was opened six years ago and there has been no
+ progress since: <https://bitbucket.org/site/master/issues/5814>.
+
+Bitbucket Hosts
+...............
+
+ • <https://bitbucket.org>
+
+\1f
+File: forge.info, Node: Supported Semi-Forges, Prev: Partially Supported Forges, Up: Supported Forges and Hosts
+
+2.3 Supported Semi-Forges
+=========================
+
+Gitweb https://git-scm.com/docs/gitweb
+--------------------------------------
+
+Gitweb Caveats
+..............
+
+ • I could find only one public installation
+ (<https://git.savannah.gnu.org>), which gives users the choice
+ between Gitweb and Cgit. The latter seems more popular (not just
+ on this site).
+
+Cgit https://git.zx2c4.com/cgit/about
+-------------------------------------
+
+Cgit Caveats
+............
+
+ • Different sites use different URL schemata and some of the bigger
+ sites use a fork. For this reason Forge has to provide several
+ classes to support different variations of Cgit and you have to
+ look at their definitions to figure out which one is the correct
+ one for a particular installation.
+
+Cgit Hosts
+..........
+
+ • <https://git.savannah.gnu.org/cgit>
+ • <https://git.kernel.org>
+ • <https://repo.or.cz>
+
+Stgit https://codemadness.org/git/stagit/file/README.html
+---------------------------------------------------------
+
+Stgit Caveats
+.............
+
+ • Stgit cannot show logs for branches beside "master". For that
+ reason Forge takes users to a page listing the branches when they
+ request the log for a particular branch (even for "master" whose
+ log is just one click away from there).
+
+Stgit Hosts
+...........
+
+ • <https://git.suckless.org>
+
+Srht https://meta.sr.ht
+-----------------------
+
+Srht Caveats
+............
+
+ • Srht cannot show logs for branches beside "master". For that
+ reason Forge takes users to a page listing the branches when they
+ request the log for a particular branch (even for "master" whose
+ log is just one click away from there).
+
+Srht Hosts
+..........
+
+ • <https://git.sr.ht>
+
+\1f
+File: forge.info, Node: Getting Started, Next: Usage, Prev: Supported Forges and Hosts, Up: Top
+
+3 Getting Started
+*****************
+
+Initial setup turned out to more challenging for many users than I had
+hoped. I am trying to counter that by providing detailed instructions
+that cover not just the happy path but also many of the issues users
+have ran into in the past. The recommended reading is longer than one
+might wish, but skipping it does not necessarily save time.
+
+ Forge uses the Ghub package to access the APIs of supported forges.
+How this works and how to create and store a token is documented in
+*note (ghub)Getting Started::. Please read that in full before coming
+back here and continuing with the subsections listed below.
+
+ <https://github.com/magit/forge/wiki> lists additional resources;
+including a link to a much shorter quick-start guide provided by a user.
+
+* Menu:
+
+* Loading Forge::
+* Token Creation::
+* Initial Pull::
+* Repository Detection::
+* Caveats::
+
+\1f
+File: forge.info, Node: Loading Forge, Next: Token Creation, Up: Getting Started
+
+3.1 Loading Forge
+=================
+
+Loading Magit doesn’t cause Forge to be loaded automatically. Adding
+something like this to your init file takes care of that:
+
+ (with-eval-after-load 'magit
+ (require 'forge))
+
+Or if you use ‘use-package’:
+
+ (use-package forge
+ :after magit)
+
+\1f
+File: forge.info, Node: Token Creation, Next: Initial Pull, Prev: Loading Forge, Up: Getting Started
+
+3.2 Token Creation
+==================
+
+Forge uses the Ghub package to access the APIs of supported Git forges.
+How this works and how to create and store a token is documented in
+*note (ghub)Getting Started::.
+
+ Ghub used to provide a setup wizard, but that had to be removed for
+reasons given in the manual just mentioned. Nowadays there is no way
+around reading the documentation and doing this manually I am afraid.
+
+ Forge requires the following token scopes.
+
+ • For Github these scopes are required.
+
+ • ‘repo’ grants full read/write access to private and public
+ repositories.
+ • ‘user’ grants access to profile information.
+ • ‘read:org’ grants read-only access to organization membership.
+
+ More information about these and other scopes can be found at
+ <https://docs.github.com/en/developers/apps/scopes-for-oauth-apps>.
+
+ • For Gitlab instances ‘api’ is the only required scope. It gives
+ read and write access to everything. The Gitlab API provides more
+ fine-grained scopes for read-only access, but when any write access
+ at all is required, then it is all or nothing.
+
+\1f
+File: forge.info, Node: Initial Pull, Next: Repository Detection, Prev: Token Creation, Up: Getting Started
+
+3.3 Initial Pull
+================
+
+To start using Forge in a certain repository visit the Magit status
+buffer for that repository and type ‘f n’ (‘forge-pull’).
+Alternatively, you can use ‘M-x forge-add-repository’, which makes it
+possible to add a forge repository without pulling all topics and even
+without having to clone the respective Git repository.
+
+ You must set up a token *before* you can add the first repository.
+See *note Token Creation::.
+
+ The first time ‘forge-pull’ is run in a repository, an entry for that
+repository is added to the database and a new value is added to the Git
+variable ‘remote.<remote>.fetch’, which fetches all pull-requests.
+(‘+refs/pull/*/head:refs/pullreqs/*’ for Github)
+
+ ‘forge-pull’ then fetches topics and other information using the
+forge’s API and pull-request references using Git.
+
+ The initial fetch can take a while but most of that is done
+asynchronously. Storing the information in the database is done
+synchronously though, so there can be a noticeable hang at the end.
+Subsequent fetches are much faster.
+
+ Fetching issues from Github is much faster than fetching from other
+forges because making a handful of GraphQL requests is much faster than
+making hundreds of REST requests.
+
+\1f
+File: forge.info, Node: Repository Detection, Next: Caveats, Prev: Initial Pull, Up: Getting Started
+
+3.4 Repository Detection
+========================
+
+Ghub does *not* associate a given local repository with a repository on
+a forge. The Forge package itself takes care of this. In doing so it
+ignores the Git variable ‘ghub.host’ and other ‘*.host’ variables used
+by Ghub. (But ‘github.user’ and other variables used to specify the
+user are honored).
+
+ Forge associates the local repository with a forge repository by
+first determining which remote is associated with the upstream
+repository and then looking that up in ‘forge-alist’.
+
+ If only one remote exists, then Forge uses that unconditionally. To
+reduce the number of support requests, this is even the case if the Git
+variable ‘forge.remote’ names another, non-existent, remote.
+
+ If several remotes exist, then a remote may be selected based on its
+name. Almost always we want to fetch the data associated with the
+upstream repository, so that is what the logic described here tries to
+achieve. The convention is to name the upstream remote "origin", and if
+that convention were universally followed, then things would be trivial.
+However many people name the upstream remote "upstream", which also
+makes sense.
+
+ Note, however, that even though a surprising number of people do
+ just that, it does not make any sense to use the name "origin" to
+ refer to a fork; not even to your own fork. A fork is a *copy* of
+ the original, "copy" is an antonym for "original", and the word
+ "origin" is not only closely related to but even contained in the
+ word "original". Naming a fork the "origin" is at best extremely
+ confusing.
+
+ copy
+ a thing made to be similar or identical to another.
+
+ original
+ the earliest form of something, from which copies may be made.
+
+ origin
+ the point or place where something begins, arises, or is
+ derived.
+
+ If several remotes exist, then the following remote names are tried
+in order and the first remote thus named that exists in the repository
+is used.
+
+ 1. The value of the Git variable ‘forge.remote’, if set. If the
+ variable has a value but no remote by the specified name exists,
+ then a warning is shown, but otherwise this conflict is ignored.
+ This behavior is arguably odd, but due to historic and pragmatic
+ reasons it is the least painful path forward.
+
+ 2. The remote named ‘upstream’, if it exists.
+
+ 3. The remote named ‘origin’, if it exists.
+
+ The remote named "upstream" is preferred over the remote named
+"origin" because the existence of the former strongly suggests that the
+latter is either not used in this repository (in which case the order
+does not matter) or else it is abused as the name of a fork (in which
+case "upstream" must be preferred).
+
+ -- Variable: forge.remote
+ The value of this variable specifies the remote from which Forge
+ fetches data. It is usually best to leave this unspecified and to
+ rely on the behavior described above.
+
+ If the remote has to be specified explicitly, then this should be
+ done locally, for a single repository.
+
+ Only ever set this globally, if you consistently use a certain name
+ to refer to the upstream repository and it isn’t one of "upstream"
+ or "origin", and you *never* use that name to refer to a repository
+ that does *not* refer to the upstream repository.
+
+‘N r’ (‘forge-forge.remote’)
+ This command changes the value of the ‘forge.remote’ Git variable
+ in the current repository.
+
+ If this variable is set, then Forge uses the remote by that name, if
+it exists, the same way it may have used ‘origin’ if the the variable
+were undefined. I.e., it does not fall through to try ‘origin’ if no
+remote by your chosen name exists.
+
+ Once the upstream remote has been determined, Forge looks it up in
+‘forge-alist’, using the host part of the URL as the key. For example
+the key for ‘gitNOSPAMgithub.com:magit/forge.git’ is ‘github.com’.
+
+ -- User Option: forge-alist
+ This option defines forge hosts known to Forge.
+
+ Each entry has the form ‘(GITHOST APIHOST WEBHOST CLASS)’.
+
+ • GITHOST is the host used to access repositories on the forge
+ using Git.
+
+ • APIHOST is the host used to access the forge’s API. For some
+ forges the isn’t just a host, but a host followed by the path
+ to the API’s endpoint.
+
+ • WEBHOST is the host used to access repositories on this forge
+ using a browser. The IDs used to identify repositories from
+ the forge in the local database also derives from this value.
+
+ • CLASS is the class to be used for repositories from the forge.
+
+ Complications:
+
+ • When connecting to a Github Enterprise edition whose REST
+ API’s end point is "<host>/v3" and whose GraphQL API’s end
+ point is "<host>/graphql", then use "<host>/v3" as APIHOST.
+ This is a historic accident. See issue #174.
+
+ • WEBHOST and CLASS cannot be changed once you have added one or
+ more repositories from a forge. Changing GITHOST and/or
+ APIHOST may be possible, but should seldom be necessary.
+
+\1f
+File: forge.info, Node: Caveats, Prev: Repository Detection, Up: Getting Started
+
+3.5 Caveats
+===========
+
+ • Fetched information is stored in a database. The table schemata of
+ that database have not been finalized yet. Until that has happened
+ it will occasionally have to be discarded. That isn’t such a huge
+ deal because for now the database does not contain any information
+ that cannot simply be fetched again, see *note Initial Pull::.
+
+ • Fetching is implemented under the assumption that the API can be
+ asked to list the things that have changed since we last checked.
+ Unfortunately the APIs are not bug-free, so this is not always the
+ case. If in doubt, then re-fetch an individual topic to ensure it
+ is up-to-date using the command ‘forge-pull-topic’.
+
+ • Some other, forge-specific, caveats are mentioned in *note
+ Supported Forges and Hosts::.
+
+\1f
+File: forge.info, Node: Usage, Next: FAQ, Prev: Getting Started, Up: Top
+
+4 Usage
+*******
+
+Once information has been pulled from a repository’s forge for the first
+time, Forge adds two additional sections, named "Pull requests" and
+"Issues" to Magit’s status buffer. It is also possible to add a
+repository to the local database without pulling all the data, which is
+useful if you want to create a single pull-request.
+
+‘N a’ (‘forge-add-repository’)
+ This command adds a repository to the database.
+
+ It offers to either pull topics (now and in the future) or to only
+ pull individual topics when the user invokes ‘forge-pull-topic’.
+
+ Some of Forge’s commands are only bound when point is within one of
+these sections but other commands are also available elsewhere in
+Magit’s status buffer and/or from Magit’s transient commands.
+
+‘N’ (‘forge-dispatch’)
+ This prefix command is available in any Magit buffer and provides
+ access to several of the available Forge commands. Most of these
+ commands are also bound elsewhere, but some are not. See the
+ following sections for information about the available commands.
+
+ Throughout this manual you will find many bindings that begin with
+ ‘N’, but if you prefer to continue to use ‘forge-dispatch’’s older
+ binding you can substitute ‘'’ for that.
+
+* Menu:
+
+* Pulling::
+* Branching::
+* Working with Topics::
+* Miscellaneous::
+
+\1f
+File: forge.info, Node: Pulling, Next: Branching, Up: Usage
+
+4.1 Pulling
+===========
+
+The commands that fetch forge data are available from the same transient
+prefix command (‘magit-fetch’ on ‘f’) that is used to fetch Git data.
+If option ‘magit-pull-or-fetch’ is non-nil, then they are also available
+from the ‘magit-pull’ transient (on ‘F’).
+
+‘f n’ (‘forge-pull’)
+‘N f f’
+ This command uses a forge’s API to fetch topics and other
+ information about the current repository and stores the fetched
+ information in the database. It also fetches notifications for all
+ repositories from the same forge host. (Currently this is limited
+ to Github.) Finally it fetches pull-request references using Git.
+
+ After using this command for the first time in a given repository
+ the status buffer for that repository always lists the
+ pull-requests and issues. See *note Initial Pull::.
+
+‘f N’ (‘forge-pull-notifications’)
+‘N f n’
+ This command uses a forge’s API to fetch all notifications from
+ that forge including, but not limited to, the notifications for the
+ current repository.
+
+ Fetching all notifications fetches associated topics even if you
+ have not started fetching *all* topics for the respective
+ repositories (using ‘forge-pull’), but it does not cause the topics
+ to be listed in the status buffer of such "uninitialized"
+ repositories.
+
+ Note how pulling data from a forge’s API works the same way as
+pulling Git data does; you do it explicitly when you want to see the
+work done by others.
+
+ This is less disruptive, more reliable, and easier to understand than
+if Forge did the pulling by itself at random intervals. It might
+however mean that you occasionally invoke a command expecting the most
+recent data to be available and then have to abort to pull first. The
+same can happen with Git, e.g., you might attempt to merge a branch that
+you know exists but haven’t actually pulled yet.
+
+‘N f t’ (‘forge-pull-topic’)
+ This command uses a forge’s API to fetch a single pull-request and
+ stores it in the database.
+
+ Normally you wouldn’t want to pull a single pull-request by itself,
+ but due to a bug in the Github API you might sometimes have to do
+ so.
+
+ Fetching is implemented under the assumption that the API can be
+ asked to list the things that have changed since we last checked.
+ Unfortunately the APIs are not bug-free, so this is not always the
+ case. If in doubt, then re-fetch an individual topic to ensure it
+ is up-to-date using the command ‘forge-pull-topic’.
+
+\1f
+File: forge.info, Node: Branching, Next: Working with Topics, Prev: Pulling, Up: Usage
+
+4.2 Branching
+=============
+
+Forge provides commands for creating and checking out a new branch or
+work tree from a pull-request. These commands are available from the
+same transient prefix commands as the suffix commands used to create and
+check out branches and work trees in a more generic fashion
+(‘magit-branch’ on ‘b’ and ‘magit-worktree’ on ‘%’).
+
+‘b F’ (‘forge-branch-pullreq’)
+ This command creates and configures a new branch from a
+ pull-request, creating and configuring a new remote if necessary.
+
+ The name of the local branch is the same as the name of the remote
+ branch that you are being asked to merge, unless the contributor
+ could not be bothered to properly name the branch before opening
+ the pull-request. The most likely such case is when you are being
+ asked to merge something like "fork/master" into "origin/master".
+ In such cases the local branch will be named "pr-N", where ‘N’ is
+ the pull-request number.
+
+ These variables are always set by this command:
+
+ • ‘branch.<name>.pullRequest’ is set to the pull-request number.
+ • ‘branch.<name>.pullRequestRemote’ is set to the remote on
+ which the pull-request branch is located.
+ • ‘branch.<name>.pushRemote’ is set to the same remote as
+ ‘branch.<name>.pullRequestRemote’ if that is possible,
+ otherwise it is set to the upstream remote.
+ • ‘branch.<name>.description’ is set to the pull-request title.
+ • ‘branch.<name>.rebase’ is set to ‘true’ because there should
+ be no merge commits among the commits in a pull-request.
+
+ This command also configures the upstream and the push-remote of
+ the local branch that it creates.
+
+ The branch against which the pull-request was opened is always used
+ as the upstream. This makes it easy to see what commits you are
+ being asked to merge in the section titled something like "Unmerged
+ into origin/master".
+
+ Like for other commands that create a branch, it depends on the
+ option ‘magit-branch-prefer-remote-upstream’ whether the remote
+ branch itself or the respective local branch is used as the
+ upstream, so this section may also be titled, e.g., "Unmerged into
+ master".
+
+ When necessary and possible, the remote pull-request branch is
+ configured to be used as the push-target. This makes it easy to
+ see what further changes the contributor has made since you last
+ reviewed their changes in the section titled something like
+ "Unpulled from origin/new-feature" or "Unpulled from
+ fork/new-feature".
+
+ • If the pull-request branch is located in the upstream
+ repository, then you probably have set ‘remote.pushDefault’ to
+ that repository. However some users like to set that variable
+ to their personal fork, even if they have push access to the
+ upstream, so ‘branch.<name>.pushRemote’ is set anyway.
+
+ • If the pull-request branch is located inside a fork, then you
+ are usually able to push to that branch, because Github by
+ default allows the recipient of a pull-request to push to the
+ remote pull-request branch even if it is located in a fork.
+ The contributor has to explicitly disable this.
+
+ • If you are not allowed to push to the pull-request branch
+ on the fork, then a branch by the same name located in
+ the upstream repository is configured as the push-target.
+
+ • A—sadly rather common—special case is when the
+ contributor didn’t bother to use a dedicated branch for
+ the pull-request.
+
+ The most likely such case is when you are being asked to
+ merge something like "fork/master" into "origin/master".
+ The special push permission mentioned above is never
+ granted for the branch that is the repository’s default
+ branch, and that would almost certainly be the case in
+ this scenario.
+
+ To enable you to easily push somewhere anyway, the local
+ branch is named "pr-N" (where ‘N’ is the pull-request
+ number) and the upstream repository is used as the
+ push-remote.
+
+ • Finally, if you are allowed to push to the pull-request
+ branch and the contributor had the foresight to use a
+ dedicated branch, then the fork is configured as the
+ push-remote.
+
+ The push-remote is configured using
+ ‘branch.<name>.pushRemote’, even if the used value is
+ identical to that of ‘remote.pushDefault’, just in case you
+ change the value of the latter later on. Additionally the
+ variable ‘branch.<name>.pullRequestRemote’ is set to the
+ remote on which the pull-request branch is located.
+
+‘b f’ (‘forge-checkout-pullreq’)
+ This command creates and configures a new branch from a
+ pull-request the same way ‘forge-branch-pullreq’ does.
+ Additionally it checks out the new branch.
+
+‘Z n’ (‘forge-checkout-worktree’)
+ This command creates and configures a new branch from a
+ pull-request the same way ‘forge-branch-pullreq’ does.
+ Additionally it checks out the new branch using a new working tree.
+
+ -- User Option: forge-checkout-worktree-read-directory-function
+ This function is used by ‘forge-checkout-worktree’ to read read the
+ new worktree directory where it checks out to pull-request. It
+ takes the pull-request as the only argument and must return a
+ directory.
+
+ When you delete a pull-request branch, which was created using one of
+the above three commands, then ‘magit-branch-delete’ usually offers to
+also delete the corresponding remote. It does not offer to delete a
+remote if (1) the remote is the upstream remote, and/or (2) if other
+branches are being fetched from the remote.
+
+ Note that you have to delete the local branch (e.g., "feature") for
+this to work. If you delete the tracking branch (e.g., "fork/feature"),
+then the remote is never removed.
+
+\1f
+File: forge.info, Node: Working with Topics, Next: Miscellaneous, Prev: Branching, Up: Usage
+
+4.3 Working with Topics
+=======================
+
+We call both issues and pull-requests "topics". The contributions to
+the conversation are called "posts".
+
+* Menu:
+
+* Visiting Topics::
+* Listing Topics and Notifications::
+* Creating Topics::
+* Editing Topics and Posts::
+
+\1f
+File: forge.info, Node: Visiting Topics, Next: Listing Topics and Notifications, Up: Working with Topics
+
+4.3.1 Visiting Topics
+---------------------
+
+Magit’s status buffer contains lists of issues and pull-requests.
+Topics are ordered by last modification time. All open issues and some
+recently edited and closed topics are listed.
+
+ Forge provides some commands that act on the listed topics. These
+commands can also be used in other contexts, such as when point is on a
+commit or branch section.
+
+‘C-c C-w’ (‘forge-browse-TYPE’)
+‘C-c C-w’ (‘forge-browse-dwim’)
+‘N b r’ (‘forge-browse-remote’)
+‘N b I’ (‘forge-browse-issues’)
+‘N b P’ (‘forge-browse-pullreqs’)
+‘N b t’ (‘forge-browse-topic’)
+‘N b i’ (‘forge-browse-issue’)
+‘N b p’ (‘forge-browse-pullreq’)
+ These commands visit the topic, issue(s), pull-request(s), post,
+ branch, commit, or remote at point in a browser.
+
+ This is implemented using various commands named
+ ‘forge-browse-TYPE’, and the key binding is defined by remapping
+ ‘magit-browse-thing’ (as defined in ‘magit-mode-map)’. For commit
+ sections this key is bound to ‘forge-browse-dwim’, which prefers a
+ topic over a branch and a branch over a commit.
+
+‘<RET>’ (‘forge-visit-TYPE’)
+‘C-c C-v’ (‘forge-visit-topic’)
+‘N v t’ (‘forge-visit-topic’)
+‘N v i’ (‘forge-visit-issue’)
+‘N v p’ (‘forge-visit-pullreq’)
+ These commands visit the pull-request(s), issue(s), or repository
+ in a separate buffer.
+
+ The ‘RET’ binding is only available when point is on a issue or
+ pull-request section because that key is already bound to something
+ else for most of Magit’s own sections. ‘C-c C-v’ however is also
+ available on regular commit (e.g., in a log) and branch sections.
+
+ This is implemented using various commands named ‘forge-visit-TYPE’
+ and the key binding is defined by remapping ‘magit-visit-thing’ (as
+ defined in ‘magit-mode-map’).
+
+\1f
+File: forge.info, Node: Listing Topics and Notifications, Next: Creating Topics, Prev: Visiting Topics, Up: Working with Topics
+
+4.3.2 Listing Topics and Notifications
+--------------------------------------
+
+By default Forge lists a subset of topics directly in the Magit status
+buffer. It also provides commands to list topics and notifications in
+separate buffers.
+
+ Forge adds the following functions to ‘magit-status-sections-hook’:
+
+ -- Function: forge-insert-pullreqs
+ This function inserts a list of the most recent and/or open
+ pull-requests.
+
+ -- Function: forge-insert-issues
+ This function inserts a list of the most recent and/or open issues.
+
+ -- User Option: forge-topic-list-limit
+ This option limits the number of topics listed by the above
+ functions.
+
+ All unread topics are always shown. If the value of this option
+ has the form ‘(OPEN . CLOSED)’, then the integer ‘OPEN’ specifies
+ the maximal number of topics and ‘CLOSED’ specifies the maximal
+ number of closed topics. IF ‘CLOSED’ is negative then show no
+ closed topics until the command ‘forge-toggle-closed-visibility’
+ changes the sign.
+
+ -- Command: forge-toggle-closed-visibility
+ This command toggles whether the above two functions list recently
+ closed issues in the current buffer.
+
+ The following functions are also suitable for
+‘magit-status-sections-hook’:
+
+ -- Function: forge-insert-assigned-pullreqs
+ This function inserts a list of open pull-requests that are
+ assigned to you.
+
+ -- Function: forge-insert-requested-reviews
+ This function inserts a list of open pull-requests that are
+ awaiting your review.
+
+ -- Function: forge-insert-authored-pullreqs
+ This function inserts a list of open pull-requests that are
+ authored by you.
+
+ -- Function: forge-insert-assigned-issues
+ This function inserts a list of open issues that are assigned to
+ you.
+
+ -- Function: forge-insert-authored-issues
+ This function inserts a list of open issues that are authored by
+ you.
+
+ The following commands list repositories, notifications and topics in
+dedicated buffers:
+
+‘N l r’ (‘forge-list-repositories’)
+ This command lists all known repositories in a separate buffer.
+
+‘N l n’ (‘forge-list-notifications’)
+ This command lists all notifications for all forges in a separate
+ buffer.
+
+‘N l p’ (‘forge-list-pullreqs’)
+ This command lists the current repository’s pull-requests in a
+ separate buffer.
+
+‘N l i’ (‘forge-list-issues’)
+ This command lists the current repository’s issues in a separate
+ buffer.
+
+ -- Command: forge-list-labeled-pullreqs
+ This command lists the current repository’s open pull-requests that
+ are labeled with a label read from the user.
+
+ -- Command: forge-list-labeled-issues
+ This command lists the current repository’s open issues that are
+ labeled with a label read from the user.
+
+ -- Command: forge-list-assigned-pullreqs
+ This command lists the current repository’s open pull-requests that
+ are assigned to you in a separate buffer.
+
+ -- Command: forge-list-assigned-issues
+ This command lists the current repository’s open issues that are
+ assigned to you in a separate buffer.
+
+ -- Command: forge-list-requested-reviews
+ This command lists pull-requests of the current repository that are
+ awaiting your review in a separate buffer.
+
+ -- Command: forge-list-authored-pullreqs
+ This command lists the current repository’s open pull-requests that
+ are authored by you in a separate buffer.
+
+ -- Command: forge-list-authored-issues
+ This command lists the current repository’s open issues that are
+ authored by you in a separate buffer.
+
+ -- Command: forge-list-owned-pullreqs
+ This command lists open pull-requests from all the repositories
+ that you own. Options ‘forge-owned-accounts’ and
+ ‘forge-owned-ignored’ controls which repositories are considered to
+ be owned by you. Only Github is supported for now.
+
+ -- Command: forge-list-owned-issues
+ This command lists open issues from all the repositories that you
+ own. Options ‘forge-owned-accounts’ and ‘forge-owned-ignored’
+ controls which repositories are considered to be owned by you.
+ Only Github is supported for now.
+
+ -- User Option: forge-owned-accounts
+ This is an alist of accounts that are owned by you. This should
+ include your username as well as any organization that you own.
+ Used by the commands ‘forge-list-owned-issues’,
+ ‘forge-list-owned-pullreqs’ and ‘forge-fork’.
+
+ Each element has the form ‘(ACCOUNT . PLIST)’. The following
+ properties are currently being used:
+
+ • ‘remote-name’ The default name suggested by ‘forge-fork’ for a
+ fork created within this account. If unspecified, then the
+ name of the account is used.
+
+ Example: ‘(("tarsius") ("emacsmirror" remote-name "mirror"))’.
+
+ -- User Option: forge-owned-ignored
+ This is a list of repository names that are considered to not be
+ owned by you even though they would have been considered to be
+ owned by you based on ‘forge-owned-accounts’.
+
+\1f
+File: forge.info, Node: Creating Topics, Next: Editing Topics and Posts, Prev: Listing Topics and Notifications, Up: Working with Topics
+
+4.3.3 Creating Topics
+---------------------
+
+‘N c p’ (‘forge-create-pullreq’)
+‘C-c C-n [on "Pull requests" section]’
+ This command creates a new pull-request for the current repository.
+
+‘N c i’ (‘forge-create-issue’)
+‘C-c C-n [on "Issues" section]’
+ This command creates a new issue for the current repository.
+
+\1f
+File: forge.info, Node: Editing Topics and Posts, Prev: Creating Topics, Up: Working with Topics
+
+4.3.4 Editing Topics and Posts
+------------------------------
+
+We call both issues and pull-requests "topics". The contributions to
+the conversation are called "posts". The post that initiated the
+conversation is also called a post.
+
+ These commands are available only from the topic buffer (i.e., from
+the buffer that shows the posts on a topic). Other commands that also
+work in other buffers are available here also. For example ‘C-c C-w’ on
+a post visits that post in a browser.
+
+‘C-c C-n’ (‘forge-create-post’)
+‘C-c C-r’
+ This command allows users to create a new post on an existing
+ topic. It opens a buffer in which the user can write the post.
+ When the post is done, then the user has to submit using ‘C-c C-c’.
+
+ If the region is active and marks part of an existing post, then
+ that part of the post is quoted. Otherwise, or if a prefix
+ argument is used, then the complete post that point is currently on
+ is quoted.
+
+‘C-c C-e [on a post section]’ (‘forge-edit-post’)
+ This command visits an existing post in a separate buffer. When
+ the changes to the post are done, then the user has to submit using
+ ‘C-c C-c’.
+
+‘C-c C-e [on "Title" section]’ (‘forge-edit-topic-title’)
+ This command reads a new title for an existing topic in the
+ minibuffer.
+
+‘C-c C-e [on "State" section]’ (‘forge-edit-topic-state’)
+ This command toggles the state of an existing topic between "open"
+ and "closed".
+
+‘C-c C-e [on "Draft" section]’ (‘forge-edit-topic-draft’)
+ This command toggles whether an existing topic is a draft or not.
+
+‘C-c C-e [on "Labels" section]’ (‘forge-edit-topic-labels’)
+ This command reads a list of labels for an existing topic in the
+ minibuffer.
+
+‘C-c C-e [on "Marks" section]’ (‘forge-edit-topic-marks’)
+ This command reads a list of marks for an existing topic in the
+ minibuffer.
+
+ Marks are like labels except that they are not shared with anyone
+ else. To create a mark that topics can subsequently be marked with
+ use the command ‘forge-create-mark’. Existing marks can be edited
+ using the command ‘forge-edit-mark’.
+
+‘C-c C-e [on "Assignees" section]’ (‘forge-edit-topic-assignees’)
+ This command reads a list of assignees for an existing topic in the
+ minibuffer.
+
+‘C-c C-e [on "Review-Requests" section]’ (‘forge-edit-topic-review-requests’)
+ This command reads a list of people who you would like to review an
+ existing topic in the minibuffer.
+
+‘C-c C-e [on "Note" section]’
+‘M-x forge-edit-topic-note’
+ This lets you edit your private note about a topic.
+
+‘C-c C-k [on a comment section]’ (‘forge-delete-comment’)
+ This command deletes the comment at point.
+
+‘m M [if enabled]’ (‘forge-merge’)
+‘N M [if enabled]’
+ This command merges the current pull-request using the forge’s API.
+ If there is no current pull-request or with a prefix argument, then
+ it reads a pull-request to visit instead.
+
+ The "merge method" to be used is read from the user.
+
+ Use of this command is discouraged. Unless the remote repository
+ 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.
+
+ Creating a new post and editing an existing post are similar to
+creating a new commit and editing the message of an existing commit. In
+both cases the message has to be written in a separate buffer and then
+the process has to be finished or canceled using a separate command.
+
+ The following commands are available in buffers used to edit posts:
+
+‘C-c C-c’ (‘forge-post-submit’)
+ This command submits the post that is being edited in the current
+ buffer.
+
+‘C-c C-k’ (‘forge-post-cancel’)
+ This command cancels the post that is being edited in the current
+ buffer.
+
+‘C-c C-e’ (‘forge-post-dispatch’)
+ This prefix command features the above two commands as suffixes,
+ and when creating a pull-request also the following command. More
+ suffix commands will likely be added in the future.
+
+‘C-c C-e d’ (‘forge-post-toggle-draft’)
+ This command toggles whether the pull-request being created is a
+ draft.
+
+\1f
+File: forge.info, Node: Miscellaneous, Prev: Working with Topics, Up: Usage
+
+4.4 Miscellaneous
+=================
+
+‘N c f’ (‘forge-fork’)
+ This command adds an additional remote to the current repository.
+ The remote can either point at an existing repository or one that
+ has to be created first by forking it to an account the user has
+ access to.
+
+ Currently this only supports Github and Gitlab.
+
+‘N a’ (‘forge-add-repository’)
+ This command reads a repository from the user and adds it to the
+ database. The repository can be provided as a URL, a name, or in
+ the form OWNER/NAME. This is subject to ‘magit-clone-name-alist’.
+
+ This command offers to either pull topics (now and in the future)
+ or to only pull individual topics when the user invokes
+ ‘forge-pull-topic’.
+
+‘N t t’ (‘forge-toggle-display-in-status-buffer’)
+ This command toggles whether any topics are displayed in the
+ current Magit status buffer.
+
+‘N t c’ (‘forge-toggle-closed-visibility’)
+ This command toggles whether closed topics are shown in the Magit
+ status buffer.
+
+ -- Command: forge-add-user-repositories
+ This command reads a host and a username from the user and adds all
+ of that user’s repositories on that host to the local database.
+
+ This may take a while. Only Github is supported at the moment.
+
+ -- Command: forge-add-organization-repositories
+ This command reads a host and an organization from the user and
+ adds all the organization’s repositories on that host to the local
+ database.
+
+ This may take a while. Only Github is supported at the moment.
+
+ -- Command: forge-remove-repository
+ This command reads a repository and removes it from the local
+ database.
+
+ -- Command: forge-remove-topic-locally
+ This command reads a topic and removes it from the local database.
+ The topic is not removed from the forge and, if it is later
+ modified, then it will be added to the database again.
+
+ 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.
+
+ -- Command: forge-reset-database
+ This command moves the current database file to the trash and
+ creates a new empty database.
+
+ This is useful after the database’s table schemata have changed,
+ which will happen a few times while the Forge functionality is
+ still under heavy development.
+
+\1f
+File: forge.info, Node: FAQ, Next: Keystroke Index, Prev: Usage, Up: Top
+
+Appendix A FAQ
+**************
+
+This section lists some frequently asked questions. Please also see
+<https://github.com/magit/forge/wiki/FAQ> for an extended list of common
+issues.
+
+* Menu:
+
+* Is it possible to create a single pull-request without pulling everything?::
+* ‘error in process filter HTTP Error 502, "Bad gateway"’: error in process filter HTTP Error 502 "Bad gateway".
+
+\1f
+File: forge.info, Node: Is it possible to create a single pull-request without pulling everything?, Next: error in process filter HTTP Error 502 "Bad gateway", Up: FAQ
+
+A.1 Is it possible to create a single pull-request without pulling everything?
+==============================================================================
+
+Yes. ‘M-x forge-add-repository’ offers to add a repository to the
+database without also fetching all pull-requests and issues.
+
+\1f
+File: forge.info, Node: error in process filter HTTP Error 502 "Bad gateway", Prev: Is it possible to create a single pull-request without pulling everything?, Up: FAQ
+
+A.2 ‘error in process filter: HTTP Error: 502, "Bad gateway"’
+=============================================================
+
+This is a frequently occurring error. Adding some formatting the full
+error is:
+
+ error in process filter: ghub--signal-error: HTTP Error: 502,
+ "Bad gateway", "/graphql",
+ ((data . "null")
+ (errors ((message . "Something went wrong while executing your query.
+ This may be the result of a timeout, or it could be a GitHub bug.
+ Please include `CC2C:4FEA:A1771C1:CBF40CE:5C33F7E5`
+ when reporting this issue."))))
+
+ This indicates that something went wrong within Github’s network.
+See
+<https://en.wikipedia.org/wiki/List_of_HTTP_status_codes#5xx_server_errors>.
+The appended error message also says as much: "This may be the result of
+a timeout, or it could be a GitHub bug."
+
+ It appears that this happens more often in big repositories,
+especially during the initial pull, but this may be an illusion; it is
+known to also happens for smaller, incremental requests.
+
+ I believe that more data just means more requests and thus more
+opportunities for things to go wrong. It seems unlikely that this is
+due to us requesting too much data at once (in that case we would get a
+different error from GraphQL, not HTTP). When fetching lots of data,
+then we do not request one large response but make many requests and we
+then collect the many responses (pagination forces us to do that).
+
+ The timeout may be due to many requests from other people arriving at
+some Github-internal bottleneck at the same time, or it may be due to
+cold caches and overly aggressive timeouts. We just don’t know; it’s
+their infrastructure.
+
+ The second problem is that we currently simply error out if we get
+this error. This could be changed and eventually it will be, but for
+the time being your only option is to just try again, possibly
+repeatedly and possibly after a delay to give whatever congestion may
+exist on the other end a chance to clear or to give their caches a
+chance to warm up.
+
+ This was also discussed in <https://github.com/magit/forge/issues/20>
+and <https://github.com/magit/ghub/issues/83>.
+
+\1f
+File: forge.info, Node: Keystroke Index, Next: Function and Command Index, Prev: FAQ, Up: Top
+
+Appendix B Keystroke Index
+**************************
+
+\0\b[index\0\b]
+* Menu:
+
+* b F: Branching. (line 13)
+* b f: Branching. (line 102)
+* C-c C-c: Editing Topics and Posts.
+ (line 92)
+* C-c C-e: Editing Topics and Posts.
+ (line 100)
+* C-c C-e d: Editing Topics and Posts.
+ (line 105)
+* C-c C-e [on "Assignees" section]: Editing Topics and Posts.
+ (line 56)
+* C-c C-e [on "Draft" section]: Editing Topics and Posts.
+ (line 40)
+* C-c C-e [on "Labels" section]: Editing Topics and Posts.
+ (line 43)
+* C-c C-e [on "Marks" section]: Editing Topics and Posts.
+ (line 47)
+* C-c C-e [on "Note" section]: Editing Topics and Posts.
+ (line 65)
+* C-c C-e [on "Review-Requests" section]: Editing Topics and Posts.
+ (line 60)
+* C-c C-e [on "State" section]: Editing Topics and Posts.
+ (line 36)
+* C-c C-e [on "Title" section]: Editing Topics and Posts.
+ (line 32)
+* C-c C-e [on a post section]: Editing Topics and Posts.
+ (line 27)
+* C-c C-k: Editing Topics and Posts.
+ (line 96)
+* C-c C-k [on a comment section]: Editing Topics and Posts.
+ (line 68)
+* C-c C-n: Editing Topics and Posts.
+ (line 17)
+* C-c C-n [on "Issues" section]: Creating Topics. (line 12)
+* C-c C-n [on "Pull requests" section]: Creating Topics. (line 8)
+* C-c C-r: Editing Topics and Posts.
+ (line 17)
+* C-c C-v: Visiting Topics. (line 36)
+* C-c C-w: Visiting Topics. (line 22)
+* C-c C-w <1>: Visiting Topics. (line 22)
+* f n: Pulling. (line 13)
+* f N: Pulling. (line 25)
+* m M [if enabled]: Editing Topics and Posts.
+ (line 72)
+* N: Usage. (line 23)
+* N a: Usage. (line 13)
+* N a <1>: Miscellaneous. (line 15)
+* N b I: Visiting Topics. (line 22)
+* N b i: Visiting Topics. (line 22)
+* N b P: Visiting Topics. (line 22)
+* N b p: Visiting Topics. (line 22)
+* N b r: Visiting Topics. (line 22)
+* N b t: Visiting Topics. (line 22)
+* N c f: Miscellaneous. (line 7)
+* N c i: Creating Topics. (line 12)
+* N c p: Creating Topics. (line 8)
+* N f f: Pulling. (line 13)
+* N f n: Pulling. (line 25)
+* N f t: Pulling. (line 47)
+* N l i: Listing Topics and Notifications.
+ (line 72)
+* N l n: Listing Topics and Notifications.
+ (line 64)
+* N l p: Listing Topics and Notifications.
+ (line 68)
+* N l r: Listing Topics and Notifications.
+ (line 61)
+* N M [if enabled]: Editing Topics and Posts.
+ (line 72)
+* N r: Repository Detection.
+ (line 80)
+* N t c: Miscellaneous. (line 28)
+* N t t: Miscellaneous. (line 24)
+* N v i: Visiting Topics. (line 36)
+* N v p: Visiting Topics. (line 36)
+* N v t: Visiting Topics. (line 36)
+* RET: Visiting Topics. (line 36)
+* Z n: Branching. (line 107)
+
+\1f
+File: forge.info, Node: Function and Command Index, Next: Variable Index, Prev: Keystroke Index, Up: Top
+
+Appendix C Function and Command Index
+*************************************
+
+\0\b[index\0\b]
+* Menu:
+
+* forge-add-organization-repositories: Miscellaneous. (line 37)
+* forge-add-repository: Usage. (line 13)
+* forge-add-repository <1>: Miscellaneous. (line 15)
+* forge-add-user-repositories: Miscellaneous. (line 31)
+* forge-branch-pullreq: Branching. (line 13)
+* forge-browse-dwim: Visiting Topics. (line 22)
+* forge-browse-issue: Visiting Topics. (line 22)
+* forge-browse-issues: Visiting Topics. (line 22)
+* forge-browse-pullreq: Visiting Topics. (line 22)
+* forge-browse-pullreqs: Visiting Topics. (line 22)
+* forge-browse-remote: Visiting Topics. (line 22)
+* forge-browse-topic: Visiting Topics. (line 22)
+* forge-browse-TYPE: Visiting Topics. (line 22)
+* forge-checkout-pullreq: Branching. (line 102)
+* forge-checkout-worktree: Branching. (line 107)
+* forge-create-issue: Creating Topics. (line 12)
+* forge-create-post: Editing Topics and Posts.
+ (line 17)
+* forge-create-pullreq: Creating Topics. (line 8)
+* forge-delete-comment: Editing Topics and Posts.
+ (line 68)
+* forge-dispatch: Usage. (line 23)
+* forge-edit-post: Editing Topics and Posts.
+ (line 27)
+* forge-edit-topic-assignees: Editing Topics and Posts.
+ (line 56)
+* forge-edit-topic-draft: Editing Topics and Posts.
+ (line 40)
+* forge-edit-topic-labels: Editing Topics and Posts.
+ (line 43)
+* forge-edit-topic-marks: Editing Topics and Posts.
+ (line 47)
+* forge-edit-topic-note: Editing Topics and Posts.
+ (line 65)
+* forge-edit-topic-review-requests: Editing Topics and Posts.
+ (line 60)
+* forge-edit-topic-state: Editing Topics and Posts.
+ (line 36)
+* forge-edit-topic-title: Editing Topics and Posts.
+ (line 32)
+* forge-forge.remote: Repository Detection.
+ (line 80)
+* forge-fork: Miscellaneous. (line 7)
+* forge-insert-assigned-issues: Listing Topics and Notifications.
+ (line 49)
+* forge-insert-assigned-pullreqs: Listing Topics and Notifications.
+ (line 37)
+* forge-insert-authored-issues: Listing Topics and Notifications.
+ (line 53)
+* forge-insert-authored-pullreqs: Listing Topics and Notifications.
+ (line 45)
+* forge-insert-issues: Listing Topics and Notifications.
+ (line 16)
+* forge-insert-pullreqs: Listing Topics and Notifications.
+ (line 12)
+* forge-insert-requested-reviews: Listing Topics and Notifications.
+ (line 41)
+* forge-list-assigned-issues: Listing Topics and Notifications.
+ (line 87)
+* forge-list-assigned-pullreqs: Listing Topics and Notifications.
+ (line 83)
+* forge-list-authored-issues: Listing Topics and Notifications.
+ (line 99)
+* forge-list-authored-pullreqs: Listing Topics and Notifications.
+ (line 95)
+* forge-list-issues: Listing Topics and Notifications.
+ (line 72)
+* forge-list-labeled-issues: Listing Topics and Notifications.
+ (line 79)
+* forge-list-labeled-pullreqs: Listing Topics and Notifications.
+ (line 75)
+* forge-list-notifications: Listing Topics and Notifications.
+ (line 64)
+* forge-list-owned-issues: Listing Topics and Notifications.
+ (line 109)
+* forge-list-owned-pullreqs: Listing Topics and Notifications.
+ (line 103)
+* forge-list-pullreqs: Listing Topics and Notifications.
+ (line 68)
+* forge-list-repositories: Listing Topics and Notifications.
+ (line 61)
+* forge-list-requested-reviews: Listing Topics and Notifications.
+ (line 91)
+* forge-merge: Editing Topics and Posts.
+ (line 72)
+* forge-post-cancel: Editing Topics and Posts.
+ (line 96)
+* forge-post-dispatch: Editing Topics and Posts.
+ (line 100)
+* forge-post-submit: Editing Topics and Posts.
+ (line 92)
+* forge-post-toggle-draft: Editing Topics and Posts.
+ (line 105)
+* forge-pull: Pulling. (line 13)
+* forge-pull-notifications: Pulling. (line 25)
+* forge-pull-topic: Pulling. (line 47)
+* forge-remove-repository: Miscellaneous. (line 44)
+* forge-remove-topic-locally: Miscellaneous. (line 48)
+* forge-reset-database: Miscellaneous. (line 58)
+* forge-toggle-closed-visibility: Listing Topics and Notifications.
+ (line 30)
+* forge-toggle-closed-visibility <1>: Miscellaneous. (line 28)
+* forge-toggle-display-in-status-buffer: Miscellaneous. (line 24)
+* forge-visit-issue: Visiting Topics. (line 36)
+* forge-visit-pullreq: Visiting Topics. (line 36)
+* forge-visit-topic: Visiting Topics. (line 36)
+* forge-visit-TYPE: Visiting Topics. (line 36)
+
+\1f
+File: forge.info, Node: Variable Index, Prev: Function and Command Index, Up: Top
+
+Appendix D Variable Index
+*************************
+
+\0\b[index\0\b]
+* Menu:
+
+* forge-alist: Repository Detection.
+ (line 92)
+* forge-checkout-worktree-read-directory-function: Branching. (line 111)
+* forge-owned-accounts: Listing Topics and Notifications.
+ (line 115)
+* forge-owned-ignored: Listing Topics and Notifications.
+ (line 130)
+* forge-topic-list-limit: Listing Topics and Notifications.
+ (line 19)
+* forge.remote: Repository Detection.
+ (line 66)
+
+
+\1f
+Tag Table:
+Node: Top\7f771
+Node: Introduction\7f2475
+Node: Supported Forges and Hosts\7f3038
+Node: Supported Forges\7f4323
+Ref: Github\7f4479
+Ref: Github Caveats\7f4622
+Ref: Github Hosts\7f5268
+Ref: Gitlab\7f5324
+Ref: Gitlab Caveats\7f5339
+Ref: Gitlab Hosts\7f5464
+Node: Partially Supported Forges\7f5584
+Ref: Gitea https//giteaio\7f5790
+Ref: Gitea Hosts\7f5890
+Ref: Gogs https//gogsio\7f5946
+Ref: Gogs Hosts\7f6149
+Ref: Bitbucket https//bitbucketorg\7f6207
+Ref: Bitbucket Caveats\7f6405
+Ref: Bitbucket Hosts\7f7302
+Node: Supported Semi-Forges\7f7367
+Ref: Gitweb https//git-scmcom/docs/gitweb\7f7538
+Ref: Gitweb Caveats\7f7617
+Ref: Cgit https//gitzx2c4com/cgit/about\7f7857
+Ref: Cgit Caveats\7f7934
+Ref: Cgit Hosts\7f8283
+Ref: Stgit https//codemadnessorg/git/stagit/file/READMEhtml\7f8410
+Ref: Stgit Caveats\7f8527
+Ref: Stgit Hosts\7f8813
+Ref: Srht https//metasrht\7f8873
+Ref: Srht Caveats\7f8922
+Ref: Srht Hosts\7f9205
+Node: Getting Started\7f9256
+Node: Loading Forge\7f10254
+Node: Token Creation\7f10649
+Node: Initial Pull\7f11928
+Node: Repository Detection\7f13323
+Node: Caveats\7f18690
+Node: Usage\7f19616
+Node: Pulling\7f21088
+Node: Branching\7f23771
+Node: Working with Topics\7f30166
+Node: Visiting Topics\7f30539
+Node: Listing Topics and Notifications\7f32616
+Node: Creating Topics\7f37930
+Node: Editing Topics and Posts\7f38419
+Node: Miscellaneous\7f42946
+Node: FAQ\7f45569
+Node: Is it possible to create a single pull-request without pulling everything?\7f46037
+Node: error in process filter HTTP Error 502 "Bad gateway"\7f46503
+Node: Keystroke Index\7f48874
+Node: Function and Command Index\7f54564
+Node: Variable Index\7f62522
+\1f
+End Tag Table
+
+\1f
+Local Variables:
+coding: utf-8
+End:
projects / emacsconfig.git / commitdiff