;;; forge-commands.el --- Commands  -*- lexical-binding:t -*-

;; Copyright (C) 2018-2026 Jonas Bernoulli

;; Author: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.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."
  :transient-non-suffix #'transient--do-call
  :refresh-suffixes t
  :environment #'forge--menu-environment
  :column-widths forge--topic-menus-column-widths
  [forge--topic-menus-group
   ["Fetch"
    ("f f" "all topics"     forge-pull)
    ("f t" "one topic"      forge-pull-topic)
    ("f n" "notifications"  forge-pull-notifications)]
   ["Create"
    :if (##forge-get-repository :tracked?)
    ("c d" "discussion"     forge-create-discussion)
    ("c i" "issue"          forge-create-issue)
    ("c p" "pull-request"   forge-create-pullreq)
    ("c u" "pr from issue"  forge-create-pullreq-from-issue)
    ("c f" "fork or remote" forge-fork)]
   [:description (lambda ()
                   (cond
                     ((forge-get-repository :tracked?) "Actions")
                     ((or (magit-gitdir) (forge-repository-at-point))
                      "Forge does not yet track this repository")
                     ("Not inside a Git repository")))
    ("/ a" forge-add-repository
     :description (lambda () (let ((repo (forge-get-repository :stub?)))
                          (if (or (not repo)
                                  (eq (oref repo condition) :tracked))
                              "track some repo"
                            "track this repository"))))
    ("c f" "fork this repository" forge-fork
     :if-not (##forge-get-repository :tracked?))
    ("/ M" "merge with api" forge-merge
     :if (##forge-get-repository :tracked?)
     :level 7)]]
  [forge--lists-group
   ["Visit"
    :inapt-if-not (##forge-get-repository :tracked?)
    ("v t" "topic"          forge-visit-topic)
    ("v u" "topic from url" forge-visit-topic-from-url :level 0)
    ("v d" "discussion"     forge-visit-discussion)
    ("v i" "issue"          forge-visit-issue)
    ("v p" "pull-request"   forge-visit-pullreq)]
   ["Browse"
    ("b t" "topic"          forge-browse-topic
     :inapt-if-not (##forge-get-repository :tracked?))
    ("b i" "issue"          forge-browse-issue
     :inapt-if-not (##forge-get-repository :tracked?))
    ("b p" "pull-request"   forge-browse-pullreq
     :inapt-if-not (##forge-get-repository :tracked?))
    ("b r" "remote"         forge-browse-remote)
    ("b I" "issues"         forge-browse-issues)
    ("b P" "pull-requests"  forge-browse-pullreqs)
    ""]
   ["Display"
    ("-S" forge-toggle-display-in-status-buffer
     :inapt-if-not forge--buffer-with-topics-sections-p)
    ("-H" forge-toggle-topic-legend)]]
  [forge--topic-legend-group])

(transient-augment-suffix forge-dispatch
  :transient #'transient--do-replace
  :inapt-if (##eq (oref transient--prefix command) 'forge-dispatch)
  :inapt-face 'forge-suffix-active)

;;;###autoload(autoload 'forge-configure "forge-commands" nil t)
(transient-define-prefix forge-configure ()
  "Configure current repository and global settings."
  :transient-non-suffix #'transient--do-call
  :refresh-suffixes t
  :environment #'forge--menu-environment
  :column-widths forge--topic-menus-column-widths
  [forge--topic-menus-group
   ["Configure"
    ("R  " forge-add-pullreq-refspec)
    ("s r" forge-forge.remote)
    ("s l" forge-forge.graphqlItemLimit)]])

(transient-augment-suffix forge-configure
  :transient #'transient--do-replace
  :inapt-if (##eq (oref transient--prefix command) 'forge-configure)
  :inapt-face 'forge-suffix-active)

;;; Pull

;;;###autoload(autoload 'forge-pull "forge-commands" nil t)
(transient-define-suffix 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'."
  :description (lambda ()
                 (if (forge-get-repository :tracked?)
                     "forge topics"
                   "new forge repository"))
  (interactive)
  (if-let ((repo (forge-get-repository :tracked?)))
      (forge--pull repo)
    (transient-setup 'forge-add-repository nil nil
                     :scope (forge-add-repository--scope))))

(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)
  (cond-let
    ((buffer-live-p buffer)
     (with-current-buffer buffer
       (if (and (derived-mode-p 'magit-mode)
                (forge-repository-equal (forge-get-repository :stub?) repo)
                (magit-toplevel))
           (magit-git-fetch (oref repo remote) (magit-fetch-arguments))
         (magit-refresh-buffer))))
    ([worktree (forge-get-worktree repo)]
     (let ((default-directory worktree)
           (magit-inhibit-refresh t))
       (magit-git-fetch (oref repo remote) (magit-fetch-arguments))))))

;;;###autoload(autoload 'forge-pull-notifications "forge-commands" nil t)
(transient-define-suffix forge-pull-notifications ()
  "Fetch notifications for all repositories from the current forge."
  :description "forge notifications"
  (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 (lambda () (and (forge-get-repository :tracked?)
                           (forge--get-github-repository)))
  (interactive
    (list (read-number "Pull topic: "
                       (and$ (forge-current-topic) (oref $ 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-discussions ()
  "Visit the current repository's discussions using a browser."
  (interactive)
  (browse-url (forge--format (forge-get-repository :stub)
                             'discussions-url-format)))

;;;###autoload
(defun forge-browse-issues ()
  "Visit the current repository's issues using a browser."
  (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-discussion (discussion)
  "Read a DISCUSSION and visit it using a browser.
By default only offer open discussions but with a prefix argument
also offer closed issues."
  (interactive (list (forge-read-discussion "Browse discussion")))
  (forge--browse-topic discussion))

;;;###autoload
(defun forge-browse-issue (issue)
  "Read an ISSUE and visit it using a browser.
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
(defun forge-browse-blob (commit file &optional line end force-hash)
  "Visit a blob using a browser.

When invoked from a blob- or file-visiting buffer, visit that blob
without prompting.  If the region is active, try to jump to the marked
line or lines, and highlight them in the browser.  To what extend that
is possible depends on the forge.  When the region is not active just
visit the blob, without trying to jump to the current line.  When
jumping to a line, always use a commit hash as part of the URL.  From
a file in the worktree with no active region, instead use the branch
name as part of the URL, unless a prefix argument is used.

When invoked from a Dired buffer, visit the blob at point without
prompting. If a prefix argument is used, the commit hash is included
in the URL.

When invoked from any other buffer, prompt the user for a branch or
commit, and for a file."
  (interactive (forge--browse-blob-args))
  (browse-url (forge-get-url :blob commit file line end force-hash)))

;;;###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 thing at point or the thing visited in the current buffer."
  (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$ (magit--painted-branch-at-point) (forge-get-url :branch $))
      (and$ (magit-commit-at-point)          (forge-get-url :commit $))
      (and$ (magit-branch-at-point)          (forge-get-url :branch $))
      (and$ (magit-remote-at-point)          (forge-get-url :remote $))
      (and$ (magit-file-at-point)            (forge-get-url :blob nil $))
      (forge-post-at-point)
      (forge-current-topic)
      (and (or magit-buffer-file-name
               buffer-file-name
               (derived-mode-p 'dired-mode))
           (apply #'forge-get-url :blob (forge--browse-blob-args)))
      (and magit-buffer-revision
           (forge-get-url :commit magit-buffer-revision))
      (forge-get-repository :stub?)))

(defun forge--browse-blob-args ()
  (cond
    (magit-buffer-file-name
     `(,(or magit-buffer-refname magit-buffer-revision)
       ,(magit-file-relative-name magit-buffer-file-name)
       ,@(or (magit-file-region-line-numbers) (list nil nil))
       ,current-prefix-arg))
    (buffer-file-name
     `(nil
       ,(magit-file-relative-name buffer-file-name)
       ,@(or (magit-file-region-line-numbers) (list nil nil))
       ,current-prefix-arg))
    ((derived-mode-p 'dired-mode)
     `(nil
       ,(magit-file-relative-name (dired-get-filename))
       nil nil ,current-prefix-arg))
    ((let ((commit (magit-read-local-branch-or-commit
                    "Browse file from commit")))
       (list commit (magit-read-file-from-rev commit "Browse file"))))))

;;;; Urls

(cl-defgeneric forge-get-url (obj)
  "Return the URL for a forge object.")

(cl-defmethod forge-get-url ((disc forge-discussion))
  (forge--format disc 'discussion-url-format))

(cl-defmethod forge-get-url ((issue forge-issue))
  (forge--format issue 'issue-url-format))

(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)
  (when (member commit '(nil "{worktree}" "{index}"))
    (setq commit (or (magit-get-current-branch) "HEAD")))
  (let ((repo (forge-get-repository :stub)))
    (cond-let*
      ((magit-list-containing-branches
        commit "-r" (concat (oref repo remote) "/*")))
      ([branch (car (magit-list-containing-branches commit "-r"))]
       [remote (car (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 :blob)) commit file
                             &optional line end force-hash)
  (cl-assert (stringp file))
  (when (member commit '(nil "{worktree}" "{index}"))
    (setq commit (or (magit-get-current-branch) "HEAD")))
  (let* ((commit (or (and (magit-branch-p commit)
                          (cdr (magit-split-branch-name commit)))
                     (magit-commit-p commit)
                     (and (not (or line force-hash))
                          (magit-get-current-branch))
                     (magit-rev-parse "HEAD")))
         (repo   (forge-get-repository :stub))
         (format (oref repo blob-url-format)))
    (when (cl-typep repo 'forge-gitweb-repository)
      (setq commit (concat (if (magit-branch-p commit) "hb=" "h=") commit)))
    (concat
     (forge--format repo format `((?r . ,commit) (?f . ,file)))
     (and line (forge-format-blob-lines repo line
                                        (and (not (equal line end)) end))))))

(cl-defmethod forge-get-url ((_(eql :branch)) branch)
  (cl-assert (stringp branch))
  (let (remote)
    (cond ((magit-remote-branch-p branch)
           (pcase-setq `(,remote . ,branch) (magit-split-branch-name branch)))
          ((not (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)
  (cl-assert (stringp 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-discussion)
                               'discussion-post-url-format)
                              ((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))

;; Transitional kludge for the infamous package.el defect.
(require 'forge-forgejo)

(cl-defmethod forge-format-blob-lines ((repo forge-repository) line end)
  (cl-etypecase repo ;Third-party classes require separate methods.
    ((or forge-github-repository
         forge-gitlab-repository ;Also supports "#L%s-%s".
         forge-forgejo-repository
         forge-gitea-repository
         forge-gogs-repository)
     (format (if end "#L%s-L%s" "#L%s") line end))
    (forge-bitbucket-repository
     (format (if end "#lines-%s:%s" "#lines-%s") line end))
    ((or forge-cgit-repository
         forge-cgit*-repository
         forge-cgit**-repository)
     (format "#n%s" line))
    ((or forge-gitweb-repository
         forge-repoorcz-repository
         forge-stagit-repository)
     (format "#l%s" line))
    (forge-srht-repository
     (format "#L%s" line))))

;;; Visit

;;;###autoload
(defun forge-visit-topic (topic)
  "Read a TOPIC and visit it.
By default only offer active topics for completion.  With a prefix
argument offer all topics.  While completion is in progress, \
\\<forge-read-topic-minibuffer-map>\\[forge-read-topic-lift-limit] lifts
the limitation to active topics."
  (interactive (list (forge-read-topic "View topic")))
  (forge-topic-setup-buffer (forge-get-topic topic)))

;;;###autoload
(defun forge-visit-discussion (discussion)
  "Read a DISCUSSION and visit it.
By default only offer active topics for completion.  With a prefix
argument offer all topics.  While completion is in progress, \
\\<forge-read-topic-minibuffer-map>\\[forge-read-topic-lift-limit] lifts
the limitation to active topics."
  (interactive (list (forge-read-discussion "View discussion")))
  (forge-topic-setup-buffer (forge-get-discussion discussion)))

;;;###autoload
(defun forge-visit-issue (issue)
  "Read an ISSUE and visit it.
By default only offer active issues for completion.  With a prefix
argument offer all topics.  While completion is in progress, \
\\<forge-read-topic-minibuffer-map>\\[forge-read-topic-lift-limit] lifts
the limitation to active issues."
  (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 active pull-requests for completion.  With a
prefix argument offer all topics.  While completion is in progress,
\\<forge-read-topic-minibuffer-map>\\[forge-read-topic-lift-limit] \
lifts the limitation to active pull-requests."
  (interactive (list (forge-read-pullreq "View pull-request")))
  (forge-topic-setup-buffer (forge-get-pullreq pull-request)))

;;;###autoload
(defun forge-visit-topic-from-url (url)
  "Visit the topic specified by web URL."
  (interactive (list (read-string "Topic URL: ")))
  (if (string-match
       "/\\(issues\\|pull\\|discussions\\|merge_requests\\)/\\([0-9]+\\)\\'"
       url)
      (forge-topic-setup-buffer
       (forge-get-topic (forge-get-repository
                         (substring url 0 (match-beginning 1))
                         nil :tracked)
                        (string-to-number (match-string 2 url))))
    (user-error "Not recognized as a topic URL: %s" url)))

;;;###autoload
(defun forge-visit-this-topic (&optional menu)
  "Visit the topic at point.
With prefix argument MENU, also show the topic menu."
  (interactive (list current-prefix-arg))
  (forge-topic-setup-buffer (forge-topic-at-point))
  (cond
    ((eq transient-current-command 'forge-topic-menu)
     (setq forge--quit-keep-topic-menu t))
    ((or menu
         (memq transient-current-command
               '(forge-topics-menu forge-notifications-menu)))
     (transient-setup 'forge-topic-menu))))

;;;###autoload
(defun forge-visit-this-repository ()
  "Visit the repository at point."
  (interactive)
  (let* ((repo (forge-repository-at-point))
         (worktree (forge-get-worktree repo)))
    (cond
      ((and (eq transient-current-command 'forge-repositories-menu)
            (forge-get-repository repo nil :tracked?))
       (cond-let
         ([buffer (get-buffer (forge-topics-buffer-name repo))]
          (switch-to-buffer buffer)
          (transient-setup 'forge-topics-menu))
         ((forge-list-topics repo))))
      (worktree
       (magit-status-setup-buffer worktree))
      ((forge-get-repository repo nil :tracked?)
       (forge-list-topics repo))
      ((user-error "Not tracked and location of clone is unknown")))))

;;; Create

(defun forge-create-discussion (category)
  "Create a new discussion for the current repository."
  (interactive
    (list (forge-read-topic-category nil "Category for new discussion")))
  (forge--setup-post-buffer 'new-discussion #'forge--submit-create-discussion
    "new-discussion" "Create new discussion on %p"
    `((forge--buffer-category ,category))))

(defun forge-create-issue (template)
  "Create a new issue for the current repository."
  (interactive (list (forge--topic-template nil 'forge-issue)))
  (let-alist template
    (pcase-exhaustive .type
      ('redirect (browse-url .url))
      ('forge-discussion (forge-create-discussion .category))
      ('forge-issue
       (forge--setup-post-buffer 'new-issue #'forge--submit-create-issue
         "new-issue" "Create new issue on %p"
         `((forge--buffer-template ,template)))))))

(defun forge-create-pullreq (source target)
  "Create a new pull-request for the current repository."
  (interactive (forge-create-pullreq--read-args))
  (forge--setup-post-buffer 'new-pullreq #'forge--submit-create-pullreq
    "new-pullreq" "Create new pull-request on %p"
    `((forge--buffer-base-branch ,target)
      (forge--buffer-head-branch ,source)
      (forge--buffer-template    ,(forge--topic-template nil 'forge-pullreq)))))

(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 ()
        (and (forge--get-github-repository)
             (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* ((repo (forge-get-repository :tracked))
         (_ (unless (oref repo worktree)
              (user-error "Cannot create pull-request without working tree")))
         (source  (magit-completing-read
                   "Source branch"
                   (magit-list-remote-branch-names)
                   nil t nil 'magit-revision-history
                   (or (and$ (magit-branch-at-point)
                             (if (magit-remote-branch-p $)
                                 $
                               (magit-get-push-branch $ t)))
                       (and$ (magit-get-current-branch)
                             (if (magit-remote-branch-p $)
                                 $
                               (magit-get-push-branch $ t))))))
         (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
                   (or (and$ (cdr (magit-split-branch-name source))
                             (and (magit-branch-p $)
                                  (magit-get-upstream-branch $))
                             (if (magit-remote-branch-p $)
                                 $
                               (magit-get-upstream-branch $))
                             (car (member $ targets)))
                       (seq-some (##car (member (concat remote "/" %) targets))
                                 (delete-dups
                                  (cons (oref repo default-branch)
                                        magit-main-branch-names)))))))
    (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* ((quote (cond
                  ((not (magit-section-match 'post)) nil)
                  ((use-region-p)
                   (buffer-str (region-beginning) (region-end)))
                  (quote
                   (with-slots (content end) (magit-current-section)
                     (string-trim (buffer-str content end))))))
         (quote (and quote
                     (lambda ()
                       (goto-char (point-max))
                       (unless (bobp)
                         (insert "\n"))
                       (insert (replace-regexp-in-string "^" "> " quote))
                       (insert "\n\n"))))
         (obj (if (forge-discussion-p forge-buffer-topic)
                  (forge--select-discussion-reply-target)
                forge-buffer-topic)))
    (cl-typecase obj
      (forge-discussion-post
       (forge--setup-post-buffer obj #'forge--submit-create-post
         "%i;%I;new-reply" "New comment on #%i;%I of %p" nil quote))
      (forge-discussion
       (forge--setup-post-buffer obj #'forge--submit-create-post
         "%i;new-answer" "New comment on #%i of %p" nil quote))
      (t
       (forge--setup-post-buffer obj #'forge--submit-create-post
         "%i;new-comment" "New comment on #%i of %p" nil quote)))))

(transient-define-suffix forge-approve-pullreq ()
  "Approve the current pull-request."
  :description "approve pull-request"
  :inapt-if-not #'forge-current-pullreq
  :transient nil
  (interactive)
  (let ((pullreq (forge-current-pullreq t)))
    (unless (forge-github-repository-p (forge-get-repository pullreq))
      (user-error "This command is only available for Github"))
    (forge--setup-post-buffer pullreq #'forge--submit-approve-pullreq
      "%i;new-approval" "Approve pull-request #%i of %p")))

(transient-define-suffix forge-request-changes ()
  "Request changes to the current pull-request."
  :description "request changes"
  :inapt-if-not #'forge-current-pullreq
  :transient nil
  (interactive)
  (let ((pullreq (forge-current-pullreq t)))
    (unless (forge-github-repository-p (forge-get-repository pullreq))
      (user-error "This command is only available for Github"))
    (forge--setup-post-buffer pullreq #'forge--submit-request-changes
      "%i;new-request" "Request changes for pull-request #%i of %p")))

;;; Edit

(defun forge-edit-post ()
  "Edit the current post."
  (interactive)
  (let ((post (forge-post-at-point t)))
    (cl-typecase post
      (forge-topic
       (forge--setup-post-buffer post #'forge--submit-edit-post
         "%i" "Edit #%i of %p" nil
         (lambda ()
           (insert "# " (oref post title) "\n\n")
           (insert (oref post body)))))
      (forge-post
       (forge--setup-post-buffer post #'forge--submit-edit-post
         "%i;%I" "Edit comment on #%i of %p" nil
         (lambda ()
           (insert (oref post body))))))))

(transient-define-suffix forge-edit-topic-note ()
  "Edit your private note about the current topic."
  :transient #'transient--do-quit-all
  :inapt-if-not #'forge-current-topic
  :description
  (lambda ()
    (if-let ((topic (forge-current-topic)))
        (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)
  (if-let* ((topic (forge-current-topic t))
            (repo (forge-get-repository topic))
            (default-directory (forge-get-worktree repo)))
      (forge--setup-post-buffer topic #'forge--save-note
        "%i;note" "New note on #%i of %p" nil
        (lambda ()
          (when-let ((note (oref topic note)))
            (save-excursion (insert note ?\n)))))
    (message "Cannot determine topic or worktree")))

;;; 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)))
        (prog1 branch
          (message "Branch %S already exists and is configured" branch))
      (forge--branch-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"
                  "an 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(autoload 'forge-checkout-this-pullreq "forge-commands" nil t)
(transient-define-suffix forge-checkout-this-pullreq ()
  "Checkout the current pull-request.
If the branch for that pull-request does not exist yet, then create and
configure it first."
  :description "checkout"
  :inapt-if-not #'forge-current-pullreq
  (interactive)
  (forge-checkout-pullreq (forge-current-topic t)))

;;;###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))

;;;###autoload(autoload 'forge-push-to-unnamed-pullreq "forge-commands" nil t)
(transient-define-suffix forge-push-to-unnamed-pullreq (args)
  "Push the current branch to the branch on the contributor's fork.

Usually a maintainer would use `magit-push-current-to-pushremote' to
push to the branch, the contributor asks to be merged.  That does not
work if they did not create a dedicated branch and instead committed
directly to \"main\", or some other branch, that also exists in the
upstream repository.

If this is the case then the branch, which is used to check out the
pull-request locally, is named \"pr-N\" (where N is the pull-request
number) and this command is made available as a substitute in the
`magit-push' menu."
  :if (lambda ()
        (and-let ((branch (magit-get-current-branch)))
          (and (forge-get-pullreq :branch branch)
               (string-match-p "\\`pr-[0-9]+\\'" branch))))
  :description (lambda ()
                 (and-let* ((branch (magit-get-current-branch))
                            (pullreq (forge-get-pullreq :branch branch)))
                   (format "contributor's %s branch"
                           (magit--propertize-face
                            (format "%s/%s"
                                    (oref pullreq head-user)
                                    (oref pullreq head-ref))
                            'magit-branch-remote))))
  (interactive (list (magit-push-arguments)))
  (cond-let*
    ([branch (magit-get-current-branch)]
     [pullreq (forge-get-pullreq :branch branch)]
     (run-hooks 'magit-credential-hook)
     (magit-run-git-async "push" "-v"
                          (delete "--tags" (delete "--follow-tags" args))
                          (oref pullreq head-user)
                          (format "%s:%s" branch (oref pullreq head-ref))))
    ((error "Checked out branch is not an unnamed pull-request branch"))))

;;; 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 all)
  "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.

With prefix argument ALL, fork all branches, not just the default
branch.  On Gitlab it is not possible to fork only the default."
  (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))
            current-prefix-arg)))
  (let ((repo (forge-get-repository :stub)))
    (forge--fork-repository repo fork all)
    (magit-remote-add remote
                      (magit-clone--format-url (oref repo githost) fork
                                               (oref repo name))
                      (list "--fetch"))))

;;;###autoload(autoload 'forge-merge "forge-commands" nil t)
(transient-define-suffix 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."
  (declare (interactive-only nil))
  (interactive (list (forge-read-pullreq "Merge pull-request")
                     (forge-select-merge-method)))
  (let ((pullreq (forge-get-pullreq pullreq)))
    (forge--merge-pullreq (forge-get-repository pullreq)
                          pullreq
                          (magit-commit-oid
                           (forge--pullreq-branch-internal pullreq))
                          method)))

(defun forge-select-merge-method ()
  (if (forge--childp (forge-get-repository :tracked)
                     'forge-gitlab-repository)
      (magit-read-char-case "Merge method " t
        (?m "[m]erge"  'merge)
        (?s "[s]quash" 'squash))
    (magit-read-char-case "Merge method " t
      (?m "[m]erge"  'merge)
      (?s "[s]quash" 'squash)
      (?r "[r]ebase" 'rebase))))

;;;###autoload
(defun forge-set-default-branch ()
  "Change the default branch on the upstream remote and locally.
Also update the upstream branches of local branches accordingly."
  (interactive)
  (pcase-let* ((`(,repo ,old) (forge--set-default-branch-read-args))
               (new (magit-read-remote-branch
                     (format "Set default branch (was: %s)" old)
                     (delete old (forge--get-remote))
                     nil nil t)))
    (message "Changing default branch...")
    (forge--set-default-branch repo new)
    (magit--set-default-branch new old)
    (forge-refresh-buffer)
    (message "Changing default branch...done")))

;;;###autoload
(defun forge-rename-default-branch ()
  "Rename the default branch on the upstream remote and locally.
Also update the upstream branches of local branches accordingly."
  (interactive)
  (pcase-let* ((`(,repo ,old) (forge--set-default-branch-read-args))
               (default (and (not (equal old "main")) "main"))
               (new (read-string
                     (format "Rename default branch `%s' to%s: " old
                             (if default (format " (default: %s)" default) ""))
                     nil nil default)))
    (message "Renaming default branch...")
    (forge--rename-branch repo new old)
    (magit--set-default-branch new old)
    (magit-git "remote" "set-head" "--auto" (oref repo remote))
    (forge-refresh-buffer)
    (message "Renaming default branch...done")))

(defun forge--set-default-branch-read-args ()
  (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))))
    (list repo
          (if oldhead
              (cdr (magit-split-branch-name oldhead))
            (error "Cannot determine old default branch")))))

;;; Configuration

(transient-define-suffix 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 t))
  (interactive)
  (let ((obj (transient-suffix-object)))
    (transient-infix-set obj (transient-infix-read obj)))
  (if (and transient--prefix
           (eq (oref transient--prefix command) 'forge-add-repository))
      ;; Improvements to Transient will make this hack unnecessary.
      (let ((scope (forge-add-repository--scope)))
        (oset (transient-prefix-object) scope scope))
    (transient--show)))

(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 (##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."
  :if-mode 'magit-status-mode
  :inapt-if-not #'forge--buffer-with-topics-sections-p
  :description (lambda ()
                 (if (and forge--buffer-topics-spec
                          (oref forge--buffer-topics-spec type))
                     "hide topics"
                   "display topics"))
  (interactive)
  (oset forge--buffer-topics-spec type
        (if (oref forge--buffer-topics-spec type) nil 'topic))
  (forge-refresh-buffer))

(defun forge--buffer-with-topics-sections-p ()
  (and forge--buffer-topics-spec
       (not (eq major-mode 'forge-topics-mode))
       (forge-get-repository :tracked?)))

;;;###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."
  :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."
  :refresh-suffixes t
  [:class transient-subgroups

   ;; Already tracked.
   [:if (##forge--scope :tracked)
    (:info*
     (lambda ()
       (format
        (propertize "%s is already being tracked" 'face 'transient-heading)
        (propertize (forge--scope 'url) 'face 'bold)))
     :format "%d")]

   ;; Nothing to tracked.
   [:if-not (##forge--scope 'topdir)
    (:info*
     (lambda ()
       (format
        (propertize "%s is not inside a Git repository" 'face 'transient-heading)
        (propertize default-directory 'face 'bold)))
     :format "%d")]

   ;; Cannot track.
   [:if (##and (not (forge--scope 'repo)) (forge--scope 'topdir))
    :description
    (lambda ()
      (concat
       (format (propertize "Cannot determine forge host for %s\n"
                           'face 'transient-heading)
               (propertize (forge--scope 'topdir) 'face 'bold))
       (if-let* ((remote (forge--get-remote))
                 (url (magit-git-string "remote" "get-url" remote)))
           (format (propertize "because %s is not on a host known to Forge."
                               'face 'transient-heading)
                   (propertize url 'face 'bold))
         (propertize "because no suitable remote was detected."
                     'face 'transient-heading))))
    ("r" forge-forge.remote :format " %k Try another %d %v" :face 'bold)
    ("h" "Learn how to configure another Github host"
     (lambda () (interactive) (info "(forge)Setup for Another Github Instance")))
    ("l" "Learn how to configure another Gitlab host"
     (lambda () (interactive) (info "(forge)Setup for Another Gitlab Instance")))
    ("p" "Learn how to configure partially supported host"
     (lambda () (interactive) (info "(forge)Setup a Partially Supported Host")))]

   ;; Track it!
   [:if (##forge--scope :untracked)
    :description
    (lambda ()
      (format
       (propertize "Adding %s to database," 'face 'transient-heading)
       (propertize (forge--scope 'url) 'face 'bold)))
    ("r" forge-forge.remote :format " %k from %d %v," :face 'bold)
    ("a" "pulling all topics"
     (lambda (repo)
       (interactive (list (forge--scope 'repo)))
       (forge-add-repository repo)))
    ("s" "pulling only topics since <date>"
     (lambda (repo date)
       (interactive
         (list (forge--scope 'repo)
               (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 (forge--scope 'repo)))
       (forge-add-repository repo :selective)))]

   ;; Pivot.
   [("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-add-repository--scope)))
    ((stringp repo)
     (transient-setup 'forge-add-repository nil nil
                      :scope (forge-add-repository--scope repo)))
    (t
     (when-let*
         ((_(not (eq limit :selective)))
          (_(magit-git-config-p "forge.autoPull" t))
          (remote  (oref repo remote))
          (refspec (oref repo pullreq-refspec))
          (default-directory (forge-get-worktree repo))
          (_(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
                  (and (not (forge-get-worktree repo)) #'ignore)
                  limit))))

(defun forge-add-repository--scope (&optional directory)
  (let* ((repo      (if directory
                        (forge-get-repository directory nil :stub?)
                      (forge-get-repository :stub?)))
         (wtree     (and repo (forge-get-worktree repo)))
         (condition (and repo (oref repo condition)))
         (val
          `((repo       . ,repo)
            (wtree      . ,wtree)
            (condition  . ,condition)
            (:tracked   . ,(eq condition :tracked))
            (:untracked . ,(memq condition '(:known :stub)))
            (topdir     . ,(or wtree (magit-toplevel)))
            (url        . ,(and repo (forge-get-url repo))))))
    val))

(defun forge--scope (&optional key)
  ;; `transient-scope' itself probably offer optional KEY.
  (let ((scope (transient-scope)))
    (if key (alist-get key scope) scope)))

(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.

When the region marks multiple topics, then offer to remove them all.

The topic is not removed from the forge and, if it is later modified,
then it will be added to the database again when fetching all topics.

This is useful for users who only fetch individual topics and want to
remove the topics they are no longer interested in.  This can also be
used to remove topics locally, which have already been removed on the
forge (the service).  Forge (the package) cannot automatically detect
when that happens, because given how the APIs work, this would be too
expensive."
  (interactive
    (list (if-let* ((topics (magit-region-values '(issue pullreq) t))
                    (_(magit-confirm 'remove-topics-locally nil
                        "Delete %d topics locally" nil
                        (mapcar #'forge--format-topic-line topics))))
              topics
            (forge-read-topic "Delete topic LOCALLY only"))))
  (if (listp topic)
      (progn (mapc #'closql-delete topic)
             (forge-refresh-buffer))
    (setq topic (forge-get-topic topic))
    (closql-delete topic)
    (if (and (derived-mode-p 'forge-topic-mode)
             (equal (oref topic id)
                    (oref forge-buffer-topic id)))
        (kill-buffer (current-buffer))
      (forge-refresh-buffer))))

;;;###autoload
(defun forge-reset-database ()
  "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)

;;; _
;; Local Variables:
;; read-symbol-shorthands: (
;;   ("and$"          . "cond-let--and$")
;;   ("thread$"       . "cond-let--thread$")
;;   ("when$"         . "cond-let--when$")
;;   ("and-let*"      . "cond-let--and-let*")
;;   ("and-let"       . "cond-let--and-let")
;;   ("if-let*"       . "cond-let--if-let*")
;;   ("if-let"        . "cond-let--if-let")
;;   ("when-let*"     . "cond-let--when-let*")
;;   ("when-let"      . "cond-let--when-let")
;;   ("while-let*"    . "cond-let--while-let*")
;;   ("while-let"     . "cond-let--while-let")
;;   ("buffer-string" . "buffer-string")
;;   ("buffer-str"    . "forge--buffer-substring-no-properties")
;;   ("partial"       . "llama--left-apply-partially"))
;; End:
(provide 'forge-commands)
;;; forge-commands.el ends here
